File:
[LON-CAPA] /
loncom /
interface /
lonmenu.pm
Revision
1.67:
download - view:
text,
annotated -
select for diffs
Fri May 23 13:56:39 2003 UTC (21 years ago) by
www
Branches:
MAIN
CVS tags:
HEAD
Attempt to fix quadruplicate bug 1178: when using browser URL field of
main content window to go to an external site, JavaScript security model
disconnects all access the Remote could have to it, including the one to
even find out if it has access.
Implemented flag "noclient" in the Remote which gets set in an unLoad event of
the main window (ignoring the fact that unLoad is kaputt in some browser
versions).
This all seems to work great on Mozilla, but I am sure there will be stupid
side effects in some odd scenarios.
1: # The LearningOnline Network with CAPA
2: # Routines to control the menu
3: #
4: # $Id: lonmenu.pm,v 1.67 2003/05/23 13:56:39 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: #
29: # There are two parameters controlling the action of this module:
30: #
31: # browser.interface - if this is 'textual', it overrides the second parameter
32: # and goes to screen reader PDA mode
33: #
34: # environment.remote - if this is 'on', the routines controll the remote
35: # control, otherwise they render the main window controls; ignored it
36: # browser.interface is 'textual'
37: #
38:
39: package Apache::lonmenu;
40:
41: use strict;
42: use Apache::lonnet;
43: use Apache::Constants qw(:common);
44: use Apache::lonhtmlcommon();
45: use Apache::loncommon;
46: use Apache::File;
47: use vars qw(@desklines $readdesk);
48: my @inlineremote;
49: my $font;
50: my $tabbg;
51: my $pgbg;
52:
53: # ============================= This gets called at the top of the body section
54:
55: sub menubuttons {
56: my $forcereg=shift;
57: my $target =shift;
58: my $registration=shift;
59: my $navmaps='';
60: my $reloadlink='';
61: my $escurl=&Apache::lonnet::escape($ENV{'REQUEST_URI'});
62: my $escsymb=&Apache::lonnet::escape($ENV{'request.symb'});
63: if ($ENV{'browser.interface'} eq 'textual') {
64: # Textual display only
65: if ($ENV{'request.course.id'}) {
66: $navmaps=(<<ENDNAV);
67: <a href="/adm/navmaps?postdata=$escurl&postsymb=$escsymb" target="_top">Navigate Contents</a>
68: ENDNAV
69: if (($ENV{'REQUEST_URI'}=~/^\/adm\//) &&
70: ($ENV{'REQUEST_URI'}!~/^\/adm\/wrapper\//) &&
71: ($ENV{'REQUEST_URI'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
72: my $escreload=&Apache::lonnet::escape('return:');
73: $reloadlink=(<<ENDRELOAD);
74: <a href="/adm/flip?postdata=$escreload" target="_top"><font color="$font">Return to Last Location</font></a>
75: ENDRELOAD
76: }
77: }
78: my $output=(<<ENDMAINMENU);
79: <script>
80: // BEGIN LON-CAPA Internal
81: </script>
82: <a href="/adm/menu" target="_top">Main Menu</a>
83: $reloadlink $navmaps<br />
84: <script>
85: // END LON-CAPA Internal
86: </script>
87: ENDMAINMENU
88: if ($registration) { $output.=&innerregister($forcereg,$target); }
89: return $output."<hr />";
90: } elsif ($ENV{'environment.remote'} eq 'off') {
91: # Remote Control is switched off
92: # figure out colors
93: my $function='student';
94: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
95: $function='coordinator';
96: }
97: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
98: $function='admin';
99: }
100: if (($ENV{'request.role'}=~/^(au|ca)/) ||
101: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
102: $function='author';
103: }
104: my $domain=&Apache::loncommon::determinedomain();
105: $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
106: $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
107: $font=&Apache::loncommon::designparm($function.'.font',$domain);
108: my $link=&Apache::loncommon::designparm($function.'.link',$domain);
109: my $alink=&Apache::loncommon::designparm($function.'.alink',$domain);
110: my $vlink=&Apache::loncommon::designparm($function.'.vlink',$domain);
111: my $sidebg=&Apache::loncommon::designparm($function.'.sidebg',$domain);
112: # Do we have a NAV link?
113: if ($ENV{'request.course.id'}) {
114: $navmaps=(<<ENDNAVREM);
115: <td bgcolor="$tabbg">
116: <a href="/adm/navmaps?postdata=$escurl&postsymb=$escsymb" target="_top"><font color="$font">Navigate Contents</font></a></td>
117: ENDNAVREM
118: if (($ENV{'REQUEST_URI'}=~/^\/adm\//) &&
119: ($ENV{'REQUEST_URI'}!~/^\/adm\/wrapper\//) &&
120: ($ENV{'REQUEST_URI'}!~/^\/adm\/.*\/(smppg|bulletinboard|aboutme)(\?|$)/)) {
121: my $escreload=&Apache::lonnet::escape('return:');
122: $reloadlink=(<<ENDRELOAD);
123: <td bgcolor="$tabbg">
124: <a href="/adm/flip?postdata=$escreload" target="_top"><font color="$font">Return to Last Location</font></a></td>
125: ENDRELOAD
126: }
127: }
128: my $reg='';
129: if ($registration) {
130: $reg=&innerregister($forcereg,$target);
131: }
132: return (<<ENDINLINEMENU);
133: <script>
134: // BEGIN LON-CAPA Internal
135: </script>
136: <table bgcolor="$pgbg" width="100%" border="0" cellpadding="3" cellspacing="3">
137: <tr>
138: <td bgcolor="$tabbg">
139: <a href="/adm/menu" target="_top"><font color="$font">Main Menu</font></a>
140: </td>
141: $reloadlink
142: $navmaps
143: <td bgcolor="$tabbg">
144: <a href="/adm/remote?action=launch&url=$escurl" target="_top">
145: <font color="$font">Launch Remote Control</font></a></td>
146: <td bgcolor="$tabbg">
147: <img align="right" src="/adm/lonIcons/minilogo.gif" />
148: <b>LON-CAPA</b></td>
149: </tr>
150: </table>
151: <script>
152: // END LON-CAPA Internal
153: </script>
154: $reg
155: ENDINLINEMENU
156: } else {
157: return '';
158: }
159: }
160:
161: # ====================================== This gets called in the header section
162:
163: sub registerurl {
164: my $forcereg=shift;
165: my $target = shift;
166: my $result = '';
167:
168: my $force_title='';
169: if ($ENV{'request.state'} eq 'construct') {
170: $force_title=&Apache::lonxml::display_title();
171: }
172: if ($target eq 'edit') {
173: $result .="<script type=\"text/javascript\">\n".
174: "if (typeof swmenu != 'undefined') {swmenu.currentURL=null;}\n".
175: &Apache::loncommon::browser_and_searcher_javascript().
176: "\n</script>\n";
177: }
178: if (($ENV{'browser.interface'} eq 'textual') ||
179: ($ENV{'environment.remote'} eq 'off') ||
180: ((($ENV{'request.publicaccess'}) ||
181: (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
182: (!$forcereg))) {
183: return $result.
184: '<script type="text/javascript">function LONCAPAreg(){;} function LONCAPAstale(){}</script>'.$force_title;
185: }
186: # Graphical display after login only
187: if ($Apache::lonxml::registered && !$forcereg) { return ''; }
188: $result.=&innerregister($forcereg,$target);
189: return $result.$force_title;
190: }
191:
192: # =========== This gets called in order to register a URL, both with the Remote
193: # =========== and in the body of the document
194:
195: sub innerregister {
196: my $forcereg=shift;
197: my $target = shift;
198: my $result = '';
199:
200: $Apache::lonxml::registered=1;
201:
202: my $textinter=($ENV{'browser.interface'} eq 'textual');
203: my $noremote=($ENV{'environment.remote'} eq 'off');
204:
205: my $textual=($textinter || $noremote);
206:
207: @inlineremote=();
208: undef @inlineremote;
209:
210: my $reopen=&Apache::lonmenu::reopenmenu();
211:
212: my $newmail='';
213: if ($noremote) {
214: $newmail='<table bgcolor="'.$pgbg.'" border="0" cellspacing="3" cellpadding="3" width="100%"><tr><td bgcolor="'.$tabbg.'">';
215: }
216: if (($textual) && ($ENV{'request.symb'}) && ($ENV{'request.course.id'})) {
217: my ($mapurl,$rid,$resurl)=split(/\_\_\_/,$ENV{'request.symb'});
218: $newmail.=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
219: my $maptitle=&Apache::lonnet::gettitle($mapurl);
220: my $restitle=&Apache::lonnet::gettitle($resurl);
221: if ($maptitle) {
222: $newmail.=', '.$maptitle;
223: }
224: if ($restitle) {
225: $newmail.=': '.$restitle;
226: }
227: $newmail.=' ';
228: }
229: if (&Apache::lonmsg::newmail()) {
230: $newmail=($textual?
231: '<b><a href="/adm/communicate">You have new messages</a></b><br />':
232: 'swmenu.setstatus("you have","messages");');
233: }
234: if ($noremote) {
235: $newmail.='</td></tr></table>';
236: }
237: my $timesync=($textual?'':'swmenu.syncclock(1000*'.time.');');
238: my $tablestart=($noremote?'<table bgcolor="'.$pgbg.'" border="0" cellspacing="3" cellpadding="3" width="100%">':'');
239: my $tableend=($noremote?'</table>':'');
240: # =============================================================================
241: # ============================ This is for URLs that actually can be registered
242: if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
243: # -- This applies to homework problems for users with grading privileges
244: my $hwkadd='';
245: if
246: ($ENV{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
247: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
248: $hwkadd.=&switch('','',7,1,'subm.gif','view sub','missions',
249: "gocmd('/adm/grades','submission')",
250: 'View user submissions for this assessment resource');
251: }
252: if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
253: $hwkadd.=&switch('','',7,2,'pgrd.gif','problem','grades',
254: "gocmd('/adm/grades','gradingmenu')",
255: 'Modify user grades for this assessment resource');
256: }
257: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
258: $hwkadd.=&switch('','',7,3,'pparm.gif','problem','parms',
259: "gocmd('/adm/parmset','set')",
260: 'Modify deadlines, etc, for this assessment resource');
261: }
262: }
263: # -- End Homework
264: ###
265: ### Determine whether or not to display the 'cstr' button for this
266: ### resource
267: ###
268: my $editbutton = '';
269: if ($ENV{'user.author'}) {
270: if ($ENV{'request.role'}=~/^(ca|au)/) {
271: # Set defaults for authors
272: my ($top,$bottom) = ('con-','struct');
273: my $action = "go('/priv/".$ENV{'user.name'}."');";
274: my $cadom = $ENV{'request.role.domain'};
275: my $caname = $ENV{'user.name'};
276: my $desc = "Enter my resource construction space";
277: # Set defaults for co-authors
278: if ($ENV{'request.role'} =~ /^ca/) {
279: ($cadom,$caname)=($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
280: ($top,$bottom) = ('co con-','struct');
281: $action = "go('/priv/".$caname."');";
282: $desc = "Enter construction space as co-author";
283: }
284: # Check that we are on the correct machine
285: my $home = &Apache::lonnet::homeserver($caname,$cadom);
286: if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) {
287: $editbutton=&switch
288: ('','',6,1,$top,,$bottom,$action,$desc);
289: }
290: }
291: ##
292: ## Determine if user can edit url.
293: ##
294: my $cfile='';
295: my $cfuname='';
296: my $cfudom='';
297: if ($ENV{'request.filename'}) {
298: my $file=&Apache::lonnet::declutter($ENV{'request.filename'});
299: $file=~s/^(\w+)\/(\w+)/\/priv\/$2/;
300: # Chech that the user has permission to edit this resource
301: ($cfuname,$cfudom)=&Apache::loncacc::constructaccess($file,$1);
302: if (defined($cfudom)) {
303: if (&Apache::lonnet::homeserver($cfuname,$cfudom)
304: eq $Apache::lonnet::perlvar{'lonHostID'}) {
305: $cfile=$file;
306: }
307: }
308: }
309: # Finally, turn the button on or off
310: if ($cfile) {
311: $editbutton=&switch
312: ('','',6,1,'cstr.gif','edit','resource',
313: "go('".$cfile."');","Edit this resource");
314: } elsif ($editbutton eq '') {
315: $editbutton=&clear(6,1);
316: }
317: }
318: ###
319: ###
320: # Prepare the rest of the buttons
321: my $menuitems=(<<ENDMENUITEMS);
322: c&3&1
323: s&2&1&back.gif&backward&&gopost('/adm/flip','back:'+currentURL)&Go to the previous resource in the course sequence&1
324: s&2&3&forw.gif&forward&&gopost('/adm/flip','forward:'+currentURL)&Go to the next resource in the course sequence&3
325: s&6&3&catalog.gif&catalog&info&catalog_info()&Show catalog information
326: s&8&1&eval.gif&evaluate&this&gopost('/adm/evaluate',currentURL)&Provide my evaluation of this resource
327: s&8&2&fdbk.gif&feedback&discuss&gopost('/adm/feedback',currentURL)&Provide feedback messages or contribute to the course discussion about this resource
328: s&8&3&prt.gif&prepare&printout&gopost('/adm/printout',currentURL)&Prepare a printable document
329: s&9&1&sbkm.gif&set&bookmark&set_bookmark()&Set a bookmark for this resource&2
330: s&9&2&vbkm.gif&view&bookmark&edit_bookmarks()&Use or edit my bookmark collection&2
331: s&9&3&anot.gif&anno-&tations&annotate()&Make notes and annotations about this resource&2
332: ENDMENUITEMS
333: my $buttons='';
334: foreach (split(/\n/,$menuitems)) {
335: my ($command,@rest)=split(/\&/,$_);
336: if ($command eq 's') {
337: $buttons.=&switch('','',@rest);
338: } else {
339: $buttons.=&clear(@rest);
340: }
341: }
342: if ($textual) {
343: # Registered, textual output
344: my $utility=&utilityfunctions();
345: my $form=&serverform();
346: my $inlinebuttons=
347: join('',map { (defined($_)?$_:'') } @inlineremote);
348: $result =(<<ENDREGTEXT);
349: <script>
350: // BEGIN LON-CAPA Internal
351: $utility
352: </script>
353: $timesync
354: $newmail
355: $tablestart
356: $inlinebuttons
357: $tableend
358: $form
359: <script>
360: // END LON-CAPA Internal
361: </script>
362:
363: ENDREGTEXT
364: # Registered, graphical output
365: } else {
366: $result = (<<ENDREGTHIS);
367:
368: <script language="JavaScript">
369: // BEGIN LON-CAPA Internal
370: var swmenu=null;
371:
372: function LONCAPAreg() {
373: swmenu=$reopen;
374: swmenu.noclient=0;
375: swmenu.clearTimeout(swmenu.menucltim);
376: $timesync
377: $newmail
378: $buttons
379: swmenu.currentURL=window.location.pathname;
380: swmenu.reloadURL=window.location.pathname+window.location.search;
381: swmenu.currentSymb="$ENV{'request.symb'}";
382: swmenu.reloadSymb="$ENV{'request.symb'}";
383: swmenu.currentStale=0;
384: $hwkadd
385: $editbutton
386: }
387:
388: function LONCAPAstale() {
389: swmenu=$reopen
390: swmenu.currentStale=1;
391: if (swmenu.reloadURL!='' && swmenu.reloadURL!= null) {
392: swmenu.switchbutton
393: (3,1,'reload.gif','return','location','go(reloadURL)','Return to the last known location in the course sequence');
394: }
395: swmenu.clearbut(7,1);
396: swmenu.clearbut(7,2);
397: swmenu.clearbut(7,3);
398: swmenu.menucltim=swmenu.setTimeout(
399: 'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
400: 'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3);clearbut(6,1)',
401: 2000);
402: swmenu.noclient=1;
403: }
404:
405: // END LON-CAPA Internal
406: </script>
407: ENDREGTHIS
408: }
409: # =============================================================================
410: } else {
411: # ========================================== This can or will not be registered
412: if ($textual) {
413: # Not registered, textual
414: $result= (<<ENDDONOTREGTEXT);
415: ENDDONOTREGTEXT
416: } else {
417: # Not registered, graphical
418: $result = (<<ENDDONOTREGTHIS);
419:
420: <script language="JavaScript">
421: // BEGIN LON-CAPA Internal
422: var swmenu=null;
423:
424: function LONCAPAreg() {
425: swmenu=$reopen
426: swmenu.noclient=0;
427: $timesync
428: swmenu.currentStale=1;
429: swmenu.clearbut(2,1);
430: swmenu.clearbut(2,3);
431: swmenu.clearbut(8,1);
432: swmenu.clearbut(8,2);
433: swmenu.clearbut(8,3);
434: if (swmenu.currentURL) {
435: swmenu.switchbutton
436: (3,1,'reload.gif','return','location','go(currentURL)');
437: } else {
438: swmenu.clearbut(3,1);
439: }
440: }
441:
442: function LONCAPAstale() {
443: swmenu=$reopen
444: swmenu.noclient=1;
445: }
446:
447: // END LON-CAPA Internal
448: </script>
449: ENDDONOTREGTHIS
450: }
451: # =============================================================================
452: }
453: return $result;
454: }
455:
456: sub loadevents() {
457: return 'LONCAPAreg();';
458: }
459:
460: sub unloadevents() {
461: return 'LONCAPAstale();';
462: }
463:
464: # ============================================================= Start up remote
465:
466: sub startupremote {
467: my ($lowerurl)=@_;
468: if (($ENV{'browser.interface'} eq 'textual') ||
469: ($ENV{'environment.remote'} eq 'off')) {
470: return ('<meta HTTP-EQUIV="Refresh" CONTENT="0.5; url='.$lowerurl.'" />');
471: }
472: #
473: # The Remote actually gets launched!
474: #
475: my $configmenu=&rawconfig();
476: my $esclowerurl=&Apache::lonnet::escape($lowerurl);
477:
478: return(<<ENDREMOTESTARTUP);
479: <script>
480:
481: function wheelswitch() {
482: if (window.status=='|') {
483: window.status='/';
484: } else {
485: if (window.status=='/') {
486: window.status='-';
487: } else {
488: if (window.status=='-') {
489: window.status='\\\\';
490: } else {
491: if (window.status=='\\\\') { window.status='|'; }
492: }
493: }
494: }
495: }
496:
497: // ---------------------------------------------------------- The wait function
498: var canceltim;
499: function wait() {
500: if ((menuloaded==1) || (tim==1)) {
501: window.status='Done.';
502: if (tim==0) {
503: clearTimeout(canceltim);
504: $configmenu
505: window.location='$lowerurl';
506: } else {
507: window.location='/adm/remote?action=collapse&url=$esclowerurl';
508: }
509: } else {
510: wheelswitch();
511: setTimeout('wait();',200);
512: }
513: }
514:
515: function main() {
516: canceltim=setTimeout('tim=1;',30000);
517: window.status='-';
518: wait();
519: }
520:
521: </script>
522: ENDREMOTESTARTUP
523: }
524:
525: sub setflags() {
526: return(<<ENDSETFLAGS);
527: <script>
528: menuloaded=0;
529: tim=0;
530: </script>
531: ENDSETFLAGS
532: }
533:
534: sub maincall() {
535: if (($ENV{'browser.interface'} eq 'textual') ||
536: ($ENV{'environment.remote'} eq 'off')) { return ''; }
537: return(<<ENDMAINCALL);
538: <script>
539: main();
540: </script>
541: ENDMAINCALL
542: }
543: # ================================================================= Reopen menu
544:
545: sub reopenmenu {
546: if (($ENV{'browser.interface'} eq 'textual') ||
547: ($ENV{'environment.remote'} eq 'off')) { return ''; }
548: my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
549: my $nothing = &Apache::lonhtmlcommon::javascript_nothing();
550: return('window.open('.$nothing.',"'.$menuname.'","",false);');
551: }
552:
553: # =============================================================== Open the menu
554:
555: sub open {
556: my $returnval='';
557: if (($ENV{'browser.interface'} eq 'textual') ||
558: ($ENV{'environment.remote'} eq 'off')) { return ''; }
559: my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
560: unless (shift eq 'unix') {
561: # resizing does not work on linux because of virtual desktop sizes
562: $returnval.=(<<ENDRESIZE);
563: if (window.screen) {
564: self.resizeTo(screen.availWidth-215,screen.availHeight-55);
565: self.moveTo(190,15);
566: }
567: ENDRESIZE
568: }
569: $returnval.=(<<ENDOPEN);
570: window.status='Opening LON-CAPA Remote Control';
571: var menu=window.open("/res/adm/pages/menu.html","$menuname",
572: "height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
573: ENDOPEN
574: return '<script>'.$returnval.'</script>';
575: }
576:
577:
578: # ================================================================== Raw Config
579:
580: sub clear {
581: my ($row,$col)=@_;
582: unless (($ENV{'browser.interface'} eq 'textual') ||
583: ($ENV{'environment.remote'} eq 'off')) {
584: return "\n".qq(window.status+='.';swmenu.clearbut($row,$col););
585: } else {
586: $inlineremote[10*$row+$col]='';
587: return '';
588: }
589: }
590:
591: # ============================================ Switch a button or create a link
592: # Switch acts on the javascript that is executed when a button is clicked.
593: # The javascript is usually similar to "go('/adm/roles')" or "cstrgo(..)".
594:
595: sub switch {
596: my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc,$nobreak)=@_;
597: $act=~s/\$uname/$uname/g;
598: $act=~s/\$udom/$udom/g;
599: unless (($ENV{'browser.interface'} eq 'textual') ||
600: ($ENV{'environment.remote'} eq 'off')) {
601: # Remote
602: return "\n".
603: qq(window.status+='.';swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
604: } elsif ($ENV{'browser.interface'} eq 'textual') {
605: # Accessibility
606: if ($nobreak==2) { return ''; }
607: my $text=$top.' '.$bot;
608: $text=~s/\- //;
609: $inlineremote[10*$row+$col]="\n".($nobreak?' ':'<br />').
610: '<a href="javascript:'.$act.';">'.$text.'</a> '.
611: ($nobreak?'':$desc);
612: } else {
613: # Inline Remote
614: if ($nobreak==2) { return ''; }
615: my $text=$top.' '.$bot;
616: $text=~s/\- //;
617: $inlineremote[10*$row+$col]="\n".
618: ($nobreak==3?'<td width="50%" colspan="2" align="right"':'<tr><td').
619: ' bgcolor="'.$tabbg.'"'.($nobreak==1?' width="50%" colspan="2"':'').
620: '"><a href="javascript:'.$act.';"><font color="'.$font.'"'.
621: ($nobreak?' size="+1"':'').
622: '>'.$text.'</font></a></td>'.
623: ($nobreak?'':'<td colspan="3" width="80%"><font color="'.$font.'" size="-1">'.$desc.'</font>').($nobreak!=1?'</tr>':'');
624: }
625: return '';
626: }
627:
628: sub secondlevel {
629: my $output='';
630: my
631: ($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc)=@_;
632: if ($prt eq 'any') {
633: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
634: } elsif ($prt=~/^r(\w+)/) {
635: if ($rol eq $1) {
636: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
637: }
638: }
639: return $output;
640: }
641:
642: sub openmenu {
643: my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
644: if (($ENV{'browser.interface'} eq 'textual') ||
645: ($ENV{'environment.remote'} eq 'off')) { return ''; }
646: my $nothing = &Apache::lonhtmlcommon::javascript_nothing();
647: return "window.open(".$nothing.",'".$menuname."');";
648: }
649:
650: sub inlinemenu {
651: @inlineremote=();
652: undef @inlineremote;
653: &rawconfig(1);
654: return join('',map { (defined($_)?$_:'') } @inlineremote);
655: }
656:
657: sub rawconfig {
658: my $textualoverride=shift;
659: my $output='';
660: unless (($ENV{'browser.interface'} eq 'textual') ||
661: ($ENV{'environment.remote'} eq 'off')) {
662: $output.=
663: "window.status='Opening Remote Control';var swmenu=".&openmenu().
664: "\nwindow.status='Configuring Remote Control ';";
665: } else {
666: unless ($textualoverride) { return ''; }
667: }
668: my $uname=$ENV{'user.name'};
669: my $udom=$ENV{'user.domain'};
670: my $adv=$ENV{'user.adv'};
671: my $author=$ENV{'user.author'};
672: my $crs='';
673: if ($ENV{'request.course.id'}) {
674: $crs='/'.$ENV{'request.course.id'};
675: if ($ENV{'request.course.sec'}) {
676: $crs.='_'.$ENV{'request.course.sec'};
677: }
678: $crs=~s/\_/\//g;
679: }
680: my $pub=($ENV{'request.state'} eq 'published');
681: my $con=($ENV{'request.state'} eq 'construct');
682: my $rol=$ENV{'request.role'};
683: my $requested_domain = $ENV{'request.role.domain'};
684: foreach (@desklines) {
685: my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc)=split(/\:/,$_);
686: $prt=~s/\$uname/$uname/g;
687: $prt=~s/\$udom/$udom/g;
688: $prt=~s/\$crs/$crs/g;
689: $prt=~s/\$requested_domain/$requested_domain/g;
690: if ($pro eq 'clear') {
691: $output.=&clear($row,$col);
692: } elsif ($pro eq 'any') {
693: $output.=&secondlevel(
694: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
695: } elsif ($pro eq 'smp') {
696: unless ($adv) {
697: $output.=&secondlevel(
698: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
699: }
700: } elsif ($pro eq 'adv') {
701: if ($adv) {
702: $output.=&secondlevel(
703: $uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
704: }
705: } elsif (($pro=~/p(\w+)/) && ($prt)) {
706: if (&Apache::lonnet::allowed($1,$prt)) {
707: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
708: }
709: } elsif ($pro eq 'course') {
710: if ($ENV{'request.course.fn'}) {
711: $output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
712: }
713: } elsif ($pro eq 'author') {
714: if ($author) {
715: if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) ||
716: (($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) {
717: # Check that we are on the correct machine
718: my $cadom=$requested_domain;
719: my $caname=$ENV{'user.name'};
720: if ($prt eq 'rca') {
721: ($cadom,$caname)=
722: ($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
723: }
724: $act =~ s/\$caname/$caname/g;
725: my $home = &Apache::lonnet::homeserver($caname,$cadom);
726: if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) {
727: $output.=switch($caname,$cadom,
728: $row,$col,$img,$top,$bot,$act,$desc);
729: }
730: }
731: }
732: }
733: }
734: unless (($ENV{'browser.interface'} eq 'textual') ||
735: ($ENV{'environment.remote'} eq 'off')) {
736: $output.="\nwindow.status='Synchronizing Time';swmenu.syncclock(1000*".time.");\nwindow.status='Remote Control Configured.';";
737: }
738: return $output;
739: }
740:
741: # ======================================================================= Close
742:
743: sub close {
744: if (($ENV{'browser.interface'} eq 'textual') ||
745: ($ENV{'environment.remote'} eq 'off')) { return ''; }
746: my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
747: return(<<ENDCLOSE);
748: <script>
749: window.status='Accessing Remote Control';
750: menu=window.open("/adm/rat/empty.html","$menuname",
751: "height=350,width=150,scrollbars=no,menubar=no");
752: window.status='Disabling Remote Control';
753: menu.active=0;
754: menu.autologout=0;
755: window.status='Closing Remote Control';
756: menu.close();
757: window.status='Done.';
758: </script>
759: ENDCLOSE
760: }
761:
762: # ====================================================================== Footer
763:
764: sub footer {
765:
766: }
767:
768: sub utilityfunctions {
769: unless (($ENV{'browser.interface'} eq 'textual') ||
770: ($ENV{'environment.remote'} eq 'off')) { return ''; }
771: my $currenturl=$ENV{'REQUEST_URI'};
772: my $currentsymb=$ENV{'request.symb'};
773: return (<<ENDUTILITY)
774:
775: var currentURL="$currenturl";
776: var reloadURL="$currenturl";
777: var currentSymb="$currentsymb";
778:
779: function go(url) {
780: if (url!='' && url!= null) {
781: currentURL = null;
782: currentSymb= null;
783: window.location.href=url;
784: }
785: }
786:
787: function gopost(url,postdata) {
788: if (url!='') {
789: this.document.server.action=url;
790: this.document.server.postdata.value=postdata;
791: this.document.server.command.value='';
792: this.document.server.url.value='';
793: this.document.server.symb.value='';
794: this.document.server.submit();
795: }
796: }
797:
798: function gocmd(url,cmd) {
799: if (url!='') {
800: this.document.server.action=url;
801: this.document.server.postdata.value='';
802: this.document.server.command.value=cmd;
803: this.document.server.url.value=currentURL;
804: this.document.server.symb.value=currentSymb;
805: this.document.server.submit();
806: }
807: }
808:
809: function catalog_info() {
810: loncatinfo=window.open(window.location.pathname+'.meta',"LONcatInfo",'height=320,width=280,resizeable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no');
811: }
812:
813: function chat_win() {
814: lonchat=window.open('/res/adm/pages/chatroom.html',"LONchat",'height=320,width=280,resizeable=yes,location=no,menubar=no,toolbar=no');
815: }
816: ENDUTILITY
817: }
818:
819: sub serverform {
820: return(<<ENDSERVERFORM);
821:
822: <form name="server" action="/adm/logout" method="post" target="_top">
823: <input type="hidden" name="postdata" value="none" />
824: <input type="hidden" name="command" value="none" />
825: <input type="hidden" name="url" value="none" />
826: <input type="hidden" name="symb" value="none" />
827: </form>
828: ENDSERVERFORM
829: }
830: # ================================================ Handler when called directly
831:
832:
833: sub handler {
834: my $r = shift;
835: $r->content_type('text/html');
836: $r->send_http_header;
837: return OK if $r->header_only;
838:
839: my $form=&serverform();
840: my $bodytag=&Apache::loncommon::bodytag('Main Menu');
841: my $function='student';
842: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
843: $function='coordinator';
844: }
845: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
846: $function='admin';
847: }
848: if (($ENV{'request.role'}=~/^(au|ca)/) ||
849: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
850: $function='author';
851: }
852: my $domain=&Apache::loncommon::determinedomain();
853: $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
854: $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
855: $font=&Apache::loncommon::designparm($function.'.font',$domain);
856: # ---- Print the screen, pretent to be in text mode to generate text-based menu
857: unless ($ENV{'brower.interface'} eq 'textual') {
858: $ENV{'environment.remote'}='off';
859: }
860: my $utility=&utilityfunctions();
861: $r->print(<<ENDHEADER);
862: <html><head>
863: <title>LON-CAPA Main Menu</title>
864: <script>
865: $utility
866: </script>
867: </head>
868: $bodytag
869: ENDHEADER
870: $r->print('<table>'.&inlinemenu().'</table>'.$form);
871: $r->print('</body></html>');
872: return OK;
873: }
874:
875: # ================================================================ Main Program
876:
877: BEGIN {
878: if (! defined($readdesk)) {
879: {
880: my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
881: '/mydesk.tab');
882: while (my $configline=<$config>) {
883: $configline=(split(/\#/,$configline))[0];
884: $configline=~s/^\s+//;
885: chomp($configline);
886: if ($configline) {
887: $desklines[$#desklines+1]=$configline;
888: }
889: }
890: }
891: $readdesk='done';
892: }
893: }
894:
895: 1;
896: __END__
897:
898:
899:
900:
901:
902:
903:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmenu.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface