Annotation of loncom/interface/lonmenu.pm, revision 1.31

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Routines to control the menu
                      3: #
1.31    ! www         4: # $Id: lonmenu.pm,v 1.30 2003/01/15 23:59:26 www Exp $
1.11      albertel    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: #
1.1       www        28: # (TeX Conversion Module
                     29: #
                     30: # 05/29/00,05/30 Gerd Kortemeyer)
                     31: #
1.8       www        32: # 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
1.17      matthew    33: # 02/15/02 Matthew Hall
1.1       www        34: 
                     35: package Apache::lonmenu;
                     36: 
                     37: use strict;
1.2       www        38: use Apache::lonnet;
                     39: use Apache::File;
                     40: use vars qw(@desklines $readdesk);
1.30      www        41: 
                     42: # ================================================================= Reopen menu
                     43: 
                     44: sub reopenmenu {
                     45:    my $nothing='';
                     46:    my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
                     47:    if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
                     48:    return('window.open("'.$nothing.'","'.$menuname.'","",false);');
                     49: } 
                     50: 
1.1       www        51: # =============================================================== Open the menu
                     52: 
                     53: sub open {
1.22      www        54:     my $returnval='';
1.30      www        55:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
1.22      www        56:     unless (shift eq 'unix') {
                     57: # resizing does not work on linux because of virtual desktop sizes
                     58:        $returnval.=(<<ENDRESIZE);
                     59: if (window.screen) {
1.28      www        60:     self.resizeTo(screen.availWidth-215,screen.availHeight-55);
1.22      www        61:     self.moveTo(190,15);
                     62: }
                     63: ENDRESIZE
                     64:     }
                     65:     $returnval.=(<<ENDOPEN);
1.30      www        66: var menu=window.open("/res/adm/pages/menu.html","$menuname",
1.14      www        67: "height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
1.1       www        68: ENDOPEN
1.22      www        69:     return '<script>'.$returnval.'</script>';
1.1       www        70: }
                     71: 
1.2       www        72: # ============================================================ Switch Menu Item
                     73: 
                     74: sub switchmenu {
1.27      www        75:     my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
1.18      www        76:     my $openwin=&openmenu();
1.2       www        77:     return(<<ENDSMENU);
                     78: <script>
1.20      matthew    79:    var swmenu=$openwin
1.27      www        80:    swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action","$description");
1.2       www        81: </script>
                     82: ENDSMENU
                     83: }
                     84: 
                     85: # ================================================================== Raw Config
                     86: 
1.3       www        87: sub clear {
                     88:     my ($row,$col)=@_;
                     89:     return qq(swmenu.clearbut($row,$col););
                     90: }
                     91: 
1.25      matthew    92: # Switch acts on the javascript that is executed when a button is clicked.  
                     93: # The javascript is usually similar to "go('/adm/roles')" or "cstrgo(..)".
1.2       www        94: sub switch {
1.27      www        95:     my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc)=@_;
1.2       www        96:     $act=~s/\$uname/$uname/g;
                     97:     $act=~s/\$udom/$udom/g;
                     98:     return "\n".
1.27      www        99:  qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
1.2       www       100: }
                    101: 
                    102: sub secondlevel {
                    103:     my $output='';
                    104:     my 
1.27      www       105:     ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc)=@_;
1.2       www       106:     if ($prt eq 'any') {
1.27      www       107: 	   $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
1.2       www       108:     } elsif ($prt=~/^r(\w+)/) {
                    109:         if ($rol eq $1) {
1.27      www       110:            $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
1.2       www       111:         }
                    112:     }
                    113:     return $output;
                    114: }
                    115: 
1.18      www       116: sub openmenu {
1.30      www       117:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
1.18      www       118:     if ($ENV{'browser.type'} eq 'explorer') {
1.30      www       119:        return "window.open('javascript:void(0);','".$menuname."');";
1.18      www       120:    } else {
1.30      www       121:        return "window.open('','".$menuname."');";
1.18      www       122:    }
                    123: }
                    124: 
