# The LearningOnline Network with CAPA # Routines to control the menu # # $Id: lonmenu.pm,v 1.37 2003/02/14 15:14:37 www Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # (TeX Conversion Module # # 05/29/00,05/30 Gerd Kortemeyer) # # 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::Constants qw(:common); use Apache::loncommon; use Apache::File; use vars qw(@desklines $readdesk); # ============================================================= Start up remote sub startupremote { my ($lowerurl)=@_; if ($ENV{'browser.interface'} eq 'textual') { return (''); } my $configmenu=&rawconfig(); return(< function wheelswitch() { 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 { alert("Remote Control timed out. It is possible that it was blocked by pop-up window filters."); } } else { wheelswitch(); setTimeout('wait();',200); } } function main() { canceltim=setTimeout('tim=1;',60000); window.status='-'; wait(); } ENDREMOTESTARTUP } sub setflags() { return(< menuloaded=0; tim=0; ENDSETFLAGS } sub maincall() { if ($ENV{'browser.interface'} eq 'textual') { return ''; } return(< main(); ENDMAINCALL } # ================================================================= Reopen menu sub reopenmenu { my $nothing=''; if ($ENV{'browser.interface'} eq 'textual') { return ''; } 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=''; if ($ENV{'browser.interface'} eq 'textual') { 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.''; } # ================================================================== Raw Config sub clear { my ($row,$col)=@_; unless ($ENV{'browser.interface'} eq 'textual') { return "\n".qq(window.status+='.';swmenu.clearbut($row,$col);); } else { return ''; } } # 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)=@_; $act=~s/\$uname/$uname/g; $act=~s/\$udom/$udom/g; unless ($ENV{'browser.interface'} eq 'textual') { return "\n". qq(window.status+='.';swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc");); } else { my $text=$top.' '.$bot; $text=~s/\- //; return '
'.$text.' '.$desc; } } sub secondlevel { my $output=''; my ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc)=@_; if ($prt eq 'any') { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } elsif ($prt=~/^r(\w+)/) { if ($rol eq $1) { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } } return $output; } sub openmenu { my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; if ($ENV{'browser.interface'} eq 'textual') { return ''; } if ($ENV{'browser.type'} eq 'explorer') { return "window.open('javascript:void(0);','".$menuname."');"; } else { return "window.open('','".$menuname."');"; } } sub rawconfig { my $textualoverride=shift; my $output=''; unless ($ENV{'browser.interface'} eq 'textual') { $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'}; my $author=$ENV{'user.author'}; my $crs=''; if ($ENV{'request.course.id'}) { $crs='/'.$ENV{'request.course.id'}; if ($ENV{'request.course.sec'}) { $crs.='_'.$ENV{'request.course.sec'}; } $crs=~s/\_/\//g; } my $pub=($ENV{'request.state'} eq 'published'); my $con=($ENV{'request.state'} eq 'construct'); my $rol=$ENV{'request.role'}; my $requested_domain = $ENV{'request.role.domain'}; foreach (@desklines) { my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc)=split(/\:/,$_); $prt=~s/\$uname/$uname/g; $prt=~s/\$udom/$udom/g; $prt=~s/\$crs/$crs/g; $prt=~s/\$requested_domain/$requested_domain/g; if ($pro eq 'clear') { $output.=&clear($row,$col); } elsif ($pro eq 'any') { $output.=&secondlevel( $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc); } elsif ($pro eq 'smp') { unless ($adv) { $output.=&secondlevel( $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc); } } elsif ($pro eq 'adv') { if ($adv) { $output.=&secondlevel( $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc); } } elsif (($pro=~/p(\w+)/) && ($prt)) { if (&Apache::lonnet::allowed($1,$prt)) { $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc); } } elsif ($pro eq 'course') { if ($ENV{'request.course.fn'}) { $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/)) || (($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) { # Check that we are on the correct machine 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 $Apache::lonnet::perlvar{'lonHostID'}) { $output.=switch($caname,$cadom, $row,$col,$img,$top,$bot,$act,$desc); } } } } } unless ($ENV{'browser.interface'} eq 'textual') { $output.="\nwindow.status='Synchronizing Time';swmenu.syncclock(1000*".time.");\nwindow.status='Remote Control Configured.';"; } return $output; } # ======================================================================= Close sub close { if ($ENV{'browser.interface'} eq 'textual') { return ''; } my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'}; return(< window.status='Accessing Remote Control'; menu=window.open("/adm/rat/empty.html","$menuname", "height=350,width=150,scrollbars=no,menubar=no"); window.status='Disabling Remote Control'; menu.active=0; menu.autologout=0; window.status='Closing Remote Control'; menu.close(); window.status='Done.'; ENDCLOSE } # ====================================================================== Footer sub footer { } # ================================================ Handler when called directly sub handler { my $r = shift; $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; my $bodytag=&Apache::loncommon::bodytag('Main Menu'); # ------------------------------------------------------------ Print the screen $r->print(< LON-CAPA Main Menu $bodytag ENDHEADER $r->print(&rawconfig(1)); $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; } } } $readdesk='done'; } } 1; __END__