File:  [LON-CAPA] / loncom / interface / lonmenu.pm
Revision 1.10: download - view: text, annotated - select for diffs
Fri Oct 5 19:26:20 2001 UTC (22 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: stable_2001_fall, HEAD
- fixed to actually read in the config file

    1: # The LearningOnline Network with CAPA
    2: # Routines to control the menu
    3: #
    4: # (TeX Conversion Module
    5: #
    6: # 05/29/00,05/30 Gerd Kortemeyer)
    7: #
    8: # 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
    9: 
   10: package Apache::lonmenu;
   11: 
   12: use strict;
   13: use Apache::lonnet;
   14: use Apache::File;
   15: use vars qw(@desklines $readdesk);
   16:  
   17: # =============================================================== Open the menu
   18: 
   19: sub open {
   20:     return(<<ENDOPEN);
   21: <script>
   22: window.status='MenuControl:nologout';
   23: menu=window.open("/res/adm/pages/menu.html","LONCAPAmenu",
   24:                  "height=350,width=150,scrollbars=no,menubar=no");
   25: </script>
   26: ENDOPEN
   27: }
   28: 
   29: # ============================================================ Switch Menu Item
   30: 
   31: sub switchmenu {
   32:     my ($row,$col,$imgsrc,$texttop,$textbot,$action)=@_;
   33:     return(<<ENDSMENU);
   34: <script>
   35:    swmenu=window.open('','LONCAPAmenu');
   36:    swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action");
   37: </script>
   38: ENDSMENU
   39: }
   40: 
   41: # ================================================================== Raw Config
   42: 
   43: sub clear {
   44:     my ($row,$col)=@_;
   45:     return qq(swmenu.clearbut($row,$col););
   46: }
   47: 
   48: sub switch {
   49:     my ($uname,$udom,$row,$col,$img,$top,$bot,$act)=@_;
   50:     $act=~s/\$uname/$uname/g;
   51:     $act=~s/\$udom/$udom/g;
   52:     return "\n".
   53:  qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act"););
   54: }
   55: 
   56: sub secondlevel {
   57:     my $output='';
   58:     my 
   59:     ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act)=@_;
   60:     if ($prt eq 'any') {
   61: 	   $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
   62:     } elsif ($prt=~/^r(\w+)/) {
   63:         if ($rol eq $1) {
   64:            $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
   65:         }
   66:     }
   67:     return $output;
   68: }
   69: 
   70: sub rawconfig {
   71:     my $output="swmenu=window.open('','LONCAPAmenu');";
   72:     my $uname=$ENV{'user.name'};
   73:     my $udom=$ENV{'user.domain'};
   74:     my $adv=$ENV{'user.adv'};
   75:     my $author=$ENV{'user.author'};
   76:     my $crs='';
   77:     if ($ENV{'request.course.id'}) {
   78:        $crs='/'.$ENV{'request.course.id'};
   79:        if ($ENV{'request.course.sec'}) {
   80: 	   $crs.='_'.$ENV{'request.course.sec'};
   81:        }
   82:        $crs=~s/\_/\//g;
   83:     }
   84:     my $pub=($ENV{'request.state'} eq 'published');
   85:     my $con=($ENV{'request.state'} eq 'construct');
   86:     my $rol=$ENV{'request.role'};
   87:     map {
   88:         my ($row,$col,$pro,$prt,$img,$top,$bot,$act)=split(/\:/,$_);
   89:         $prt=~s/\$uname/$uname/g;
   90:         $prt=~s/\$udom/$udom/g;
   91:         $prt=~s/\$crs/$crs/g; 
   92:         if ($pro eq 'clear') {
   93: 	    $output.=&clear($row,$col);
   94:         } elsif ($pro eq 'any') {
   95:                $output.=&secondlevel(
   96: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
   97: 	} elsif ($pro eq 'smp') {
   98:             unless ($adv) {
   99:                $output.=&secondlevel(
  100:           $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
  101:             }
  102:         } elsif ($pro eq 'adv') {
  103:             if ($adv) {
  104:                $output.=&secondlevel(
  105: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
  106:             }
  107:         } elsif (($pro=~/p(\w+)/) && ($prt)) {
  108: 	    if (&Apache::lonnet::allowed($1,$prt)) {
  109:                $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
  110:             }
  111:         } elsif ($pro eq 'author') {
  112:             if ($author) {
  113:                 if (($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) {
  114: 		    my ($cadom,$caname)=
  115:                                ($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
  116:                     $output.=switch($caname,$cadom,
  117:                                     $row,$col,$img,$top,$bot,$act);
  118:                 } elsif ($prt eq 'any') {
  119:                     $output.=switch($ENV{'user.name'},$ENV{'user.domain'},
  120: 				    $row,$col,$img,$top,$bot,$act);
  121:                 }
  122:             }
  123:         }
  124:     } @desklines;
  125:     return $output;
  126: }
  127: 
  128: # ======================================================================= Close
  129: 
  130: sub close {
  131:     return(<<ENDCLOSE);
  132: <script>
  133: window.status='MenuControl:nologout';
  134: menu=window.open("/adm/rat/empty.html","LONCAPAmenu",
  135:                  "height=350,width=150,scrollbars=no,menubar=no");
  136: menu.close();
  137: </script>
  138: ENDCLOSE
  139: }
  140: 
  141: # ====================================================================== Footer
  142: 
  143: sub footer {
  144: 
  145: }
  146: 
  147: # ================================================================ Main Program
  148: 
  149: sub BEGIN {
  150:   unless ($readdesk) {
  151:   {
  152:     my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
  153: 				  '/mydesk.tab');
  154:     while (my $configline=<$config>) {
  155:        chomp($configline);
  156:        $desklines[$#desklines+1]=$configline;
  157:     }
  158:   }
  159: }
  160: }
  161: 1;
  162: __END__
  163: 
  164: 
  165: 
  166: 
  167: 
  168: 
  169: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>