Annotation of loncom/interface/lonmenu.pm, revision 1.2
1.1 www 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: #
1.2 ! www 8: # 10/05,05/28,05/30 Gerd Kortemeyer
1.1 www 9:
10: package Apache::lonmenu;
11:
12: use strict;
1.2 ! www 13: use Apache::lonnet;
! 14: use Apache::File;
! 15: use vars qw(@desklines $readdesk);
! 16:
1.1 www 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:
1.2 ! www 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 switch {
! 44: my ($uname,$udom,$row,$col,$img,$top,$bot,$act)=@_;
! 45: $act=~s/\$uname/$uname/g;
! 46: $act=~s/\$udom/$udom/g;
! 47: return "\n".
! 48: qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act"));
! 49: }
! 50:
! 51: sub secondlevel {
! 52: my $output='';
! 53: my
! 54: ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act)=@_;
! 55: if ($prt eq 'any') {
! 56: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
! 57: } elsif ($prt=~/^r(\w+)/) {
! 58: if ($rol eq $1) {
! 59: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
! 60: }
! 61: }
! 62: return $output;
! 63: }
! 64:
! 65: sub rawconfig {
! 66: my $output="swmenu=window.open('','LONCAPAmenu');";
! 67: my $uname=$ENV{'user.name'};
! 68: my $udom=$ENV{'user.domain'};
! 69: my $adv=$ENV{'user.adv'};
! 70: my $crs=$ENV{'request.course.id'};
! 71: my $pub=($ENV{'request.state'} eq 'published');
! 72: my $con=($ENV{'request.state'} eq 'construct');
! 73: my $rol=$ENV{'request.role'};
! 74: map {
! 75: my ($row,$col,$pro,$prt,$img,$top,$bot,$act)=split(/\:/,$_);
! 76: if ($pro eq 'any') {
! 77: $prt=~s/\$uname/$uname/g;
! 78: $prt=~s/\$udom/$udom/g;
! 79: $prt=~s/\$crs/$crs/g;
! 80: $output.=&secondlevel(
! 81: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
! 82: } elsif ($pro eq 'smp') {
! 83: unless ($adv) {
! 84: $output.=&secondlevel(
! 85: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
! 86: }
! 87: } elsif ($pro eq 'adv') {
! 88: if ($adv) {
! 89: $output.=&secondlevel(
! 90: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
! 91: }
! 92: } elsif (($pro=~/p(\w+)/) && ($prt)) {
! 93: if (&Apache::lonnet::allowed($1,$prt)) {
! 94: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
! 95: }
! 96: }
! 97: } @desklines;
! 98: return $output;
! 99: }
! 100:
! 101: # ======================================================================= Close
1.1 www 102:
103: sub close {
104: return(<<ENDCLOSE);
105: <script>
106: window.status='MenuControl:nologout';
107: menu=window.open("/adm/rat/empty.html","LONCAPAmenu",
108: "height=350,width=150,scrollbars=no,menubar=no");
109: menu.close();
110: </script>
111: ENDCLOSE
112: }
113:
114: # ====================================================================== Footer
115:
116: sub footer {
117:
118: }
119:
1.2 ! www 120: # ================================================================ Main Program
! 121:
! 122: sub BEGIN {
! 123: if ($readdesk ne 'done') {
! 124: {
! 125: my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
! 126: '/mydesk.tab');
! 127: while (my $configline=<$config>) {
! 128: chomp($configline);
! 129: $desklines[$#desklines+1]=$configline;
! 130: }
! 131: }
! 132: }
! 133: }
1.1 www 134: 1;
135: __END__
136:
137:
138:
139:
140:
141:
142:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>