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.

    1: # The LearningOnline Network with CAPA
    2: # Routines to control the menu
    3: #
    4: # $Id: lonmenu.pm,v 1.34 2003/02/13 18:11:26 www Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: # (TeX Conversion Module
   29: #
   30: # 05/29/00,05/30 Gerd Kortemeyer)
   31: #
   32: # 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
   33: # 02/15/02 Matthew Hall
   34: 
   35: package Apache::lonmenu;
   36: 
   37: use strict;
   38: use Apache::lonnet;
   39: use Apache::Constants qw(:common);
   40: use Apache::loncommon;
   41: use Apache::File;
   42: use vars qw(@desklines $readdesk);
   43: 
   44: # ============================================================= Start up remote
   45: 
   46: sub startupremote {
   47:     my ($lowerurl)=@_;
   48:     if ($ENV{'browser.interface'} eq 'textual') {
   49:      return ('<meta HTTP-EQUIV="Refresh" CONTENT="0.5; url='.$lowerurl.'" />');
   50:     }
   51:     my $configmenu=&rawconfig();
   52:     return(<<ENDREMOTESTARTUP);
   53: <script>
   54: 
   55: // ---------------------------------------------------------- The wait function
   56: var canceltim;
   57: function wait() {
   58:    if ((menuloaded==1) || (tim==1)) {
   59:       if (tim==0) {
   60:          clearTimeout(canceltim);
   61:          $configmenu
   62:          window.location='$lowerurl';  
   63:       } else {
   64:          alert("Remote Control Timed Out.");
   65:       }
   66:    } else {
   67:       setTimeout('wait();',100);
   68:    }
   69: }
   70: 
   71: function main() {
   72:    canceltim=setTimeout('tim=1;',80000);
   73:    wait();
   74: }
   75: 
   76: </script>
   77: ENDREMOTESTARTUP
   78: }
   79: 
   80: sub setflags() {
   81:     return(<<ENDSETFLAGS);
   82: <script>
   83:     menuloaded=0;
   84:     tim=0;
   85: </script>
   86: ENDSETFLAGS
   87: }
   88: 
   89: sub maincall() {
   90:     if ($ENV{'browser.interface'} eq 'textual') { return ''; }
   91:     return(<<ENDMAINCALL);
   92: <script>
   93:     main();
   94: </script>
   95: ENDMAINCALL
   96: }
   97: # ================================================================= Reopen menu
   98: 
   99: sub reopenmenu {
  100:    my $nothing='';
  101:    if ($ENV{'browser.interface'} eq 'textual') { return ''; }
  102:    my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
  103:    if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
  104:    return('window.open("'.$nothing.'","'.$menuname.'","",false);');
  105: } 
  106: 
  107: # =============================================================== Open the menu
  108: 
  109: sub open {
  110:     my $returnval='';
  111:     if ($ENV{'browser.interface'} eq 'textual') { return ''; }
  112:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
  113:     unless (shift eq 'unix') {
  114: # resizing does not work on linux because of virtual desktop sizes
  115:        $returnval.=(<<ENDRESIZE);
  116: if (window.screen) {
  117:     self.resizeTo(screen.availWidth-215,screen.availHeight-55);
  118:     self.moveTo(190,15);
  119: }
  120: ENDRESIZE
  121:     }
  122:     $returnval.=(<<ENDOPEN);
  123: var menu=window.open("/res/adm/pages/menu.html","$menuname",
  124: "height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
  125: ENDOPEN
  126:     return '<script>'.$returnval.'</script>';
  127: }
  128: 
  129: # ============================================================ Switch Menu Item
  130: 
  131: sub switchmenu {
  132:     my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
  133:     if ($ENV{'browser.interface'} eq 'textual') { return ''; }
  134:     my $openwin=&openmenu();
  135:     return(<<ENDSMENU);
  136: <script>
  137:    var swmenu=$openwin
  138:    swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action","$description");
  139: </script>
  140: ENDSMENU
  141: }
  142: 
  143: # ================================================================== Raw Config
  144: 
  145: sub clear {
  146:     my ($row,$col)=@_;
  147:     unless ($ENV{'browser.interface'} eq 'textual') {
  148:        return qq(swmenu.clearbut($row,$col););
  149:    } else { return ''; }
  150: }
  151: 
  152: # Switch acts on the javascript that is executed when a button is clicked.  
  153: # The javascript is usually similar to "go('/adm/roles')" or "cstrgo(..)".
  154: sub switch {
  155:     my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc)=@_;
  156:     $act=~s/\$uname/$uname/g;
  157:     $act=~s/\$udom/$udom/g;
  158:     unless ($ENV{'browser.interface'} eq 'textual') {
  159:        return "\n".
  160:  qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
  161:    } else {
  162:        my $text=$top.' '.$bot;
  163:        $text=~s/\- //;
  164:        return '<br /><a href="'.$act.'">'.$text.'</a> '.$desc;
  165:    }
  166: }
  167: 
  168: sub secondlevel {
  169:     my $output='';
  170:     my 
  171:     ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc)=@_;
  172:     if ($prt eq 'any') {
  173: 	   $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
  174:     } elsif ($prt=~/^r(\w+)/) {
  175:         if ($rol eq $1) {
  176:            $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
  177:         }
  178:     }
  179:     return $output;
  180: }
  181: 
  182: sub openmenu {
  183:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
  184:     if ($ENV{'browser.interface'} eq 'textual') { return ''; }
  185:     if ($ENV{'browser.type'} eq 'explorer') {
  186:        return "window.open('javascript:void(0);','".$menuname."');";
  187:    } else {
  188:        return "window.open('','".$menuname."');";
  189:    }
  190: }
  191: 
  192: sub rawconfig {
  193:     my $textualoverride=shift;
  194:     my $output='';
  195:     unless ($ENV{'browser.interface'} eq 'textual') {
  196:        $output.="var swmenu=".&openmenu();
  197:     } else {
  198:        unless ($textualoverride) { return ''; }
  199:     }
  200:     my $uname=$ENV{'user.name'};
  201:     my $udom=$ENV{'user.domain'};
  202:     my $adv=$ENV{'user.adv'};
  203:     my $author=$ENV{'user.author'};
  204:     my $crs='';
  205:     if ($ENV{'request.course.id'}) {
  206:        $crs='/'.$ENV{'request.course.id'};
  207:        if ($ENV{'request.course.sec'}) {
  208: 	   $crs.='_'.$ENV{'request.course.sec'};
  209:        }
  210:        $crs=~s/\_/\//g;
  211:     }
  212:     my $pub=($ENV{'request.state'} eq 'published');
  213:     my $con=($ENV{'request.state'} eq 'construct');
  214:     my $rol=$ENV{'request.role'};
  215:     my $requested_domain = $ENV{'request.role.domain'};
  216:     foreach (@desklines) {
  217:         my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc)=split(/\:/,$_);
  218:         $prt=~s/\$uname/$uname/g;
  219:         $prt=~s/\$udom/$udom/g;
  220:         $prt=~s/\$crs/$crs/g; 
  221:         $prt=~s/\$requested_domain/$requested_domain/g;
  222:         if ($pro eq 'clear') {
  223: 	    $output.=&clear($row,$col);
  224:         } elsif ($pro eq 'any') {
  225:                $output.=&secondlevel(
  226: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
  227: 	} elsif ($pro eq 'smp') {
  228:             unless ($adv) {
  229:                $output.=&secondlevel(
  230:           $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
  231:             }
  232:         } elsif ($pro eq 'adv') {
  233:             if ($adv) {
  234:                $output.=&secondlevel(
  235: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
  236:             }
  237:         } elsif (($pro=~/p(\w+)/) && ($prt)) {
  238: 	    if (&Apache::lonnet::allowed($1,$prt)) {
  239:                $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
  240:             }
  241:         } elsif ($pro eq 'course') {
  242:             if ($ENV{'request.course.fn'}) {
  243:                $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
  244: 	    }
  245:         } elsif ($pro eq 'author') {
  246:             if ($author) {
  247:                 if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) ||
  248:                     (($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) {
  249:                     # Check that we are on the correct machine
  250:                     my $cadom=$requested_domain;
  251:                     my $caname=$ENV{'user.name'};
  252:                     if ($prt eq 'rca') {
  253: 		       ($cadom,$caname)=
  254:                                ($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
  255:                     }                       
  256:                     $act =~ s/\$caname/$caname/g;
  257:                     my $home = &Apache::lonnet::homeserver($caname,$cadom);
  258:                     if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) {
  259:                         $output.=switch($caname,$cadom,
  260:                                         $row,$col,$img,$top,$bot,$act,$desc);
  261:                     }
  262:                 }
  263:             }
  264:         }
  265:     }
  266:     unless ($ENV{'browser.interface'} eq 'textual') {
  267:        $output.="swmenu.syncclock(1000*".time.");";
  268:     }
  269:     return $output;
  270: }
  271: 
  272: # ======================================================================= Close
  273: 
  274: sub close {
  275:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
  276:     return(<<ENDCLOSE);
  277: <script>
  278: menu=window.open("/adm/rat/empty.html","$menuname",
  279:                  "height=350,width=150,scrollbars=no,menubar=no");
  280: menu.autologout=0;
  281: menu.close();
  282: </script>
  283: ENDCLOSE
  284: }
  285: 
  286: # ====================================================================== Footer
  287: 
  288: sub footer {
  289: 
  290: }
  291: 
  292: # ================================================ Handler when called directly
  293: 
  294: 
  295: sub handler {
  296:     my $r = shift;
  297:     $r->content_type('text/html');
  298:     $r->send_http_header;
  299:     return OK if $r->header_only;
  300: 
  301:     my $bodytag=&Apache::loncommon::bodytag('Main Menu');
  302: # ------------------------------------------------------------ Print the screen
  303:     $r->print('<html><head><title>LON-CAPA Main Menu</title></head>'.$bodytag);
  304:     $r->print(&rawconfig(1));
  305:     $r->print('</body></html>');
  306:     return OK;
  307: }
  308: 
  309: # ================================================================ Main Program
  310: 
  311: BEGIN {
  312:   if (! defined($readdesk)) {
  313:    {
  314:     my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
  315: 				  '/mydesk.tab');
  316:     while (my $configline=<$config>) {
  317:        $configline=(split(/\#/,$configline))[0];
  318:        $configline=~s/^\s+//;
  319:        chomp($configline);
  320:        if ($configline) {
  321:           $desklines[$#desklines+1]=$configline;
  322:        }
  323:     }
  324:    }
  325:    $readdesk='done';
  326:   }
  327: }
  328: 
  329: 1;
  330: __END__
  331: 
  332: 
  333: 
  334: 
  335: 
  336: 
  337: