--- loncom/interface/lonmenu.pm 2003/05/23 23:58:53 1.70 +++ loncom/interface/lonmenu.pm 2004/10/28 16:25:21 1.118 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines to control the menu # -# $Id: lonmenu.pm,v 1.70 2003/05/23 23:58:53 www Exp $ +# $Id: lonmenu.pm,v 1.118 2004/10/28 16:25:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,47 +39,70 @@ package Apache::lonmenu; use strict; -use Apache::lonnet; +use Apache::lonnet(); use Apache::Constants qw(:common); use Apache::lonhtmlcommon(); -use Apache::loncommon; -use Apache::File; +use Apache::loncommon(); +use Apache::lonnavmaps(); +use Apache::lonlocal; + use vars qw(@desklines $readdesk); + + my @inlineremote; my $font; my $tabbg; my $pgbg; +# ================================================================ Little texts + +sub initlittle { + return &Apache::lonlocal::texthash('ret' => 'Return to Last Location', + 'nav' => 'Navigate Contents', + 'main' => 'Main Menu', + 'launch' => 'Launch Remote Control'); +} + # ============================= This gets called at the top of the body section sub menubuttons { my $forcereg=shift; my $target =shift; my $registration=shift; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['inhibitmenu']); + if ($ENV{'form.inhibitmenu'} eq 'yes') { return ''; } + my $navmaps=''; my $reloadlink=''; - my $escurl=&Apache::lonnet::escape($ENV{'REQUEST_URI'}); + my $escurl=&Apache::lonnet::escape($ENV{'request.noversionuri'}); my $escsymb=&Apache::lonnet::escape($ENV{'request.symb'}); if ($ENV{'browser.interface'} eq 'textual') { # Textual display only + my %lt=&initlittle(); + $pgbg='#FFFFFF'; + $tabbg='#FFFFFF'; + $font='#000000'; if ($ENV{'request.course.id'}) { $navmaps=(<Navigate Contents +$lt{'nav'} ENDNAV - if (($ENV{'REQUEST_URI'}=~/^\/adm\//) && - ($ENV{'REQUEST_URI'}!~/^\/adm\/wrapper\//) && - ($ENV{'REQUEST_URI'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) { + if (($ENV{'request.noversionuri'}=~/^\/adm\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/wrapper\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) { my $escreload=&Apache::lonnet::escape('return:'); $reloadlink=(<Return to Last Location +$lt{'ret'} ENDRELOAD } } + my $utility=&utilityfunctions(); my $output=(< // BEGIN LON-CAPA Internal +$utility -Main Menu +$lt{'main'} $reloadlink $navmaps
- +
$reloadlink $navmaps +$lt{'launch'}
-Main Menu +$lt{'main'} -Launch Remote Control LON-CAPA
+ @@ -164,7 +191,7 @@ sub registerurl { my $forcereg=shift; my $target = shift; my $result = ''; - if ($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html') { return ''; } + if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } my $force_title=''; if ($ENV{'request.state'} eq 'construct') { $force_title=&Apache::lonxml::display_title(); @@ -178,33 +205,17 @@ sub registerurl { if (($ENV{'browser.interface'} eq 'textual') || ($ENV{'environment.remote'} eq 'off') || ((($ENV{'request.publicaccess'}) || - (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) && + (!&Apache::lonnet::is_on_map( + &Apache::lonnet::unescape($ENV{'request.noversionuri'})))) && (!$forcereg))) { - my $loadfunction=''; - my $unloadfunction=''; - unless (($ENV{'browser.interface'} eq 'textual') || - ($ENV{'environment.remote'} eq 'off') || - ($ENV{'request.publicaccess'})) { - my $reopen=&Apache::lonmenu::reopenmenu(); - $loadfunction='swmenu='.$reopen.'swmenu.noclient=0;'; - $unloadfunction='swmenu='.$reopen.'swmenu.noclient=1;'; - } - return $result.(< -function LONCAPAreg() { - $loadfunction -} - -function LONCAPAstale() { - $unloadfunction -} - -$force_title -ENDFUNCTIONS + return $result. + ''.$force_title; } # Graphical display after login only if ($Apache::lonxml::registered && !$forcereg) { return ''; } - $result.=&innerregister($forcereg,$target); + if ($target ne 'edit') { + $result.=&innerregister($forcereg,$target); + } return $result.$force_title; } @@ -215,7 +226,7 @@ sub innerregister { my $forcereg=shift; my $target = shift; my $result = ''; - if ($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html') { return ''; } + if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } $Apache::lonxml::registered=1; @@ -231,10 +242,10 @@ sub innerregister { my $newmail=''; if ($noremote) { - $newmail='
'; + $newmail='
'; } if (($textual) && ($ENV{'request.symb'}) && ($ENV{'request.course.id'})) { - my ($mapurl,$rid,$resurl)=split(/\_\_\_/,$ENV{'request.symb'}); + my ($mapurl,$rid,$resurl)=&Apache::lonnet::decode_symb($ENV{'request.symb'}); $newmail.=$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; my $maptitle=&Apache::lonnet::gettitle($mapurl); my $restitle=&Apache::lonnet::gettitle($resurl); @@ -248,37 +259,42 @@ sub innerregister { } if (&Apache::lonmsg::newmail()) { $newmail=($textual? - 'You have new messages
': + 'You have new messages
': 'swmenu.setstatus("you have","messages");'); } if ($noremote) { - $newmail.='
'; + $newmail.='
'; } my $timesync=($textual?'':'swmenu.syncclock(1000*'.time.');'); - my $tablestart=($noremote?'':''); - my $tableend=($noremote?'
':''); + my $tablestart=($noremote?'':'').($textinter?'
'.&mt('Skip to Content').'
':''); + my $tableend=($noremote?'
':'').($textinter?'':''); # ============================================================================= # ============================ This is for URLs that actually can be registered - if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) { + if (($ENV{'request.noversionuri'}!~/^\/(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.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) { - if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { - $hwkadd.=&switch('','',7,1,'subm.gif','view sub','missions', + if ($ENV{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) { + if (&Apache::lonnet::allowed('vgr',$crs)) { + $hwkadd.=&switch('','',7,1,'subm.gif','view sub-[_1]','missions[_1]', "gocmd('/adm/grades','submission')", 'View user submissions for this assessment resource'); } - if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) { - $hwkadd.=&switch('','',7,2,'pgrd.gif','problem','grades', + if (&Apache::lonnet::allowed('mgr',$crs)) { + $hwkadd.=&switch('','',7,2,'pgrd.gif','problem[_1]','grades[_3]', "gocmd('/adm/grades','gradingmenu')", 'Modify user grades for this assessment resource'); } - if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { - $hwkadd.=&switch('','',7,3,'pparm.gif','problem','parms', - "gocmd('/adm/parmset','set')", - 'Modify deadlines, etc, for this assessment resource'); - } + } + if (&Apache::lonnet::allowed('opa',$crs)) { + $hwkadd.=&switch('','',7,3,'pparm.gif','problem[_2]','parms[_2]', + "gocmd('/adm/parmset','set')", + 'Modify deadlines, etc, for this resource'); } # -- End Homework ### @@ -303,9 +319,11 @@ sub innerregister { } # Check that we are on the correct machine my $home = &Apache::lonnet::homeserver($caname,$cadom); - if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) { - $editbutton=&switch - ('','',6,1,$top,,$bottom,$action,$desc); + 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); } } ## @@ -317,11 +335,14 @@ sub innerregister { if ($ENV{'request.filename'}) { my $file=&Apache::lonnet::declutter($ENV{'request.filename'}); $file=~s/^(\w+)\/(\w+)/\/priv\/$2/; - # Chech that the user has permission to edit this resource + # Check that the user has permission to edit this resource ($cfuname,$cfudom)=&Apache::loncacc::constructaccess($file,$1); if (defined($cfudom)) { - if (&Apache::lonnet::homeserver($cfuname,$cfudom) - eq $Apache::lonnet::perlvar{'lonHostID'}) { + 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; } } @@ -329,7 +350,7 @@ sub innerregister { # Finally, turn the button on or off if ($cfile) { $editbutton=&switch - ('','',6,1,'cstr.gif','edit','resource', + ('','',6,1,'cstr.gif','edit[_1]','resource[_2]', "go('".$cfile."');","Edit this resource"); } elsif ($editbutton eq '') { $editbutton=&clear(6,1); @@ -340,16 +361,22 @@ sub innerregister { # Prepare the rest of the buttons my $menuitems=(<$inlineremote[21] $inlineremote[23] +$inlineremote[61]$inlineremote[62]$inlineremote[63] +$inlineremote[71]$inlineremote[72]$inlineremote[73] +$inlineremote[81]$inlineremote[82]$inlineremote[83] +$inlineremote[91]$inlineremote[92]$inlineremote[93] +ENDINLINE + } $result =(< // BEGIN LON-CAPA Internal -$utility $timesync $newmail @@ -383,6 +420,9 @@ $form ENDREGTEXT # Registered, graphical output } else { + my $requri=(split(/\?/,$ENV{'request.noversionuri'}))[0]; + $requri=&Apache::lonnet::unescape($requri); + my $navstatus=&get_nav_status(); $result = (< @@ -391,16 +431,16 @@ var swmenu=null; function LONCAPAreg() { swmenu=$reopen; - swmenu.noclient=0; swmenu.clearTimeout(swmenu.menucltim); $timesync $newmail $buttons - swmenu.currentURL=window.location.pathname; - swmenu.reloadURL=window.location.pathname+window.location.search; + swmenu.currentURL="$requri"; + swmenu.reloadURL=swmenu.currentURL+window.location.search; swmenu.currentSymb="$ENV{'request.symb'}"; swmenu.reloadSymb="$ENV{'request.symb'}"; swmenu.currentStale=0; + $navstatus $hwkadd $editbutton } @@ -417,9 +457,8 @@ var swmenu=null; swmenu.clearbut(7,3); swmenu.menucltim=swmenu.setTimeout( 'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+ - 'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3);clearbut(6,1)', + 'clearbut(9,1);clearbut(9,3);clearbut(6,3);clearbut(6,1)', 2000); - swmenu.noclient=1; } // END LON-CAPA Internal @@ -443,7 +482,6 @@ var swmenu=null; function LONCAPAreg() { swmenu=$reopen - swmenu.noclient=0; $timesync swmenu.currentStale=1; swmenu.clearbut(2,1); @@ -460,8 +498,6 @@ var swmenu=null; } function LONCAPAstale() { - swmenu=$reopen - swmenu.noclient=1; } // END LON-CAPA Internal @@ -474,12 +510,12 @@ ENDDONOTREGTHIS } sub loadevents() { - if ($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html') { return ''; } + if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } return 'LONCAPAreg();'; } sub unloadevents() { - if ($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html') { return ''; } + if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } return 'LONCAPAstale();'; } @@ -496,11 +532,18 @@ sub startupremote { # my $configmenu=&rawconfig(); my $esclowerurl=&Apache::lonnet::escape($lowerurl); - + my $message=&mt('"Waiting for remote to load "+[_1]','waited'); return(< - +var timestart; function wheelswitch() { + if (typeof(document.wheel) != 'undefined') { + if (typeof(document.wheel.spin) != 'undefined') { + var date=new Date(); + var waited=Math.round(30-((date.getTime()-timestart)/1000)); + document.wheel.spin.value=$message; + } + } if (window.status=='|') { window.status='/'; } else { @@ -537,6 +580,8 @@ function wait() { function main() { canceltim=setTimeout('tim=1;',30000); window.status='-'; + var date=new Date(); + timestart=date.getTime(); wait(); } @@ -562,6 +607,25 @@ sub maincall() { ENDMAINCALL } + +sub load_remote_msg { + my ($lowerurl)=@_; + + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { return ''; } + + my $esclowerurl=&Apache::lonnet::escape($lowerurl); + my $link=&mt('Continue on in inline remote mode', + "/adm/remote?action=collapse?url=$esclowerurl"); + return(< +
+ +
+

