Annotation of loncom/interface/loncommon.pm, revision 1.610
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.610 ! albertel 4: # $Id: loncommon.pm,v 1.609 2007/11/06 04:39:19 raeburn 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.610 ! albertel 4400: background: $pgbg;
1.347 albertel 4401: }
1.422 albertel 4402: .LC_data_table_dense {
4403: font-size: small;
4404: }
1.507 raeburn 4405: table.LC_nested_outer {
4406: border: 1px solid #000000;
1.589 raeburn 4407: border-collapse: collapse;
1.507 raeburn 4408: border-spacing: 0px;
4409: width: 100%;
4410: }
4411: table.LC_nested {
4412: border: 0px;
1.589 raeburn 4413: border-collapse: collapse;
1.507 raeburn 4414: border-spacing: 0px;
4415: width: 100%;
4416: }
1.523 albertel 4417: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4418: table.LC_prior_tries tr th {
1.349 albertel 4419: font-weight: bold;
4420: background-color: $data_table_head;
1.421 albertel 4421: font-size: smaller;
1.347 albertel 4422: }
1.610 ! albertel 4423: table.LC_data_table tr.LC_odd_row > td,
1.440 albertel 4424: table.LC_aboutme_port tr td {
1.349 albertel 4425: background-color: $data_table_light;
1.425 albertel 4426: padding: 2px;
1.347 albertel 4427: }
1.610 ! albertel 4428: table.LC_data_table tr.LC_even_row > td,
1.440 albertel 4429: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4430: background-color: $data_table_dark;
1.347 albertel 4431: }
1.425 albertel 4432: table.LC_data_table tr.LC_data_table_highlight td {
4433: background-color: $data_table_darker;
4434: }
1.451 albertel 4435: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4436: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4437: background-color: #FFFFFF;
1.421 albertel 4438: font-weight: bold;
4439: font-style: italic;
4440: text-align: center;
4441: padding: 8px;
1.347 albertel 4442: }
1.507 raeburn 4443: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4444: padding: 4ex
4445: }
1.507 raeburn 4446: table.LC_nested_outer tr th {
4447: font-weight: bold;
4448: background-color: $data_table_head;
4449: font-size: smaller;
4450: border-bottom: 1px solid #000000;
4451: }
4452: table.LC_nested_outer tr td.LC_subheader {
4453: background-color: $data_table_head;
4454: font-weight: bold;
4455: font-size: small;
4456: border-bottom: 1px solid #000000;
4457: text-align: right;
1.451 albertel 4458: }
1.507 raeburn 4459: table.LC_nested tr.LC_info_row td {
1.451 albertel 4460: background-color: #CCC;
4461: font-weight: bold;
4462: font-size: small;
1.507 raeburn 4463: text-align: center;
4464: }
1.589 raeburn 4465: table.LC_nested tr.LC_info_row td.LC_left_item,
4466: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4467: text-align: left;
1.451 albertel 4468: }
1.507 raeburn 4469: table.LC_nested td {
1.451 albertel 4470: background-color: #FFF;
4471: font-size: small;
1.507 raeburn 4472: }
4473: table.LC_nested_outer tr th.LC_right_item,
4474: table.LC_nested tr.LC_info_row td.LC_right_item,
4475: table.LC_nested tr.LC_odd_row td.LC_right_item,
4476: table.LC_nested tr td.LC_right_item {
1.451 albertel 4477: text-align: right;
4478: }
4479:
1.507 raeburn 4480: table.LC_nested tr.LC_odd_row td {
1.451 albertel 4481: background-color: #EEE;
4482: }
4483:
1.473 raeburn 4484: table.LC_createuser {
4485: }
4486:
4487: table.LC_createuser tr.LC_section_row td {
4488: font-size: smaller;
4489: }
4490:
4491: table.LC_createuser tr.LC_info_row td {
4492: background-color: #CCC;
4493: font-weight: bold;
4494: text-align: center;
4495: }
4496:
1.349 albertel 4497: table.LC_calendar {
4498: border: 1px solid #000000;
4499: border-collapse: collapse;
4500: }
4501: table.LC_calendar_pickdate {
4502: font-size: xx-small;
4503: }
4504: table.LC_calendar tr td {
4505: border: 1px solid #000000;
4506: vertical-align: top;
4507: }
4508: table.LC_calendar tr td.LC_calendar_day_empty {
4509: background-color: $data_table_dark;
4510: }
4511: table.LC_calendar tr td.LC_calendar_day_current {
4512: background-color: $data_table_highlight;
4513: }
4514:
4515: table.LC_mail_list tr.LC_mail_new {
4516: background-color: $mail_new;
4517: }
4518: table.LC_mail_list tr.LC_mail_new:hover {
4519: background-color: $mail_new_hover;
4520: }
4521: table.LC_mail_list tr.LC_mail_read {
4522: background-color: $mail_read;
4523: }
4524: table.LC_mail_list tr.LC_mail_read:hover {
4525: background-color: $mail_read_hover;
4526: }
4527: table.LC_mail_list tr.LC_mail_replied {
4528: background-color: $mail_replied;
4529: }
4530: table.LC_mail_list tr.LC_mail_replied:hover {
4531: background-color: $mail_replied_hover;
4532: }
4533: table.LC_mail_list tr.LC_mail_other {
4534: background-color: $mail_other;
4535: }
4536: table.LC_mail_list tr.LC_mail_other:hover {
4537: background-color: $mail_other_hover;
4538: }
1.494 raeburn 4539: table.LC_mail_list tr.LC_mail_even {
4540: }
4541: table.LC_mail_list tr.LC_mail_odd {
4542: }
4543:
1.385 albertel 4544:
1.386 albertel 4545: table#LC_portfolio_actions {
4546: width: auto;
4547: background: $pgbg;
4548: border: 0px;
4549: border-spacing: 2px 2px;
4550: padding: 0px;
4551: margin: 0px;
4552: border-collapse: separate;
4553: }
4554: table#LC_portfolio_actions td.LC_label {
4555: background: $tabbg;
4556: text-align: right;
4557: }
4558: table#LC_portfolio_actions td.LC_value {
4559: background: $tabbg;
4560: }
1.385 albertel 4561:
1.391 albertel 4562: table#LC_cstr_controls {
4563: width: 100%;
4564: border-collapse: collapse;
4565: }
4566: table#LC_cstr_controls tr td {
4567: border: 4px solid $pgbg;
4568: padding: 4px;
4569: text-align: center;
4570: background: $tabbg;
4571: }
4572: table#LC_cstr_controls tr th {
4573: border: 4px solid $pgbg;
4574: background: $table_header;
4575: text-align: center;
4576: font-family: $sans;
4577: font-size: smaller;
4578: }
4579:
1.389 albertel 4580: table#LC_browser {
4581:
4582: }
4583: table#LC_browser tr th {
1.391 albertel 4584: background: $table_header;
1.389 albertel 4585: }
1.390 albertel 4586: table#LC_browser tr td {
4587: padding: 2px;
4588: }
1.389 albertel 4589: table#LC_browser tr.LC_browser_file,
4590: table#LC_browser tr.LC_browser_file_published {
4591: background: #CCFF88;
4592: }
4593: table#LC_browser tr.LC_browser_file_locked,
4594: table#LC_browser tr.LC_browser_file_unpublished {
4595: background: #FFAA99;
1.387 albertel 4596: }
1.389 albertel 4597: table#LC_browser tr.LC_browser_file_obsolete {
4598: background: #AAAAAA;
1.387 albertel 4599: }
1.455 albertel 4600: table#LC_browser tr.LC_browser_file_modified,
4601: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 4602: background: #FFFF77;
1.387 albertel 4603: }
1.389 albertel 4604: table#LC_browser tr.LC_browser_folder {
4605: background: #CCCCFF;
1.387 albertel 4606: }
1.388 albertel 4607: span.LC_current_location {
4608: font-size: x-large;
4609: background: $pgbg;
4610: }
1.387 albertel 4611:
1.395 albertel 4612: span.LC_parm_menu_item {
4613: font-size: larger;
4614: font-family: $sans;
4615: }
4616: span.LC_parm_scope_all {
4617: color: red;
4618: }
4619: span.LC_parm_scope_folder {
4620: color: green;
4621: }
4622: span.LC_parm_scope_resource {
4623: color: orange;
4624: }
4625: span.LC_parm_part {
4626: color: blue;
4627: }
4628: span.LC_parm_folder, span.LC_parm_symb {
4629: font-size: x-small;
4630: font-family: $mono;
4631: color: #AAAAAA;
4632: }
4633:
1.396 albertel 4634: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
4635: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
4636: border: 1px solid black;
4637: border-collapse: collapse;
4638: }
4639: table.LC_parm_overview_restrictions td {
4640: border-width: 1px 4px 1px 4px;
4641: border-style: solid;
4642: border-color: $pgbg;
4643: text-align: center;
4644: }
4645: table.LC_parm_overview_restrictions th {
4646: background: $tabbg;
4647: border-width: 1px 4px 1px 4px;
4648: border-style: solid;
4649: border-color: $pgbg;
4650: }
1.398 albertel 4651: table#LC_helpmenu {
4652: border: 0px;
4653: height: 55px;
4654: border-spacing: 0px;
4655: }
4656:
4657: table#LC_helpmenu fieldset legend {
4658: font-size: larger;
4659: font-weight: bold;
4660: }
1.397 albertel 4661: table#LC_helpmenu_links {
4662: width: 100%;
4663: border: 1px solid black;
4664: background: $pgbg;
4665: padding: 0px;
4666: border-spacing: 1px;
4667: }
4668: table#LC_helpmenu_links tr td {
4669: padding: 1px;
4670: background: $tabbg;
1.399 albertel 4671: text-align: center;
4672: font-weight: bold;
1.397 albertel 4673: }
1.396 albertel 4674:
1.397 albertel 4675: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
4676: table#LC_helpmenu_links a:active {
4677: text-decoration: none;
4678: color: $font;
4679: }
4680: table#LC_helpmenu_links a:hover {
4681: text-decoration: underline;
4682: color: $vlink;
4683: }
1.396 albertel 4684:
1.417 albertel 4685: .LC_chrt_popup_exists {
4686: border: 1px solid #339933;
4687: margin: -1px;
4688: }
4689: .LC_chrt_popup_up {
4690: border: 1px solid yellow;
4691: margin: -1px;
4692: }
4693: .LC_chrt_popup {
4694: border: 1px solid #8888FF;
4695: background: #CCCCFF;
4696: }
1.421 albertel 4697: table.LC_pick_box {
4698: border-collapse: separate;
4699: background: white;
4700: border: 1px solid black;
4701: border-spacing: 1px;
4702: }
4703: table.LC_pick_box td.LC_pick_box_title {
4704: background: $tabbg;
4705: font-weight: bold;
4706: text-align: right;
4707: width: 184px;
4708: padding: 8px;
4709: }
1.579 raeburn 4710: table.LC_pick_box td.LC_pick_box_value {
4711: text-align: left;
4712: padding: 8px;
4713: }
4714: table.LC_pick_box td.LC_pick_box_select {
4715: text-align: left;
4716: padding: 8px;
4717: }
1.424 albertel 4718: table.LC_pick_box td.LC_pick_box_separator {
1.421 albertel 4719: padding: 0px;
4720: height: 1px;
4721: background: black;
4722: }
4723: table.LC_pick_box td.LC_pick_box_submit {
4724: text-align: right;
4725: }
1.579 raeburn 4726: table.LC_pick_box td.LC_evenrow_value {
4727: text-align: left;
4728: padding: 8px;
4729: background-color: $data_table_light;
4730: }
4731: table.LC_pick_box td.LC_oddrow_value {
4732: text-align: left;
4733: padding: 8px;
4734: background-color: $data_table_light;
4735: }
4736: table.LC_helpform_receipt {
4737: width: 620px;
4738: border-collapse: separate;
4739: background: white;
4740: border: 1px solid black;
4741: border-spacing: 1px;
4742: }
4743: table.LC_helpform_receipt td.LC_pick_box_title {
4744: background: $tabbg;
4745: font-weight: bold;
4746: text-align: right;
4747: width: 184px;
4748: padding: 8px;
4749: }
4750: table.LC_helpform_receipt td.LC_evenrow_value {
4751: text-align: left;
4752: padding: 8px;
4753: background-color: $data_table_light;
4754: }
4755: table.LC_helpform_receipt td.LC_oddrow_value {
4756: text-align: left;
4757: padding: 8px;
4758: background-color: $data_table_light;
4759: }
4760: table.LC_helpform_receipt td.LC_pick_box_separator {
4761: padding: 0px;
4762: height: 1px;
4763: background: black;
4764: }
4765: span.LC_helpform_receipt_cat {
4766: font-weight: bold;
4767: }
1.424 albertel 4768: table.LC_group_priv_box {
4769: background: white;
4770: border: 1px solid black;
4771: border-spacing: 1px;
4772: }
4773: table.LC_group_priv_box td.LC_pick_box_title {
4774: background: $tabbg;
4775: font-weight: bold;
4776: text-align: right;
4777: width: 184px;
4778: }
4779: table.LC_group_priv_box td.LC_groups_fixed {
4780: background: $data_table_light;
4781: text-align: center;
4782: }
4783: table.LC_group_priv_box td.LC_groups_optional {
4784: background: $data_table_dark;
4785: text-align: center;
4786: }
4787: table.LC_group_priv_box td.LC_groups_functionality {
4788: background: $data_table_darker;
4789: text-align: center;
4790: font-weight: bold;
4791: }
4792: table.LC_group_priv td {
4793: text-align: left;
4794: padding: 0px;
4795: }
4796:
1.421 albertel 4797: table.LC_notify_front_page {
4798: background: white;
4799: border: 1px solid black;
4800: padding: 8px;
4801: }
4802: table.LC_notify_front_page td {
4803: padding: 8px;
4804: }
1.424 albertel 4805: .LC_navbuttons {
4806: margin: 2ex 0ex 2ex 0ex;
4807: }
1.423 albertel 4808: .LC_topic_bar {
4809: font-family: $sans;
4810: font-weight: bold;
4811: width: 100%;
4812: background: $tabbg;
4813: vertical-align: middle;
4814: margin: 2ex 0ex 2ex 0ex;
4815: }
4816: .LC_topic_bar span {
4817: vertical-align: middle;
4818: }
4819: .LC_topic_bar img {
4820: vertical-align: bottom;
4821: }
4822: table.LC_course_group_status {
4823: margin: 20px;
4824: }
4825: table.LC_status_selector td {
4826: vertical-align: top;
4827: text-align: center;
1.424 albertel 4828: padding: 4px;
4829: }
4830: table.LC_descriptive_input td.LC_description {
4831: vertical-align: top;
4832: text-align: right;
4833: font-weight: bold;
1.423 albertel 4834: }
1.599 albertel 4835: div.LC_feedback_link {
4836: background: white;
4837: width: 100%;
1.489 raeburn 4838: }
4839: span.LC_feedback_link {
1.599 albertel 4840: background: $feedback_link_bg;
4841: font-size: larger;
4842: }
4843: span.LC_message_link {
4844: background: $feedback_link_bg;
4845: font-size: larger;
4846: position: absolute;
4847: right: 1em;
1.489 raeburn 4848: }
1.421 albertel 4849:
1.515 albertel 4850: table.LC_prior_tries {
1.524 albertel 4851: border: 1px solid #000000;
4852: border-collapse: separate;
4853: border-spacing: 1px;
1.515 albertel 4854: }
1.523 albertel 4855:
1.515 albertel 4856: table.LC_prior_tries td {
1.524 albertel 4857: padding: 2px;
1.515 albertel 4858: }
1.523 albertel 4859:
4860: .LC_answer_correct {
4861: background: #AAFFAA;
4862: color: black;
4863: }
4864: .LC_answer_charged_try {
4865: background: #FFAAAA ! important;
4866: color: black;
4867: }
4868: .LC_answer_not_charged_try,
4869: .LC_answer_no_grade,
4870: .LC_answer_late {
4871: background: #FFFFAA;
4872: color: black;
4873: }
4874: .LC_answer_previous {
4875: background: #AAAAFF;
4876: color: black;
4877: }
4878: .LC_answer_no_message {
4879: background: #FFFFFF;
4880: color: black;
4881: }
4882: .LC_answer_unknown {
4883: background: orange;
4884: color: black;
4885: }
4886:
4887:
1.529 albertel 4888: span.LC_prior_numerical,
4889: span.LC_prior_string,
4890: span.LC_prior_custom,
4891: span.LC_prior_reaction,
4892: span.LC_prior_math {
1.523 albertel 4893: font-family: monospace;
4894: white-space: pre;
4895: }
4896:
1.525 albertel 4897: span.LC_prior_string {
4898: font-family: monospace;
4899: white-space: pre;
4900: }
4901:
1.523 albertel 4902: table.LC_prior_option {
4903: width: 100%;
4904: border-collapse: collapse;
4905: }
1.528 albertel 4906: table.LC_prior_rank, table.LC_prior_match {
4907: border-collapse: collapse;
4908: }
4909: table.LC_prior_option tr td,
4910: table.LC_prior_rank tr td,
4911: table.LC_prior_match tr td {
1.524 albertel 4912: border: 1px solid #000000;
1.515 albertel 4913: }
4914:
1.519 raeburn 4915: span.LC_nobreak {
1.544 albertel 4916: white-space: nowrap;
1.519 raeburn 4917: }
4918:
1.576 raeburn 4919: span.LC_cusr_emph {
4920: font-style: italic;
4921: }
4922:
1.545 albertel 4923: table.LC_docs_documents {
4924: background: #BBBBBB;
1.547 albertel 4925: border-width: 0px;
1.545 albertel 4926: border-collapse: collapse;
4927: }
4928:
4929: table.LC_docs_documents td.LC_docs_document {
4930: border: 2px solid black;
4931: padding: 4px;
4932: }
4933:
4934: .LC_docs_course_commands div {
4935: float: left;
4936: border: 4px solid #AAAAAA;
4937: padding: 4px;
4938: background: #DDDDCC;
4939: }
4940:
4941: .LC_docs_entry_move {
4942: border: 0px;
4943: border-collapse: collapse;
1.544 albertel 4944: }
4945:
1.545 albertel 4946: .LC_docs_entry_move td {
4947: border: 2px solid #BBBBBB;
4948: background: #DDDDDD;
4949: }
4950:
4951: .LC_docs_editor td.LC_docs_entry_commands {
4952: background: #DDDDDD;
4953: font-size: x-small;
4954: }
1.544 albertel 4955: .LC_docs_copy {
1.545 albertel 4956: color: #000099;
1.544 albertel 4957: }
4958: .LC_docs_cut {
1.545 albertel 4959: color: #550044;
1.544 albertel 4960: }
4961: .LC_docs_rename {
1.545 albertel 4962: color: #009900;
1.544 albertel 4963: }
4964: .LC_docs_remove {
1.545 albertel 4965: color: #990000;
4966: }
4967:
1.547 albertel 4968: .LC_docs_reinit_warn,
4969: .LC_docs_ext_edit {
4970: font-size: x-small;
4971: }
4972:
1.545 albertel 4973: .LC_docs_editor td.LC_docs_entry_title,
4974: .LC_docs_editor td.LC_docs_entry_icon {
4975: background: #FFFFBB;
4976: }
4977: .LC_docs_editor td.LC_docs_entry_parameter {
4978: background: #BBBBFF;
4979: font-size: x-small;
4980: white-space: nowrap;
4981: }
4982:
4983: table.LC_docs_adddocs td,
4984: table.LC_docs_adddocs th {
4985: border: 1px solid #BBBBBB;
4986: padding: 4px;
4987: background: #DDDDDD;
1.543 albertel 4988: }
4989:
1.584 albertel 4990: table.LC_sty_begin {
4991: background: #BBFFBB;
4992: }
4993: table.LC_sty_end {
4994: background: #FFBBBB;
4995: }
4996:
1.589 raeburn 4997: table.LC_double_column {
4998: border-width: 0px;
4999: border-collapse: collapse;
5000: width: 100%;
5001: padding: 2px;
5002: }
5003:
5004: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5005: top: 2px;
1.589 raeburn 5006: left: 2px;
5007: width: 47%;
5008: vertical-align: top;
5009: }
5010:
5011: table.LC_double_column tr td.LC_right_col {
5012: top: 2px;
5013: right: 2px;
5014: width: 47%;
5015: vertical-align: top;
5016: }
5017:
1.594 raeburn 5018: span.LC_role_level {
5019: font-weight: bold;
5020: }
5021:
1.591 raeburn 5022: div.LC_left_float {
5023: float: left;
5024: padding-right: 5%;
1.597 albertel 5025: padding-bottom: 4px;
1.591 raeburn 5026: }
5027:
5028: div.LC_clear_float_header {
1.597 albertel 5029: padding-bottom: 2px;
1.591 raeburn 5030: }
5031:
5032: div.LC_clear_float_footer {
1.597 albertel 5033: padding-top: 10px;
1.591 raeburn 5034: clear: both;
5035: }
5036:
1.597 albertel 5037:
1.601 albertel 5038: div.LC_grade_select_mode {
5039: float: left;
1.604 albertel 5040: font-family: $sans;
1.601 albertel 5041: }
5042: div.LC_grade_select_mode div div {
5043: margin: 5px;
5044: }
5045: div.LC_grade_select_mode_selector {
5046: margin: 5px;
5047: float: left;
5048: }
5049: div.LC_grade_select_mode_selector_header {
5050: font: bold medium $sans;
5051: }
5052: div.LC_grade_select_mode_type {
5053: clear: left;
5054: }
5055:
1.597 albertel 5056: div.LC_grade_show_user {
5057: margin-top: 20px;
5058: border: 1px solid black;
5059: }
5060: div.LC_grade_user_name {
5061: background: #DDDDEE;
5062: border-bottom: 1px solid black;
5063: font: bold large $sans;
5064: }
5065: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5066: background: #DDEEDD;
5067: }
5068:
5069: div.LC_grade_show_problem,
5070: div.LC_grade_submissions,
5071: div.LC_grade_message_center,
5072: div.LC_grade_info_links,
5073: div.LC_grade_assign {
5074: margin: 5px;
5075: width: 99%;
5076: background: #FFFFFF;
5077: }
5078: div.LC_grade_show_problem_header,
5079: div.LC_grade_submissions_header,
5080: div.LC_grade_message_center_header,
5081: div.LC_grade_assign_header {
5082: font: bold large $sans;
5083: }
5084: div.LC_grade_show_problem_problem,
5085: div.LC_grade_submissions_body,
5086: div.LC_grade_message_center_body,
5087: div.LC_grade_assign_body {
5088: border: 1px solid black;
5089: width: 99%;
5090: background: #FFFFFF;
5091: }
1.598 albertel 5092: span.LC_grade_check_note {
5093: font: normal medium $sans;
5094: display: inline;
5095: position: absolute;
5096: right: 1em;
5097: }
1.597 albertel 5098:
1.600 albertel 5099:
5100: div.LC_edit_problem_header {
5101: font: normal medium $sans;
1.602 albertel 5102: margin: 2px;
1.600 albertel 5103: }
5104: div.LC_edit_problem_header,
1.602 albertel 5105: div.LC_edit_problem_header div,
5106: div.LC_edit_problem_editxml_header,
5107: div.LC_edit_problem_editxml_header div {
1.600 albertel 5108: margin-top: 5px;
5109: }
1.602 albertel 5110: div.LC_edit_problem_header_edit_row {
5111: background: $tabbg;
5112: padding: 3px;
5113: margin-bottom: 5px;
5114: }
1.600 albertel 5115: div.LC_edit_problem_header_title {
1.602 albertel 5116: font: larger bold $sans;
5117: background: $tabbg;
5118: padding: 3px;
5119: }
5120: table.LC_edit_problem_header_title {
5121: font: larger bold $sans;
5122: width: 100%;
5123: border-color: $pgbg;
5124: border-style: solid;
5125: border-width: $border;
5126:
1.600 albertel 5127: background: $tabbg;
1.602 albertel 5128: border-collapse: collapse;
5129: padding: 0px
5130: }
5131:
5132: div.LC_edit_problem_discards {
5133: float: left;
5134: padding-bottom: 5px;
5135: }
5136: div.LC_edit_problem_saves {
5137: float: right;
5138: padding-bottom: 5px;
1.600 albertel 5139: }
5140: hr.LC_edit_problem_divide {
1.602 albertel 5141: clear: both;
1.600 albertel 5142: color: $tabbg;
5143: background-color: $tabbg;
5144: height: 3px;
5145: border: 0px;
5146: }
1.343 albertel 5147: END
5148: }
5149:
1.306 albertel 5150: =pod
5151:
5152: =item * &headtag()
5153:
5154: Returns a uniform footer for LON-CAPA web pages.
5155:
1.307 albertel 5156: Inputs: $title - optional title for the head
5157: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5158: $args - optional arguments
1.319 albertel 5159: force_register - if is true call registerurl so the remote is
5160: informed
1.415 albertel 5161: redirect -> array ref of
5162: 1- seconds before redirect occurs
5163: 2- url to redirect to
5164: 3- whether the side effect should occur
1.315 albertel 5165: (side effect of setting
5166: $env{'internal.head.redirect'} to the url
5167: redirected too)
1.352 albertel 5168: domain -> force to color decorate a page for a specific
5169: domain
5170: function -> force usage of a specific rolish color scheme
5171: bgcolor -> override the default page bgcolor
1.460 albertel 5172: no_auto_mt_title
5173: -> prevent &mt()ing the title arg
1.464 albertel 5174:
1.306 albertel 5175: =cut
5176:
5177: sub headtag {
1.313 albertel 5178: my ($title,$head_extra,$args) = @_;
1.306 albertel 5179:
1.363 albertel 5180: my $function = $args->{'function'} || &get_users_function();
5181: my $domain = $args->{'domain'} || &determinedomain();
5182: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5183: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5184: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5185: #time(),
1.418 albertel 5186: $env{'environment.color.timestamp'},
1.363 albertel 5187: $function,$domain,$bgcolor);
5188:
1.369 www 5189: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5190:
1.308 albertel 5191: my $result =
5192: '<head>'.
1.461 albertel 5193: &font_settings();
1.319 albertel 5194:
1.461 albertel 5195: if (!$args->{'frameset'}) {
5196: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5197: }
1.319 albertel 5198: if ($args->{'force_register'}) {
5199: $result .= &Apache::lonmenu::registerurl(1);
5200: }
1.436 albertel 5201: if (!$args->{'no_nav_bar'}
5202: && !$args->{'only_body'}
5203: && !$args->{'frameset'}) {
5204: $result .= &help_menu_js();
5205: }
1.319 albertel 5206:
1.314 albertel 5207: if (ref($args->{'redirect'})) {
1.414 albertel 5208: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5209: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5210: if (!$inhibit_continue) {
5211: $env{'internal.head.redirect'} = $url;
5212: }
1.313 albertel 5213: $result.=<<ADDMETA
5214: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5215: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5216: ADDMETA
5217: }
1.306 albertel 5218: if (!defined($title)) {
5219: $title = 'The LearningOnline Network with CAPA';
5220: }
1.460 albertel 5221: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5222: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5223: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5224: .$head_extra;
1.306 albertel 5225: return $result;
5226: }
5227:
5228: =pod
5229:
1.340 albertel 5230: =item * &font_settings()
5231:
5232: Returns neccessary <meta> to set the proper encoding
5233:
5234: Inputs: none
5235:
5236: =cut
5237:
5238: sub font_settings {
5239: my $headerstring='';
5240: if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
5241: $headerstring.=
5242: '<meta Content-Type="text/html; charset=x-mac-roman" />';
5243: } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
5244: $headerstring.=
5245: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5246: }
5247: return $headerstring;
5248: }
5249:
1.341 albertel 5250: =pod
5251:
5252: =item * &xml_begin()
5253:
5254: Returns the needed doctype and <html>
5255:
5256: Inputs: none
5257:
5258: =cut
5259:
5260: sub xml_begin {
5261: my $output='';
5262:
1.592 albertel 5263: if ($env{'internal.start_page'}==1) {
5264: &Apache::lonhtmlcommon::init_htmlareafields();
5265: }
1.342 albertel 5266:
1.341 albertel 5267: if ($env{'browser.mathml'}) {
5268: $output='<?xml version="1.0"?>'
5269: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5270: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5271:
5272: # .'<!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">] >'
5273: .'<!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">'
5274: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5275: .'xmlns="http://www.w3.org/1999/xhtml">';
5276: } else {
5277: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
5278: }
5279: return $output;
5280: }
1.340 albertel 5281:
5282: =pod
5283:
1.306 albertel 5284: =item * &endheadtag()
5285:
5286: Returns a uniform </head> for LON-CAPA web pages.
5287:
5288: Inputs: none
5289:
5290: =cut
5291:
5292: sub endheadtag {
5293: return '</head>';
5294: }
5295:
5296: =pod
5297:
5298: =item * &head()
5299:
5300: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5301:
5302: Inputs: $title - optional title for the page
1.307 albertel 5303: $head_extra - optional extra HTML to put inside the <head>
1.405 albertel 5304:
1.306 albertel 5305: =cut
5306:
5307: sub head {
1.325 albertel 5308: my ($title,$head_extra,$args) = @_;
5309: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5310: }
5311:
5312: =pod
5313:
5314: =item * &start_page()
5315:
5316: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5317:
5318: Inputs: $title - optional title for the page
5319: $head_extra - optional extra HTML to incude inside the <head>
1.315 albertel 5320: $args - additional optional args supported are:
1.317 albertel 5321: only_body -> is true will set &bodytag() onlybodytag
5322: arg on
5323: no_nav_bar -> is true will set &bodytag() notopbar arg on
5324: add_entries -> additional attributes to add to the <body>
5325: domain -> force to color decorate a page for a
5326: specific domain
5327: function -> force usage of a specific rolish color
5328: scheme
5329: redirect -> see &headtag()
5330: bgcolor -> override the default page bg color
5331: js_ready -> return a string ready for being used in
5332: a javascript writeln
1.320 albertel 5333: html_encode -> return a string ready for being used in
5334: a html attribute
1.317 albertel 5335: force_register -> if is true will turn on the &bodytag()
5336: $forcereg arg
1.326 albertel 5337: body_title -> alternate text to use instead of $title
5338: in the title box that appears, this text
5339: is not auto translated like the $title is
1.330 albertel 5340: frameset -> if true will start with a <frameset>
5341: rather than <body>
1.338 albertel 5342: no_title -> if true the title bar won't be shown
5343: skip_phases -> hash ref of
5344: head -> skip the <html><head> generation
5345: body -> skip all <body> generation
1.337 albertel 5346:
1.361 albertel 5347: no_inline_link -> if true and in remote mode, don't show the
5348: 'Switch To Inline Menu' link
5349:
1.460 albertel 5350: no_auto_mt_title -> prevent &mt()ing the title arg
5351:
1.562 albertel 5352: inherit_jsmath -> when creating popup window in a page,
5353: should it have jsmath forced on by the
5354: current page
5355:
1.306 albertel 5356: =cut
5357:
5358: sub start_page {
1.309 albertel 5359: my ($title,$head_extra,$args) = @_;
1.318 albertel 5360: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5361: my %head_args;
1.352 albertel 5362: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5363: 'bgcolor','frameset','no_nav_bar','only_body',
5364: 'no_auto_mt_title') {
1.319 albertel 5365: if (defined($args->{$arg})) {
1.324 raeburn 5366: $head_args{$arg} = $args->{$arg};
1.319 albertel 5367: }
1.313 albertel 5368: }
1.319 albertel 5369:
1.315 albertel 5370: $env{'internal.start_page'}++;
1.338 albertel 5371: my $result;
5372: if (! exists($args->{'skip_phases'}{'head'}) ) {
5373: $result.=
1.341 albertel 5374: &xml_begin().
1.338 albertel 5375: &headtag($title,$head_extra,\%head_args).&endheadtag();
5376: }
5377:
5378: if (! exists($args->{'skip_phases'}{'body'}) ) {
5379: if ($args->{'frameset'}) {
5380: my $attr_string = &make_attr_string($args->{'force_register'},
5381: $args->{'add_entries'});
5382: $result .= "\n<frameset $attr_string>\n";
5383: } else {
5384: $result .=
5385: &bodytag($title,
5386: $args->{'function'}, $args->{'add_entries'},
5387: $args->{'only_body'}, $args->{'domain'},
5388: $args->{'force_register'}, $args->{'body_title'},
5389: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5390: $args->{'no_title'}, $args->{'no_inline_link'},
5391: $args);
1.338 albertel 5392: }
1.330 albertel 5393: }
1.338 albertel 5394:
1.315 albertel 5395: if ($args->{'js_ready'}) {
1.317 albertel 5396: $result = &js_ready($result);
1.315 albertel 5397: }
1.320 albertel 5398: if ($args->{'html_encode'}) {
5399: $result = &html_encode($result);
5400: }
1.315 albertel 5401: return $result;
1.306 albertel 5402: }
5403:
1.330 albertel 5404:
1.306 albertel 5405: =pod
5406:
5407: =item * &head()
5408:
5409: Returns a complete </body></html> section for LON-CAPA web pages.
5410:
1.315 albertel 5411: Inputs: $args - additional optional args supported are:
5412: js_ready -> return a string ready for being used in
5413: a javascript writeln
1.320 albertel 5414: html_encode -> return a string ready for being used in
5415: a html attribute
1.330 albertel 5416: frameset -> if true will start with a <frameset>
5417: rather than <body>
1.493 albertel 5418: dicsussion -> if true will get discussion from
5419: lonxml::xmlend
5420: (you can pass the target and parser arguments
5421: through optional 'target' and 'parser' args
5422: to this routine)
1.306 albertel 5423:
5424: =cut
5425:
5426: sub end_page {
1.315 albertel 5427: my ($args) = @_;
5428: $env{'internal.end_page'}++;
1.330 albertel 5429: my $result;
1.335 albertel 5430: if ($args->{'discussion'}) {
5431: my ($target,$parser);
5432: if (ref($args->{'discussion'})) {
5433: ($target,$parser) =($args->{'discussion'}{'target'},
5434: $args->{'discussion'}{'parser'});
5435: }
5436: $result .= &Apache::lonxml::xmlend($target,$parser);
5437: }
5438:
1.330 albertel 5439: if ($args->{'frameset'}) {
5440: $result .= '</frameset>';
5441: } else {
5442: $result .= &endbodytag();
5443: }
5444: $result .= "\n</html>";
5445:
1.315 albertel 5446: if ($args->{'js_ready'}) {
1.317 albertel 5447: $result = &js_ready($result);
1.315 albertel 5448: }
1.335 albertel 5449:
1.320 albertel 5450: if ($args->{'html_encode'}) {
5451: $result = &html_encode($result);
5452: }
1.335 albertel 5453:
1.315 albertel 5454: return $result;
5455: }
5456:
1.320 albertel 5457: sub html_encode {
5458: my ($result) = @_;
5459:
1.322 albertel 5460: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 5461:
5462: return $result;
5463: }
1.317 albertel 5464: sub js_ready {
5465: my ($result) = @_;
5466:
1.323 albertel 5467: $result =~ s/[\n\r]/ /xmsg;
5468: $result =~ s/\\/\\\\/xmsg;
5469: $result =~ s/'/\\'/xmsg;
1.372 albertel 5470: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 5471:
5472: return $result;
5473: }
5474:
1.315 albertel 5475: sub validate_page {
5476: if ( exists($env{'internal.start_page'})
1.316 albertel 5477: && $env{'internal.start_page'} > 1) {
5478: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 5479: $env{'internal.start_page'}.' '.
1.316 albertel 5480: $ENV{'request.filename'});
1.315 albertel 5481: }
5482: if ( exists($env{'internal.end_page'})
1.316 albertel 5483: && $env{'internal.end_page'} > 1) {
5484: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 5485: $env{'internal.end_page'}.' '.
1.316 albertel 5486: $env{'request.filename'});
1.315 albertel 5487: }
5488: if ( exists($env{'internal.start_page'})
5489: && ! exists($env{'internal.end_page'})) {
1.316 albertel 5490: &Apache::lonnet::logthis('start_page called without end_page '.
5491: $env{'request.filename'});
1.315 albertel 5492: }
5493: if ( ! exists($env{'internal.start_page'})
5494: && exists($env{'internal.end_page'})) {
1.316 albertel 5495: &Apache::lonnet::logthis('end_page called without start_page'.
5496: $env{'request.filename'});
1.315 albertel 5497: }
1.306 albertel 5498: }
1.315 albertel 5499:
1.318 albertel 5500: sub simple_error_page {
5501: my ($r,$title,$msg) = @_;
5502: my $page =
5503: &Apache::loncommon::start_page($title).
5504: &mt($msg).
5505: &Apache::loncommon::end_page();
5506: if (ref($r)) {
5507: $r->print($page);
1.327 albertel 5508: return;
1.318 albertel 5509: }
5510: return $page;
5511: }
1.347 albertel 5512:
5513: {
1.610 ! albertel 5514: my @row_count;
1.347 albertel 5515: sub start_data_table {
1.422 albertel 5516: my ($add_class) = @_;
5517: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 ! albertel 5518: unshift(@row_count,0);
1.422 albertel 5519: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 5520: }
5521:
5522: sub end_data_table {
1.610 ! albertel 5523: shift(@row_count);
1.389 albertel 5524: return '</table>'."\n";;
1.347 albertel 5525: }
5526:
5527: sub start_data_table_row {
1.422 albertel 5528: my ($add_class) = @_;
1.610 ! albertel 5529: $row_count[0]++;
! 5530: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 5531: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 5532: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 5533: }
1.471 banghart 5534:
5535: sub continue_data_table_row {
5536: my ($add_class) = @_;
1.610 ! albertel 5537: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 5538: $css_class = (join(' ',$css_class,$add_class));
5539: return '<tr class="'.$css_class.'">'."\n";;
5540: }
1.347 albertel 5541:
5542: sub end_data_table_row {
1.389 albertel 5543: return '</tr>'."\n";;
1.347 albertel 5544: }
1.367 www 5545:
1.421 albertel 5546: sub start_data_table_empty_row {
1.610 ! albertel 5547: $row_count[0]++;
1.421 albertel 5548: return '<tr class="LC_empty_row" >'."\n";;
5549: }
5550:
5551: sub end_data_table_empty_row {
5552: return '</tr>'."\n";;
5553: }
5554:
1.367 www 5555: sub start_data_table_header_row {
1.389 albertel 5556: return '<tr class="LC_header_row">'."\n";;
1.367 www 5557: }
5558:
5559: sub end_data_table_header_row {
1.389 albertel 5560: return '</tr>'."\n";;
1.367 www 5561: }
1.347 albertel 5562: }
5563:
1.548 albertel 5564: =pod
5565:
5566: =item * &inhibit_menu_check($arg)
5567:
5568: Checks for a inhibitmenu state and generates output to preserve it
5569:
5570: Inputs: $arg - can be any of
5571: - undef - in which case the return value is a string
5572: to add into arguments list of a uri
5573: - 'input' - in which case the return value is a HTML
5574: <form> <input> field of type hidden to
5575: preserve the value
5576: - a url - in which case the return value is the url with
5577: the neccesary cgi args added to preserve the
5578: inhibitmenu state
5579: - a ref to a url - no return value, but the string is
5580: updated to include the neccessary cgi
5581: args to preserve the inhibitmenu state
5582:
5583: =cut
5584:
5585: sub inhibit_menu_check {
5586: my ($arg) = @_;
5587: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5588: if ($arg eq 'input') {
5589: if ($env{'form.inhibitmenu'}) {
5590: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
5591: } else {
5592: return
5593: }
5594: }
5595: if ($env{'form.inhibitmenu'}) {
5596: if (ref($arg)) {
5597: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5598: } elsif ($arg eq '') {
5599: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
5600: } else {
5601: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5602: }
5603: }
5604: if (!ref($arg)) {
5605: return $arg;
5606: }
5607: }
5608:
1.251 albertel 5609: ###############################################
1.182 matthew 5610:
5611: =pod
5612:
1.549 albertel 5613: =back
5614:
5615: =head1 User Information Routines
5616:
5617: =over 4
5618:
1.405 albertel 5619: =item * &get_users_function()
1.182 matthew 5620:
5621: Used by &bodytag to determine the current users primary role.
5622: Returns either 'student','coordinator','admin', or 'author'.
5623:
5624: =cut
5625:
5626: ###############################################
5627: sub get_users_function {
5628: my $function = 'student';
1.258 albertel 5629: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 5630: $function='coordinator';
5631: }
1.258 albertel 5632: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 5633: $function='admin';
5634: }
1.258 albertel 5635: if (($env{'request.role'}=~/^(au|ca)/) ||
1.182 matthew 5636: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
5637: $function='author';
5638: }
5639: return $function;
1.54 www 5640: }
1.99 www 5641:
5642: ###############################################
5643:
1.233 raeburn 5644: =pod
5645:
1.542 raeburn 5646: =item * &check_user_status()
1.274 raeburn 5647:
5648: Determines current status of supplied role for a
5649: specific user. Roles can be active, previous or future.
5650:
5651: Inputs:
5652: user's domain, user's username, course's domain,
1.375 raeburn 5653: course's number, optional section ID.
1.274 raeburn 5654:
5655: Outputs:
5656: role status: active, previous or future.
5657:
5658: =cut
5659:
5660: sub check_user_status {
1.412 raeburn 5661: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 5662: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
5663: my @uroles = keys %userinfo;
5664: my $srchstr;
5665: my $active_chk = 'none';
1.412 raeburn 5666: my $now = time;
1.274 raeburn 5667: if (@uroles > 0) {
1.412 raeburn 5668: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 5669: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
5670: } else {
1.412 raeburn 5671: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
5672: }
5673: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 5674: my $role_end = 0;
5675: my $role_start = 0;
5676: $active_chk = 'active';
1.412 raeburn 5677: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
5678: $role_end = $1;
5679: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
5680: $role_start = $1;
1.274 raeburn 5681: }
5682: }
5683: if ($role_start > 0) {
1.412 raeburn 5684: if ($now < $role_start) {
1.274 raeburn 5685: $active_chk = 'future';
5686: }
5687: }
5688: if ($role_end > 0) {
1.412 raeburn 5689: if ($now > $role_end) {
1.274 raeburn 5690: $active_chk = 'previous';
5691: }
5692: }
5693: }
5694: }
5695: return $active_chk;
5696: }
5697:
5698: ###############################################
5699:
5700: =pod
5701:
1.405 albertel 5702: =item * &get_sections()
1.233 raeburn 5703:
5704: Determines all the sections for a course including
5705: sections with students and sections containing other roles.
1.419 raeburn 5706: Incoming parameters:
5707:
5708: 1. domain
5709: 2. course number
5710: 3. reference to array containing roles for which sections should
5711: be gathered (optional).
5712: 4. reference to array containing status types for which sections
5713: should be gathered (optional).
5714:
5715: If the third argument is undefined, sections are gathered for any role.
5716: If the fourth argument is undefined, sections are gathered for any status.
5717: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 5718:
1.374 raeburn 5719: Returns section hash (keys are section IDs, values are
5720: number of users in each section), subject to the
1.419 raeburn 5721: optional roles filter, optional status filter
1.233 raeburn 5722:
5723: =cut
5724:
5725: ###############################################
5726: sub get_sections {
1.419 raeburn 5727: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 5728: if (!defined($cdom) || !defined($cnum)) {
5729: my $cid = $env{'request.course.id'};
5730:
5731: return if (!defined($cid));
5732:
5733: $cdom = $env{'course.'.$cid.'.domain'};
5734: $cnum = $env{'course.'.$cid.'.num'};
5735: }
5736:
5737: my %sectioncount;
1.419 raeburn 5738: my $now = time;
1.240 albertel 5739:
1.366 albertel 5740: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 5741: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 5742: my $sec_index = &Apache::loncoursedata::CL_SECTION();
5743: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 5744: my $start_index = &Apache::loncoursedata::CL_START();
5745: my $end_index = &Apache::loncoursedata::CL_END();
5746: my $status;
1.366 albertel 5747: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 5748: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
5749: $data->[$status_index],
5750: $data->[$start_index],
5751: $data->[$end_index]);
5752: if ($stu_status eq 'Active') {
5753: $status = 'active';
5754: } elsif ($end < $now) {
5755: $status = 'previous';
5756: } elsif ($start > $now) {
5757: $status = 'future';
5758: }
5759: if ($section ne '-1' && $section !~ /^\s*$/) {
5760: if ((!defined($possible_status)) || (($status ne '') &&
5761: (grep/^\Q$status\E$/,@{$possible_status}))) {
5762: $sectioncount{$section}++;
5763: }
1.240 albertel 5764: }
5765: }
5766: }
5767: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5768: foreach my $user (sort(keys(%courseroles))) {
5769: if ($user !~ /^(\w{2})/) { next; }
5770: my ($role) = ($user =~ /^(\w{2})/);
5771: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 5772: my ($section,$status);
1.240 albertel 5773: if ($role eq 'cr' &&
5774: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
5775: $section=$1;
5776: }
5777: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
5778: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 5779: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
5780: if ($end == -1 && $start == -1) {
5781: next; #deleted role
5782: }
5783: if (!defined($possible_status)) {
5784: $sectioncount{$section}++;
5785: } else {
5786: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
5787: $status = 'active';
5788: } elsif ($end < $now) {
5789: $status = 'future';
5790: } elsif ($start > $now) {
5791: $status = 'previous';
5792: }
5793: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
5794: $sectioncount{$section}++;
5795: }
5796: }
1.233 raeburn 5797: }
1.366 albertel 5798: return %sectioncount;
1.233 raeburn 5799: }
5800:
1.274 raeburn 5801: ###############################################
1.294 raeburn 5802:
5803: =pod
1.405 albertel 5804:
5805: =item * &get_course_users()
5806:
1.275 raeburn 5807: Retrieves usernames:domains for users in the specified course
5808: with specific role(s), and access status.
5809:
5810: Incoming parameters:
1.277 albertel 5811: 1. course domain
5812: 2. course number
5813: 3. access status: users must have - either active,
1.275 raeburn 5814: previous, future, or all.
1.277 albertel 5815: 4. reference to array of permissible roles
1.288 raeburn 5816: 5. reference to array of section restrictions (optional)
5817: 6. reference to results object (hash of hashes).
5818: 7. reference to optional userdata hash
1.609 raeburn 5819: 8. reference to optional statushash
5820: Keys of top level results hash are roles.
1.275 raeburn 5821: Keys of inner hashes are username:domain, with
5822: values set to access type.
1.288 raeburn 5823: Optional userdata hash returns an array with arguments in the
5824: same order as loncoursedata::get_classlist() for student data.
5825:
1.609 raeburn 5826: Optional statushash returns
5827:
1.288 raeburn 5828: Entries for end, start, section and status are blank because
5829: of the possibility of multiple values for non-student roles.
5830:
1.275 raeburn 5831: =cut
1.405 albertel 5832:
1.275 raeburn 5833: ###############################################
1.405 albertel 5834:
1.275 raeburn 5835: sub get_course_users {
1.609 raeburn 5836: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash) = @_;
1.288 raeburn 5837: my %idx = ();
1.419 raeburn 5838: my %seclists;
1.288 raeburn 5839:
5840: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
5841: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
5842: $idx{end} = &Apache::loncoursedata::CL_END();
5843: $idx{start} = &Apache::loncoursedata::CL_START();
5844: $idx{id} = &Apache::loncoursedata::CL_ID();
5845: $idx{section} = &Apache::loncoursedata::CL_SECTION();
5846: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
5847: $idx{status} = &Apache::loncoursedata::CL_STATUS();
5848:
1.290 albertel 5849: if (grep(/^st$/,@{$roles})) {
1.276 albertel 5850: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 5851: my $now = time;
1.277 albertel 5852: foreach my $student (keys(%{$classlist})) {
1.609 raeburn 5853: my $status;
1.288 raeburn 5854: my $match = 0;
1.412 raeburn 5855: my $secmatch = 0;
1.419 raeburn 5856: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 5857: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 5858: if ($section eq '') {
5859: $section = 'none';
5860: }
1.291 albertel 5861: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 5862: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 5863: $secmatch = 1;
5864: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 5865: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 5866: $secmatch = 1;
5867: }
5868: } else {
1.419 raeburn 5869: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 5870: $secmatch = 1;
5871: }
1.290 albertel 5872: }
1.412 raeburn 5873: if (!$secmatch) {
5874: next;
5875: }
1.419 raeburn 5876: }
1.275 raeburn 5877: if (defined($$types{'active'})) {
1.288 raeburn 5878: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 5879: push(@{$$users{st}{$student}},'active');
1.288 raeburn 5880: $match = 1;
1.275 raeburn 5881: }
5882: }
5883: if (defined($$types{'previous'})) {
1.609 raeburn 5884: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 5885: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 5886: $match = 1;
1.275 raeburn 5887: }
5888: }
5889: if (defined($$types{'future'})) {
1.609 raeburn 5890: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 5891: push(@{$$users{st}{$student}},'future');
1.288 raeburn 5892: $match = 1;
1.275 raeburn 5893: }
5894: }
1.609 raeburn 5895: if ($match) {
5896: push(@{$seclists{$student}},$section);
5897: if (ref($userdata) eq 'HASH') {
5898: $$userdata{$student} = $$classlist{$student};
5899: }
5900: if (ref($statushash) eq 'HASH') {
5901: $statushash->{$student}{'st'}{$section} = $status;
5902: }
1.288 raeburn 5903: }
1.275 raeburn 5904: }
5905: }
1.412 raeburn 5906: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 5907: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5908: my $now = time;
1.609 raeburn 5909: my %displaystatus = ( previous => 'Expired',
5910: active => 'Active',
5911: future => 'Future',
5912: );
1.439 raeburn 5913: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 5914: my $match = 0;
1.412 raeburn 5915: my $secmatch = 0;
1.439 raeburn 5916: my $status;
1.412 raeburn 5917: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 5918: $user =~ s/:$//;
1.439 raeburn 5919: my ($end,$start) = split(/:/,$coursepersonnel{$person});
5920: if ($end == -1 || $start == -1) {
5921: next;
5922: }
5923: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
5924: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 5925: my ($uname,$udom) = split(/:/,$user);
5926: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 5927: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 5928: $secmatch = 1;
5929: } elsif ($usec eq '') {
1.420 albertel 5930: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 5931: $secmatch = 1;
5932: }
5933: } else {
5934: if (grep(/^\Q$usec\E$/,@{$sections})) {
5935: $secmatch = 1;
5936: }
5937: }
5938: if (!$secmatch) {
5939: next;
5940: }
1.288 raeburn 5941: }
1.419 raeburn 5942: if ($usec eq '') {
5943: $usec = 'none';
5944: }
1.275 raeburn 5945: if ($uname ne '' && $udom ne '') {
1.503 raeburn 5946: if ($end > 0 && $end < $now) {
1.439 raeburn 5947: $status = 'previous';
5948: } elsif ($start > $now) {
5949: $status = 'future';
5950: } else {
5951: $status = 'active';
5952: }
1.277 albertel 5953: foreach my $type (keys(%{$types})) {
1.275 raeburn 5954: if ($status eq $type) {
1.420 albertel 5955: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 5956: push(@{$$users{$role}{$user}},$type);
5957: }
1.288 raeburn 5958: $match = 1;
5959: }
5960: }
1.419 raeburn 5961: if (($match) && (ref($userdata) eq 'HASH')) {
5962: if (!exists($$userdata{$uname.':'.$udom})) {
5963: &get_user_info($udom,$uname,\%idx,$userdata);
5964: }
1.420 albertel 5965: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 5966: push(@{$seclists{$uname.':'.$udom}},$usec);
5967: }
1.609 raeburn 5968: if (ref($statushash) eq 'HASH') {
5969: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
5970: }
1.275 raeburn 5971: }
5972: }
5973: }
5974: }
1.290 albertel 5975: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 5976: if ((defined($cdom)) && (defined($cnum))) {
5977: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
5978: if ( defined($csettings{'internal.courseowner'}) ) {
5979: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 5980: next if ($owner eq '');
5981: my ($ownername,$ownerdom);
5982: if ($owner =~ /^([^:]+):([^:]+)$/) {
5983: $ownername = $1;
5984: $ownerdom = $2;
5985: } else {
5986: $ownername = $owner;
5987: $ownerdom = $cdom;
5988: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 5989: }
5990: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 5991: if (defined($userdata) &&
1.609 raeburn 5992: !exists($$userdata{$owner})) {
5993: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
5994: if (!grep(/^none$/,@{$seclists{$owner}})) {
5995: push(@{$seclists{$owner}},'none');
5996: }
5997: if (ref($statushash) eq 'HASH') {
5998: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 5999: }
1.290 albertel 6000: }
1.279 raeburn 6001: }
6002: }
6003: }
1.419 raeburn 6004: foreach my $user (keys(%seclists)) {
6005: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6006: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6007: }
1.275 raeburn 6008: }
6009: return;
6010: }
6011:
1.288 raeburn 6012: sub get_user_info {
6013: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6014: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6015: &plainname($uname,$udom,'lastname');
1.291 albertel 6016: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6017: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6018: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6019: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6020: return;
6021: }
1.275 raeburn 6022:
1.472 raeburn 6023: ###############################################
6024:
6025: =pod
6026:
6027: =item * &get_user_quota()
6028:
6029: Retrieves quota assigned for storage of portfolio files for a user
6030:
6031: Incoming parameters:
6032: 1. user's username
6033: 2. user's domain
6034:
6035: Returns:
1.536 raeburn 6036: 1. Disk quota (in Mb) assigned to student.
6037: 2. (Optional) Type of setting: custom or default
6038: (individually assigned or default for user's
6039: institutional status).
6040: 3. (Optional) - User's institutional status (e.g., faculty, staff
6041: or student - types as defined in localenroll::inst_usertypes
6042: for user's domain, which determines default quota for user.
6043: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6044:
6045: If a value has been stored in the user's environment,
1.536 raeburn 6046: it will return that, otherwise it returns the maximal default
6047: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6048:
6049: =cut
6050:
6051: ###############################################
6052:
6053:
6054: sub get_user_quota {
6055: my ($uname,$udom) = @_;
1.536 raeburn 6056: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6057: if (!defined($udom)) {
6058: $udom = $env{'user.domain'};
6059: }
6060: if (!defined($uname)) {
6061: $uname = $env{'user.name'};
6062: }
6063: if (($udom eq '' || $uname eq '') ||
6064: ($udom eq 'public') && ($uname eq 'public')) {
6065: $quota = 0;
1.536 raeburn 6066: $quotatype = 'default';
6067: $defquota = 0;
1.472 raeburn 6068: } else {
1.536 raeburn 6069: my $inststatus;
1.472 raeburn 6070: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6071: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6072: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6073: } else {
1.536 raeburn 6074: my %userenv =
6075: &Apache::lonnet::get('environment',['portfolioquota',
6076: 'inststatus'],$udom,$uname);
1.472 raeburn 6077: my ($tmp) = keys(%userenv);
6078: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6079: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6080: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6081: } else {
6082: undef(%userenv);
6083: }
6084: }
1.536 raeburn 6085: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6086: if ($quota eq '') {
1.536 raeburn 6087: $quota = $defquota;
6088: $quotatype = 'default';
6089: } else {
6090: $quotatype = 'custom';
1.472 raeburn 6091: }
6092: }
1.536 raeburn 6093: if (wantarray) {
6094: return ($quota,$quotatype,$settingstatus,$defquota);
6095: } else {
6096: return $quota;
6097: }
1.472 raeburn 6098: }
6099:
6100: ###############################################
6101:
6102: =pod
6103:
6104: =item * &default_quota()
6105:
1.536 raeburn 6106: Retrieves default quota assigned for storage of user portfolio files,
6107: given an (optional) user's institutional status.
1.472 raeburn 6108:
6109: Incoming parameters:
6110: 1. domain
1.536 raeburn 6111: 2. (Optional) institutional status(es). This is a : separated list of
6112: status types (e.g., faculty, staff, student etc.)
6113: which apply to the user for whom the default is being retrieved.
6114: If the institutional status string in undefined, the domain
6115: default quota will be returned.
1.472 raeburn 6116:
6117: Returns:
6118: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6119: 2. (Optional) institutional type which determined the value of the
6120: default quota.
1.472 raeburn 6121:
6122: If a value has been stored in the domain's configuration db,
6123: it will return that, otherwise it returns 20 (for backwards
6124: compatibility with domains which have not set up a configuration
6125: db file; the original statically defined portfolio quota was 20 Mb).
6126:
1.536 raeburn 6127: If the user's status includes multiple types (e.g., staff and student),
6128: the largest default quota which applies to the user determines the
6129: default quota returned.
6130:
1.472 raeburn 6131: =cut
6132:
6133: ###############################################
6134:
6135:
6136: sub default_quota {
1.536 raeburn 6137: my ($udom,$inststatus) = @_;
6138: my ($defquota,$settingstatus);
6139: my %quotahash = &Apache::lonnet::get_dom('configuration',
6140: ['quota'],$udom);
6141: if (ref($quotahash{'quota'}) eq 'HASH') {
6142: if ($inststatus ne '') {
6143: my @statuses = split(/:/,$inststatus);
6144: foreach my $item (@statuses) {
6145: if ($quotahash{'quota'}{$item} ne '') {
6146: if ($defquota eq '') {
6147: $defquota = $quotahash{'quota'}{$item};
6148: $settingstatus = $item;
6149: } elsif ($quotahash{'quota'}{$item} > $defquota) {
6150: $defquota = $quotahash{'quota'}{$item};
6151: $settingstatus = $item;
6152: }
6153: }
6154: }
6155: }
6156: if ($defquota eq '') {
6157: $defquota = $quotahash{'quota'}{'default'};
6158: $settingstatus = 'default';
6159: }
6160: } else {
6161: $settingstatus = 'default';
6162: $defquota = 20;
6163: }
6164: if (wantarray) {
6165: return ($defquota,$settingstatus);
1.472 raeburn 6166: } else {
1.536 raeburn 6167: return $defquota;
1.472 raeburn 6168: }
6169: }
6170:
1.384 raeburn 6171: sub get_secgrprole_info {
6172: my ($cdom,$cnum,$needroles,$type) = @_;
6173: my %sections_count = &get_sections($cdom,$cnum);
6174: my @sections = (sort {$a <=> $b} keys(%sections_count));
6175: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6176: my @groups = sort(keys(%curr_groups));
6177: my $allroles = [];
6178: my $rolehash;
6179: my $accesshash = {
6180: active => 'Currently has access',
6181: future => 'Will have future access',
6182: previous => 'Previously had access',
6183: };
6184: if ($needroles) {
6185: $rolehash = {'all' => 'all'};
1.385 albertel 6186: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6187: if (&Apache::lonnet::error(%user_roles)) {
6188: undef(%user_roles);
6189: }
6190: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6191: my ($role)=split(/\:/,$item,2);
6192: if ($role eq 'cr') { next; }
6193: if ($role =~ /^cr/) {
6194: $$rolehash{$role} = (split('/',$role))[3];
6195: } else {
6196: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6197: }
6198: }
6199: foreach my $key (sort(keys(%{$rolehash}))) {
6200: push(@{$allroles},$key);
6201: }
6202: push (@{$allroles},'st');
6203: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6204: }
6205: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6206: }
6207:
1.555 raeburn 6208: sub user_picker {
1.570 raeburn 6209: my ($dom,$srch,$forcenewuser,$caller) = @_;
1.555 raeburn 6210: my $currdom = $dom;
6211: my %curr_selected = (
6212: srchin => 'dom',
1.580 raeburn 6213: srchby => 'lastname',
1.555 raeburn 6214: );
6215: my $srchterm;
6216: if (ref($srch) eq 'HASH') {
6217: if ($srch->{'srchby'} ne '') {
6218: $curr_selected{'srchby'} = $srch->{'srchby'};
6219: }
6220: if ($srch->{'srchin'} ne '') {
6221: $curr_selected{'srchin'} = $srch->{'srchin'};
6222: }
6223: if ($srch->{'srchtype'} ne '') {
6224: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6225: }
6226: if ($srch->{'srchdomain'} ne '') {
6227: $currdom = $srch->{'srchdomain'};
6228: }
6229: $srchterm = $srch->{'srchterm'};
6230: }
6231: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6232: 'usr' => 'Search criteria',
1.563 raeburn 6233: 'doma' => 'Domain/institution to search',
1.558 albertel 6234: 'uname' => 'username',
6235: 'lastname' => 'last name',
1.555 raeburn 6236: 'lastfirst' => 'last name, first name',
1.558 albertel 6237: 'crs' => 'in this course',
1.576 raeburn 6238: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6239: 'alc' => 'all LON-CAPA',
1.573 raeburn 6240: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6241: 'exact' => 'is',
6242: 'contains' => 'contains',
1.569 raeburn 6243: 'begins' => 'begins with',
1.571 raeburn 6244: 'youm' => "You must include some text to search for.",
6245: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6246: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6247: 'yomc' => "You must choose a domain when using an institutional directory search.",
6248: 'ymcd' => "You must choose a domain when using a domain search.",
6249: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6250: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6251: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6252: );
1.563 raeburn 6253: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6254: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6255:
6256: my @srchins = ('crs','dom','alc','instd');
6257:
6258: foreach my $option (@srchins) {
6259: # FIXME 'alc' option unavailable until
6260: # loncreateuser::print_user_query_page()
6261: # has been completed.
6262: next if ($option eq 'alc');
6263: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6264: if ($curr_selected{'srchin'} eq $option) {
6265: $srchinsel .= '
6266: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6267: } else {
6268: $srchinsel .= '
6269: <option value="'.$option.'">'.$lt{$option}.'</option>';
6270: }
1.555 raeburn 6271: }
1.563 raeburn 6272: $srchinsel .= "\n </select>\n";
1.555 raeburn 6273:
6274: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6275: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6276: if ($curr_selected{'srchby'} eq $option) {
6277: $srchbysel .= '
6278: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6279: } else {
6280: $srchbysel .= '
6281: <option value="'.$option.'">'.$lt{$option}.'</option>';
6282: }
6283: }
6284: $srchbysel .= "\n </select>\n";
6285:
6286: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6287: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6288: if ($curr_selected{'srchtype'} eq $option) {
6289: $srchtypesel .= '
6290: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6291: } else {
6292: $srchtypesel .= '
6293: <option value="'.$option.'">'.$lt{$option}.'</option>';
6294: }
6295: }
6296: $srchtypesel .= "\n </select>\n";
6297:
1.558 albertel 6298: my ($newuserscript,$new_user_create);
1.556 raeburn 6299:
6300: if ($forcenewuser) {
1.576 raeburn 6301: if (ref($srch) eq 'HASH') {
6302: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
6303: $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>';
6304: }
6305: }
6306:
1.556 raeburn 6307: $newuserscript = <<"ENDSCRIPT";
6308:
1.570 raeburn 6309: function setSearch(createnew,callingForm) {
1.556 raeburn 6310: if (createnew == 1) {
1.570 raeburn 6311: for (var i=0; i<callingForm.srchby.length; i++) {
6312: if (callingForm.srchby.options[i].value == 'uname') {
6313: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6314: }
6315: }
1.570 raeburn 6316: for (var i=0; i<callingForm.srchin.length; i++) {
6317: if ( callingForm.srchin.options[i].value == 'dom') {
6318: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6319: }
6320: }
1.570 raeburn 6321: for (var i=0; i<callingForm.srchtype.length; i++) {
6322: if (callingForm.srchtype.options[i].value == 'exact') {
6323: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6324: }
6325: }
1.570 raeburn 6326: for (var i=0; i<callingForm.srchdomain.length; i++) {
6327: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6328: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6329: }
6330: }
6331: }
6332: }
6333: ENDSCRIPT
1.558 albertel 6334:
1.556 raeburn 6335: }
6336:
1.555 raeburn 6337: my $output = <<"END_BLOCK";
1.556 raeburn 6338: <script type="text/javascript">
1.570 raeburn 6339: function validateEntry(callingForm) {
1.558 albertel 6340:
1.556 raeburn 6341: var checkok = 1;
1.558 albertel 6342: var srchin;
1.570 raeburn 6343: for (var i=0; i<callingForm.srchin.length; i++) {
6344: if ( callingForm.srchin[i].checked ) {
6345: srchin = callingForm.srchin[i].value;
1.558 albertel 6346: }
6347: }
6348:
1.570 raeburn 6349: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6350: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6351: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6352: var srchterm = callingForm.srchterm.value;
6353: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6354: var msg = "";
6355:
6356: if (srchterm == "") {
6357: checkok = 0;
1.571 raeburn 6358: msg += "$lt{'youm'}\\n";
1.556 raeburn 6359: }
6360:
1.569 raeburn 6361: if (srchtype== 'begins') {
6362: if (srchterm.length < 2) {
6363: checkok = 0;
1.571 raeburn 6364: msg += "$lt{'thte'}\\n";
1.569 raeburn 6365: }
6366: }
6367:
1.556 raeburn 6368: if (srchtype== 'contains') {
6369: if (srchterm.length < 3) {
6370: checkok = 0;
1.571 raeburn 6371: msg += "$lt{'thet'}\\n";
1.556 raeburn 6372: }
6373: }
6374: if (srchin == 'instd') {
6375: if (srchdomain == '') {
6376: checkok = 0;
1.571 raeburn 6377: msg += "$lt{'yomc'}\\n";
1.556 raeburn 6378: }
6379: }
6380: if (srchin == 'dom') {
6381: if (srchdomain == '') {
6382: checkok = 0;
1.571 raeburn 6383: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 6384: }
6385: }
6386: if (srchby == 'lastfirst') {
6387: if (srchterm.indexOf(",") == -1) {
6388: checkok = 0;
1.571 raeburn 6389: msg += "$lt{'whus'}\\n";
1.556 raeburn 6390: }
6391: if (srchterm.indexOf(",") == srchterm.length -1) {
6392: checkok = 0;
1.571 raeburn 6393: msg += "$lt{'whse'}\\n";
1.556 raeburn 6394: }
6395: }
6396: if (checkok == 0) {
1.571 raeburn 6397: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 6398: return;
6399: }
6400: if (checkok == 1) {
1.570 raeburn 6401: callingForm.submit();
1.556 raeburn 6402: }
6403: }
6404:
6405: $newuserscript
6406:
6407: </script>
1.558 albertel 6408:
6409: $new_user_create
6410:
1.555 raeburn 6411: <table>
1.558 albertel 6412: <tr>
1.573 raeburn 6413: <td>$lt{'doma'}:</td>
6414: <td>$domform</td>
6415: </td>
6416: </tr>
6417: <tr>
6418: <td>$lt{'usr'}:</td>
1.563 raeburn 6419: <td>$srchbysel
6420: $srchtypesel
6421: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 6422: $srchinsel
1.563 raeburn 6423: </td>
6424: </tr>
1.555 raeburn 6425: </table>
6426: <br />
6427: END_BLOCK
1.558 albertel 6428:
1.555 raeburn 6429: return $output;
6430: }
6431:
1.585 raeburn 6432: sub username_rule_check {
6433: my ($srch,$caller) = @_;
6434: my ($response,@curr_rules,%inst_results,$rulematch);
6435: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'});
6436: if (ref($srch) eq 'HASH') {
6437: (my $inst_response,%inst_results) =
6438: &Apache::lonnet::get_instuser($srch->{'srchdomain'},
6439: $srch->{'srchterm'});
6440: my %domconfig = &Apache::lonnet::get_dom('configuration',
6441: ['usercreation'],$srch->{'srchdomain'});
6442: if (ref($domconfig{'usercreation'}) eq 'HASH') {
6443: if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') {
6444: @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}};
6445: }
6446: }
6447: if (@curr_rules > 0) {
6448: my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description');
6449: my $instuser_reqd;
6450: my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules);
6451: foreach my $rule (@curr_rules) {
6452: if ($rule_check{$rule}) {
6453: $rulematch = $rule;
6454: if ($inst_response eq 'ok') {
6455: if (keys(%inst_results) == 0) {
6456: if ($caller eq 'new') {
6457: $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.");
6458: }
6459: }
6460: }
6461: last;
6462: }
6463: }
6464: if ($response) {
6465: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
6466: if (@{$ruleorder} > 0) {
6467: $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>';
6468: foreach my $rule (@{$ruleorder}) {
6469: if (grep(/^\Q$rule\E$/,@curr_rules)) {
6470: if (ref($rules->{$rule}) eq 'HASH') {
6471: $response .= '<li>'.$rules->{$rule}{'name'}.': '.
6472: $rules->{$rule}{'desc'}.'</li>';
6473: }
6474: }
6475: }
6476: }
6477: $response .= '</ul>';
6478: }
6479: }
6480: }
6481: }
6482: return ($response,$rulematch,$rules,%inst_results);
6483: }
6484:
1.112 bowersj2 6485: =pod
6486:
1.549 albertel 6487: =back
6488:
6489: =head1 HTTP Helpers
6490:
6491: =over 4
6492:
1.112 bowersj2 6493: =item * get_unprocessed_cgi($query,$possible_names)
6494:
1.258 albertel 6495: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 6496: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 6497: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 6498:
6499: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
6500: $possible_names is an ref to an array of form element names. As an example:
6501: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 6502: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 6503:
6504: =cut
1.1 albertel 6505:
1.6 albertel 6506: sub get_unprocessed_cgi {
1.25 albertel 6507: my ($query,$possible_names)= @_;
1.26 matthew 6508: # $Apache::lonxml::debug=1;
1.356 albertel 6509: foreach my $pair (split(/&/,$query)) {
6510: my ($name, $value) = split(/=/,$pair);
1.369 www 6511: $name = &unescape($name);
1.25 albertel 6512: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
6513: $value =~ tr/+/ /;
6514: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 6515: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 6516: }
1.16 harris41 6517: }
1.6 albertel 6518: }
6519:
1.112 bowersj2 6520: =pod
6521:
6522: =item * cacheheader()
6523:
6524: returns cache-controlling header code
6525:
6526: =cut
6527:
1.7 albertel 6528: sub cacheheader {
1.258 albertel 6529: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 6530: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
6531: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 6532: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
6533: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 6534: return $output;
1.7 albertel 6535: }
6536:
1.112 bowersj2 6537: =pod
6538:
6539: =item * no_cache($r)
6540:
6541: specifies header code to not have cache
6542:
6543: =cut
6544:
1.9 albertel 6545: sub no_cache {
1.216 albertel 6546: my ($r) = @_;
6547: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 6548: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 6549: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
6550: $r->no_cache(1);
6551: $r->header_out("Expires" => $date);
6552: $r->header_out("Pragma" => "no-cache");
1.123 www 6553: }
6554:
6555: sub content_type {
1.181 albertel 6556: my ($r,$type,$charset) = @_;
1.299 foxr 6557: if ($r) {
6558: # Note that printout.pl calls this with undef for $r.
6559: &no_cache($r);
6560: }
1.258 albertel 6561: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 6562: unless ($charset) {
6563: $charset=&Apache::lonlocal::current_encoding;
6564: }
6565: if ($charset) { $type.='; charset='.$charset; }
6566: if ($r) {
6567: $r->content_type($type);
6568: } else {
6569: print("Content-type: $type\n\n");
6570: }
1.9 albertel 6571: }
1.25 albertel 6572:
1.112 bowersj2 6573: =pod
6574:
6575: =item * add_to_env($name,$value)
6576:
1.258 albertel 6577: adds $name to the %env hash with value
1.112 bowersj2 6578: $value, if $name already exists, the entry is converted to an array
6579: reference and $value is added to the array.
6580:
6581: =cut
6582:
1.25 albertel 6583: sub add_to_env {
6584: my ($name,$value)=@_;
1.258 albertel 6585: if (defined($env{$name})) {
6586: if (ref($env{$name})) {
1.25 albertel 6587: #already have multiple values
1.258 albertel 6588: push(@{ $env{$name} },$value);
1.25 albertel 6589: } else {
6590: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 6591: my $first=$env{$name};
6592: undef($env{$name});
6593: push(@{ $env{$name} },$first,$value);
1.25 albertel 6594: }
6595: } else {
1.258 albertel 6596: $env{$name}=$value;
1.25 albertel 6597: }
1.31 albertel 6598: }
1.149 albertel 6599:
6600: =pod
6601:
6602: =item * get_env_multiple($name)
6603:
1.258 albertel 6604: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 6605: values may be defined and end up as an array ref.
6606:
6607: returns an array of values
6608:
6609: =cut
6610:
6611: sub get_env_multiple {
6612: my ($name) = @_;
6613: my @values;
1.258 albertel 6614: if (defined($env{$name})) {
1.149 albertel 6615: # exists is it an array
1.258 albertel 6616: if (ref($env{$name})) {
6617: @values=@{ $env{$name} };
1.149 albertel 6618: } else {
1.258 albertel 6619: $values[0]=$env{$name};
1.149 albertel 6620: }
6621: }
6622: return(@values);
6623: }
6624:
1.31 albertel 6625:
1.41 ng 6626: =pod
1.45 matthew 6627:
1.464 albertel 6628: =back
1.41 ng 6629:
1.112 bowersj2 6630: =head1 CSV Upload/Handling functions
1.38 albertel 6631:
1.41 ng 6632: =over 4
6633:
1.112 bowersj2 6634: =item * upfile_store($r)
1.41 ng 6635:
6636: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 6637: needs $env{'form.upfile'}
1.41 ng 6638: returns $datatoken to be put into hidden field
6639:
6640: =cut
1.31 albertel 6641:
6642: sub upfile_store {
6643: my $r=shift;
1.258 albertel 6644: $env{'form.upfile'}=~s/\r/\n/gs;
6645: $env{'form.upfile'}=~s/\f/\n/gs;
6646: $env{'form.upfile'}=~s/\n+/\n/gs;
6647: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 6648:
1.258 albertel 6649: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
6650: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 6651: {
1.158 raeburn 6652: my $datafile = $r->dir_config('lonDaemons').
6653: '/tmp/'.$datatoken.'.tmp';
6654: if ( open(my $fh,">$datafile") ) {
1.258 albertel 6655: print $fh $env{'form.upfile'};
1.158 raeburn 6656: close($fh);
6657: }
1.31 albertel 6658: }
6659: return $datatoken;
6660: }
6661:
1.56 matthew 6662: =pod
6663:
1.112 bowersj2 6664: =item * load_tmp_file($r)
1.41 ng 6665:
6666: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 6667: needs $env{'form.datatoken'},
6668: sets $env{'form.upfile'} to the contents of the file
1.41 ng 6669:
6670: =cut
1.31 albertel 6671:
6672: sub load_tmp_file {
6673: my $r=shift;
6674: my @studentdata=();
6675: {
1.158 raeburn 6676: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 6677: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 6678: if ( open(my $fh,"<$studentfile") ) {
6679: @studentdata=<$fh>;
6680: close($fh);
6681: }
1.31 albertel 6682: }
1.258 albertel 6683: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 6684: }
6685:
1.56 matthew 6686: =pod
6687:
1.112 bowersj2 6688: =item * upfile_record_sep()
1.41 ng 6689:
6690: Separate uploaded file into records
6691: returns array of records,
1.258 albertel 6692: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 6693:
6694: =cut
1.31 albertel 6695:
6696: sub upfile_record_sep {
1.258 albertel 6697: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 6698: } else {
1.248 albertel 6699: my @records;
1.258 albertel 6700: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 6701: if ($line=~/^\s*$/) { next; }
6702: push(@records,$line);
6703: }
6704: return @records;
1.31 albertel 6705: }
6706: }
6707:
1.56 matthew 6708: =pod
6709:
1.112 bowersj2 6710: =item * record_sep($record)
1.41 ng 6711:
1.258 albertel 6712: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 6713:
6714: =cut
6715:
1.263 www 6716: sub takeleft {
6717: my $index=shift;
6718: return substr('0000'.$index,-4,4);
6719: }
6720:
1.31 albertel 6721: sub record_sep {
6722: my $record=shift;
6723: my %components=();
1.258 albertel 6724: if ($env{'form.upfiletype'} eq 'xml') {
6725: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 6726: my $i=0;
1.356 albertel 6727: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 6728: $field=~s/^(\"|\')//;
6729: $field=~s/(\"|\')$//;
1.263 www 6730: $components{&takeleft($i)}=$field;
1.31 albertel 6731: $i++;
6732: }
1.258 albertel 6733: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 6734: my $i=0;
1.356 albertel 6735: foreach my $field (split(/\t/,$record)) {
1.31 albertel 6736: $field=~s/^(\"|\')//;
6737: $field=~s/(\"|\')$//;
1.263 www 6738: $components{&takeleft($i)}=$field;
1.31 albertel 6739: $i++;
6740: }
6741: } else {
1.561 www 6742: my $separator=',';
1.480 banghart 6743: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 6744: $separator=';';
1.480 banghart 6745: }
1.31 albertel 6746: my $i=0;
1.561 www 6747: # the character we are looking for to indicate the end of a quote or a record
6748: my $looking_for=$separator;
6749: # do not add the characters to the fields
6750: my $ignore=0;
6751: # we just encountered a separator (or the beginning of the record)
6752: my $just_found_separator=1;
6753: # store the field we are working on here
6754: my $field='';
6755: # work our way through all characters in record
6756: foreach my $character ($record=~/(.)/g) {
6757: if ($character eq $looking_for) {
6758: if ($character ne $separator) {
6759: # Found the end of a quote, again looking for separator
6760: $looking_for=$separator;
6761: $ignore=1;
6762: } else {
6763: # Found a separator, store away what we got
6764: $components{&takeleft($i)}=$field;
6765: $i++;
6766: $just_found_separator=1;
6767: $ignore=0;
6768: $field='';
6769: }
6770: next;
6771: }
6772: # single or double quotation marks after a separator indicate beginning of a quote
6773: # we are now looking for the end of the quote and need to ignore separators
6774: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
6775: $looking_for=$character;
6776: next;
6777: }
6778: # ignore would be true after we reached the end of a quote
6779: if ($ignore) { next; }
6780: if (($just_found_separator) && ($character=~/\s/)) { next; }
6781: $field.=$character;
6782: $just_found_separator=0;
1.31 albertel 6783: }
1.561 www 6784: # catch the very last entry, since we never encountered the separator
6785: $components{&takeleft($i)}=$field;
1.31 albertel 6786: }
6787: return %components;
6788: }
6789:
1.144 matthew 6790: ######################################################
6791: ######################################################
6792:
1.56 matthew 6793: =pod
6794:
1.112 bowersj2 6795: =item * upfile_select_html()
1.41 ng 6796:
1.144 matthew 6797: Return HTML code to select a file from the users machine and specify
6798: the file type.
1.41 ng 6799:
6800: =cut
6801:
1.144 matthew 6802: ######################################################
6803: ######################################################
1.31 albertel 6804: sub upfile_select_html {
1.144 matthew 6805: my %Types = (
6806: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 6807: semisv => &mt('Semicolon separated values'),
1.144 matthew 6808: space => &mt('Space separated'),
6809: tab => &mt('Tabulator separated'),
6810: # xml => &mt('HTML/XML'),
6811: );
6812: my $Str = '<input type="file" name="upfile" size="50" />'.
6813: '<br />Type: <select name="upfiletype">';
6814: foreach my $type (sort(keys(%Types))) {
6815: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
6816: }
6817: $Str .= "</select>\n";
6818: return $Str;
1.31 albertel 6819: }
6820:
1.301 albertel 6821: sub get_samples {
6822: my ($records,$toget) = @_;
6823: my @samples=({});
6824: my $got=0;
6825: foreach my $rec (@$records) {
6826: my %temp = &record_sep($rec);
6827: if (! grep(/\S/, values(%temp))) { next; }
6828: if (%temp) {
6829: $samples[$got]=\%temp;
6830: $got++;
6831: if ($got == $toget) { last; }
6832: }
6833: }
6834: return \@samples;
6835: }
6836:
1.144 matthew 6837: ######################################################
6838: ######################################################
6839:
1.56 matthew 6840: =pod
6841:
1.112 bowersj2 6842: =item * csv_print_samples($r,$records)
1.41 ng 6843:
6844: Prints a table of sample values from each column uploaded $r is an
6845: Apache Request ref, $records is an arrayref from
6846: &Apache::loncommon::upfile_record_sep
6847:
6848: =cut
6849:
1.144 matthew 6850: ######################################################
6851: ######################################################
1.31 albertel 6852: sub csv_print_samples {
6853: my ($r,$records) = @_;
1.301 albertel 6854: my $samples = &get_samples($records,3);
6855:
1.594 raeburn 6856: $r->print(&mt('Samples').'<br />'.&start_data_table().
6857: &start_data_table_header_row());
1.356 albertel 6858: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
6859: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 6860: $r->print(&end_data_table_header_row());
1.301 albertel 6861: foreach my $hash (@$samples) {
1.594 raeburn 6862: $r->print(&start_data_table_row());
1.356 albertel 6863: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 6864: $r->print('<td>');
1.356 albertel 6865: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 6866: $r->print('</td>');
6867: }
1.594 raeburn 6868: $r->print(&end_data_table_row());
1.31 albertel 6869: }
1.594 raeburn 6870: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 6871: }
6872:
1.144 matthew 6873: ######################################################
6874: ######################################################
6875:
1.56 matthew 6876: =pod
6877:
1.112 bowersj2 6878: =item * csv_print_select_table($r,$records,$d)
1.41 ng 6879:
6880: Prints a table to create associations between values and table columns.
1.144 matthew 6881:
1.41 ng 6882: $r is an Apache Request ref,
6883: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 6884: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 6885:
6886: =cut
6887:
1.144 matthew 6888: ######################################################
6889: ######################################################
1.31 albertel 6890: sub csv_print_select_table {
6891: my ($r,$records,$d) = @_;
1.301 albertel 6892: my $i=0;
6893: my $samples = &get_samples($records,1);
1.144 matthew 6894: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 6895: &start_data_table().&start_data_table_header_row().
1.144 matthew 6896: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 6897: '<th>'.&mt('Column').'</th>'.
6898: &end_data_table_header_row()."\n");
1.356 albertel 6899: foreach my $array_ref (@$d) {
6900: my ($value,$display,$defaultcol)=@{ $array_ref };
1.594 raeburn 6901: $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
1.31 albertel 6902:
6903: $r->print('<td><select name=f'.$i.
1.32 matthew 6904: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 6905: $r->print('<option value="none"></option>');
1.356 albertel 6906: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
6907: $r->print('<option value="'.$sample.'"'.
6908: ($sample eq $defaultcol ? ' selected="selected" ' : '').
6909: '>Column '.($sample+1).'</option>');
1.31 albertel 6910: }
1.594 raeburn 6911: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 6912: $i++;
6913: }
1.594 raeburn 6914: $r->print(&end_data_table());
1.31 albertel 6915: $i--;
6916: return $i;
6917: }
1.56 matthew 6918:
1.144 matthew 6919: ######################################################
6920: ######################################################
6921:
1.56 matthew 6922: =pod
1.31 albertel 6923:
1.112 bowersj2 6924: =item * csv_samples_select_table($r,$records,$d)
1.41 ng 6925:
6926: Prints a table of sample values from the upload and can make associate samples to internal names.
6927:
6928: $r is an Apache Request ref,
6929: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
6930: $d is an array of 2 element arrays (internal name, displayed name)
6931:
6932: =cut
6933:
1.144 matthew 6934: ######################################################
6935: ######################################################
1.31 albertel 6936: sub csv_samples_select_table {
6937: my ($r,$records,$d) = @_;
6938: my $i=0;
1.144 matthew 6939: #
1.301 albertel 6940: my $samples = &get_samples($records,3);
1.594 raeburn 6941: $r->print(&start_data_table().
6942: &start_data_table_header_row().'<th>'.
6943: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
6944: &end_data_table_header_row());
1.301 albertel 6945:
6946: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 6947: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 6948: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 6949: foreach my $option (@$d) {
6950: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 6951: $r->print('<option value="'.$value.'"'.
1.253 albertel 6952: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 6953: $display.'</option>');
1.31 albertel 6954: }
6955: $r->print('</select></td><td>');
1.301 albertel 6956: foreach my $line (0..2) {
6957: if (defined($samples->[$line]{$key})) {
6958: $r->print($samples->[$line]{$key}."<br />\n");
6959: }
6960: }
1.594 raeburn 6961: $r->print('</td>'.&end_data_table_row());
1.31 albertel 6962: $i++;
6963: }
1.594 raeburn 6964: $r->print(&end_data_table());
1.31 albertel 6965: $i--;
6966: return($i);
1.115 matthew 6967: }
6968:
1.144 matthew 6969: ######################################################
6970: ######################################################
6971:
1.115 matthew 6972: =pod
6973:
6974: =item clean_excel_name($name)
6975:
6976: Returns a replacement for $name which does not contain any illegal characters.
6977:
6978: =cut
6979:
1.144 matthew 6980: ######################################################
6981: ######################################################
1.115 matthew 6982: sub clean_excel_name {
6983: my ($name) = @_;
6984: $name =~ s/[:\*\?\/\\]//g;
6985: if (length($name) > 31) {
6986: $name = substr($name,0,31);
6987: }
6988: return $name;
1.25 albertel 6989: }
1.84 albertel 6990:
1.85 albertel 6991: =pod
6992:
1.112 bowersj2 6993: =item * check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 6994:
6995: Returns either 1 or undef
6996:
6997: 1 if the part is to be hidden, undef if it is to be shown
6998:
6999: Arguments are:
7000:
7001: $id the id of the part to be checked
7002: $symb, optional the symb of the resource to check
7003: $udom, optional the domain of the user to check for
7004: $uname, optional the username of the user to check for
7005:
7006: =cut
1.84 albertel 7007:
7008: sub check_if_partid_hidden {
7009: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 7010: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 7011: $symb,$udom,$uname);
1.141 albertel 7012: my $truth=1;
7013: #if the string starts with !, then the list is the list to show not hide
7014: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 7015: my @hiddenlist=split(/,/,$hiddenparts);
7016: foreach my $checkid (@hiddenlist) {
1.141 albertel 7017: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 7018: }
1.141 albertel 7019: return !$truth;
1.84 albertel 7020: }
1.127 matthew 7021:
1.138 matthew 7022:
7023: ############################################################
7024: ############################################################
7025:
7026: =pod
7027:
1.157 matthew 7028: =back
7029:
1.138 matthew 7030: =head1 cgi-bin script and graphing routines
7031:
1.157 matthew 7032: =over 4
7033:
1.138 matthew 7034: =item get_cgi_id
7035:
7036: Inputs: none
7037:
7038: Returns an id which can be used to pass environment variables
7039: to various cgi-bin scripts. These environment variables will
7040: be removed from the users environment after a given time by
7041: the routine &Apache::lonnet::transfer_profile_to_env.
7042:
7043: =cut
7044:
7045: ############################################################
7046: ############################################################
1.152 albertel 7047: my $uniq=0;
1.136 matthew 7048: sub get_cgi_id {
1.154 albertel 7049: $uniq=($uniq+1)%100000;
1.280 albertel 7050: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 7051: }
7052:
1.127 matthew 7053: ############################################################
7054: ############################################################
7055:
7056: =pod
7057:
1.134 matthew 7058: =item DrawBarGraph
1.127 matthew 7059:
1.138 matthew 7060: Facilitates the plotting of data in a (stacked) bar graph.
7061: Puts plot definition data into the users environment in order for
7062: graph.png to plot it. Returns an <img> tag for the plot.
7063: The bars on the plot are labeled '1','2',...,'n'.
7064:
7065: Inputs:
7066:
7067: =over 4
7068:
7069: =item $Title: string, the title of the plot
7070:
7071: =item $xlabel: string, text describing the X-axis of the plot
7072:
7073: =item $ylabel: string, text describing the Y-axis of the plot
7074:
7075: =item $Max: scalar, the maximum Y value to use in the plot
7076: If $Max is < any data point, the graph will not be rendered.
7077:
1.140 matthew 7078: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 7079: they are plotted. If undefined, default values will be used.
7080:
1.178 matthew 7081: =item $labels: array ref holding the labels to use on the x-axis for the bars.
7082:
1.138 matthew 7083: =item @Values: An array of array references. Each array reference holds data
7084: to be plotted in a stacked bar chart.
7085:
1.239 matthew 7086: =item If the final element of @Values is a hash reference the key/value
7087: pairs will be added to the graph definition.
7088:
1.138 matthew 7089: =back
7090:
7091: Returns:
7092:
7093: An <img> tag which references graph.png and the appropriate identifying
7094: information for the plot.
7095:
1.127 matthew 7096: =cut
7097:
7098: ############################################################
7099: ############################################################
1.134 matthew 7100: sub DrawBarGraph {
1.178 matthew 7101: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 7102: #
7103: if (! defined($colors)) {
7104: $colors = ['#33ff00',
7105: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
7106: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
7107: ];
7108: }
1.228 matthew 7109: my $extra_settings = {};
7110: if (ref($Values[-1]) eq 'HASH') {
7111: $extra_settings = pop(@Values);
7112: }
1.127 matthew 7113: #
1.136 matthew 7114: my $identifier = &get_cgi_id();
7115: my $id = 'cgi.'.$identifier;
1.129 matthew 7116: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 7117: return '';
7118: }
1.225 matthew 7119: #
7120: my @Labels;
7121: if (defined($labels)) {
7122: @Labels = @$labels;
7123: } else {
7124: for (my $i=0;$i<@{$Values[0]};$i++) {
7125: push (@Labels,$i+1);
7126: }
7127: }
7128: #
1.129 matthew 7129: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 7130: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 7131: my %ValuesHash;
7132: my $NumSets=1;
7133: foreach my $array (@Values) {
7134: next if (! ref($array));
1.136 matthew 7135: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 7136: join(',',@$array);
1.129 matthew 7137: }
1.127 matthew 7138: #
1.136 matthew 7139: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 7140: if ($NumBars < 3) {
7141: $width = 120+$NumBars*32;
1.220 matthew 7142: $xskip = 1;
1.225 matthew 7143: $bar_width = 30;
7144: } elsif ($NumBars < 5) {
7145: $width = 120+$NumBars*20;
7146: $xskip = 1;
7147: $bar_width = 20;
1.220 matthew 7148: } elsif ($NumBars < 10) {
1.136 matthew 7149: $width = 120+$NumBars*15;
7150: $xskip = 1;
7151: $bar_width = 15;
7152: } elsif ($NumBars <= 25) {
7153: $width = 120+$NumBars*11;
7154: $xskip = 5;
7155: $bar_width = 8;
7156: } elsif ($NumBars <= 50) {
7157: $width = 120+$NumBars*8;
7158: $xskip = 5;
7159: $bar_width = 4;
7160: } else {
7161: $width = 120+$NumBars*8;
7162: $xskip = 5;
7163: $bar_width = 4;
7164: }
7165: #
1.137 matthew 7166: $Max = 1 if ($Max < 1);
7167: if ( int($Max) < $Max ) {
7168: $Max++;
7169: $Max = int($Max);
7170: }
1.127 matthew 7171: $Title = '' if (! defined($Title));
7172: $xlabel = '' if (! defined($xlabel));
7173: $ylabel = '' if (! defined($ylabel));
1.369 www 7174: $ValuesHash{$id.'.title'} = &escape($Title);
7175: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
7176: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 7177: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 7178: $ValuesHash{$id.'.NumBars'} = $NumBars;
7179: $ValuesHash{$id.'.NumSets'} = $NumSets;
7180: $ValuesHash{$id.'.PlotType'} = 'bar';
7181: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7182: $ValuesHash{$id.'.height'} = $height;
7183: $ValuesHash{$id.'.width'} = $width;
7184: $ValuesHash{$id.'.xskip'} = $xskip;
7185: $ValuesHash{$id.'.bar_width'} = $bar_width;
7186: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 7187: #
1.228 matthew 7188: # Deal with other parameters
7189: while (my ($key,$value) = each(%$extra_settings)) {
7190: $ValuesHash{$id.'.'.$key} = $value;
7191: }
7192: #
1.137 matthew 7193: &Apache::lonnet::appenv(%ValuesHash);
7194: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7195: }
7196:
7197: ############################################################
7198: ############################################################
7199:
7200: =pod
7201:
7202: =item DrawXYGraph
7203:
1.138 matthew 7204: Facilitates the plotting of data in an XY graph.
7205: Puts plot definition data into the users environment in order for
7206: graph.png to plot it. Returns an <img> tag for the plot.
7207:
7208: Inputs:
7209:
7210: =over 4
7211:
7212: =item $Title: string, the title of the plot
7213:
7214: =item $xlabel: string, text describing the X-axis of the plot
7215:
7216: =item $ylabel: string, text describing the Y-axis of the plot
7217:
7218: =item $Max: scalar, the maximum Y value to use in the plot
7219: If $Max is < any data point, the graph will not be rendered.
7220:
7221: =item $colors: Array ref containing the hex color codes for the data to be
7222: plotted in. If undefined, default values will be used.
7223:
7224: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7225:
7226: =item $Ydata: Array ref containing Array refs.
1.185 www 7227: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 7228:
7229: =item %Values: hash indicating or overriding any default values which are
7230: passed to graph.png.
7231: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7232:
7233: =back
7234:
7235: Returns:
7236:
7237: An <img> tag which references graph.png and the appropriate identifying
7238: information for the plot.
7239:
1.137 matthew 7240: =cut
7241:
7242: ############################################################
7243: ############################################################
7244: sub DrawXYGraph {
7245: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
7246: #
7247: # Create the identifier for the graph
7248: my $identifier = &get_cgi_id();
7249: my $id = 'cgi.'.$identifier;
7250: #
7251: $Title = '' if (! defined($Title));
7252: $xlabel = '' if (! defined($xlabel));
7253: $ylabel = '' if (! defined($ylabel));
7254: my %ValuesHash =
7255: (
1.369 www 7256: $id.'.title' => &escape($Title),
7257: $id.'.xlabel' => &escape($xlabel),
7258: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 7259: $id.'.y_max_value'=> $Max,
7260: $id.'.labels' => join(',',@$Xlabels),
7261: $id.'.PlotType' => 'XY',
7262: );
7263: #
7264: if (defined($colors) && ref($colors) eq 'ARRAY') {
7265: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7266: }
7267: #
7268: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
7269: return '';
7270: }
7271: my $NumSets=1;
1.138 matthew 7272: foreach my $array (@{$Ydata}){
1.137 matthew 7273: next if (! ref($array));
7274: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
7275: }
1.138 matthew 7276: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 7277: #
7278: # Deal with other parameters
7279: while (my ($key,$value) = each(%Values)) {
7280: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 7281: }
7282: #
1.136 matthew 7283: &Apache::lonnet::appenv(%ValuesHash);
7284: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7285: }
7286:
7287: ############################################################
7288: ############################################################
7289:
7290: =pod
7291:
1.138 matthew 7292: =item DrawXYYGraph
7293:
7294: Facilitates the plotting of data in an XY graph with two Y axes.
7295: Puts plot definition data into the users environment in order for
7296: graph.png to plot it. Returns an <img> tag for the plot.
7297:
7298: Inputs:
7299:
7300: =over 4
7301:
7302: =item $Title: string, the title of the plot
7303:
7304: =item $xlabel: string, text describing the X-axis of the plot
7305:
7306: =item $ylabel: string, text describing the Y-axis of the plot
7307:
7308: =item $colors: Array ref containing the hex color codes for the data to be
7309: plotted in. If undefined, default values will be used.
7310:
7311: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7312:
7313: =item $Ydata1: The first data set
7314:
7315: =item $Min1: The minimum value of the left Y-axis
7316:
7317: =item $Max1: The maximum value of the left Y-axis
7318:
7319: =item $Ydata2: The second data set
7320:
7321: =item $Min2: The minimum value of the right Y-axis
7322:
7323: =item $Max2: The maximum value of the left Y-axis
7324:
7325: =item %Values: hash indicating or overriding any default values which are
7326: passed to graph.png.
7327: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7328:
7329: =back
7330:
7331: Returns:
7332:
7333: An <img> tag which references graph.png and the appropriate identifying
7334: information for the plot.
1.136 matthew 7335:
7336: =cut
7337:
7338: ############################################################
7339: ############################################################
1.137 matthew 7340: sub DrawXYYGraph {
7341: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
7342: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 7343: #
7344: # Create the identifier for the graph
7345: my $identifier = &get_cgi_id();
7346: my $id = 'cgi.'.$identifier;
7347: #
7348: $Title = '' if (! defined($Title));
7349: $xlabel = '' if (! defined($xlabel));
7350: $ylabel = '' if (! defined($ylabel));
7351: my %ValuesHash =
7352: (
1.369 www 7353: $id.'.title' => &escape($Title),
7354: $id.'.xlabel' => &escape($xlabel),
7355: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 7356: $id.'.labels' => join(',',@$Xlabels),
7357: $id.'.PlotType' => 'XY',
7358: $id.'.NumSets' => 2,
1.137 matthew 7359: $id.'.two_axes' => 1,
7360: $id.'.y1_max_value' => $Max1,
7361: $id.'.y1_min_value' => $Min1,
7362: $id.'.y2_max_value' => $Max2,
7363: $id.'.y2_min_value' => $Min2,
1.136 matthew 7364: );
7365: #
1.137 matthew 7366: if (defined($colors) && ref($colors) eq 'ARRAY') {
7367: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7368: }
7369: #
7370: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
7371: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 7372: return '';
7373: }
7374: my $NumSets=1;
1.137 matthew 7375: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 7376: next if (! ref($array));
7377: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 7378: }
7379: #
7380: # Deal with other parameters
7381: while (my ($key,$value) = each(%Values)) {
7382: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 7383: }
7384: #
7385: &Apache::lonnet::appenv(%ValuesHash);
1.130 albertel 7386: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 7387: }
7388:
7389: ############################################################
7390: ############################################################
7391:
7392: =pod
7393:
1.157 matthew 7394: =back
7395:
1.139 matthew 7396: =head1 Statistics helper routines?
7397:
7398: Bad place for them but what the hell.
7399:
1.157 matthew 7400: =over 4
7401:
1.139 matthew 7402: =item &chartlink
7403:
7404: Returns a link to the chart for a specific student.
7405:
7406: Inputs:
7407:
7408: =over 4
7409:
7410: =item $linktext: The text of the link
7411:
7412: =item $sname: The students username
7413:
7414: =item $sdomain: The students domain
7415:
7416: =back
7417:
1.157 matthew 7418: =back
7419:
1.139 matthew 7420: =cut
7421:
7422: ############################################################
7423: ############################################################
7424: sub chartlink {
7425: my ($linktext, $sname, $sdomain) = @_;
7426: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 7427: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 7428: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 7429: '">'.$linktext.'</a>';
1.153 matthew 7430: }
7431:
7432: #######################################################
7433: #######################################################
7434:
7435: =pod
7436:
7437: =head1 Course Environment Routines
1.157 matthew 7438:
7439: =over 4
1.153 matthew 7440:
7441: =item &restore_course_settings
7442:
7443: =item &store_course_settings
7444:
7445: Restores/Store indicated form parameters from the course environment.
7446: Will not overwrite existing values of the form parameters.
7447:
7448: Inputs:
7449: a scalar describing the data (e.g. 'chart', 'problem_analysis')
7450:
7451: a hash ref describing the data to be stored. For example:
7452:
7453: %Save_Parameters = ('Status' => 'scalar',
7454: 'chartoutputmode' => 'scalar',
7455: 'chartoutputdata' => 'scalar',
7456: 'Section' => 'array',
1.373 raeburn 7457: 'Group' => 'array',
1.153 matthew 7458: 'StudentData' => 'array',
7459: 'Maps' => 'array');
7460:
7461: Returns: both routines return nothing
7462:
7463: =cut
7464:
7465: #######################################################
7466: #######################################################
7467: sub store_course_settings {
1.496 albertel 7468: return &store_settings($env{'request.course.id'},@_);
7469: }
7470:
7471: sub store_settings {
1.153 matthew 7472: # save to the environment
7473: # appenv the same items, just to be safe
1.300 albertel 7474: my $udom = $env{'user.domain'};
7475: my $uname = $env{'user.name'};
1.496 albertel 7476: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7477: my %SaveHash;
7478: my %AppHash;
7479: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 7480: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 7481: my $envname = 'environment.'.$basename;
1.258 albertel 7482: if (exists($env{'form.'.$setting})) {
1.153 matthew 7483: # Save this value away
7484: if ($type eq 'scalar' &&
1.258 albertel 7485: (! exists($env{$envname}) ||
7486: $env{$envname} ne $env{'form.'.$setting})) {
7487: $SaveHash{$basename} = $env{'form.'.$setting};
7488: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 7489: } elsif ($type eq 'array') {
7490: my $stored_form;
1.258 albertel 7491: if (ref($env{'form.'.$setting})) {
1.153 matthew 7492: $stored_form = join(',',
7493: map {
1.369 www 7494: &escape($_);
1.258 albertel 7495: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 7496: } else {
7497: $stored_form =
1.369 www 7498: &escape($env{'form.'.$setting});
1.153 matthew 7499: }
7500: # Determine if the array contents are the same.
1.258 albertel 7501: if ($stored_form ne $env{$envname}) {
1.153 matthew 7502: $SaveHash{$basename} = $stored_form;
7503: $AppHash{$envname} = $stored_form;
7504: }
7505: }
7506: }
7507: }
7508: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 7509: $udom,$uname);
1.153 matthew 7510: if ($put_result !~ /^(ok|delayed)/) {
7511: &Apache::lonnet::logthis('unable to save form parameters, '.
7512: 'got error:'.$put_result);
7513: }
7514: # Make sure these settings stick around in this session, too
7515: &Apache::lonnet::appenv(%AppHash);
7516: return;
7517: }
7518:
7519: sub restore_course_settings {
1.499 albertel 7520: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 7521: }
7522:
7523: sub restore_settings {
7524: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7525: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 7526: next if (exists($env{'form.'.$setting}));
1.496 albertel 7527: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 7528: '.'.$setting;
1.258 albertel 7529: if (exists($env{$envname})) {
1.153 matthew 7530: if ($type eq 'scalar') {
1.258 albertel 7531: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 7532: } elsif ($type eq 'array') {
1.258 albertel 7533: $env{'form.'.$setting} = [
1.153 matthew 7534: map {
1.369 www 7535: &unescape($_);
1.258 albertel 7536: } split(',',$env{$envname})
1.153 matthew 7537: ];
7538: }
7539: }
7540: }
1.127 matthew 7541: }
7542:
7543: ############################################################
7544: ############################################################
1.154 albertel 7545:
1.443 albertel 7546: sub commit_customrole {
7547: my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
7548: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
7549: ($start?', '.&mt('starting').' '.localtime($start):'').
7550: ($end?', ending '.localtime($end):'').': <b>'.
7551: &Apache::lonnet::assigncustomrole(
7552: $udom,$uname,$url,$three,$four,$five,$end,$start).
7553: '</b><br />';
7554: return $output;
7555: }
7556:
7557: sub commit_standardrole {
1.541 raeburn 7558: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7559: my ($output,$logmsg,$linefeed);
7560: if ($context eq 'auto') {
7561: $linefeed = "\n";
7562: } else {
7563: $linefeed = "<br />\n";
7564: }
1.443 albertel 7565: if ($three eq 'st') {
1.541 raeburn 7566: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
7567: $one,$two,$sec,$context);
7568: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
7569: ($result eq 'unknown_course')) {
1.443 albertel 7570: $output = "Error: $result\n";
7571: } else {
1.541 raeburn 7572: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 7573: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7574: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7575: if ($context eq 'auto') {
7576: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
7577: } else {
7578: $output .= '<b>'.$result.'</b>'.$linefeed.
7579: &mt('Add to classlist').': <b>ok</b>';
7580: }
7581: $output .= $linefeed;
1.443 albertel 7582: }
7583: } else {
7584: $output = &mt('Assigning').' '.$three.' in '.$url.
7585: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7586: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7587: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
7588: if ($context eq 'auto') {
7589: $output .= $result.$linefeed;
7590: } else {
7591: $output .= '<b>'.$result.'</b>'.$linefeed;
7592: }
1.443 albertel 7593: }
7594: return $output;
7595: }
7596:
7597: sub commit_studentrole {
1.541 raeburn 7598: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7599: my ($result,$linefeed);
7600: if ($context eq 'auto') {
7601: $linefeed = "\n";
7602: } else {
7603: $linefeed = '<br />'."\n";
7604: }
1.443 albertel 7605: if (defined($one) && defined($two)) {
7606: my $cid=$one.'_'.$two;
7607: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
7608: my $secchange = 0;
7609: my $expire_role_result;
7610: my $modify_section_result;
7611: unless ($oldsec eq '-1') {
7612: unless ($sec eq $oldsec) {
7613: $secchange = 1;
7614: my $uurl='/'.$cid;
7615: $uurl=~s/\_/\//g;
7616: if ($oldsec) {
7617: $uurl.='/'.$oldsec;
7618: }
7619: $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
7620: $result = $expire_role_result;
7621: }
7622: }
7623: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
7624: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
7625: if ($modify_section_result =~ /^ok/) {
7626: if ($secchange == 1) {
7627: $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
7628: } elsif ($oldsec eq '-1') {
7629: $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
7630: } else {
7631: $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
7632: }
7633: } else {
7634: $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
7635: }
7636: $result = $modify_section_result;
7637: } elsif ($secchange == 1) {
7638: $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
7639: }
7640: } else {
7641: $$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
7642: $result = "error: incomplete course id\n";
7643: }
7644: return $result;
7645: }
7646:
7647: ############################################################
7648: ############################################################
7649:
1.566 albertel 7650: sub check_clone {
1.578 raeburn 7651: my ($args,$linefeed) = @_;
1.566 albertel 7652: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
7653: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
7654: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
7655: my $clonemsg;
7656: my $can_clone = 0;
7657:
7658: if ($clonehome eq 'no_host') {
1.578 raeburn 7659: $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 7660: } else {
7661: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 7662: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 7663: $can_clone = 1;
7664: } else {
7665: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
7666: $args->{'clonedomain'},$args->{'clonecourse'});
7667: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 7668: if (grep(/^\*$/,@cloners)) {
7669: $can_clone = 1;
7670: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
7671: $can_clone = 1;
7672: } else {
7673: my %roleshash =
7674: &Apache::lonnet::get_my_roles($args->{'ccuname'},
7675: $args->{'ccdomain'},
7676: 'userroles',['active'],['cc'],
7677: [$args->{'clonedomain'}]);
7678: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
7679: $can_clone = 1;
7680: } else {
7681: $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'});
7682: }
1.566 albertel 7683: }
1.578 raeburn 7684: }
1.566 albertel 7685: }
7686: return ($can_clone, $clonemsg, $cloneid, $clonehome);
7687: }
7688:
1.444 albertel 7689: sub construct_course {
1.541 raeburn 7690: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 7691: my $outcome;
1.541 raeburn 7692: my $linefeed = '<br />'."\n";
7693: if ($context eq 'auto') {
7694: $linefeed = "\n";
7695: }
1.566 albertel 7696:
7697: #
7698: # Are we cloning?
7699: #
7700: my ($can_clone, $clonemsg, $cloneid, $clonehome);
7701: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 7702: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 7703: if ($context ne 'auto') {
1.578 raeburn 7704: if ($clonemsg ne '') {
7705: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
7706: }
1.566 albertel 7707: }
7708: $outcome .= $clonemsg.$linefeed;
7709:
7710: if (!$can_clone) {
7711: return (0,$outcome);
7712: }
7713: }
7714:
1.444 albertel 7715: #
7716: # Open course
7717: #
7718: my $crstype = lc($args->{'crstype'});
7719: my %cenv=();
7720: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
7721: $args->{'cdescr'},
7722: $args->{'curl'},
7723: $args->{'course_home'},
7724: $args->{'nonstandard'},
7725: $args->{'crscode'},
7726: $args->{'ccuname'}.':'.
7727: $args->{'ccdomain'},
7728: $args->{'crstype'});
7729:
7730: # Note: The testing routines depend on this being output; see
7731: # Utils::Course. This needs to at least be output as a comment
7732: # if anyone ever decides to not show this, and Utils::Course::new
7733: # will need to be suitably modified.
1.541 raeburn 7734: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 7735: #
7736: # Check if created correctly
7737: #
1.479 albertel 7738: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 7739: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 7740: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 7741:
1.444 albertel 7742: #
1.566 albertel 7743: # Do the cloning
7744: #
7745: if ($can_clone && $cloneid) {
7746: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
7747: if ($context ne 'auto') {
7748: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
7749: }
7750: $outcome .= $clonemsg.$linefeed;
7751: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 7752: # Copy all files
1.566 albertel 7753: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
1.444 albertel 7754: # Restore URL
1.566 albertel 7755: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 7756: # Restore title
1.566 albertel 7757: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 7758: # restore grading mode
1.566 albertel 7759: if (defined($oldcenv{'grading'})) {
7760: $cenv{'grading'}=$oldcenv{'grading'};
7761: }
1.444 albertel 7762: # Mark as cloned
1.566 albertel 7763: $cenv{'clonedfrom'}=$cloneid;
7764: delete($cenv{'default_enrollment_start_date'});
7765: delete($cenv{'default_enrollment_end_date'});
1.444 albertel 7766: }
1.566 albertel 7767:
1.444 albertel 7768: #
7769: # Set environment (will override cloned, if existing)
7770: #
7771: my @sections = ();
7772: my @xlists = ();
7773: if ($args->{'crstype'}) {
7774: $cenv{'type'}=$args->{'crstype'};
7775: }
7776: if ($args->{'crsid'}) {
7777: $cenv{'courseid'}=$args->{'crsid'};
7778: }
7779: if ($args->{'crscode'}) {
7780: $cenv{'internal.coursecode'}=$args->{'crscode'};
7781: }
7782: if ($args->{'crsquota'} ne '') {
7783: $cenv{'internal.coursequota'}=$args->{'crsquota'};
7784: } else {
7785: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
7786: }
7787: if ($args->{'ccuname'}) {
7788: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
7789: ':'.$args->{'ccdomain'};
7790: } else {
7791: $cenv{'internal.courseowner'} = $args->{'curruser'};
7792: }
7793:
7794: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
7795: if ($args->{'crssections'}) {
7796: $cenv{'internal.sectionnums'} = '';
7797: if ($args->{'crssections'} =~ m/,/) {
7798: @sections = split/,/,$args->{'crssections'};
7799: } else {
7800: $sections[0] = $args->{'crssections'};
7801: }
7802: if (@sections > 0) {
7803: foreach my $item (@sections) {
7804: my ($sec,$gp) = split/:/,$item;
7805: my $class = $args->{'crscode'}.$sec;
7806: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
7807: $cenv{'internal.sectionnums'} .= $item.',';
7808: unless ($addcheck eq 'ok') {
7809: push @badclasses, $class;
7810: }
7811: }
7812: $cenv{'internal.sectionnums'} =~ s/,$//;
7813: }
7814: }
7815: # do not hide course coordinator from staff listing,
7816: # even if privileged
7817: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7818: # add crosslistings
7819: if ($args->{'crsxlist'}) {
7820: $cenv{'internal.crosslistings'}='';
7821: if ($args->{'crsxlist'} =~ m/,/) {
7822: @xlists = split/,/,$args->{'crsxlist'};
7823: } else {
7824: $xlists[0] = $args->{'crsxlist'};
7825: }
7826: if (@xlists > 0) {
7827: foreach my $item (@xlists) {
7828: my ($xl,$gp) = split/:/,$item;
7829: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
7830: $cenv{'internal.crosslistings'} .= $item.',';
7831: unless ($addcheck eq 'ok') {
7832: push @badclasses, $xl;
7833: }
7834: }
7835: $cenv{'internal.crosslistings'} =~ s/,$//;
7836: }
7837: }
7838: if ($args->{'autoadds'}) {
7839: $cenv{'internal.autoadds'}=$args->{'autoadds'};
7840: }
7841: if ($args->{'autodrops'}) {
7842: $cenv{'internal.autodrops'}=$args->{'autodrops'};
7843: }
7844: # check for notification of enrollment changes
7845: my @notified = ();
7846: if ($args->{'notify_owner'}) {
7847: if ($args->{'ccuname'} ne '') {
7848: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
7849: }
7850: }
7851: if ($args->{'notify_dc'}) {
7852: if ($uname ne '') {
7853: push(@notified,$uname.'@'.$udom);
7854: }
7855: }
7856: if (@notified > 0) {
7857: my $notifylist;
7858: if (@notified > 1) {
7859: $notifylist = join(',',@notified);
7860: } else {
7861: $notifylist = $notified[0];
7862: }
7863: $cenv{'internal.notifylist'} = $notifylist;
7864: }
7865: if (@badclasses > 0) {
7866: my %lt=&Apache::lonlocal::texthash(
7867: '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',
7868: 'dnhr' => 'does not have rights to access enrollment in these classes',
7869: 'adby' => 'as determined by the policies of your institution on access to official classlists'
7870: );
1.541 raeburn 7871: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
7872: ' ('.$lt{'adby'}.')';
7873: if ($context eq 'auto') {
7874: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 7875: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 7876: foreach my $item (@badclasses) {
7877: if ($context eq 'auto') {
7878: $outcome .= " - $item\n";
7879: } else {
7880: $outcome .= "<li>$item</li>\n";
7881: }
7882: }
7883: if ($context eq 'auto') {
7884: $outcome .= $linefeed;
7885: } else {
1.566 albertel 7886: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 7887: }
7888: }
1.444 albertel 7889: }
7890: if ($args->{'no_end_date'}) {
7891: $args->{'endaccess'} = 0;
7892: }
7893: $cenv{'internal.autostart'}=$args->{'enrollstart'};
7894: $cenv{'internal.autoend'}=$args->{'enrollend'};
7895: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
7896: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
7897: if ($args->{'showphotos'}) {
7898: $cenv{'internal.showphotos'}=$args->{'showphotos'};
7899: }
7900: $cenv{'internal.authtype'} = $args->{'authtype'};
7901: $cenv{'internal.autharg'} = $args->{'autharg'};
7902: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
7903: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 7904: 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');
7905: if ($context eq 'auto') {
7906: $outcome .= $krb_msg;
7907: } else {
1.566 albertel 7908: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 7909: }
7910: $outcome .= $linefeed;
1.444 albertel 7911: }
7912: }
7913: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
7914: if ($args->{'setpolicy'}) {
7915: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7916: }
7917: if ($args->{'setcontent'}) {
7918: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
7919: }
7920: }
7921: if ($args->{'reshome'}) {
7922: $cenv{'reshome'}=$args->{'reshome'}.'/';
7923: $cenv{'reshome'}=~s/\/+$/\//;
7924: }
7925: #
7926: # course has keyed access
7927: #
7928: if ($args->{'setkeys'}) {
7929: $cenv{'keyaccess'}='yes';
7930: }
7931: # if specified, key authority is not course, but user
7932: # only active if keyaccess is yes
7933: if ($args->{'keyauth'}) {
1.487 albertel 7934: my ($user,$domain) = split(':',$args->{'keyauth'});
7935: $user = &LONCAPA::clean_username($user);
7936: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 7937: if ($user ne '' && $domain ne '') {
1.487 albertel 7938: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 7939: }
7940: }
7941:
7942: if ($args->{'disresdis'}) {
7943: $cenv{'pch.roles.denied'}='st';
7944: }
7945: if ($args->{'disablechat'}) {
7946: $cenv{'plc.roles.denied'}='st';
7947: }
7948:
7949: # Record we've not yet viewed the Course Initialization Helper for this
7950: # course
7951: $cenv{'course.helper.not.run'} = 1;
7952: #
7953: # Use new Randomseed
7954: #
7955: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
7956: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
7957: #
7958: # The encryption code and receipt prefix for this course
7959: #
7960: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
7961: $cenv{'internal.encpref'}=100+int(9*rand(99));
7962: #
7963: # By default, use standard grading
7964: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
7965:
1.541 raeburn 7966: $outcome .= $linefeed.&mt('Setting environment').': '.
7967: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 7968: #
7969: # Open all assignments
7970: #
7971: if ($args->{'openall'}) {
7972: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
7973: my %storecontent = ($storeunder => time,
7974: $storeunder.'.type' => 'date_start');
7975:
7976: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 7977: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 7978: }
7979: #
7980: # Set first page
7981: #
7982: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
7983: || ($cloneid)) {
1.445 albertel 7984: use LONCAPA::map;
1.444 albertel 7985: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 7986:
7987: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
7988: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
7989:
1.444 albertel 7990: $outcome .= ($fatal?$errtext:'read ok').' - ';
7991: my $title; my $url;
7992: if ($args->{'firstres'} eq 'syl') {
7993: $title='Syllabus';
7994: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
7995: } else {
7996: $title='Navigate Contents';
7997: $url='/adm/navmaps';
7998: }
1.445 albertel 7999:
8000: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
8001: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
8002:
8003: if ($errtext) { $fatal=2; }
1.541 raeburn 8004: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 8005: }
1.566 albertel 8006:
8007: return (1,$outcome);
1.444 albertel 8008: }
8009:
8010: ############################################################
8011: ############################################################
8012:
1.378 raeburn 8013: sub course_type {
8014: my ($cid) = @_;
8015: if (!defined($cid)) {
8016: $cid = $env{'request.course.id'};
8017: }
1.404 albertel 8018: if (defined($env{'course.'.$cid.'.type'})) {
8019: return $env{'course.'.$cid.'.type'};
1.378 raeburn 8020: } else {
8021: return 'Course';
1.377 raeburn 8022: }
8023: }
1.156 albertel 8024:
1.406 raeburn 8025: sub group_term {
8026: my $crstype = &course_type();
8027: my %names = (
8028: 'Course' => 'group',
8029: 'Group' => 'team',
8030: );
8031: return $names{$crstype};
8032: }
8033:
1.156 albertel 8034: sub icon {
8035: my ($file)=@_;
1.505 albertel 8036: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 8037: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 8038: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 8039: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
8040: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
8041: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8042: $curfext.".gif") {
8043: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8044: $curfext.".gif";
8045: }
8046: }
1.249 albertel 8047: return &lonhttpdurl($iconname);
1.154 albertel 8048: }
1.84 albertel 8049:
1.575 albertel 8050: sub lonhttpd_port {
1.215 albertel 8051: my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
8052: if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
1.574 albertel 8053: # IE doesn't like a secure page getting images from a non-secure
8054: # port (when logging we haven't parsed the browser type so default
8055: # back to secure
8056: if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
8057: && $ENV{'SERVER_PORT'} == 443) {
1.575 albertel 8058: return 443;
8059: }
8060: return $lonhttpd_port;
8061:
8062: }
8063:
8064: sub lonhttpdurl {
8065: my ($url)=@_;
8066:
8067: my $lonhttpd_port = &lonhttpd_port();
8068: if ($lonhttpd_port == 443) {
1.574 albertel 8069: return 'https://'.$ENV{'SERVER_NAME'}.$url;
8070: }
1.215 albertel 8071: return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
8072: }
8073:
1.213 albertel 8074: sub connection_aborted {
8075: my ($r)=@_;
8076: $r->print(" ");$r->rflush();
8077: my $c = $r->connection;
8078: return $c->aborted();
8079: }
8080:
1.221 foxr 8081: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 8082: # strings as 'strings'.
8083: sub escape_single {
1.221 foxr 8084: my ($input) = @_;
1.223 albertel 8085: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 8086: $input =~ s/\'/\\\'/g; # Esacpe the 's....
8087: return $input;
8088: }
1.223 albertel 8089:
1.222 foxr 8090: # Same as escape_single, but escape's "'s This
8091: # can be used for "strings"
8092: sub escape_double {
8093: my ($input) = @_;
8094: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
8095: $input =~ s/\"/\\\"/g; # Esacpe the "s....
8096: return $input;
8097: }
1.223 albertel 8098:
1.222 foxr 8099: # Escapes the last element of a full URL.
8100: sub escape_url {
8101: my ($url) = @_;
1.238 raeburn 8102: my @urlslices = split(/\//, $url,-1);
1.369 www 8103: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 8104: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 8105: }
1.462 albertel 8106:
8107: # -------------------------------------------------------- Initliaze user login
8108: sub init_user_environment {
1.463 albertel 8109: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 8110: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
8111:
8112: my $public=($username eq 'public' && $domain eq 'public');
8113:
8114: # See if old ID present, if so, remove
8115:
8116: my ($filename,$cookie,$userroles);
8117: my $now=time;
8118:
8119: if ($public) {
8120: my $max_public=100;
8121: my $oldest;
8122: my $oldest_time=0;
8123: for(my $next=1;$next<=$max_public;$next++) {
8124: if (-e $lonids."/publicuser_$next.id") {
8125: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
8126: if ($mtime<$oldest_time || !$oldest_time) {
8127: $oldest_time=$mtime;
8128: $oldest=$next;
8129: }
8130: } else {
8131: $cookie="publicuser_$next";
8132: last;
8133: }
8134: }
8135: if (!$cookie) { $cookie="publicuser_$oldest"; }
8136: } else {
1.463 albertel 8137: # if this isn't a robot, kill any existing non-robot sessions
8138: if (!$args->{'robot'}) {
8139: opendir(DIR,$lonids);
8140: while ($filename=readdir(DIR)) {
8141: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
8142: unlink($lonids.'/'.$filename);
8143: }
1.462 albertel 8144: }
1.463 albertel 8145: closedir(DIR);
1.462 albertel 8146: }
8147: # Give them a new cookie
1.463 albertel 8148: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
8149: : $now);
8150: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 8151:
8152: # Initialize roles
8153:
8154: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
8155: }
8156: # ------------------------------------ Check browser type and MathML capability
8157:
8158: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
8159: $clientunicode,$clientos) = &decode_user_agent($r);
8160:
8161: # -------------------------------------- Any accessibility options to remember?
8162: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
8163: foreach my $option ('imagesuppress','appletsuppress',
8164: 'embedsuppress','fontenhance','blackwhite') {
8165: if ($form->{$option} eq 'true') {
8166: &Apache::lonnet::put('environment',{$option => 'on'},
8167: $domain,$username);
8168: } else {
8169: &Apache::lonnet::del('environment',[$option],
8170: $domain,$username);
8171: }
8172: }
8173: }
8174: # ------------------------------------------------------------- Get environment
8175:
8176: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
8177: my ($tmp) = keys(%userenv);
8178: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8179: # default remote control to off
8180: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
8181: } else {
8182: undef(%userenv);
8183: }
8184: if (($userenv{'interface'}) && (!$form->{'interface'})) {
8185: $form->{'interface'}=$userenv{'interface'};
8186: }
8187: $env{'environment.remote'}=$userenv{'remote'};
8188: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
8189:
8190: # --------------- Do not trust query string to be put directly into environment
8191: foreach my $option ('imagesuppress','appletsuppress',
8192: 'embedsuppress','fontenhance','blackwhite',
8193: 'interface','localpath','localres') {
8194: $form->{$option}=~s/[\n\r\=]//gs;
8195: }
8196: # --------------------------------------------------------- Write first profile
8197:
8198: {
8199: my %initial_env =
8200: ("user.name" => $username,
8201: "user.domain" => $domain,
8202: "user.home" => $authhost,
8203: "browser.type" => $clientbrowser,
8204: "browser.version" => $clientversion,
8205: "browser.mathml" => $clientmathml,
8206: "browser.unicode" => $clientunicode,
8207: "browser.os" => $clientos,
8208: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
8209: "request.course.fn" => '',
8210: "request.course.uri" => '',
8211: "request.course.sec" => '',
8212: "request.role" => 'cm',
8213: "request.role.adv" => $env{'user.adv'},
8214: "request.host" => $ENV{'REMOTE_ADDR'},);
8215:
8216: if ($form->{'localpath'}) {
8217: $initial_env{"browser.localpath"} = $form->{'localpath'};
8218: $initial_env{"browser.localres"} = $form->{'localres'};
8219: }
8220:
8221: if ($public) {
8222: $initial_env{"environment.remote"} = "off";
8223: }
8224: if ($form->{'interface'}) {
8225: $form->{'interface'}=~s/\W//gs;
8226: $initial_env{"browser.interface"} = $form->{'interface'};
8227: $env{'browser.interface'}=$form->{'interface'};
8228: foreach my $option ('imagesuppress','appletsuppress',
8229: 'embedsuppress','fontenhance','blackwhite') {
8230: if (($form->{$option} eq 'true') ||
8231: ($userenv{$option} eq 'on')) {
8232: $initial_env{"browser.$option"} = "on";
8233: }
8234: }
8235: }
8236:
8237: $env{'user.environment'} = "$lonids/$cookie.id";
8238:
8239: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
8240: &GDBM_WRCREAT(),0640)) {
8241: &_add_to_env(\%disk_env,\%initial_env);
8242: &_add_to_env(\%disk_env,\%userenv,'environment.');
8243: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 8244: if (ref($args->{'extra_env'})) {
8245: &_add_to_env(\%disk_env,$args->{'extra_env'});
8246: }
1.462 albertel 8247: untie(%disk_env);
8248: } else {
8249: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
8250: 'Could not create environment storage in lonauth: '.$!.'</font>');
8251: return 'error: '.$!;
8252: }
8253: }
8254: $env{'request.role'}='cm';
8255: $env{'request.role.adv'}=$env{'user.adv'};
8256: $env{'browser.type'}=$clientbrowser;
8257:
8258: return $cookie;
8259:
8260: }
8261:
8262: sub _add_to_env {
8263: my ($idf,$env_data,$prefix) = @_;
8264: while (my ($key,$value) = each(%$env_data)) {
8265: $idf->{$prefix.$key} = $value;
8266: $env{$prefix.$key} = $value;
8267: }
8268: }
8269:
8270:
1.41 ng 8271: =pod
8272:
8273: =back
8274:
1.112 bowersj2 8275: =cut
1.41 ng 8276:
1.112 bowersj2 8277: 1;
8278: __END__;
1.41 ng 8279:
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