Return to lonmenu.pm CVS log

Up to [LON-CAPA] / loncom / interface

Steps towards server side menu for handicapper access.
Get activated when logging in with "Accessibility Option"
If not using that entrance, Remote should remain exactly the same pain as it
always was.

# The LearningOnline Network with CAPA
# Routines to control the menu
#
# $Id: lonmenu.pm,v 1.34 2003/02/13 18:11:26 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 ('<meta HTTP-EQUIV="Refresh" CONTENT="0.5; url='.$lowerurl.'" />');
    }
    my $configmenu=&rawconfig();
    return(<<ENDREMOTESTARTUP);
<script>

// ---------------------------------------------------------- The wait function
var canceltim;
function wait() {
   if ((menuloaded==1) || (tim==1)) {
      if (tim==0) {
         clearTimeout(canceltim);
         $configmenu
         window.location='$lowerurl';  
      } else {
         alert("Remote Control Timed Out.");
      }
   } else {
      setTimeout('wait();',100);
   }
}

function main() {
   canceltim=setTimeout('tim=1;',80000);
   wait();
}

</script>
ENDREMOTESTARTUP
}

sub setflags() {
    return(<<ENDSETFLAGS);
<script>
    menuloaded=0;
    tim=0;
</script>
ENDSETFLAGS
}

sub maincall() {
    if ($ENV{'browser.interface'} eq 'textual') { return ''; }
    return(<<ENDMAINCALL);
<script>
    main();
</script>
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.=(<<ENDRESIZE);
if (window.screen) {
    self.resizeTo(screen.availWidth-215,screen.availHeight-55);
    self.moveTo(190,15);
}
ENDRESIZE
    }
    $returnval.=(<<ENDOPEN);
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");
ENDOPEN
    return '<script>'.$returnval.'</script>';
}

# ============================================================ Switch Menu Item

sub switchmenu {
    my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
    if ($ENV{'browser.interface'} eq 'textual') { return ''; }
    my $openwin=&openmenu();
    return(<<ENDSMENU);
<script>
   var swmenu=$openwin
   swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action","$description");
</script>
ENDSMENU
}

# ================================================================== Raw Config

sub clear {
    my ($row,$col)=@_;
    unless ($ENV{'browser.interface'} eq 'textual') {
       return qq(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(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
   } else {
       my $text=$top.' '.$bot;
       $text=~s/\- //;
       return '<br /><a href="'.$act.'">'.$text.'</a> '.$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.="var swmenu=".&openmenu();
    } 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.="swmenu.syncclock(1000*".time.");";
    }
    return $output;
}

# ======================================================================= Close

sub close {
    my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
    return(<<ENDCLOSE);
<script>
menu=window.open("/adm/rat/empty.html","$menuname",
                 "height=350,width=150,scrollbars=no,menubar=no");
menu.autologout=0;
menu.close();
</script>
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('<html><head><title>LON-CAPA Main Menu</title></head>'.$bodytag);
    $r->print(&rawconfig(1));
    $r->print('</body></html>');
    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__