--- loncom/interface/lonmenu.pm 2002/11/18 15:23:32 1.28 +++ loncom/interface/lonmenu.pm 2004/12/06 19:37:46 1.139 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines to control the menu # -# $Id: lonmenu.pm,v 1.28 2002/11/18 15:23:32 www Exp $ +# $Id: lonmenu.pm,v 1.139 2004/12/06 19:37:46 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,24 +25,669 @@ # # http://www.lon-capa.org/ # -# (TeX Conversion Module # -# 05/29/00,05/30 Gerd Kortemeyer) +# 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' # -# 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer -# 02/15/02 Matthew Hall package Apache::lonmenu; use strict; -use Apache::lonnet; -use Apache::File; +use Apache::lonnet(); +use Apache::Constants qw(:common); +use Apache::lonhtmlcommon(); +use Apache::loncommon(); +use Apache::lonenc(); +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; + my $titletable=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(&Apache::lonenc::check_encrypt($ENV{'request.noversionuri'})); + my $escsymb=&Apache::lonnet::escape(&Apache::lonenc::check_encrypt($ENV{'request.symb'})); + if ($ENV{'request.state'} eq 'construct') { + if (($ENV{'request.noversionuri'} eq '') || (!defined($ENV{'request.noversionuri'}))) { + my $returnurl = $ENV{'request.filename'}; + $returnurl =~ s:^/home/([^/]+)/public_html/(.*)$:/priv/$1/$2:; + $escurl = &Apache::lonnet::escape($returnurl); + } + } + if ($ENV{'browser.interface'} eq 'textual') { +# Textual display only + my %lt=&initlittle(); + $pgbg='#FFFFFF'; + $tabbg='#FFFFFF'; + $font='#000000'; + if ($ENV{'request.course.id'}) { + $navmaps=(<$lt{'nav'} +ENDNAV + if (($ENV{'request.noversionuri'}=~/^\/adm\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/wrapper\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) { + my $escreload=&Apache::lonnet::escape('return:'); + $reloadlink=(<$lt{'ret'} +ENDRELOAD + } + } + my $form=&serverform(); + my $utility=&utilityfunctions(); + my $output=(< +// BEGIN LON-CAPA Internal +$utility + +$lt{'main'} +$reloadlink $navmaps
+ +$form +ENDMAINMENU + if ($registration) { $output.=&innerregister($forcereg,$target); } + return $output."
"; + } elsif ($ENV{'environment.remote'} eq 'off') { +# Remote Control is switched off +# figure out colors + my %lt=&initlittle(); + 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.noversionuri'}=~/^(\/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=(< +$lt{'nav'} +ENDNAV + if (($ENV{'request.noversionuri'}=~/^\/adm\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/wrapper\//) && + ($ENV{'request.noversionuri'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) { + my $escreload=&Apache::lonnet::escape('return:'); + $reloadlink=(< +$lt{'ret'} +ENDRELOAD + } + } + my $reg=''; + if ($registration) { + $reg=&innerregister($forcereg,$target,$titletable); + } + my $form=&serverform(); + my $utility=&utilityfunctions(); + return (< +// BEGIN LON-CAPA Internal +$utility + + + + +$reloadlink +$navmaps + + +$form + +
+$lt{'main'} + + +$lt{'launch'} + +LON-CAPA
+
+ +$reg +ENDINLINEMENU + } else { + return ''; + } +} + +# ====================================== This gets called in the header section + +sub registerurl { + my $forcereg=shift; + my $target = shift; + my $result = ''; + 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(); + } + if ($target eq 'edit') { + $result .="\n"; + } + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off') || + ((($ENV{'request.publicaccess'}) || + (!&Apache::lonnet::is_on_map( + &Apache::lonnet::unescape($ENV{'request.noversionuri'})))) && + (!$forcereg))) { + return $result. + ''.$force_title; + } +# Graphical display after login only + if ($Apache::lonxml::registered && !$forcereg) { return ''; } + if ($target ne 'edit') { + $result.=&innerregister($forcereg,$target); + } + return $result.$force_title; +} + +# =========== This gets called in order to register a URL, both with the Remote +# =========== and in the body of the document + +sub innerregister { + my $forcereg=shift; + my $target = shift; + my $titletable = shift; + my $result = ''; + my ($uname,$thisdisfn); + my $const_space = ($ENV{'request.state'} eq 'construct'); + my $is_const_dir = 0; + + if ($ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } + + $Apache::lonxml::registered=1; + + my $textinter=($ENV{'browser.interface'} eq 'textual'); + my $noremote=($ENV{'environment.remote'} eq 'off'); + + my $textual=($textinter || $noremote); + + @inlineremote=(); + undef @inlineremote; + + my $reopen=&Apache::lonmenu::reopenmenu(); + + my $newmail=''; + if ($noremote) { + $newmail='
'; + } + if (($textual) && ($ENV{'request.symb'}) && ($ENV{'request.course.id'})) { + 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); + if ($maptitle && $maptitle ne 'default.sequence') { + $newmail.=', '.$maptitle; + } + if ($restitle) { + $newmail.=': '.$restitle; + } + $newmail.='   '; + } + if (&Apache::lonmsg::newmail()) { + $newmail=($textual? + 'You have new messages
': + 'swmenu.setstatus("you have","messages");'); + } + if ($ENV{'request.state'} eq 'construct') { + $newmail = $titletable; + } + if ($noremote) { + $newmail.='
'; + } + my $timesync=($textual?'':'swmenu.syncclock(1000*'.time.');'); + my $tablestart=($noremote?'':'').($textinter?'
'.&mt('Skip to Content').'
':''); + my $tableend=($noremote?'
':'').($textinter?'':''); +# ============================================================================= +# ============================ This is for URLs that actually can be registered + 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',$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',$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',$crs)) { + $hwkadd.=&switch('','',7,3,'pparm.gif','problem[_2]','parms[_2]', + "gocmd('/adm/parmset','set')", + 'Modify deadlines, etc, for this resource'); + } +# -- End Homework + ### + ### Determine whether or not to display the 'cstr' button for this + ### resource + ### + my $editbutton = ''; + if ($ENV{'user.author'}) { + if ($ENV{'request.role'}=~/^(ca|au)/) { + # 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 resource construction space"; + # Set defaults for co-authors + if ($ENV{'request.role'} =~ /^ca/) { + ($cadom,$caname)=($ENV{'request.role'}=~/(\w+)\/(\w+)$/); + ($top,$bottom) = ('co con-','struct'); + $action = "go('/priv/".$caname."');"; + $desc = "Enter construction space as 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); + } + } + ## + ## Determine if user can edit url. + ## + my $cfile=''; + my $cfuname=''; + my $cfudom=''; + if ($ENV{'request.filename'}) { + my $file=&Apache::lonnet::declutter($ENV{'request.filename'}); + $file=~s/^(\w+)\/(\w+)/\/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) { + $editbutton=&switch + ('','',6,1,'cstr.gif','edit[_1]','resource[_2]', + "go('".$cfile."');","Edit this resource"); + } elsif ($editbutton eq '') { + $editbutton=&clear(6,1); + } + } + ### + ### +# Prepare the rest of the buttons + my $menuitems; + if ($const_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#[^/]+$##; + $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 + } + if ($const_space && $is_const_dir) { + $inlinebuttons = ''; + } + $result =(< +// BEGIN LON-CAPA Internal + +$timesync +$newmail +$tablestart +$inlinebuttons +$tableend + + +ENDREGTEXT +# Registered, graphical output + } else { + my $requri=&Apache::lonnet::clutter(&Apache::lonnet::fixversion((split(/\?/,$ENV{'request.noversionuri'}))[0])); + $requri=&Apache::lonenc::check_encrypt(&Apache::lonnet::unescape($requri)); + my $cursymb=&Apache::lonenc::check_encrypt($ENV{'request.symb'}); + my $navstatus=&get_nav_status(); + $result = (< +// BEGIN LON-CAPA Internal +var swmenu=null; + + function LONCAPAreg() { + swmenu=$reopen; + swmenu.clearTimeout(swmenu.menucltim); + $timesync + $newmail + $buttons + swmenu.currentURL="$requri"; + swmenu.reloadURL=swmenu.currentURL+window.location.search; + swmenu.currentSymb="$cursymb"; + swmenu.reloadSymb="$cursymb"; + swmenu.currentStale=0; + $navstatus + $hwkadd + $editbutton + } + + function LONCAPAstale() { + swmenu=$reopen + swmenu.currentStale=1; + if (swmenu.reloadURL!='' && swmenu.reloadURL!= null) { + swmenu.switchbutton + (3,1,'reload.gif','return','location','go(reloadURL)','Return to the last known location in the course sequence'); + } + swmenu.clearbut(7,1); + swmenu.clearbut(7,2); + 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,3);clearbut(6,3);clearbut(6,1)', + 2000); + } + +// END LON-CAPA Internal + +ENDREGTHIS + } +# ============================================================================= + } else { +# ========================================== This can or will not be registered + if ($textual) { +# Not registered, textual + $result= (< +// BEGIN LON-CAPA Internal +var swmenu=null; + + function LONCAPAreg() { + swmenu=$reopen + $timesync + swmenu.currentStale=1; + swmenu.clearbut(2,1); + swmenu.clearbut(2,3); + swmenu.clearbut(8,1); + swmenu.clearbut(8,2); + swmenu.clearbut(8,3); + if (swmenu.currentURL) { + swmenu.switchbutton + (3,1,'reload.gif','return','location','go(currentURL)'); + } else { + swmenu.clearbut(3,1); + } + } + + function LONCAPAstale() { + } + +// END LON-CAPA Internal + +ENDDONOTREGTHIS + } +# ============================================================================= + } + return $result; +} + +sub loadevents() { + if ($ENV{'request.state'} eq 'construct' || + $ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } + return 'LONCAPAreg();'; +} + +sub unloadevents() { + if ($ENV{'request.state'} eq 'construct' || + $ENV{'request.noversionuri'} eq '/res/adm/pages/menu.html') { return ''; } + return 'LONCAPAstale();'; +} + +# ============================================================= Start up remote + +sub startupremote { + my ($lowerurl)=@_; + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { + return (''); + } +# +# The Remote actually gets launched! +# + my $configmenu=&rawconfig(); + my $esclowerurl=&Apache::lonnet::escape($lowerurl); + my $message=&mt('"Waiting for Remote Control window 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 { + if (window.status=='/') { + window.status='-'; + } else { + if (window.status=='-') { + window.status='\\\\'; + } else { + if (window.status=='\\\\') { window.status='|'; } + } + } + } +} + +// ---------------------------------------------------------- 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 { + window.location='/adm/remote?action=collapse&url=$esclowerurl'; + } + } else { + wheelswitch(); + setTimeout('wait();',200); + } +} + +function main() { + canceltim=setTimeout('tim=1;',30000); + window.status='-'; + var date=new Date(); + timestart=date.getTime(); + wait(); +} + + +ENDREMOTESTARTUP +} + +sub setflags() { + return(< + menuloaded=0; + tim=0; + +ENDSETFLAGS +} + +sub maincall() { + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { return ''; } + return(< + main(); + +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 Menu mode', + "/adm/remote?action=collapse?url=$esclowerurl"); + return(< +
+ +
+

