File:
[LON-CAPA] /
loncom /
interface /
lonmenu.pm
Revision
1.34:
download - view:
text,
annotated -
select for diffs
Thu Feb 13 18:11:26 2003 UTC (21 years, 4 months ago) by
www
Branches:
MAIN
CVS tags:
HEAD
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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>