--- loncom/interface/lonmenu.pm 2003/05/16 20:47:07 1.66
+++ loncom/interface/lonmenu.pm 2012/05/23 00:29:22 1.369.2.5
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.66 2003/05/16 20:47:07 albertel Exp $
+# $Id: lonmenu.pm,v 1.369.2.5 2012/05/23 00:29:22 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,468 +26,881 @@
# http://www.lon-capa.org/
#
#
-# There are two parameters controlling the action of this module:
-#
-# browser.interface - if this is 'textual', it overrides the second parameter
-# and goes to screen reader PDA mode
-#
-# environment.remote - if this is 'on', the routines controll the remote
-# control, otherwise they render the main window controls; ignored it
-# browser.interface is 'textual'
-#
+
+=head1 NAME
+
+Apache::lonmenu
+
+=head1 SYNOPSIS
+
+Loads contents of /home/httpd/lonTabs/mydesk.tab,
+used to generate inline menu, and Main Menu page.
+
+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 %primary_sub_menu
+
+The keys of this hash reference are the names of items in the primary_menu array
+which have sub-menus. For each key, the corresponding value is a reference to
+an array containing components extracted from lines in mydesk.tab which begin
+with primsub:.
+This hash, which is used by primary_menu to generate sub-menus, is populated in
+the BEGIN block.
+
+=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::lonhtmlcommon();
-use Apache::loncommon;
-use Apache::File;
-use vars qw(@desklines $readdesk);
+use Apache::loncommon();
+use Apache::lonenc();
+use Apache::lonlocal;
+use Apache::lonmsg();
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities();
+
+use vars qw(@desklines %category_names %category_members %category_positions
+ $readdesk @primary_menu %primary_submenu @secondary_menu %secondary_submenu);
+
my @inlineremote;
-my $font;
-my $tabbg;
-my $pgbg;
-
-# ============================= This gets called at the top of the body section
-
-sub menubuttons {
- my $forcereg=shift;
- my $target =shift;
- my $registration=shift;
- my $navmaps='';
- my $reloadlink='';
- my $escurl=&Apache::lonnet::escape($ENV{'REQUEST_URI'});
- my $escsymb=&Apache::lonnet::escape($ENV{'request.symb'});
- if ($ENV{'browser.interface'} eq 'textual') {
-# Textual display only
- if ($ENV{'request.course.id'}) {
- $navmaps=(<Navigate Contents
-ENDNAV
- if (($ENV{'REQUEST_URI'}=~/^\/adm\//) &&
- ($ENV{'REQUEST_URI'}!~/^\/adm\/wrapper\//) &&
- ($ENV{'REQUEST_URI'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
- my $escreload=&Apache::lonnet::escape('return:');
- $reloadlink=(<Return to Last Location
-ENDRELOAD
- }
- }
- my $output=(<
-// BEGIN LON-CAPA Internal
-
-Main Menu
-$reloadlink $navmaps
-
-ENDMAINMENU
- if ($registration) { $output.=&innerregister($forcereg,$target); }
- return $output."";
- } elsif ($ENV{'environment.remote'} eq 'off') {
-# Remote Control is switched off
-# figure out colors
- my $function='student';
- if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
- $function='coordinator';
- }
- if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
- $function='admin';
- }
- if (($ENV{'request.role'}=~/^(au|ca)/) ||
- ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
- $function='author';
- }
- my $domain=&Apache::loncommon::determinedomain();
- $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
- $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
- $font=&Apache::loncommon::designparm($function.'.font',$domain);
- 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);
-# Do we have a NAV link?
- if ($ENV{'request.course.id'}) {
- $navmaps=(<
-Navigate Contents
-ENDNAVREM
- if (($ENV{'REQUEST_URI'}=~/^\/adm\//) &&
- ($ENV{'REQUEST_URI'}!~/^\/adm\/wrapper\//) &&
- ($ENV{'REQUEST_URI'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
- my $escreload=&Apache::lonnet::escape('return:');
- $reloadlink=(<
-Return to Last Location
-ENDRELOAD
- }
- }
- my $reg='';
- if ($registration) {
- $reg=&innerregister($forcereg,$target);
- }
- return (<
-// BEGIN LON-CAPA Internal
-
-
|;
+}
+
+# primary_menu() evaluates @primary_menu and returns XHTML for the menu
+# that contains following links:
+# About, Message, Personal, 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(); ##
+
+ my $title = $menuitem->[3];
+ if (defined($primary_submenu{$title})) {
+ my ($link,$target,$numsub);
+ if ($menuitem->[0] ne '') {
+ $link = $menuitem->[0];
+ $target = '_top';
+ } else {
+ $link = '#';
+ }
+ if (ref($primary_submenu{$title}) eq 'ARRAY') {
+ $numsub = @{$primary_submenu{$title}};
+ if ($numsub) {
+ $title =
+ ''.$title.
+ ''.
+ ' ▼';
+ }
+ }
+ $menu .= '
';
+ } elsif ($$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";
}
-# ====================================== This gets called in the header section
+#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 $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 $canviewroster = $env{'course.'.$env{'request.course.id'}.'.student_classlist_view'};
+ 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] =~ /^mdc/
+ && !$canedit;
+ next if $$menuitem[4] eq 'mdcCourse'
+ && ($crstype eq 'Community');
+ next if $$menuitem[4] eq 'mdcCommunity'
+ && ($crstype eq 'Course');
+ 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 || !$canviewroster);
+ 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] eq 'nvcg'
+ && ($canviewgrps || !%groups);
+ next if $$menuitem[4] eq 'author'
+ && !$author;
+
+ my $title = $menuitem->[3];
+ if (defined($secondary_submenu{$title})) {
+ my ($link,$target,$numsub);
+ if ($menuitem->[0] ne '') {
+ $link = $menuitem->[0];
+ $target = '_top';
+ } else {
+ $link = '#';
+ }
-sub registerurl {
- my $forcereg=shift;
- my $target = shift;
- my $result = '';
+ my @scndsub;
+ if (ref($secondary_submenu{$title}) eq 'ARRAY') {
+ $numsub = 0;
+ foreach my $item (@{$secondary_submenu{$title}}) {
+ if (ref($item) eq 'ARRAY') {
+ next if ($item->[2] eq 'vgr' && !$canvgr);
+ next if ($item->[2] eq 'opa' && !$canmodpara);
+ next if ($item->[2] eq 'cst' && !$canmodifyuser);
+ next if ($item->[2] eq 'mgr' && !$canmgr);
+ next if ($item->[2] eq 'vcg' && !$canviewgrps);
+ push(@scndsub,$item);
+ $numsub ++;
+ }
+ }
+ if ($numsub) {
+ $title =
+ ''.$title.
+ ''.
+ ' ▼';
+ }
+ }
+ $menu .= '