--- loncom/interface/lonmenu.pm 2003/01/29 15:22:06 1.31
+++ loncom/interface/lonmenu.pm 2010/03/16 19:55:49 1.318
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.31 2003/01/29 15:22:06 www Exp $
+# $Id: lonmenu.pm,v 1.318 2010/03/16 19:55:49 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,222 +25,1510 @@
#
# 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 show_return_link()
+
+=item registerurl()
+
+This gets called in the header section
+
+=item innerregister()
+
+This gets called in order to register a URL, both with the Remote
+and 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::File;
-use vars qw(@desklines $readdesk);
+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 '
|;
+}
-# ================================================================= Reopen menu
+# 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)
+ 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,
+ && $env{'user.name'} eq 'public' ##who should not see all
+ && $env{'user.domain'} eq 'public'; ##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' ##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
+ $menu .= '
'.&Apache::loncommon::top_nav_help('Help').'
';
+ } else {
+ my @items = @{$menuitem};
+ $items[0] = 'javascript:'.$menuitem->[0].';';
+ $menu .= &prep_menuitem(\@items);
+ }
+ }
-sub reopenmenu {
- my $nothing='';
- my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
- if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
- return('window.open("'.$nothing.'","'.$menuname.'","",false);');
-}
-
-# =============================================================== Open the menu
-
-sub open {
- my $returnval='';
- my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
- unless (shift eq 'unix') {
-# resizing does not work on linux because of virtual desktop sizes
- $returnval.=(<'.$returnval.'';
-}
-
-# ============================================================ Switch Menu Item
-
-sub switchmenu {
- my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
- my $openwin=&openmenu();
- return(<
- var swmenu=$openwin
- swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action","$description");
-
-ENDSMENU
+ return "$menu";
+}
+
+
+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 %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'
+ && !$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] =~ /^Course$/
+ && $crstype eq 'Community';
+ next if $$menuitem[4] =~ /^Community$/
+ && $crstype ne 'Community';
+ next if $$menuitem[4] =~ /showgroups$/
+ && !$canviewgrps
+ && !%groups;
+
+ 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 ? "
";
+}
+
+sub show_return_link {
+ return (($env{'request.noversionuri'}=~m{^/(res|public)/} &&
+ $env{'request.symb'} eq '')
+ ||
+ ($env{'request.noversionuri'}=~ m{^/cgi-bin/printout.pl})
+ ||
+ (($env{'request.noversionuri'}=~/^\/adm\//) &&
+ ($env{'request.noversionuri'}!~/^\/adm\/wrapper\//) &&
+ ($env{'request.noversionuri'}!~
+ m[^/adm/.*/(smppg|bulletinboard|aboutme)($|\?)])
+ ));
+}
+
+
+sub registerurl {
+ if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { return ''; }
+ return Apache::lonxml::display_title();
+}
+
+sub innerregister {
+ my ($forcereg,$titletable,$bread_crumbs) = @_;
+ my ($uname,$thisdisfn);
+ my $const_space = ($env{'request.state'} eq 'construct');
+ my $is_const_dir = 0;
+
+ if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { return ''; }
+
+ $env{'request.registered'} = 1;
+
+ undef(@inlineremote);
+
+ if ( $env{'request.symb'} && $env{'request.course.id'} ) {
+
+ my ($mapurl,$rid,$resurl) = &Apache::lonnet::decode_symb(&Apache::lonnet::symbread());
+ my $coursetitle = $env{'course.'.$env{'request.course.id'}.'.description'};
+
+ my $maptitle = &Apache::lonnet::gettitle($mapurl);
+ my $restitle = &Apache::lonnet::gettitle(&Apache::lonnet::symbread());
+
+#SD
+#course_type only Course and Community?
+#
+ my @crumbs = ({text => Apache::loncommon::course_type()
+ . ' Contents',
+ href => "Javascript:gonav('/adm/navmaps')"});
+
+ if ($mapurl ne $env{'course.'.$env{'request.course.id'}.'.url'}) {
+ push(@crumbs, {text => '...',
+ no_mt => 1});
+ }
+
+ push @crumbs, {text => $maptitle, no_mt => 1} if ($maptitle
+ && $maptitle ne 'default.sequence'
+ && $maptitle ne $coursetitle);
+
+ push @crumbs, {text => $restitle, no_mt => 1} if $restitle;
+
+ &Apache::lonhtmlcommon::clear_breadcrumbs();
+ &Apache::lonhtmlcommon::add_breadcrumb(@crumbs);
+ }
+# =============================================================================
+# ============================ This is for URLs that actually can be registered
+ return '' unless ( ($env{'request.noversionuri'}!~m{^/(res/)*adm/})
+ || $forcereg );
+
+# -- This applies to homework problems for users with grading privileges
+ my $crs='/'.$env{'request.course.id'};
+ if ($env{'request.course.sec'}) {
+ $crs.='_'.$env{'request.course.sec'};
+ }
+ $crs=~s/\_/\//g;
+
+ my $hwkadd='';
+ if ($env{'request.symb'} ne '' &&
+ $env{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form|task)$/) {
+ if (&Apache::lonnet::allowed('mgr',$crs)) {
+ $hwkadd.=&switch('','',7,2,'pgrd.png','problem[_1]','grades[_4]',
+ "gocmd('/adm/grades','gradingmenu')",
+ 'Modify user grades for this assessment resource');
+ } elsif (&Apache::lonnet::allowed('vgr',$crs)) {
+ $hwkadd.=&switch('','',7,2,'subm.png','view sub-[_1]','missions[_1]',
+ "gocmd('/adm/grades','submission')",
+ 'View user submissions for this assessment resource');
+ }
+ }
+ if ($env{'request.symb'} ne '' &&
+ &Apache::lonnet::allowed('opa',$crs)) {
+ $hwkadd.=&switch('','',7,3,'pparm.png','problem[_2]','parms[_2]',
+ "gocmd('/adm/parmset','set')",
+ 'Modify parameter settings for this resource');
+ }
+# -- End Homework
+ ###
+ ### Determine whether or not to display the 'cstr' button for this
+ ### resource
+ ###
+ my $editbutton = '';
+ my $noeditbutton = 1;
+ my ($cnum,$cdom);
+ if ($env{'request.course.id'}) {
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ }
+ if ($env{'user.author'}) {
+ if ($env{'request.role'}=~/^(aa|ca|au)/) {
+#
+# We have the role of an author
+#
+ # Set defaults for authors
+ my ($top,$bottom) = ('con-','struct');
+ my $action = "go('/priv/".$env{'user.name'}."');";
+ my $cadom = $env{'request.role.domain'};
+ my $caname = $env{'user.name'};
+ my $desc = "Enter my construction space";
+ # Set defaults for co-authors
+ if ($env{'request.role'} =~ /^ca/) {
+ ($cadom,$caname)=($env{'request.role'}=~/($match_domain)\/($match_username)$/);
+ ($top,$bottom) = ('co con-','struct');
+ $action = "go('/priv/".$caname."');";
+ $desc = "Enter construction space as co-author";
+ } elsif ($env{'request.role'} =~ /^aa/) {
+ ($cadom,$caname)=($env{'request.role'}=~/($match_domain)\/($match_username)$/);
+ ($top,$bottom) = ('co con-','struct');
+ $action = "go('/priv/".$caname."');";
+ $desc = "Enter construction space as assistant co-author";
+ }
+ # Check that we are on the correct machine
+ my $home = &Apache::lonnet::homeserver($caname,$cadom);
+ my $allowed=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if (!$allowed) {
+ $editbutton=&switch('','',6,1,$top,,$bottom,$action,$desc);
+ $noeditbutton = 0;
+ }
+ }
+#
+# We are an author for some stuff, but currently do not have the role of author.
+# Figure out if we have authoring privileges for the resource we are looking at.
+# This should maybe become a privilege check in lonnet
+#
+ ##
+ ## Determine if user can edit url.
+ ##
+ my $cfile='';
+ my $cfuname='';
+ my $cfudom='';
+ my $uploaded;
+ if ($env{'request.filename'}) {
+ my $file=&Apache::lonnet::declutter($env{'request.filename'});
+ if (defined($cnum) && defined($cdom)) {
+ $uploaded = &is_course_upload($file,$cnum,$cdom);
+ }
+ if (!$uploaded) {
+ $file=~s/^($match_domain)\/($match_username)/\/priv\/$2/;
+ # Check that the user has permission to edit this resource
+ ($cfuname,$cfudom)=&Apache::loncacc::constructaccess($file,$1);
+ if (defined($cfudom)) {
+ my $home=&Apache::lonnet::homeserver($cfuname,$cfudom);
+ my $allowed=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if ($allowed) {
+ $cfile=$file;
+ }
+ }
+ }
+ }
+ # Finally, turn the button on or off
+ if ($cfile && !$const_space) {
+ my $nocrsedit;
+ # Suppress display where CC has switched to student role.
+ if ($env{'request.course.id'}) {
+ unless(&Apache::lonnet::allowed('mdc',
+ $env{'request.course.id'})) {
+ $nocrsedit = 1;
+ }
+ }
+ if ($nocrsedit) {
+ $editbutton=&clear(6,1);
+ } else {
+ $editbutton=&switch
+ ('','',6,1,'pcstr.png','edit[_1]','resource[_2]',
+ "go('".$cfile."');","Edit this resource");
+ $noeditbutton = 0;
+ }
+ } elsif ($editbutton eq '') {
+ $editbutton=&clear(6,1);
+ }
+ }
+ if (($noeditbutton) && ($env{'request.filename'})) {
+ if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
+ my $file=&Apache::lonnet::declutter($env{'request.filename'});
+ if (defined($cnum) && defined($cdom)) {
+ if (&is_course_upload($file,$cnum,$cdom)) {
+ my $cfile = &edit_course_upload($file,$cnum,$cdom);
+ if ($cfile) {
+ $editbutton=&switch
+ ('','',6,1,'pcstr.png','edit[_1]',
+ 'resource[_2]',"go('".$cfile."');",
+ 'Edit this resource');
+ }
+ }
+ }
+ }
+ }
+ ###
+ ###
+# Prepare the rest of the buttons
+ my $menuitems;
+ if ($const_space) {
+#
+# We are in construction space
+#
+ my ($uname,$thisdisfn) =
+ ($env{'request.filename'}=~m|^/home/([^/]+)/public_html/(.*)|);
+ my $currdir = '/priv/'.$uname.'/'.$thisdisfn;
+ if ($currdir =~ m-/$-) {
+ $is_const_dir = 1;
+ } else {
+ $currdir =~ s|[^/]+$||;
+ my $cleandisfn = &Apache::loncommon::escape_single($thisdisfn);
+ my $esc_currdir = &Apache::loncommon::escape_single($currdir);
+#
+# Probably should be in mydesk.tab
+#
+ $menuitems=(< 0){
+ $menuitems.="anot2.png";
+}else{
+ $menuitems.="anot.png";
+}
+$menuitems.="&anno-[_1]&tations[_1]&annotate()&";
+$menuitems.="Make notes and annotations about this resource&&1\n";
+
+ unless ($env{'request.noversionuri'}=~/\/(bulletinboard|smppg|navmaps|syllabus|aboutme)(\?|$)/) {
+ if ((!$env{'request.enc'}) && ($env{'request.noversionuri'} !~ m{^/adm/wrapper/ext/})) {
+ $menuitems.=(<&');
+ }
+ }
+ return $cfile;
}
# ================================================================== Raw Config
+#SD
+#this is called by
+#lonmenu
+#
sub clear {
my ($row,$col)=@_;
- return qq(swmenu.clearbut($row,$col););
+ $inlineremote[10*$row+$col]='';
+ return '';
}
+# ============================================ 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(..)".
+
sub switch {
- my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc)=@_;
+ my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$cat,$nobreak)=@_;
$act=~s/\$uname/$uname/g;
$act=~s/\$udom/$udom/g;
- return "\n".
- qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
+ $top=&mt($top);
+ $bot=&mt($bot);
+ $desc=&mt($desc);
+ my $idx=10*$row+$col;
+ $category_members{$cat}.=':'.$idx;
+
+# Inline Remote
+ if ($nobreak==2) { return ''; }
+ my $text=$top.' '.$bot;
+ $text=~s/\s*\-\s*//gs;
+
+ my $pic=
+ '';
+ if ($env{'browser.interface'} eq 'faketextual') {
+# Main Menu
+ if ($nobreak==3) {
+ $inlineremote[$idx]="\n".
+ '