+

$link

+ENDREMOTEFORM +} # ================================================================= Reopen menu sub reopenmenu { @@ -577,7 +641,9 @@ sub reopenmenu { sub open { my $returnval=''; if (($ENV{'browser.interface'} eq 'textual') || - ($ENV{'environment.remote'} eq 'off')) { return ''; } + ($ENV{'environment.remote'} eq 'off')) { + return ''; + } my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; unless (shift eq 'unix') { # resizing does not work on linux because of virtual desktop sizes @@ -592,6 +658,7 @@ ENDRESIZE window.status='Opening LON-CAPA Remote Control'; var menu=window.open("/res/adm/pages/menu.html","$menuname", "height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5"); +self.name='loncapaclient'; ENDOPEN return ''; } @@ -618,6 +685,10 @@ sub switch { my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$nobreak)=@_; $act=~s/\$uname/$uname/g; $act=~s/\$udom/$udom/g; + $top=&mt($top); + $bot=&mt($bot); + $desc=&mt($desc); + $img=&mt($img); unless (($ENV{'browser.interface'} eq 'textual') || ($ENV{'environment.remote'} eq 'off')) { # Remote @@ -627,22 +698,52 @@ sub switch { # Accessibility if ($nobreak==2) { return ''; } my $text=$top.' '.$bot; - $text=~s/\- //; - $inlineremote[10*$row+$col]="\n".($nobreak?' ':'
'). - ''.$text.' '. - ($nobreak?'':$desc); + $text=~s/\s*\-\s*//gs; + if ($nobreak) { + $inlineremote[10*$row+$col]= + ''.$text.''; + } else { + $inlineremote[10*$row+$col]="\n
". + $desc.' '.$text.''; + } } else { # Inline Remote if ($nobreak==2) { return ''; } my $text=$top.' '.$bot; - $text=~s/\- //; - $inlineremote[10*$row+$col]="\n". - ($nobreak==3?''.$text.''. - ($nobreak?'':''.$desc.'').($nobreak!=1?'':''); + $text=~s/\s*\-\s*//gs; + + my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } + my $pic= + ''.$text.''; + if (($ENV{'browser.interface'} eq 'textual') || ($ENV{'browser.interface'} eq 'faketextual')) { +# Accessibility + if ($nobreak==3) { + $inlineremote[10*$row+$col]="\n". + ''.$text. + ''. + ''.$pic.''; + } elsif ($nobreak) { + $inlineremote[10*$row+$col]="\n". + ''. + ''.$pic. + ''.$text.''; + } else { + $inlineremote[10*$row+$col]="\n". + ''. + ''.$pic. + ''.$desc. + ''; + } + } else { +# Inline Menu + $inlineremote[10*$row+$col]= + ''.$pic. + ''.$desc. + ''; + } } return ''; } @@ -724,7 +825,7 @@ sub rawconfig { $output.=&secondlevel( $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc); } - } elsif (($pro=~/p(\w+)/) && ($prt)) { + } elsif (($pro=~/^p(\w+)/) && ($prt)) { if (&Apache::lonnet::allowed($1,$prt)) { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } @@ -732,6 +833,14 @@ sub rawconfig { if ($ENV{'request.course.fn'}) { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } + } elsif ($pro =~ /^course_(.*)$/) { + # Check for permissions inside of a course + if (($ENV{'request.course.id'}) && + (&Apache::lonnet::allowed($1,$ENV{'request.course.id'}. + ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:'')) + )) { + $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); + } } elsif ($pro eq 'author') { if ($author) { if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) || @@ -745,7 +854,10 @@ sub rawconfig { } $act =~ s/\$caname/$caname/g; my $home = &Apache::lonnet::homeserver($caname,$cadom); - if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) { + my $allowed=0; + my @ids=&Apache::lonnet::current_machine_ids(); + foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } + if ($allowed) { $output.=switch($caname,$cadom, $row,$col,$img,$top,$bot,$act,$desc); } @@ -790,14 +902,17 @@ sub footer { sub utilityfunctions { unless (($ENV{'browser.interface'} eq 'textual') || ($ENV{'environment.remote'} eq 'off')) { return ''; } - my $currenturl=$ENV{'REQUEST_URI'}; + my $currenturl=$ENV{'request.noversionuri'}; my $currentsymb=$ENV{'request.symb'}; + my $nav_control=&Apache::lonnavmaps::nav_control_js(); return (< ENDSERVERFORM } + +sub get_nav_status { + my $navstatus="swmenu.w_loncapanav_flag="; + if ($ENV{'environment.remotenavmap'} eq 'on') { + $navstatus.="1"; + } else { + $navstatus.="-1"; + } + return $navstatus; +} + # ================================================ Handler when called directly sub handler { my $r = shift; - $r->content_type('text/html'); + &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; @@ -868,7 +994,7 @@ sub handler { $function='admin'; } if (($ENV{'request.role'}=~/^(au|ca)/) || - ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + ($ENV{'request.noversionuri'}=~/^(\/priv|\~)/)) { $function='author'; } my $domain=&Apache::loncommon::determinedomain(); @@ -876,16 +1002,13 @@ sub handler { $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain); $font=&Apache::loncommon::designparm($function.'.font',$domain); # ---- Print the screen, pretent to be in text mode to generate text-based menu - unless ($ENV{'brower.interface'} eq 'textual') { + unless ($ENV{'browser.interface'} eq 'textual') { + $ENV{'browser.interface'}='faketextual'; $ENV{'environment.remote'}='off'; } - my $utility=&utilityfunctions(); $r->print(< LON-CAPA Main Menu - $bodytag ENDHEADER @@ -899,15 +1022,17 @@ ENDHEADER BEGIN { if (! defined($readdesk)) { { - my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/mydesk.tab'); - while (my $configline=<$config>) { - $configline=(split(/\#/,$configline))[0]; - $configline=~s/^\s+//; - chomp($configline); - if ($configline) { - $desklines[$#desklines+1]=$configline; - } + my $tabfile = $Apache::lonnet::perlvar{'lonTabDir'}.'/mydesk.tab'; + if ( CORE::open( my $config,"<$tabfile") ) { + while (my $configline=<$config>) { + $configline=(split(/\#/,$configline))[0]; + $configline=~s/^\s+//; + chomp($configline); + if ($configline) { + $desklines[$#desklines+1]=$configline; + } + } + CORE::close($config); } } $readdesk='done'; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.