1.2       www       125: sub rawconfig {
1.19      matthew   126:     my $r = shift;
1.20      matthew   127:     my $output="var swmenu=".&openmenu();
1.2       www       128:     my $uname=$ENV{'user.name'};
                    129:     my $udom=$ENV{'user.domain'};
                    130:     my $adv=$ENV{'user.adv'};
1.4       www       131:     my $author=$ENV{'user.author'};
1.5       www       132:     my $crs='';
                    133:     if ($ENV{'request.course.id'}) {
                    134:        $crs='/'.$ENV{'request.course.id'};
1.7       www       135:        if ($ENV{'request.course.sec'}) {
                    136: 	   $crs.='_'.$ENV{'request.course.sec'};
                    137:        }
1.8       www       138:        $crs=~s/\_/\//g;
1.5       www       139:     }
1.2       www       140:     my $pub=($ENV{'request.state'} eq 'published');
                    141:     my $con=($ENV{'request.state'} eq 'construct');
                    142:     my $rol=$ENV{'request.role'};
1.25      matthew   143:     my $requested_domain = $ENV{'request.role.domain'};
1.13      harris41  144:     foreach (@desklines) {
1.27      www       145:         my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc)=split(/\:/,$_);
1.3       www       146:         $prt=~s/\$uname/$uname/g;
                    147:         $prt=~s/\$udom/$udom/g;
1.5       www       148:         $prt=~s/\$crs/$crs/g; 
1.25      matthew   149:         $prt=~s/\$requested_domain/$requested_domain/g;
1.3       www       150:         if ($pro eq 'clear') {
1.4       www       151: 	    $output.=&clear($row,$col);
1.3       www       152:         } elsif ($pro eq 'any') {
1.2       www       153:                $output.=&secondlevel(
1.27      www       154: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
1.2       www       155: 	} elsif ($pro eq 'smp') {
                    156:             unless ($adv) {
                    157:                $output.=&secondlevel(
1.27      www       158:           $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
1.2       www       159:             }
                    160:         } elsif ($pro eq 'adv') {
                    161:             if ($adv) {
                    162:                $output.=&secondlevel(
1.27      www       163: 	  $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
1.2       www       164:             }
                    165:         } elsif (($pro=~/p(\w+)/) && ($prt)) {
                    166: 	    if (&Apache::lonnet::allowed($1,$prt)) {
1.27      www       167:                $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
1.4       www       168:             }
1.26      www       169:         } elsif ($pro eq 'course') {
                    170:             if ($ENV{'request.course.fn'}) {
1.27      www       171:                $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
1.26      www       172: 	    }
1.4       www       173:         } elsif ($pro eq 'author') {
                    174:             if ($author) {
1.29      matthew   175:                 if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) ||
                    176:                     (($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) {
1.19      matthew   177:                     # Check that we are on the correct machine
1.29      matthew   178:                     my $cadom=$requested_domain;
                    179:                     my $caname=$ENV{'user.name'};
                    180:                     if ($prt eq 'rca') {
                    181: 		       ($cadom,$caname)=
1.6       www       182:                                ($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
1.29      matthew   183:                     }                       
                    184:                     $act =~ s/\$caname/$caname/g;
1.19      matthew   185:                     my $home = &Apache::lonnet::homeserver($caname,$cadom);
                    186:                     if ($home eq $r->dir_config('lonHostID')) {
                    187:                         $output.=switch($caname,$cadom,
1.27      www       188:                                         $row,$col,$img,$top,$bot,$act,$desc);
1.19      matthew   189:                     }
1.6       www       190:                 }
1.2       www       191:             }
                    192:         }
1.13      harris41  193:     }
1.24      www       194:     $output.="swmenu.syncclock(1000*".time.");";
1.2       www       195:     return $output;
                    196: }
                    197: 
                    198: # ======================================================================= Close
1.1       www       199: 
                    200: sub close {
1.30      www       201:     my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
1.1       www       202:     return(<<ENDCLOSE);
                    203: <script>
1.30      www       204: menu=window.open("/adm/rat/empty.html","$menuname",
1.1       www       205:                  "height=350,width=150,scrollbars=no,menubar=no");
1.31    ! www       206: menu.autologout=0;
1.1       www       207: menu.close();
                    208: </script>
                    209: ENDCLOSE
                    210: }
                    211: 
                    212: # ====================================================================== Footer
                    213: 
                    214: sub footer {
                    215: 
                    216: }
                    217: 
1.2       www       218: # ================================================================ Main Program
                    219: 
1.16      harris41  220: BEGIN {
1.15      matthew   221:   if (! defined($readdesk)) {
1.14      www       222:    {
1.10      albertel  223:     my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                    224: 				  '/mydesk.tab');
                    225:     while (my $configline=<$config>) {
1.14      www       226:        $configline=(split(/\#/,$configline))[0];
                    227:        $configline=~s/^\s+//;
1.10      albertel  228:        chomp($configline);
1.14      www       229:        if ($configline) {
                    230:           $desklines[$#desklines+1]=$configline;
                    231:        }
1.2       www       232:     }
1.14      www       233:    }
                    234:    $readdesk='done';
1.10      albertel  235:   }
1.2       www       236: }
1.30      www       237: 
1.1       www       238: 1;
                    239: __END__
                    240: 
                    241: 
                    242: 
                    243: 
                    244: 
                    245: 
                    246: 

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