--- loncom/interface/lonmenu.pm 2003/11/10 15:15:08 1.99
+++ loncom/interface/lonmenu.pm 2005/01/31 19:20:47 1.141
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines to control the menu
#
-# $Id: lonmenu.pm,v 1.99 2003/11/10 15:15:08 www Exp $
+# $Id: lonmenu.pm,v 1.141 2005/01/31 19:20:47 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,11 +39,11 @@
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::lonenc();
use Apache::lonlocal;
use vars qw(@desklines $readdesk);
@@ -69,13 +69,28 @@ 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($ENV{'request.noversionuri'});
- my $escsymb=&Apache::lonnet::escape($ENV{'request.symb'});
+ 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'}
@@ -89,15 +104,19 @@ ENDNAV
ENDRELOAD
}
}
+ my $form=&serverform();
+ my $utility=&utilityfunctions();
my $output=(<
+
$lt{'main'}
$reloadlink $navmaps
-
+$form
ENDMAINMENU
if ($registration) { $output.=&innerregister($forcereg,$target); }
return $output."
";
@@ -126,11 +145,16 @@ ENDMAINMENU
my $sidebg=&Apache::loncommon::designparm($function.'.sidebg',$domain);
# Do we have a NAV link?
if ($ENV{'request.course.id'}) {
- $navmaps=(<
-$lt{'nav'}
-ENDNAVREM
- if (($ENV{'request.noversionuri'}=~/^\/adm\//) &&
+$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:');
@@ -142,11 +166,14 @@ ENDRELOAD
}
my $reg='';
if ($registration) {
- $reg=&innerregister($forcereg,$target);
+ $reg=&innerregister($forcereg,$target,$titletable);
}
+ my $form=&serverform();
+ my $utility=&utilityfunctions();
return (<
+
@@ -156,15 +183,16 @@ ENDRELOAD
$reloadlink
$navmaps
-
+
$lt{'launch'} |
LON-CAPA |
+$form
-
$reg
@@ -214,7 +242,12 @@ sub registerurl {
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;
@@ -238,7 +271,7 @@ sub innerregister {
$newmail.=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
my $maptitle=&Apache::lonnet::gettitle($mapurl);
my $restitle=&Apache::lonnet::gettitle($resurl);
- if ($maptitle) {
+ if ($maptitle && $maptitle ne 'default.sequence') {
$newmail.=', '.$maptitle;
}
if ($restitle) {
@@ -251,40 +284,42 @@ sub innerregister {
'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?'':'');
- my $tableend=($noremote?'
':'');
+ my $tablestart=($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 $hwkadd='';
- if
- ($ENV{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
- my $crs='/'.$ENV{'request.course.id'};
- if ($ENV{'request.course.sec'}) {
- $crs.='_'.$ENV{'request.course.sec'};
- }
- $crs=~s/\_/\//g;
+ 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-','missions',
+ $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','grades',
+ $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','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
###
@@ -309,9 +344,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);
}
}
##
@@ -323,19 +360,22 @@ 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;
}
}
}
# Finally, turn the button on or off
- if ($cfile) {
+ if ($cfile && !$const_space) {
$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);
@@ -344,24 +384,43 @@ 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
+ }
+ if ($const_space && $is_const_dir) {
+ $inlinebuttons = '';
+ }
$result =(<
+
$timesync
$newmail
$tablestart
$inlinebuttons
$tableend
-$form
-
ENDREGTEXT
# Registered, graphical output
} else {
- my $requri=(split(/\?/,$ENV{'request.noversionuri'}))[0];
- $requri=&Apache::lonnet::unescape($requri);
+ 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();
+ my $clearcstr;
+ if ($ENV{'user.adv'}) { $clearcstr='clearbut(6,1)'; }
$result = (<
+
@@ -566,11 +652,30 @@ sub maincall() {
if (($ENV{'browser.interface'} eq 'textual') ||
($ENV{'environment.remote'} eq 'off')) { return ''; }
return(<
+
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 {
@@ -586,7 +691,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
@@ -603,7 +710,7 @@ var menu=window.open("/res/adm/pages/men
"height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
self.name='loncapaclient';
ENDOPEN
- return '';
+ return '';
}
@@ -631,6 +738,7 @@ sub switch {
$top=&mt($top);
$bot=&mt($bot);
$desc=&mt($desc);
+ $img=&mt($img);
unless (($ENV{'browser.interface'} eq 'textual') ||
($ENV{'environment.remote'} eq 'off')) {
# Remote
@@ -646,31 +754,45 @@ sub switch {
''.$text.'';
} else {
$inlineremote[10*$row+$col]="\n
".
- ''.$desc.'';
+ $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=
- '';
- if ($nobreak==3) {
- $inlineremote[10*$row+$col]="\n".
- ''.$text.
- ' | '.
- ''.$pic.' | ';
- } elsif ($nobreak) {
- $inlineremote[10*$row+$col]="\n".
- ''.
- ''.$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 {
- $inlineremote[10*$row+$col]="\n".
- ''.
- ''.$pic.
- ' | '.$desc.
- ' |
';
+# Inline Menu
+ $inlineremote[10*$row+$col]=
+ ''.$pic.
+ ''.$desc.
+ '';
}
}
return '';
@@ -761,6 +883,11 @@ 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'}) &&
@@ -782,7 +909,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);
}
@@ -793,7 +923,11 @@ sub rawconfig {
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;
}
@@ -804,7 +938,7 @@ sub close {
($ENV{'environment.remote'} eq 'off')) { return ''; }
my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
return(<
+
+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';
}
- my $utility=&utilityfunctions();
$r->print(<
LON-CAPA Main Menu
-
+$script_tag
$bodytag
ENDHEADER
@@ -936,15 +1177,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';