+

$link

+ENDREMOTEFORM +} +# ================================================================= Reopen menu + +sub reopenmenu { + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { return ''; } + my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; + my $nothing = &Apache::lonhtmlcommon::javascript_nothing(); + return('window.open('.$nothing.',"'.$menuname.'","",false);'); +} + # =============================================================== Open the menu sub open { my $returnval=''; + if (($ENV{'browser.interface'} eq 'textual') || + ($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 $returnval.=(<'.$returnval.''; + return ''; } -# ============================================================ 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 -} # ================================================================== Raw Config sub clear { my ($row,$col)=@_; - return qq(swmenu.clearbut($row,$col);); + unless (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { + return "\n".qq(window.status+='.';swmenu.clearbut($row,$col);); + } else { + $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,$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); + $img=&mt($img); + unless (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { +# Remote + return "\n". + qq(window.status+='.';swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc");); + } elsif ($ENV{'browser.interface'} eq 'textual') { +# Accessibility + if ($nobreak==2) { return ''; } + my $text=$top.' '.$bot; + $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/\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 ''; } sub secondlevel { @@ -104,16 +806,31 @@ sub secondlevel { } sub openmenu { - if ($ENV{'browser.type'} eq 'explorer') { - return "window.open('javascript:void(0);','LONCAPAmenu');"; - } else { - return "window.open('','LONCAPAmenu');"; - } + my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { return ''; } + my $nothing = &Apache::lonhtmlcommon::javascript_nothing(); + return "window.open(".$nothing.",'".$menuname."');"; +} + +sub inlinemenu { + @inlineremote=(); + undef @inlineremote; + &rawconfig(1); + return join('',map { (defined($_)?$_:'') } @inlineremote); } sub rawconfig { - my $r = shift; - my $output="var swmenu=".&openmenu(); + my $textualoverride=shift; + my $output=''; + unless (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { + $output.= + "window.status='Opening Remote Control';var swmenu=".&openmenu(). +"\nwindow.status='Configuring Remote Control ';"; + } else { + unless ($textualoverride) { return ''; } + } my $uname=$ENV{'user.name'}; my $udom=$ENV{'user.domain'}; my $adv=$ENV{'user.adv'}; @@ -151,7 +868,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); } @@ -159,41 +876,71 @@ sub rawconfig { if ($ENV{'request.course.fn'}) { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } + } elsif ($pro =~ /^courseenv_(.*)$/) { + my $key = $1; + if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$key}) { + $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/)) { + if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) || + (($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) { # Check that we are on the correct machine - my ($cadom,$caname)= + my $cadom=$requested_domain; + my $caname=$ENV{'user.name'}; + if ($prt eq 'rca') { + ($cadom,$caname)= ($ENV{'request.role'}=~/(\w+)\/(\w+)$/); + } + $act =~ s/\$caname/$caname/g; my $home = &Apache::lonnet::homeserver($caname,$cadom); - if ($home eq $r->dir_config('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); } - } elsif ($prt eq 'any') { - my $home = &Apache::lonnet::homeserver - ($ENV{'user.name'},$ENV{'user.domain'}); - if ($home eq $r->dir_config('lonHostID')) { - $output.=switch - ($ENV{'user.name'},$ENV{'user.domain'}, - $row,$col,$img,$top,$bot,$act,$desc); - } } } } } - $output.="swmenu.syncclock(1000*".time.");"; + unless (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { + $output.="\nwindow.status='Synchronizing Time';swmenu.syncclock(1000*".time.");\nwindow.status='Remote Control Configured.';"; + if (&Apache::lonmsg::newmail()) { + $output.='swmenu.setstatus("you have","messages");'; + } + } + return $output; } # ======================================================================= Close sub close { + if (($ENV{'browser.interface'} eq 'textual') || + ($ENV{'environment.remote'} eq 'off')) { return ''; } + my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; return(< -menu=window.open("/adm/rat/empty.html","LONCAPAmenu", + ENDCLOSE } @@ -204,25 +951,242 @@ sub footer { } +sub nav_control_js { + my $nav=($ENV{'environment.remotenavmap'} eq 'on'); + return (< + + + + + +ENDSERVERFORM +} + +sub constspaceform { + return(< + + +
+ + +
+
+ + + +
+ +ENDCONSTSPACEFORM +} + + +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; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK if $r->header_only; + + my $form; + if ($ENV{'environment.remote'} ne 'off' && + $ENV{'browser.interface'} ne 'textual') { + $form=&serverform(); + } + my $bodytag=&Apache::loncommon::bodytag('Main Menu'); + 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.noversionuri'}=~/^(\/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 $script_tag; + if ($ENV{'environment.remote'} eq 'on') { + my $utility=&utilityfunctions('/adm/menu'); + $script_tag=(< +$utility + +ENDSCRIPT + } +# ---- Print the screen, pretend to be in text mode to generate text-based menu + unless ($ENV{'browser.interface'} eq 'textual') { + $ENV{'browser.interface'}='faketextual'; + $ENV{'environment.remote'}='off'; + } + $r->print(< +LON-CAPA Main Menu +$script_tag + +$bodytag +ENDHEADER + $r->print(''.&inlinemenu().'
'.$form); + $r->print(''); + return OK; +} + # ================================================================ Main Program 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'; } } + 1; __END__ 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.