--- loncom/interface/lonmenu.pm 2009/12/14 23:03:27 1.309.2.3
+++ loncom/interface/lonmenu.pm 2012/05/14 13:58:04 1.369.2.2
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.309.2.3 2009/12/14 23:03:27 raeburn Exp $
+# $Id: lonmenu.pm,v 1.369.2.2 2012/05/14 13:58:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,8 +28,6 @@
#
# There is one parameter controlling the action of this module:
#
-# environment.remote - if this is 'on', the routines controll the remote
-# control, otherwise they render the main window controls;
=head1 NAME
@@ -42,48 +40,76 @@ Coordinates the response to clicking an
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
-=head1 SUBROUTINES
+=head1 GLOBAL VARIABLES
=over
-Little texts
+=item @desklines
-=item initlittle()
+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 menubuttons()
+=item %category_names
-This gets called at the top of the body section
+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 show_return_link()
+=item %category_members
-=item registerurl()
+TODO
-This gets called in the header section
+=item %category_positions
-=item innerregister()
+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.
-This gets called in order to register a URL, both with the Remote
-and in the body of the document
+=back
-=item loadevents()
+=head1 SUBROUTINES
-=item unloadevents()
+=over
-=item startupremote()
+=item prep_menuitems(\@menuitem)
-=item setflags()
+This routine wraps a menuitem in proper HTML. It is used by primary_menu() and
+secondary_menu().
-=item maincall()
+=item primary_menu()
-=item load_remote_msg()
+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 get_menu_name()
+=item secondary_menu()
-=item reopenmenu()
+Same as primary_menu() but operates on @secondary_menu.
-=item open()
+=item innerregister()
-Open the menu
+This gets called in order to register a URL in the body of the document
=item clear()
@@ -101,10 +127,6 @@ The javascript is usually similar to "go
=item rawconfig()
-=item close()
-
-=item footer()
-
=item utilityfunctions()
=item serverform()
@@ -131,6 +153,7 @@ use Apache::lonhtmlcommon();
use Apache::loncommon();
use Apache::lonenc();
use Apache::lonlocal;
+use Apache::lonmsg();
use LONCAPA qw(:DEFAULT :match);
use HTML::Entities();
@@ -150,7 +173,10 @@ sub prep_menuitem {
} else { # textual Link
$link = &mt($$menuitem[3]);
}
- return '
'.$link.'';
+ return '$link|;
}
# primary_menu() evaluates @primary_menu and returns XHTML for the menu
@@ -160,9 +186,13 @@ sub prep_menuitem {
# entries from mydesk.tab
sub primary_menu {
my $menu;
- my $custommenu = &Apache::loncommon::needs_gci_custom();
# 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'; #
@@ -170,16 +200,12 @@ sub primary_menu {
&& &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,
- && $env{'user.name'} eq 'public' ##who should not see all
- && $env{'user.domain'} eq 'public'; ##links
+ 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
- && $env{'user.name'} ne 'public' # only visible to public
- && $env{'user.domain'} ne 'public'; # users
- next if $$menuitem[4] eq 'roles' # hide links which are
- && $custommenu; # not visible when GCI
- next if $$menuitem[4] eq 'courses' # tabbed interface in use
- && $custommenu; #
+ && !$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
@@ -187,56 +213,103 @@ sub primary_menu {
if ($$menuitem[3] eq 'Help') { # special treatment for helplink
- $menu .= ''.&Apache::loncommon::top_nav_help('Help').'';
+ 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 {
- my @items = @{$menuitem};
- $items[0] = 'javascript:'.$menuitem->[0].';';
- $menu .= &prep_menuitem(\@items);
+ $menu .= prep_menuitem($menuitem);
}
}
+ $menu =~ s/\[domain\]/$env{'user.domain'}/g;
+ $menu =~ s/\[user\]/$env{'user.name'}/g;
return "";
}
+#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;
+}
sub secondary_menu {
my $menu;
my $crstype = &Apache::loncommon::course_type();
- my $canedit = &Apache::lonnet::allowed('mdc', $env{'request.course.id'});
- my $canviewgrps = &Apache::lonnet::allowed('vcg', $env{'request.course.id'}
- . ($env{'request.course.sec'} ? "/$env{'request.course.sec'}"
- : ''));
- my $showlink = &show_return_link();
+ 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 $canmgr = &Apache::lonnet::allowed('mgr', $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] eq 'showreturn'
- && !$showlink
- && !($env{'request.state'} eq 'construct');
next if $$menuitem[4] =~ /^mdc/
&& !$canedit;
- next if $$menuitem[4] eq 'mdcCourse'
- && $crstype eq 'Community';
- next if $$menuitem[4] eq 'mdcCommunity'
- && $crstype ne 'Community';
- next if $$menuitem[4] =~ /^remotenav/
- && $env{'environment.remotenavmap'} ne 'on';
- next if $$menuitem[4] =~ /noremotenav/
- && $env{'environment.remotenavmap'} eq 'on';
- next if $$menuitem[4] =~ /^(no|)remotenav$/
- && $crstype eq 'Community';
- next if $$menuitem[4] =~ /^(no|)remotenavCommunity$/
- && $crstype ne 'Community';
+ 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 'ncst'
+ && $canmodifyuser;
+ next if $$menuitem[4] eq 'mgr'
+ && !$canmgr;
+ next if $$menuitem[4] eq 'nmgr'
+ && $canmgr;
+ 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
@@ -246,15 +319,6 @@ sub secondary_menu {
$menu .= $roles_selector ? "$roles_selector"
: '';
- } elsif ($env{'environment.remotenavmap'} eq 'on') {
- # open link using javascript when remote navmap is activated
- my @items = @{$menuitem};
- if ($menuitem->[4] eq 'remotenav') {
- $items[0] = "javascript:gonav('$menuitem->[0]');";
- } else {
- $items[0] = "javascript:go('$menuitem->[0]');";
- }
- $menu .= &prep_menuitem(\@items);
} else {
$menu .= &prep_menuitem(\@$menuitem);
}
@@ -270,292 +334,21 @@ sub secondary_menu {
and ( $env{'request.noversionuri'} eq ''
|| !defined($env{'request.noversionuri'})))
{
- ($escurl = $env{'request.filename'}) =~
- s{^/home/([^/]+)/public_html/(.*)$}{/priv/$1/$2};
-
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ ($escurl = $env{'request.filename'}) =~ s{^\Q$londocroot\E}{};
$escurl = &escape($escurl);
}
$menu =~ s/\[url\]/$escurl/g;
$menu =~ s/\[symb\]/$escsymb/g;
}
+ $menu =~ s/\[uname\]/$$author{user}/g;
+ $menu =~ s/\[udom\]/$$author{dom}/g;
return "";
}
-sub gci_secondary_menu {
- my %courses = (
- 'review' => 'gci_9615072b469884921gcil1',
- 'submit' => 'gci_1H96711d710194bfegcil1',
- );
- my %linktext = (
- 'review' => 'Review Questions',
- 'submit' => 'Submit Questions',
- 'managetest' => 'Manage Tests',
- );
- my %links = (
- 'managetest' => '/adm/menu',
- );
- my $current = 'managetest';
- foreach my $key (keys(%courses)) {
- $links{$key} = "javascript:switchpage('$key');";
- if ($env{'request.course.id'} eq $courses{$key}) {
- $links{$key} = '/adm/navmaps';
- $current = $key;
- $links{'managetest'} = '/adm/roles?selectrole=1&cm=1&orgurl=%2fadm%2fmenu';
- }
- }
- my @menutabs = ('review','submit','managetest');
- my $tabs;
- foreach my $item (@menutabs) {
- if ($item eq $current) {
- $tabs .= ' '.
- $linktext{$item}.'';
- } else {
- $tabs .= ' '.
- $linktext{$item}.'';
- }
- }
- return '
';
-}
-
-#
-# This routine returns a translated hash for the menu items in the top inline menu row
-# Probably should be in mydesk.tab
-
-#SD this sub is deprecated - don't use it
-sub initlittle {
- return &Apache::lonlocal::texthash('ret' => 'Return to Last Location',
- 'nav' => 'Course Contents',
- 'main' => 'Main Menu',
- 'roles' => (&Apache::loncommon::show_course()?
- 'Courses':'Roles'),
- 'other' => 'Other Roles',
- 'docs' => 'Edit Course',
- 'exit' => 'Logout',
- 'login' => 'Log In',
- 'launch' => 'Launch Remote Control',
- 'groups' => 'Groups',
- 'gdoc' => 'Community Documents',
- );
-}
-
-#SD this sub is deprecated - don't use it
-#SD functionality is covered by new loncommon::bodytag and primary_menu(), secondary_menu()
-sub menubuttons {
- my $forcereg=shift;
- my $titletable=shift;
-#
-# Early-out for pages that should not have a menu, triggered by query string "inhibitmenu=yes"
-#
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['inhibitmenu']);
- if (($env{'form.inhibitmenu'} eq 'yes') ||
- ($ENV{'REQUEST_URI'} eq '/adm/logout')) { return ''; }
-
- if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { return ''; }
-
- my %lt=&initlittle();
- my $navmaps='';
- my $reloadlink='';
- my $docs='';
- my $groups='';
- my $roles=''.$lt{'roles'}.'';
- my $role_selector;
- my $showgroups=0;
- my ($cnum,$cdom);
-#
-# if the URL is hidden, symbs and the non-versioned version of the URL would be encrypted
-#
- my $escurl=&escape(&Apache::lonenc::check_encrypt($env{'request.noversionuri'}));
- my $escsymb=&escape(&Apache::lonenc::check_encrypt($env{'request.symb'}));
-
- my $logo=&Apache::loncommon::lonhttpdurl("/adm/lonIcons/minilogo.gif");
- $logo = '';
-
- if ($env{'request.state'} eq 'construct') {
-#
-# We are in construction space
-#
- if (($env{'request.noversionuri'} eq '') || (!defined($env{'request.noversionuri'}))) {
- my $returnurl = $env{'request.filename'};
- $returnurl =~ s:^/home/([^/]+)/public_html/(.*)$:/priv/$1/$2:;
- $escurl = &escape($returnurl);
- }
- }
- if ($env{'request.course.id'}) {
-#
-# We are in a course
-#
- $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my %coursegroups;
- my $viewgrps_permission =
- &Apache::lonnet::allowed('vcg',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''));
- if (!$viewgrps_permission) {
- %coursegroups = &Apache::lonnet::get_active_groups($env{'user.domain'},$env{'user.name'},$cdom,$cnum);
- }
- if ((keys(%coursegroups) > 0) || ($viewgrps_permission)) {
- $showgroups = 1;
- }
- $role_selector = &roles_selector($cdom,$cnum);
- if ($role_selector) {
- $roles = ''.$role_selector.' '.$lt{'other'}.'';
- }
- }
-
- if ($env{'environment.remote'} eq 'off') {
-# Remote Control is switched off
-# figure out colors
- my %lt=&initlittle();
-
- my $domain=&Apache::loncommon::determinedomain();
- my $function=&Apache::loncommon::get_users_function();
- my $link=&Apache::loncommon::designparm($function.'.link',$domain);
- my $alink=&Apache::loncommon::designparm($function.'.alink',$domain);
- my $vlink=&Apache::loncommon::designparm($function.'.vlink',$domain);
- my $sidebg=&Apache::loncommon::designparm($function.'.sidebg',$domain);
-
- if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
- return (<