Annotation of loncom/interface/lonmenu.pm, revision 1.5
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.5 ! www 8: # 10/05,05/28,05/30,06/01,06/08 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:
1.3 www 43: sub clear {
44: my ($row,$col)=@_;
45: return qq(swmenu.clearbut($row,$col););
46: }
47:
1.2 www 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".
1.3 www 53: qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act"););
1.2 www 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'};
1.4 www 75: my $author=$ENV{'user.author'};
1.5 ! www 76: my $crs='';
! 77: if ($ENV{'request.course.id'}) {
! 78: $crs='/'.$ENV{'request.course.id'};
! 79: $crs=~s/\_/\//;
! 80: }
1.2 www 81: my $pub=($ENV{'request.state'} eq 'published');
82: my $con=($ENV{'request.state'} eq 'construct');
83: my $rol=$ENV{'request.role'};
84: map {
85: my ($row,$col,$pro,$prt,$img,$top,$bot,$act)=split(/\:/,$_);
1.3 www 86: $prt=~s/\$uname/$uname/g;
87: $prt=~s/\$udom/$udom/g;
1.5 ! www 88: $prt=~s/\$crs/$crs/g;
1.3 www 89: if ($pro eq 'clear') {
1.4 www 90: $output.=&clear($row,$col);
1.3 www 91: } elsif ($pro eq 'any') {
1.2 www 92: $output.=&secondlevel(
93: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
94: } elsif ($pro eq 'smp') {
95: unless ($adv) {
96: $output.=&secondlevel(
97: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
98: }
99: } elsif ($pro eq 'adv') {
100: if ($adv) {
101: $output.=&secondlevel(
102: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);
103: }
104: } elsif (($pro=~/p(\w+)/) && ($prt)) {
105: if (&Apache::lonnet::allowed($1,$prt)) {
106: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);
1.4 www 107: }
108: } elsif ($pro eq 'author') {
109: if ($author) {
1.2 www 110: }
111: }
112: } @desklines;
113: return $output;
114: }
115:
116: # ======================================================================= Close
1.1 www 117:
118: sub close {
119: return(<<ENDCLOSE);
120: <script>
121: window.status='MenuControl:nologout';
122: menu=window.open("/adm/rat/empty.html","LONCAPAmenu",
123: "height=350,width=150,scrollbars=no,menubar=no");
124: menu.close();
125: </script>
126: ENDCLOSE
127: }
128:
129: # ====================================================================== Footer
130:
131: sub footer {
132:
133: }
134:
1.2 www 135: # ================================================================ Main Program
136:
137: sub BEGIN {
138: if ($readdesk ne 'done') {
139: {
140: my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
141: '/mydesk.tab');
142: while (my $configline=<$config>) {
143: chomp($configline);
144: $desklines[$#desklines+1]=$configline;
145: }
146: }
147: }
148: }
1.1 www 149: 1;
150: __END__
151:
152:
153:
154:
155:
156:
157:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>