Annotation of loncom/interface/loncommon.pm, revision 1.609
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.609 ! raeburn 4: # $Id: loncommon.pm,v 1.608 2007/11/06 02:23:49 albertel Exp $
1.10 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 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.139 matthew 64: use HTML::Entities;
1.334 albertel 65: use Apache::lonhtmlcommon();
66: use Apache::loncoursedata();
1.344 albertel 67: use Apache::lontexconvert();
1.444 albertel 68: use Apache::lonclonecourse();
1.479 albertel 69: use LONCAPA qw(:DEFAULT :match);
1.117 www 70:
1.517 raeburn 71: # ---------------------------------------------- Designs
72: use vars qw(%defaultdesign);
73:
1.22 www 74: my $readit;
75:
1.517 raeburn 76:
1.157 matthew 77: ##
78: ## Global Variables
79: ##
1.46 matthew 80:
1.20 www 81: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 82: my %language;
1.124 www 83: my %supported_language;
1.12 harris41 84: my %cprtag;
1.192 taceyjo1 85: my %scprtag;
1.351 www 86: my %fe; my %fd; my %fm;
1.41 ng 87: my %category_extensions;
1.12 harris41 88:
1.46 matthew 89: # ---------------------------------------------- Thesaurus variables
1.144 matthew 90: #
91: # %Keywords:
92: # A hash used by &keyword to determine if a word is considered a keyword.
93: # $thesaurus_db_file
94: # Scalar containing the full path to the thesaurus database.
1.46 matthew 95:
96: my %Keywords;
97: my $thesaurus_db_file;
98:
1.144 matthew 99: #
100: # Initialize values from language.tab, copyright.tab, filetypes.tab,
101: # thesaurus.tab, and filecategories.tab.
102: #
1.18 www 103: BEGIN {
1.46 matthew 104: # Variable initialization
105: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
106: #
1.22 www 107: unless ($readit) {
1.12 harris41 108: # ------------------------------------------------------------------- languages
109: {
1.158 raeburn 110: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
111: '/language.tab';
112: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 113: while (my $line = <$fh>) {
114: next if ($line=~/^\#/);
115: chomp($line);
116: my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158 raeburn 117: $language{$key}=$val.' - '.$enc;
118: if ($sup) {
119: $supported_language{$key}=$sup;
120: }
121: }
122: close($fh);
123: }
1.12 harris41 124: }
125: # ------------------------------------------------------------------ copyrights
126: {
1.158 raeburn 127: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
128: '/copyright.tab';
129: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 130: while (my $line = <$fh>) {
131: next if ($line=~/^\#/);
132: chomp($line);
133: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 134: $cprtag{$key}=$val;
135: }
136: close($fh);
137: }
1.12 harris41 138: }
1.351 www 139: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 140: {
141: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
142: '/source_copyright.tab';
143: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 144: while (my $line = <$fh>) {
145: next if ($line =~ /^\#/);
146: chomp($line);
147: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 148: $scprtag{$key}=$val;
149: }
150: close($fh);
151: }
152: }
1.63 www 153:
1.517 raeburn 154: # -------------------------------------------------------------- default domain designs
1.63 www 155: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 156: my $designfile = $designdir.'/default.tab';
157: if ( open (my $fh,"<$designfile") ) {
158: while (my $line = <$fh>) {
159: next if ($line =~ /^\#/);
160: chomp($line);
161: my ($key,$val)=(split(/\=/,$line));
162: if ($val) { $defaultdesign{$key}=$val; }
163: }
164: close($fh);
1.63 www 165: }
166:
1.15 harris41 167: # ------------------------------------------------------------- file categories
168: {
1.158 raeburn 169: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
170: '/filecategories.tab';
171: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 172: while (my $line = <$fh>) {
173: next if ($line =~ /^\#/);
174: chomp($line);
175: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 176: push @{$category_extensions{lc($category)}},$extension;
177: }
178: close($fh);
179: }
180:
1.15 harris41 181: }
1.12 harris41 182: # ------------------------------------------------------------------ file types
183: {
1.158 raeburn 184: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
185: '/filetypes.tab';
186: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 187: while (my $line = <$fh>) {
188: next if ($line =~ /^\#/);
189: chomp($line);
190: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 191: if ($descr ne '') {
192: $fe{$ending}=lc($emb);
193: $fd{$ending}=$descr;
1.351 www 194: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 195: }
196: }
197: close($fh);
198: }
1.12 harris41 199: }
1.22 www 200: &Apache::lonnet::logthis(
1.46 matthew 201: "<font color=yellow>INFO: Read file types</font>");
1.22 www 202: $readit=1;
1.46 matthew 203: } # end of unless($readit)
1.32 matthew 204:
205: }
1.112 bowersj2 206:
1.42 matthew 207: ###############################################################
208: ## HTML and Javascript Helper Functions ##
209: ###############################################################
210:
211: =pod
212:
1.112 bowersj2 213: =head1 HTML and Javascript Functions
1.42 matthew 214:
1.112 bowersj2 215: =over 4
216:
217: =item * browser_and_searcher_javascript ()
218:
219: X<browsing, javascript>X<searching, javascript>Returns a string
220: containing javascript with two functions, C<openbrowser> and
221: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
222: tags.
1.42 matthew 223:
1.112 bowersj2 224: =item * openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 225:
226: inputs: formname, elementname, only, omit
227:
228: formname and elementname indicate the name of the html form and name of
229: the element that the results of the browsing selection are to be placed in.
230:
231: Specifying 'only' will restrict the browser to displaying only files
1.185 www 232: with the given extension. Can be a comma separated list.
1.42 matthew 233:
234: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 235: with the given extension. Can be a comma separated list.
1.42 matthew 236:
1.112 bowersj2 237: =item * opensearcher(formname, elementname) [javascript]
1.42 matthew 238:
239: Inputs: formname, elementname
240:
241: formname and elementname specify the name of the html form and the name
242: of the element the selection from the search results will be placed in.
1.542 raeburn 243:
1.42 matthew 244: =cut
245:
246: sub browser_and_searcher_javascript {
1.199 albertel 247: my ($mode)=@_;
248: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 249: my $resurl=&escape_single(&lastresurl());
1.42 matthew 250: return <<END;
1.219 albertel 251: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 252: var editbrowser = null;
1.135 albertel 253: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 254: var url = '$resurl/?';
1.42 matthew 255: if (editbrowser == null) {
256: url += 'launch=1&';
257: }
258: url += 'catalogmode=interactive&';
1.199 albertel 259: url += 'mode=$mode&';
1.42 matthew 260: url += 'form=' + formname + '&';
261: if (only != null) {
262: url += 'only=' + only + '&';
1.217 albertel 263: } else {
264: url += 'only=&';
265: }
1.42 matthew 266: if (omit != null) {
267: url += 'omit=' + omit + '&';
1.217 albertel 268: } else {
269: url += 'omit=&';
270: }
1.135 albertel 271: if (titleelement != null) {
272: url += 'titleelement=' + titleelement + '&';
1.217 albertel 273: } else {
274: url += 'titleelement=&';
275: }
1.42 matthew 276: url += 'element=' + elementname + '';
277: var title = 'Browser';
1.435 albertel 278: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 279: options += ',width=700,height=600';
280: editbrowser = open(url,title,options,'1');
281: editbrowser.focus();
282: }
283: var editsearcher;
1.135 albertel 284: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 285: var url = '/adm/searchcat?';
286: if (editsearcher == null) {
287: url += 'launch=1&';
288: }
289: url += 'catalogmode=interactive&';
1.199 albertel 290: url += 'mode=$mode&';
1.42 matthew 291: url += 'form=' + formname + '&';
1.135 albertel 292: if (titleelement != null) {
293: url += 'titleelement=' + titleelement + '&';
1.217 albertel 294: } else {
295: url += 'titleelement=&';
296: }
1.42 matthew 297: url += 'element=' + elementname + '';
298: var title = 'Search';
1.435 albertel 299: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 300: options += ',width=700,height=600';
301: editsearcher = open(url,title,options,'1');
302: editsearcher.focus();
303: }
1.219 albertel 304: // END LON-CAPA Internal -->
1.42 matthew 305: END
1.170 www 306: }
307:
308: sub lastresurl {
1.258 albertel 309: if ($env{'environment.lastresurl'}) {
310: return $env{'environment.lastresurl'}
1.170 www 311: } else {
312: return '/res';
313: }
314: }
315:
316: sub storeresurl {
317: my $resurl=&Apache::lonnet::clutter(shift);
318: unless ($resurl=~/^\/res/) { return 0; }
319: $resurl=~s/\/$//;
320: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
321: &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
322: return 1;
1.42 matthew 323: }
324:
1.74 www 325: sub studentbrowser_javascript {
1.111 www 326: unless (
1.258 albertel 327: (($env{'request.course.id'}) &&
1.302 albertel 328: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
329: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
330: '/'.$env{'request.course.sec'})
331: ))
1.258 albertel 332: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 333: ) { return ''; }
1.74 www 334: return (<<'ENDSTDBRW');
335: <script type="text/javascript" language="Javascript" >
336: var stdeditbrowser;
1.558 albertel 337: function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {
1.74 www 338: var url = '/adm/pickstudent?';
339: var filter;
1.558 albertel 340: if (!ignorefilter) {
341: eval('filter=document.'+formname+'.'+uname+'.value;');
342: }
1.74 www 343: if (filter != null) {
344: if (filter != '') {
345: url += 'filter='+filter+'&';
346: }
347: }
348: url += 'form=' + formname + '&unameelement='+uname+
349: '&udomelement='+udom;
1.111 www 350: if (roleflag) { url+="&roles=1"; }
1.102 www 351: var title = 'Student_Browser';
1.74 www 352: var options = 'scrollbars=1,resizable=1,menubar=0';
353: options += ',width=700,height=600';
354: stdeditbrowser = open(url,title,options,'1');
355: stdeditbrowser.focus();
356: }
357: </script>
358: ENDSTDBRW
359: }
1.42 matthew 360:
1.74 www 361: sub selectstudent_link {
1.111 www 362: my ($form,$unameele,$udomele)=@_;
1.258 albertel 363: if ($env{'request.course.id'}) {
1.302 albertel 364: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
365: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
366: '/'.$env{'request.course.sec'})) {
1.111 www 367: return '';
368: }
369: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.607 albertel 370: '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
1.74 www 371: }
1.258 albertel 372: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.111 www 373: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.119 www 374: '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
1.111 www 375: }
376: return '';
1.91 www 377: }
378:
379: sub coursebrowser_javascript {
1.468 raeburn 380: my ($domainfilter,$sec_element,$formname)=@_;
1.377 raeburn 381: my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
1.468 raeburn 382: my $output = '
1.538 albertel 383: <script type="text/javascript">
1.468 raeburn 384: var stdeditbrowser;'."\n";
385: $output .= <<"ENDSTDBRW";
1.377 raeburn 386: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91 www 387: var url = '/adm/pickcourse?';
1.468 raeburn 388: var domainfilter = '';
389: var formid = getFormIdByName(formname);
390: if (formid > -1) {
391: var domid = getIndexByName(formid,udom);
392: if (domid > -1) {
393: if (document.forms[formid].elements[domid].type == 'select-one') {
394: domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
395: }
396: if (document.forms[formid].elements[domid].type == 'hidden') {
397: domainfilter=document.forms[formid].elements[domid].value;
398: }
399: }
1.91 www 400: }
1.128 albertel 401: if (domainfilter != null) {
402: if (domainfilter != '') {
403: url += 'domainfilter='+domainfilter+'&';
404: }
405: }
1.91 www 406: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 407: '&cdomelement='+udom+
408: '&cnameelement='+desc;
1.468 raeburn 409: if (extra_element !=null && extra_element != '') {
1.594 raeburn 410: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 411: url += '&roleelement='+extra_element;
412: if (domainfilter == null || domainfilter == '') {
413: url += '&domainfilter='+extra_element;
414: }
1.234 raeburn 415: }
1.468 raeburn 416: else {
417: if (formname == 'portform') {
418: url += '&setroles='+extra_element;
419: }
420: }
1.230 raeburn 421: }
1.293 raeburn 422: if (multflag !=null && multflag != '') {
423: url += '&multiple='+multflag;
424: }
1.377 raeburn 425: if (crstype == 'Course/Group') {
426: if (formname == 'cu') {
427: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
428: if (crstype == "") {
429: alert("$crs_or_grp_alert");
430: return;
431: }
432: }
433: }
434: if (crstype !=null && crstype != '') {
435: url += '&type='+crstype;
436: }
1.102 www 437: var title = 'Course_Browser';
1.91 www 438: var options = 'scrollbars=1,resizable=1,menubar=0';
439: options += ',width=700,height=600';
440: stdeditbrowser = open(url,title,options,'1');
441: stdeditbrowser.focus();
442: }
1.468 raeburn 443:
444: function getFormIdByName(formname) {
445: for (var i=0;i<document.forms.length;i++) {
446: if (document.forms[i].name == formname) {
447: return i;
448: }
449: }
450: return -1;
451: }
452:
453: function getIndexByName(formid,item) {
454: for (var i=0;i<document.forms[formid].elements.length;i++) {
455: if (document.forms[formid].elements[i].name == item) {
456: return i;
457: }
458: }
459: return -1;
460: }
1.91 www 461: ENDSTDBRW
1.468 raeburn 462: if ($sec_element ne '') {
463: $output .= &setsec_javascript($sec_element,$formname);
464: }
465: $output .= '
466: </script>';
467: return $output;
468: }
469:
470: sub setsec_javascript {
471: my ($sec_element,$formname) = @_;
472: my $setsections = qq|
473: function setSect(sectionlist) {
474: var sectionsArray = sectionlist.split(",");
475: var numSections = sectionsArray.length;
476: document.$formname.$sec_element.length = 0;
477: if (numSections == 0) {
478: document.$formname.$sec_element.multiple=false;
479: document.$formname.$sec_element.size=1;
480: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
481: } else {
482: if (numSections == 1) {
483: document.$formname.$sec_element.multiple=false;
484: document.$formname.$sec_element.size=1;
485: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
486: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
487: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
488: } else {
489: for (var i=0; i<numSections; i++) {
490: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
491: }
492: document.$formname.$sec_element.multiple=true
493: if (numSections < 3) {
494: document.$formname.$sec_element.size=numSections;
495: } else {
496: document.$formname.$sec_element.size=3;
497: }
498: document.$formname.$sec_element.options[0].selected = false
499: }
500: }
1.91 www 501: }
1.468 raeburn 502: |;
503: return $setsections;
504: }
505:
1.91 www 506:
507: sub selectcourse_link {
1.377 raeburn 508: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.492 albertel 509: return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
510: '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
1.74 www 511: }
1.42 matthew 512:
1.273 raeburn 513: sub check_uncheck_jscript {
514: my $jscript = <<"ENDSCRT";
515: function checkAll(field) {
516: if (field.length > 0) {
517: for (i = 0; i < field.length; i++) {
518: field[i].checked = true ;
519: }
520: } else {
521: field.checked = true
522: }
523: }
524:
525: function uncheckAll(field) {
526: if (field.length > 0) {
527: for (i = 0; i < field.length; i++) {
528: field[i].checked = false ;
1.543 albertel 529: }
530: } else {
1.273 raeburn 531: field.checked = false ;
532: }
533: }
534: ENDSCRT
535: return $jscript;
536: }
537:
538:
1.42 matthew 539: =pod
1.36 matthew 540:
1.112 bowersj2 541: =item * linked_select_forms(...)
1.36 matthew 542:
543: linked_select_forms returns a string containing a <script></script> block
544: and html for two <select> menus. The select menus will be linked in that
545: changing the value of the first menu will result in new values being placed
546: in the second menu. The values in the select menu will appear in alphabetical
1.609 ! raeburn 547: order unless a defined order is provided.
1.36 matthew 548:
549: linked_select_forms takes the following ordered inputs:
550:
551: =over 4
552:
1.112 bowersj2 553: =item * $formname, the name of the <form> tag
1.36 matthew 554:
1.112 bowersj2 555: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 556:
1.112 bowersj2 557: =item * $firstdefault, the default value for the first menu
1.36 matthew 558:
1.112 bowersj2 559: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 560:
1.112 bowersj2 561: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 562:
1.112 bowersj2 563: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 564:
1.609 ! raeburn 565: =item * $menuorder, the order of values in the first menu
! 566:
1.41 ng 567: =back
568:
1.36 matthew 569: Below is an example of such a hash. Only the 'text', 'default', and
570: 'select2' keys must appear as stated. keys(%menu) are the possible
571: values for the first select menu. The text that coincides with the
1.41 ng 572: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 573: and text for the second menu are given in the hash pointed to by
574: $menu{$choice1}->{'select2'}.
575:
1.112 bowersj2 576: my %menu = ( A1 => { text =>"Choice A1" ,
577: default => "B3",
578: select2 => {
579: B1 => "Choice B1",
580: B2 => "Choice B2",
581: B3 => "Choice B3",
582: B4 => "Choice B4"
1.609 ! raeburn 583: },
! 584: order => ['B4','B3','B1','B2'],
1.112 bowersj2 585: },
586: A2 => { text =>"Choice A2" ,
587: default => "C2",
588: select2 => {
589: C1 => "Choice C1",
590: C2 => "Choice C2",
591: C3 => "Choice C3"
1.609 ! raeburn 592: },
! 593: order => ['C2','C1','C3'],
1.112 bowersj2 594: },
595: A3 => { text =>"Choice A3" ,
596: default => "D6",
597: select2 => {
598: D1 => "Choice D1",
599: D2 => "Choice D2",
600: D3 => "Choice D3",
601: D4 => "Choice D4",
602: D5 => "Choice D5",
603: D6 => "Choice D6",
604: D7 => "Choice D7"
1.609 ! raeburn 605: },
! 606: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 607: }
608: );
1.36 matthew 609:
610: =cut
611:
612: sub linked_select_forms {
613: my ($formname,
614: $middletext,
615: $firstdefault,
616: $firstselectname,
617: $secondselectname,
1.609 ! raeburn 618: $hashref,
! 619: $menuorder,
1.36 matthew 620: ) = @_;
621: my $second = "document.$formname.$secondselectname";
622: my $first = "document.$formname.$firstselectname";
623: # output the javascript to do the changing
624: my $result = '';
1.219 albertel 625: $result.="<script type=\"text/javascript\">\n";
1.36 matthew 626: $result.="var select2data = new Object();\n";
627: $" = '","';
628: my $debug = '';
629: foreach my $s1 (sort(keys(%$hashref))) {
630: $result.="select2data.d_$s1 = new Object();\n";
631: $result.="select2data.d_$s1.def = new String('".
632: $hashref->{$s1}->{'default'}."');\n";
1.609 ! raeburn 633: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 634: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 ! raeburn 635: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
! 636: @s2values = @{$hashref->{$s1}->{'order'}};
! 637: }
1.36 matthew 638: $result.="\"@s2values\");\n";
639: $result.="select2data.d_$s1.texts = new Array(";
640: my @s2texts;
641: foreach my $value (@s2values) {
642: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
643: }
644: $result.="\"@s2texts\");\n";
645: }
646: $"=' ';
647: $result.= <<"END";
648:
649: function select1_changed() {
650: // Determine new choice
651: var newvalue = "d_" + $first.value;
652: // update select2
653: var values = select2data[newvalue].values;
654: var texts = select2data[newvalue].texts;
655: var select2def = select2data[newvalue].def;
656: var i;
657: // out with the old
658: for (i = 0; i < $second.options.length; i++) {
659: $second.options[i] = null;
660: }
661: // in with the nuclear
662: for (i=0;i<values.length; i++) {
663: $second.options[i] = new Option(values[i]);
1.143 matthew 664: $second.options[i].value = values[i];
1.36 matthew 665: $second.options[i].text = texts[i];
666: if (values[i] == select2def) {
667: $second.options[i].selected = true;
668: }
669: }
670: }
671: </script>
672: END
673: # output the initial values for the selection lists
674: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 ! raeburn 675: my @order = sort(keys(%{$hashref}));
! 676: if (ref($menuorder) eq 'ARRAY') {
! 677: @order = @{$menuorder};
! 678: }
! 679: foreach my $value (@order) {
1.36 matthew 680: $result.=" <option value=\"$value\" ";
1.253 albertel 681: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 682: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 683: }
684: $result .= "</select>\n";
685: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
686: $result .= $middletext;
687: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
688: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 ! raeburn 689:
! 690: my @secondorder = sort(keys(%select2));
! 691: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
! 692: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
! 693: }
! 694: foreach my $value (@secondorder) {
1.36 matthew 695: $result.=" <option value=\"$value\" ";
1.253 albertel 696: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 697: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 698: }
699: $result .= "</select>\n";
700: # return $debug;
701: return $result;
702: } # end of sub linked_select_forms {
703:
1.45 matthew 704: =pod
1.44 bowersj2 705:
1.112 bowersj2 706: =item * help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44 bowersj2 707:
1.112 bowersj2 708: Returns a string corresponding to an HTML link to the given help
709: $topic, where $topic corresponds to the name of a .tex file in
710: /home/httpd/html/adm/help/tex, with underscores replaced by
711: spaces.
712:
713: $text will optionally be linked to the same topic, allowing you to
714: link text in addition to the graphic. If you do not want to link
715: text, but wish to specify one of the later parameters, pass an
716: empty string.
717:
718: $stayOnPage is a value that will be interpreted as a boolean. If true,
719: the link will not open a new window. If false, the link will open
720: a new window using Javascript. (Default is false.)
721:
722: $width and $height are optional numerical parameters that will
723: override the width and height of the popped up window, which may
724: be useful for certain help topics with big pictures included.
1.44 bowersj2 725:
726: =cut
727:
728: sub help_open_topic {
1.48 bowersj2 729: my ($topic, $text, $stayOnPage, $width, $height) = @_;
730: $text = "" if (not defined $text);
1.44 bowersj2 731: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 732: if ($env{'browser.interface'} eq 'textual') {
1.79 www 733: $stayOnPage=1;
734: }
1.44 bowersj2 735: $width = 350 if (not defined $width);
736: $height = 400 if (not defined $height);
737: my $filename = $topic;
738: $filename =~ s/ /_/g;
739:
1.48 bowersj2 740: my $template = "";
741: my $link;
1.572 banghart 742:
1.159 www 743: $topic=~s/\W/\_/g;
1.44 bowersj2 744:
1.572 banghart 745: if (!$stayOnPage) {
1.72 bowersj2 746: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572 banghart 747: } else {
1.48 bowersj2 748: $link = "/adm/help/${filename}.hlp";
749: }
750:
751: # Add the text
1.572 banghart 752: if ($text ne "") {
1.77 www 753: $template .=
1.572 banghart 754: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
755: "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 756: }
757:
758: # Add the graphic
1.179 matthew 759: my $title = &mt('Online Help');
1.215 albertel 760: my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
1.48 bowersj2 761: $template .= <<"ENDTEMPLATE";
1.436 albertel 762: <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
1.44 bowersj2 763: ENDTEMPLATE
1.78 www 764: if ($text ne '') { $template.='</td></tr></table>' };
1.44 bowersj2 765: return $template;
766:
1.106 bowersj2 767: }
768:
769: # This is a quicky function for Latex cheatsheet editing, since it
770: # appears in at least four places
771: sub helpLatexCheatsheet {
772: my $other = shift;
773: my $addOther = '';
774: if ($other) {
775: $addOther = Apache::loncommon::help_open_topic($other, shift,
776: undef, undef, 600) .
777: '</td><td>';
778: }
779: return '<table><tr><td>'.
780: $addOther .
781: &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',
782: undef,undef,600)
783: .'</td><td>'.
784: &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',
785: undef,undef,600)
786: .'</td></tr></table>';
1.172 www 787: }
788:
1.430 albertel 789: sub general_help {
790: my $helptopic='Student_Intro';
791: if ($env{'request.role'}=~/^(ca|au)/) {
792: $helptopic='Authoring_Intro';
793: } elsif ($env{'request.role'}=~/^cc/) {
794: $helptopic='Course_Coordination_Intro';
795: }
796: return $helptopic;
797: }
798:
799: sub update_help_link {
800: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
801: my $origurl = $ENV{'REQUEST_URI'};
802: $origurl=~s|^/~|/priv/|;
803: my $timestamp = time;
804: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
805: $$datum = &escape($$datum);
806: }
807:
808: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
809: my $output .= <<"ENDOUTPUT";
810: <script type="text/javascript">
811: banner_link = '$banner_link';
812: </script>
813: ENDOUTPUT
814: return $output;
815: }
816:
817: # now just updates the help link and generates a blue icon
1.193 raeburn 818: sub help_open_menu {
1.430 albertel 819: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 820: = @_;
1.430 albertel 821: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 822: # only use pop-up help (stayOnPage == 0)
1.552 banghart 823: # if environment.remote is on (using remote control UI)
1.572 banghart 824: if ($env{'browser.interface'} eq 'textual' ||
825: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 826: $stayOnPage=1;
1.430 albertel 827: }
828: my $output;
829: if ($component_help) {
830: if (!$text) {
831: $output=&help_open_topic($component_help,undef,$stayOnPage,
832: $width,$height);
833: } else {
834: my $help_text;
835: $help_text=&unescape($topic);
836: $output='<table><tr><td>'.
837: &help_open_topic($component_help,$help_text,$stayOnPage,
838: $width,$height).'</td></tr></table>';
839: }
840: }
841: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
842: return $output.$banner_link;
843: }
844:
845: sub top_nav_help {
846: my ($text) = @_;
1.436 albertel 847: $text = &mt($text);
1.572 banghart 848: my $stay_on_page =
1.436 albertel 849: ($env{'browser.interface'} eq 'textual' ||
850: $env{'environment.remote'} eq 'off' );
1.572 banghart 851: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 852: : "javascript:helpMenu('open')";
1.572 banghart 853: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 854:
1.201 raeburn 855: my $title = &mt('Get help');
1.436 albertel 856:
857: return <<"END";
858: $banner_link
859: <a href="$link" title="$title">$text</a>
860: END
861: }
862:
863: sub help_menu_js {
864: my ($text) = @_;
865:
866: my $stayOnPage =
867: ($env{'browser.interface'} eq 'textual' ||
868: $env{'environment.remote'} eq 'off' );
869:
870: my $width = 620;
871: my $height = 600;
1.430 albertel 872: my $helptopic=&general_help();
873: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 874: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 875: my $start_page =
876: &Apache::loncommon::start_page('Help Menu', undef,
877: {'frameset' => 1,
878: 'js_ready' => 1,
879: 'add_entries' => {
880: 'border' => '0',
1.579 raeburn 881: 'rows' => "110,*",},});
1.331 albertel 882: my $end_page =
883: &Apache::loncommon::end_page({'frameset' => 1,
884: 'js_ready' => 1,});
885:
1.436 albertel 886: my $template .= <<"ENDTEMPLATE";
887: <script type="text/javascript">
1.253 albertel 888: // <!-- BEGIN LON-CAPA Internal
889: // <![CDATA[
1.430 albertel 890: var banner_link = '';
1.243 raeburn 891: function helpMenu(target) {
892: var caller = this;
893: if (target == 'open') {
894: var newWindow = null;
895: try {
1.262 albertel 896: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 897: }
898: catch(error) {
899: writeHelp(caller);
900: return;
901: }
902: if (newWindow) {
903: caller = newWindow;
904: }
1.193 raeburn 905: }
1.243 raeburn 906: writeHelp(caller);
907: return;
908: }
909: function writeHelp(caller) {
1.430 albertel 910: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 911: caller.document.close()
912: caller.focus()
1.193 raeburn 913: }
1.253 albertel 914: // ]]>
1.219 albertel 915: // END LON-CAPA Internal -->
1.436 albertel 916: </script>
1.193 raeburn 917: ENDTEMPLATE
918: return $template;
919: }
920:
1.172 www 921: sub help_open_bug {
922: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 923: unless ($env{'user.adv'}) { return ''; }
1.172 www 924: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
925: $text = "" if (not defined $text);
926: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 927: if ($env{'browser.interface'} eq 'textual' ||
928: $env{'environment.remote'} eq 'off' ) {
1.172 www 929: $stayOnPage=1;
930: }
1.184 albertel 931: $width = 600 if (not defined $width);
932: $height = 600 if (not defined $height);
1.172 www 933:
934: $topic=~s/\W+/\+/g;
935: my $link='';
936: my $template='';
1.379 albertel 937: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
938: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 939: if (!$stayOnPage)
940: {
941: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
942: }
943: else
944: {
945: $link = $url;
946: }
947: # Add the text
948: if ($text ne "")
949: {
950: $template .=
951: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 952: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 953: }
954:
955: # Add the graphic
1.179 matthew 956: my $title = &mt('Report a Bug');
1.215 albertel 957: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 958: $template .= <<"ENDTEMPLATE";
1.436 albertel 959: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 960: ENDTEMPLATE
961: if ($text ne '') { $template.='</td></tr></table>' };
962: return $template;
963:
964: }
965:
966: sub help_open_faq {
967: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 968: unless ($env{'user.adv'}) { return ''; }
1.172 www 969: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
970: $text = "" if (not defined $text);
971: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 972: if ($env{'browser.interface'} eq 'textual' ||
973: $env{'environment.remote'} eq 'off' ) {
1.172 www 974: $stayOnPage=1;
975: }
976: $width = 350 if (not defined $width);
977: $height = 400 if (not defined $height);
978:
979: $topic=~s/\W+/\+/g;
980: my $link='';
981: my $template='';
982: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
983: if (!$stayOnPage)
984: {
985: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
986: }
987: else
988: {
989: $link = $url;
990: }
991:
992: # Add the text
993: if ($text ne "")
994: {
995: $template .=
1.173 www 996: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 997: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 998: }
999:
1000: # Add the graphic
1.179 matthew 1001: my $title = &mt('View the FAQ');
1.215 albertel 1002: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1003: $template .= <<"ENDTEMPLATE";
1.436 albertel 1004: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1005: ENDTEMPLATE
1006: if ($text ne '') { $template.='</td></tr></table>' };
1007: return $template;
1008:
1.44 bowersj2 1009: }
1.37 matthew 1010:
1.180 matthew 1011: ###############################################################
1012: ###############################################################
1013:
1.45 matthew 1014: =pod
1015:
1.256 matthew 1016: =item * change_content_javascript():
1017:
1018: This and the next function allow you to create small sections of an
1019: otherwise static HTML page that you can update on the fly with
1020: Javascript, even in Netscape 4.
1021:
1022: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1023: must be written to the HTML page once. It will prove the Javascript
1024: function "change(name, content)". Calling the change function with the
1025: name of the section
1026: you want to update, matching the name passed to C<changable_area>, and
1027: the new content you want to put in there, will put the content into
1028: that area.
1029:
1030: B<Note>: Netscape 4 only reserves enough space for the changable area
1031: to contain room for the original contents. You need to "make space"
1032: for whatever changes you wish to make, and be B<sure> to check your
1033: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1034: it's adequate for updating a one-line status display, but little more.
1035: This script will set the space to 100% width, so you only need to
1036: worry about height in Netscape 4.
1037:
1038: Modern browsers are much less limiting, and if you can commit to the
1039: user not using Netscape 4, this feature may be used freely with
1040: pretty much any HTML.
1041:
1042: =cut
1043:
1044: sub change_content_javascript {
1045: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1046: if ($env{'browser.type'} eq 'netscape' &&
1047: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1048: return (<<NETSCAPE4);
1049: function change(name, content) {
1050: doc = document.layers[name+"___escape"].layers[0].document;
1051: doc.open();
1052: doc.write(content);
1053: doc.close();
1054: }
1055: NETSCAPE4
1056: } else {
1057: # Otherwise, we need to use semi-standards-compliant code
1058: # (technically, "innerHTML" isn't standard but the equivalent
1059: # is really scary, and every useful browser supports it
1060: return (<<DOMBASED);
1061: function change(name, content) {
1062: element = document.getElementById(name);
1063: element.innerHTML = content;
1064: }
1065: DOMBASED
1066: }
1067: }
1068:
1069: =pod
1070:
1071: =item * changable_area($name, $origContent):
1072:
1073: This provides a "changable area" that can be modified on the fly via
1074: the Javascript code provided in C<change_content_javascript>. $name is
1075: the name you will use to reference the area later; do not repeat the
1076: same name on a given HTML page more then once. $origContent is what
1077: the area will originally contain, which can be left blank.
1078:
1079: =cut
1080:
1081: sub changable_area {
1082: my ($name, $origContent) = @_;
1083:
1.258 albertel 1084: if ($env{'browser.type'} eq 'netscape' &&
1085: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1086: # If this is netscape 4, we need to use the Layer tag
1087: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1088: } else {
1089: return "<span id='$name'>$origContent</span>";
1090: }
1091: }
1092:
1093: =pod
1094:
1.590 raeburn 1095: =item * viewport_geometry_js {
1096:
1097: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1098:
1099: =cut
1100:
1101:
1102: sub viewport_geometry_js {
1103: return <<"GEOMETRY";
1104: var Geometry = {};
1105: function init_geometry() {
1106: if (Geometry.init) { return };
1107: Geometry.init=1;
1108: if (window.innerHeight) {
1109: Geometry.getViewportHeight = function() { return window.innerHeight; };
1110: Geometry.getViewportWidth = function() { return window.innerWidth; };
1111: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1112: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1113: }
1114: else if (document.documentElement && document.documentElement.clientHeight) {
1115: Geometry.getViewportHeight =
1116: function() { return document.documentElement.clientHeight; };
1117: Geometry.getViewportWidth =
1118: function() { return document.documentElement.clientWidth; };
1119:
1120: Geometry.getHorizontalScroll =
1121: function() { return document.documentElement.scrollLeft; };
1122: Geometry.getVerticalScroll =
1123: function() { return document.documentElement.scrollTop; };
1124: }
1125: else if (document.body.clientHeight) {
1126: Geometry.getViewportHeight =
1127: function() { return document.body.clientHeight; };
1128: Geometry.getViewportWidth =
1129: function() { return document.body.clientWidth; };
1130: Geometry.getHorizontalScroll =
1131: function() { return document.body.scrollLeft; };
1132: Geometry.getVerticalScroll =
1133: function() { return document.body.scrollTop; };
1134: }
1135: }
1136:
1137: GEOMETRY
1138: }
1139:
1140: =pod
1141:
1142: =item * viewport_size_js {
1143:
1144: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.
1145:
1146: =cut
1147:
1148: sub viewport_size_js {
1149: my $geometry = &viewport_geometry_js();
1150: return <<"DIMS";
1151:
1152: $geometry
1153:
1154: function getViewportDims(width,height) {
1155: init_geometry();
1156: width.value = Geometry.getViewportWidth();
1157: height.value = Geometry.getViewportHeight();
1158: return;
1159: }
1160:
1161: DIMS
1162: }
1163:
1164: =pod
1165:
1.565 albertel 1166: =item * resize_textarea_js
1167:
1168: emits the needed javascript to resize a textarea to be as big as possible
1169:
1170: creates a function resize_textrea that takes two IDs first should be
1171: the id of the element to resize, second should be the id of a div that
1172: surrounds everything that comes after the textarea, this routine needs
1173: to be attached to the <body> for the onload and onresize events.
1174:
1175:
1176: =cut
1177:
1178: sub resize_textarea_js {
1.590 raeburn 1179: my $geometry = &viewport_geometry_js();
1.565 albertel 1180: return <<"RESIZE";
1181: <script type="text/javascript">
1.590 raeburn 1182: $geometry
1.565 albertel 1183:
1.588 albertel 1184: function getX(element) {
1185: var x = 0;
1186: while (element) {
1187: x += element.offsetLeft;
1188: element = element.offsetParent;
1189: }
1190: return x;
1191: }
1192: function getY(element) {
1193: var y = 0;
1194: while (element) {
1195: y += element.offsetTop;
1196: element = element.offsetParent;
1197: }
1198: return y;
1199: }
1200:
1201:
1.565 albertel 1202: function resize_textarea(textarea_id,bottom_id) {
1203: init_geometry();
1204: var textarea = document.getElementById(textarea_id);
1205: //alert(textarea);
1206:
1.588 albertel 1207: var textarea_top = getY(textarea);
1.565 albertel 1208: var textarea_height = textarea.offsetHeight;
1209: var bottom = document.getElementById(bottom_id);
1.588 albertel 1210: var bottom_top = getY(bottom);
1.565 albertel 1211: var bottom_height = bottom.offsetHeight;
1212: var window_height = Geometry.getViewportHeight();
1.588 albertel 1213: var fudge = 23;
1.565 albertel 1214: var new_height = window_height-fudge-textarea_top-bottom_height;
1215: if (new_height < 300) {
1216: new_height = 300;
1217: }
1218: textarea.style.height=new_height+'px';
1219: }
1220: </script>
1221: RESIZE
1222:
1223: }
1224:
1225: =pod
1226:
1.256 matthew 1227: =back
1.542 raeburn 1228:
1.256 matthew 1229: =head1 Excel and CSV file utility routines
1230:
1231: =over 4
1232:
1233: =cut
1234:
1235: ###############################################################
1236: ###############################################################
1237:
1238: =pod
1239:
1.112 bowersj2 1240: =item * csv_translate($text)
1.37 matthew 1241:
1.185 www 1242: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1243: format.
1244:
1245: =cut
1246:
1.180 matthew 1247: ###############################################################
1248: ###############################################################
1.37 matthew 1249: sub csv_translate {
1250: my $text = shift;
1251: $text =~ s/\"/\"\"/g;
1.209 albertel 1252: $text =~ s/\n/ /g;
1.37 matthew 1253: return $text;
1254: }
1.180 matthew 1255:
1256: ###############################################################
1257: ###############################################################
1258:
1259: =pod
1260:
1261: =item * define_excel_formats
1262:
1263: Define some commonly used Excel cell formats.
1264:
1265: Currently supported formats:
1266:
1267: =over 4
1268:
1269: =item header
1270:
1271: =item bold
1272:
1273: =item h1
1274:
1275: =item h2
1276:
1277: =item h3
1278:
1.256 matthew 1279: =item h4
1280:
1281: =item i
1282:
1.180 matthew 1283: =item date
1284:
1285: =back
1286:
1287: Inputs: $workbook
1288:
1289: Returns: $format, a hash reference.
1290:
1291: =cut
1292:
1293: ###############################################################
1294: ###############################################################
1295: sub define_excel_formats {
1296: my ($workbook) = @_;
1297: my $format;
1298: $format->{'header'} = $workbook->add_format(bold => 1,
1299: bottom => 1,
1300: align => 'center');
1301: $format->{'bold'} = $workbook->add_format(bold=>1);
1302: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1303: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1304: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1305: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1306: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1307: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1308: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1309: return $format;
1310: }
1311:
1312: ###############################################################
1313: ###############################################################
1.113 bowersj2 1314:
1315: =pod
1316:
1.256 matthew 1317: =item * create_workbook
1.255 matthew 1318:
1319: Create an Excel worksheet. If it fails, output message on the
1320: request object and return undefs.
1321:
1322: Inputs: Apache request object
1323:
1324: Returns (undef) on failure,
1325: Excel worksheet object, scalar with filename, and formats
1326: from &Apache::loncommon::define_excel_formats on success
1327:
1328: =cut
1329:
1330: ###############################################################
1331: ###############################################################
1332: sub create_workbook {
1333: my ($r) = @_;
1334: #
1335: # Create the excel spreadsheet
1336: my $filename = '/prtspool/'.
1.258 albertel 1337: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1338: time.'_'.rand(1000000000).'.xls';
1339: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1340: if (! defined($workbook)) {
1341: $r->log_error("Error creating excel spreadsheet $filename: $!");
1342: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1343: "This error has been logged. ".
1344: "Please alert your LON-CAPA administrator").
1345: '</p>');
1346: return (undef);
1347: }
1348: #
1349: $workbook->set_tempdir('/home/httpd/perl/tmp');
1350: #
1351: my $format = &Apache::loncommon::define_excel_formats($workbook);
1352: return ($workbook,$filename,$format);
1353: }
1354:
1355: ###############################################################
1356: ###############################################################
1357:
1358: =pod
1359:
1.256 matthew 1360: =item * create_text_file
1.113 bowersj2 1361:
1.542 raeburn 1362: Create a file to write to and eventually make available to the user.
1.256 matthew 1363: If file creation fails, outputs an error message on the request object and
1364: return undefs.
1.113 bowersj2 1365:
1.256 matthew 1366: Inputs: Apache request object, and file suffix
1.113 bowersj2 1367:
1.256 matthew 1368: Returns (undef) on failure,
1369: Filehandle and filename on success.
1.113 bowersj2 1370:
1371: =cut
1372:
1.256 matthew 1373: ###############################################################
1374: ###############################################################
1375: sub create_text_file {
1376: my ($r,$suffix) = @_;
1377: if (! defined($suffix)) { $suffix = 'txt'; };
1378: my $fh;
1379: my $filename = '/prtspool/'.
1.258 albertel 1380: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1381: time.'_'.rand(1000000000).'.'.$suffix;
1382: $fh = Apache::File->new('>/home/httpd'.$filename);
1383: if (! defined($fh)) {
1384: $r->log_error("Couldn't open $filename for output $!");
1385: $r->print("Problems occured in creating the output file. ".
1386: "This error has been logged. ".
1387: "Please alert your LON-CAPA administrator.");
1.113 bowersj2 1388: }
1.256 matthew 1389: return ($fh,$filename)
1.113 bowersj2 1390: }
1391:
1392:
1.256 matthew 1393: =pod
1.113 bowersj2 1394:
1395: =back
1396:
1397: =cut
1.37 matthew 1398:
1399: ###############################################################
1.33 matthew 1400: ## Home server <option> list generating code ##
1401: ###############################################################
1.35 matthew 1402:
1.169 www 1403: # ------------------------------------------
1404:
1405: sub domain_select {
1406: my ($name,$value,$multiple)=@_;
1407: my %domains=map {
1.514 albertel 1408: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1409: } &Apache::lonnet::all_domains();
1.169 www 1410: if ($multiple) {
1411: $domains{''}=&mt('Any domain');
1.550 albertel 1412: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1413: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1414: } else {
1.550 albertel 1415: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1416: return &select_form($name,$value,%domains);
1417: }
1418: }
1419:
1.282 albertel 1420: #-------------------------------------------
1421:
1422: =pod
1423:
1.519 raeburn 1424: =head1 Routines for form select boxes
1425:
1426: =over 4
1427:
1.287 albertel 1428: =item * multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1429:
1430: Returns a string containing a <select> element int multiple mode
1431:
1432:
1433: Args:
1434: $name - name of the <select> element
1.506 raeburn 1435: $value - scalar or array ref of values that should already be selected
1.282 albertel 1436: $size - number of rows long the select element is
1.283 albertel 1437: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1438: (shown text should already have been &mt())
1.506 raeburn 1439: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1440:
1.282 albertel 1441: =cut
1442:
1443: #-------------------------------------------
1.169 www 1444: sub multiple_select_form {
1.284 albertel 1445: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1446: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1447: my $output='';
1.191 matthew 1448: if (! defined($size)) {
1449: $size = 4;
1.283 albertel 1450: if (scalar(keys(%$hash))<4) {
1451: $size = scalar(keys(%$hash));
1.191 matthew 1452: }
1453: }
1.169 www 1454: $output.="\n<select name='$name' size='$size' multiple='1'>";
1.501 banghart 1455: my @order;
1.506 raeburn 1456: if (ref($order) eq 'ARRAY') {
1457: @order = @{$order};
1458: } else {
1459: @order = sort(keys(%$hash));
1.501 banghart 1460: }
1461: if (exists($$hash{'select_form_order'})) {
1462: @order = @{$$hash{'select_form_order'}};
1463: }
1464:
1.284 albertel 1465: foreach my $key (@order) {
1.356 albertel 1466: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1467: $output.='selected="selected" ' if ($selected{$key});
1468: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1469: }
1470: $output.="</select>\n";
1471: return $output;
1472: }
1473:
1.88 www 1474: #-------------------------------------------
1475:
1476: =pod
1477:
1.112 bowersj2 1478: =item * select_form($defdom,$name,%hash)
1.88 www 1479:
1480: Returns a string containing a <select name='$name' size='1'> form to
1481: allow a user to select options from a hash option_name => displayed text.
1482: See lonrights.pm for an example invocation and use.
1483:
1484: =cut
1485:
1486: #-------------------------------------------
1487: sub select_form {
1488: my ($def,$name,%hash) = @_;
1489: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1490: my @keys;
1491: if (exists($hash{'select_form_order'})) {
1492: @keys=@{$hash{'select_form_order'}};
1493: } else {
1494: @keys=sort(keys(%hash));
1495: }
1.356 albertel 1496: foreach my $key (@keys) {
1497: $selectform.=
1498: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1499: ($key eq $def ? 'selected="selected" ' : '').
1500: ">".&mt($hash{$key})."</option>\n";
1.88 www 1501: }
1502: $selectform.="</select>";
1503: return $selectform;
1504: }
1505:
1.475 www 1506: # For display filters
1507:
1508: sub display_filter {
1509: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1510: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.475 www 1511: return '<nobr><label>'.&mt('Records [_1]',
1512: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1513: (&mt('all'),10,20,50,100,1000,10000))).
1.478 www 1514: '</label></nobr> <nobr>'.
1.475 www 1515: &mt('Filter [_1]',
1.477 www 1516: &select_form($env{'form.displayfilter'},
1517: 'displayfilter',
1518: ('currentfolder' => 'Current folder/page',
1519: 'containing' => 'Containing phrase',
1520: 'none' => 'None'))).
1.478 www 1521: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
1.475 www 1522: }
1523:
1.167 www 1524: sub gradeleveldescription {
1525: my $gradelevel=shift;
1526: my %gradelevels=(0 => 'Not specified',
1527: 1 => 'Grade 1',
1528: 2 => 'Grade 2',
1529: 3 => 'Grade 3',
1530: 4 => 'Grade 4',
1531: 5 => 'Grade 5',
1532: 6 => 'Grade 6',
1533: 7 => 'Grade 7',
1534: 8 => 'Grade 8',
1535: 9 => 'Grade 9',
1536: 10 => 'Grade 10',
1537: 11 => 'Grade 11',
1538: 12 => 'Grade 12',
1539: 13 => 'Grade 13',
1540: 14 => '100 Level',
1541: 15 => '200 Level',
1542: 16 => '300 Level',
1543: 17 => '400 Level',
1544: 18 => 'Graduate Level');
1545: return &mt($gradelevels{$gradelevel});
1546: }
1547:
1.163 www 1548: sub select_level_form {
1549: my ($deflevel,$name)=@_;
1550: unless ($deflevel) { $deflevel=0; }
1.167 www 1551: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1552: for (my $i=0; $i<=18; $i++) {
1553: $selectform.="<option value=\"$i\" ".
1.253 albertel 1554: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1555: ">".&gradeleveldescription($i)."</option>\n";
1556: }
1557: $selectform.="</select>";
1558: return $selectform;
1.163 www 1559: }
1.167 www 1560:
1.35 matthew 1561: #-------------------------------------------
1562:
1.45 matthew 1563: =pod
1564:
1.563 raeburn 1565: =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
1.35 matthew 1566:
1567: Returns a string containing a <select name='$name' size='1'> form to
1568: allow a user to select the domain to preform an operation in.
1569: See loncreateuser.pm for an example invocation and use.
1570:
1.90 www 1571: If the $includeempty flag is set, it also includes an empty choice ("no domain
1572: selected");
1573:
1.563 raeburn 1574: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1575:
1.35 matthew 1576: =cut
1577:
1578: #-------------------------------------------
1.34 matthew 1579: sub select_dom_form {
1.563 raeburn 1580: my ($defdom,$name,$includeempty,$showdomdesc) = @_;
1.550 albertel 1581: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1582: if ($includeempty) { @domains=('',@domains); }
1.34 matthew 1583: my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
1.356 albertel 1584: foreach my $dom (@domains) {
1585: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1586: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1587: if ($showdomdesc) {
1588: if ($dom ne '') {
1589: my $domdesc = &Apache::lonnet::domain($dom,'description');
1590: if ($domdesc ne '') {
1591: $selectdomain .= ' ('.$domdesc.')';
1592: }
1593: }
1594: }
1595: $selectdomain .= "</option>\n";
1.34 matthew 1596: }
1597: $selectdomain.="</select>";
1598: return $selectdomain;
1599: }
1600:
1.35 matthew 1601: #-------------------------------------------
1602:
1.45 matthew 1603: =pod
1604:
1.586 raeburn 1605: =item * home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1606:
1.586 raeburn 1607: input: 4 arguments (two required, two optional) -
1608: $domain - domain of new user
1609: $name - name of form element
1610: $default - Value of 'default' causes a default item to be first
1611: option, and selected by default.
1612: $hide - Value of 'hide' causes hiding of the name of the server,
1613: if 1 server found, or default, if 0 found.
1.594 raeburn 1614: output: returns 2 items:
1.586 raeburn 1615: (a) form element which contains either:
1616: (i) <select name="$name">
1617: <option value="$hostid1">$hostid $servers{$hostid}</option>
1618: <option value="$hostid2">$hostid $servers{$hostid}</option>
1619: </select>
1620: form item if there are multiple library servers in $domain, or
1621: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1622: if there is only one library server in $domain.
1623:
1624: (b) number of library servers found.
1625:
1626: See loncreateuser.pm for example of use.
1.35 matthew 1627:
1628: =cut
1629:
1630: #-------------------------------------------
1.586 raeburn 1631: sub home_server_form_item {
1632: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1633: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1634: my $result;
1635: my $numlib = keys(%servers);
1636: if ($numlib > 1) {
1637: $result .= '<select name="'.$name.'" />'."\n";
1638: if ($default) {
1639: $result .= '<option value="default" selected>'.&mt('default').
1640: '</option>'."\n";
1641: }
1642: foreach my $hostid (sort(keys(%servers))) {
1643: $result.= '<option value="'.$hostid.'">'.
1644: $hostid.' '.$servers{$hostid}."</option>\n";
1645: }
1646: $result .= '</select>'."\n";
1647: } elsif ($numlib == 1) {
1648: my $hostid;
1649: foreach my $item (keys(%servers)) {
1650: $hostid = $item;
1651: }
1652: $result .= '<input type="hidden" name="'.$name.'" value="'.
1653: $hostid.'" />';
1654: if (!$hide) {
1655: $result .= $hostid.' '.$servers{$hostid};
1656: }
1657: $result .= "\n";
1658: } elsif ($default) {
1659: $result .= '<input type="hidden" name="'.$name.
1660: '" value="default" />';
1661: if (!$hide) {
1662: $result .= &mt('default');
1663: }
1664: $result .= "\n";
1.33 matthew 1665: }
1.586 raeburn 1666: return ($result,$numlib);
1.33 matthew 1667: }
1.112 bowersj2 1668:
1669: =pod
1670:
1.534 albertel 1671: =back
1672:
1.112 bowersj2 1673: =cut
1.87 matthew 1674:
1675: ###############################################################
1.112 bowersj2 1676: ## Decoding User Agent ##
1.87 matthew 1677: ###############################################################
1678:
1679: =pod
1680:
1.112 bowersj2 1681: =head1 Decoding the User Agent
1682:
1683: =over 4
1684:
1685: =item * &decode_user_agent()
1.87 matthew 1686:
1687: Inputs: $r
1688:
1689: Outputs:
1690:
1691: =over 4
1692:
1.112 bowersj2 1693: =item * $httpbrowser
1.87 matthew 1694:
1.112 bowersj2 1695: =item * $clientbrowser
1.87 matthew 1696:
1.112 bowersj2 1697: =item * $clientversion
1.87 matthew 1698:
1.112 bowersj2 1699: =item * $clientmathml
1.87 matthew 1700:
1.112 bowersj2 1701: =item * $clientunicode
1.87 matthew 1702:
1.112 bowersj2 1703: =item * $clientos
1.87 matthew 1704:
1705: =back
1706:
1.157 matthew 1707: =back
1708:
1.87 matthew 1709: =cut
1710:
1711: ###############################################################
1712: ###############################################################
1713: sub decode_user_agent {
1.247 albertel 1714: my ($r)=@_;
1.87 matthew 1715: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
1716: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
1717: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 1718: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 1719: my $clientbrowser='unknown';
1720: my $clientversion='0';
1721: my $clientmathml='';
1722: my $clientunicode='0';
1723: for (my $i=0;$i<=$#browsertype;$i++) {
1724: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
1725: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
1726: $clientbrowser=$bname;
1727: $httpbrowser=~/$vreg/i;
1728: $clientversion=$1;
1729: $clientmathml=($clientversion>=$minv);
1730: $clientunicode=($clientversion>=$univ);
1731: }
1732: }
1733: my $clientos='unknown';
1734: if (($httpbrowser=~/linux/i) ||
1735: ($httpbrowser=~/unix/i) ||
1736: ($httpbrowser=~/ux/i) ||
1737: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
1738: if (($httpbrowser=~/vax/i) ||
1739: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
1740: if ($httpbrowser=~/next/i) { $clientos='next'; }
1741: if (($httpbrowser=~/mac/i) ||
1742: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1743: if ($httpbrowser=~/win/i) { $clientos='win'; }
1744: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1745: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1746: $clientunicode,$clientos,);
1747: }
1748:
1.32 matthew 1749: ###############################################################
1750: ## Authentication changing form generation subroutines ##
1751: ###############################################################
1752: ##
1753: ## All of the authform_xxxxxxx subroutines take their inputs in a
1754: ## hash, and have reasonable default values.
1755: ##
1756: ## formname = the name given in the <form> tag.
1.35 matthew 1757: #-------------------------------------------
1758:
1.45 matthew 1759: =pod
1760:
1.112 bowersj2 1761: =head1 Authentication Routines
1762:
1763: =over 4
1764:
1765: =item * authform_xxxxxx
1.35 matthew 1766:
1767: The authform_xxxxxx subroutines provide javascript and html forms which
1768: handle some of the conveniences required for authentication forms.
1769: This is not an optimal method, but it works.
1770:
1771: See loncreateuser.pm for invocation and use examples.
1772:
1773: =over 4
1774:
1.112 bowersj2 1775: =item * authform_header
1.35 matthew 1776:
1.112 bowersj2 1777: =item * authform_authorwarning
1.35 matthew 1778:
1.112 bowersj2 1779: =item * authform_nochange
1.35 matthew 1780:
1.112 bowersj2 1781: =item * authform_kerberos
1.35 matthew 1782:
1.112 bowersj2 1783: =item * authform_internal
1.35 matthew 1784:
1.112 bowersj2 1785: =item * authform_filesystem
1.35 matthew 1786:
1787: =back
1788:
1.157 matthew 1789: =back
1790:
1.35 matthew 1791: =cut
1792:
1793: #-------------------------------------------
1.32 matthew 1794: sub authform_header{
1795: my %in = (
1796: formname => 'cu',
1.80 albertel 1797: kerb_def_dom => '',
1.32 matthew 1798: @_,
1799: );
1800: $in{'formname'} = 'document.' . $in{'formname'};
1801: my $result='';
1.80 albertel 1802:
1803: #---------------------------------------------- Code for upper case translation
1804: my $Javascript_toUpperCase;
1805: unless ($in{kerb_def_dom}) {
1806: $Javascript_toUpperCase =<<"END";
1807: switch (choice) {
1808: case 'krb': currentform.elements[choicearg].value =
1809: currentform.elements[choicearg].value.toUpperCase();
1810: break;
1811: default:
1812: }
1813: END
1814: } else {
1815: $Javascript_toUpperCase = "";
1816: }
1817:
1.165 raeburn 1818: my $radioval = "'nochange'";
1.591 raeburn 1819: if (defined($in{'curr_authtype'})) {
1820: if ($in{'curr_authtype'} ne '') {
1821: $radioval = "'".$in{'curr_authtype'}."arg'";
1822: }
1.174 matthew 1823: }
1.165 raeburn 1824: my $argfield = 'null';
1.591 raeburn 1825: if (defined($in{'mode'})) {
1.165 raeburn 1826: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 1827: if (defined($in{'curr_autharg'})) {
1828: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 1829: $argfield = "'$in{'curr_autharg'}'";
1830: }
1831: }
1832: }
1833: }
1834:
1.32 matthew 1835: $result.=<<"END";
1836: var current = new Object();
1.165 raeburn 1837: current.radiovalue = $radioval;
1838: current.argfield = $argfield;
1.32 matthew 1839:
1840: function changed_radio(choice,currentform) {
1841: var choicearg = choice + 'arg';
1842: // If a radio button in changed, we need to change the argfield
1843: if (current.radiovalue != choice) {
1844: current.radiovalue = choice;
1845: if (current.argfield != null) {
1846: currentform.elements[current.argfield].value = '';
1847: }
1848: if (choice == 'nochange') {
1849: current.argfield = null;
1850: } else {
1851: current.argfield = choicearg;
1852: switch(choice) {
1853: case 'krb':
1854: currentform.elements[current.argfield].value =
1855: "$in{'kerb_def_dom'}";
1856: break;
1857: default:
1858: break;
1859: }
1860: }
1861: }
1862: return;
1863: }
1.22 www 1864:
1.32 matthew 1865: function changed_text(choice,currentform) {
1866: var choicearg = choice + 'arg';
1867: if (currentform.elements[choicearg].value !='') {
1.80 albertel 1868: $Javascript_toUpperCase
1.32 matthew 1869: // clear old field
1870: if ((current.argfield != choicearg) && (current.argfield != null)) {
1871: currentform.elements[current.argfield].value = '';
1872: }
1873: current.argfield = choicearg;
1874: }
1875: set_auth_radio_buttons(choice,currentform);
1876: return;
1.20 www 1877: }
1.32 matthew 1878:
1879: function set_auth_radio_buttons(newvalue,currentform) {
1880: var i=0;
1881: while (i < currentform.login.length) {
1882: if (currentform.login[i].value == newvalue) { break; }
1883: i++;
1884: }
1885: if (i == currentform.login.length) {
1886: return;
1887: }
1888: current.radiovalue = newvalue;
1889: currentform.login[i].checked = true;
1890: return;
1891: }
1892: END
1893: return $result;
1894: }
1895:
1896: sub authform_authorwarning{
1897: my $result='';
1.144 matthew 1898: $result='<i>'.
1899: &mt('As a general rule, only authors or co-authors should be '.
1900: 'filesystem authenticated '.
1901: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 1902: return $result;
1903: }
1904:
1905: sub authform_nochange{
1906: my %in = (
1907: formname => 'document.cu',
1908: kerb_def_dom => 'MSU.EDU',
1909: @_,
1910: );
1.586 raeburn 1911: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1912: my $result;
1913: if (keys(%can_assign) == 0) {
1914: $result = &mt('Under you current role you are not permitted to change login settings for this user');
1915: } else {
1916: $result = '<label>'.&mt('[_1] Do not change login data',
1917: '<input type="radio" name="login" value="nochange" '.
1918: 'checked="checked" onclick="'.
1.281 albertel 1919: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
1920: '</label>';
1.586 raeburn 1921: }
1.32 matthew 1922: return $result;
1923: }
1924:
1.591 raeburn 1925: sub authform_kerberos {
1.32 matthew 1926: my %in = (
1927: formname => 'document.cu',
1928: kerb_def_dom => 'MSU.EDU',
1.80 albertel 1929: kerb_def_auth => 'krb4',
1.32 matthew 1930: @_,
1931: );
1.586 raeburn 1932: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1933: $autharg,$jscall);
1934: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 1935: if ($in{'kerb_def_auth'} eq 'krb5') {
1.586 raeburn 1936: $check5 = ' checked="on"';
1.80 albertel 1937: } else {
1.586 raeburn 1938: $check4 = ' checked="on"';
1.80 albertel 1939: }
1.165 raeburn 1940: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 1941: if (defined($in{'curr_authtype'})) {
1942: if ($in{'curr_authtype'} eq 'krb') {
1.586 raeburn 1943: $krbcheck = ' checked="on"';
1.591 raeburn 1944: if (defined($in{'curr_kerb_ver'})) {
1945: if ($in{'curr_krb_ver'} eq '5') {
1946: $check5 = ' checked="on"';
1947: $check4 = '';
1948: } else {
1949: $check4 = ' checked="on"';
1950: $check5 = '';
1951: }
1.586 raeburn 1952: }
1.591 raeburn 1953: if (defined($in{'curr_autharg'})) {
1.165 raeburn 1954: $krbarg = $in{'curr_autharg'};
1955: }
1.586 raeburn 1956: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 1957: if (defined($in{'curr_autharg'})) {
1.586 raeburn 1958: $result =
1959: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
1960: $in{'curr_autharg'},$krbver);
1961: } else {
1962: $result =
1963: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
1964: }
1965: return $result;
1966: }
1967: }
1968: } else {
1969: if ($authnum == 1) {
1970: $authtype = '<input type="hidden" name="login" value="krb">';
1.165 raeburn 1971: }
1972: }
1.586 raeburn 1973: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1974: return;
1.587 raeburn 1975: } elsif ($authtype eq '') {
1.591 raeburn 1976: if (defined($in{'mode'})) {
1.587 raeburn 1977: if ($in{'mode'} eq 'modifycourse') {
1978: if ($authnum == 1) {
1979: $authtype = '<input type="hidden" name="login" value="krb">';
1980: }
1981: }
1982: }
1.586 raeburn 1983: }
1984: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
1985: if ($authtype eq '') {
1986: $authtype = '<input type="radio" name="login" value="krb" '.
1987: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1988: $krbcheck.' />';
1989: }
1990: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1991: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1992: $in{'curr_authtype'} eq 'krb5') ||
1993: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1994: $in{'curr_authtype'} eq 'krb4')) {
1995: $result .= &mt
1.144 matthew 1996: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 1997: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 1998: '<label>'.$authtype,
1.281 albertel 1999: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2000: 'value="'.$krbarg.'" '.
1.144 matthew 2001: 'onchange="'.$jscall.'" />',
1.281 albertel 2002: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2003: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2004: '</label>');
1.586 raeburn 2005: } elsif ($can_assign{'krb4'}) {
2006: $result .= &mt
2007: ('[_1] Kerberos authenticated with domain [_2] '.
2008: '[_3] Version 4 [_4]',
2009: '<label>'.$authtype,
2010: '</label><input type="text" size="10" name="krbarg" '.
2011: 'value="'.$krbarg.'" '.
2012: 'onchange="'.$jscall.'" />',
2013: '<label><input type="hidden" name="krbver" value="4" />',
2014: '</label>');
2015: } elsif ($can_assign{'krb5'}) {
2016: $result .= &mt
2017: ('[_1] Kerberos authenticated with domain [_2] '.
2018: '[_3] Version 5 [_4]',
2019: '<label>'.$authtype,
2020: '</label><input type="text" size="10" name="krbarg" '.
2021: 'value="'.$krbarg.'" '.
2022: 'onchange="'.$jscall.'" />',
2023: '<label><input type="hidden" name="krbver" value="5" />',
2024: '</label>');
2025: }
1.32 matthew 2026: return $result;
2027: }
2028:
2029: sub authform_internal{
1.586 raeburn 2030: my %in = (
1.32 matthew 2031: formname => 'document.cu',
2032: kerb_def_dom => 'MSU.EDU',
2033: @_,
2034: );
1.586 raeburn 2035: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2036: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2037: if (defined($in{'curr_authtype'})) {
2038: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2039: if ($can_assign{'int'}) {
2040: $intcheck = 'checked="on" ';
1.591 raeburn 2041: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2042: $intarg = $in{'curr_autharg'};
2043: }
2044: } else {
2045: $result = &mt('Currently internally authenticated.');
2046: return $result;
1.165 raeburn 2047: }
2048: }
1.586 raeburn 2049: } else {
2050: if ($authnum == 1) {
2051: $authtype = '<input type="hidden" name="login" value="int">';
2052: }
2053: }
2054: if (!$can_assign{'int'}) {
2055: return;
1.587 raeburn 2056: } elsif ($authtype eq '') {
1.591 raeburn 2057: if (defined($in{'mode'})) {
1.587 raeburn 2058: if ($in{'mode'} eq 'modifycourse') {
2059: if ($authnum == 1) {
2060: $authtype = '<input type="hidden" name="login" value="int">';
2061: }
2062: }
2063: }
1.165 raeburn 2064: }
1.586 raeburn 2065: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2066: if ($authtype eq '') {
2067: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2068: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2069: }
1.605 bisitz 2070: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2071: $intarg.'" onchange="'.$jscall.'" />';
2072: $result = &mt
1.144 matthew 2073: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2074: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2075: return $result;
2076: }
2077:
2078: sub authform_local{
2079: my %in = (
2080: formname => 'document.cu',
2081: kerb_def_dom => 'MSU.EDU',
2082: @_,
2083: );
1.586 raeburn 2084: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2085: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2086: if (defined($in{'curr_authtype'})) {
2087: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2088: if ($can_assign{'loc'}) {
2089: $loccheck = 'checked="on" ';
1.591 raeburn 2090: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2091: $locarg = $in{'curr_autharg'};
2092: }
2093: } else {
2094: $result = &mt('Currently using local (institutional) authentication.');
2095: return $result;
1.165 raeburn 2096: }
2097: }
1.586 raeburn 2098: } else {
2099: if ($authnum == 1) {
2100: $authtype = '<input type="hidden" name="login" value="loc">';
2101: }
2102: }
2103: if (!$can_assign{'loc'}) {
2104: return;
1.587 raeburn 2105: } elsif ($authtype eq '') {
1.591 raeburn 2106: if (defined($in{'mode'})) {
1.587 raeburn 2107: if ($in{'mode'} eq 'modifycourse') {
2108: if ($authnum == 1) {
2109: $authtype = '<input type="hidden" name="login" value="loc">';
2110: }
2111: }
2112: }
1.165 raeburn 2113: }
1.586 raeburn 2114: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2115: if ($authtype eq '') {
2116: $authtype = '<input type="radio" name="login" value="loc" '.
2117: $loccheck.' onchange="'.$jscall.'" onclick="'.
2118: $jscall.'" />';
2119: }
2120: $autharg = '<input type="text" size="10" name="locarg" value="'.
2121: $locarg.'" onchange="'.$jscall.'" />';
2122: $result = &mt('[_1] Local Authentication with argument [_2]',
2123: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2124: return $result;
2125: }
2126:
2127: sub authform_filesystem{
2128: my %in = (
2129: formname => 'document.cu',
2130: kerb_def_dom => 'MSU.EDU',
2131: @_,
2132: );
1.586 raeburn 2133: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2134: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2135: if (defined($in{'curr_authtype'})) {
2136: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2137: if ($can_assign{'fsys'}) {
2138: $fsyscheck = 'checked="on" ';
2139: } else {
2140: $result = &mt('Currently Filesystem Authenticated.');
2141: return $result;
2142: }
2143: }
2144: } else {
2145: if ($authnum == 1) {
2146: $authtype = '<input type="hidden" name="login" value="fsys">';
2147: }
2148: }
2149: if (!$can_assign{'fsys'}) {
2150: return;
1.587 raeburn 2151: } elsif ($authtype eq '') {
1.591 raeburn 2152: if (defined($in{'mode'})) {
1.587 raeburn 2153: if ($in{'mode'} eq 'modifycourse') {
2154: if ($authnum == 1) {
2155: $authtype = '<input type="hidden" name="login" value="fsys">';
2156: }
2157: }
2158: }
1.586 raeburn 2159: }
2160: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2161: if ($authtype eq '') {
2162: $authtype = '<input type="radio" name="login" value="fsys" '.
2163: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2164: $jscall.'" />';
2165: }
2166: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2167: ' onchange="'.$jscall.'" />';
2168: $result = &mt
1.144 matthew 2169: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2170: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2171: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2172: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2173: 'onchange="'.$jscall.'" />');
1.32 matthew 2174: return $result;
2175: }
2176:
1.586 raeburn 2177: sub get_assignable_auth {
2178: my ($dom) = @_;
2179: if ($dom eq '') {
2180: $dom = $env{'request.role.domain'};
2181: }
2182: my %can_assign = (
2183: krb4 => 1,
2184: krb5 => 1,
2185: int => 1,
2186: loc => 1,
2187: );
2188: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2189: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2190: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2191: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2192: my $context;
2193: if ($env{'request.role'} =~ /^au/) {
2194: $context = 'author';
2195: } elsif ($env{'request.role'} =~ /^dc/) {
2196: $context = 'domain';
2197: } elsif ($env{'request.course.id'}) {
2198: $context = 'course';
2199: }
2200: if ($context) {
2201: if (ref($authhash->{$context}) eq 'HASH') {
2202: %can_assign = %{$authhash->{$context}};
2203: }
2204: }
2205: }
2206: }
2207: my $authnum = 0;
2208: foreach my $key (keys(%can_assign)) {
2209: if ($can_assign{$key}) {
2210: $authnum ++;
2211: }
2212: }
2213: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2214: $authnum --;
2215: }
2216: return ($authnum,%can_assign);
2217: }
2218:
1.80 albertel 2219: ###############################################################
2220: ## Get Authentication Defaults for Domain ##
2221: ###############################################################
2222:
2223: =pod
2224:
1.112 bowersj2 2225: =head1 Domains and Authentication
2226:
2227: Returns default authentication type and an associated argument as
2228: listed in file 'domain.tab'.
2229:
2230: =over 4
2231:
2232: =item * get_auth_defaults
1.80 albertel 2233:
2234: get_auth_defaults($target_domain) returns the default authentication
2235: type and an associated argument (initial password or a kerberos domain).
2236: These values are stored in lonTabs/domain.tab
2237:
2238: ($def_auth, $def_arg) = &get_auth_defaults($target_domain);
2239:
2240: If target_domain is not found in domain.tab, returns nothing ('').
2241:
2242: =cut
2243:
2244: #-------------------------------------------
2245: sub get_auth_defaults {
2246: my $domain=shift;
1.514 albertel 2247: return (&Apache::lonnet::domain($domain,'auth_def'),
2248: &Apache::lonnet::domain($domain,'auth_arg_def'));
2249:
1.80 albertel 2250: }
2251: ###############################################################
2252: ## End Get Authentication Defaults for Domain ##
2253: ###############################################################
2254:
2255: ###############################################################
2256: ## Get Kerberos Defaults for Domain ##
2257: ###############################################################
2258: ##
2259: ## Returns default kerberos version and an associated argument
2260: ## as listed in file domain.tab. If not listed, provides
2261: ## appropriate default domain and kerberos version.
2262: ##
2263: #-------------------------------------------
2264:
2265: =pod
2266:
1.112 bowersj2 2267: =item * get_kerberos_defaults
1.80 albertel 2268:
2269: get_kerberos_defaults($target_domain) returns the default kerberos
2270: version and domain. If not found in domain.tabs, it defaults to
2271: version 4 and the domain of the server.
2272:
2273: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2274:
2275: =cut
2276:
2277: #-------------------------------------------
2278: sub get_kerberos_defaults {
2279: my $domain=shift;
2280: my ($krbdef,$krbdefdom) =
2281: &Apache::loncommon::get_auth_defaults($domain);
2282: unless ($krbdef =~/^krb/ && $krbdefdom) {
2283: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2284: my $krbdefdom=$1;
2285: $krbdefdom=~tr/a-z/A-Z/;
2286: $krbdef = "krb4";
2287: }
2288: return ($krbdef,$krbdefdom);
2289: }
1.112 bowersj2 2290:
2291: =pod
2292:
2293: =back
2294:
2295: =cut
1.32 matthew 2296:
1.46 matthew 2297: ###############################################################
2298: ## Thesaurus Functions ##
2299: ###############################################################
1.20 www 2300:
1.46 matthew 2301: =pod
1.20 www 2302:
1.112 bowersj2 2303: =head1 Thesaurus Functions
2304:
2305: =over 4
2306:
2307: =item * initialize_keywords
1.46 matthew 2308:
2309: Initializes the package variable %Keywords if it is empty. Uses the
2310: package variable $thesaurus_db_file.
2311:
2312: =cut
2313:
2314: ###################################################
2315:
2316: sub initialize_keywords {
2317: return 1 if (scalar keys(%Keywords));
2318: # If we are here, %Keywords is empty, so fill it up
2319: # Make sure the file we need exists...
2320: if (! -e $thesaurus_db_file) {
2321: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2322: " failed because it does not exist");
2323: return 0;
2324: }
2325: # Set up the hash as a database
2326: my %thesaurus_db;
2327: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2328: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2329: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2330: $thesaurus_db_file);
2331: return 0;
2332: }
2333: # Get the average number of appearances of a word.
2334: my $avecount = $thesaurus_db{'average.count'};
2335: # Put keywords (those that appear > average) into %Keywords
2336: while (my ($word,$data)=each (%thesaurus_db)) {
2337: my ($count,undef) = split /:/,$data;
2338: $Keywords{$word}++ if ($count > $avecount);
2339: }
2340: untie %thesaurus_db;
2341: # Remove special values from %Keywords.
1.356 albertel 2342: foreach my $value ('total.count','average.count') {
2343: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2344: }
1.46 matthew 2345: return 1;
2346: }
2347:
2348: ###################################################
2349:
2350: =pod
2351:
1.112 bowersj2 2352: =item * keyword($word)
1.46 matthew 2353:
2354: Returns true if $word is a keyword. A keyword is a word that appears more
2355: than the average number of times in the thesaurus database. Calls
2356: &initialize_keywords
2357:
2358: =cut
2359:
2360: ###################################################
1.20 www 2361:
2362: sub keyword {
1.46 matthew 2363: return if (!&initialize_keywords());
2364: my $word=lc(shift());
2365: $word=~s/\W//g;
2366: return exists($Keywords{$word});
1.20 www 2367: }
1.46 matthew 2368:
2369: ###############################################################
2370:
2371: =pod
1.20 www 2372:
1.112 bowersj2 2373: =item * get_related_words
1.46 matthew 2374:
1.160 matthew 2375: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2376: an array of words. If the keyword is not in the thesaurus, an empty array
2377: will be returned. The order of the words returned is determined by the
2378: database which holds them.
2379:
2380: Uses global $thesaurus_db_file.
2381:
2382: =cut
2383:
2384: ###############################################################
2385: sub get_related_words {
2386: my $keyword = shift;
2387: my %thesaurus_db;
2388: if (! -e $thesaurus_db_file) {
2389: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2390: "failed because the file does not exist");
2391: return ();
2392: }
2393: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2394: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2395: return ();
2396: }
2397: my @Words=();
1.429 www 2398: my $count=0;
1.46 matthew 2399: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2400: # The first element is the number of times
2401: # the word appears. We do not need it now.
1.429 www 2402: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2403: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2404: my $threshold=$mostfrequentcount/10;
2405: foreach my $possibleword (@RelatedWords) {
2406: my ($word,$wordcount)=split(/\,/,$possibleword);
2407: if ($wordcount>$threshold) {
2408: push(@Words,$word);
2409: $count++;
2410: if ($count>10) { last; }
2411: }
1.20 www 2412: }
2413: }
1.46 matthew 2414: untie %thesaurus_db;
2415: return @Words;
1.14 harris41 2416: }
1.46 matthew 2417:
1.112 bowersj2 2418: =pod
2419:
2420: =back
2421:
2422: =cut
1.61 www 2423:
2424: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2425: =pod
2426:
1.112 bowersj2 2427: =head1 User Name Functions
2428:
2429: =over 4
2430:
1.226 albertel 2431: =item * plainname($uname,$udom,$first)
1.81 albertel 2432:
1.112 bowersj2 2433: Takes a users logon name and returns it as a string in
1.226 albertel 2434: "first middle last generation" form
2435: if $first is set to 'lastname' then it returns it as
2436: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2437:
2438: =cut
1.61 www 2439:
1.295 www 2440:
1.81 albertel 2441: ###############################################################
1.61 www 2442: sub plainname {
1.226 albertel 2443: my ($uname,$udom,$first)=@_;
1.537 albertel 2444: return if (!defined($uname) || !defined($udom));
1.295 www 2445: my %names=&getnames($uname,$udom);
1.226 albertel 2446: my $name=&Apache::lonnet::format_name($names{'firstname'},
2447: $names{'middlename'},
2448: $names{'lastname'},
2449: $names{'generation'},$first);
2450: $name=~s/^\s+//;
1.62 www 2451: $name=~s/\s+$//;
2452: $name=~s/\s+/ /g;
1.353 albertel 2453: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2454: return $name;
1.61 www 2455: }
1.66 www 2456:
2457: # -------------------------------------------------------------------- Nickname
1.81 albertel 2458: =pod
2459:
1.112 bowersj2 2460: =item * nickname($uname,$udom)
1.81 albertel 2461:
2462: Gets a users name and returns it as a string as
2463:
2464: ""nickname""
1.66 www 2465:
1.81 albertel 2466: if the user has a nickname or
2467:
2468: "first middle last generation"
2469:
2470: if the user does not
2471:
2472: =cut
1.66 www 2473:
2474: sub nickname {
2475: my ($uname,$udom)=@_;
1.537 albertel 2476: return if (!defined($uname) || !defined($udom));
1.295 www 2477: my %names=&getnames($uname,$udom);
1.68 albertel 2478: my $name=$names{'nickname'};
1.66 www 2479: if ($name) {
2480: $name='"'.$name.'"';
2481: } else {
2482: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2483: $names{'lastname'}.' '.$names{'generation'};
2484: $name=~s/\s+$//;
2485: $name=~s/\s+/ /g;
2486: }
2487: return $name;
2488: }
2489:
1.295 www 2490: sub getnames {
2491: my ($uname,$udom)=@_;
1.537 albertel 2492: return if (!defined($uname) || !defined($udom));
1.433 albertel 2493: if ($udom eq 'public' && $uname eq 'public') {
2494: return ('lastname' => &mt('Public'));
2495: }
1.295 www 2496: my $id=$uname.':'.$udom;
2497: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2498: if ($cached) {
2499: return %{$names};
2500: } else {
2501: my %loadnames=&Apache::lonnet::get('environment',
2502: ['firstname','middlename','lastname','generation','nickname'],
2503: $udom,$uname);
2504: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2505: return %loadnames;
2506: }
2507: }
1.61 www 2508:
1.542 raeburn 2509: # -------------------------------------------------------------------- getemails
2510: =pod
2511:
2512: =item * getemails($uname,$udom)
2513:
2514: Gets a user's email information and returns it as a hash with keys:
2515: notification, critnotification, permanentemail
2516:
2517: For notification and critnotification, values are comma-separated lists
2518: of e-mail address(es); for permanentemail, value is a single e-mail address.
2519:
2520: =cut
2521:
1.466 albertel 2522: sub getemails {
2523: my ($uname,$udom)=@_;
2524: if ($udom eq 'public' && $uname eq 'public') {
2525: return;
2526: }
1.467 www 2527: if (!$udom) { $udom=$env{'user.domain'}; }
2528: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2529: my $id=$uname.':'.$udom;
2530: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2531: if ($cached) {
2532: return %{$names};
2533: } else {
2534: my %loadnames=&Apache::lonnet::get('environment',
2535: ['notification','critnotification',
2536: 'permanentemail'],
2537: $udom,$uname);
2538: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2539: return %loadnames;
2540: }
2541: }
2542:
1.551 albertel 2543: sub flush_email_cache {
2544: my ($uname,$udom)=@_;
2545: if (!$udom) { $udom =$env{'user.domain'}; }
2546: if (!$uname) { $uname=$env{'user.name'}; }
2547: return if ($udom eq 'public' && $uname eq 'public');
2548: my $id=$uname.':'.$udom;
2549: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2550: }
2551:
1.61 www 2552: # ------------------------------------------------------------------ Screenname
1.81 albertel 2553:
2554: =pod
2555:
1.112 bowersj2 2556: =item * screenname($uname,$udom)
1.81 albertel 2557:
2558: Gets a users screenname and returns it as a string
2559:
2560: =cut
1.61 www 2561:
2562: sub screenname {
2563: my ($uname,$udom)=@_;
1.258 albertel 2564: if ($uname eq $env{'user.name'} &&
2565: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2566: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2567: return $names{'screenname'};
1.62 www 2568: }
2569:
1.212 albertel 2570:
1.62 www 2571: # ------------------------------------------------------------- Message Wrapper
2572:
2573: sub messagewrapper {
1.369 www 2574: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2575: return
1.441 albertel 2576: '<a href="/adm/email?compose=individual&'.
2577: 'recname='.$username.'&recdom='.$domain.
2578: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2579: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2580: }
2581: # --------------------------------------------------------------- Notes Wrapper
2582:
2583: sub noteswrapper {
2584: my ($link,$un,$do)=@_;
2585: return
2586: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2587: }
2588: # ------------------------------------------------------------- Aboutme Wrapper
2589:
2590: sub aboutmewrapper {
1.166 www 2591: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2592: if (!defined($username) && !defined($domain)) {
2593: return;
2594: }
1.205 www 2595: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.454 banghart 2596: ($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
1.62 www 2597: }
2598:
2599: # ------------------------------------------------------------ Syllabus Wrapper
2600:
2601:
2602: sub syllabuswrapper {
1.109 matthew 2603: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
2604: if ($fontcolor) {
2605: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
2606: }
1.208 matthew 2607: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2608: }
1.14 harris41 2609:
1.208 matthew 2610: sub track_student_link {
1.268 albertel 2611: my ($linktext,$sname,$sdom,$target,$start) = @_;
2612: my $link ="/adm/trackstudent?";
1.208 matthew 2613: my $title = 'View recent activity';
2614: if (defined($sname) && $sname !~ /^\s*$/ &&
2615: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2616: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2617: $title .= ' of this student';
1.268 albertel 2618: }
1.208 matthew 2619: if (defined($target) && $target !~ /^\s*$/) {
2620: $target = qq{target="$target"};
2621: } else {
2622: $target = '';
2623: }
1.268 albertel 2624: if ($start) { $link.='&start='.$start; }
1.554 albertel 2625: $title = &mt($title);
2626: $linktext = &mt($linktext);
1.448 albertel 2627: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2628: &help_open_topic('View_recent_activity');
1.208 matthew 2629: }
2630:
1.508 www 2631: # ===================================================== Display a student photo
2632:
2633:
1.509 albertel 2634: sub student_image_tag {
1.508 www 2635: my ($domain,$user)=@_;
2636: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
2637: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
2638: return '<img src="'.$imgsrc.'" align="right" />';
2639: } else {
2640: return '';
2641: }
2642: }
2643:
1.112 bowersj2 2644: =pod
2645:
2646: =back
2647:
2648: =head1 Access .tab File Data
2649:
2650: =over 4
2651:
2652: =item * languageids()
2653:
2654: returns list of all language ids
2655:
2656: =cut
2657:
1.14 harris41 2658: sub languageids {
1.16 harris41 2659: return sort(keys(%language));
1.14 harris41 2660: }
2661:
1.112 bowersj2 2662: =pod
2663:
2664: =item * languagedescription()
2665:
2666: returns description of a specified language id
2667:
2668: =cut
2669:
1.14 harris41 2670: sub languagedescription {
1.125 www 2671: my $code=shift;
2672: return ($supported_language{$code}?'* ':'').
2673: $language{$code}.
1.126 www 2674: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 2675: }
2676:
2677: sub plainlanguagedescription {
2678: my $code=shift;
2679: return $language{$code};
2680: }
2681:
2682: sub supportedlanguagecode {
2683: my $code=shift;
2684: return $supported_language{$code};
1.97 www 2685: }
2686:
1.112 bowersj2 2687: =pod
2688:
2689: =item * copyrightids()
2690:
2691: returns list of all copyrights
2692:
2693: =cut
2694:
2695: sub copyrightids {
2696: return sort(keys(%cprtag));
2697: }
2698:
2699: =pod
2700:
2701: =item * copyrightdescription()
2702:
2703: returns description of a specified copyright id
2704:
2705: =cut
2706:
2707: sub copyrightdescription {
1.166 www 2708: return &mt($cprtag{shift(@_)});
1.112 bowersj2 2709: }
1.197 matthew 2710:
2711: =pod
2712:
1.192 taceyjo1 2713: =item * source_copyrightids()
2714:
2715: returns list of all source copyrights
2716:
2717: =cut
2718:
2719: sub source_copyrightids {
2720: return sort(keys(%scprtag));
2721: }
2722:
2723: =pod
2724:
2725: =item * source_copyrightdescription()
2726:
2727: returns description of a specified source copyright id
2728:
2729: =cut
2730:
2731: sub source_copyrightdescription {
2732: return &mt($scprtag{shift(@_)});
2733: }
1.112 bowersj2 2734:
2735: =pod
2736:
2737: =item * filecategories()
2738:
2739: returns list of all file categories
2740:
2741: =cut
2742:
2743: sub filecategories {
2744: return sort(keys(%category_extensions));
2745: }
2746:
2747: =pod
2748:
2749: =item * filecategorytypes()
2750:
2751: returns list of file types belonging to a given file
2752: category
2753:
2754: =cut
2755:
2756: sub filecategorytypes {
1.356 albertel 2757: my ($cat) = @_;
2758: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 2759: }
2760:
2761: =pod
2762:
2763: =item * fileembstyle()
2764:
2765: returns embedding style for a specified file type
2766:
2767: =cut
2768:
2769: sub fileembstyle {
2770: return $fe{lc(shift(@_))};
1.169 www 2771: }
2772:
1.351 www 2773: sub filemimetype {
2774: return $fm{lc(shift(@_))};
2775: }
2776:
1.169 www 2777:
2778: sub filecategoryselect {
2779: my ($name,$value)=@_;
1.189 matthew 2780: return &select_form($value,$name,
1.169 www 2781: '' => &mt('Any category'),
2782: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 2783: }
2784:
2785: =pod
2786:
2787: =item * filedescription()
2788:
2789: returns description for a specified file type
2790:
2791: =cut
2792:
2793: sub filedescription {
1.188 matthew 2794: my $file_description = $fd{lc(shift())};
2795: $file_description =~ s:([\[\]]):~$1:g;
2796: return &mt($file_description);
1.112 bowersj2 2797: }
2798:
2799: =pod
2800:
2801: =item * filedescriptionex()
2802:
2803: returns description for a specified file type with
2804: extra formatting
2805:
2806: =cut
2807:
2808: sub filedescriptionex {
2809: my $ex=shift;
1.188 matthew 2810: my $file_description = $fd{lc($ex)};
2811: $file_description =~ s:([\[\]]):~$1:g;
2812: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 2813: }
2814:
2815: # End of .tab access
2816: =pod
2817:
2818: =back
2819:
2820: =cut
2821:
2822: # ------------------------------------------------------------------ File Types
2823: sub fileextensions {
2824: return sort(keys(%fe));
2825: }
2826:
1.97 www 2827: # ----------------------------------------------------------- Display Languages
2828: # returns a hash with all desired display languages
2829: #
2830:
2831: sub display_languages {
2832: my %languages=();
1.356 albertel 2833: foreach my $lang (&preferred_languages()) {
2834: $languages{$lang}=1;
1.97 www 2835: }
2836: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 2837: if ($env{'form.displaylanguage'}) {
1.356 albertel 2838: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
2839: $languages{$lang}=1;
1.97 www 2840: }
2841: }
2842: return %languages;
1.14 harris41 2843: }
2844:
1.117 www 2845: sub preferred_languages {
2846: my @languages=();
1.258 albertel 2847: if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
1.117 www 2848: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
1.258 albertel 2849: $env{'course.'.$env{'request.course.id'}.'.languages'}));
1.177 www 2850: }
1.258 albertel 2851: if ($env{'environment.languages'}) {
1.459 albertel 2852: @languages=(@languages,
2853: split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
1.118 www 2854: }
1.583 albertel 2855: my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
1.162 www 2856: if ($browser) {
1.583 albertel 2857: my @browser =
2858: map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
2859: push(@languages,@browser);
1.162 www 2860: }
1.514 albertel 2861: if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
1.118 www 2862: @languages=(@languages,
1.514 albertel 2863: &Apache::lonnet::domain($env{'user.domain'},
2864: 'lang_def'));
1.118 www 2865: }
1.514 albertel 2866: if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
1.118 www 2867: @languages=(@languages,
1.514 albertel 2868: &Apache::lonnet::domain($env{'request.role.domain'},
2869: 'lang_def'));
1.118 www 2870: }
1.514 albertel 2871: if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
2872: 'lang_def')) {
1.118 www 2873: @languages=(@languages,
1.514 albertel 2874: &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
2875: 'lang_def'));
1.118 www 2876: }
2877: # turn "en-ca" into "en-ca,en"
2878: my @genlanguages;
1.356 albertel 2879: foreach my $lang (@languages) {
2880: unless ($lang=~/\w/) { next; }
1.583 albertel 2881: push(@genlanguages,$lang);
1.356 albertel 2882: if ($lang=~/(\-|\_)/) {
2883: push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
1.118 www 2884: }
2885: }
1.583 albertel 2886: #uniqueify the languages list
2887: my %count;
2888: @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
1.118 www 2889: return @genlanguages;
1.117 www 2890: }
2891:
1.582 albertel 2892: sub languages {
2893: my ($possible_langs) = @_;
2894: my @preferred_langs = &preferred_languages();
2895: if (!ref($possible_langs)) {
2896: if( wantarray ) {
2897: return @preferred_langs;
2898: } else {
2899: return $preferred_langs[0];
2900: }
2901: }
2902: my %possibilities = map { $_ => 1 } (@$possible_langs);
2903: my @preferred_possibilities;
2904: foreach my $preferred_lang (@preferred_langs) {
2905: if (exists($possibilities{$preferred_lang})) {
2906: push(@preferred_possibilities, $preferred_lang);
2907: }
2908: }
2909: if( wantarray ) {
2910: return @preferred_possibilities;
2911: }
2912: return $preferred_possibilities[0];
2913: }
2914:
1.112 bowersj2 2915: ###############################################################
2916: ## Student Answer Attempts ##
2917: ###############################################################
2918:
2919: =pod
2920:
2921: =head1 Alternate Problem Views
2922:
2923: =over 4
2924:
2925: =item * get_previous_attempt($symb, $username, $domain, $course,
2926: $getattempt, $regexp, $gradesub)
2927:
2928: Return string with previous attempt on problem. Arguments:
2929:
2930: =over 4
2931:
2932: =item * $symb: Problem, including path
2933:
2934: =item * $username: username of the desired student
2935:
2936: =item * $domain: domain of the desired student
1.14 harris41 2937:
1.112 bowersj2 2938: =item * $course: Course ID
1.14 harris41 2939:
1.112 bowersj2 2940: =item * $getattempt: Leave blank for all attempts, otherwise put
2941: something
1.14 harris41 2942:
1.112 bowersj2 2943: =item * $regexp: if string matches this regexp, the string will be
2944: sent to $gradesub
1.14 harris41 2945:
1.112 bowersj2 2946: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 2947:
1.112 bowersj2 2948: =back
1.14 harris41 2949:
1.112 bowersj2 2950: The output string is a table containing all desired attempts, if any.
1.16 harris41 2951:
1.112 bowersj2 2952: =cut
1.1 albertel 2953:
2954: sub get_previous_attempt {
1.43 ng 2955: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 2956: my $prevattempts='';
1.43 ng 2957: no strict 'refs';
1.1 albertel 2958: if ($symb) {
1.3 albertel 2959: my (%returnhash)=
2960: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 2961: if ($returnhash{'version'}) {
2962: my %lasthash=();
2963: my $version;
2964: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 2965: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
2966: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 2967: }
1.1 albertel 2968: }
1.596 albertel 2969: $prevattempts=&start_data_table().&start_data_table_header_row();
2970: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 2971: foreach my $key (sort(keys(%lasthash))) {
2972: my ($ign,@parts) = split(/\./,$key);
1.41 ng 2973: if ($#parts > 0) {
1.31 albertel 2974: my $data=$parts[-1];
2975: pop(@parts);
1.596 albertel 2976: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 2977: } else {
1.41 ng 2978: if ($#parts == 0) {
2979: $prevattempts.='<th>'.$parts[0].'</th>';
2980: } else {
2981: $prevattempts.='<th>'.$ign.'</th>';
2982: }
1.31 albertel 2983: }
1.16 harris41 2984: }
1.596 albertel 2985: $prevattempts.=&end_data_table_header_row();
1.40 ng 2986: if ($getattempt eq '') {
2987: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 2988: $prevattempts.=&start_data_table_row().
2989: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 2990: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 2991: my $value = &format_previous_attempt_value($key,
2992: $returnhash{$version.':'.$key});
2993: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 2994: }
1.596 albertel 2995: $prevattempts.=&end_data_table_row();
1.40 ng 2996: }
1.1 albertel 2997: }
1.596 albertel 2998: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 2999: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3000: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3001: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3002: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3003: }
1.596 albertel 3004: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3005: } else {
1.596 albertel 3006: $prevattempts=
3007: &start_data_table().&start_data_table_row().
3008: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3009: &end_data_table_row().&end_data_table();
1.1 albertel 3010: }
3011: } else {
1.596 albertel 3012: $prevattempts=
3013: &start_data_table().&start_data_table_row().
3014: '<td>'.&mt('No data.').'</td>'.
3015: &end_data_table_row().&end_data_table();
1.1 albertel 3016: }
1.10 albertel 3017: }
3018:
1.581 albertel 3019: sub format_previous_attempt_value {
3020: my ($key,$value) = @_;
3021: if ($key =~ /timestamp/) {
3022: $value = &Apache::lonlocal::locallocaltime($value);
3023: } elsif (ref($value) eq 'ARRAY') {
3024: $value = '('.join(', ', @{ $value }).')';
3025: } else {
3026: $value = &unescape($value);
3027: }
3028: return $value;
3029: }
3030:
3031:
1.107 albertel 3032: sub relative_to_absolute {
3033: my ($url,$output)=@_;
3034: my $parser=HTML::TokeParser->new(\$output);
3035: my $token;
3036: my $thisdir=$url;
3037: my @rlinks=();
3038: while ($token=$parser->get_token) {
3039: if ($token->[0] eq 'S') {
3040: if ($token->[1] eq 'a') {
3041: if ($token->[2]->{'href'}) {
3042: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3043: }
3044: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3045: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3046: } elsif ($token->[1] eq 'base') {
3047: $thisdir=$token->[2]->{'href'};
3048: }
3049: }
3050: }
3051: $thisdir=~s-/[^/]*$--;
1.356 albertel 3052: foreach my $link (@rlinks) {
3053: unless (($link=~/^http:\/\//i) ||
3054: ($link=~/^\//) ||
3055: ($link=~/^javascript:/i) ||
3056: ($link=~/^mailto:/i) ||
3057: ($link=~/^\#/)) {
3058: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3059: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3060: }
3061: }
3062: # -------------------------------------------------- Deal with Applet codebases
3063: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3064: return $output;
3065: }
3066:
1.112 bowersj2 3067: =pod
3068:
3069: =item * get_student_view
3070:
3071: show a snapshot of what student was looking at
3072:
3073: =cut
3074:
1.10 albertel 3075: sub get_student_view {
1.186 albertel 3076: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3077: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3078: my (%form);
1.10 albertel 3079: my @elements=('symb','courseid','domain','username');
3080: foreach my $element (@elements) {
1.186 albertel 3081: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3082: }
1.186 albertel 3083: if (defined($moreenv)) {
3084: %form=(%form,%{$moreenv});
3085: }
1.236 albertel 3086: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3087: $feedurl=&Apache::lonnet::clutter($feedurl);
1.186 albertel 3088: my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3089: $userview=~s/\<body[^\>]*\>//gi;
3090: $userview=~s/\<\/body\>//gi;
3091: $userview=~s/\<html\>//gi;
3092: $userview=~s/\<\/html\>//gi;
3093: $userview=~s/\<head\>//gi;
3094: $userview=~s/\<\/head\>//gi;
3095: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3096: $userview=&relative_to_absolute($feedurl,$userview);
1.11 albertel 3097: return $userview;
3098: }
3099:
1.112 bowersj2 3100: =pod
3101:
3102: =item * get_student_answers()
3103:
3104: show a snapshot of how student was answering problem
3105:
3106: =cut
3107:
1.11 albertel 3108: sub get_student_answers {
1.100 sakharuk 3109: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3110: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3111: my (%moreenv);
1.11 albertel 3112: my @elements=('symb','courseid','domain','username');
3113: foreach my $element (@elements) {
1.186 albertel 3114: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3115: }
1.186 albertel 3116: $moreenv{'grade_target'}='answer';
3117: %moreenv=(%form,%moreenv);
1.497 raeburn 3118: $feedurl = &Apache::lonnet::clutter($feedurl);
3119: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3120: return $userview;
1.1 albertel 3121: }
1.116 albertel 3122:
3123: =pod
3124:
3125: =item * &submlink()
3126:
1.242 albertel 3127: Inputs: $text $uname $udom $symb $target
1.116 albertel 3128:
3129: Returns: A link to grades.pm such as to see the SUBM view of a student
3130:
3131: =cut
3132:
3133: ###############################################
3134: sub submlink {
1.242 albertel 3135: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3136: if (!($uname && $udom)) {
3137: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3138: &Apache::lonnet::whichuser($symb);
1.116 albertel 3139: if (!$symb) { $symb=$cursymb; }
3140: }
1.254 matthew 3141: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3142: $symb=&escape($symb);
1.242 albertel 3143: if ($target) { $target="target=\"$target\""; }
3144: return '<a href="/adm/grades?&command=submission&'.
3145: 'symb='.$symb.'&student='.$uname.
3146: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3147: }
3148: ##############################################
3149:
3150: =pod
3151:
3152: =item * &pgrdlink()
3153:
3154: Inputs: $text $uname $udom $symb $target
3155:
3156: Returns: A link to grades.pm such as to see the PGRD view of a student
3157:
3158: =cut
3159:
3160: ###############################################
3161: sub pgrdlink {
3162: my $link=&submlink(@_);
3163: $link=~s/(&command=submission)/$1&showgrading=yes/;
3164: return $link;
3165: }
3166: ##############################################
3167:
3168: =pod
3169:
3170: =item * &pprmlink()
3171:
3172: Inputs: $text $uname $udom $symb $target
3173:
3174: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3175: student and a specific resource
1.242 albertel 3176:
3177: =cut
3178:
3179: ###############################################
3180: sub pprmlink {
3181: my ($text,$uname,$udom,$symb,$target)=@_;
3182: if (!($uname && $udom)) {
3183: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3184: &Apache::lonnet::whichuser($symb);
1.242 albertel 3185: if (!$symb) { $symb=$cursymb; }
3186: }
1.254 matthew 3187: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3188: $symb=&escape($symb);
1.242 albertel 3189: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3190: return '<a href="/adm/parmset?command=set&'.
3191: 'symb='.$symb.'&uname='.$uname.
3192: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3193: }
3194: ##############################################
1.37 matthew 3195:
1.112 bowersj2 3196: =pod
3197:
3198: =back
3199:
3200: =cut
3201:
1.37 matthew 3202: ###############################################
1.51 www 3203:
3204:
3205: sub timehash {
3206: my @ltime=localtime(shift);
3207: return ( 'seconds' => $ltime[0],
3208: 'minutes' => $ltime[1],
3209: 'hours' => $ltime[2],
3210: 'day' => $ltime[3],
3211: 'month' => $ltime[4]+1,
3212: 'year' => $ltime[5]+1900,
3213: 'weekday' => $ltime[6],
3214: 'dayyear' => $ltime[7]+1,
3215: 'dlsav' => $ltime[8] );
3216: }
3217:
1.370 www 3218: sub utc_string {
3219: my ($date)=@_;
1.371 www 3220: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3221: }
3222:
1.51 www 3223: sub maketime {
3224: my %th=@_;
3225: return POSIX::mktime(
3226: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3227: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3228: }
3229:
3230: #########################################
1.51 www 3231:
3232: sub findallcourses {
1.482 raeburn 3233: my ($roles,$uname,$udom) = @_;
1.355 albertel 3234: my %roles;
3235: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3236: my %courses;
1.51 www 3237: my $now=time;
1.482 raeburn 3238: if (!defined($uname)) {
3239: $uname = $env{'user.name'};
3240: }
3241: if (!defined($udom)) {
3242: $udom = $env{'user.domain'};
3243: }
3244: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3245: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3246: if (!%roles) {
3247: %roles = (
3248: cc => 1,
3249: in => 1,
3250: ep => 1,
3251: ta => 1,
3252: cr => 1,
3253: st => 1,
3254: );
3255: }
3256: foreach my $entry (keys(%roleshash)) {
3257: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3258: if ($trole =~ /^cr/) {
3259: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3260: } else {
3261: next if (!exists($roles{$trole}));
3262: }
3263: if ($tend) {
3264: next if ($tend < $now);
3265: }
3266: if ($tstart) {
3267: next if ($tstart > $now);
3268: }
3269: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3270: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3271: if ($secpart eq '') {
3272: ($cnum,$role) = split(/_/,$cnumpart);
3273: $sec = 'none';
3274: $realsec = '';
3275: } else {
3276: $cnum = $cnumpart;
3277: ($sec,$role) = split(/_/,$secpart);
3278: $realsec = $sec;
1.490 raeburn 3279: }
1.482 raeburn 3280: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3281: }
3282: } else {
3283: foreach my $key (keys(%env)) {
1.483 albertel 3284: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3285: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3286: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3287: next if ($role eq 'ca' || $role eq 'aa');
3288: next if (%roles && !exists($roles{$role}));
3289: my ($starttime,$endtime)=split(/\./,$env{$key});
3290: my $active=1;
3291: if ($starttime) {
3292: if ($now<$starttime) { $active=0; }
3293: }
3294: if ($endtime) {
3295: if ($now>$endtime) { $active=0; }
3296: }
3297: if ($active) {
3298: if ($sec eq '') {
3299: $sec = 'none';
3300: }
3301: $courses{$cdom.'_'.$cnum}{$sec} =
3302: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3303: }
3304: }
1.51 www 3305: }
3306: }
1.474 raeburn 3307: return %courses;
1.51 www 3308: }
1.37 matthew 3309:
1.54 www 3310: ###############################################
1.474 raeburn 3311:
3312: sub blockcheck {
1.482 raeburn 3313: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3314:
3315: if (!defined($udom)) {
3316: $udom = $env{'user.domain'};
3317: }
3318: if (!defined($uname)) {
3319: $uname = $env{'user.name'};
3320: }
3321:
3322: # If uname and udom are for a course, check for blocks in the course.
3323:
3324: if (&Apache::lonnet::is_course($udom,$uname)) {
3325: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3326: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3327: return ($startblock,$endblock);
3328: }
1.474 raeburn 3329:
1.502 raeburn 3330: my $startblock = 0;
3331: my $endblock = 0;
1.482 raeburn 3332: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3333:
1.490 raeburn 3334: # If uname is for a user, and activity is course-specific, i.e.,
3335: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3336:
1.490 raeburn 3337: if (($activity eq 'boards' || $activity eq 'chat' ||
3338: $activity eq 'groups') && ($env{'request.course.id'})) {
3339: foreach my $key (keys(%live_courses)) {
3340: if ($key ne $env{'request.course.id'}) {
3341: delete($live_courses{$key});
3342: }
3343: }
3344: }
3345:
3346: my $otheruser = 0;
3347: my %own_courses;
3348: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3349: # Resource belongs to user other than current user.
3350: $otheruser = 1;
3351: # Gather courses for current user
3352: %own_courses =
3353: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3354: }
3355:
3356: # Gather active course roles - course coordinator, instructor,
3357: # exam proctor, ta, student, or custom role.
1.474 raeburn 3358:
3359: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3360: my ($cdom,$cnum);
3361: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3362: $cdom = $env{'course.'.$course.'.domain'};
3363: $cnum = $env{'course.'.$course.'.num'};
3364: } else {
1.490 raeburn 3365: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3366: }
3367: my $no_ownblock = 0;
3368: my $no_userblock = 0;
1.533 raeburn 3369: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3370: # Check if current user has 'evb' priv for this
3371: if (defined($own_courses{$course})) {
3372: foreach my $sec (keys(%{$own_courses{$course}})) {
3373: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3374: if ($sec ne 'none') {
3375: $checkrole .= '/'.$sec;
3376: }
3377: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3378: $no_ownblock = 1;
3379: last;
3380: }
3381: }
3382: }
3383: # if they have 'evb' priv and are currently not playing student
3384: next if (($no_ownblock) &&
3385: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3386: }
1.474 raeburn 3387: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3388: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3389: if ($sec ne 'none') {
1.482 raeburn 3390: $checkrole .= '/'.$sec;
1.474 raeburn 3391: }
1.490 raeburn 3392: if ($otheruser) {
3393: # Resource belongs to user other than current user.
3394: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3395: my ($trole,$tdom,$tnum,$tsec);
3396: my $entry = $live_courses{$course}{$sec};
3397: if ($entry =~ /^cr/) {
3398: ($trole,$tdom,$tnum,$tsec) =
3399: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3400: } else {
3401: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3402: }
3403: my ($spec,$area,$trest,%allroles,%userroles);
3404: $area = '/'.$tdom.'/'.$tnum;
3405: $trest = $tnum;
3406: if ($tsec ne '') {
3407: $area .= '/'.$tsec;
3408: $trest .= '/'.$tsec;
3409: }
3410: $spec = $trole.'.'.$area;
3411: if ($trole =~ /^cr/) {
3412: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3413: $tdom,$spec,$trest,$area);
3414: } else {
3415: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3416: $tdom,$spec,$trest,$area);
3417: }
3418: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3419: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3420: if ($1) {
3421: $no_userblock = 1;
3422: last;
3423: }
3424: }
1.490 raeburn 3425: } else {
3426: # Resource belongs to current user
3427: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3428: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3429: $no_ownblock = 1;
3430: last;
3431: }
1.474 raeburn 3432: }
3433: }
3434: # if they have the evb priv and are currently not playing student
1.482 raeburn 3435: next if (($no_ownblock) &&
1.491 albertel 3436: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3437: next if ($no_userblock);
1.474 raeburn 3438:
1.490 raeburn 3439: # Retrieve blocking times and identity of blocker for course
3440: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3441:
3442: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3443: if (($start != 0) &&
3444: (($startblock == 0) || ($startblock > $start))) {
3445: $startblock = $start;
3446: }
3447: if (($end != 0) &&
3448: (($endblock == 0) || ($endblock < $end))) {
3449: $endblock = $end;
3450: }
1.490 raeburn 3451: }
3452: return ($startblock,$endblock);
3453: }
3454:
3455: sub get_blocks {
3456: my ($setters,$activity,$cdom,$cnum) = @_;
3457: my $startblock = 0;
3458: my $endblock = 0;
3459: my $course = $cdom.'_'.$cnum;
3460: $setters->{$course} = {};
3461: $setters->{$course}{'staff'} = [];
3462: $setters->{$course}{'times'} = [];
3463: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3464: foreach my $record (keys(%records)) {
3465: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3466: if ($start <= time && $end >= time) {
3467: my ($staff_name,$staff_dom,$title,$blocks) =
3468: &parse_block_record($records{$record});
3469: if ($blocks->{$activity} eq 'on') {
3470: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3471: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3472: if ( ($startblock == 0) || ($startblock > $start) ) {
3473: $startblock = $start;
1.490 raeburn 3474: }
1.491 albertel 3475: if ( ($endblock == 0) || ($endblock < $end) ) {
3476: $endblock = $end;
1.474 raeburn 3477: }
3478: }
3479: }
3480: }
3481: return ($startblock,$endblock);
3482: }
3483:
3484: sub parse_block_record {
3485: my ($record) = @_;
3486: my ($setuname,$setudom,$title,$blocks);
3487: if (ref($record) eq 'HASH') {
3488: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3489: $title = &unescape($record->{'event'});
3490: $blocks = $record->{'blocks'};
3491: } else {
3492: my @data = split(/:/,$record,3);
3493: if (scalar(@data) eq 2) {
3494: $title = $data[1];
3495: ($setuname,$setudom) = split(/@/,$data[0]);
3496: } else {
3497: ($setuname,$setudom,$title) = @data;
3498: }
3499: $blocks = { 'com' => 'on' };
3500: }
3501: return ($setuname,$setudom,$title,$blocks);
3502: }
3503:
3504: sub build_block_table {
3505: my ($startblock,$endblock,$setters) = @_;
3506: my %lt = &Apache::lonlocal::texthash(
3507: 'cacb' => 'Currently active communication blocks',
3508: 'cour' => 'Course',
3509: 'dura' => 'Duration',
3510: 'blse' => 'Block set by'
3511: );
3512: my $output;
1.476 raeburn 3513: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 3514: $output .= &start_data_table();
3515: $output .= '
3516: <tr>
3517: <th>'.$lt{'cour'}.'</th>
3518: <th>'.$lt{'dura'}.'</th>
3519: <th>'.$lt{'blse'}.'</th>
3520: </tr>
3521: ';
3522: foreach my $course (keys(%{$setters})) {
3523: my %courseinfo=&Apache::lonnet::coursedescription($course);
3524: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
3525: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 3526: my $fullname = &plainname($uname,$udom);
3527: if (defined($env{'user.name'}) && defined($env{'user.domain'})
3528: && $env{'user.name'} ne 'public'
3529: && $env{'user.domain'} ne 'public') {
3530: $fullname = &aboutmewrapper($fullname,$uname,$udom);
3531: }
1.474 raeburn 3532: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
3533: $openblock = &Apache::lonlocal::locallocaltime($openblock);
3534: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
3535: $output .= &Apache::loncommon::start_data_table_row().
3536: '<td>'.$courseinfo{'description'}.'</td>'.
3537: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 3538: '<td>'.$fullname.'</td>'.
1.474 raeburn 3539: &Apache::loncommon::end_data_table_row();
3540: }
3541: }
3542: $output .= &end_data_table();
3543: }
3544:
1.490 raeburn 3545: sub blocking_status {
3546: my ($activity,$uname,$udom) = @_;
3547: my %setters;
3548: my ($blocked,$output,$ownitem,$is_course);
3549: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
3550: if ($startblock && $endblock) {
3551: $blocked = 1;
3552: if (wantarray) {
3553: my $category;
3554: if ($activity eq 'boards') {
3555: $category = 'Discussion posts in this course';
3556: } elsif ($activity eq 'blogs') {
3557: $category = 'Blogs';
3558: } elsif ($activity eq 'port') {
3559: if (defined($uname) && defined($udom)) {
3560: if ($uname eq $env{'user.name'} &&
3561: $udom eq $env{'user.domain'}) {
3562: $ownitem = 1;
3563: }
3564: }
3565: $is_course = &Apache::lonnet::is_course($udom,$uname);
3566: if ($ownitem) {
3567: $category = 'Your portfolio files';
3568: } elsif ($is_course) {
3569: my $coursedesc;
3570: foreach my $course (keys(%setters)) {
3571: my %courseinfo =
3572: &Apache::lonnet::coursedescription($course);
3573: $coursedesc = $courseinfo{'description'};
3574: }
3575: $category = "Group files in the course '$coursedesc'";
3576: } else {
3577: $category = 'Portfolio files belonging to ';
3578: if ($env{'user.name'} eq 'public' &&
3579: $env{'user.domain'} eq 'public') {
3580: $category .= &plainname($uname,$udom);
3581: } else {
3582: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
3583: }
3584: }
3585: } elsif ($activity eq 'groups') {
3586: $category = 'Groups in this course';
3587: }
3588: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
3589: my $showend = &Apache::lonlocal::locallocaltime($endblock);
3590: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
3591: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
3592: $output .= &build_block_table($startblock,$endblock,\%setters);
3593: }
3594: }
3595: }
3596: if (wantarray) {
3597: return ($blocked,$output);
3598: } else {
3599: return $blocked;
3600: }
3601: }
3602:
1.60 matthew 3603: ###############################################
3604:
3605: =pod
3606:
1.112 bowersj2 3607: =head1 Domain Template Functions
3608:
3609: =over 4
3610:
3611: =item * &determinedomain()
1.60 matthew 3612:
3613: Inputs: $domain (usually will be undef)
3614:
1.63 www 3615: Returns: Determines which domain should be used for designs
1.60 matthew 3616:
3617: =cut
1.54 www 3618:
1.60 matthew 3619: ###############################################
1.63 www 3620: sub determinedomain {
3621: my $domain=shift;
1.531 albertel 3622: if (! $domain) {
1.60 matthew 3623: # Determine domain if we have not been given one
3624: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258 albertel 3625: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
3626: if ($env{'request.role.domain'}) {
3627: $domain=$env{'request.role.domain'};
1.60 matthew 3628: }
3629: }
1.63 www 3630: return $domain;
3631: }
3632: ###############################################
1.517 raeburn 3633:
1.518 albertel 3634: sub devalidate_domconfig_cache {
3635: my ($udom)=@_;
3636: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
3637: }
3638:
3639: # ---------------------- Get domain configuration for a domain
3640: sub get_domainconf {
3641: my ($udom) = @_;
3642: my $cachetime=1800;
3643: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
3644: if (defined($cached)) { return %{$result}; }
3645:
3646: my %domconfig = &Apache::lonnet::get_dom('configuration',
3647: ['login','rolecolors'],$udom);
3648: my %designhash;
3649: if (keys(%domconfig) > 0) {
3650: if (ref($domconfig{'login'}) eq 'HASH') {
3651: foreach my $key (keys(%{$domconfig{'login'}})) {
3652: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
3653: }
3654: }
3655: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
3656: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
3657: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
3658: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
3659: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
3660: }
3661: }
3662: }
3663: }
3664: } else {
3665: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
3666: my $designfile = $designdir.'/'.$udom.'.tab';
3667: if (-e $designfile) {
3668: if ( open (my $fh,"<$designfile") ) {
3669: while (my $line = <$fh>) {
3670: next if ($line =~ /^\#/);
3671: chomp($line);
3672: my ($key,$val)=(split(/\=/,$line));
3673: if ($val) { $designhash{$udom.'.'.$key}=$val; }
3674: }
3675: close($fh);
3676: }
3677: }
3678: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
1.519 raeburn 3679: $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
1.518 albertel 3680: }
3681: }
3682: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
3683: $cachetime);
3684: return %designhash;
3685: }
3686:
1.63 www 3687: =pod
3688:
1.112 bowersj2 3689: =item * &domainlogo()
1.63 www 3690:
3691: Inputs: $domain (usually will be undef)
3692:
3693: Returns: A link to a domain logo, if the domain logo exists.
3694: If the domain logo does not exist, a description of the domain.
3695:
3696: =cut
1.112 bowersj2 3697:
1.63 www 3698: ###############################################
3699: sub domainlogo {
1.517 raeburn 3700: my $domain = &determinedomain(shift);
1.518 albertel 3701: my %designhash = &get_domainconf($domain);
1.517 raeburn 3702: # See if there is a logo
3703: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 3704: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 3705: if ($imgsrc =~ m{^/(adm|res)/}) {
3706: if ($imgsrc =~ m{^/res/}) {
3707: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
3708: &Apache::lonnet::repcopy($local_name);
3709: }
3710: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 3711: }
3712: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 3713: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
3714: return &Apache::lonnet::domain($domain,'description');
1.59 www 3715: } else {
1.60 matthew 3716: return '';
1.59 www 3717: }
3718: }
1.63 www 3719: ##############################################
3720:
3721: =pod
3722:
1.112 bowersj2 3723: =item * &designparm()
1.63 www 3724:
3725: Inputs: $which parameter; $domain (usually will be undef)
3726:
3727: Returns: value of designparamter $which
3728:
3729: =cut
1.112 bowersj2 3730:
1.397 albertel 3731:
1.400 albertel 3732: ##############################################
1.397 albertel 3733: sub designparm {
3734: my ($which,$domain)=@_;
1.258 albertel 3735: if ($env{'browser.blackwhite'} eq 'on') {
1.110 www 3736: if ($which=~/\.(font|alink|vlink|link)$/) {
3737: return '#000000';
3738: }
3739: if ($which=~/\.(pgbg|sidebg)$/) {
3740: return '#FFFFFF';
3741: }
3742: if ($which=~/\.tabbg$/) {
3743: return '#CCCCCC';
3744: }
3745: }
1.397 albertel 3746: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 3747: return $env{'environment.color.'.$which};
1.96 www 3748: }
1.63 www 3749: $domain=&determinedomain($domain);
1.518 albertel 3750: my %domdesign = &get_domainconf($domain);
1.520 raeburn 3751: my $output;
1.517 raeburn 3752: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 3753: $output = $domdesign{$domain.'.'.$which};
1.63 www 3754: } else {
1.520 raeburn 3755: $output = $defaultdesign{$which};
3756: }
3757: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
3758: ($which =~ /login\.(img|logo|domlogo)/)) {
1.538 albertel 3759: if ($output =~ m{^/(adm|res)/}) {
3760: if ($output =~ m{^/res/}) {
3761: my $local_name = &Apache::lonnet::filelocation('',$output);
3762: &Apache::lonnet::repcopy($local_name);
3763: }
1.520 raeburn 3764: $output = &lonhttpdurl($output);
3765: }
1.63 www 3766: }
1.520 raeburn 3767: return $output;
1.63 www 3768: }
1.59 www 3769:
1.60 matthew 3770: ###############################################
3771: ###############################################
3772:
3773: =pod
3774:
1.112 bowersj2 3775: =back
3776:
1.549 albertel 3777: =head1 HTML Helpers
1.112 bowersj2 3778:
3779: =over 4
3780:
3781: =item * &bodytag()
1.60 matthew 3782:
3783: Returns a uniform header for LON-CAPA web pages.
3784:
3785: Inputs:
3786:
1.112 bowersj2 3787: =over 4
3788:
3789: =item * $title, A title to be displayed on the page.
3790:
3791: =item * $function, the current role (can be undef).
3792:
3793: =item * $addentries, extra parameters for the <body> tag.
3794:
3795: =item * $bodyonly, if defined, only return the <body> tag.
3796:
3797: =item * $domain, if defined, force a given domain.
3798:
3799: =item * $forcereg, if page should register as content page (relevant for
1.86 www 3800: text interface only)
1.60 matthew 3801:
1.326 albertel 3802: =item * $customtitle, alternate text to use instead of $title
3803: in the title box that appears, this text
3804: is not auto translated like the $title is
1.309 albertel 3805:
3806: =item * $notopbar, if true, keep the 'what is this' info but remove the
3807: navigational links
1.317 albertel 3808:
1.338 albertel 3809: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
3810:
3811: =item * $notitle, if true keep the nav controls, but remove the title bar
3812:
1.361 albertel 3813: =item * $no_inline_link, if true and in remote mode, don't show the
3814: 'Switch To Inline Menu' link
3815:
1.460 albertel 3816: =item * $args, optional argument valid values are
3817: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 3818: inherit_jsmath -> when creating popup window in a page,
3819: should it have jsmath forced on by the
3820: current page
1.460 albertel 3821:
1.112 bowersj2 3822: =back
3823:
1.60 matthew 3824: Returns: A uniform header for LON-CAPA web pages.
3825: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
3826: If $bodyonly is undef or zero, an html string containing a <body> tag and
3827: other decorations will be returned.
3828:
3829: =cut
3830:
1.54 www 3831: sub bodytag {
1.309 albertel 3832: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 3833: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 3834:
1.460 albertel 3835: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 3836:
1.183 matthew 3837: $function = &get_users_function() if (!$function);
1.339 albertel 3838: my $img = &designparm($function.'.img',$domain);
3839: my $font = &designparm($function.'.font',$domain);
3840: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
3841:
3842: my %design = ( 'style' => 'margin-top: 0px',
1.535 albertel 3843: 'bgcolor' => $pgbg,
1.339 albertel 3844: 'text' => $font,
3845: 'alink' => &designparm($function.'.alink',$domain),
3846: 'vlink' => &designparm($function.'.vlink',$domain),
3847: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 3848: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 3849:
1.63 www 3850: # role and realm
1.378 raeburn 3851: my ($role,$realm) = split(/\./,$env{'request.role'},2);
3852: if ($role eq 'ca') {
1.479 albertel 3853: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 3854: $realm = &plainname($rname,$rdom);
1.378 raeburn 3855: }
1.55 www 3856: # realm
1.258 albertel 3857: if ($env{'request.course.id'}) {
1.378 raeburn 3858: if ($env{'request.role'} !~ /^cr/) {
3859: $role = &Apache::lonnet::plaintext($role,&course_type());
3860: }
1.359 albertel 3861: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 3862: } else {
3863: $role = &Apache::lonnet::plaintext($role);
1.54 www 3864: }
1.433 albertel 3865:
1.359 albertel 3866: if (!$realm) { $realm=' '; }
1.55 www 3867: # Set messages
1.60 matthew 3868: my $messages=&domainlogo($domain);
1.330 albertel 3869:
1.438 albertel 3870: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 3871:
1.101 www 3872: # construct main body tag
1.359 albertel 3873: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 3874: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 3875:
1.530 albertel 3876: if ($bodyonly) {
1.60 matthew 3877: return $bodytag;
1.258 albertel 3878: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 3879: # Accessibility
1.224 raeburn 3880:
1.337 albertel 3881: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 3882: if (!$notitle) {
1.337 albertel 3883: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
3884: }
3885: return $bodytag;
1.359 albertel 3886: }
3887:
1.410 albertel 3888: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 3889: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
3890: undef($role);
1.434 albertel 3891: } else {
3892: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 3893: }
1.359 albertel 3894:
3895: my $roleinfo=(<<ENDROLE);
3896: <td class="LC_title_bar_who">
3897: <div class="LC_title_bar_name">
1.410 albertel 3898: $name
1.361 albertel 3899:
1.359 albertel 3900: </div>
3901: <div class="LC_title_bar_role">
1.361 albertel 3902: $role
1.359 albertel 3903: </div>
3904: <div class="LC_title_bar_realm">
1.361 albertel 3905: $realm
1.359 albertel 3906: </div>
1.206 albertel 3907: </td>
3908: ENDROLE
1.235 raeburn 3909:
1.359 albertel 3910: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
3911: if ($customtitle) {
3912: $titleinfo = $customtitle;
3913: }
3914: #
3915: # Extra info if you are the DC
3916: my $dc_info = '';
3917: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
3918: $env{'course.'.$env{'request.course.id'}.
3919: '.domain'}.'/'})) {
3920: my $cid = $env{'request.course.id'};
3921: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 3922: $dc_info =~ s/\s+$//;
1.359 albertel 3923: $dc_info = '('.$dc_info.')';
3924: }
3925:
3926: if ($env{'environment.remote'} eq 'off') {
3927: # No Remote
1.258 albertel 3928: if ($env{'request.state'} eq 'construct') {
1.359 albertel 3929: $forcereg=1;
3930: }
3931:
3932: if (!$customtitle && $env{'request.state'} eq 'construct') {
3933: # this is for resources; directories have customtitle, and crumbs
3934: # and select recent are created in lonpubdir.pm
1.229 albertel 3935: my ($uname,$thisdisfn)=
1.258 albertel 3936: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 3937: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
3938: $formaction=~s/\/+/\//g;
3939:
1.359 albertel 3940: my $parentpath = '';
3941: my $lastitem = '';
3942: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
3943: $parentpath = $1;
3944: $lastitem = $2;
3945: } else {
3946: $lastitem = $thisdisfn;
3947: }
3948: $titleinfo =
1.401 albertel 3949: &Apache::loncommon::help_open_menu('','',3,'Authoring').
1.359 albertel 3950: '<b>Construction Space</b>: '.
3951: '<form name="dirs" method="post" action="'.$formaction
3952: .'" target="_top"><tt><b>'
3953: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
3954: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
3955: .'</form>'
3956: .&Apache::lonmenu::constspaceform();
1.235 raeburn 3957: }
1.359 albertel 3958:
1.337 albertel 3959: my $titletable;
1.338 albertel 3960: if (!$notitle) {
1.337 albertel 3961: $titletable =
1.359 albertel 3962: '<table id="LC_title_bar">'.
3963: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
3964: '</tr></table>';
1.337 albertel 3965: }
1.359 albertel 3966: if ($notopbar) {
3967: $bodytag .= $titletable;
3968: } else {
3969: if ($env{'request.state'} eq 'construct') {
1.337 albertel 3970: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
3971: $titletable);
1.272 raeburn 3972: } else {
1.336 albertel 3973: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 3974: $titletable;
1.272 raeburn 3975: }
1.235 raeburn 3976: }
3977: return $bodytag;
1.94 www 3978: }
1.95 www 3979:
1.93 www 3980: #
1.95 www 3981: # Top frame rendering, Remote is up
1.93 www 3982: #
1.359 albertel 3983:
1.517 raeburn 3984: my $imgsrc = $img;
3985: if ($img =~ /^\/adm/) {
1.575 albertel 3986: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 3987: }
3988: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 3989:
1.305 www 3990: # Explicit link to get inline menu
1.361 albertel 3991: my $menu= ($no_inline_link?''
3992: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 3993: #
1.338 albertel 3994: if ($notitle) {
1.337 albertel 3995: return $bodytag;
3996: }
1.94 www 3997: return(<<ENDBODY);
1.60 matthew 3998: $bodytag
1.359 albertel 3999: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4000: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4001: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4002: </tr>
1.359 albertel 4003: <tr><td>$titleinfo $dc_info $menu</td>
4004: $roleinfo
1.368 albertel 4005: </tr>
1.356 albertel 4006: </table>
1.54 www 4007: ENDBODY
1.182 matthew 4008: }
4009:
1.330 albertel 4010: sub make_attr_string {
4011: my ($register,$attr_ref) = @_;
4012:
4013: if ($attr_ref && !ref($attr_ref)) {
4014: die("addentries Must be a hash ref ".
4015: join(':',caller(1))." ".
4016: join(':',caller(0))." ");
4017: }
4018:
4019: if ($register) {
1.339 albertel 4020: my ($on_load,$on_unload);
4021: foreach my $key (keys(%{$attr_ref})) {
4022: if (lc($key) eq 'onload') {
4023: $on_load.=$attr_ref->{$key}.';';
4024: delete($attr_ref->{$key});
4025:
4026: } elsif (lc($key) eq 'onunload') {
4027: $on_unload.=$attr_ref->{$key}.';';
4028: delete($attr_ref->{$key});
4029: }
4030: }
4031: $attr_ref->{'onload'} =
4032: &Apache::lonmenu::loadevents(). $on_load;
4033: $attr_ref->{'onunload'}=
4034: &Apache::lonmenu::unloadevents().$on_unload;
4035: }
4036:
4037: # Accessibility font enhance
4038: if ($env{'browser.fontenhance'} eq 'on') {
4039: my $style;
4040: foreach my $key (keys(%{$attr_ref})) {
4041: if (lc($key) eq 'style') {
4042: $style.=$attr_ref->{$key}.';';
4043: delete($attr_ref->{$key});
4044: }
4045: }
4046: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4047: }
1.339 albertel 4048:
4049: if ($env{'browser.blackwhite'} eq 'on') {
4050: delete($attr_ref->{'font'});
4051: delete($attr_ref->{'link'});
4052: delete($attr_ref->{'alink'});
4053: delete($attr_ref->{'vlink'});
4054: delete($attr_ref->{'bgcolor'});
4055: delete($attr_ref->{'background'});
4056: }
4057:
1.330 albertel 4058: my $attr_string;
4059: foreach my $attr (keys(%$attr_ref)) {
4060: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4061: }
4062: return $attr_string;
4063: }
4064:
4065:
1.182 matthew 4066: ###############################################
1.251 albertel 4067: ###############################################
4068:
4069: =pod
4070:
4071: =item * &endbodytag()
4072:
4073: Returns a uniform footer for LON-CAPA web pages.
4074:
1.306 albertel 4075: Inputs: none
1.251 albertel 4076:
4077: =cut
4078:
4079: sub endbodytag {
4080: my $endbodytag='</body>';
1.269 albertel 4081: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4082: if ( exists( $env{'internal.head.redirect'} ) ) {
4083: $endbodytag=
4084: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4085: &mt('Continue').'</a>'.
4086: $endbodytag;
4087: }
1.251 albertel 4088: return $endbodytag;
4089: }
4090:
1.352 albertel 4091: =pod
4092:
4093: =item * &standard_css()
4094:
4095: Returns a style sheet
4096:
4097: Inputs: (all optional)
4098: domain -> force to color decorate a page for a specific
4099: domain
4100: function -> force usage of a specific rolish color scheme
4101: bgcolor -> override the default page bgcolor
4102:
4103: =cut
4104:
1.343 albertel 4105: sub standard_css {
1.345 albertel 4106: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4107: $function = &get_users_function() if (!$function);
4108: my $img = &designparm($function.'.img', $domain);
4109: my $tabbg = &designparm($function.'.tabbg', $domain);
4110: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4111: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4112: my $pgbg_or_bgcolor =
4113: $bgcolor ||
1.352 albertel 4114: &designparm($function.'.pgbg', $domain);
1.382 albertel 4115: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4116: my $alink = &designparm($function.'.alink', $domain);
4117: my $vlink = &designparm($function.'.vlink', $domain);
4118: my $link = &designparm($function.'.link', $domain);
4119:
1.602 albertel 4120: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4121: my $mono = 'monospace';
1.352 albertel 4122: my $data_table_head = $tabbg;
4123: my $data_table_light = '#EEEEEE';
1.470 banghart 4124: my $data_table_dark = '#DDDDDD';
4125: my $data_table_darker = '#CCCCCC';
1.349 albertel 4126: my $data_table_highlight = '#FFFF00';
1.352 albertel 4127: my $mail_new = '#FFBB77';
4128: my $mail_new_hover = '#DD9955';
4129: my $mail_read = '#BBBB77';
4130: my $mail_read_hover = '#999944';
4131: my $mail_replied = '#AAAA88';
4132: my $mail_replied_hover = '#888855';
4133: my $mail_other = '#99BBBB';
4134: my $mail_other_hover = '#669999';
1.391 albertel 4135: my $table_header = '#DDDDDD';
1.489 raeburn 4136: my $feedback_link_bg = '#BBBBBB';
1.392 albertel 4137:
1.608 albertel 4138: my $border = ($env{'browser.type'} eq 'explorer' ||
4139: $env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px'
4140: : '0px 3px 0px 4px';
1.448 albertel 4141:
1.523 albertel 4142:
1.343 albertel 4143: return <<END;
1.345 albertel 4144: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4145: a:focus { color: red; background: yellow }
1.510 albertel 4146: table.thinborder,
1.523 albertel 4147:
1.510 albertel 4148: table.thinborder tr th {
4149: border-style: solid;
4150: border-width: 1px;
4151: background: $tabbg;
4152: }
1.523 albertel 4153: table.thinborder tr td {
1.510 albertel 4154: border-style: solid;
4155: border-width: 1px
4156: }
1.426 albertel 4157:
1.343 albertel 4158: form, .inline { display: inline; }
4159: .center { text-align: center; }
1.593 albertel 4160: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4161: .LC_error {
4162: color: red;
4163: font-size: larger;
4164: }
1.457 albertel 4165: .LC_warning,
4166: .LC_diff_removed {
1.394 albertel 4167: color: red;
4168: }
1.532 albertel 4169:
4170: .LC_info,
1.457 albertel 4171: .LC_success,
4172: .LC_diff_added {
1.350 albertel 4173: color: green;
4174: }
1.543 albertel 4175: .LC_unknown {
4176: color: yellow;
4177: }
4178:
1.440 albertel 4179: .LC_icon {
4180: border: 0px;
4181: }
1.539 albertel 4182: .LC_indexer_icon {
4183: border: 0px;
4184: height: 22px;
4185: }
1.543 albertel 4186: .LC_docs_spacer {
4187: width: 25px;
4188: height: 1px;
4189: border: 0px;
4190: }
1.346 albertel 4191:
1.532 albertel 4192: .LC_internal_info {
4193: color: #999;
4194: }
4195:
1.458 albertel 4196: table.LC_pastsubmission {
4197: border: 1px solid black;
4198: margin: 2px;
4199: }
4200:
1.606 albertel 4201: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4202: width: 100%;
4203: background: $pgbg;
1.392 albertel 4204: border: 2px;
1.402 albertel 4205: border-collapse: separate;
1.403 albertel 4206: padding: 0px;
1.345 albertel 4207: }
1.392 albertel 4208:
1.606 albertel 4209: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4210: table#LC_title_bar.LC_with_remote {
1.359 albertel 4211: width: 100%;
1.392 albertel 4212: border-color: $pgbg;
4213: border-style: solid;
4214: border-width: $border;
4215:
1.379 albertel 4216: background: $pgbg;
4217: font-family: $sans;
1.392 albertel 4218: border-collapse: collapse;
1.403 albertel 4219: padding: 0px;
1.359 albertel 4220: }
1.392 albertel 4221:
1.409 albertel 4222: table.LC_docs_path {
4223: width: 100%;
4224: border: 0;
4225: background: $pgbg;
4226: font-family: $sans;
4227: border-collapse: collapse;
4228: padding: 0px;
4229: }
4230:
1.359 albertel 4231: table#LC_title_bar td {
4232: background: $tabbg;
4233: }
4234: table#LC_title_bar td.LC_title_bar_who {
4235: background: $tabbg;
4236: color: $font;
1.427 albertel 4237: font: small $sans;
1.359 albertel 4238: text-align: right;
4239: }
1.469 banghart 4240: span.LC_metadata {
4241: font-family: $sans;
4242: }
1.359 albertel 4243: span.LC_title_bar_title {
1.416 albertel 4244: font: bold x-large $sans;
1.359 albertel 4245: }
4246: table#LC_title_bar td.LC_title_bar_domain_logo {
4247: background: $sidebg;
4248: text-align: right;
1.368 albertel 4249: padding: 0px;
4250: }
4251: table#LC_title_bar td.LC_title_bar_role_logo {
4252: background: $sidebg;
4253: padding: 0px;
1.359 albertel 4254: }
4255:
1.346 albertel 4256: table#LC_menubuttons_mainmenu {
1.526 www 4257: width: 100%;
1.346 albertel 4258: border: 0px;
4259: border-spacing: 1px;
1.372 albertel 4260: padding: 0px 1px;
1.346 albertel 4261: margin: 0px;
4262: border-collapse: separate;
4263: }
4264: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
4265: border: 0px;
4266: }
1.345 albertel 4267: table#LC_top_nav td {
4268: background: $tabbg;
1.392 albertel 4269: border: 0px;
1.407 albertel 4270: font-size: small;
1.345 albertel 4271: }
4272: table#LC_top_nav td a, div#LC_top_nav a {
4273: color: $font;
4274: font-family: $sans;
4275: }
1.364 albertel 4276: table#LC_top_nav td.LC_top_nav_logo {
4277: background: $tabbg;
1.432 albertel 4278: text-align: left;
1.408 albertel 4279: white-space: nowrap;
1.432 albertel 4280: width: 31px;
1.408 albertel 4281: }
4282: table#LC_top_nav td.LC_top_nav_logo img {
1.432 albertel 4283: border: 0px;
1.408 albertel 4284: vertical-align: bottom;
1.364 albertel 4285: }
1.432 albertel 4286: table#LC_top_nav td.LC_top_nav_exit,
4287: table#LC_top_nav td.LC_top_nav_help {
4288: width: 2.0em;
4289: }
1.442 albertel 4290: table#LC_top_nav td.LC_top_nav_login {
4291: width: 4.0em;
4292: text-align: center;
4293: }
1.409 albertel 4294: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4295: background: $tabbg;
4296: color: $font;
4297: font-family: $sans;
1.358 albertel 4298: font-size: smaller;
1.357 albertel 4299: }
1.411 albertel 4300: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4301: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4302: background: $tabbg;
4303: color: $font;
4304: font-family: $sans;
4305: font-size: larger;
4306: text-align: right;
4307: }
1.383 albertel 4308: td.LC_table_cell_checkbox {
4309: text-align: center;
4310: }
4311:
1.522 albertel 4312: table#LC_mainmenu td.LC_mainmenu_column {
4313: vertical-align: top;
4314: }
4315:
1.346 albertel 4316: .LC_menubuttons_inline_text {
4317: color: $font;
4318: font-family: $sans;
4319: font-size: smaller;
4320: }
4321:
1.526 www 4322: .LC_menubuttons_link {
4323: text-decoration: none;
4324: }
4325:
1.522 albertel 4326: .LC_menubuttons_category {
1.521 www 4327: color: $font;
1.526 www 4328: background: $pgbg;
1.521 www 4329: font-family: $sans;
4330: font-size: larger;
4331: font-weight: bold;
4332: }
4333:
1.346 albertel 4334: td.LC_menubuttons_text {
1.526 www 4335: width: 90%;
1.346 albertel 4336: color: $font;
4337: font-family: $sans;
4338: }
1.526 www 4339:
1.346 albertel 4340: td.LC_menubuttons_img {
4341: }
1.526 www 4342:
1.346 albertel 4343: .LC_current_location {
4344: font-family: $sans;
4345: background: $tabbg;
4346: }
4347: .LC_new_mail {
4348: font-family: $sans;
4349: font-weight: bold;
4350: }
1.347 albertel 4351:
1.526 www 4352: .LC_rolesmenu_is {
4353: font-family: $sans;
4354: }
4355:
4356: .LC_rolesmenu_selected {
4357: font-family: $sans;
4358: }
4359:
4360: .LC_rolesmenu_future {
4361: font-family: $sans;
4362: }
4363:
4364:
4365: .LC_rolesmenu_will {
4366: font-family: $sans;
4367: }
4368:
4369: .LC_rolesmenu_will_not {
4370: font-family: $sans;
4371: }
4372:
4373: .LC_rolesmenu_expired {
4374: font-family: $sans;
4375: }
4376:
4377: .LC_rolesinfo {
4378: font-family: $sans;
4379: }
4380:
1.527 www 4381: .LC_dropadd_labeltext {
4382: font-family: $sans;
4383: text-align: right;
4384: }
4385:
4386: .LC_preferences_labeltext {
4387: font-family: $sans;
4388: text-align: right;
4389: }
4390:
1.440 albertel 4391: table.LC_aboutme_port {
4392: border: 0px;
4393: border-collapse: collapse;
4394: border-spacing: 0px;
4395: }
1.349 albertel 4396: table.LC_data_table, table.LC_mail_list {
1.347 albertel 4397: border: 1px solid #000000;
1.402 albertel 4398: border-collapse: separate;
1.426 albertel 4399: border-spacing: 1px;
1.347 albertel 4400: }
1.422 albertel 4401: .LC_data_table_dense {
4402: font-size: small;
4403: }
1.507 raeburn 4404: table.LC_nested_outer {
4405: border: 1px solid #000000;
1.589 raeburn 4406: border-collapse: collapse;
1.507 raeburn 4407: border-spacing: 0px;
4408: width: 100%;
4409: }
4410: table.LC_nested {
4411: border: 0px;
1.589 raeburn 4412: border-collapse: collapse;
1.507 raeburn 4413: border-spacing: 0px;
4414: width: 100%;
4415: }
1.523 albertel 4416: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4417: table.LC_prior_tries tr th {
1.349 albertel 4418: font-weight: bold;
4419: background-color: $data_table_head;
1.421 albertel 4420: font-size: smaller;
1.347 albertel 4421: }
1.440 albertel 4422: table.LC_data_table tr td,
4423: table.LC_aboutme_port tr td {
1.349 albertel 4424: background-color: $data_table_light;
1.425 albertel 4425: padding: 2px;
1.347 albertel 4426: }
1.440 albertel 4427: table.LC_data_table tr.LC_even_row td,
4428: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4429: background-color: $data_table_dark;
1.347 albertel 4430: }
1.425 albertel 4431: table.LC_data_table tr.LC_data_table_highlight td {
4432: background-color: $data_table_darker;
4433: }
1.451 albertel 4434: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4435: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4436: background-color: #FFFFFF;
1.421 albertel 4437: font-weight: bold;
4438: font-style: italic;
4439: text-align: center;
4440: padding: 8px;
1.347 albertel 4441: }
1.507 raeburn 4442: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4443: padding: 4ex
4444: }
1.507 raeburn 4445: table.LC_nested_outer tr th {
4446: font-weight: bold;
4447: background-color: $data_table_head;
4448: font-size: smaller;
4449: border-bottom: 1px solid #000000;
4450: }
4451: table.LC_nested_outer tr td.LC_subheader {
4452: background-color: $data_table_head;
4453: font-weight: bold;
4454: font-size: small;
4455: border-bottom: 1px solid #000000;
4456: text-align: right;
1.451 albertel 4457: }
1.507 raeburn 4458: table.LC_nested tr.LC_info_row td {
1.451 albertel 4459: background-color: #CCC;
4460: font-weight: bold;
4461: font-size: small;
1.507 raeburn 4462: text-align: center;
4463: }
1.589 raeburn 4464: table.LC_nested tr.LC_info_row td.LC_left_item,
4465: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4466: text-align: left;
1.451 albertel 4467: }
1.507 raeburn 4468: table.LC_nested td {
1.451 albertel 4469: background-color: #FFF;
4470: font-size: small;
1.507 raeburn 4471: }
4472: table.LC_nested_outer tr th.LC_right_item,
4473: table.LC_nested tr.LC_info_row td.LC_right_item,
4474: table.LC_nested tr.LC_odd_row td.LC_right_item,
4475: table.LC_nested tr td.LC_right_item {
1.451 albertel 4476: text-align: right;
4477: }
4478:
1.507 raeburn 4479: table.LC_nested tr.LC_odd_row td {
1.451 albertel 4480: background-color: #EEE;
4481: }
4482:
1.473 raeburn 4483: table.LC_createuser {
4484: }
4485:
4486: table.LC_createuser tr.LC_section_row td {
4487: font-size: smaller;
4488: }
4489:
4490: table.LC_createuser tr.LC_info_row td {
4491: background-color: #CCC;
4492: font-weight: bold;
4493: text-align: center;
4494: }
4495:
1.349 albertel 4496: table.LC_calendar {
4497: border: 1px solid #000000;
4498: border-collapse: collapse;
4499: }
4500: table.LC_calendar_pickdate {
4501: font-size: xx-small;
4502: }
4503: table.LC_calendar tr td {
4504: border: 1px solid #000000;
4505: vertical-align: top;
4506: }
4507: table.LC_calendar tr td.LC_calendar_day_empty {
4508: background-color: $data_table_dark;
4509: }
4510: table.LC_calendar tr td.LC_calendar_day_current {
4511: background-color: $data_table_highlight;
4512: }
4513:
4514: table.LC_mail_list tr.LC_mail_new {
4515: background-color: $mail_new;
4516: }
4517: table.LC_mail_list tr.LC_mail_new:hover {
4518: background-color: $mail_new_hover;
4519: }
4520: table.LC_mail_list tr.LC_mail_read {
4521: background-color: $mail_read;
4522: }
4523: table.LC_mail_list tr.LC_mail_read:hover {
4524: background-color: $mail_read_hover;
4525: }
4526: table.LC_mail_list tr.LC_mail_replied {
4527: background-color: $mail_replied;
4528: }
4529: table.LC_mail_list tr.LC_mail_replied:hover {
4530: background-color: $mail_replied_hover;
4531: }
4532: table.LC_mail_list tr.LC_mail_other {
4533: background-color: $mail_other;
4534: }
4535: table.LC_mail_list tr.LC_mail_other:hover {
4536: background-color: $mail_other_hover;
4537: }
1.494 raeburn 4538: table.LC_mail_list tr.LC_mail_even {
4539: }
4540: table.LC_mail_list tr.LC_mail_odd {
4541: }
4542:
1.385 albertel 4543:
1.386 albertel 4544: table#LC_portfolio_actions {
4545: width: auto;
4546: background: $pgbg;
4547: border: 0px;
4548: border-spacing: 2px 2px;
4549: padding: 0px;
4550: margin: 0px;
4551: border-collapse: separate;
4552: }
4553: table#LC_portfolio_actions td.LC_label {
4554: background: $tabbg;
4555: text-align: right;
4556: }
4557: table#LC_portfolio_actions td.LC_value {
4558: background: $tabbg;
4559: }
1.385 albertel 4560:
1.391 albertel 4561: table#LC_cstr_controls {
4562: width: 100%;
4563: border-collapse: collapse;
4564: }
4565: table#LC_cstr_controls tr td {
4566: border: 4px solid $pgbg;
4567: padding: 4px;
4568: text-align: center;
4569: background: $tabbg;
4570: }
4571: table#LC_cstr_controls tr th {
4572: border: 4px solid $pgbg;
4573: background: $table_header;
4574: text-align: center;
4575: font-family: $sans;
4576: font-size: smaller;
4577: }
4578:
1.389 albertel 4579: table#LC_browser {
4580:
4581: }
4582: table#LC_browser tr th {
1.391 albertel 4583: background: $table_header;
1.389 albertel 4584: }
1.390 albertel 4585: table#LC_browser tr td {
4586: padding: 2px;
4587: }
1.389 albertel 4588: table#LC_browser tr.LC_browser_file,
4589: table#LC_browser tr.LC_browser_file_published {
4590: background: #CCFF88;
4591: }
4592: table#LC_browser tr.LC_browser_file_locked,
4593: table#LC_browser tr.LC_browser_file_unpublished {
4594: background: #FFAA99;
1.387 albertel 4595: }
1.389 albertel 4596: table#LC_browser tr.LC_browser_file_obsolete {
4597: background: #AAAAAA;
1.387 albertel 4598: }
1.455 albertel 4599: table#LC_browser tr.LC_browser_file_modified,
4600: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 4601: background: #FFFF77;
1.387 albertel 4602: }
1.389 albertel 4603: table#LC_browser tr.LC_browser_folder {
4604: background: #CCCCFF;
1.387 albertel 4605: }
1.388 albertel 4606: span.LC_current_location {
4607: font-size: x-large;
4608: background: $pgbg;
4609: }
1.387 albertel 4610:
1.395 albertel 4611: span.LC_parm_menu_item {
4612: font-size: larger;
4613: font-family: $sans;
4614: }
4615: span.LC_parm_scope_all {
4616: color: red;
4617: }
4618: span.LC_parm_scope_folder {
4619: color: green;
4620: }
4621: span.LC_parm_scope_resource {
4622: color: orange;
4623: }
4624: span.LC_parm_part {
4625: color: blue;
4626: }
4627: span.LC_parm_folder, span.LC_parm_symb {
4628: font-size: x-small;
4629: font-family: $mono;
4630: color: #AAAAAA;
4631: }
4632:
1.396 albertel 4633: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
4634: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
4635: border: 1px solid black;
4636: border-collapse: collapse;
4637: }
4638: table.LC_parm_overview_restrictions td {
4639: border-width: 1px 4px 1px 4px;
4640: border-style: solid;
4641: border-color: $pgbg;
4642: text-align: center;
4643: }
4644: table.LC_parm_overview_restrictions th {
4645: background: $tabbg;
4646: border-width: 1px 4px 1px 4px;
4647: border-style: solid;
4648: border-color: $pgbg;
4649: }
1.398 albertel 4650: table#LC_helpmenu {
4651: border: 0px;
4652: height: 55px;
4653: border-spacing: 0px;
4654: }
4655:
4656: table#LC_helpmenu fieldset legend {
4657: font-size: larger;
4658: font-weight: bold;
4659: }
1.397 albertel 4660: table#LC_helpmenu_links {
4661: width: 100%;
4662: border: 1px solid black;
4663: background: $pgbg;
4664: padding: 0px;
4665: border-spacing: 1px;
4666: }
4667: table#LC_helpmenu_links tr td {
4668: padding: 1px;
4669: background: $tabbg;
1.399 albertel 4670: text-align: center;
4671: font-weight: bold;
1.397 albertel 4672: }
1.396 albertel 4673:
1.397 albertel 4674: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
4675: table#LC_helpmenu_links a:active {
4676: text-decoration: none;
4677: color: $font;
4678: }
4679: table#LC_helpmenu_links a:hover {
4680: text-decoration: underline;
4681: color: $vlink;
4682: }
1.396 albertel 4683:
1.417 albertel 4684: .LC_chrt_popup_exists {
4685: border: 1px solid #339933;
4686: margin: -1px;
4687: }
4688: .LC_chrt_popup_up {
4689: border: 1px solid yellow;
4690: margin: -1px;
4691: }
4692: .LC_chrt_popup {
4693: border: 1px solid #8888FF;
4694: background: #CCCCFF;
4695: }
1.421 albertel 4696: table.LC_pick_box {
4697: border-collapse: separate;
4698: background: white;
4699: border: 1px solid black;
4700: border-spacing: 1px;
4701: }
4702: table.LC_pick_box td.LC_pick_box_title {
4703: background: $tabbg;
4704: font-weight: bold;
4705: text-align: right;
4706: width: 184px;
4707: padding: 8px;
4708: }
1.579 raeburn 4709: table.LC_pick_box td.LC_pick_box_value {
4710: text-align: left;
4711: padding: 8px;
4712: }
4713: table.LC_pick_box td.LC_pick_box_select {
4714: text-align: left;
4715: padding: 8px;
4716: }
1.424 albertel 4717: table.LC_pick_box td.LC_pick_box_separator {
1.421 albertel 4718: padding: 0px;
4719: height: 1px;
4720: background: black;
4721: }
4722: table.LC_pick_box td.LC_pick_box_submit {
4723: text-align: right;
4724: }
1.579 raeburn 4725: table.LC_pick_box td.LC_evenrow_value {
4726: text-align: left;
4727: padding: 8px;
4728: background-color: $data_table_light;
4729: }
4730: table.LC_pick_box td.LC_oddrow_value {
4731: text-align: left;
4732: padding: 8px;
4733: background-color: $data_table_light;
4734: }
4735: table.LC_helpform_receipt {
4736: width: 620px;
4737: border-collapse: separate;
4738: background: white;
4739: border: 1px solid black;
4740: border-spacing: 1px;
4741: }
4742: table.LC_helpform_receipt td.LC_pick_box_title {
4743: background: $tabbg;
4744: font-weight: bold;
4745: text-align: right;
4746: width: 184px;
4747: padding: 8px;
4748: }
4749: table.LC_helpform_receipt td.LC_evenrow_value {
4750: text-align: left;
4751: padding: 8px;
4752: background-color: $data_table_light;
4753: }
4754: table.LC_helpform_receipt td.LC_oddrow_value {
4755: text-align: left;
4756: padding: 8px;
4757: background-color: $data_table_light;
4758: }
4759: table.LC_helpform_receipt td.LC_pick_box_separator {
4760: padding: 0px;
4761: height: 1px;
4762: background: black;
4763: }
4764: span.LC_helpform_receipt_cat {
4765: font-weight: bold;
4766: }
1.424 albertel 4767: table.LC_group_priv_box {
4768: background: white;
4769: border: 1px solid black;
4770: border-spacing: 1px;
4771: }
4772: table.LC_group_priv_box td.LC_pick_box_title {
4773: background: $tabbg;
4774: font-weight: bold;
4775: text-align: right;
4776: width: 184px;
4777: }
4778: table.LC_group_priv_box td.LC_groups_fixed {
4779: background: $data_table_light;
4780: text-align: center;
4781: }
4782: table.LC_group_priv_box td.LC_groups_optional {
4783: background: $data_table_dark;
4784: text-align: center;
4785: }
4786: table.LC_group_priv_box td.LC_groups_functionality {
4787: background: $data_table_darker;
4788: text-align: center;
4789: font-weight: bold;
4790: }
4791: table.LC_group_priv td {
4792: text-align: left;
4793: padding: 0px;
4794: }
4795:
1.421 albertel 4796: table.LC_notify_front_page {
4797: background: white;
4798: border: 1px solid black;
4799: padding: 8px;
4800: }
4801: table.LC_notify_front_page td {
4802: padding: 8px;
4803: }
1.424 albertel 4804: .LC_navbuttons {
4805: margin: 2ex 0ex 2ex 0ex;
4806: }
1.423 albertel 4807: .LC_topic_bar {
4808: font-family: $sans;
4809: font-weight: bold;
4810: width: 100%;
4811: background: $tabbg;
4812: vertical-align: middle;
4813: margin: 2ex 0ex 2ex 0ex;
4814: }
4815: .LC_topic_bar span {
4816: vertical-align: middle;
4817: }
4818: .LC_topic_bar img {
4819: vertical-align: bottom;
4820: }
4821: table.LC_course_group_status {
4822: margin: 20px;
4823: }
4824: table.LC_status_selector td {
4825: vertical-align: top;
4826: text-align: center;
1.424 albertel 4827: padding: 4px;
4828: }
4829: table.LC_descriptive_input td.LC_description {
4830: vertical-align: top;
4831: text-align: right;
4832: font-weight: bold;
1.423 albertel 4833: }
1.599 albertel 4834: div.LC_feedback_link {
4835: background: white;
4836: width: 100%;
1.489 raeburn 4837: }
4838: span.LC_feedback_link {
1.599 albertel 4839: background: $feedback_link_bg;
4840: font-size: larger;
4841: }
4842: span.LC_message_link {
4843: background: $feedback_link_bg;
4844: font-size: larger;
4845: position: absolute;
4846: right: 1em;
1.489 raeburn 4847: }
1.421 albertel 4848:
1.515 albertel 4849: table.LC_prior_tries {
1.524 albertel 4850: border: 1px solid #000000;
4851: border-collapse: separate;
4852: border-spacing: 1px;
1.515 albertel 4853: }
1.523 albertel 4854:
1.515 albertel 4855: table.LC_prior_tries td {
1.524 albertel 4856: padding: 2px;
1.515 albertel 4857: }
1.523 albertel 4858:
4859: .LC_answer_correct {
4860: background: #AAFFAA;
4861: color: black;
4862: }
4863: .LC_answer_charged_try {
4864: background: #FFAAAA ! important;
4865: color: black;
4866: }
4867: .LC_answer_not_charged_try,
4868: .LC_answer_no_grade,
4869: .LC_answer_late {
4870: background: #FFFFAA;
4871: color: black;
4872: }
4873: .LC_answer_previous {
4874: background: #AAAAFF;
4875: color: black;
4876: }
4877: .LC_answer_no_message {
4878: background: #FFFFFF;
4879: color: black;
4880: }
4881: .LC_answer_unknown {
4882: background: orange;
4883: color: black;
4884: }
4885:
4886:
1.529 albertel 4887: span.LC_prior_numerical,
4888: span.LC_prior_string,
4889: span.LC_prior_custom,
4890: span.LC_prior_reaction,
4891: span.LC_prior_math {
1.523 albertel 4892: font-family: monospace;
4893: white-space: pre;
4894: }
4895:
1.525 albertel 4896: span.LC_prior_string {
4897: font-family: monospace;
4898: white-space: pre;
4899: }
4900:
1.523 albertel 4901: table.LC_prior_option {
4902: width: 100%;
4903: border-collapse: collapse;
4904: }
1.528 albertel 4905: table.LC_prior_rank, table.LC_prior_match {
4906: border-collapse: collapse;
4907: }
4908: table.LC_prior_option tr td,
4909: table.LC_prior_rank tr td,
4910: table.LC_prior_match tr td {
1.524 albertel 4911: border: 1px solid #000000;
1.515 albertel 4912: }
4913:
1.519 raeburn 4914: span.LC_nobreak {
1.544 albertel 4915: white-space: nowrap;
1.519 raeburn 4916: }
4917:
1.576 raeburn 4918: span.LC_cusr_emph {
4919: font-style: italic;
4920: }
4921:
1.545 albertel 4922: table.LC_docs_documents {
4923: background: #BBBBBB;
1.547 albertel 4924: border-width: 0px;
1.545 albertel 4925: border-collapse: collapse;
4926: }
4927:
4928: table.LC_docs_documents td.LC_docs_document {
4929: border: 2px solid black;
4930: padding: 4px;
4931: }
4932:
4933: .LC_docs_course_commands div {
4934: float: left;
4935: border: 4px solid #AAAAAA;
4936: padding: 4px;
4937: background: #DDDDCC;
4938: }
4939:
4940: .LC_docs_entry_move {
4941: border: 0px;
4942: border-collapse: collapse;
1.544 albertel 4943: }
4944:
1.545 albertel 4945: .LC_docs_entry_move td {
4946: border: 2px solid #BBBBBB;
4947: background: #DDDDDD;
4948: }
4949:
4950: .LC_docs_editor td.LC_docs_entry_commands {
4951: background: #DDDDDD;
4952: font-size: x-small;
4953: }
1.544 albertel 4954: .LC_docs_copy {
1.545 albertel 4955: color: #000099;
1.544 albertel 4956: }
4957: .LC_docs_cut {
1.545 albertel 4958: color: #550044;
1.544 albertel 4959: }
4960: .LC_docs_rename {
1.545 albertel 4961: color: #009900;
1.544 albertel 4962: }
4963: .LC_docs_remove {
1.545 albertel 4964: color: #990000;
4965: }
4966:
1.547 albertel 4967: .LC_docs_reinit_warn,
4968: .LC_docs_ext_edit {
4969: font-size: x-small;
4970: }
4971:
1.545 albertel 4972: .LC_docs_editor td.LC_docs_entry_title,
4973: .LC_docs_editor td.LC_docs_entry_icon {
4974: background: #FFFFBB;
4975: }
4976: .LC_docs_editor td.LC_docs_entry_parameter {
4977: background: #BBBBFF;
4978: font-size: x-small;
4979: white-space: nowrap;
4980: }
4981:
4982: table.LC_docs_adddocs td,
4983: table.LC_docs_adddocs th {
4984: border: 1px solid #BBBBBB;
4985: padding: 4px;
4986: background: #DDDDDD;
1.543 albertel 4987: }
4988:
1.584 albertel 4989: table.LC_sty_begin {
4990: background: #BBFFBB;
4991: }
4992: table.LC_sty_end {
4993: background: #FFBBBB;
4994: }
4995:
1.589 raeburn 4996: table.LC_double_column {
4997: border-width: 0px;
4998: border-collapse: collapse;
4999: width: 100%;
5000: padding: 2px;
5001: }
5002:
5003: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5004: top: 2px;
1.589 raeburn 5005: left: 2px;
5006: width: 47%;
5007: vertical-align: top;
5008: }
5009:
5010: table.LC_double_column tr td.LC_right_col {
5011: top: 2px;
5012: right: 2px;
5013: width: 47%;
5014: vertical-align: top;
5015: }
5016:
1.594 raeburn 5017: span.LC_role_level {
5018: font-weight: bold;
5019: }
5020:
1.591 raeburn 5021: div.LC_left_float {
5022: float: left;
5023: padding-right: 5%;
1.597 albertel 5024: padding-bottom: 4px;
1.591 raeburn 5025: }
5026:
5027: div.LC_clear_float_header {
1.597 albertel 5028: padding-bottom: 2px;
1.591 raeburn 5029: }
5030:
5031: div.LC_clear_float_footer {
1.597 albertel 5032: padding-top: 10px;
1.591 raeburn 5033: clear: both;
5034: }
5035:
1.597 albertel 5036:
1.601 albertel 5037: div.LC_grade_select_mode {
5038: float: left;
1.604 albertel 5039: font-family: $sans;
1.601 albertel 5040: }
5041: div.LC_grade_select_mode div div {
5042: margin: 5px;
5043: }
5044: div.LC_grade_select_mode_selector {
5045: margin: 5px;
5046: float: left;
5047: }
5048: div.LC_grade_select_mode_selector_header {
5049: font: bold medium $sans;
5050: }
5051: div.LC_grade_select_mode_type {
5052: clear: left;
5053: }
5054:
1.597 albertel 5055: div.LC_grade_show_user {
5056: margin-top: 20px;
5057: border: 1px solid black;
5058: }
5059: div.LC_grade_user_name {
5060: background: #DDDDEE;
5061: border-bottom: 1px solid black;
5062: font: bold large $sans;
5063: }
5064: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5065: background: #DDEEDD;
5066: }
5067:
5068: div.LC_grade_show_problem,
5069: div.LC_grade_submissions,
5070: div.LC_grade_message_center,
5071: div.LC_grade_info_links,
5072: div.LC_grade_assign {
5073: margin: 5px;
5074: width: 99%;
5075: background: #FFFFFF;
5076: }
5077: div.LC_grade_show_problem_header,
5078: div.LC_grade_submissions_header,
5079: div.LC_grade_message_center_header,
5080: div.LC_grade_assign_header {
5081: font: bold large $sans;
5082: }
5083: div.LC_grade_show_problem_problem,
5084: div.LC_grade_submissions_body,
5085: div.LC_grade_message_center_body,
5086: div.LC_grade_assign_body {
5087: border: 1px solid black;
5088: width: 99%;
5089: background: #FFFFFF;
5090: }
1.598 albertel 5091: span.LC_grade_check_note {
5092: font: normal medium $sans;
5093: display: inline;
5094: position: absolute;
5095: right: 1em;
5096: }
1.597 albertel 5097:
1.600 albertel 5098:
5099: div.LC_edit_problem_header {
5100: font: normal medium $sans;
1.602 albertel 5101: margin: 2px;
1.600 albertel 5102: }
5103: div.LC_edit_problem_header,
1.602 albertel 5104: div.LC_edit_problem_header div,
5105: div.LC_edit_problem_editxml_header,
5106: div.LC_edit_problem_editxml_header div {
1.600 albertel 5107: margin-top: 5px;
5108: }
1.602 albertel 5109: div.LC_edit_problem_header_edit_row {
5110: background: $tabbg;
5111: padding: 3px;
5112: margin-bottom: 5px;
5113: }
1.600 albertel 5114: div.LC_edit_problem_header_title {
1.602 albertel 5115: font: larger bold $sans;
5116: background: $tabbg;
5117: padding: 3px;
5118: }
5119: table.LC_edit_problem_header_title {
5120: font: larger bold $sans;
5121: width: 100%;
5122: border-color: $pgbg;
5123: border-style: solid;
5124: border-width: $border;
5125:
1.600 albertel 5126: background: $tabbg;
1.602 albertel 5127: border-collapse: collapse;
5128: padding: 0px
5129: }
5130:
5131: div.LC_edit_problem_discards {
5132: float: left;
5133: padding-bottom: 5px;
5134: }
5135: div.LC_edit_problem_saves {
5136: float: right;
5137: padding-bottom: 5px;
1.600 albertel 5138: }
5139: hr.LC_edit_problem_divide {
1.602 albertel 5140: clear: both;
1.600 albertel 5141: color: $tabbg;
5142: background-color: $tabbg;
5143: height: 3px;
5144: border: 0px;
5145: }
1.343 albertel 5146: END
5147: }
5148:
1.306 albertel 5149: =pod
5150:
5151: =item * &headtag()
5152:
5153: Returns a uniform footer for LON-CAPA web pages.
5154:
1.307 albertel 5155: Inputs: $title - optional title for the head
5156: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5157: $args - optional arguments
1.319 albertel 5158: force_register - if is true call registerurl so the remote is
5159: informed
1.415 albertel 5160: redirect -> array ref of
5161: 1- seconds before redirect occurs
5162: 2- url to redirect to
5163: 3- whether the side effect should occur
1.315 albertel 5164: (side effect of setting
5165: $env{'internal.head.redirect'} to the url
5166: redirected too)
1.352 albertel 5167: domain -> force to color decorate a page for a specific
5168: domain
5169: function -> force usage of a specific rolish color scheme
5170: bgcolor -> override the default page bgcolor
1.460 albertel 5171: no_auto_mt_title
5172: -> prevent &mt()ing the title arg
1.464 albertel 5173:
1.306 albertel 5174: =cut
5175:
5176: sub headtag {
1.313 albertel 5177: my ($title,$head_extra,$args) = @_;
1.306 albertel 5178:
1.363 albertel 5179: my $function = $args->{'function'} || &get_users_function();
5180: my $domain = $args->{'domain'} || &determinedomain();
5181: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5182: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5183: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5184: #time(),
1.418 albertel 5185: $env{'environment.color.timestamp'},
1.363 albertel 5186: $function,$domain,$bgcolor);
5187:
1.369 www 5188: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5189:
1.308 albertel 5190: my $result =
5191: '<head>'.
1.461 albertel 5192: &font_settings();
1.319 albertel 5193:
1.461 albertel 5194: if (!$args->{'frameset'}) {
5195: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5196: }
1.319 albertel 5197: if ($args->{'force_register'}) {
5198: $result .= &Apache::lonmenu::registerurl(1);
5199: }
1.436 albertel 5200: if (!$args->{'no_nav_bar'}
5201: && !$args->{'only_body'}
5202: && !$args->{'frameset'}) {
5203: $result .= &help_menu_js();
5204: }
1.319 albertel 5205:
1.314 albertel 5206: if (ref($args->{'redirect'})) {
1.414 albertel 5207: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5208: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5209: if (!$inhibit_continue) {
5210: $env{'internal.head.redirect'} = $url;
5211: }
1.313 albertel 5212: $result.=<<ADDMETA
5213: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5214: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5215: ADDMETA
5216: }
1.306 albertel 5217: if (!defined($title)) {
5218: $title = 'The LearningOnline Network with CAPA';
5219: }
1.460 albertel 5220: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5221: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5222: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5223: .$head_extra;
1.306 albertel 5224: return $result;
5225: }
5226:
5227: =pod
5228:
1.340 albertel 5229: =item * &font_settings()
5230:
5231: Returns neccessary <meta> to set the proper encoding
5232:
5233: Inputs: none
5234:
5235: =cut
5236:
5237: sub font_settings {
5238: my $headerstring='';
5239: if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
5240: $headerstring.=
5241: '<meta Content-Type="text/html; charset=x-mac-roman" />';
5242: } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
5243: $headerstring.=
5244: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5245: }
5246: return $headerstring;
5247: }
5248:
1.341 albertel 5249: =pod
5250:
5251: =item * &xml_begin()
5252:
5253: Returns the needed doctype and <html>
5254:
5255: Inputs: none
5256:
5257: =cut
5258:
5259: sub xml_begin {
5260: my $output='';
5261:
1.592 albertel 5262: if ($env{'internal.start_page'}==1) {
5263: &Apache::lonhtmlcommon::init_htmlareafields();
5264: }
1.342 albertel 5265:
1.341 albertel 5266: if ($env{'browser.mathml'}) {
5267: $output='<?xml version="1.0"?>'
5268: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5269: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5270:
5271: # .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
5272: .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
5273: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5274: .'xmlns="http://www.w3.org/1999/xhtml">';
5275: } else {
5276: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
5277: }
5278: return $output;
5279: }
1.340 albertel 5280:
5281: =pod
5282:
1.306 albertel 5283: =item * &endheadtag()
5284:
5285: Returns a uniform </head> for LON-CAPA web pages.
5286:
5287: Inputs: none
5288:
5289: =cut
5290:
5291: sub endheadtag {
5292: return '</head>';
5293: }
5294:
5295: =pod
5296:
5297: =item * &head()
5298:
5299: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5300:
5301: Inputs: $title - optional title for the page
1.307 albertel 5302: $head_extra - optional extra HTML to put inside the <head>
1.405 albertel 5303:
1.306 albertel 5304: =cut
5305:
5306: sub head {
1.325 albertel 5307: my ($title,$head_extra,$args) = @_;
5308: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5309: }
5310:
5311: =pod
5312:
5313: =item * &start_page()
5314:
5315: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5316:
5317: Inputs: $title - optional title for the page
5318: $head_extra - optional extra HTML to incude inside the <head>
1.315 albertel 5319: $args - additional optional args supported are:
1.317 albertel 5320: only_body -> is true will set &bodytag() onlybodytag
5321: arg on
5322: no_nav_bar -> is true will set &bodytag() notopbar arg on
5323: add_entries -> additional attributes to add to the <body>
5324: domain -> force to color decorate a page for a
5325: specific domain
5326: function -> force usage of a specific rolish color
5327: scheme
5328: redirect -> see &headtag()
5329: bgcolor -> override the default page bg color
5330: js_ready -> return a string ready for being used in
5331: a javascript writeln
1.320 albertel 5332: html_encode -> return a string ready for being used in
5333: a html attribute
1.317 albertel 5334: force_register -> if is true will turn on the &bodytag()
5335: $forcereg arg
1.326 albertel 5336: body_title -> alternate text to use instead of $title
5337: in the title box that appears, this text
5338: is not auto translated like the $title is
1.330 albertel 5339: frameset -> if true will start with a <frameset>
5340: rather than <body>
1.338 albertel 5341: no_title -> if true the title bar won't be shown
5342: skip_phases -> hash ref of
5343: head -> skip the <html><head> generation
5344: body -> skip all <body> generation
1.337 albertel 5345:
1.361 albertel 5346: no_inline_link -> if true and in remote mode, don't show the
5347: 'Switch To Inline Menu' link
5348:
1.460 albertel 5349: no_auto_mt_title -> prevent &mt()ing the title arg
5350:
1.562 albertel 5351: inherit_jsmath -> when creating popup window in a page,
5352: should it have jsmath forced on by the
5353: current page
5354:
1.306 albertel 5355: =cut
5356:
5357: sub start_page {
1.309 albertel 5358: my ($title,$head_extra,$args) = @_;
1.318 albertel 5359: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5360: my %head_args;
1.352 albertel 5361: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5362: 'bgcolor','frameset','no_nav_bar','only_body',
5363: 'no_auto_mt_title') {
1.319 albertel 5364: if (defined($args->{$arg})) {
1.324 raeburn 5365: $head_args{$arg} = $args->{$arg};
1.319 albertel 5366: }
1.313 albertel 5367: }
1.319 albertel 5368:
1.315 albertel 5369: $env{'internal.start_page'}++;
1.338 albertel 5370: my $result;
5371: if (! exists($args->{'skip_phases'}{'head'}) ) {
5372: $result.=
1.341 albertel 5373: &xml_begin().
1.338 albertel 5374: &headtag($title,$head_extra,\%head_args).&endheadtag();
5375: }
5376:
5377: if (! exists($args->{'skip_phases'}{'body'}) ) {
5378: if ($args->{'frameset'}) {
5379: my $attr_string = &make_attr_string($args->{'force_register'},
5380: $args->{'add_entries'});
5381: $result .= "\n<frameset $attr_string>\n";
5382: } else {
5383: $result .=
5384: &bodytag($title,
5385: $args->{'function'}, $args->{'add_entries'},
5386: $args->{'only_body'}, $args->{'domain'},
5387: $args->{'force_register'}, $args->{'body_title'},
5388: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5389: $args->{'no_title'}, $args->{'no_inline_link'},
5390: $args);
1.338 albertel 5391: }
1.330 albertel 5392: }
1.338 albertel 5393:
1.315 albertel 5394: if ($args->{'js_ready'}) {
1.317 albertel 5395: $result = &js_ready($result);
1.315 albertel 5396: }
1.320 albertel 5397: if ($args->{'html_encode'}) {
5398: $result = &html_encode($result);
5399: }
1.315 albertel 5400: return $result;
1.306 albertel 5401: }
5402:
1.330 albertel 5403:
1.306 albertel 5404: =pod
5405:
5406: =item * &head()
5407:
5408: Returns a complete </body></html> section for LON-CAPA web pages.
5409:
1.315 albertel 5410: Inputs: $args - additional optional args supported are:
5411: js_ready -> return a string ready for being used in
5412: a javascript writeln
1.320 albertel 5413: html_encode -> return a string ready for being used in
5414: a html attribute
1.330 albertel 5415: frameset -> if true will start with a <frameset>
5416: rather than <body>
1.493 albertel 5417: dicsussion -> if true will get discussion from
5418: lonxml::xmlend
5419: (you can pass the target and parser arguments
5420: through optional 'target' and 'parser' args
5421: to this routine)
1.306 albertel 5422:
5423: =cut
5424:
5425: sub end_page {
1.315 albertel 5426: my ($args) = @_;
5427: $env{'internal.end_page'}++;
1.330 albertel 5428: my $result;
1.335 albertel 5429: if ($args->{'discussion'}) {
5430: my ($target,$parser);
5431: if (ref($args->{'discussion'})) {
5432: ($target,$parser) =($args->{'discussion'}{'target'},
5433: $args->{'discussion'}{'parser'});
5434: }
5435: $result .= &Apache::lonxml::xmlend($target,$parser);
5436: }
5437:
1.330 albertel 5438: if ($args->{'frameset'}) {
5439: $result .= '</frameset>';
5440: } else {
5441: $result .= &endbodytag();
5442: }
5443: $result .= "\n</html>";
5444:
1.315 albertel 5445: if ($args->{'js_ready'}) {
1.317 albertel 5446: $result = &js_ready($result);
1.315 albertel 5447: }
1.335 albertel 5448:
1.320 albertel 5449: if ($args->{'html_encode'}) {
5450: $result = &html_encode($result);
5451: }
1.335 albertel 5452:
1.315 albertel 5453: return $result;
5454: }
5455:
1.320 albertel 5456: sub html_encode {
5457: my ($result) = @_;
5458:
1.322 albertel 5459: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 5460:
5461: return $result;
5462: }
1.317 albertel 5463: sub js_ready {
5464: my ($result) = @_;
5465:
1.323 albertel 5466: $result =~ s/[\n\r]/ /xmsg;
5467: $result =~ s/\\/\\\\/xmsg;
5468: $result =~ s/'/\\'/xmsg;
1.372 albertel 5469: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 5470:
5471: return $result;
5472: }
5473:
1.315 albertel 5474: sub validate_page {
5475: if ( exists($env{'internal.start_page'})
1.316 albertel 5476: && $env{'internal.start_page'} > 1) {
5477: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 5478: $env{'internal.start_page'}.' '.
1.316 albertel 5479: $ENV{'request.filename'});
1.315 albertel 5480: }
5481: if ( exists($env{'internal.end_page'})
1.316 albertel 5482: && $env{'internal.end_page'} > 1) {
5483: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 5484: $env{'internal.end_page'}.' '.
1.316 albertel 5485: $env{'request.filename'});
1.315 albertel 5486: }
5487: if ( exists($env{'internal.start_page'})
5488: && ! exists($env{'internal.end_page'})) {
1.316 albertel 5489: &Apache::lonnet::logthis('start_page called without end_page '.
5490: $env{'request.filename'});
1.315 albertel 5491: }
5492: if ( ! exists($env{'internal.start_page'})
5493: && exists($env{'internal.end_page'})) {
1.316 albertel 5494: &Apache::lonnet::logthis('end_page called without start_page'.
5495: $env{'request.filename'});
1.315 albertel 5496: }
1.306 albertel 5497: }
1.315 albertel 5498:
1.318 albertel 5499: sub simple_error_page {
5500: my ($r,$title,$msg) = @_;
5501: my $page =
5502: &Apache::loncommon::start_page($title).
5503: &mt($msg).
5504: &Apache::loncommon::end_page();
5505: if (ref($r)) {
5506: $r->print($page);
1.327 albertel 5507: return;
1.318 albertel 5508: }
5509: return $page;
5510: }
1.347 albertel 5511:
5512: {
5513: my $row_count;
5514: sub start_data_table {
1.422 albertel 5515: my ($add_class) = @_;
5516: my $css_class = (join(' ','LC_data_table',$add_class));
1.347 albertel 5517: undef($row_count);
1.422 albertel 5518: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 5519: }
5520:
5521: sub end_data_table {
5522: undef($row_count);
1.389 albertel 5523: return '</table>'."\n";;
1.347 albertel 5524: }
5525:
5526: sub start_data_table_row {
1.422 albertel 5527: my ($add_class) = @_;
1.347 albertel 5528: $row_count++;
1.422 albertel 5529: my $css_class = ($row_count % 2)?'':'LC_even_row';
1.428 albertel 5530: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 5531: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 5532: }
1.471 banghart 5533:
5534: sub continue_data_table_row {
5535: my ($add_class) = @_;
5536: my $css_class = ($row_count % 2)?'':'LC_even_row';
5537: $css_class = (join(' ',$css_class,$add_class));
5538: return '<tr class="'.$css_class.'">'."\n";;
5539: }
1.347 albertel 5540:
5541: sub end_data_table_row {
1.389 albertel 5542: return '</tr>'."\n";;
1.347 albertel 5543: }
1.367 www 5544:
1.421 albertel 5545: sub start_data_table_empty_row {
5546: $row_count++;
5547: return '<tr class="LC_empty_row" >'."\n";;
5548: }
5549:
5550: sub end_data_table_empty_row {
5551: return '</tr>'."\n";;
5552: }
5553:
1.367 www 5554: sub start_data_table_header_row {
1.389 albertel 5555: return '<tr class="LC_header_row">'."\n";;
1.367 www 5556: }
5557:
5558: sub end_data_table_header_row {
1.389 albertel 5559: return '</tr>'."\n";;
1.367 www 5560: }
1.347 albertel 5561: }
5562:
1.548 albertel 5563: =pod
5564:
5565: =item * &inhibit_menu_check($arg)
5566:
5567: Checks for a inhibitmenu state and generates output to preserve it
5568:
5569: Inputs: $arg - can be any of
5570: - undef - in which case the return value is a string
5571: to add into arguments list of a uri
5572: - 'input' - in which case the return value is a HTML
5573: <form> <input> field of type hidden to
5574: preserve the value
5575: - a url - in which case the return value is the url with
5576: the neccesary cgi args added to preserve the
5577: inhibitmenu state
5578: - a ref to a url - no return value, but the string is
5579: updated to include the neccessary cgi
5580: args to preserve the inhibitmenu state
5581:
5582: =cut
5583:
5584: sub inhibit_menu_check {
5585: my ($arg) = @_;
5586: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5587: if ($arg eq 'input') {
5588: if ($env{'form.inhibitmenu'}) {
5589: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
5590: } else {
5591: return
5592: }
5593: }
5594: if ($env{'form.inhibitmenu'}) {
5595: if (ref($arg)) {
5596: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5597: } elsif ($arg eq '') {
5598: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
5599: } else {
5600: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5601: }
5602: }
5603: if (!ref($arg)) {
5604: return $arg;
5605: }
5606: }
5607:
1.251 albertel 5608: ###############################################
1.182 matthew 5609:
5610: =pod
5611:
1.549 albertel 5612: =back
5613:
5614: =head1 User Information Routines
5615:
5616: =over 4
5617:
1.405 albertel 5618: =item * &get_users_function()
1.182 matthew 5619:
5620: Used by &bodytag to determine the current users primary role.
5621: Returns either 'student','coordinator','admin', or 'author'.
5622:
5623: =cut
5624:
5625: ###############################################
5626: sub get_users_function {
5627: my $function = 'student';
1.258 albertel 5628: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 5629: $function='coordinator';
5630: }
1.258 albertel 5631: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 5632: $function='admin';
5633: }
1.258 albertel 5634: if (($env{'request.role'}=~/^(au|ca)/) ||
1.182 matthew 5635: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
5636: $function='author';
5637: }
5638: return $function;
1.54 www 5639: }
1.99 www 5640:
5641: ###############################################
5642:
1.233 raeburn 5643: =pod
5644:
1.542 raeburn 5645: =item * &check_user_status()
1.274 raeburn 5646:
5647: Determines current status of supplied role for a
5648: specific user. Roles can be active, previous or future.
5649:
5650: Inputs:
5651: user's domain, user's username, course's domain,
1.375 raeburn 5652: course's number, optional section ID.
1.274 raeburn 5653:
5654: Outputs:
5655: role status: active, previous or future.
5656:
5657: =cut
5658:
5659: sub check_user_status {
1.412 raeburn 5660: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 5661: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
5662: my @uroles = keys %userinfo;
5663: my $srchstr;
5664: my $active_chk = 'none';
1.412 raeburn 5665: my $now = time;
1.274 raeburn 5666: if (@uroles > 0) {
1.412 raeburn 5667: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 5668: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
5669: } else {
1.412 raeburn 5670: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
5671: }
5672: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 5673: my $role_end = 0;
5674: my $role_start = 0;
5675: $active_chk = 'active';
1.412 raeburn 5676: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
5677: $role_end = $1;
5678: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
5679: $role_start = $1;
1.274 raeburn 5680: }
5681: }
5682: if ($role_start > 0) {
1.412 raeburn 5683: if ($now < $role_start) {
1.274 raeburn 5684: $active_chk = 'future';
5685: }
5686: }
5687: if ($role_end > 0) {
1.412 raeburn 5688: if ($now > $role_end) {
1.274 raeburn 5689: $active_chk = 'previous';
5690: }
5691: }
5692: }
5693: }
5694: return $active_chk;
5695: }
5696:
5697: ###############################################
5698:
5699: =pod
5700:
1.405 albertel 5701: =item * &get_sections()
1.233 raeburn 5702:
5703: Determines all the sections for a course including
5704: sections with students and sections containing other roles.
1.419 raeburn 5705: Incoming parameters:
5706:
5707: 1. domain
5708: 2. course number
5709: 3. reference to array containing roles for which sections should
5710: be gathered (optional).
5711: 4. reference to array containing status types for which sections
5712: should be gathered (optional).
5713:
5714: If the third argument is undefined, sections are gathered for any role.
5715: If the fourth argument is undefined, sections are gathered for any status.
5716: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 5717:
1.374 raeburn 5718: Returns section hash (keys are section IDs, values are
5719: number of users in each section), subject to the
1.419 raeburn 5720: optional roles filter, optional status filter
1.233 raeburn 5721:
5722: =cut
5723:
5724: ###############################################
5725: sub get_sections {
1.419 raeburn 5726: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 5727: if (!defined($cdom) || !defined($cnum)) {
5728: my $cid = $env{'request.course.id'};
5729:
5730: return if (!defined($cid));
5731:
5732: $cdom = $env{'course.'.$cid.'.domain'};
5733: $cnum = $env{'course.'.$cid.'.num'};
5734: }
5735:
5736: my %sectioncount;
1.419 raeburn 5737: my $now = time;
1.240 albertel 5738:
1.366 albertel 5739: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 5740: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 5741: my $sec_index = &Apache::loncoursedata::CL_SECTION();
5742: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 5743: my $start_index = &Apache::loncoursedata::CL_START();
5744: my $end_index = &Apache::loncoursedata::CL_END();
5745: my $status;
1.366 albertel 5746: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 5747: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
5748: $data->[$status_index],
5749: $data->[$start_index],
5750: $data->[$end_index]);
5751: if ($stu_status eq 'Active') {
5752: $status = 'active';
5753: } elsif ($end < $now) {
5754: $status = 'previous';
5755: } elsif ($start > $now) {
5756: $status = 'future';
5757: }
5758: if ($section ne '-1' && $section !~ /^\s*$/) {
5759: if ((!defined($possible_status)) || (($status ne '') &&
5760: (grep/^\Q$status\E$/,@{$possible_status}))) {
5761: $sectioncount{$section}++;
5762: }
1.240 albertel 5763: }
5764: }
5765: }
5766: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5767: foreach my $user (sort(keys(%courseroles))) {
5768: if ($user !~ /^(\w{2})/) { next; }
5769: my ($role) = ($user =~ /^(\w{2})/);
5770: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 5771: my ($section,$status);
1.240 albertel 5772: if ($role eq 'cr' &&
5773: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
5774: $section=$1;
5775: }
5776: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
5777: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 5778: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
5779: if ($end == -1 && $start == -1) {
5780: next; #deleted role
5781: }
5782: if (!defined($possible_status)) {
5783: $sectioncount{$section}++;
5784: } else {
5785: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
5786: $status = 'active';
5787: } elsif ($end < $now) {
5788: $status = 'future';
5789: } elsif ($start > $now) {
5790: $status = 'previous';
5791: }
5792: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
5793: $sectioncount{$section}++;
5794: }
5795: }
1.233 raeburn 5796: }
1.366 albertel 5797: return %sectioncount;
1.233 raeburn 5798: }
5799:
1.274 raeburn 5800: ###############################################
1.294 raeburn 5801:
5802: =pod
1.405 albertel 5803:
5804: =item * &get_course_users()
5805:
1.275 raeburn 5806: Retrieves usernames:domains for users in the specified course
5807: with specific role(s), and access status.
5808:
5809: Incoming parameters:
1.277 albertel 5810: 1. course domain
5811: 2. course number
5812: 3. access status: users must have - either active,
1.275 raeburn 5813: previous, future, or all.
1.277 albertel 5814: 4. reference to array of permissible roles
1.288 raeburn 5815: 5. reference to array of section restrictions (optional)
5816: 6. reference to results object (hash of hashes).
5817: 7. reference to optional userdata hash
1.609 ! raeburn 5818: 8. reference to optional statushash
! 5819: Keys of top level results hash are roles.
1.275 raeburn 5820: Keys of inner hashes are username:domain, with
5821: values set to access type.
1.288 raeburn 5822: Optional userdata hash returns an array with arguments in the
5823: same order as loncoursedata::get_classlist() for student data.
5824:
1.609 ! raeburn 5825: Optional statushash returns
! 5826:
1.288 raeburn 5827: Entries for end, start, section and status are blank because
5828: of the possibility of multiple values for non-student roles.
5829:
1.275 raeburn 5830: =cut
1.405 albertel 5831:
1.275 raeburn 5832: ###############################################
1.405 albertel 5833:
1.275 raeburn 5834: sub get_course_users {
1.609 ! raeburn 5835: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash) = @_;
1.288 raeburn 5836: my %idx = ();
1.419 raeburn 5837: my %seclists;
1.288 raeburn 5838:
5839: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
5840: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
5841: $idx{end} = &Apache::loncoursedata::CL_END();
5842: $idx{start} = &Apache::loncoursedata::CL_START();
5843: $idx{id} = &Apache::loncoursedata::CL_ID();
5844: $idx{section} = &Apache::loncoursedata::CL_SECTION();
5845: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
5846: $idx{status} = &Apache::loncoursedata::CL_STATUS();
5847:
1.290 albertel 5848: if (grep(/^st$/,@{$roles})) {
1.276 albertel 5849: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 5850: my $now = time;
1.277 albertel 5851: foreach my $student (keys(%{$classlist})) {
1.609 ! raeburn 5852: my $status;
1.288 raeburn 5853: my $match = 0;
1.412 raeburn 5854: my $secmatch = 0;
1.419 raeburn 5855: my $section = $$classlist{$student}[$idx{section}];
1.609 ! raeburn 5856: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 5857: if ($section eq '') {
5858: $section = 'none';
5859: }
1.291 albertel 5860: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 5861: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 5862: $secmatch = 1;
5863: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 5864: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 5865: $secmatch = 1;
5866: }
5867: } else {
1.419 raeburn 5868: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 5869: $secmatch = 1;
5870: }
1.290 albertel 5871: }
1.412 raeburn 5872: if (!$secmatch) {
5873: next;
5874: }
1.419 raeburn 5875: }
1.275 raeburn 5876: if (defined($$types{'active'})) {
1.288 raeburn 5877: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 5878: push(@{$$users{st}{$student}},'active');
1.288 raeburn 5879: $match = 1;
1.275 raeburn 5880: }
5881: }
5882: if (defined($$types{'previous'})) {
1.609 ! raeburn 5883: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 5884: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 5885: $match = 1;
1.275 raeburn 5886: }
5887: }
5888: if (defined($$types{'future'})) {
1.609 ! raeburn 5889: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 5890: push(@{$$users{st}{$student}},'future');
1.288 raeburn 5891: $match = 1;
1.275 raeburn 5892: }
5893: }
1.609 ! raeburn 5894: if ($match) {
! 5895: push(@{$seclists{$student}},$section);
! 5896: if (ref($userdata) eq 'HASH') {
! 5897: $$userdata{$student} = $$classlist{$student};
! 5898: }
! 5899: if (ref($statushash) eq 'HASH') {
! 5900: $statushash->{$student}{'st'}{$section} = $status;
! 5901: }
1.288 raeburn 5902: }
1.275 raeburn 5903: }
5904: }
1.412 raeburn 5905: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 5906: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5907: my $now = time;
1.609 ! raeburn 5908: my %displaystatus = ( previous => 'Expired',
! 5909: active => 'Active',
! 5910: future => 'Future',
! 5911: );
1.439 raeburn 5912: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 5913: my $match = 0;
1.412 raeburn 5914: my $secmatch = 0;
1.439 raeburn 5915: my $status;
1.412 raeburn 5916: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 5917: $user =~ s/:$//;
1.439 raeburn 5918: my ($end,$start) = split(/:/,$coursepersonnel{$person});
5919: if ($end == -1 || $start == -1) {
5920: next;
5921: }
5922: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
5923: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 5924: my ($uname,$udom) = split(/:/,$user);
5925: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 5926: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 5927: $secmatch = 1;
5928: } elsif ($usec eq '') {
1.420 albertel 5929: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 5930: $secmatch = 1;
5931: }
5932: } else {
5933: if (grep(/^\Q$usec\E$/,@{$sections})) {
5934: $secmatch = 1;
5935: }
5936: }
5937: if (!$secmatch) {
5938: next;
5939: }
1.288 raeburn 5940: }
1.419 raeburn 5941: if ($usec eq '') {
5942: $usec = 'none';
5943: }
1.275 raeburn 5944: if ($uname ne '' && $udom ne '') {
1.503 raeburn 5945: if ($end > 0 && $end < $now) {
1.439 raeburn 5946: $status = 'previous';
5947: } elsif ($start > $now) {
5948: $status = 'future';
5949: } else {
5950: $status = 'active';
5951: }
1.277 albertel 5952: foreach my $type (keys(%{$types})) {
1.275 raeburn 5953: if ($status eq $type) {
1.420 albertel 5954: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 5955: push(@{$$users{$role}{$user}},$type);
5956: }
1.288 raeburn 5957: $match = 1;
5958: }
5959: }
1.419 raeburn 5960: if (($match) && (ref($userdata) eq 'HASH')) {
5961: if (!exists($$userdata{$uname.':'.$udom})) {
5962: &get_user_info($udom,$uname,\%idx,$userdata);
5963: }
1.420 albertel 5964: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 5965: push(@{$seclists{$uname.':'.$udom}},$usec);
5966: }
1.609 ! raeburn 5967: if (ref($statushash) eq 'HASH') {
! 5968: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
! 5969: }
1.275 raeburn 5970: }
5971: }
5972: }
5973: }
1.290 albertel 5974: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 5975: if ((defined($cdom)) && (defined($cnum))) {
5976: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
5977: if ( defined($csettings{'internal.courseowner'}) ) {
5978: my $owner = $csettings{'internal.courseowner'};
1.609 ! raeburn 5979: next if ($owner eq '');
! 5980: my ($ownername,$ownerdom);
! 5981: if ($owner =~ /^([^:]+):([^:]+)$/) {
! 5982: $ownername = $1;
! 5983: $ownerdom = $2;
! 5984: } else {
! 5985: $ownername = $owner;
! 5986: $ownerdom = $cdom;
! 5987: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 5988: }
5989: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 5990: if (defined($userdata) &&
1.609 ! raeburn 5991: !exists($$userdata{$owner})) {
! 5992: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
! 5993: if (!grep(/^none$/,@{$seclists{$owner}})) {
! 5994: push(@{$seclists{$owner}},'none');
! 5995: }
! 5996: if (ref($statushash) eq 'HASH') {
! 5997: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 5998: }
1.290 albertel 5999: }
1.279 raeburn 6000: }
6001: }
6002: }
1.419 raeburn 6003: foreach my $user (keys(%seclists)) {
6004: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6005: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6006: }
1.275 raeburn 6007: }
6008: return;
6009: }
6010:
1.288 raeburn 6011: sub get_user_info {
6012: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6013: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6014: &plainname($uname,$udom,'lastname');
1.291 albertel 6015: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6016: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 ! raeburn 6017: my %idhash = &Apache::lonnet::idrget($udom,($uname));
! 6018: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6019: return;
6020: }
1.275 raeburn 6021:
1.472 raeburn 6022: ###############################################
6023:
6024: =pod
6025:
6026: =item * &get_user_quota()
6027:
6028: Retrieves quota assigned for storage of portfolio files for a user
6029:
6030: Incoming parameters:
6031: 1. user's username
6032: 2. user's domain
6033:
6034: Returns:
1.536 raeburn 6035: 1. Disk quota (in Mb) assigned to student.
6036: 2. (Optional) Type of setting: custom or default
6037: (individually assigned or default for user's
6038: institutional status).
6039: 3. (Optional) - User's institutional status (e.g., faculty, staff
6040: or student - types as defined in localenroll::inst_usertypes
6041: for user's domain, which determines default quota for user.
6042: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6043:
6044: If a value has been stored in the user's environment,
1.536 raeburn 6045: it will return that, otherwise it returns the maximal default
6046: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6047:
6048: =cut
6049:
6050: ###############################################
6051:
6052:
6053: sub get_user_quota {
6054: my ($uname,$udom) = @_;
1.536 raeburn 6055: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6056: if (!defined($udom)) {
6057: $udom = $env{'user.domain'};
6058: }
6059: if (!defined($uname)) {
6060: $uname = $env{'user.name'};
6061: }
6062: if (($udom eq '' || $uname eq '') ||
6063: ($udom eq 'public') && ($uname eq 'public')) {
6064: $quota = 0;
1.536 raeburn 6065: $quotatype = 'default';
6066: $defquota = 0;
1.472 raeburn 6067: } else {
1.536 raeburn 6068: my $inststatus;
1.472 raeburn 6069: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6070: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6071: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6072: } else {
1.536 raeburn 6073: my %userenv =
6074: &Apache::lonnet::get('environment',['portfolioquota',
6075: 'inststatus'],$udom,$uname);
1.472 raeburn 6076: my ($tmp) = keys(%userenv);
6077: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6078: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6079: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6080: } else {
6081: undef(%userenv);
6082: }
6083: }
1.536 raeburn 6084: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6085: if ($quota eq '') {
1.536 raeburn 6086: $quota = $defquota;
6087: $quotatype = 'default';
6088: } else {
6089: $quotatype = 'custom';
1.472 raeburn 6090: }
6091: }
1.536 raeburn 6092: if (wantarray) {
6093: return ($quota,$quotatype,$settingstatus,$defquota);
6094: } else {
6095: return $quota;
6096: }
1.472 raeburn 6097: }
6098:
6099: ###############################################
6100:
6101: =pod
6102:
6103: =item * &default_quota()
6104:
1.536 raeburn 6105: Retrieves default quota assigned for storage of user portfolio files,
6106: given an (optional) user's institutional status.
1.472 raeburn 6107:
6108: Incoming parameters:
6109: 1. domain
1.536 raeburn 6110: 2. (Optional) institutional status(es). This is a : separated list of
6111: status types (e.g., faculty, staff, student etc.)
6112: which apply to the user for whom the default is being retrieved.
6113: If the institutional status string in undefined, the domain
6114: default quota will be returned.
1.472 raeburn 6115:
6116: Returns:
6117: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6118: 2. (Optional) institutional type which determined the value of the
6119: default quota.
1.472 raeburn 6120:
6121: If a value has been stored in the domain's configuration db,
6122: it will return that, otherwise it returns 20 (for backwards
6123: compatibility with domains which have not set up a configuration
6124: db file; the original statically defined portfolio quota was 20 Mb).
6125:
1.536 raeburn 6126: If the user's status includes multiple types (e.g., staff and student),
6127: the largest default quota which applies to the user determines the
6128: default quota returned.
6129:
1.472 raeburn 6130: =cut
6131:
6132: ###############################################
6133:
6134:
6135: sub default_quota {
1.536 raeburn 6136: my ($udom,$inststatus) = @_;
6137: my ($defquota,$settingstatus);
6138: my %quotahash = &Apache::lonnet::get_dom('configuration',
6139: ['quota'],$udom);
6140: if (ref($quotahash{'quota'}) eq 'HASH') {
6141: if ($inststatus ne '') {
6142: my @statuses = split(/:/,$inststatus);
6143: foreach my $item (@statuses) {
6144: if ($quotahash{'quota'}{$item} ne '') {
6145: if ($defquota eq '') {
6146: $defquota = $quotahash{'quota'}{$item};
6147: $settingstatus = $item;
6148: } elsif ($quotahash{'quota'}{$item} > $defquota) {
6149: $defquota = $quotahash{'quota'}{$item};
6150: $settingstatus = $item;
6151: }
6152: }
6153: }
6154: }
6155: if ($defquota eq '') {
6156: $defquota = $quotahash{'quota'}{'default'};
6157: $settingstatus = 'default';
6158: }
6159: } else {
6160: $settingstatus = 'default';
6161: $defquota = 20;
6162: }
6163: if (wantarray) {
6164: return ($defquota,$settingstatus);
1.472 raeburn 6165: } else {
1.536 raeburn 6166: return $defquota;
1.472 raeburn 6167: }
6168: }
6169:
1.384 raeburn 6170: sub get_secgrprole_info {
6171: my ($cdom,$cnum,$needroles,$type) = @_;
6172: my %sections_count = &get_sections($cdom,$cnum);
6173: my @sections = (sort {$a <=> $b} keys(%sections_count));
6174: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6175: my @groups = sort(keys(%curr_groups));
6176: my $allroles = [];
6177: my $rolehash;
6178: my $accesshash = {
6179: active => 'Currently has access',
6180: future => 'Will have future access',
6181: previous => 'Previously had access',
6182: };
6183: if ($needroles) {
6184: $rolehash = {'all' => 'all'};
1.385 albertel 6185: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6186: if (&Apache::lonnet::error(%user_roles)) {
6187: undef(%user_roles);
6188: }
6189: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6190: my ($role)=split(/\:/,$item,2);
6191: if ($role eq 'cr') { next; }
6192: if ($role =~ /^cr/) {
6193: $$rolehash{$role} = (split('/',$role))[3];
6194: } else {
6195: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6196: }
6197: }
6198: foreach my $key (sort(keys(%{$rolehash}))) {
6199: push(@{$allroles},$key);
6200: }
6201: push (@{$allroles},'st');
6202: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6203: }
6204: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6205: }
6206:
1.555 raeburn 6207: sub user_picker {
1.570 raeburn 6208: my ($dom,$srch,$forcenewuser,$caller) = @_;
1.555 raeburn 6209: my $currdom = $dom;
6210: my %curr_selected = (
6211: srchin => 'dom',
1.580 raeburn 6212: srchby => 'lastname',
1.555 raeburn 6213: );
6214: my $srchterm;
6215: if (ref($srch) eq 'HASH') {
6216: if ($srch->{'srchby'} ne '') {
6217: $curr_selected{'srchby'} = $srch->{'srchby'};
6218: }
6219: if ($srch->{'srchin'} ne '') {
6220: $curr_selected{'srchin'} = $srch->{'srchin'};
6221: }
6222: if ($srch->{'srchtype'} ne '') {
6223: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6224: }
6225: if ($srch->{'srchdomain'} ne '') {
6226: $currdom = $srch->{'srchdomain'};
6227: }
6228: $srchterm = $srch->{'srchterm'};
6229: }
6230: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6231: 'usr' => 'Search criteria',
1.563 raeburn 6232: 'doma' => 'Domain/institution to search',
1.558 albertel 6233: 'uname' => 'username',
6234: 'lastname' => 'last name',
1.555 raeburn 6235: 'lastfirst' => 'last name, first name',
1.558 albertel 6236: 'crs' => 'in this course',
1.576 raeburn 6237: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6238: 'alc' => 'all LON-CAPA',
1.573 raeburn 6239: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6240: 'exact' => 'is',
6241: 'contains' => 'contains',
1.569 raeburn 6242: 'begins' => 'begins with',
1.571 raeburn 6243: 'youm' => "You must include some text to search for.",
6244: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6245: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6246: 'yomc' => "You must choose a domain when using an institutional directory search.",
6247: 'ymcd' => "You must choose a domain when using a domain search.",
6248: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6249: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6250: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6251: );
1.563 raeburn 6252: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6253: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6254:
6255: my @srchins = ('crs','dom','alc','instd');
6256:
6257: foreach my $option (@srchins) {
6258: # FIXME 'alc' option unavailable until
6259: # loncreateuser::print_user_query_page()
6260: # has been completed.
6261: next if ($option eq 'alc');
6262: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6263: if ($curr_selected{'srchin'} eq $option) {
6264: $srchinsel .= '
6265: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6266: } else {
6267: $srchinsel .= '
6268: <option value="'.$option.'">'.$lt{$option}.'</option>';
6269: }
1.555 raeburn 6270: }
1.563 raeburn 6271: $srchinsel .= "\n </select>\n";
1.555 raeburn 6272:
6273: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6274: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6275: if ($curr_selected{'srchby'} eq $option) {
6276: $srchbysel .= '
6277: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6278: } else {
6279: $srchbysel .= '
6280: <option value="'.$option.'">'.$lt{$option}.'</option>';
6281: }
6282: }
6283: $srchbysel .= "\n </select>\n";
6284:
6285: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6286: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6287: if ($curr_selected{'srchtype'} eq $option) {
6288: $srchtypesel .= '
6289: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6290: } else {
6291: $srchtypesel .= '
6292: <option value="'.$option.'">'.$lt{$option}.'</option>';
6293: }
6294: }
6295: $srchtypesel .= "\n </select>\n";
6296:
1.558 albertel 6297: my ($newuserscript,$new_user_create);
1.556 raeburn 6298:
6299: if ($forcenewuser) {
1.576 raeburn 6300: if (ref($srch) eq 'HASH') {
6301: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
6302: $new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
6303: }
6304: }
6305:
1.556 raeburn 6306: $newuserscript = <<"ENDSCRIPT";
6307:
1.570 raeburn 6308: function setSearch(createnew,callingForm) {
1.556 raeburn 6309: if (createnew == 1) {
1.570 raeburn 6310: for (var i=0; i<callingForm.srchby.length; i++) {
6311: if (callingForm.srchby.options[i].value == 'uname') {
6312: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6313: }
6314: }
1.570 raeburn 6315: for (var i=0; i<callingForm.srchin.length; i++) {
6316: if ( callingForm.srchin.options[i].value == 'dom') {
6317: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6318: }
6319: }
1.570 raeburn 6320: for (var i=0; i<callingForm.srchtype.length; i++) {
6321: if (callingForm.srchtype.options[i].value == 'exact') {
6322: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6323: }
6324: }
1.570 raeburn 6325: for (var i=0; i<callingForm.srchdomain.length; i++) {
6326: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6327: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6328: }
6329: }
6330: }
6331: }
6332: ENDSCRIPT
1.558 albertel 6333:
1.556 raeburn 6334: }
6335:
1.555 raeburn 6336: my $output = <<"END_BLOCK";
1.556 raeburn 6337: <script type="text/javascript">
1.570 raeburn 6338: function validateEntry(callingForm) {
1.558 albertel 6339:
1.556 raeburn 6340: var checkok = 1;
1.558 albertel 6341: var srchin;
1.570 raeburn 6342: for (var i=0; i<callingForm.srchin.length; i++) {
6343: if ( callingForm.srchin[i].checked ) {
6344: srchin = callingForm.srchin[i].value;
1.558 albertel 6345: }
6346: }
6347:
1.570 raeburn 6348: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6349: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6350: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6351: var srchterm = callingForm.srchterm.value;
6352: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6353: var msg = "";
6354:
6355: if (srchterm == "") {
6356: checkok = 0;
1.571 raeburn 6357: msg += "$lt{'youm'}\\n";
1.556 raeburn 6358: }
6359:
1.569 raeburn 6360: if (srchtype== 'begins') {
6361: if (srchterm.length < 2) {
6362: checkok = 0;
1.571 raeburn 6363: msg += "$lt{'thte'}\\n";
1.569 raeburn 6364: }
6365: }
6366:
1.556 raeburn 6367: if (srchtype== 'contains') {
6368: if (srchterm.length < 3) {
6369: checkok = 0;
1.571 raeburn 6370: msg += "$lt{'thet'}\\n";
1.556 raeburn 6371: }
6372: }
6373: if (srchin == 'instd') {
6374: if (srchdomain == '') {
6375: checkok = 0;
1.571 raeburn 6376: msg += "$lt{'yomc'}\\n";
1.556 raeburn 6377: }
6378: }
6379: if (srchin == 'dom') {
6380: if (srchdomain == '') {
6381: checkok = 0;
1.571 raeburn 6382: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 6383: }
6384: }
6385: if (srchby == 'lastfirst') {
6386: if (srchterm.indexOf(",") == -1) {
6387: checkok = 0;
1.571 raeburn 6388: msg += "$lt{'whus'}\\n";
1.556 raeburn 6389: }
6390: if (srchterm.indexOf(",") == srchterm.length -1) {
6391: checkok = 0;
1.571 raeburn 6392: msg += "$lt{'whse'}\\n";
1.556 raeburn 6393: }
6394: }
6395: if (checkok == 0) {
1.571 raeburn 6396: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 6397: return;
6398: }
6399: if (checkok == 1) {
1.570 raeburn 6400: callingForm.submit();
1.556 raeburn 6401: }
6402: }
6403:
6404: $newuserscript
6405:
6406: </script>
1.558 albertel 6407:
6408: $new_user_create
6409:
1.555 raeburn 6410: <table>
1.558 albertel 6411: <tr>
1.573 raeburn 6412: <td>$lt{'doma'}:</td>
6413: <td>$domform</td>
6414: </td>
6415: </tr>
6416: <tr>
6417: <td>$lt{'usr'}:</td>
1.563 raeburn 6418: <td>$srchbysel
6419: $srchtypesel
6420: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 6421: $srchinsel
1.563 raeburn 6422: </td>
6423: </tr>
1.555 raeburn 6424: </table>
6425: <br />
6426: END_BLOCK
1.558 albertel 6427:
1.555 raeburn 6428: return $output;
6429: }
6430:
1.585 raeburn 6431: sub username_rule_check {
6432: my ($srch,$caller) = @_;
6433: my ($response,@curr_rules,%inst_results,$rulematch);
6434: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'});
6435: if (ref($srch) eq 'HASH') {
6436: (my $inst_response,%inst_results) =
6437: &Apache::lonnet::get_instuser($srch->{'srchdomain'},
6438: $srch->{'srchterm'});
6439: my %domconfig = &Apache::lonnet::get_dom('configuration',
6440: ['usercreation'],$srch->{'srchdomain'});
6441: if (ref($domconfig{'usercreation'}) eq 'HASH') {
6442: if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') {
6443: @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}};
6444: }
6445: }
6446: if (@curr_rules > 0) {
6447: my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description');
6448: my $instuser_reqd;
6449: my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules);
6450: foreach my $rule (@curr_rules) {
6451: if ($rule_check{$rule}) {
6452: $rulematch = $rule;
6453: if ($inst_response eq 'ok') {
6454: if (keys(%inst_results) == 0) {
6455: if ($caller eq 'new') {
6456: $response = &mt('The username you chose matches the format of usernames defined for <span class="LC_cusr_emph">[_1]</span>, but the user does not exist in the institutional directory.',$domdesc).'<br />'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames.");
6457: }
6458: }
6459: }
6460: last;
6461: }
6462: }
6463: if ($response) {
6464: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
6465: if (@{$ruleorder} > 0) {
6466: $response .= '<br />'.&mt('Usernames with the following format(s) may <span class="LC_cusr_emph">only</span> be used for verified users at [_1]:',$domdesc).' <ul>';
6467: foreach my $rule (@{$ruleorder}) {
6468: if (grep(/^\Q$rule\E$/,@curr_rules)) {
6469: if (ref($rules->{$rule}) eq 'HASH') {
6470: $response .= '<li>'.$rules->{$rule}{'name'}.': '.
6471: $rules->{$rule}{'desc'}.'</li>';
6472: }
6473: }
6474: }
6475: }
6476: $response .= '</ul>';
6477: }
6478: }
6479: }
6480: }
6481: return ($response,$rulematch,$rules,%inst_results);
6482: }
6483:
1.112 bowersj2 6484: =pod
6485:
1.549 albertel 6486: =back
6487:
6488: =head1 HTTP Helpers
6489:
6490: =over 4
6491:
1.112 bowersj2 6492: =item * get_unprocessed_cgi($query,$possible_names)
6493:
1.258 albertel 6494: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 6495: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 6496: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 6497:
6498: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
6499: $possible_names is an ref to an array of form element names. As an example:
6500: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 6501: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 6502:
6503: =cut
1.1 albertel 6504:
1.6 albertel 6505: sub get_unprocessed_cgi {
1.25 albertel 6506: my ($query,$possible_names)= @_;
1.26 matthew 6507: # $Apache::lonxml::debug=1;
1.356 albertel 6508: foreach my $pair (split(/&/,$query)) {
6509: my ($name, $value) = split(/=/,$pair);
1.369 www 6510: $name = &unescape($name);
1.25 albertel 6511: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
6512: $value =~ tr/+/ /;
6513: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 6514: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 6515: }
1.16 harris41 6516: }
1.6 albertel 6517: }
6518:
1.112 bowersj2 6519: =pod
6520:
6521: =item * cacheheader()
6522:
6523: returns cache-controlling header code
6524:
6525: =cut
6526:
1.7 albertel 6527: sub cacheheader {
1.258 albertel 6528: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 6529: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
6530: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 6531: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
6532: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 6533: return $output;
1.7 albertel 6534: }
6535:
1.112 bowersj2 6536: =pod
6537:
6538: =item * no_cache($r)
6539:
6540: specifies header code to not have cache
6541:
6542: =cut
6543:
1.9 albertel 6544: sub no_cache {
1.216 albertel 6545: my ($r) = @_;
6546: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 6547: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 6548: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
6549: $r->no_cache(1);
6550: $r->header_out("Expires" => $date);
6551: $r->header_out("Pragma" => "no-cache");
1.123 www 6552: }
6553:
6554: sub content_type {
1.181 albertel 6555: my ($r,$type,$charset) = @_;
1.299 foxr 6556: if ($r) {
6557: # Note that printout.pl calls this with undef for $r.
6558: &no_cache($r);
6559: }
1.258 albertel 6560: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 6561: unless ($charset) {
6562: $charset=&Apache::lonlocal::current_encoding;
6563: }
6564: if ($charset) { $type.='; charset='.$charset; }
6565: if ($r) {
6566: $r->content_type($type);
6567: } else {
6568: print("Content-type: $type\n\n");
6569: }
1.9 albertel 6570: }
1.25 albertel 6571:
1.112 bowersj2 6572: =pod
6573:
6574: =item * add_to_env($name,$value)
6575:
1.258 albertel 6576: adds $name to the %env hash with value
1.112 bowersj2 6577: $value, if $name already exists, the entry is converted to an array
6578: reference and $value is added to the array.
6579:
6580: =cut
6581:
1.25 albertel 6582: sub add_to_env {
6583: my ($name,$value)=@_;
1.258 albertel 6584: if (defined($env{$name})) {
6585: if (ref($env{$name})) {
1.25 albertel 6586: #already have multiple values
1.258 albertel 6587: push(@{ $env{$name} },$value);
1.25 albertel 6588: } else {
6589: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 6590: my $first=$env{$name};
6591: undef($env{$name});
6592: push(@{ $env{$name} },$first,$value);
1.25 albertel 6593: }
6594: } else {
1.258 albertel 6595: $env{$name}=$value;
1.25 albertel 6596: }
1.31 albertel 6597: }
1.149 albertel 6598:
6599: =pod
6600:
6601: =item * get_env_multiple($name)
6602:
1.258 albertel 6603: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 6604: values may be defined and end up as an array ref.
6605:
6606: returns an array of values
6607:
6608: =cut
6609:
6610: sub get_env_multiple {
6611: my ($name) = @_;
6612: my @values;
1.258 albertel 6613: if (defined($env{$name})) {
1.149 albertel 6614: # exists is it an array
1.258 albertel 6615: if (ref($env{$name})) {
6616: @values=@{ $env{$name} };
1.149 albertel 6617: } else {
1.258 albertel 6618: $values[0]=$env{$name};
1.149 albertel 6619: }
6620: }
6621: return(@values);
6622: }
6623:
1.31 albertel 6624:
1.41 ng 6625: =pod
1.45 matthew 6626:
1.464 albertel 6627: =back
1.41 ng 6628:
1.112 bowersj2 6629: =head1 CSV Upload/Handling functions
1.38 albertel 6630:
1.41 ng 6631: =over 4
6632:
1.112 bowersj2 6633: =item * upfile_store($r)
1.41 ng 6634:
6635: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 6636: needs $env{'form.upfile'}
1.41 ng 6637: returns $datatoken to be put into hidden field
6638:
6639: =cut
1.31 albertel 6640:
6641: sub upfile_store {
6642: my $r=shift;
1.258 albertel 6643: $env{'form.upfile'}=~s/\r/\n/gs;
6644: $env{'form.upfile'}=~s/\f/\n/gs;
6645: $env{'form.upfile'}=~s/\n+/\n/gs;
6646: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 6647:
1.258 albertel 6648: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
6649: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 6650: {
1.158 raeburn 6651: my $datafile = $r->dir_config('lonDaemons').
6652: '/tmp/'.$datatoken.'.tmp';
6653: if ( open(my $fh,">$datafile") ) {
1.258 albertel 6654: print $fh $env{'form.upfile'};
1.158 raeburn 6655: close($fh);
6656: }
1.31 albertel 6657: }
6658: return $datatoken;
6659: }
6660:
1.56 matthew 6661: =pod
6662:
1.112 bowersj2 6663: =item * load_tmp_file($r)
1.41 ng 6664:
6665: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 6666: needs $env{'form.datatoken'},
6667: sets $env{'form.upfile'} to the contents of the file
1.41 ng 6668:
6669: =cut
1.31 albertel 6670:
6671: sub load_tmp_file {
6672: my $r=shift;
6673: my @studentdata=();
6674: {
1.158 raeburn 6675: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 6676: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 6677: if ( open(my $fh,"<$studentfile") ) {
6678: @studentdata=<$fh>;
6679: close($fh);
6680: }
1.31 albertel 6681: }
1.258 albertel 6682: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 6683: }
6684:
1.56 matthew 6685: =pod
6686:
1.112 bowersj2 6687: =item * upfile_record_sep()
1.41 ng 6688:
6689: Separate uploaded file into records
6690: returns array of records,
1.258 albertel 6691: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 6692:
6693: =cut
1.31 albertel 6694:
6695: sub upfile_record_sep {
1.258 albertel 6696: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 6697: } else {
1.248 albertel 6698: my @records;
1.258 albertel 6699: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 6700: if ($line=~/^\s*$/) { next; }
6701: push(@records,$line);
6702: }
6703: return @records;
1.31 albertel 6704: }
6705: }
6706:
1.56 matthew 6707: =pod
6708:
1.112 bowersj2 6709: =item * record_sep($record)
1.41 ng 6710:
1.258 albertel 6711: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 6712:
6713: =cut
6714:
1.263 www 6715: sub takeleft {
6716: my $index=shift;
6717: return substr('0000'.$index,-4,4);
6718: }
6719:
1.31 albertel 6720: sub record_sep {
6721: my $record=shift;
6722: my %components=();
1.258 albertel 6723: if ($env{'form.upfiletype'} eq 'xml') {
6724: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 6725: my $i=0;
1.356 albertel 6726: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 6727: $field=~s/^(\"|\')//;
6728: $field=~s/(\"|\')$//;
1.263 www 6729: $components{&takeleft($i)}=$field;
1.31 albertel 6730: $i++;
6731: }
1.258 albertel 6732: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 6733: my $i=0;
1.356 albertel 6734: foreach my $field (split(/\t/,$record)) {
1.31 albertel 6735: $field=~s/^(\"|\')//;
6736: $field=~s/(\"|\')$//;
1.263 www 6737: $components{&takeleft($i)}=$field;
1.31 albertel 6738: $i++;
6739: }
6740: } else {
1.561 www 6741: my $separator=',';
1.480 banghart 6742: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 6743: $separator=';';
1.480 banghart 6744: }
1.31 albertel 6745: my $i=0;
1.561 www 6746: # the character we are looking for to indicate the end of a quote or a record
6747: my $looking_for=$separator;
6748: # do not add the characters to the fields
6749: my $ignore=0;
6750: # we just encountered a separator (or the beginning of the record)
6751: my $just_found_separator=1;
6752: # store the field we are working on here
6753: my $field='';
6754: # work our way through all characters in record
6755: foreach my $character ($record=~/(.)/g) {
6756: if ($character eq $looking_for) {
6757: if ($character ne $separator) {
6758: # Found the end of a quote, again looking for separator
6759: $looking_for=$separator;
6760: $ignore=1;
6761: } else {
6762: # Found a separator, store away what we got
6763: $components{&takeleft($i)}=$field;
6764: $i++;
6765: $just_found_separator=1;
6766: $ignore=0;
6767: $field='';
6768: }
6769: next;
6770: }
6771: # single or double quotation marks after a separator indicate beginning of a quote
6772: # we are now looking for the end of the quote and need to ignore separators
6773: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
6774: $looking_for=$character;
6775: next;
6776: }
6777: # ignore would be true after we reached the end of a quote
6778: if ($ignore) { next; }
6779: if (($just_found_separator) && ($character=~/\s/)) { next; }
6780: $field.=$character;
6781: $just_found_separator=0;
1.31 albertel 6782: }
1.561 www 6783: # catch the very last entry, since we never encountered the separator
6784: $components{&takeleft($i)}=$field;
1.31 albertel 6785: }
6786: return %components;
6787: }
6788:
1.144 matthew 6789: ######################################################
6790: ######################################################
6791:
1.56 matthew 6792: =pod
6793:
1.112 bowersj2 6794: =item * upfile_select_html()
1.41 ng 6795:
1.144 matthew 6796: Return HTML code to select a file from the users machine and specify
6797: the file type.
1.41 ng 6798:
6799: =cut
6800:
1.144 matthew 6801: ######################################################
6802: ######################################################
1.31 albertel 6803: sub upfile_select_html {
1.144 matthew 6804: my %Types = (
6805: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 6806: semisv => &mt('Semicolon separated values'),
1.144 matthew 6807: space => &mt('Space separated'),
6808: tab => &mt('Tabulator separated'),
6809: # xml => &mt('HTML/XML'),
6810: );
6811: my $Str = '<input type="file" name="upfile" size="50" />'.
6812: '<br />Type: <select name="upfiletype">';
6813: foreach my $type (sort(keys(%Types))) {
6814: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
6815: }
6816: $Str .= "</select>\n";
6817: return $Str;
1.31 albertel 6818: }
6819:
1.301 albertel 6820: sub get_samples {
6821: my ($records,$toget) = @_;
6822: my @samples=({});
6823: my $got=0;
6824: foreach my $rec (@$records) {
6825: my %temp = &record_sep($rec);
6826: if (! grep(/\S/, values(%temp))) { next; }
6827: if (%temp) {
6828: $samples[$got]=\%temp;
6829: $got++;
6830: if ($got == $toget) { last; }
6831: }
6832: }
6833: return \@samples;
6834: }
6835:
1.144 matthew 6836: ######################################################
6837: ######################################################
6838:
1.56 matthew 6839: =pod
6840:
1.112 bowersj2 6841: =item * csv_print_samples($r,$records)
1.41 ng 6842:
6843: Prints a table of sample values from each column uploaded $r is an
6844: Apache Request ref, $records is an arrayref from
6845: &Apache::loncommon::upfile_record_sep
6846:
6847: =cut
6848:
1.144 matthew 6849: ######################################################
6850: ######################################################
1.31 albertel 6851: sub csv_print_samples {
6852: my ($r,$records) = @_;
1.301 albertel 6853: my $samples = &get_samples($records,3);
6854:
1.594 raeburn 6855: $r->print(&mt('Samples').'<br />'.&start_data_table().
6856: &start_data_table_header_row());
1.356 albertel 6857: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
6858: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 6859: $r->print(&end_data_table_header_row());
1.301 albertel 6860: foreach my $hash (@$samples) {
1.594 raeburn 6861: $r->print(&start_data_table_row());
1.356 albertel 6862: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 6863: $r->print('<td>');
1.356 albertel 6864: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 6865: $r->print('</td>');
6866: }
1.594 raeburn 6867: $r->print(&end_data_table_row());
1.31 albertel 6868: }
1.594 raeburn 6869: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 6870: }
6871:
1.144 matthew 6872: ######################################################
6873: ######################################################
6874:
1.56 matthew 6875: =pod
6876:
1.112 bowersj2 6877: =item * csv_print_select_table($r,$records,$d)
1.41 ng 6878:
6879: Prints a table to create associations between values and table columns.
1.144 matthew 6880:
1.41 ng 6881: $r is an Apache Request ref,
6882: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 6883: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 6884:
6885: =cut
6886:
1.144 matthew 6887: ######################################################
6888: ######################################################
1.31 albertel 6889: sub csv_print_select_table {
6890: my ($r,$records,$d) = @_;
1.301 albertel 6891: my $i=0;
6892: my $samples = &get_samples($records,1);
1.144 matthew 6893: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 6894: &start_data_table().&start_data_table_header_row().
1.144 matthew 6895: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 6896: '<th>'.&mt('Column').'</th>'.
6897: &end_data_table_header_row()."\n");
1.356 albertel 6898: foreach my $array_ref (@$d) {
6899: my ($value,$display,$defaultcol)=@{ $array_ref };
1.594 raeburn 6900: $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
1.31 albertel 6901:
6902: $r->print('<td><select name=f'.$i.
1.32 matthew 6903: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 6904: $r->print('<option value="none"></option>');
1.356 albertel 6905: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
6906: $r->print('<option value="'.$sample.'"'.
6907: ($sample eq $defaultcol ? ' selected="selected" ' : '').
6908: '>Column '.($sample+1).'</option>');
1.31 albertel 6909: }
1.594 raeburn 6910: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 6911: $i++;
6912: }
1.594 raeburn 6913: $r->print(&end_data_table());
1.31 albertel 6914: $i--;
6915: return $i;
6916: }
1.56 matthew 6917:
1.144 matthew 6918: ######################################################
6919: ######################################################
6920:
1.56 matthew 6921: =pod
1.31 albertel 6922:
1.112 bowersj2 6923: =item * csv_samples_select_table($r,$records,$d)
1.41 ng 6924:
6925: Prints a table of sample values from the upload and can make associate samples to internal names.
6926:
6927: $r is an Apache Request ref,
6928: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
6929: $d is an array of 2 element arrays (internal name, displayed name)
6930:
6931: =cut
6932:
1.144 matthew 6933: ######################################################
6934: ######################################################
1.31 albertel 6935: sub csv_samples_select_table {
6936: my ($r,$records,$d) = @_;
6937: my $i=0;
1.144 matthew 6938: #
1.301 albertel 6939: my $samples = &get_samples($records,3);
1.594 raeburn 6940: $r->print(&start_data_table().
6941: &start_data_table_header_row().'<th>'.
6942: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
6943: &end_data_table_header_row());
1.301 albertel 6944:
6945: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 6946: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 6947: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 6948: foreach my $option (@$d) {
6949: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 6950: $r->print('<option value="'.$value.'"'.
1.253 albertel 6951: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 6952: $display.'</option>');
1.31 albertel 6953: }
6954: $r->print('</select></td><td>');
1.301 albertel 6955: foreach my $line (0..2) {
6956: if (defined($samples->[$line]{$key})) {
6957: $r->print($samples->[$line]{$key}."<br />\n");
6958: }
6959: }
1.594 raeburn 6960: $r->print('</td>'.&end_data_table_row());
1.31 albertel 6961: $i++;
6962: }
1.594 raeburn 6963: $r->print(&end_data_table());
1.31 albertel 6964: $i--;
6965: return($i);
1.115 matthew 6966: }
6967:
1.144 matthew 6968: ######################################################
6969: ######################################################
6970:
1.115 matthew 6971: =pod
6972:
6973: =item clean_excel_name($name)
6974:
6975: Returns a replacement for $name which does not contain any illegal characters.
6976:
6977: =cut
6978:
1.144 matthew 6979: ######################################################
6980: ######################################################
1.115 matthew 6981: sub clean_excel_name {
6982: my ($name) = @_;
6983: $name =~ s/[:\*\?\/\\]//g;
6984: if (length($name) > 31) {
6985: $name = substr($name,0,31);
6986: }
6987: return $name;
1.25 albertel 6988: }
1.84 albertel 6989:
1.85 albertel 6990: =pod
6991:
1.112 bowersj2 6992: =item * check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 6993:
6994: Returns either 1 or undef
6995:
6996: 1 if the part is to be hidden, undef if it is to be shown
6997:
6998: Arguments are:
6999:
7000: $id the id of the part to be checked
7001: $symb, optional the symb of the resource to check
7002: $udom, optional the domain of the user to check for
7003: $uname, optional the username of the user to check for
7004:
7005: =cut
1.84 albertel 7006:
7007: sub check_if_partid_hidden {
7008: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 7009: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 7010: $symb,$udom,$uname);
1.141 albertel 7011: my $truth=1;
7012: #if the string starts with !, then the list is the list to show not hide
7013: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 7014: my @hiddenlist=split(/,/,$hiddenparts);
7015: foreach my $checkid (@hiddenlist) {
1.141 albertel 7016: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 7017: }
1.141 albertel 7018: return !$truth;
1.84 albertel 7019: }
1.127 matthew 7020:
1.138 matthew 7021:
7022: ############################################################
7023: ############################################################
7024:
7025: =pod
7026:
1.157 matthew 7027: =back
7028:
1.138 matthew 7029: =head1 cgi-bin script and graphing routines
7030:
1.157 matthew 7031: =over 4
7032:
1.138 matthew 7033: =item get_cgi_id
7034:
7035: Inputs: none
7036:
7037: Returns an id which can be used to pass environment variables
7038: to various cgi-bin scripts. These environment variables will
7039: be removed from the users environment after a given time by
7040: the routine &Apache::lonnet::transfer_profile_to_env.
7041:
7042: =cut
7043:
7044: ############################################################
7045: ############################################################
1.152 albertel 7046: my $uniq=0;
1.136 matthew 7047: sub get_cgi_id {
1.154 albertel 7048: $uniq=($uniq+1)%100000;
1.280 albertel 7049: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 7050: }
7051:
1.127 matthew 7052: ############################################################
7053: ############################################################
7054:
7055: =pod
7056:
1.134 matthew 7057: =item DrawBarGraph
1.127 matthew 7058:
1.138 matthew 7059: Facilitates the plotting of data in a (stacked) bar graph.
7060: Puts plot definition data into the users environment in order for
7061: graph.png to plot it. Returns an <img> tag for the plot.
7062: The bars on the plot are labeled '1','2',...,'n'.
7063:
7064: Inputs:
7065:
7066: =over 4
7067:
7068: =item $Title: string, the title of the plot
7069:
7070: =item $xlabel: string, text describing the X-axis of the plot
7071:
7072: =item $ylabel: string, text describing the Y-axis of the plot
7073:
7074: =item $Max: scalar, the maximum Y value to use in the plot
7075: If $Max is < any data point, the graph will not be rendered.
7076:
1.140 matthew 7077: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 7078: they are plotted. If undefined, default values will be used.
7079:
1.178 matthew 7080: =item $labels: array ref holding the labels to use on the x-axis for the bars.
7081:
1.138 matthew 7082: =item @Values: An array of array references. Each array reference holds data
7083: to be plotted in a stacked bar chart.
7084:
1.239 matthew 7085: =item If the final element of @Values is a hash reference the key/value
7086: pairs will be added to the graph definition.
7087:
1.138 matthew 7088: =back
7089:
7090: Returns:
7091:
7092: An <img> tag which references graph.png and the appropriate identifying
7093: information for the plot.
7094:
1.127 matthew 7095: =cut
7096:
7097: ############################################################
7098: ############################################################
1.134 matthew 7099: sub DrawBarGraph {
1.178 matthew 7100: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 7101: #
7102: if (! defined($colors)) {
7103: $colors = ['#33ff00',
7104: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
7105: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
7106: ];
7107: }
1.228 matthew 7108: my $extra_settings = {};
7109: if (ref($Values[-1]) eq 'HASH') {
7110: $extra_settings = pop(@Values);
7111: }
1.127 matthew 7112: #
1.136 matthew 7113: my $identifier = &get_cgi_id();
7114: my $id = 'cgi.'.$identifier;
1.129 matthew 7115: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 7116: return '';
7117: }
1.225 matthew 7118: #
7119: my @Labels;
7120: if (defined($labels)) {
7121: @Labels = @$labels;
7122: } else {
7123: for (my $i=0;$i<@{$Values[0]};$i++) {
7124: push (@Labels,$i+1);
7125: }
7126: }
7127: #
1.129 matthew 7128: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 7129: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 7130: my %ValuesHash;
7131: my $NumSets=1;
7132: foreach my $array (@Values) {
7133: next if (! ref($array));
1.136 matthew 7134: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 7135: join(',',@$array);
1.129 matthew 7136: }
1.127 matthew 7137: #
1.136 matthew 7138: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 7139: if ($NumBars < 3) {
7140: $width = 120+$NumBars*32;
1.220 matthew 7141: $xskip = 1;
1.225 matthew 7142: $bar_width = 30;
7143: } elsif ($NumBars < 5) {
7144: $width = 120+$NumBars*20;
7145: $xskip = 1;
7146: $bar_width = 20;
1.220 matthew 7147: } elsif ($NumBars < 10) {
1.136 matthew 7148: $width = 120+$NumBars*15;
7149: $xskip = 1;
7150: $bar_width = 15;
7151: } elsif ($NumBars <= 25) {
7152: $width = 120+$NumBars*11;
7153: $xskip = 5;
7154: $bar_width = 8;
7155: } elsif ($NumBars <= 50) {
7156: $width = 120+$NumBars*8;
7157: $xskip = 5;
7158: $bar_width = 4;
7159: } else {
7160: $width = 120+$NumBars*8;
7161: $xskip = 5;
7162: $bar_width = 4;
7163: }
7164: #
1.137 matthew 7165: $Max = 1 if ($Max < 1);
7166: if ( int($Max) < $Max ) {
7167: $Max++;
7168: $Max = int($Max);
7169: }
1.127 matthew 7170: $Title = '' if (! defined($Title));
7171: $xlabel = '' if (! defined($xlabel));
7172: $ylabel = '' if (! defined($ylabel));
1.369 www 7173: $ValuesHash{$id.'.title'} = &escape($Title);
7174: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
7175: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 7176: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 7177: $ValuesHash{$id.'.NumBars'} = $NumBars;
7178: $ValuesHash{$id.'.NumSets'} = $NumSets;
7179: $ValuesHash{$id.'.PlotType'} = 'bar';
7180: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7181: $ValuesHash{$id.'.height'} = $height;
7182: $ValuesHash{$id.'.width'} = $width;
7183: $ValuesHash{$id.'.xskip'} = $xskip;
7184: $ValuesHash{$id.'.bar_width'} = $bar_width;
7185: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 7186: #
1.228 matthew 7187: # Deal with other parameters
7188: while (my ($key,$value) = each(%$extra_settings)) {
7189: $ValuesHash{$id.'.'.$key} = $value;
7190: }
7191: #
1.137 matthew 7192: &Apache::lonnet::appenv(%ValuesHash);
7193: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7194: }
7195:
7196: ############################################################
7197: ############################################################
7198:
7199: =pod
7200:
7201: =item DrawXYGraph
7202:
1.138 matthew 7203: Facilitates the plotting of data in an XY graph.
7204: Puts plot definition data into the users environment in order for
7205: graph.png to plot it. Returns an <img> tag for the plot.
7206:
7207: Inputs:
7208:
7209: =over 4
7210:
7211: =item $Title: string, the title of the plot
7212:
7213: =item $xlabel: string, text describing the X-axis of the plot
7214:
7215: =item $ylabel: string, text describing the Y-axis of the plot
7216:
7217: =item $Max: scalar, the maximum Y value to use in the plot
7218: If $Max is < any data point, the graph will not be rendered.
7219:
7220: =item $colors: Array ref containing the hex color codes for the data to be
7221: plotted in. If undefined, default values will be used.
7222:
7223: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7224:
7225: =item $Ydata: Array ref containing Array refs.
1.185 www 7226: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 7227:
7228: =item %Values: hash indicating or overriding any default values which are
7229: passed to graph.png.
7230: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7231:
7232: =back
7233:
7234: Returns:
7235:
7236: An <img> tag which references graph.png and the appropriate identifying
7237: information for the plot.
7238:
1.137 matthew 7239: =cut
7240:
7241: ############################################################
7242: ############################################################
7243: sub DrawXYGraph {
7244: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
7245: #
7246: # Create the identifier for the graph
7247: my $identifier = &get_cgi_id();
7248: my $id = 'cgi.'.$identifier;
7249: #
7250: $Title = '' if (! defined($Title));
7251: $xlabel = '' if (! defined($xlabel));
7252: $ylabel = '' if (! defined($ylabel));
7253: my %ValuesHash =
7254: (
1.369 www 7255: $id.'.title' => &escape($Title),
7256: $id.'.xlabel' => &escape($xlabel),
7257: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 7258: $id.'.y_max_value'=> $Max,
7259: $id.'.labels' => join(',',@$Xlabels),
7260: $id.'.PlotType' => 'XY',
7261: );
7262: #
7263: if (defined($colors) && ref($colors) eq 'ARRAY') {
7264: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7265: }
7266: #
7267: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
7268: return '';
7269: }
7270: my $NumSets=1;
1.138 matthew 7271: foreach my $array (@{$Ydata}){
1.137 matthew 7272: next if (! ref($array));
7273: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
7274: }
1.138 matthew 7275: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 7276: #
7277: # Deal with other parameters
7278: while (my ($key,$value) = each(%Values)) {
7279: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 7280: }
7281: #
1.136 matthew 7282: &Apache::lonnet::appenv(%ValuesHash);
7283: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7284: }
7285:
7286: ############################################################
7287: ############################################################
7288:
7289: =pod
7290:
1.138 matthew 7291: =item DrawXYYGraph
7292:
7293: Facilitates the plotting of data in an XY graph with two Y axes.
7294: Puts plot definition data into the users environment in order for
7295: graph.png to plot it. Returns an <img> tag for the plot.
7296:
7297: Inputs:
7298:
7299: =over 4
7300:
7301: =item $Title: string, the title of the plot
7302:
7303: =item $xlabel: string, text describing the X-axis of the plot
7304:
7305: =item $ylabel: string, text describing the Y-axis of the plot
7306:
7307: =item $colors: Array ref containing the hex color codes for the data to be
7308: plotted in. If undefined, default values will be used.
7309:
7310: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7311:
7312: =item $Ydata1: The first data set
7313:
7314: =item $Min1: The minimum value of the left Y-axis
7315:
7316: =item $Max1: The maximum value of the left Y-axis
7317:
7318: =item $Ydata2: The second data set
7319:
7320: =item $Min2: The minimum value of the right Y-axis
7321:
7322: =item $Max2: The maximum value of the left Y-axis
7323:
7324: =item %Values: hash indicating or overriding any default values which are
7325: passed to graph.png.
7326: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7327:
7328: =back
7329:
7330: Returns:
7331:
7332: An <img> tag which references graph.png and the appropriate identifying
7333: information for the plot.
1.136 matthew 7334:
7335: =cut
7336:
7337: ############################################################
7338: ############################################################
1.137 matthew 7339: sub DrawXYYGraph {
7340: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
7341: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 7342: #
7343: # Create the identifier for the graph
7344: my $identifier = &get_cgi_id();
7345: my $id = 'cgi.'.$identifier;
7346: #
7347: $Title = '' if (! defined($Title));
7348: $xlabel = '' if (! defined($xlabel));
7349: $ylabel = '' if (! defined($ylabel));
7350: my %ValuesHash =
7351: (
1.369 www 7352: $id.'.title' => &escape($Title),
7353: $id.'.xlabel' => &escape($xlabel),
7354: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 7355: $id.'.labels' => join(',',@$Xlabels),
7356: $id.'.PlotType' => 'XY',
7357: $id.'.NumSets' => 2,
1.137 matthew 7358: $id.'.two_axes' => 1,
7359: $id.'.y1_max_value' => $Max1,
7360: $id.'.y1_min_value' => $Min1,
7361: $id.'.y2_max_value' => $Max2,
7362: $id.'.y2_min_value' => $Min2,
1.136 matthew 7363: );
7364: #
1.137 matthew 7365: if (defined($colors) && ref($colors) eq 'ARRAY') {
7366: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7367: }
7368: #
7369: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
7370: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 7371: return '';
7372: }
7373: my $NumSets=1;
1.137 matthew 7374: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 7375: next if (! ref($array));
7376: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 7377: }
7378: #
7379: # Deal with other parameters
7380: while (my ($key,$value) = each(%Values)) {
7381: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 7382: }
7383: #
7384: &Apache::lonnet::appenv(%ValuesHash);
1.130 albertel 7385: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 7386: }
7387:
7388: ############################################################
7389: ############################################################
7390:
7391: =pod
7392:
1.157 matthew 7393: =back
7394:
1.139 matthew 7395: =head1 Statistics helper routines?
7396:
7397: Bad place for them but what the hell.
7398:
1.157 matthew 7399: =over 4
7400:
1.139 matthew 7401: =item &chartlink
7402:
7403: Returns a link to the chart for a specific student.
7404:
7405: Inputs:
7406:
7407: =over 4
7408:
7409: =item $linktext: The text of the link
7410:
7411: =item $sname: The students username
7412:
7413: =item $sdomain: The students domain
7414:
7415: =back
7416:
1.157 matthew 7417: =back
7418:
1.139 matthew 7419: =cut
7420:
7421: ############################################################
7422: ############################################################
7423: sub chartlink {
7424: my ($linktext, $sname, $sdomain) = @_;
7425: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 7426: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 7427: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 7428: '">'.$linktext.'</a>';
1.153 matthew 7429: }
7430:
7431: #######################################################
7432: #######################################################
7433:
7434: =pod
7435:
7436: =head1 Course Environment Routines
1.157 matthew 7437:
7438: =over 4
1.153 matthew 7439:
7440: =item &restore_course_settings
7441:
7442: =item &store_course_settings
7443:
7444: Restores/Store indicated form parameters from the course environment.
7445: Will not overwrite existing values of the form parameters.
7446:
7447: Inputs:
7448: a scalar describing the data (e.g. 'chart', 'problem_analysis')
7449:
7450: a hash ref describing the data to be stored. For example:
7451:
7452: %Save_Parameters = ('Status' => 'scalar',
7453: 'chartoutputmode' => 'scalar',
7454: 'chartoutputdata' => 'scalar',
7455: 'Section' => 'array',
1.373 raeburn 7456: 'Group' => 'array',
1.153 matthew 7457: 'StudentData' => 'array',
7458: 'Maps' => 'array');
7459:
7460: Returns: both routines return nothing
7461:
7462: =cut
7463:
7464: #######################################################
7465: #######################################################
7466: sub store_course_settings {
1.496 albertel 7467: return &store_settings($env{'request.course.id'},@_);
7468: }
7469:
7470: sub store_settings {
1.153 matthew 7471: # save to the environment
7472: # appenv the same items, just to be safe
1.300 albertel 7473: my $udom = $env{'user.domain'};
7474: my $uname = $env{'user.name'};
1.496 albertel 7475: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7476: my %SaveHash;
7477: my %AppHash;
7478: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 7479: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 7480: my $envname = 'environment.'.$basename;
1.258 albertel 7481: if (exists($env{'form.'.$setting})) {
1.153 matthew 7482: # Save this value away
7483: if ($type eq 'scalar' &&
1.258 albertel 7484: (! exists($env{$envname}) ||
7485: $env{$envname} ne $env{'form.'.$setting})) {
7486: $SaveHash{$basename} = $env{'form.'.$setting};
7487: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 7488: } elsif ($type eq 'array') {
7489: my $stored_form;
1.258 albertel 7490: if (ref($env{'form.'.$setting})) {
1.153 matthew 7491: $stored_form = join(',',
7492: map {
1.369 www 7493: &escape($_);
1.258 albertel 7494: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 7495: } else {
7496: $stored_form =
1.369 www 7497: &escape($env{'form.'.$setting});
1.153 matthew 7498: }
7499: # Determine if the array contents are the same.
1.258 albertel 7500: if ($stored_form ne $env{$envname}) {
1.153 matthew 7501: $SaveHash{$basename} = $stored_form;
7502: $AppHash{$envname} = $stored_form;
7503: }
7504: }
7505: }
7506: }
7507: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 7508: $udom,$uname);
1.153 matthew 7509: if ($put_result !~ /^(ok|delayed)/) {
7510: &Apache::lonnet::logthis('unable to save form parameters, '.
7511: 'got error:'.$put_result);
7512: }
7513: # Make sure these settings stick around in this session, too
7514: &Apache::lonnet::appenv(%AppHash);
7515: return;
7516: }
7517:
7518: sub restore_course_settings {
1.499 albertel 7519: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 7520: }
7521:
7522: sub restore_settings {
7523: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7524: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 7525: next if (exists($env{'form.'.$setting}));
1.496 albertel 7526: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 7527: '.'.$setting;
1.258 albertel 7528: if (exists($env{$envname})) {
1.153 matthew 7529: if ($type eq 'scalar') {
1.258 albertel 7530: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 7531: } elsif ($type eq 'array') {
1.258 albertel 7532: $env{'form.'.$setting} = [
1.153 matthew 7533: map {
1.369 www 7534: &unescape($_);
1.258 albertel 7535: } split(',',$env{$envname})
1.153 matthew 7536: ];
7537: }
7538: }
7539: }
1.127 matthew 7540: }
7541:
7542: ############################################################
7543: ############################################################
1.154 albertel 7544:
1.443 albertel 7545: sub commit_customrole {
7546: my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
7547: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
7548: ($start?', '.&mt('starting').' '.localtime($start):'').
7549: ($end?', ending '.localtime($end):'').': <b>'.
7550: &Apache::lonnet::assigncustomrole(
7551: $udom,$uname,$url,$three,$four,$five,$end,$start).
7552: '</b><br />';
7553: return $output;
7554: }
7555:
7556: sub commit_standardrole {
1.541 raeburn 7557: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7558: my ($output,$logmsg,$linefeed);
7559: if ($context eq 'auto') {
7560: $linefeed = "\n";
7561: } else {
7562: $linefeed = "<br />\n";
7563: }
1.443 albertel 7564: if ($three eq 'st') {
1.541 raeburn 7565: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
7566: $one,$two,$sec,$context);
7567: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
7568: ($result eq 'unknown_course')) {
1.443 albertel 7569: $output = "Error: $result\n";
7570: } else {
1.541 raeburn 7571: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 7572: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7573: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7574: if ($context eq 'auto') {
7575: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
7576: } else {
7577: $output .= '<b>'.$result.'</b>'.$linefeed.
7578: &mt('Add to classlist').': <b>ok</b>';
7579: }
7580: $output .= $linefeed;
1.443 albertel 7581: }
7582: } else {
7583: $output = &mt('Assigning').' '.$three.' in '.$url.
7584: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7585: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7586: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
7587: if ($context eq 'auto') {
7588: $output .= $result.$linefeed;
7589: } else {
7590: $output .= '<b>'.$result.'</b>'.$linefeed;
7591: }
1.443 albertel 7592: }
7593: return $output;
7594: }
7595:
7596: sub commit_studentrole {
1.541 raeburn 7597: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7598: my ($result,$linefeed);
7599: if ($context eq 'auto') {
7600: $linefeed = "\n";
7601: } else {
7602: $linefeed = '<br />'."\n";
7603: }
1.443 albertel 7604: if (defined($one) && defined($two)) {
7605: my $cid=$one.'_'.$two;
7606: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
7607: my $secchange = 0;
7608: my $expire_role_result;
7609: my $modify_section_result;
7610: unless ($oldsec eq '-1') {
7611: unless ($sec eq $oldsec) {
7612: $secchange = 1;
7613: my $uurl='/'.$cid;
7614: $uurl=~s/\_/\//g;
7615: if ($oldsec) {
7616: $uurl.='/'.$oldsec;
7617: }
7618: $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
7619: $result = $expire_role_result;
7620: }
7621: }
7622: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
7623: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
7624: if ($modify_section_result =~ /^ok/) {
7625: if ($secchange == 1) {
7626: $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
7627: } elsif ($oldsec eq '-1') {
7628: $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
7629: } else {
7630: $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
7631: }
7632: } else {
7633: $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
7634: }
7635: $result = $modify_section_result;
7636: } elsif ($secchange == 1) {
7637: $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
7638: }
7639: } else {
7640: $$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
7641: $result = "error: incomplete course id\n";
7642: }
7643: return $result;
7644: }
7645:
7646: ############################################################
7647: ############################################################
7648:
1.566 albertel 7649: sub check_clone {
1.578 raeburn 7650: my ($args,$linefeed) = @_;
1.566 albertel 7651: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
7652: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
7653: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
7654: my $clonemsg;
7655: my $can_clone = 0;
7656:
7657: if ($clonehome eq 'no_host') {
1.578 raeburn 7658: $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
1.566 albertel 7659: } else {
7660: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 7661: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 7662: $can_clone = 1;
7663: } else {
7664: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
7665: $args->{'clonedomain'},$args->{'clonecourse'});
7666: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 7667: if (grep(/^\*$/,@cloners)) {
7668: $can_clone = 1;
7669: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
7670: $can_clone = 1;
7671: } else {
7672: my %roleshash =
7673: &Apache::lonnet::get_my_roles($args->{'ccuname'},
7674: $args->{'ccdomain'},
7675: 'userroles',['active'],['cc'],
7676: [$args->{'clonedomain'}]);
7677: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
7678: $can_clone = 1;
7679: } else {
7680: $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
7681: }
1.566 albertel 7682: }
1.578 raeburn 7683: }
1.566 albertel 7684: }
7685: return ($can_clone, $clonemsg, $cloneid, $clonehome);
7686: }
7687:
1.444 albertel 7688: sub construct_course {
1.541 raeburn 7689: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 7690: my $outcome;
1.541 raeburn 7691: my $linefeed = '<br />'."\n";
7692: if ($context eq 'auto') {
7693: $linefeed = "\n";
7694: }
1.566 albertel 7695:
7696: #
7697: # Are we cloning?
7698: #
7699: my ($can_clone, $clonemsg, $cloneid, $clonehome);
7700: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 7701: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 7702: if ($context ne 'auto') {
1.578 raeburn 7703: if ($clonemsg ne '') {
7704: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
7705: }
1.566 albertel 7706: }
7707: $outcome .= $clonemsg.$linefeed;
7708:
7709: if (!$can_clone) {
7710: return (0,$outcome);
7711: }
7712: }
7713:
1.444 albertel 7714: #
7715: # Open course
7716: #
7717: my $crstype = lc($args->{'crstype'});
7718: my %cenv=();
7719: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
7720: $args->{'cdescr'},
7721: $args->{'curl'},
7722: $args->{'course_home'},
7723: $args->{'nonstandard'},
7724: $args->{'crscode'},
7725: $args->{'ccuname'}.':'.
7726: $args->{'ccdomain'},
7727: $args->{'crstype'});
7728:
7729: # Note: The testing routines depend on this being output; see
7730: # Utils::Course. This needs to at least be output as a comment
7731: # if anyone ever decides to not show this, and Utils::Course::new
7732: # will need to be suitably modified.
1.541 raeburn 7733: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 7734: #
7735: # Check if created correctly
7736: #
1.479 albertel 7737: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 7738: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 7739: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 7740:
1.444 albertel 7741: #
1.566 albertel 7742: # Do the cloning
7743: #
7744: if ($can_clone && $cloneid) {
7745: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
7746: if ($context ne 'auto') {
7747: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
7748: }
7749: $outcome .= $clonemsg.$linefeed;
7750: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 7751: # Copy all files
1.566 albertel 7752: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
1.444 albertel 7753: # Restore URL
1.566 albertel 7754: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 7755: # Restore title
1.566 albertel 7756: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 7757: # restore grading mode
1.566 albertel 7758: if (defined($oldcenv{'grading'})) {
7759: $cenv{'grading'}=$oldcenv{'grading'};
7760: }
1.444 albertel 7761: # Mark as cloned
1.566 albertel 7762: $cenv{'clonedfrom'}=$cloneid;
7763: delete($cenv{'default_enrollment_start_date'});
7764: delete($cenv{'default_enrollment_end_date'});
1.444 albertel 7765: }
1.566 albertel 7766:
1.444 albertel 7767: #
7768: # Set environment (will override cloned, if existing)
7769: #
7770: my @sections = ();
7771: my @xlists = ();
7772: if ($args->{'crstype'}) {
7773: $cenv{'type'}=$args->{'crstype'};
7774: }
7775: if ($args->{'crsid'}) {
7776: $cenv{'courseid'}=$args->{'crsid'};
7777: }
7778: if ($args->{'crscode'}) {
7779: $cenv{'internal.coursecode'}=$args->{'crscode'};
7780: }
7781: if ($args->{'crsquota'} ne '') {
7782: $cenv{'internal.coursequota'}=$args->{'crsquota'};
7783: } else {
7784: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
7785: }
7786: if ($args->{'ccuname'}) {
7787: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
7788: ':'.$args->{'ccdomain'};
7789: } else {
7790: $cenv{'internal.courseowner'} = $args->{'curruser'};
7791: }
7792:
7793: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
7794: if ($args->{'crssections'}) {
7795: $cenv{'internal.sectionnums'} = '';
7796: if ($args->{'crssections'} =~ m/,/) {
7797: @sections = split/,/,$args->{'crssections'};
7798: } else {
7799: $sections[0] = $args->{'crssections'};
7800: }
7801: if (@sections > 0) {
7802: foreach my $item (@sections) {
7803: my ($sec,$gp) = split/:/,$item;
7804: my $class = $args->{'crscode'}.$sec;
7805: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
7806: $cenv{'internal.sectionnums'} .= $item.',';
7807: unless ($addcheck eq 'ok') {
7808: push @badclasses, $class;
7809: }
7810: }
7811: $cenv{'internal.sectionnums'} =~ s/,$//;
7812: }
7813: }
7814: # do not hide course coordinator from staff listing,
7815: # even if privileged
7816: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7817: # add crosslistings
7818: if ($args->{'crsxlist'}) {
7819: $cenv{'internal.crosslistings'}='';
7820: if ($args->{'crsxlist'} =~ m/,/) {
7821: @xlists = split/,/,$args->{'crsxlist'};
7822: } else {
7823: $xlists[0] = $args->{'crsxlist'};
7824: }
7825: if (@xlists > 0) {
7826: foreach my $item (@xlists) {
7827: my ($xl,$gp) = split/:/,$item;
7828: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
7829: $cenv{'internal.crosslistings'} .= $item.',';
7830: unless ($addcheck eq 'ok') {
7831: push @badclasses, $xl;
7832: }
7833: }
7834: $cenv{'internal.crosslistings'} =~ s/,$//;
7835: }
7836: }
7837: if ($args->{'autoadds'}) {
7838: $cenv{'internal.autoadds'}=$args->{'autoadds'};
7839: }
7840: if ($args->{'autodrops'}) {
7841: $cenv{'internal.autodrops'}=$args->{'autodrops'};
7842: }
7843: # check for notification of enrollment changes
7844: my @notified = ();
7845: if ($args->{'notify_owner'}) {
7846: if ($args->{'ccuname'} ne '') {
7847: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
7848: }
7849: }
7850: if ($args->{'notify_dc'}) {
7851: if ($uname ne '') {
7852: push(@notified,$uname.'@'.$udom);
7853: }
7854: }
7855: if (@notified > 0) {
7856: my $notifylist;
7857: if (@notified > 1) {
7858: $notifylist = join(',',@notified);
7859: } else {
7860: $notifylist = $notified[0];
7861: }
7862: $cenv{'internal.notifylist'} = $notifylist;
7863: }
7864: if (@badclasses > 0) {
7865: my %lt=&Apache::lonlocal::texthash(
7866: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
7867: 'dnhr' => 'does not have rights to access enrollment in these classes',
7868: 'adby' => 'as determined by the policies of your institution on access to official classlists'
7869: );
1.541 raeburn 7870: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
7871: ' ('.$lt{'adby'}.')';
7872: if ($context eq 'auto') {
7873: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 7874: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 7875: foreach my $item (@badclasses) {
7876: if ($context eq 'auto') {
7877: $outcome .= " - $item\n";
7878: } else {
7879: $outcome .= "<li>$item</li>\n";
7880: }
7881: }
7882: if ($context eq 'auto') {
7883: $outcome .= $linefeed;
7884: } else {
1.566 albertel 7885: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 7886: }
7887: }
1.444 albertel 7888: }
7889: if ($args->{'no_end_date'}) {
7890: $args->{'endaccess'} = 0;
7891: }
7892: $cenv{'internal.autostart'}=$args->{'enrollstart'};
7893: $cenv{'internal.autoend'}=$args->{'enrollend'};
7894: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
7895: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
7896: if ($args->{'showphotos'}) {
7897: $cenv{'internal.showphotos'}=$args->{'showphotos'};
7898: }
7899: $cenv{'internal.authtype'} = $args->{'authtype'};
7900: $cenv{'internal.autharg'} = $args->{'autharg'};
7901: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
7902: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 7903: my $krb_msg = &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student');
7904: if ($context eq 'auto') {
7905: $outcome .= $krb_msg;
7906: } else {
1.566 albertel 7907: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 7908: }
7909: $outcome .= $linefeed;
1.444 albertel 7910: }
7911: }
7912: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
7913: if ($args->{'setpolicy'}) {
7914: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7915: }
7916: if ($args->{'setcontent'}) {
7917: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7918: }
7919: }
7920: if ($args->{'reshome'}) {
7921: $cenv{'reshome'}=$args->{'reshome'}.'/';
7922: $cenv{'reshome'}=~s/\/+$/\//;
7923: }
7924: #
7925: # course has keyed access
7926: #
7927: if ($args->{'setkeys'}) {
7928: $cenv{'keyaccess'}='yes';
7929: }
7930: # if specified, key authority is not course, but user
7931: # only active if keyaccess is yes
7932: if ($args->{'keyauth'}) {
1.487 albertel 7933: my ($user,$domain) = split(':',$args->{'keyauth'});
7934: $user = &LONCAPA::clean_username($user);
7935: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 7936: if ($user ne '' && $domain ne '') {
1.487 albertel 7937: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 7938: }
7939: }
7940:
7941: if ($args->{'disresdis'}) {
7942: $cenv{'pch.roles.denied'}='st';
7943: }
7944: if ($args->{'disablechat'}) {
7945: $cenv{'plc.roles.denied'}='st';
7946: }
7947:
7948: # Record we've not yet viewed the Course Initialization Helper for this
7949: # course
7950: $cenv{'course.helper.not.run'} = 1;
7951: #
7952: # Use new Randomseed
7953: #
7954: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
7955: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
7956: #
7957: # The encryption code and receipt prefix for this course
7958: #
7959: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
7960: $cenv{'internal.encpref'}=100+int(9*rand(99));
7961: #
7962: # By default, use standard grading
7963: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
7964:
1.541 raeburn 7965: $outcome .= $linefeed.&mt('Setting environment').': '.
7966: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 7967: #
7968: # Open all assignments
7969: #
7970: if ($args->{'openall'}) {
7971: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
7972: my %storecontent = ($storeunder => time,
7973: $storeunder.'.type' => 'date_start');
7974:
7975: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 7976: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 7977: }
7978: #
7979: # Set first page
7980: #
7981: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
7982: || ($cloneid)) {
1.445 albertel 7983: use LONCAPA::map;
1.444 albertel 7984: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 7985:
7986: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
7987: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
7988:
1.444 albertel 7989: $outcome .= ($fatal?$errtext:'read ok').' - ';
7990: my $title; my $url;
7991: if ($args->{'firstres'} eq 'syl') {
7992: $title='Syllabus';
7993: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
7994: } else {
7995: $title='Navigate Contents';
7996: $url='/adm/navmaps';
7997: }
1.445 albertel 7998:
7999: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
8000: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
8001:
8002: if ($errtext) { $fatal=2; }
1.541 raeburn 8003: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 8004: }
1.566 albertel 8005:
8006: return (1,$outcome);
1.444 albertel 8007: }
8008:
8009: ############################################################
8010: ############################################################
8011:
1.378 raeburn 8012: sub course_type {
8013: my ($cid) = @_;
8014: if (!defined($cid)) {
8015: $cid = $env{'request.course.id'};
8016: }
1.404 albertel 8017: if (defined($env{'course.'.$cid.'.type'})) {
8018: return $env{'course.'.$cid.'.type'};
1.378 raeburn 8019: } else {
8020: return 'Course';
1.377 raeburn 8021: }
8022: }
1.156 albertel 8023:
1.406 raeburn 8024: sub group_term {
8025: my $crstype = &course_type();
8026: my %names = (
8027: 'Course' => 'group',
8028: 'Group' => 'team',
8029: );
8030: return $names{$crstype};
8031: }
8032:
1.156 albertel 8033: sub icon {
8034: my ($file)=@_;
1.505 albertel 8035: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 8036: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 8037: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 8038: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
8039: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
8040: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8041: $curfext.".gif") {
8042: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8043: $curfext.".gif";
8044: }
8045: }
1.249 albertel 8046: return &lonhttpdurl($iconname);
1.154 albertel 8047: }
1.84 albertel 8048:
1.575 albertel 8049: sub lonhttpd_port {
1.215 albertel 8050: my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
8051: if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
1.574 albertel 8052: # IE doesn't like a secure page getting images from a non-secure
8053: # port (when logging we haven't parsed the browser type so default
8054: # back to secure
8055: if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
8056: && $ENV{'SERVER_PORT'} == 443) {
1.575 albertel 8057: return 443;
8058: }
8059: return $lonhttpd_port;
8060:
8061: }
8062:
8063: sub lonhttpdurl {
8064: my ($url)=@_;
8065:
8066: my $lonhttpd_port = &lonhttpd_port();
8067: if ($lonhttpd_port == 443) {
1.574 albertel 8068: return 'https://'.$ENV{'SERVER_NAME'}.$url;
8069: }
1.215 albertel 8070: return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
8071: }
8072:
1.213 albertel 8073: sub connection_aborted {
8074: my ($r)=@_;
8075: $r->print(" ");$r->rflush();
8076: my $c = $r->connection;
8077: return $c->aborted();
8078: }
8079:
1.221 foxr 8080: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 8081: # strings as 'strings'.
8082: sub escape_single {
1.221 foxr 8083: my ($input) = @_;
1.223 albertel 8084: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 8085: $input =~ s/\'/\\\'/g; # Esacpe the 's....
8086: return $input;
8087: }
1.223 albertel 8088:
1.222 foxr 8089: # Same as escape_single, but escape's "'s This
8090: # can be used for "strings"
8091: sub escape_double {
8092: my ($input) = @_;
8093: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
8094: $input =~ s/\"/\\\"/g; # Esacpe the "s....
8095: return $input;
8096: }
1.223 albertel 8097:
1.222 foxr 8098: # Escapes the last element of a full URL.
8099: sub escape_url {
8100: my ($url) = @_;
1.238 raeburn 8101: my @urlslices = split(/\//, $url,-1);
1.369 www 8102: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 8103: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 8104: }
1.462 albertel 8105:
8106: # -------------------------------------------------------- Initliaze user login
8107: sub init_user_environment {
1.463 albertel 8108: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 8109: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
8110:
8111: my $public=($username eq 'public' && $domain eq 'public');
8112:
8113: # See if old ID present, if so, remove
8114:
8115: my ($filename,$cookie,$userroles);
8116: my $now=time;
8117:
8118: if ($public) {
8119: my $max_public=100;
8120: my $oldest;
8121: my $oldest_time=0;
8122: for(my $next=1;$next<=$max_public;$next++) {
8123: if (-e $lonids."/publicuser_$next.id") {
8124: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
8125: if ($mtime<$oldest_time || !$oldest_time) {
8126: $oldest_time=$mtime;
8127: $oldest=$next;
8128: }
8129: } else {
8130: $cookie="publicuser_$next";
8131: last;
8132: }
8133: }
8134: if (!$cookie) { $cookie="publicuser_$oldest"; }
8135: } else {
1.463 albertel 8136: # if this isn't a robot, kill any existing non-robot sessions
8137: if (!$args->{'robot'}) {
8138: opendir(DIR,$lonids);
8139: while ($filename=readdir(DIR)) {
8140: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
8141: unlink($lonids.'/'.$filename);
8142: }
1.462 albertel 8143: }
1.463 albertel 8144: closedir(DIR);
1.462 albertel 8145: }
8146: # Give them a new cookie
1.463 albertel 8147: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
8148: : $now);
8149: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 8150:
8151: # Initialize roles
8152:
8153: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
8154: }
8155: # ------------------------------------ Check browser type and MathML capability
8156:
8157: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
8158: $clientunicode,$clientos) = &decode_user_agent($r);
8159:
8160: # -------------------------------------- Any accessibility options to remember?
8161: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
8162: foreach my $option ('imagesuppress','appletsuppress',
8163: 'embedsuppress','fontenhance','blackwhite') {
8164: if ($form->{$option} eq 'true') {
8165: &Apache::lonnet::put('environment',{$option => 'on'},
8166: $domain,$username);
8167: } else {
8168: &Apache::lonnet::del('environment',[$option],
8169: $domain,$username);
8170: }
8171: }
8172: }
8173: # ------------------------------------------------------------- Get environment
8174:
8175: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
8176: my ($tmp) = keys(%userenv);
8177: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8178: # default remote control to off
8179: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
8180: } else {
8181: undef(%userenv);
8182: }
8183: if (($userenv{'interface'}) && (!$form->{'interface'})) {
8184: $form->{'interface'}=$userenv{'interface'};
8185: }
8186: $env{'environment.remote'}=$userenv{'remote'};
8187: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
8188:
8189: # --------------- Do not trust query string to be put directly into environment
8190: foreach my $option ('imagesuppress','appletsuppress',
8191: 'embedsuppress','fontenhance','blackwhite',
8192: 'interface','localpath','localres') {
8193: $form->{$option}=~s/[\n\r\=]//gs;
8194: }
8195: # --------------------------------------------------------- Write first profile
8196:
8197: {
8198: my %initial_env =
8199: ("user.name" => $username,
8200: "user.domain" => $domain,
8201: "user.home" => $authhost,
8202: "browser.type" => $clientbrowser,
8203: "browser.version" => $clientversion,
8204: "browser.mathml" => $clientmathml,
8205: "browser.unicode" => $clientunicode,
8206: "browser.os" => $clientos,
8207: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
8208: "request.course.fn" => '',
8209: "request.course.uri" => '',
8210: "request.course.sec" => '',
8211: "request.role" => 'cm',
8212: "request.role.adv" => $env{'user.adv'},
8213: "request.host" => $ENV{'REMOTE_ADDR'},);
8214:
8215: if ($form->{'localpath'}) {
8216: $initial_env{"browser.localpath"} = $form->{'localpath'};
8217: $initial_env{"browser.localres"} = $form->{'localres'};
8218: }
8219:
8220: if ($public) {
8221: $initial_env{"environment.remote"} = "off";
8222: }
8223: if ($form->{'interface'}) {
8224: $form->{'interface'}=~s/\W//gs;
8225: $initial_env{"browser.interface"} = $form->{'interface'};
8226: $env{'browser.interface'}=$form->{'interface'};
8227: foreach my $option ('imagesuppress','appletsuppress',
8228: 'embedsuppress','fontenhance','blackwhite') {
8229: if (($form->{$option} eq 'true') ||
8230: ($userenv{$option} eq 'on')) {
8231: $initial_env{"browser.$option"} = "on";
8232: }
8233: }
8234: }
8235:
8236: $env{'user.environment'} = "$lonids/$cookie.id";
8237:
8238: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
8239: &GDBM_WRCREAT(),0640)) {
8240: &_add_to_env(\%disk_env,\%initial_env);
8241: &_add_to_env(\%disk_env,\%userenv,'environment.');
8242: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 8243: if (ref($args->{'extra_env'})) {
8244: &_add_to_env(\%disk_env,$args->{'extra_env'});
8245: }
1.462 albertel 8246: untie(%disk_env);
8247: } else {
8248: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
8249: 'Could not create environment storage in lonauth: '.$!.'</font>');
8250: return 'error: '.$!;
8251: }
8252: }
8253: $env{'request.role'}='cm';
8254: $env{'request.role.adv'}=$env{'user.adv'};
8255: $env{'browser.type'}=$clientbrowser;
8256:
8257: return $cookie;
8258:
8259: }
8260:
8261: sub _add_to_env {
8262: my ($idf,$env_data,$prefix) = @_;
8263: while (my ($key,$value) = each(%$env_data)) {
8264: $idf->{$prefix.$key} = $value;
8265: $env{$prefix.$key} = $value;
8266: }
8267: }
8268:
8269:
1.41 ng 8270: =pod
8271:
8272: =back
8273:
1.112 bowersj2 8274: =cut
1.41 ng 8275:
1.112 bowersj2 8276: 1;
8277: __END__;
1.41 ng 8278:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface