--- loncom/interface/lonmenu.pm 2003/02/14 15:14:37 1.37
+++ loncom/interface/lonmenu.pm 2011/01/16 22:45:05 1.342
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.37 2003/02/14 15:14:37 www Exp $
+# $Id: lonmenu.pm,v 1.342 2011/01/16 22:45:05 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,341 +25,1621 @@
#
# http://www.lon-capa.org/
#
-# (TeX Conversion Module
#
-# 05/29/00,05/30 Gerd Kortemeyer)
+# There is one parameter controlling the action of this module:
#
-# 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
-# 02/15/02 Matthew Hall
+
+=head1 NAME
+
+Apache::lonmenu
+
+=head1 SYNOPSIS
+
+Coordinates the response to clicking an image.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 GLOBAL VARIABLES
+
+=over
+
+=item @desklines
+
+Each element of this array contains a line of mydesk.tab that doesn't start with
+cat, prim or scnd.
+It gets filled in the BEGIN block of this module.
+
+=item %category_names
+
+The keys of this hash are the abbreviations used in mydesk.tab in those lines that
+start with cat, the values are strings representing titles.
+It gets filled in the BEGIN block of this module.
+
+=item %category_members
+
+TODO
+
+=item %category_positions
+
+The keys of this hash are the abbreviations used in mydesk.tab in those lines that
+start with cat, its values are position vectors (column, row).
+It gets filled in the BEGIN block of this module.
+
+=item $readdesk
+
+Indicates that mydesk.tab has been read.
+It is set to 'done' in the BEGIN block of this module.
+
+=item @primary_menu
+
+The elements of this array reference arrays that are made up of the components
+of those lines of mydesk.tab that start with prim.
+It is used by primary_menu() to generate the corresponding menu.
+It gets filled in the BEGIN block of this module.
+
+=item @secondary_menu
+
+The elements of this array reference arrays that are made up of the components
+of those lines of mydesk.tab that start with scnd.
+It is used by secondary_menu() to generate the corresponding menu.
+It gets filled in the BEGIN block of this module.
+
+=back
+
+=head1 SUBROUTINES
+
+=over
+
+=item prep_menuitems(\@menuitem)
+
+This routine wraps a menuitem in proper HTML. It is used by primary_menu() and
+secondary_menu().
+
+=item primary_menu()
+
+This routine evaluates @primary_menu and returns XHTML for the menu
+that contains following links: About, Message, Roles, Help, Logout
+@primary_menu is filled within the BEGIN block of this module with
+entries from mydesk.tab
+
+=item secondary_menu()
+
+Same as primary_menu() but operates on @secondary_menu.
+
+=item innerregister()
+
+This gets called in order to register a URL in the body of the document
+
+=item clear()
+
+=item switch()
+
+Switch a button or create a link
+Switch acts on the javascript that is executed when a button is clicked.
+The javascript is usually similar to "go('/adm/roles')" or "cstrgo(..)".
+
+=item secondlevel()
+
+=item openmenu()
+
+=item inlinemenu()
+
+=item rawconfig()
+
+=item utilityfunctions()
+
+=item serverform()
+
+=item constspaceform()
+
+=item get_nav_status()
+
+=item hidden_button_check()
+
+=item roles_selector()
+
+=item jump_to_role()
+
+=back
+
+=cut
package Apache::lonmenu;
use strict;
use Apache::lonnet;
-use Apache::Constants qw(:common);
-use Apache::loncommon;
-use Apache::File;
-use vars qw(@desklines $readdesk);
-
-# ============================================================= Start up remote
-
-sub startupremote {
- my ($lowerurl)=@_;
- if ($ENV{'browser.interface'} eq 'textual') {
- return ('');
- }
- my $configmenu=&rawconfig();
- return(<
-
-function wheelswitch() {
- if (window.status=='|') {
- window.status='/';
- } else {
- if (window.status=='/') {
- window.status='-';
- } else {
- if (window.status=='-') {
- window.status='\\\\';
- } else {
- if (window.status=='\\\\') { window.status='|'; }
- }
- }
- }
+use Apache::lonhtmlcommon();
+use Apache::loncommon();
+use Apache::lonenc();
+use Apache::lonlocal;
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities();
+
+use vars qw(@desklines %category_names %category_members %category_positions
+ $readdesk @primary_menu @secondary_menu);
+
+my @inlineremote;
+
+sub prep_menuitem {
+ my ($menuitem) = @_;
+ return '' unless(ref($menuitem) eq 'ARRAY');
+ my $link;
+ if ($$menuitem[1]) { # graphical Link
+ $link = "";
+ } else { # textual Link
+ $link = &mt($$menuitem[3]);
+ }
+ return '
|;
}
-// ---------------------------------------------------------- The wait function
-var canceltim;
-function wait() {
- if ((menuloaded==1) || (tim==1)) {
- window.status='Done.';
- if (tim==0) {
- clearTimeout(canceltim);
- $configmenu
- window.location='$lowerurl';
- } else {
- alert("Remote Control timed out. It is possible that it was blocked by pop-up window filters.");
- }
- } else {
- wheelswitch();
- setTimeout('wait();',200);
- }
+# primary_menu() evaluates @primary_menu and returns XHTML for the menu
+# that contains following links:
+# About, Message, Roles, Help, Logout
+# @primary_menu is filled within the BEGIN block of this module with
+# entries from mydesk.tab
+sub primary_menu {
+ my $menu;
+ # each element of @primary contains following array:
+ # (link url, icon path, alt text, link text, condition)
+ my $public;
+ if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
+ || (($env{'user.name'} eq '') && ($env{'user.domain'} eq ''))) {
+ $public = 1;
+ }
+ foreach my $menuitem (@primary_menu) {
+ # evaluate conditions
+ next if ref($menuitem) ne 'ARRAY'; #
+ next if $$menuitem[4] eq 'nonewmsg' # show links depending on
+ && &Apache::lonmsg::mynewmail(); # whether a new msg
+ next if $$menuitem[4] eq 'newmsg' # arrived or not
+ && !&Apache::lonmsg::mynewmail(); #
+ next if $$menuitem[4] !~ /public/ ##we've a public user,
+ && $public; ##who should not see all
+ ##links
+ next if $$menuitem[4] eq 'onlypublic'# hide links which are
+ && !$public; # only visible to public
+ # users
+ next if $$menuitem[4] eq 'roles' ##show links depending on
+ && &Apache::loncommon::show_course(); ##term 'Courses' or
+ next if $$menuitem[4] eq 'courses' ##'Roles' wanted
+ && !&Apache::loncommon::show_course(); ##
+
+
+ if ($$menuitem[3] eq 'Help') { # special treatment for helplink
+ if ($public) {
+ my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
+ my $defdom = &Apache::lonnet::default_login_domain();
+ my $to = &Apache::loncommon::build_recipient_list(undef,
+ 'helpdeskmail',
+ $defdom,$origmail);
+ if ($to ne '') {
+ $menu .= &prep_menuitem($menuitem);
+ }
+ } else {
+ $menu .= '
'.&Apache::loncommon::top_nav_help('Help').'
';
+ }
+ } else {
+ $menu .= prep_menuitem($menuitem);
+ }
+ }
+ $menu =~ s/\[domain\]/$env{'user.domain'}/g;
+ $menu =~ s/\[user\]/$env{'user.name'}/g;
+
+ return "$menu";
}
-function main() {
- canceltim=setTimeout('tim=1;',60000);
- window.status='-';
- wait();
+#returns hashref {user=>'',dom=>''} containing:
+# own name, domain if user is au
+# name, domain of parent author if user is ca or aa
+#empty return if user is not an author or not on homeserver
+#
+#TODO this should probably be moved somewhere more central
+#since it can be used by different parts of the system
+sub getauthor{
+ return unless $env{'request.role'}=~/^(ca|aa|au)/; #nothing to do if user isn't some kind of author
+
+ #co- or assistent author?
+ my ($dom, $user) = ($env{'request.role'} =~ /^(?:ca|aa)\.\/($match_domain)\/($match_username)$/)
+ ? ($1, $2) #domain, username of the parent author
+ : @env{ ('request.role.domain', 'user.name') }; #own domain, username
+
+ # current server == home server?
+ my $home = &Apache::lonnet::homeserver($user,$dom);
+ foreach (&Apache::lonnet::current_machine_ids()){
+ return {user => $user, dom => $dom} if $_ eq $home;
+ }
+
+ # if wrong server
+ return;
}
-
-ENDREMOTESTARTUP
+sub secondary_menu {
+ my $menu;
+
+ my $crstype = &Apache::loncommon::course_type();
+ my $crs_sec = $env{'request.course.id'} . ($env{'request.course.sec'}
+ ? "/$env{'request.course.sec'}"
+ : '');
+ my $canedit = &Apache::lonnet::allowed('mdc', $env{'request.course.id'});
+ my $canviewgrps = &Apache::lonnet::allowed('vcg', $crs_sec);
+ my $canmodifyuser = &Apache::lonnet::allowed('cst', $crs_sec);
+ my $canviewwnew = &Apache::lonnet::allowed('whn', $crs_sec);
+ my $canmodpara = &Apache::lonnet::allowed('opa', $crs_sec);
+ my $canvgr = &Apache::lonnet::allowed('vgr', $crs_sec);
+ my $author = getauthor();
+
+ my %groups = &Apache::lonnet::get_active_groups(
+ $env{'user.domain'}, $env{'user.name'},
+ $env{'course.' . $env{'request.course.id'} . '.domain'},
+ $env{'course.' . $env{'request.course.id'} . '.num'});
+
+ foreach my $menuitem (@secondary_menu) {
+ # evaluate conditions
+ next if ref($menuitem) ne 'ARRAY';
+ next if $$menuitem[4] ne 'always'
+ && $$menuitem[4] ne 'author'
+ && !$env{'request.course.id'};
+ next if $$menuitem[4] =~ /^mdc/
+ && !$canedit;
+ next if $$menuitem[4] eq 'nvgr'
+ && $canvgr;
+ next if $$menuitem[4] eq 'vgr'
+ && !$canvgr;
+ next if $$menuitem[4] eq 'cst'
+ && !$canmodifyuser;
+ next if $$menuitem[4] eq 'whn'
+ && !$canviewwnew;
+ next if $$menuitem[4] eq 'opa'
+ && !$canmodpara;
+ next if $$menuitem[4] =~ /showgroups$/
+ && !$canviewgrps
+ && !%groups;
+ next if $$menuitem[4] eq 'author'
+ && !$author;
+
+ if ($$menuitem[3] eq 'Roles' && $env{'request.course.id'}) {
+ # special treatment for role selector
+ my $roles_selector = &roles_selector(
+ $env{'course.' . $env{'request.course.id'} . '.domain'},
+ $env{'course.' . $env{'request.course.id'} . '.num'} );
+
+ $menu .= $roles_selector ? "