Annotation of loncom/interface/loncommon.pm, revision 1.647
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.647 ! www 4: # $Id: loncommon.pm,v 1.646 2008/03/12 02:45:06 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.643 foxr 81:
82: # ----------------------------------------------- SSI with retries:
83: #
84:
85: =pod
86:
87: =head1 Server Side incliude with retries:
88:
89: =over 4
90:
91: =item * ssi_with_retries(resource, retries form)
92:
93: Performs an ssi with some number of retries. Retries continue either
94: until the result is ok or until the retry count supplied by the
95: caller is exhausted.
96:
97: Inputs:
98: resource - Identifies the resource to insert.
99: retries - Count of the number of retries allowed.
100: form - Hash that identifies the rendering options.
101:
102: Returns:
103: content - The content of the response. If retries were exhausted this is empty.
104: response - The response from the last attempt (which may or may not have been successful.
105:
106: =cut
107:
108: sub ssi_with_retries {
109: my ($resource, $retries, %form) = @_;
110:
111:
112: my $ok = 0; # True if we got a good response.
113: my $content;
114: my $response;
115:
116: # Try to get the ssi done. within the retries count:
117:
118: do {
119: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
120: $ok = $response->is_success;
121: $retries--;
122: } while (!$ok && ($retries > 0));
123:
124: if (!$ok) {
125: $content = ''; # On error return an empty content.
126: }
127: return ($content, $response);
128:
129: }
130:
131:
132:
1.20 www 133: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 134: my %language;
1.124 www 135: my %supported_language;
1.12 harris41 136: my %cprtag;
1.192 taceyjo1 137: my %scprtag;
1.351 www 138: my %fe; my %fd; my %fm;
1.41 ng 139: my %category_extensions;
1.12 harris41 140:
1.46 matthew 141: # ---------------------------------------------- Thesaurus variables
1.144 matthew 142: #
143: # %Keywords:
144: # A hash used by &keyword to determine if a word is considered a keyword.
145: # $thesaurus_db_file
146: # Scalar containing the full path to the thesaurus database.
1.46 matthew 147:
148: my %Keywords;
149: my $thesaurus_db_file;
150:
1.144 matthew 151: #
152: # Initialize values from language.tab, copyright.tab, filetypes.tab,
153: # thesaurus.tab, and filecategories.tab.
154: #
1.18 www 155: BEGIN {
1.46 matthew 156: # Variable initialization
157: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
158: #
1.22 www 159: unless ($readit) {
1.12 harris41 160: # ------------------------------------------------------------------- languages
161: {
1.158 raeburn 162: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
163: '/language.tab';
164: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 165: while (my $line = <$fh>) {
166: next if ($line=~/^\#/);
167: chomp($line);
168: my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158 raeburn 169: $language{$key}=$val.' - '.$enc;
170: if ($sup) {
171: $supported_language{$key}=$sup;
172: }
173: }
174: close($fh);
175: }
1.12 harris41 176: }
177: # ------------------------------------------------------------------ copyrights
178: {
1.158 raeburn 179: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
180: '/copyright.tab';
181: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 182: while (my $line = <$fh>) {
183: next if ($line=~/^\#/);
184: chomp($line);
185: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 186: $cprtag{$key}=$val;
187: }
188: close($fh);
189: }
1.12 harris41 190: }
1.351 www 191: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 192: {
193: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
194: '/source_copyright.tab';
195: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 196: while (my $line = <$fh>) {
197: next if ($line =~ /^\#/);
198: chomp($line);
199: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 200: $scprtag{$key}=$val;
201: }
202: close($fh);
203: }
204: }
1.63 www 205:
1.517 raeburn 206: # -------------------------------------------------------------- default domain designs
1.63 www 207: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 208: my $designfile = $designdir.'/default.tab';
209: if ( open (my $fh,"<$designfile") ) {
210: while (my $line = <$fh>) {
211: next if ($line =~ /^\#/);
212: chomp($line);
213: my ($key,$val)=(split(/\=/,$line));
214: if ($val) { $defaultdesign{$key}=$val; }
215: }
216: close($fh);
1.63 www 217: }
218:
1.15 harris41 219: # ------------------------------------------------------------- file categories
220: {
1.158 raeburn 221: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
222: '/filecategories.tab';
223: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line =~ /^\#/);
226: chomp($line);
227: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 228: push @{$category_extensions{lc($category)}},$extension;
229: }
230: close($fh);
231: }
232:
1.15 harris41 233: }
1.12 harris41 234: # ------------------------------------------------------------------ file types
235: {
1.158 raeburn 236: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
237: '/filetypes.tab';
238: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 239: while (my $line = <$fh>) {
240: next if ($line =~ /^\#/);
241: chomp($line);
242: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 243: if ($descr ne '') {
244: $fe{$ending}=lc($emb);
245: $fd{$ending}=$descr;
1.351 www 246: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 247: }
248: }
249: close($fh);
250: }
1.12 harris41 251: }
1.22 www 252: &Apache::lonnet::logthis(
1.46 matthew 253: "<font color=yellow>INFO: Read file types</font>");
1.22 www 254: $readit=1;
1.46 matthew 255: } # end of unless($readit)
1.32 matthew 256:
257: }
1.112 bowersj2 258:
1.42 matthew 259: ###############################################################
260: ## HTML and Javascript Helper Functions ##
261: ###############################################################
262:
263: =pod
264:
1.112 bowersj2 265: =head1 HTML and Javascript Functions
1.42 matthew 266:
1.112 bowersj2 267: =over 4
268:
269: =item * browser_and_searcher_javascript ()
270:
271: X<browsing, javascript>X<searching, javascript>Returns a string
272: containing javascript with two functions, C<openbrowser> and
273: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
274: tags.
1.42 matthew 275:
1.112 bowersj2 276: =item * openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 277:
278: inputs: formname, elementname, only, omit
279:
280: formname and elementname indicate the name of the html form and name of
281: the element that the results of the browsing selection are to be placed in.
282:
283: Specifying 'only' will restrict the browser to displaying only files
1.185 www 284: with the given extension. Can be a comma separated list.
1.42 matthew 285:
286: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 287: with the given extension. Can be a comma separated list.
1.42 matthew 288:
1.112 bowersj2 289: =item * opensearcher(formname, elementname) [javascript]
1.42 matthew 290:
291: Inputs: formname, elementname
292:
293: formname and elementname specify the name of the html form and the name
294: of the element the selection from the search results will be placed in.
1.542 raeburn 295:
1.42 matthew 296: =cut
297:
298: sub browser_and_searcher_javascript {
1.199 albertel 299: my ($mode)=@_;
300: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 301: my $resurl=&escape_single(&lastresurl());
1.42 matthew 302: return <<END;
1.219 albertel 303: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 304: var editbrowser = null;
1.135 albertel 305: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 306: var url = '$resurl/?';
1.42 matthew 307: if (editbrowser == null) {
308: url += 'launch=1&';
309: }
310: url += 'catalogmode=interactive&';
1.199 albertel 311: url += 'mode=$mode&';
1.611 albertel 312: url += 'inhibitmenu=yes&';
1.42 matthew 313: url += 'form=' + formname + '&';
314: if (only != null) {
315: url += 'only=' + only + '&';
1.217 albertel 316: } else {
317: url += 'only=&';
318: }
1.42 matthew 319: if (omit != null) {
320: url += 'omit=' + omit + '&';
1.217 albertel 321: } else {
322: url += 'omit=&';
323: }
1.135 albertel 324: if (titleelement != null) {
325: url += 'titleelement=' + titleelement + '&';
1.217 albertel 326: } else {
327: url += 'titleelement=&';
328: }
1.42 matthew 329: url += 'element=' + elementname + '';
330: var title = 'Browser';
1.435 albertel 331: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 332: options += ',width=700,height=600';
333: editbrowser = open(url,title,options,'1');
334: editbrowser.focus();
335: }
336: var editsearcher;
1.135 albertel 337: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 338: var url = '/adm/searchcat?';
339: if (editsearcher == null) {
340: url += 'launch=1&';
341: }
342: url += 'catalogmode=interactive&';
1.199 albertel 343: url += 'mode=$mode&';
1.42 matthew 344: url += 'form=' + formname + '&';
1.135 albertel 345: if (titleelement != null) {
346: url += 'titleelement=' + titleelement + '&';
1.217 albertel 347: } else {
348: url += 'titleelement=&';
349: }
1.42 matthew 350: url += 'element=' + elementname + '';
351: var title = 'Search';
1.435 albertel 352: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 353: options += ',width=700,height=600';
354: editsearcher = open(url,title,options,'1');
355: editsearcher.focus();
356: }
1.219 albertel 357: // END LON-CAPA Internal -->
1.42 matthew 358: END
1.170 www 359: }
360:
361: sub lastresurl {
1.258 albertel 362: if ($env{'environment.lastresurl'}) {
363: return $env{'environment.lastresurl'}
1.170 www 364: } else {
365: return '/res';
366: }
367: }
368:
369: sub storeresurl {
370: my $resurl=&Apache::lonnet::clutter(shift);
371: unless ($resurl=~/^\/res/) { return 0; }
372: $resurl=~s/\/$//;
373: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 374: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 375: return 1;
1.42 matthew 376: }
377:
1.74 www 378: sub studentbrowser_javascript {
1.111 www 379: unless (
1.258 albertel 380: (($env{'request.course.id'}) &&
1.302 albertel 381: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
382: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
383: '/'.$env{'request.course.sec'})
384: ))
1.258 albertel 385: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 386: ) { return ''; }
1.74 www 387: return (<<'ENDSTDBRW');
388: <script type="text/javascript" language="Javascript" >
389: var stdeditbrowser;
1.558 albertel 390: function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {
1.74 www 391: var url = '/adm/pickstudent?';
392: var filter;
1.558 albertel 393: if (!ignorefilter) {
394: eval('filter=document.'+formname+'.'+uname+'.value;');
395: }
1.74 www 396: if (filter != null) {
397: if (filter != '') {
398: url += 'filter='+filter+'&';
399: }
400: }
401: url += 'form=' + formname + '&unameelement='+uname+
402: '&udomelement='+udom;
1.111 www 403: if (roleflag) { url+="&roles=1"; }
1.102 www 404: var title = 'Student_Browser';
1.74 www 405: var options = 'scrollbars=1,resizable=1,menubar=0';
406: options += ',width=700,height=600';
407: stdeditbrowser = open(url,title,options,'1');
408: stdeditbrowser.focus();
409: }
410: </script>
411: ENDSTDBRW
412: }
1.42 matthew 413:
1.74 www 414: sub selectstudent_link {
1.111 www 415: my ($form,$unameele,$udomele)=@_;
1.258 albertel 416: if ($env{'request.course.id'}) {
1.302 albertel 417: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
418: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
419: '/'.$env{'request.course.sec'})) {
1.111 www 420: return '';
421: }
422: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.607 albertel 423: '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
1.74 www 424: }
1.258 albertel 425: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.111 www 426: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.119 www 427: '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
1.111 www 428: }
429: return '';
1.91 www 430: }
431:
432: sub coursebrowser_javascript {
1.468 raeburn 433: my ($domainfilter,$sec_element,$formname)=@_;
1.377 raeburn 434: 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 435: my $output = '
1.538 albertel 436: <script type="text/javascript">
1.468 raeburn 437: var stdeditbrowser;'."\n";
438: $output .= <<"ENDSTDBRW";
1.377 raeburn 439: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91 www 440: var url = '/adm/pickcourse?';
1.468 raeburn 441: var domainfilter = '';
442: var formid = getFormIdByName(formname);
443: if (formid > -1) {
444: var domid = getIndexByName(formid,udom);
445: if (domid > -1) {
446: if (document.forms[formid].elements[domid].type == 'select-one') {
447: domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
448: }
449: if (document.forms[formid].elements[domid].type == 'hidden') {
450: domainfilter=document.forms[formid].elements[domid].value;
451: }
452: }
1.91 www 453: }
1.128 albertel 454: if (domainfilter != null) {
455: if (domainfilter != '') {
456: url += 'domainfilter='+domainfilter+'&';
457: }
458: }
1.91 www 459: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 460: '&cdomelement='+udom+
461: '&cnameelement='+desc;
1.468 raeburn 462: if (extra_element !=null && extra_element != '') {
1.594 raeburn 463: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 464: url += '&roleelement='+extra_element;
465: if (domainfilter == null || domainfilter == '') {
466: url += '&domainfilter='+extra_element;
467: }
1.234 raeburn 468: }
1.468 raeburn 469: else {
470: if (formname == 'portform') {
471: url += '&setroles='+extra_element;
472: }
473: }
1.230 raeburn 474: }
1.293 raeburn 475: if (multflag !=null && multflag != '') {
476: url += '&multiple='+multflag;
477: }
1.377 raeburn 478: if (crstype == 'Course/Group') {
479: if (formname == 'cu') {
480: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
481: if (crstype == "") {
482: alert("$crs_or_grp_alert");
483: return;
484: }
485: }
486: }
487: if (crstype !=null && crstype != '') {
488: url += '&type='+crstype;
489: }
1.102 www 490: var title = 'Course_Browser';
1.91 www 491: var options = 'scrollbars=1,resizable=1,menubar=0';
492: options += ',width=700,height=600';
493: stdeditbrowser = open(url,title,options,'1');
494: stdeditbrowser.focus();
495: }
1.468 raeburn 496:
497: function getFormIdByName(formname) {
498: for (var i=0;i<document.forms.length;i++) {
499: if (document.forms[i].name == formname) {
500: return i;
501: }
502: }
503: return -1;
504: }
505:
506: function getIndexByName(formid,item) {
507: for (var i=0;i<document.forms[formid].elements.length;i++) {
508: if (document.forms[formid].elements[i].name == item) {
509: return i;
510: }
511: }
512: return -1;
513: }
1.91 www 514: ENDSTDBRW
1.468 raeburn 515: if ($sec_element ne '') {
516: $output .= &setsec_javascript($sec_element,$formname);
517: }
518: $output .= '
519: </script>';
520: return $output;
521: }
522:
523: sub setsec_javascript {
524: my ($sec_element,$formname) = @_;
525: my $setsections = qq|
526: function setSect(sectionlist) {
1.629 raeburn 527: var sectionsArray = new Array();
528: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
529: sectionsArray = sectionlist.split(",");
530: }
1.468 raeburn 531: var numSections = sectionsArray.length;
532: document.$formname.$sec_element.length = 0;
533: if (numSections == 0) {
534: document.$formname.$sec_element.multiple=false;
535: document.$formname.$sec_element.size=1;
536: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
537: } else {
538: if (numSections == 1) {
539: document.$formname.$sec_element.multiple=false;
540: document.$formname.$sec_element.size=1;
541: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
542: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
543: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
544: } else {
545: for (var i=0; i<numSections; i++) {
546: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
547: }
548: document.$formname.$sec_element.multiple=true
549: if (numSections < 3) {
550: document.$formname.$sec_element.size=numSections;
551: } else {
552: document.$formname.$sec_element.size=3;
553: }
554: document.$formname.$sec_element.options[0].selected = false
555: }
556: }
1.91 www 557: }
1.468 raeburn 558: |;
559: return $setsections;
560: }
561:
1.91 www 562:
563: sub selectcourse_link {
1.377 raeburn 564: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.492 albertel 565: return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
566: '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
1.74 www 567: }
1.42 matthew 568:
1.273 raeburn 569: sub check_uncheck_jscript {
570: my $jscript = <<"ENDSCRT";
571: function checkAll(field) {
572: if (field.length > 0) {
573: for (i = 0; i < field.length; i++) {
574: field[i].checked = true ;
575: }
576: } else {
577: field.checked = true
578: }
579: }
580:
581: function uncheckAll(field) {
582: if (field.length > 0) {
583: for (i = 0; i < field.length; i++) {
584: field[i].checked = false ;
1.543 albertel 585: }
586: } else {
1.273 raeburn 587: field.checked = false ;
588: }
589: }
590: ENDSCRT
591: return $jscript;
592: }
593:
594:
1.42 matthew 595: =pod
1.36 matthew 596:
1.112 bowersj2 597: =item * linked_select_forms(...)
1.36 matthew 598:
599: linked_select_forms returns a string containing a <script></script> block
600: and html for two <select> menus. The select menus will be linked in that
601: changing the value of the first menu will result in new values being placed
602: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 603: order unless a defined order is provided.
1.36 matthew 604:
605: linked_select_forms takes the following ordered inputs:
606:
607: =over 4
608:
1.112 bowersj2 609: =item * $formname, the name of the <form> tag
1.36 matthew 610:
1.112 bowersj2 611: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 612:
1.112 bowersj2 613: =item * $firstdefault, the default value for the first menu
1.36 matthew 614:
1.112 bowersj2 615: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 616:
1.112 bowersj2 617: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 618:
1.112 bowersj2 619: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 620:
1.609 raeburn 621: =item * $menuorder, the order of values in the first menu
622:
1.41 ng 623: =back
624:
1.36 matthew 625: Below is an example of such a hash. Only the 'text', 'default', and
626: 'select2' keys must appear as stated. keys(%menu) are the possible
627: values for the first select menu. The text that coincides with the
1.41 ng 628: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 629: and text for the second menu are given in the hash pointed to by
630: $menu{$choice1}->{'select2'}.
631:
1.112 bowersj2 632: my %menu = ( A1 => { text =>"Choice A1" ,
633: default => "B3",
634: select2 => {
635: B1 => "Choice B1",
636: B2 => "Choice B2",
637: B3 => "Choice B3",
638: B4 => "Choice B4"
1.609 raeburn 639: },
640: order => ['B4','B3','B1','B2'],
1.112 bowersj2 641: },
642: A2 => { text =>"Choice A2" ,
643: default => "C2",
644: select2 => {
645: C1 => "Choice C1",
646: C2 => "Choice C2",
647: C3 => "Choice C3"
1.609 raeburn 648: },
649: order => ['C2','C1','C3'],
1.112 bowersj2 650: },
651: A3 => { text =>"Choice A3" ,
652: default => "D6",
653: select2 => {
654: D1 => "Choice D1",
655: D2 => "Choice D2",
656: D3 => "Choice D3",
657: D4 => "Choice D4",
658: D5 => "Choice D5",
659: D6 => "Choice D6",
660: D7 => "Choice D7"
1.609 raeburn 661: },
662: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 663: }
664: );
1.36 matthew 665:
666: =cut
667:
668: sub linked_select_forms {
669: my ($formname,
670: $middletext,
671: $firstdefault,
672: $firstselectname,
673: $secondselectname,
1.609 raeburn 674: $hashref,
675: $menuorder,
1.36 matthew 676: ) = @_;
677: my $second = "document.$formname.$secondselectname";
678: my $first = "document.$formname.$firstselectname";
679: # output the javascript to do the changing
680: my $result = '';
1.219 albertel 681: $result.="<script type=\"text/javascript\">\n";
1.36 matthew 682: $result.="var select2data = new Object();\n";
683: $" = '","';
684: my $debug = '';
685: foreach my $s1 (sort(keys(%$hashref))) {
686: $result.="select2data.d_$s1 = new Object();\n";
687: $result.="select2data.d_$s1.def = new String('".
688: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 689: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 690: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 691: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
692: @s2values = @{$hashref->{$s1}->{'order'}};
693: }
1.36 matthew 694: $result.="\"@s2values\");\n";
695: $result.="select2data.d_$s1.texts = new Array(";
696: my @s2texts;
697: foreach my $value (@s2values) {
698: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
699: }
700: $result.="\"@s2texts\");\n";
701: }
702: $"=' ';
703: $result.= <<"END";
704:
705: function select1_changed() {
706: // Determine new choice
707: var newvalue = "d_" + $first.value;
708: // update select2
709: var values = select2data[newvalue].values;
710: var texts = select2data[newvalue].texts;
711: var select2def = select2data[newvalue].def;
712: var i;
713: // out with the old
714: for (i = 0; i < $second.options.length; i++) {
715: $second.options[i] = null;
716: }
717: // in with the nuclear
718: for (i=0;i<values.length; i++) {
719: $second.options[i] = new Option(values[i]);
1.143 matthew 720: $second.options[i].value = values[i];
1.36 matthew 721: $second.options[i].text = texts[i];
722: if (values[i] == select2def) {
723: $second.options[i].selected = true;
724: }
725: }
726: }
727: </script>
728: END
729: # output the initial values for the selection lists
730: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 731: my @order = sort(keys(%{$hashref}));
732: if (ref($menuorder) eq 'ARRAY') {
733: @order = @{$menuorder};
734: }
735: foreach my $value (@order) {
1.36 matthew 736: $result.=" <option value=\"$value\" ";
1.253 albertel 737: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 738: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 739: }
740: $result .= "</select>\n";
741: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
742: $result .= $middletext;
743: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
744: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 745:
746: my @secondorder = sort(keys(%select2));
747: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
748: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
749: }
750: foreach my $value (@secondorder) {
1.36 matthew 751: $result.=" <option value=\"$value\" ";
1.253 albertel 752: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 753: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 754: }
755: $result .= "</select>\n";
756: # return $debug;
757: return $result;
758: } # end of sub linked_select_forms {
759:
1.45 matthew 760: =pod
1.44 bowersj2 761:
1.112 bowersj2 762: =item * help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44 bowersj2 763:
1.112 bowersj2 764: Returns a string corresponding to an HTML link to the given help
765: $topic, where $topic corresponds to the name of a .tex file in
766: /home/httpd/html/adm/help/tex, with underscores replaced by
767: spaces.
768:
769: $text will optionally be linked to the same topic, allowing you to
770: link text in addition to the graphic. If you do not want to link
771: text, but wish to specify one of the later parameters, pass an
772: empty string.
773:
774: $stayOnPage is a value that will be interpreted as a boolean. If true,
775: the link will not open a new window. If false, the link will open
776: a new window using Javascript. (Default is false.)
777:
778: $width and $height are optional numerical parameters that will
779: override the width and height of the popped up window, which may
780: be useful for certain help topics with big pictures included.
1.44 bowersj2 781:
782: =cut
783:
784: sub help_open_topic {
1.48 bowersj2 785: my ($topic, $text, $stayOnPage, $width, $height) = @_;
786: $text = "" if (not defined $text);
1.44 bowersj2 787: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 788: if ($env{'browser.interface'} eq 'textual') {
1.79 www 789: $stayOnPage=1;
790: }
1.44 bowersj2 791: $width = 350 if (not defined $width);
792: $height = 400 if (not defined $height);
793: my $filename = $topic;
794: $filename =~ s/ /_/g;
795:
1.48 bowersj2 796: my $template = "";
797: my $link;
1.572 banghart 798:
1.159 www 799: $topic=~s/\W/\_/g;
1.44 bowersj2 800:
1.572 banghart 801: if (!$stayOnPage) {
1.72 bowersj2 802: $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 803: } else {
1.48 bowersj2 804: $link = "/adm/help/${filename}.hlp";
805: }
806:
807: # Add the text
1.572 banghart 808: if ($text ne "") {
1.77 www 809: $template .=
1.572 banghart 810: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
811: "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 812: }
813:
814: # Add the graphic
1.179 matthew 815: my $title = &mt('Online Help');
1.215 albertel 816: my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
1.48 bowersj2 817: $template .= <<"ENDTEMPLATE";
1.436 albertel 818: <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
1.44 bowersj2 819: ENDTEMPLATE
1.78 www 820: if ($text ne '') { $template.='</td></tr></table>' };
1.44 bowersj2 821: return $template;
822:
1.106 bowersj2 823: }
824:
825: # This is a quicky function for Latex cheatsheet editing, since it
826: # appears in at least four places
827: sub helpLatexCheatsheet {
828: my $other = shift;
829: my $addOther = '';
830: if ($other) {
831: $addOther = Apache::loncommon::help_open_topic($other, shift,
832: undef, undef, 600) .
833: '</td><td>';
834: }
835: return '<table><tr><td>'.
836: $addOther .
1.636 raeburn 837: &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
1.106 bowersj2 838: undef,undef,600)
839: .'</td><td>'.
1.636 raeburn 840: &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
1.106 bowersj2 841: undef,undef,600)
842: .'</td></tr></table>';
1.172 www 843: }
844:
1.430 albertel 845: sub general_help {
846: my $helptopic='Student_Intro';
847: if ($env{'request.role'}=~/^(ca|au)/) {
848: $helptopic='Authoring_Intro';
849: } elsif ($env{'request.role'}=~/^cc/) {
850: $helptopic='Course_Coordination_Intro';
851: }
852: return $helptopic;
853: }
854:
855: sub update_help_link {
856: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
857: my $origurl = $ENV{'REQUEST_URI'};
858: $origurl=~s|^/~|/priv/|;
859: my $timestamp = time;
860: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
861: $$datum = &escape($$datum);
862: }
863:
864: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
865: my $output .= <<"ENDOUTPUT";
866: <script type="text/javascript">
867: banner_link = '$banner_link';
868: </script>
869: ENDOUTPUT
870: return $output;
871: }
872:
873: # now just updates the help link and generates a blue icon
1.193 raeburn 874: sub help_open_menu {
1.430 albertel 875: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 876: = @_;
1.430 albertel 877: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 878: # only use pop-up help (stayOnPage == 0)
1.552 banghart 879: # if environment.remote is on (using remote control UI)
1.572 banghart 880: if ($env{'browser.interface'} eq 'textual' ||
881: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 882: $stayOnPage=1;
1.430 albertel 883: }
884: my $output;
885: if ($component_help) {
886: if (!$text) {
887: $output=&help_open_topic($component_help,undef,$stayOnPage,
888: $width,$height);
889: } else {
890: my $help_text;
891: $help_text=&unescape($topic);
892: $output='<table><tr><td>'.
893: &help_open_topic($component_help,$help_text,$stayOnPage,
894: $width,$height).'</td></tr></table>';
895: }
896: }
897: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
898: return $output.$banner_link;
899: }
900:
901: sub top_nav_help {
902: my ($text) = @_;
1.436 albertel 903: $text = &mt($text);
1.572 banghart 904: my $stay_on_page =
1.436 albertel 905: ($env{'browser.interface'} eq 'textual' ||
906: $env{'environment.remote'} eq 'off' );
1.572 banghart 907: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 908: : "javascript:helpMenu('open')";
1.572 banghart 909: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 910:
1.201 raeburn 911: my $title = &mt('Get help');
1.436 albertel 912:
913: return <<"END";
914: $banner_link
915: <a href="$link" title="$title">$text</a>
916: END
917: }
918:
919: sub help_menu_js {
920: my ($text) = @_;
921:
922: my $stayOnPage =
923: ($env{'browser.interface'} eq 'textual' ||
924: $env{'environment.remote'} eq 'off' );
925:
926: my $width = 620;
927: my $height = 600;
1.430 albertel 928: my $helptopic=&general_help();
929: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 930: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 931: my $start_page =
932: &Apache::loncommon::start_page('Help Menu', undef,
933: {'frameset' => 1,
934: 'js_ready' => 1,
935: 'add_entries' => {
936: 'border' => '0',
1.579 raeburn 937: 'rows' => "110,*",},});
1.331 albertel 938: my $end_page =
939: &Apache::loncommon::end_page({'frameset' => 1,
940: 'js_ready' => 1,});
941:
1.436 albertel 942: my $template .= <<"ENDTEMPLATE";
943: <script type="text/javascript">
1.253 albertel 944: // <!-- BEGIN LON-CAPA Internal
945: // <![CDATA[
1.430 albertel 946: var banner_link = '';
1.243 raeburn 947: function helpMenu(target) {
948: var caller = this;
949: if (target == 'open') {
950: var newWindow = null;
951: try {
1.262 albertel 952: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 953: }
954: catch(error) {
955: writeHelp(caller);
956: return;
957: }
958: if (newWindow) {
959: caller = newWindow;
960: }
1.193 raeburn 961: }
1.243 raeburn 962: writeHelp(caller);
963: return;
964: }
965: function writeHelp(caller) {
1.430 albertel 966: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 967: caller.document.close()
968: caller.focus()
1.193 raeburn 969: }
1.253 albertel 970: // ]]>
1.219 albertel 971: // END LON-CAPA Internal -->
1.436 albertel 972: </script>
1.193 raeburn 973: ENDTEMPLATE
974: return $template;
975: }
976:
1.172 www 977: sub help_open_bug {
978: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 979: unless ($env{'user.adv'}) { return ''; }
1.172 www 980: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
981: $text = "" if (not defined $text);
982: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 983: if ($env{'browser.interface'} eq 'textual' ||
984: $env{'environment.remote'} eq 'off' ) {
1.172 www 985: $stayOnPage=1;
986: }
1.184 albertel 987: $width = 600 if (not defined $width);
988: $height = 600 if (not defined $height);
1.172 www 989:
990: $topic=~s/\W+/\+/g;
991: my $link='';
992: my $template='';
1.379 albertel 993: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
994: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 995: if (!$stayOnPage)
996: {
997: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
998: }
999: else
1000: {
1001: $link = $url;
1002: }
1003: # Add the text
1004: if ($text ne "")
1005: {
1006: $template .=
1007: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1008: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1009: }
1010:
1011: # Add the graphic
1.179 matthew 1012: my $title = &mt('Report a Bug');
1.215 albertel 1013: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1014: $template .= <<"ENDTEMPLATE";
1.436 albertel 1015: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1016: ENDTEMPLATE
1017: if ($text ne '') { $template.='</td></tr></table>' };
1018: return $template;
1019:
1020: }
1021:
1022: sub help_open_faq {
1023: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1024: unless ($env{'user.adv'}) { return ''; }
1.172 www 1025: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1026: $text = "" if (not defined $text);
1027: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1028: if ($env{'browser.interface'} eq 'textual' ||
1029: $env{'environment.remote'} eq 'off' ) {
1.172 www 1030: $stayOnPage=1;
1031: }
1032: $width = 350 if (not defined $width);
1033: $height = 400 if (not defined $height);
1034:
1035: $topic=~s/\W+/\+/g;
1036: my $link='';
1037: my $template='';
1038: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1039: if (!$stayOnPage)
1040: {
1041: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1042: }
1043: else
1044: {
1045: $link = $url;
1046: }
1047:
1048: # Add the text
1049: if ($text ne "")
1050: {
1051: $template .=
1.173 www 1052: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1053: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1054: }
1055:
1056: # Add the graphic
1.179 matthew 1057: my $title = &mt('View the FAQ');
1.215 albertel 1058: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1059: $template .= <<"ENDTEMPLATE";
1.436 albertel 1060: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1061: ENDTEMPLATE
1062: if ($text ne '') { $template.='</td></tr></table>' };
1063: return $template;
1064:
1.44 bowersj2 1065: }
1.37 matthew 1066:
1.180 matthew 1067: ###############################################################
1068: ###############################################################
1069:
1.45 matthew 1070: =pod
1071:
1.256 matthew 1072: =item * change_content_javascript():
1073:
1074: This and the next function allow you to create small sections of an
1075: otherwise static HTML page that you can update on the fly with
1076: Javascript, even in Netscape 4.
1077:
1078: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1079: must be written to the HTML page once. It will prove the Javascript
1080: function "change(name, content)". Calling the change function with the
1081: name of the section
1082: you want to update, matching the name passed to C<changable_area>, and
1083: the new content you want to put in there, will put the content into
1084: that area.
1085:
1086: B<Note>: Netscape 4 only reserves enough space for the changable area
1087: to contain room for the original contents. You need to "make space"
1088: for whatever changes you wish to make, and be B<sure> to check your
1089: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1090: it's adequate for updating a one-line status display, but little more.
1091: This script will set the space to 100% width, so you only need to
1092: worry about height in Netscape 4.
1093:
1094: Modern browsers are much less limiting, and if you can commit to the
1095: user not using Netscape 4, this feature may be used freely with
1096: pretty much any HTML.
1097:
1098: =cut
1099:
1100: sub change_content_javascript {
1101: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1102: if ($env{'browser.type'} eq 'netscape' &&
1103: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1104: return (<<NETSCAPE4);
1105: function change(name, content) {
1106: doc = document.layers[name+"___escape"].layers[0].document;
1107: doc.open();
1108: doc.write(content);
1109: doc.close();
1110: }
1111: NETSCAPE4
1112: } else {
1113: # Otherwise, we need to use semi-standards-compliant code
1114: # (technically, "innerHTML" isn't standard but the equivalent
1115: # is really scary, and every useful browser supports it
1116: return (<<DOMBASED);
1117: function change(name, content) {
1118: element = document.getElementById(name);
1119: element.innerHTML = content;
1120: }
1121: DOMBASED
1122: }
1123: }
1124:
1125: =pod
1126:
1127: =item * changable_area($name, $origContent):
1128:
1129: This provides a "changable area" that can be modified on the fly via
1130: the Javascript code provided in C<change_content_javascript>. $name is
1131: the name you will use to reference the area later; do not repeat the
1132: same name on a given HTML page more then once. $origContent is what
1133: the area will originally contain, which can be left blank.
1134:
1135: =cut
1136:
1137: sub changable_area {
1138: my ($name, $origContent) = @_;
1139:
1.258 albertel 1140: if ($env{'browser.type'} eq 'netscape' &&
1141: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1142: # If this is netscape 4, we need to use the Layer tag
1143: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1144: } else {
1145: return "<span id='$name'>$origContent</span>";
1146: }
1147: }
1148:
1149: =pod
1150:
1.590 raeburn 1151: =item * viewport_geometry_js {
1152:
1153: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1154:
1155: =cut
1156:
1157:
1158: sub viewport_geometry_js {
1159: return <<"GEOMETRY";
1160: var Geometry = {};
1161: function init_geometry() {
1162: if (Geometry.init) { return };
1163: Geometry.init=1;
1164: if (window.innerHeight) {
1165: Geometry.getViewportHeight = function() { return window.innerHeight; };
1166: Geometry.getViewportWidth = function() { return window.innerWidth; };
1167: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1168: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1169: }
1170: else if (document.documentElement && document.documentElement.clientHeight) {
1171: Geometry.getViewportHeight =
1172: function() { return document.documentElement.clientHeight; };
1173: Geometry.getViewportWidth =
1174: function() { return document.documentElement.clientWidth; };
1175:
1176: Geometry.getHorizontalScroll =
1177: function() { return document.documentElement.scrollLeft; };
1178: Geometry.getVerticalScroll =
1179: function() { return document.documentElement.scrollTop; };
1180: }
1181: else if (document.body.clientHeight) {
1182: Geometry.getViewportHeight =
1183: function() { return document.body.clientHeight; };
1184: Geometry.getViewportWidth =
1185: function() { return document.body.clientWidth; };
1186: Geometry.getHorizontalScroll =
1187: function() { return document.body.scrollLeft; };
1188: Geometry.getVerticalScroll =
1189: function() { return document.body.scrollTop; };
1190: }
1191: }
1192:
1193: GEOMETRY
1194: }
1195:
1196: =pod
1197:
1198: =item * viewport_size_js {
1199:
1200: 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.
1201:
1202: =cut
1203:
1204: sub viewport_size_js {
1205: my $geometry = &viewport_geometry_js();
1206: return <<"DIMS";
1207:
1208: $geometry
1209:
1210: function getViewportDims(width,height) {
1211: init_geometry();
1212: width.value = Geometry.getViewportWidth();
1213: height.value = Geometry.getViewportHeight();
1214: return;
1215: }
1216:
1217: DIMS
1218: }
1219:
1220: =pod
1221:
1.565 albertel 1222: =item * resize_textarea_js
1223:
1224: emits the needed javascript to resize a textarea to be as big as possible
1225:
1226: creates a function resize_textrea that takes two IDs first should be
1227: the id of the element to resize, second should be the id of a div that
1228: surrounds everything that comes after the textarea, this routine needs
1229: to be attached to the <body> for the onload and onresize events.
1230:
1231:
1232: =cut
1233:
1234: sub resize_textarea_js {
1.590 raeburn 1235: my $geometry = &viewport_geometry_js();
1.565 albertel 1236: return <<"RESIZE";
1237: <script type="text/javascript">
1.590 raeburn 1238: $geometry
1.565 albertel 1239:
1.588 albertel 1240: function getX(element) {
1241: var x = 0;
1242: while (element) {
1243: x += element.offsetLeft;
1244: element = element.offsetParent;
1245: }
1246: return x;
1247: }
1248: function getY(element) {
1249: var y = 0;
1250: while (element) {
1251: y += element.offsetTop;
1252: element = element.offsetParent;
1253: }
1254: return y;
1255: }
1256:
1257:
1.565 albertel 1258: function resize_textarea(textarea_id,bottom_id) {
1259: init_geometry();
1260: var textarea = document.getElementById(textarea_id);
1261: //alert(textarea);
1262:
1.588 albertel 1263: var textarea_top = getY(textarea);
1.565 albertel 1264: var textarea_height = textarea.offsetHeight;
1265: var bottom = document.getElementById(bottom_id);
1.588 albertel 1266: var bottom_top = getY(bottom);
1.565 albertel 1267: var bottom_height = bottom.offsetHeight;
1268: var window_height = Geometry.getViewportHeight();
1.588 albertel 1269: var fudge = 23;
1.565 albertel 1270: var new_height = window_height-fudge-textarea_top-bottom_height;
1271: if (new_height < 300) {
1272: new_height = 300;
1273: }
1274: textarea.style.height=new_height+'px';
1275: }
1276: </script>
1277: RESIZE
1278:
1279: }
1280:
1281: =pod
1282:
1.256 matthew 1283: =back
1.542 raeburn 1284:
1.256 matthew 1285: =head1 Excel and CSV file utility routines
1286:
1287: =over 4
1288:
1289: =cut
1290:
1291: ###############################################################
1292: ###############################################################
1293:
1294: =pod
1295:
1.112 bowersj2 1296: =item * csv_translate($text)
1.37 matthew 1297:
1.185 www 1298: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1299: format.
1300:
1301: =cut
1302:
1.180 matthew 1303: ###############################################################
1304: ###############################################################
1.37 matthew 1305: sub csv_translate {
1306: my $text = shift;
1307: $text =~ s/\"/\"\"/g;
1.209 albertel 1308: $text =~ s/\n/ /g;
1.37 matthew 1309: return $text;
1310: }
1.180 matthew 1311:
1312: ###############################################################
1313: ###############################################################
1314:
1315: =pod
1316:
1317: =item * define_excel_formats
1318:
1319: Define some commonly used Excel cell formats.
1320:
1321: Currently supported formats:
1322:
1323: =over 4
1324:
1325: =item header
1326:
1327: =item bold
1328:
1329: =item h1
1330:
1331: =item h2
1332:
1333: =item h3
1334:
1.256 matthew 1335: =item h4
1336:
1337: =item i
1338:
1.180 matthew 1339: =item date
1340:
1341: =back
1342:
1343: Inputs: $workbook
1344:
1345: Returns: $format, a hash reference.
1346:
1347: =cut
1348:
1349: ###############################################################
1350: ###############################################################
1351: sub define_excel_formats {
1352: my ($workbook) = @_;
1353: my $format;
1354: $format->{'header'} = $workbook->add_format(bold => 1,
1355: bottom => 1,
1356: align => 'center');
1357: $format->{'bold'} = $workbook->add_format(bold=>1);
1358: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1359: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1360: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1361: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1362: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1363: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1364: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1365: return $format;
1366: }
1367:
1368: ###############################################################
1369: ###############################################################
1.113 bowersj2 1370:
1371: =pod
1372:
1.256 matthew 1373: =item * create_workbook
1.255 matthew 1374:
1375: Create an Excel worksheet. If it fails, output message on the
1376: request object and return undefs.
1377:
1378: Inputs: Apache request object
1379:
1380: Returns (undef) on failure,
1381: Excel worksheet object, scalar with filename, and formats
1382: from &Apache::loncommon::define_excel_formats on success
1383:
1384: =cut
1385:
1386: ###############################################################
1387: ###############################################################
1388: sub create_workbook {
1389: my ($r) = @_;
1390: #
1391: # Create the excel spreadsheet
1392: my $filename = '/prtspool/'.
1.258 albertel 1393: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1394: time.'_'.rand(1000000000).'.xls';
1395: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1396: if (! defined($workbook)) {
1397: $r->log_error("Error creating excel spreadsheet $filename: $!");
1398: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1399: "This error has been logged. ".
1400: "Please alert your LON-CAPA administrator").
1401: '</p>');
1402: return (undef);
1403: }
1404: #
1405: $workbook->set_tempdir('/home/httpd/perl/tmp');
1406: #
1407: my $format = &Apache::loncommon::define_excel_formats($workbook);
1408: return ($workbook,$filename,$format);
1409: }
1410:
1411: ###############################################################
1412: ###############################################################
1413:
1414: =pod
1415:
1.256 matthew 1416: =item * create_text_file
1.113 bowersj2 1417:
1.542 raeburn 1418: Create a file to write to and eventually make available to the user.
1.256 matthew 1419: If file creation fails, outputs an error message on the request object and
1420: return undefs.
1.113 bowersj2 1421:
1.256 matthew 1422: Inputs: Apache request object, and file suffix
1.113 bowersj2 1423:
1.256 matthew 1424: Returns (undef) on failure,
1425: Filehandle and filename on success.
1.113 bowersj2 1426:
1427: =cut
1428:
1.256 matthew 1429: ###############################################################
1430: ###############################################################
1431: sub create_text_file {
1432: my ($r,$suffix) = @_;
1433: if (! defined($suffix)) { $suffix = 'txt'; };
1434: my $fh;
1435: my $filename = '/prtspool/'.
1.258 albertel 1436: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1437: time.'_'.rand(1000000000).'.'.$suffix;
1438: $fh = Apache::File->new('>/home/httpd'.$filename);
1439: if (! defined($fh)) {
1440: $r->log_error("Couldn't open $filename for output $!");
1441: $r->print("Problems occured in creating the output file. ".
1442: "This error has been logged. ".
1443: "Please alert your LON-CAPA administrator.");
1.113 bowersj2 1444: }
1.256 matthew 1445: return ($fh,$filename)
1.113 bowersj2 1446: }
1447:
1448:
1.256 matthew 1449: =pod
1.113 bowersj2 1450:
1451: =back
1452:
1453: =cut
1.37 matthew 1454:
1455: ###############################################################
1.33 matthew 1456: ## Home server <option> list generating code ##
1457: ###############################################################
1.35 matthew 1458:
1.169 www 1459: # ------------------------------------------
1460:
1461: sub domain_select {
1462: my ($name,$value,$multiple)=@_;
1463: my %domains=map {
1.514 albertel 1464: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1465: } &Apache::lonnet::all_domains();
1.169 www 1466: if ($multiple) {
1467: $domains{''}=&mt('Any domain');
1.550 albertel 1468: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1469: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1470: } else {
1.550 albertel 1471: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1472: return &select_form($name,$value,%domains);
1473: }
1474: }
1475:
1.282 albertel 1476: #-------------------------------------------
1477:
1478: =pod
1479:
1.519 raeburn 1480: =head1 Routines for form select boxes
1481:
1482: =over 4
1483:
1.287 albertel 1484: =item * multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1485:
1486: Returns a string containing a <select> element int multiple mode
1487:
1488:
1489: Args:
1490: $name - name of the <select> element
1.506 raeburn 1491: $value - scalar or array ref of values that should already be selected
1.282 albertel 1492: $size - number of rows long the select element is
1.283 albertel 1493: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1494: (shown text should already have been &mt())
1.506 raeburn 1495: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1496:
1.282 albertel 1497: =cut
1498:
1499: #-------------------------------------------
1.169 www 1500: sub multiple_select_form {
1.284 albertel 1501: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1502: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1503: my $output='';
1.191 matthew 1504: if (! defined($size)) {
1505: $size = 4;
1.283 albertel 1506: if (scalar(keys(%$hash))<4) {
1507: $size = scalar(keys(%$hash));
1.191 matthew 1508: }
1509: }
1.169 www 1510: $output.="\n<select name='$name' size='$size' multiple='1'>";
1.501 banghart 1511: my @order;
1.506 raeburn 1512: if (ref($order) eq 'ARRAY') {
1513: @order = @{$order};
1514: } else {
1515: @order = sort(keys(%$hash));
1.501 banghart 1516: }
1517: if (exists($$hash{'select_form_order'})) {
1518: @order = @{$$hash{'select_form_order'}};
1519: }
1520:
1.284 albertel 1521: foreach my $key (@order) {
1.356 albertel 1522: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1523: $output.='selected="selected" ' if ($selected{$key});
1524: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1525: }
1526: $output.="</select>\n";
1527: return $output;
1528: }
1529:
1.88 www 1530: #-------------------------------------------
1531:
1532: =pod
1533:
1.112 bowersj2 1534: =item * select_form($defdom,$name,%hash)
1.88 www 1535:
1536: Returns a string containing a <select name='$name' size='1'> form to
1537: allow a user to select options from a hash option_name => displayed text.
1538: See lonrights.pm for an example invocation and use.
1539:
1540: =cut
1541:
1542: #-------------------------------------------
1543: sub select_form {
1544: my ($def,$name,%hash) = @_;
1545: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1546: my @keys;
1547: if (exists($hash{'select_form_order'})) {
1548: @keys=@{$hash{'select_form_order'}};
1549: } else {
1550: @keys=sort(keys(%hash));
1551: }
1.356 albertel 1552: foreach my $key (@keys) {
1553: $selectform.=
1554: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1555: ($key eq $def ? 'selected="selected" ' : '').
1556: ">".&mt($hash{$key})."</option>\n";
1.88 www 1557: }
1558: $selectform.="</select>";
1559: return $selectform;
1560: }
1561:
1.475 www 1562: # For display filters
1563:
1564: sub display_filter {
1565: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1566: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.475 www 1567: return '<nobr><label>'.&mt('Records [_1]',
1568: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1569: (&mt('all'),10,20,50,100,1000,10000))).
1.478 www 1570: '</label></nobr> <nobr>'.
1.475 www 1571: &mt('Filter [_1]',
1.477 www 1572: &select_form($env{'form.displayfilter'},
1573: 'displayfilter',
1574: ('currentfolder' => 'Current folder/page',
1575: 'containing' => 'Containing phrase',
1576: 'none' => 'None'))).
1.478 www 1577: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
1.475 www 1578: }
1579:
1.167 www 1580: sub gradeleveldescription {
1581: my $gradelevel=shift;
1582: my %gradelevels=(0 => 'Not specified',
1583: 1 => 'Grade 1',
1584: 2 => 'Grade 2',
1585: 3 => 'Grade 3',
1586: 4 => 'Grade 4',
1587: 5 => 'Grade 5',
1588: 6 => 'Grade 6',
1589: 7 => 'Grade 7',
1590: 8 => 'Grade 8',
1591: 9 => 'Grade 9',
1592: 10 => 'Grade 10',
1593: 11 => 'Grade 11',
1594: 12 => 'Grade 12',
1595: 13 => 'Grade 13',
1596: 14 => '100 Level',
1597: 15 => '200 Level',
1598: 16 => '300 Level',
1599: 17 => '400 Level',
1600: 18 => 'Graduate Level');
1601: return &mt($gradelevels{$gradelevel});
1602: }
1603:
1.163 www 1604: sub select_level_form {
1605: my ($deflevel,$name)=@_;
1606: unless ($deflevel) { $deflevel=0; }
1.167 www 1607: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1608: for (my $i=0; $i<=18; $i++) {
1609: $selectform.="<option value=\"$i\" ".
1.253 albertel 1610: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1611: ">".&gradeleveldescription($i)."</option>\n";
1612: }
1613: $selectform.="</select>";
1614: return $selectform;
1.163 www 1615: }
1.167 www 1616:
1.35 matthew 1617: #-------------------------------------------
1618:
1.45 matthew 1619: =pod
1620:
1.563 raeburn 1621: =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
1.35 matthew 1622:
1623: Returns a string containing a <select name='$name' size='1'> form to
1624: allow a user to select the domain to preform an operation in.
1625: See loncreateuser.pm for an example invocation and use.
1626:
1.90 www 1627: If the $includeempty flag is set, it also includes an empty choice ("no domain
1628: selected");
1629:
1.563 raeburn 1630: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1631:
1.35 matthew 1632: =cut
1633:
1634: #-------------------------------------------
1.34 matthew 1635: sub select_dom_form {
1.563 raeburn 1636: my ($defdom,$name,$includeempty,$showdomdesc) = @_;
1.550 albertel 1637: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1638: if ($includeempty) { @domains=('',@domains); }
1.34 matthew 1639: my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
1.356 albertel 1640: foreach my $dom (@domains) {
1641: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1642: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1643: if ($showdomdesc) {
1644: if ($dom ne '') {
1645: my $domdesc = &Apache::lonnet::domain($dom,'description');
1646: if ($domdesc ne '') {
1647: $selectdomain .= ' ('.$domdesc.')';
1648: }
1649: }
1650: }
1651: $selectdomain .= "</option>\n";
1.34 matthew 1652: }
1653: $selectdomain.="</select>";
1654: return $selectdomain;
1655: }
1656:
1.35 matthew 1657: #-------------------------------------------
1658:
1.45 matthew 1659: =pod
1660:
1.586 raeburn 1661: =item * home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1662:
1.586 raeburn 1663: input: 4 arguments (two required, two optional) -
1664: $domain - domain of new user
1665: $name - name of form element
1666: $default - Value of 'default' causes a default item to be first
1667: option, and selected by default.
1668: $hide - Value of 'hide' causes hiding of the name of the server,
1669: if 1 server found, or default, if 0 found.
1.594 raeburn 1670: output: returns 2 items:
1.586 raeburn 1671: (a) form element which contains either:
1672: (i) <select name="$name">
1673: <option value="$hostid1">$hostid $servers{$hostid}</option>
1674: <option value="$hostid2">$hostid $servers{$hostid}</option>
1675: </select>
1676: form item if there are multiple library servers in $domain, or
1677: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1678: if there is only one library server in $domain.
1679:
1680: (b) number of library servers found.
1681:
1682: See loncreateuser.pm for example of use.
1.35 matthew 1683:
1684: =cut
1685:
1686: #-------------------------------------------
1.586 raeburn 1687: sub home_server_form_item {
1688: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1689: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1690: my $result;
1691: my $numlib = keys(%servers);
1692: if ($numlib > 1) {
1693: $result .= '<select name="'.$name.'" />'."\n";
1694: if ($default) {
1695: $result .= '<option value="default" selected>'.&mt('default').
1696: '</option>'."\n";
1697: }
1698: foreach my $hostid (sort(keys(%servers))) {
1699: $result.= '<option value="'.$hostid.'">'.
1700: $hostid.' '.$servers{$hostid}."</option>\n";
1701: }
1702: $result .= '</select>'."\n";
1703: } elsif ($numlib == 1) {
1704: my $hostid;
1705: foreach my $item (keys(%servers)) {
1706: $hostid = $item;
1707: }
1708: $result .= '<input type="hidden" name="'.$name.'" value="'.
1709: $hostid.'" />';
1710: if (!$hide) {
1711: $result .= $hostid.' '.$servers{$hostid};
1712: }
1713: $result .= "\n";
1714: } elsif ($default) {
1715: $result .= '<input type="hidden" name="'.$name.
1716: '" value="default" />';
1717: if (!$hide) {
1718: $result .= &mt('default');
1719: }
1720: $result .= "\n";
1.33 matthew 1721: }
1.586 raeburn 1722: return ($result,$numlib);
1.33 matthew 1723: }
1.112 bowersj2 1724:
1725: =pod
1726:
1.534 albertel 1727: =back
1728:
1.112 bowersj2 1729: =cut
1.87 matthew 1730:
1731: ###############################################################
1.112 bowersj2 1732: ## Decoding User Agent ##
1.87 matthew 1733: ###############################################################
1734:
1735: =pod
1736:
1.112 bowersj2 1737: =head1 Decoding the User Agent
1738:
1739: =over 4
1740:
1741: =item * &decode_user_agent()
1.87 matthew 1742:
1743: Inputs: $r
1744:
1745: Outputs:
1746:
1747: =over 4
1748:
1.112 bowersj2 1749: =item * $httpbrowser
1.87 matthew 1750:
1.112 bowersj2 1751: =item * $clientbrowser
1.87 matthew 1752:
1.112 bowersj2 1753: =item * $clientversion
1.87 matthew 1754:
1.112 bowersj2 1755: =item * $clientmathml
1.87 matthew 1756:
1.112 bowersj2 1757: =item * $clientunicode
1.87 matthew 1758:
1.112 bowersj2 1759: =item * $clientos
1.87 matthew 1760:
1761: =back
1762:
1.157 matthew 1763: =back
1764:
1.87 matthew 1765: =cut
1766:
1767: ###############################################################
1768: ###############################################################
1769: sub decode_user_agent {
1.247 albertel 1770: my ($r)=@_;
1.87 matthew 1771: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
1772: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
1773: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 1774: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 1775: my $clientbrowser='unknown';
1776: my $clientversion='0';
1777: my $clientmathml='';
1778: my $clientunicode='0';
1779: for (my $i=0;$i<=$#browsertype;$i++) {
1780: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
1781: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
1782: $clientbrowser=$bname;
1783: $httpbrowser=~/$vreg/i;
1784: $clientversion=$1;
1785: $clientmathml=($clientversion>=$minv);
1786: $clientunicode=($clientversion>=$univ);
1787: }
1788: }
1789: my $clientos='unknown';
1790: if (($httpbrowser=~/linux/i) ||
1791: ($httpbrowser=~/unix/i) ||
1792: ($httpbrowser=~/ux/i) ||
1793: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
1794: if (($httpbrowser=~/vax/i) ||
1795: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
1796: if ($httpbrowser=~/next/i) { $clientos='next'; }
1797: if (($httpbrowser=~/mac/i) ||
1798: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1799: if ($httpbrowser=~/win/i) { $clientos='win'; }
1800: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1801: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1802: $clientunicode,$clientos,);
1803: }
1804:
1.32 matthew 1805: ###############################################################
1806: ## Authentication changing form generation subroutines ##
1807: ###############################################################
1808: ##
1809: ## All of the authform_xxxxxxx subroutines take their inputs in a
1810: ## hash, and have reasonable default values.
1811: ##
1812: ## formname = the name given in the <form> tag.
1.35 matthew 1813: #-------------------------------------------
1814:
1.45 matthew 1815: =pod
1816:
1.112 bowersj2 1817: =head1 Authentication Routines
1818:
1819: =over 4
1820:
1821: =item * authform_xxxxxx
1.35 matthew 1822:
1823: The authform_xxxxxx subroutines provide javascript and html forms which
1824: handle some of the conveniences required for authentication forms.
1825: This is not an optimal method, but it works.
1826:
1827: See loncreateuser.pm for invocation and use examples.
1828:
1829: =over 4
1830:
1.112 bowersj2 1831: =item * authform_header
1.35 matthew 1832:
1.112 bowersj2 1833: =item * authform_authorwarning
1.35 matthew 1834:
1.112 bowersj2 1835: =item * authform_nochange
1.35 matthew 1836:
1.112 bowersj2 1837: =item * authform_kerberos
1.35 matthew 1838:
1.112 bowersj2 1839: =item * authform_internal
1.35 matthew 1840:
1.112 bowersj2 1841: =item * authform_filesystem
1.35 matthew 1842:
1843: =back
1844:
1.157 matthew 1845: =back
1846:
1.35 matthew 1847: =cut
1848:
1849: #-------------------------------------------
1.32 matthew 1850: sub authform_header{
1851: my %in = (
1852: formname => 'cu',
1.80 albertel 1853: kerb_def_dom => '',
1.32 matthew 1854: @_,
1855: );
1856: $in{'formname'} = 'document.' . $in{'formname'};
1857: my $result='';
1.80 albertel 1858:
1859: #---------------------------------------------- Code for upper case translation
1860: my $Javascript_toUpperCase;
1861: unless ($in{kerb_def_dom}) {
1862: $Javascript_toUpperCase =<<"END";
1863: switch (choice) {
1864: case 'krb': currentform.elements[choicearg].value =
1865: currentform.elements[choicearg].value.toUpperCase();
1866: break;
1867: default:
1868: }
1869: END
1870: } else {
1871: $Javascript_toUpperCase = "";
1872: }
1873:
1.165 raeburn 1874: my $radioval = "'nochange'";
1.591 raeburn 1875: if (defined($in{'curr_authtype'})) {
1876: if ($in{'curr_authtype'} ne '') {
1877: $radioval = "'".$in{'curr_authtype'}."arg'";
1878: }
1.174 matthew 1879: }
1.165 raeburn 1880: my $argfield = 'null';
1.591 raeburn 1881: if (defined($in{'mode'})) {
1.165 raeburn 1882: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 1883: if (defined($in{'curr_autharg'})) {
1884: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 1885: $argfield = "'$in{'curr_autharg'}'";
1886: }
1887: }
1888: }
1889: }
1890:
1.32 matthew 1891: $result.=<<"END";
1892: var current = new Object();
1.165 raeburn 1893: current.radiovalue = $radioval;
1894: current.argfield = $argfield;
1.32 matthew 1895:
1896: function changed_radio(choice,currentform) {
1897: var choicearg = choice + 'arg';
1898: // If a radio button in changed, we need to change the argfield
1899: if (current.radiovalue != choice) {
1900: current.radiovalue = choice;
1901: if (current.argfield != null) {
1902: currentform.elements[current.argfield].value = '';
1903: }
1904: if (choice == 'nochange') {
1905: current.argfield = null;
1906: } else {
1907: current.argfield = choicearg;
1908: switch(choice) {
1909: case 'krb':
1910: currentform.elements[current.argfield].value =
1911: "$in{'kerb_def_dom'}";
1912: break;
1913: default:
1914: break;
1915: }
1916: }
1917: }
1918: return;
1919: }
1.22 www 1920:
1.32 matthew 1921: function changed_text(choice,currentform) {
1922: var choicearg = choice + 'arg';
1923: if (currentform.elements[choicearg].value !='') {
1.80 albertel 1924: $Javascript_toUpperCase
1.32 matthew 1925: // clear old field
1926: if ((current.argfield != choicearg) && (current.argfield != null)) {
1927: currentform.elements[current.argfield].value = '';
1928: }
1929: current.argfield = choicearg;
1930: }
1931: set_auth_radio_buttons(choice,currentform);
1932: return;
1.20 www 1933: }
1.32 matthew 1934:
1935: function set_auth_radio_buttons(newvalue,currentform) {
1936: var i=0;
1937: while (i < currentform.login.length) {
1938: if (currentform.login[i].value == newvalue) { break; }
1939: i++;
1940: }
1941: if (i == currentform.login.length) {
1942: return;
1943: }
1944: current.radiovalue = newvalue;
1945: currentform.login[i].checked = true;
1946: return;
1947: }
1948: END
1949: return $result;
1950: }
1951:
1952: sub authform_authorwarning{
1953: my $result='';
1.144 matthew 1954: $result='<i>'.
1955: &mt('As a general rule, only authors or co-authors should be '.
1956: 'filesystem authenticated '.
1957: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 1958: return $result;
1959: }
1960:
1961: sub authform_nochange{
1962: my %in = (
1963: formname => 'document.cu',
1964: kerb_def_dom => 'MSU.EDU',
1965: @_,
1966: );
1.586 raeburn 1967: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1968: my $result;
1969: if (keys(%can_assign) == 0) {
1970: $result = &mt('Under you current role you are not permitted to change login settings for this user');
1971: } else {
1972: $result = '<label>'.&mt('[_1] Do not change login data',
1973: '<input type="radio" name="login" value="nochange" '.
1974: 'checked="checked" onclick="'.
1.281 albertel 1975: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
1976: '</label>';
1.586 raeburn 1977: }
1.32 matthew 1978: return $result;
1979: }
1980:
1.591 raeburn 1981: sub authform_kerberos {
1.32 matthew 1982: my %in = (
1983: formname => 'document.cu',
1984: kerb_def_dom => 'MSU.EDU',
1.80 albertel 1985: kerb_def_auth => 'krb4',
1.32 matthew 1986: @_,
1987: );
1.586 raeburn 1988: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1989: $autharg,$jscall);
1990: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 1991: if ($in{'kerb_def_auth'} eq 'krb5') {
1.586 raeburn 1992: $check5 = ' checked="on"';
1.80 albertel 1993: } else {
1.586 raeburn 1994: $check4 = ' checked="on"';
1.80 albertel 1995: }
1.165 raeburn 1996: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 1997: if (defined($in{'curr_authtype'})) {
1998: if ($in{'curr_authtype'} eq 'krb') {
1.586 raeburn 1999: $krbcheck = ' checked="on"';
1.623 raeburn 2000: if (defined($in{'mode'})) {
2001: if ($in{'mode'} eq 'modifyuser') {
2002: $krbcheck = '';
2003: }
2004: }
1.591 raeburn 2005: if (defined($in{'curr_kerb_ver'})) {
2006: if ($in{'curr_krb_ver'} eq '5') {
2007: $check5 = ' checked="on"';
2008: $check4 = '';
2009: } else {
2010: $check4 = ' checked="on"';
2011: $check5 = '';
2012: }
1.586 raeburn 2013: }
1.591 raeburn 2014: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2015: $krbarg = $in{'curr_autharg'};
2016: }
1.586 raeburn 2017: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2018: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2019: $result =
2020: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2021: $in{'curr_autharg'},$krbver);
2022: } else {
2023: $result =
2024: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2025: }
2026: return $result;
2027: }
2028: }
2029: } else {
2030: if ($authnum == 1) {
2031: $authtype = '<input type="hidden" name="login" value="krb">';
1.165 raeburn 2032: }
2033: }
1.586 raeburn 2034: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2035: return;
1.587 raeburn 2036: } elsif ($authtype eq '') {
1.591 raeburn 2037: if (defined($in{'mode'})) {
1.587 raeburn 2038: if ($in{'mode'} eq 'modifycourse') {
2039: if ($authnum == 1) {
2040: $authtype = '<input type="hidden" name="login" value="krb">';
2041: }
2042: }
2043: }
1.586 raeburn 2044: }
2045: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2046: if ($authtype eq '') {
2047: $authtype = '<input type="radio" name="login" value="krb" '.
2048: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2049: $krbcheck.' />';
2050: }
2051: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2052: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2053: $in{'curr_authtype'} eq 'krb5') ||
2054: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2055: $in{'curr_authtype'} eq 'krb4')) {
2056: $result .= &mt
1.144 matthew 2057: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2058: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2059: '<label>'.$authtype,
1.281 albertel 2060: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2061: 'value="'.$krbarg.'" '.
1.144 matthew 2062: 'onchange="'.$jscall.'" />',
1.281 albertel 2063: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2064: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2065: '</label>');
1.586 raeburn 2066: } elsif ($can_assign{'krb4'}) {
2067: $result .= &mt
2068: ('[_1] Kerberos authenticated with domain [_2] '.
2069: '[_3] Version 4 [_4]',
2070: '<label>'.$authtype,
2071: '</label><input type="text" size="10" name="krbarg" '.
2072: 'value="'.$krbarg.'" '.
2073: 'onchange="'.$jscall.'" />',
2074: '<label><input type="hidden" name="krbver" value="4" />',
2075: '</label>');
2076: } elsif ($can_assign{'krb5'}) {
2077: $result .= &mt
2078: ('[_1] Kerberos authenticated with domain [_2] '.
2079: '[_3] Version 5 [_4]',
2080: '<label>'.$authtype,
2081: '</label><input type="text" size="10" name="krbarg" '.
2082: 'value="'.$krbarg.'" '.
2083: 'onchange="'.$jscall.'" />',
2084: '<label><input type="hidden" name="krbver" value="5" />',
2085: '</label>');
2086: }
1.32 matthew 2087: return $result;
2088: }
2089:
2090: sub authform_internal{
1.586 raeburn 2091: my %in = (
1.32 matthew 2092: formname => 'document.cu',
2093: kerb_def_dom => 'MSU.EDU',
2094: @_,
2095: );
1.586 raeburn 2096: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2097: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2098: if (defined($in{'curr_authtype'})) {
2099: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2100: if ($can_assign{'int'}) {
2101: $intcheck = 'checked="on" ';
1.623 raeburn 2102: if (defined($in{'mode'})) {
2103: if ($in{'mode'} eq 'modifyuser') {
2104: $intcheck = '';
2105: }
2106: }
1.591 raeburn 2107: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2108: $intarg = $in{'curr_autharg'};
2109: }
2110: } else {
2111: $result = &mt('Currently internally authenticated.');
2112: return $result;
1.165 raeburn 2113: }
2114: }
1.586 raeburn 2115: } else {
2116: if ($authnum == 1) {
2117: $authtype = '<input type="hidden" name="login" value="int">';
2118: }
2119: }
2120: if (!$can_assign{'int'}) {
2121: return;
1.587 raeburn 2122: } elsif ($authtype eq '') {
1.591 raeburn 2123: if (defined($in{'mode'})) {
1.587 raeburn 2124: if ($in{'mode'} eq 'modifycourse') {
2125: if ($authnum == 1) {
2126: $authtype = '<input type="hidden" name="login" value="int">';
2127: }
2128: }
2129: }
1.165 raeburn 2130: }
1.586 raeburn 2131: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2132: if ($authtype eq '') {
2133: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2134: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2135: }
1.605 bisitz 2136: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2137: $intarg.'" onchange="'.$jscall.'" />';
2138: $result = &mt
1.144 matthew 2139: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2140: '<label>'.$authtype,'</label>'.$autharg);
1.620 www 2141: $result.="<label><input type=\"checkbox\" name=\"visible\" onClick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32 matthew 2142: return $result;
2143: }
2144:
2145: sub authform_local{
2146: my %in = (
2147: formname => 'document.cu',
2148: kerb_def_dom => 'MSU.EDU',
2149: @_,
2150: );
1.586 raeburn 2151: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2152: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2153: if (defined($in{'curr_authtype'})) {
2154: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2155: if ($can_assign{'loc'}) {
2156: $loccheck = 'checked="on" ';
1.623 raeburn 2157: if (defined($in{'mode'})) {
2158: if ($in{'mode'} eq 'modifyuser') {
2159: $loccheck = '';
2160: }
2161: }
1.591 raeburn 2162: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2163: $locarg = $in{'curr_autharg'};
2164: }
2165: } else {
2166: $result = &mt('Currently using local (institutional) authentication.');
2167: return $result;
1.165 raeburn 2168: }
2169: }
1.586 raeburn 2170: } else {
2171: if ($authnum == 1) {
2172: $authtype = '<input type="hidden" name="login" value="loc">';
2173: }
2174: }
2175: if (!$can_assign{'loc'}) {
2176: return;
1.587 raeburn 2177: } elsif ($authtype eq '') {
1.591 raeburn 2178: if (defined($in{'mode'})) {
1.587 raeburn 2179: if ($in{'mode'} eq 'modifycourse') {
2180: if ($authnum == 1) {
2181: $authtype = '<input type="hidden" name="login" value="loc">';
2182: }
2183: }
2184: }
1.165 raeburn 2185: }
1.586 raeburn 2186: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2187: if ($authtype eq '') {
2188: $authtype = '<input type="radio" name="login" value="loc" '.
2189: $loccheck.' onchange="'.$jscall.'" onclick="'.
2190: $jscall.'" />';
2191: }
2192: $autharg = '<input type="text" size="10" name="locarg" value="'.
2193: $locarg.'" onchange="'.$jscall.'" />';
2194: $result = &mt('[_1] Local Authentication with argument [_2]',
2195: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2196: return $result;
2197: }
2198:
2199: sub authform_filesystem{
2200: my %in = (
2201: formname => 'document.cu',
2202: kerb_def_dom => 'MSU.EDU',
2203: @_,
2204: );
1.586 raeburn 2205: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2206: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2207: if (defined($in{'curr_authtype'})) {
2208: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2209: if ($can_assign{'fsys'}) {
2210: $fsyscheck = 'checked="on" ';
1.623 raeburn 2211: if (defined($in{'mode'})) {
2212: if ($in{'mode'} eq 'modifyuser') {
2213: $fsyscheck = '';
2214: }
2215: }
1.586 raeburn 2216: } else {
2217: $result = &mt('Currently Filesystem Authenticated.');
2218: return $result;
2219: }
2220: }
2221: } else {
2222: if ($authnum == 1) {
2223: $authtype = '<input type="hidden" name="login" value="fsys">';
2224: }
2225: }
2226: if (!$can_assign{'fsys'}) {
2227: return;
1.587 raeburn 2228: } elsif ($authtype eq '') {
1.591 raeburn 2229: if (defined($in{'mode'})) {
1.587 raeburn 2230: if ($in{'mode'} eq 'modifycourse') {
2231: if ($authnum == 1) {
2232: $authtype = '<input type="hidden" name="login" value="fsys">';
2233: }
2234: }
2235: }
1.586 raeburn 2236: }
2237: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2238: if ($authtype eq '') {
2239: $authtype = '<input type="radio" name="login" value="fsys" '.
2240: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2241: $jscall.'" />';
2242: }
2243: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2244: ' onchange="'.$jscall.'" />';
2245: $result = &mt
1.144 matthew 2246: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2247: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2248: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2249: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2250: 'onchange="'.$jscall.'" />');
1.32 matthew 2251: return $result;
2252: }
2253:
1.586 raeburn 2254: sub get_assignable_auth {
2255: my ($dom) = @_;
2256: if ($dom eq '') {
2257: $dom = $env{'request.role.domain'};
2258: }
2259: my %can_assign = (
2260: krb4 => 1,
2261: krb5 => 1,
2262: int => 1,
2263: loc => 1,
2264: );
2265: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2266: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2267: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2268: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2269: my $context;
2270: if ($env{'request.role'} =~ /^au/) {
2271: $context = 'author';
2272: } elsif ($env{'request.role'} =~ /^dc/) {
2273: $context = 'domain';
2274: } elsif ($env{'request.course.id'}) {
2275: $context = 'course';
2276: }
2277: if ($context) {
2278: if (ref($authhash->{$context}) eq 'HASH') {
2279: %can_assign = %{$authhash->{$context}};
2280: }
2281: }
2282: }
2283: }
2284: my $authnum = 0;
2285: foreach my $key (keys(%can_assign)) {
2286: if ($can_assign{$key}) {
2287: $authnum ++;
2288: }
2289: }
2290: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2291: $authnum --;
2292: }
2293: return ($authnum,%can_assign);
2294: }
2295:
1.80 albertel 2296: ###############################################################
2297: ## Get Kerberos Defaults for Domain ##
2298: ###############################################################
2299: ##
2300: ## Returns default kerberos version and an associated argument
2301: ## as listed in file domain.tab. If not listed, provides
2302: ## appropriate default domain and kerberos version.
2303: ##
2304: #-------------------------------------------
2305:
2306: =pod
2307:
1.112 bowersj2 2308: =item * get_kerberos_defaults
1.80 albertel 2309:
2310: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2311: version and domain. If not found, it defaults to version 4 and the
2312: domain of the server.
1.80 albertel 2313:
2314: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2315:
2316: =cut
2317:
2318: #-------------------------------------------
2319: sub get_kerberos_defaults {
2320: my $domain=shift;
1.641 raeburn 2321: my ($krbdef,$krbdefdom);
2322: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2323: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2324: $krbdef = $domdefaults{'auth_def'};
2325: $krbdefdom = $domdefaults{'auth_arg_def'};
2326: } else {
1.80 albertel 2327: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2328: my $krbdefdom=$1;
2329: $krbdefdom=~tr/a-z/A-Z/;
2330: $krbdef = "krb4";
2331: }
2332: return ($krbdef,$krbdefdom);
2333: }
1.112 bowersj2 2334:
2335: =pod
2336:
2337: =back
2338:
2339: =cut
1.32 matthew 2340:
1.46 matthew 2341: ###############################################################
2342: ## Thesaurus Functions ##
2343: ###############################################################
1.20 www 2344:
1.46 matthew 2345: =pod
1.20 www 2346:
1.112 bowersj2 2347: =head1 Thesaurus Functions
2348:
2349: =over 4
2350:
2351: =item * initialize_keywords
1.46 matthew 2352:
2353: Initializes the package variable %Keywords if it is empty. Uses the
2354: package variable $thesaurus_db_file.
2355:
2356: =cut
2357:
2358: ###################################################
2359:
2360: sub initialize_keywords {
2361: return 1 if (scalar keys(%Keywords));
2362: # If we are here, %Keywords is empty, so fill it up
2363: # Make sure the file we need exists...
2364: if (! -e $thesaurus_db_file) {
2365: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2366: " failed because it does not exist");
2367: return 0;
2368: }
2369: # Set up the hash as a database
2370: my %thesaurus_db;
2371: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2372: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2373: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2374: $thesaurus_db_file);
2375: return 0;
2376: }
2377: # Get the average number of appearances of a word.
2378: my $avecount = $thesaurus_db{'average.count'};
2379: # Put keywords (those that appear > average) into %Keywords
2380: while (my ($word,$data)=each (%thesaurus_db)) {
2381: my ($count,undef) = split /:/,$data;
2382: $Keywords{$word}++ if ($count > $avecount);
2383: }
2384: untie %thesaurus_db;
2385: # Remove special values from %Keywords.
1.356 albertel 2386: foreach my $value ('total.count','average.count') {
2387: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2388: }
1.46 matthew 2389: return 1;
2390: }
2391:
2392: ###################################################
2393:
2394: =pod
2395:
1.112 bowersj2 2396: =item * keyword($word)
1.46 matthew 2397:
2398: Returns true if $word is a keyword. A keyword is a word that appears more
2399: than the average number of times in the thesaurus database. Calls
2400: &initialize_keywords
2401:
2402: =cut
2403:
2404: ###################################################
1.20 www 2405:
2406: sub keyword {
1.46 matthew 2407: return if (!&initialize_keywords());
2408: my $word=lc(shift());
2409: $word=~s/\W//g;
2410: return exists($Keywords{$word});
1.20 www 2411: }
1.46 matthew 2412:
2413: ###############################################################
2414:
2415: =pod
1.20 www 2416:
1.112 bowersj2 2417: =item * get_related_words
1.46 matthew 2418:
1.160 matthew 2419: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2420: an array of words. If the keyword is not in the thesaurus, an empty array
2421: will be returned. The order of the words returned is determined by the
2422: database which holds them.
2423:
2424: Uses global $thesaurus_db_file.
2425:
2426: =cut
2427:
2428: ###############################################################
2429: sub get_related_words {
2430: my $keyword = shift;
2431: my %thesaurus_db;
2432: if (! -e $thesaurus_db_file) {
2433: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2434: "failed because the file does not exist");
2435: return ();
2436: }
2437: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2438: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2439: return ();
2440: }
2441: my @Words=();
1.429 www 2442: my $count=0;
1.46 matthew 2443: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2444: # The first element is the number of times
2445: # the word appears. We do not need it now.
1.429 www 2446: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2447: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2448: my $threshold=$mostfrequentcount/10;
2449: foreach my $possibleword (@RelatedWords) {
2450: my ($word,$wordcount)=split(/\,/,$possibleword);
2451: if ($wordcount>$threshold) {
2452: push(@Words,$word);
2453: $count++;
2454: if ($count>10) { last; }
2455: }
1.20 www 2456: }
2457: }
1.46 matthew 2458: untie %thesaurus_db;
2459: return @Words;
1.14 harris41 2460: }
1.46 matthew 2461:
1.112 bowersj2 2462: =pod
2463:
2464: =back
2465:
2466: =cut
1.61 www 2467:
2468: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2469: =pod
2470:
1.112 bowersj2 2471: =head1 User Name Functions
2472:
2473: =over 4
2474:
1.226 albertel 2475: =item * plainname($uname,$udom,$first)
1.81 albertel 2476:
1.112 bowersj2 2477: Takes a users logon name and returns it as a string in
1.226 albertel 2478: "first middle last generation" form
2479: if $first is set to 'lastname' then it returns it as
2480: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2481:
2482: =cut
1.61 www 2483:
1.295 www 2484:
1.81 albertel 2485: ###############################################################
1.61 www 2486: sub plainname {
1.226 albertel 2487: my ($uname,$udom,$first)=@_;
1.537 albertel 2488: return if (!defined($uname) || !defined($udom));
1.295 www 2489: my %names=&getnames($uname,$udom);
1.226 albertel 2490: my $name=&Apache::lonnet::format_name($names{'firstname'},
2491: $names{'middlename'},
2492: $names{'lastname'},
2493: $names{'generation'},$first);
2494: $name=~s/^\s+//;
1.62 www 2495: $name=~s/\s+$//;
2496: $name=~s/\s+/ /g;
1.353 albertel 2497: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2498: return $name;
1.61 www 2499: }
1.66 www 2500:
2501: # -------------------------------------------------------------------- Nickname
1.81 albertel 2502: =pod
2503:
1.112 bowersj2 2504: =item * nickname($uname,$udom)
1.81 albertel 2505:
2506: Gets a users name and returns it as a string as
2507:
2508: ""nickname""
1.66 www 2509:
1.81 albertel 2510: if the user has a nickname or
2511:
2512: "first middle last generation"
2513:
2514: if the user does not
2515:
2516: =cut
1.66 www 2517:
2518: sub nickname {
2519: my ($uname,$udom)=@_;
1.537 albertel 2520: return if (!defined($uname) || !defined($udom));
1.295 www 2521: my %names=&getnames($uname,$udom);
1.68 albertel 2522: my $name=$names{'nickname'};
1.66 www 2523: if ($name) {
2524: $name='"'.$name.'"';
2525: } else {
2526: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2527: $names{'lastname'}.' '.$names{'generation'};
2528: $name=~s/\s+$//;
2529: $name=~s/\s+/ /g;
2530: }
2531: return $name;
2532: }
2533:
1.295 www 2534: sub getnames {
2535: my ($uname,$udom)=@_;
1.537 albertel 2536: return if (!defined($uname) || !defined($udom));
1.433 albertel 2537: if ($udom eq 'public' && $uname eq 'public') {
2538: return ('lastname' => &mt('Public'));
2539: }
1.295 www 2540: my $id=$uname.':'.$udom;
2541: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2542: if ($cached) {
2543: return %{$names};
2544: } else {
2545: my %loadnames=&Apache::lonnet::get('environment',
2546: ['firstname','middlename','lastname','generation','nickname'],
2547: $udom,$uname);
2548: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2549: return %loadnames;
2550: }
2551: }
1.61 www 2552:
1.542 raeburn 2553: # -------------------------------------------------------------------- getemails
2554: =pod
2555:
2556: =item * getemails($uname,$udom)
2557:
2558: Gets a user's email information and returns it as a hash with keys:
2559: notification, critnotification, permanentemail
2560:
2561: For notification and critnotification, values are comma-separated lists
2562: of e-mail address(es); for permanentemail, value is a single e-mail address.
2563:
2564: =cut
2565:
1.466 albertel 2566: sub getemails {
2567: my ($uname,$udom)=@_;
2568: if ($udom eq 'public' && $uname eq 'public') {
2569: return;
2570: }
1.467 www 2571: if (!$udom) { $udom=$env{'user.domain'}; }
2572: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2573: my $id=$uname.':'.$udom;
2574: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2575: if ($cached) {
2576: return %{$names};
2577: } else {
2578: my %loadnames=&Apache::lonnet::get('environment',
2579: ['notification','critnotification',
2580: 'permanentemail'],
2581: $udom,$uname);
2582: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2583: return %loadnames;
2584: }
2585: }
2586:
1.551 albertel 2587: sub flush_email_cache {
2588: my ($uname,$udom)=@_;
2589: if (!$udom) { $udom =$env{'user.domain'}; }
2590: if (!$uname) { $uname=$env{'user.name'}; }
2591: return if ($udom eq 'public' && $uname eq 'public');
2592: my $id=$uname.':'.$udom;
2593: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2594: }
2595:
1.61 www 2596: # ------------------------------------------------------------------ Screenname
1.81 albertel 2597:
2598: =pod
2599:
1.112 bowersj2 2600: =item * screenname($uname,$udom)
1.81 albertel 2601:
2602: Gets a users screenname and returns it as a string
2603:
2604: =cut
1.61 www 2605:
2606: sub screenname {
2607: my ($uname,$udom)=@_;
1.258 albertel 2608: if ($uname eq $env{'user.name'} &&
2609: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2610: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2611: return $names{'screenname'};
1.62 www 2612: }
2613:
1.212 albertel 2614:
1.62 www 2615: # ------------------------------------------------------------- Message Wrapper
2616:
2617: sub messagewrapper {
1.369 www 2618: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2619: return
1.441 albertel 2620: '<a href="/adm/email?compose=individual&'.
2621: 'recname='.$username.'&recdom='.$domain.
2622: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2623: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2624: }
2625: # --------------------------------------------------------------- Notes Wrapper
2626:
2627: sub noteswrapper {
2628: my ($link,$un,$do)=@_;
2629: return
2630: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2631: }
2632: # ------------------------------------------------------------- Aboutme Wrapper
2633:
2634: sub aboutmewrapper {
1.166 www 2635: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2636: if (!defined($username) && !defined($domain)) {
2637: return;
2638: }
1.205 www 2639: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.454 banghart 2640: ($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
1.62 www 2641: }
2642:
2643: # ------------------------------------------------------------ Syllabus Wrapper
2644:
2645:
2646: sub syllabuswrapper {
1.109 matthew 2647: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
2648: if ($fontcolor) {
2649: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
2650: }
1.208 matthew 2651: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2652: }
1.14 harris41 2653:
1.208 matthew 2654: sub track_student_link {
1.268 albertel 2655: my ($linktext,$sname,$sdom,$target,$start) = @_;
2656: my $link ="/adm/trackstudent?";
1.208 matthew 2657: my $title = 'View recent activity';
2658: if (defined($sname) && $sname !~ /^\s*$/ &&
2659: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2660: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2661: $title .= ' of this student';
1.268 albertel 2662: }
1.208 matthew 2663: if (defined($target) && $target !~ /^\s*$/) {
2664: $target = qq{target="$target"};
2665: } else {
2666: $target = '';
2667: }
1.268 albertel 2668: if ($start) { $link.='&start='.$start; }
1.554 albertel 2669: $title = &mt($title);
2670: $linktext = &mt($linktext);
1.448 albertel 2671: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2672: &help_open_topic('View_recent_activity');
1.208 matthew 2673: }
2674:
1.508 www 2675: # ===================================================== Display a student photo
2676:
2677:
1.509 albertel 2678: sub student_image_tag {
1.508 www 2679: my ($domain,$user)=@_;
2680: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
2681: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
2682: return '<img src="'.$imgsrc.'" align="right" />';
2683: } else {
2684: return '';
2685: }
2686: }
2687:
1.112 bowersj2 2688: =pod
2689:
2690: =back
2691:
2692: =head1 Access .tab File Data
2693:
2694: =over 4
2695:
2696: =item * languageids()
2697:
2698: returns list of all language ids
2699:
2700: =cut
2701:
1.14 harris41 2702: sub languageids {
1.16 harris41 2703: return sort(keys(%language));
1.14 harris41 2704: }
2705:
1.112 bowersj2 2706: =pod
2707:
2708: =item * languagedescription()
2709:
2710: returns description of a specified language id
2711:
2712: =cut
2713:
1.14 harris41 2714: sub languagedescription {
1.125 www 2715: my $code=shift;
2716: return ($supported_language{$code}?'* ':'').
2717: $language{$code}.
1.126 www 2718: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 2719: }
2720:
2721: sub plainlanguagedescription {
2722: my $code=shift;
2723: return $language{$code};
2724: }
2725:
2726: sub supportedlanguagecode {
2727: my $code=shift;
2728: return $supported_language{$code};
1.97 www 2729: }
2730:
1.112 bowersj2 2731: =pod
2732:
2733: =item * copyrightids()
2734:
2735: returns list of all copyrights
2736:
2737: =cut
2738:
2739: sub copyrightids {
2740: return sort(keys(%cprtag));
2741: }
2742:
2743: =pod
2744:
2745: =item * copyrightdescription()
2746:
2747: returns description of a specified copyright id
2748:
2749: =cut
2750:
2751: sub copyrightdescription {
1.166 www 2752: return &mt($cprtag{shift(@_)});
1.112 bowersj2 2753: }
1.197 matthew 2754:
2755: =pod
2756:
1.192 taceyjo1 2757: =item * source_copyrightids()
2758:
2759: returns list of all source copyrights
2760:
2761: =cut
2762:
2763: sub source_copyrightids {
2764: return sort(keys(%scprtag));
2765: }
2766:
2767: =pod
2768:
2769: =item * source_copyrightdescription()
2770:
2771: returns description of a specified source copyright id
2772:
2773: =cut
2774:
2775: sub source_copyrightdescription {
2776: return &mt($scprtag{shift(@_)});
2777: }
1.112 bowersj2 2778:
2779: =pod
2780:
2781: =item * filecategories()
2782:
2783: returns list of all file categories
2784:
2785: =cut
2786:
2787: sub filecategories {
2788: return sort(keys(%category_extensions));
2789: }
2790:
2791: =pod
2792:
2793: =item * filecategorytypes()
2794:
2795: returns list of file types belonging to a given file
2796: category
2797:
2798: =cut
2799:
2800: sub filecategorytypes {
1.356 albertel 2801: my ($cat) = @_;
2802: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 2803: }
2804:
2805: =pod
2806:
2807: =item * fileembstyle()
2808:
2809: returns embedding style for a specified file type
2810:
2811: =cut
2812:
2813: sub fileembstyle {
2814: return $fe{lc(shift(@_))};
1.169 www 2815: }
2816:
1.351 www 2817: sub filemimetype {
2818: return $fm{lc(shift(@_))};
2819: }
2820:
1.169 www 2821:
2822: sub filecategoryselect {
2823: my ($name,$value)=@_;
1.189 matthew 2824: return &select_form($value,$name,
1.169 www 2825: '' => &mt('Any category'),
2826: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 2827: }
2828:
2829: =pod
2830:
2831: =item * filedescription()
2832:
2833: returns description for a specified file type
2834:
2835: =cut
2836:
2837: sub filedescription {
1.188 matthew 2838: my $file_description = $fd{lc(shift())};
2839: $file_description =~ s:([\[\]]):~$1:g;
2840: return &mt($file_description);
1.112 bowersj2 2841: }
2842:
2843: =pod
2844:
2845: =item * filedescriptionex()
2846:
2847: returns description for a specified file type with
2848: extra formatting
2849:
2850: =cut
2851:
2852: sub filedescriptionex {
2853: my $ex=shift;
1.188 matthew 2854: my $file_description = $fd{lc($ex)};
2855: $file_description =~ s:([\[\]]):~$1:g;
2856: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 2857: }
2858:
2859: # End of .tab access
2860: =pod
2861:
2862: =back
2863:
2864: =cut
2865:
2866: # ------------------------------------------------------------------ File Types
2867: sub fileextensions {
2868: return sort(keys(%fe));
2869: }
2870:
1.97 www 2871: # ----------------------------------------------------------- Display Languages
2872: # returns a hash with all desired display languages
2873: #
2874:
2875: sub display_languages {
2876: my %languages=();
1.356 albertel 2877: foreach my $lang (&preferred_languages()) {
2878: $languages{$lang}=1;
1.97 www 2879: }
2880: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 2881: if ($env{'form.displaylanguage'}) {
1.356 albertel 2882: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
2883: $languages{$lang}=1;
1.97 www 2884: }
2885: }
2886: return %languages;
1.14 harris41 2887: }
2888:
1.117 www 2889: sub preferred_languages {
2890: my @languages=();
1.258 albertel 2891: if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
1.117 www 2892: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
1.258 albertel 2893: $env{'course.'.$env{'request.course.id'}.'.languages'}));
1.177 www 2894: }
1.258 albertel 2895: if ($env{'environment.languages'}) {
1.459 albertel 2896: @languages=(@languages,
2897: split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
1.118 www 2898: }
1.583 albertel 2899: my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
1.162 www 2900: if ($browser) {
1.583 albertel 2901: my @browser =
2902: map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
2903: push(@languages,@browser);
1.162 www 2904: }
1.641 raeburn 2905:
2906: foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'},
2907: $Apache::lonnet::perlvar{'lonDefDomain'}) {
2908: if ($domtype ne '') {
2909: my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
2910: if ($domdefs{'lang_def'} ne '') {
2911: push(@languages,$domdefs{'lang_def'});
2912: }
2913: }
1.118 www 2914: }
2915: # turn "en-ca" into "en-ca,en"
2916: my @genlanguages;
1.356 albertel 2917: foreach my $lang (@languages) {
2918: unless ($lang=~/\w/) { next; }
1.583 albertel 2919: push(@genlanguages,$lang);
1.356 albertel 2920: if ($lang=~/(\-|\_)/) {
2921: push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
1.118 www 2922: }
2923: }
1.583 albertel 2924: #uniqueify the languages list
2925: my %count;
2926: @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
1.118 www 2927: return @genlanguages;
1.117 www 2928: }
2929:
1.582 albertel 2930: sub languages {
2931: my ($possible_langs) = @_;
2932: my @preferred_langs = &preferred_languages();
2933: if (!ref($possible_langs)) {
2934: if( wantarray ) {
2935: return @preferred_langs;
2936: } else {
2937: return $preferred_langs[0];
2938: }
2939: }
2940: my %possibilities = map { $_ => 1 } (@$possible_langs);
2941: my @preferred_possibilities;
2942: foreach my $preferred_lang (@preferred_langs) {
2943: if (exists($possibilities{$preferred_lang})) {
2944: push(@preferred_possibilities, $preferred_lang);
2945: }
2946: }
2947: if( wantarray ) {
2948: return @preferred_possibilities;
2949: }
2950: return $preferred_possibilities[0];
2951: }
2952:
1.112 bowersj2 2953: ###############################################################
2954: ## Student Answer Attempts ##
2955: ###############################################################
2956:
2957: =pod
2958:
2959: =head1 Alternate Problem Views
2960:
2961: =over 4
2962:
2963: =item * get_previous_attempt($symb, $username, $domain, $course,
2964: $getattempt, $regexp, $gradesub)
2965:
2966: Return string with previous attempt on problem. Arguments:
2967:
2968: =over 4
2969:
2970: =item * $symb: Problem, including path
2971:
2972: =item * $username: username of the desired student
2973:
2974: =item * $domain: domain of the desired student
1.14 harris41 2975:
1.112 bowersj2 2976: =item * $course: Course ID
1.14 harris41 2977:
1.112 bowersj2 2978: =item * $getattempt: Leave blank for all attempts, otherwise put
2979: something
1.14 harris41 2980:
1.112 bowersj2 2981: =item * $regexp: if string matches this regexp, the string will be
2982: sent to $gradesub
1.14 harris41 2983:
1.112 bowersj2 2984: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 2985:
1.112 bowersj2 2986: =back
1.14 harris41 2987:
1.112 bowersj2 2988: The output string is a table containing all desired attempts, if any.
1.16 harris41 2989:
1.112 bowersj2 2990: =cut
1.1 albertel 2991:
2992: sub get_previous_attempt {
1.43 ng 2993: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 2994: my $prevattempts='';
1.43 ng 2995: no strict 'refs';
1.1 albertel 2996: if ($symb) {
1.3 albertel 2997: my (%returnhash)=
2998: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 2999: if ($returnhash{'version'}) {
3000: my %lasthash=();
3001: my $version;
3002: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3003: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3004: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3005: }
1.1 albertel 3006: }
1.596 albertel 3007: $prevattempts=&start_data_table().&start_data_table_header_row();
3008: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3009: foreach my $key (sort(keys(%lasthash))) {
3010: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3011: if ($#parts > 0) {
1.31 albertel 3012: my $data=$parts[-1];
3013: pop(@parts);
1.596 albertel 3014: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3015: } else {
1.41 ng 3016: if ($#parts == 0) {
3017: $prevattempts.='<th>'.$parts[0].'</th>';
3018: } else {
3019: $prevattempts.='<th>'.$ign.'</th>';
3020: }
1.31 albertel 3021: }
1.16 harris41 3022: }
1.596 albertel 3023: $prevattempts.=&end_data_table_header_row();
1.40 ng 3024: if ($getattempt eq '') {
3025: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3026: $prevattempts.=&start_data_table_row().
3027: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3028: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3029: my $value = &format_previous_attempt_value($key,
3030: $returnhash{$version.':'.$key});
3031: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3032: }
1.596 albertel 3033: $prevattempts.=&end_data_table_row();
1.40 ng 3034: }
1.1 albertel 3035: }
1.596 albertel 3036: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3037: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3038: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3039: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3040: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3041: }
1.596 albertel 3042: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3043: } else {
1.596 albertel 3044: $prevattempts=
3045: &start_data_table().&start_data_table_row().
3046: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3047: &end_data_table_row().&end_data_table();
1.1 albertel 3048: }
3049: } else {
1.596 albertel 3050: $prevattempts=
3051: &start_data_table().&start_data_table_row().
3052: '<td>'.&mt('No data.').'</td>'.
3053: &end_data_table_row().&end_data_table();
1.1 albertel 3054: }
1.10 albertel 3055: }
3056:
1.581 albertel 3057: sub format_previous_attempt_value {
3058: my ($key,$value) = @_;
3059: if ($key =~ /timestamp/) {
3060: $value = &Apache::lonlocal::locallocaltime($value);
3061: } elsif (ref($value) eq 'ARRAY') {
3062: $value = '('.join(', ', @{ $value }).')';
3063: } else {
3064: $value = &unescape($value);
3065: }
3066: return $value;
3067: }
3068:
3069:
1.107 albertel 3070: sub relative_to_absolute {
3071: my ($url,$output)=@_;
3072: my $parser=HTML::TokeParser->new(\$output);
3073: my $token;
3074: my $thisdir=$url;
3075: my @rlinks=();
3076: while ($token=$parser->get_token) {
3077: if ($token->[0] eq 'S') {
3078: if ($token->[1] eq 'a') {
3079: if ($token->[2]->{'href'}) {
3080: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3081: }
3082: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3083: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3084: } elsif ($token->[1] eq 'base') {
3085: $thisdir=$token->[2]->{'href'};
3086: }
3087: }
3088: }
3089: $thisdir=~s-/[^/]*$--;
1.356 albertel 3090: foreach my $link (@rlinks) {
3091: unless (($link=~/^http:\/\//i) ||
3092: ($link=~/^\//) ||
3093: ($link=~/^javascript:/i) ||
3094: ($link=~/^mailto:/i) ||
3095: ($link=~/^\#/)) {
3096: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3097: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3098: }
3099: }
3100: # -------------------------------------------------- Deal with Applet codebases
3101: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3102: return $output;
3103: }
3104:
1.112 bowersj2 3105: =pod
3106:
3107: =item * get_student_view
3108:
3109: show a snapshot of what student was looking at
3110:
3111: =cut
3112:
1.10 albertel 3113: sub get_student_view {
1.186 albertel 3114: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3115: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3116: my (%form);
1.10 albertel 3117: my @elements=('symb','courseid','domain','username');
3118: foreach my $element (@elements) {
1.186 albertel 3119: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3120: }
1.186 albertel 3121: if (defined($moreenv)) {
3122: %form=(%form,%{$moreenv});
3123: }
1.236 albertel 3124: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3125: $feedurl=&Apache::lonnet::clutter($feedurl);
1.186 albertel 3126: my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3127: $userview=~s/\<body[^\>]*\>//gi;
3128: $userview=~s/\<\/body\>//gi;
3129: $userview=~s/\<html\>//gi;
3130: $userview=~s/\<\/html\>//gi;
3131: $userview=~s/\<head\>//gi;
3132: $userview=~s/\<\/head\>//gi;
3133: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3134: $userview=&relative_to_absolute($feedurl,$userview);
1.11 albertel 3135: return $userview;
3136: }
3137:
1.112 bowersj2 3138: =pod
3139:
3140: =item * get_student_answers()
3141:
3142: show a snapshot of how student was answering problem
3143:
3144: =cut
3145:
1.11 albertel 3146: sub get_student_answers {
1.100 sakharuk 3147: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3148: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3149: my (%moreenv);
1.11 albertel 3150: my @elements=('symb','courseid','domain','username');
3151: foreach my $element (@elements) {
1.186 albertel 3152: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3153: }
1.186 albertel 3154: $moreenv{'grade_target'}='answer';
3155: %moreenv=(%form,%moreenv);
1.497 raeburn 3156: $feedurl = &Apache::lonnet::clutter($feedurl);
3157: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3158: return $userview;
1.1 albertel 3159: }
1.116 albertel 3160:
3161: =pod
3162:
3163: =item * &submlink()
3164:
1.242 albertel 3165: Inputs: $text $uname $udom $symb $target
1.116 albertel 3166:
3167: Returns: A link to grades.pm such as to see the SUBM view of a student
3168:
3169: =cut
3170:
3171: ###############################################
3172: sub submlink {
1.242 albertel 3173: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3174: if (!($uname && $udom)) {
3175: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3176: &Apache::lonnet::whichuser($symb);
1.116 albertel 3177: if (!$symb) { $symb=$cursymb; }
3178: }
1.254 matthew 3179: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3180: $symb=&escape($symb);
1.242 albertel 3181: if ($target) { $target="target=\"$target\""; }
3182: return '<a href="/adm/grades?&command=submission&'.
3183: 'symb='.$symb.'&student='.$uname.
3184: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3185: }
3186: ##############################################
3187:
3188: =pod
3189:
3190: =item * &pgrdlink()
3191:
3192: Inputs: $text $uname $udom $symb $target
3193:
3194: Returns: A link to grades.pm such as to see the PGRD view of a student
3195:
3196: =cut
3197:
3198: ###############################################
3199: sub pgrdlink {
3200: my $link=&submlink(@_);
3201: $link=~s/(&command=submission)/$1&showgrading=yes/;
3202: return $link;
3203: }
3204: ##############################################
3205:
3206: =pod
3207:
3208: =item * &pprmlink()
3209:
3210: Inputs: $text $uname $udom $symb $target
3211:
3212: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3213: student and a specific resource
1.242 albertel 3214:
3215: =cut
3216:
3217: ###############################################
3218: sub pprmlink {
3219: my ($text,$uname,$udom,$symb,$target)=@_;
3220: if (!($uname && $udom)) {
3221: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3222: &Apache::lonnet::whichuser($symb);
1.242 albertel 3223: if (!$symb) { $symb=$cursymb; }
3224: }
1.254 matthew 3225: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3226: $symb=&escape($symb);
1.242 albertel 3227: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3228: return '<a href="/adm/parmset?command=set&'.
3229: 'symb='.$symb.'&uname='.$uname.
3230: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3231: }
3232: ##############################################
1.37 matthew 3233:
1.112 bowersj2 3234: =pod
3235:
3236: =back
3237:
3238: =cut
3239:
1.37 matthew 3240: ###############################################
1.51 www 3241:
3242:
3243: sub timehash {
3244: my @ltime=localtime(shift);
3245: return ( 'seconds' => $ltime[0],
3246: 'minutes' => $ltime[1],
3247: 'hours' => $ltime[2],
3248: 'day' => $ltime[3],
3249: 'month' => $ltime[4]+1,
3250: 'year' => $ltime[5]+1900,
3251: 'weekday' => $ltime[6],
3252: 'dayyear' => $ltime[7]+1,
3253: 'dlsav' => $ltime[8] );
3254: }
3255:
1.370 www 3256: sub utc_string {
3257: my ($date)=@_;
1.371 www 3258: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3259: }
3260:
1.51 www 3261: sub maketime {
3262: my %th=@_;
3263: return POSIX::mktime(
3264: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3265: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3266: }
3267:
3268: #########################################
1.51 www 3269:
3270: sub findallcourses {
1.482 raeburn 3271: my ($roles,$uname,$udom) = @_;
1.355 albertel 3272: my %roles;
3273: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3274: my %courses;
1.51 www 3275: my $now=time;
1.482 raeburn 3276: if (!defined($uname)) {
3277: $uname = $env{'user.name'};
3278: }
3279: if (!defined($udom)) {
3280: $udom = $env{'user.domain'};
3281: }
3282: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3283: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3284: if (!%roles) {
3285: %roles = (
3286: cc => 1,
3287: in => 1,
3288: ep => 1,
3289: ta => 1,
3290: cr => 1,
3291: st => 1,
3292: );
3293: }
3294: foreach my $entry (keys(%roleshash)) {
3295: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3296: if ($trole =~ /^cr/) {
3297: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3298: } else {
3299: next if (!exists($roles{$trole}));
3300: }
3301: if ($tend) {
3302: next if ($tend < $now);
3303: }
3304: if ($tstart) {
3305: next if ($tstart > $now);
3306: }
3307: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3308: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3309: if ($secpart eq '') {
3310: ($cnum,$role) = split(/_/,$cnumpart);
3311: $sec = 'none';
3312: $realsec = '';
3313: } else {
3314: $cnum = $cnumpart;
3315: ($sec,$role) = split(/_/,$secpart);
3316: $realsec = $sec;
1.490 raeburn 3317: }
1.482 raeburn 3318: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3319: }
3320: } else {
3321: foreach my $key (keys(%env)) {
1.483 albertel 3322: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3323: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3324: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3325: next if ($role eq 'ca' || $role eq 'aa');
3326: next if (%roles && !exists($roles{$role}));
3327: my ($starttime,$endtime)=split(/\./,$env{$key});
3328: my $active=1;
3329: if ($starttime) {
3330: if ($now<$starttime) { $active=0; }
3331: }
3332: if ($endtime) {
3333: if ($now>$endtime) { $active=0; }
3334: }
3335: if ($active) {
3336: if ($sec eq '') {
3337: $sec = 'none';
3338: }
3339: $courses{$cdom.'_'.$cnum}{$sec} =
3340: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3341: }
3342: }
1.51 www 3343: }
3344: }
1.474 raeburn 3345: return %courses;
1.51 www 3346: }
1.37 matthew 3347:
1.54 www 3348: ###############################################
1.474 raeburn 3349:
3350: sub blockcheck {
1.482 raeburn 3351: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3352:
3353: if (!defined($udom)) {
3354: $udom = $env{'user.domain'};
3355: }
3356: if (!defined($uname)) {
3357: $uname = $env{'user.name'};
3358: }
3359:
3360: # If uname and udom are for a course, check for blocks in the course.
3361:
3362: if (&Apache::lonnet::is_course($udom,$uname)) {
3363: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3364: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3365: return ($startblock,$endblock);
3366: }
1.474 raeburn 3367:
1.502 raeburn 3368: my $startblock = 0;
3369: my $endblock = 0;
1.482 raeburn 3370: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3371:
1.490 raeburn 3372: # If uname is for a user, and activity is course-specific, i.e.,
3373: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3374:
1.490 raeburn 3375: if (($activity eq 'boards' || $activity eq 'chat' ||
3376: $activity eq 'groups') && ($env{'request.course.id'})) {
3377: foreach my $key (keys(%live_courses)) {
3378: if ($key ne $env{'request.course.id'}) {
3379: delete($live_courses{$key});
3380: }
3381: }
3382: }
3383:
3384: my $otheruser = 0;
3385: my %own_courses;
3386: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3387: # Resource belongs to user other than current user.
3388: $otheruser = 1;
3389: # Gather courses for current user
3390: %own_courses =
3391: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3392: }
3393:
3394: # Gather active course roles - course coordinator, instructor,
3395: # exam proctor, ta, student, or custom role.
1.474 raeburn 3396:
3397: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3398: my ($cdom,$cnum);
3399: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3400: $cdom = $env{'course.'.$course.'.domain'};
3401: $cnum = $env{'course.'.$course.'.num'};
3402: } else {
1.490 raeburn 3403: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3404: }
3405: my $no_ownblock = 0;
3406: my $no_userblock = 0;
1.533 raeburn 3407: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3408: # Check if current user has 'evb' priv for this
3409: if (defined($own_courses{$course})) {
3410: foreach my $sec (keys(%{$own_courses{$course}})) {
3411: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3412: if ($sec ne 'none') {
3413: $checkrole .= '/'.$sec;
3414: }
3415: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3416: $no_ownblock = 1;
3417: last;
3418: }
3419: }
3420: }
3421: # if they have 'evb' priv and are currently not playing student
3422: next if (($no_ownblock) &&
3423: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3424: }
1.474 raeburn 3425: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3426: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3427: if ($sec ne 'none') {
1.482 raeburn 3428: $checkrole .= '/'.$sec;
1.474 raeburn 3429: }
1.490 raeburn 3430: if ($otheruser) {
3431: # Resource belongs to user other than current user.
3432: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3433: my ($trole,$tdom,$tnum,$tsec);
3434: my $entry = $live_courses{$course}{$sec};
3435: if ($entry =~ /^cr/) {
3436: ($trole,$tdom,$tnum,$tsec) =
3437: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3438: } else {
3439: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3440: }
3441: my ($spec,$area,$trest,%allroles,%userroles);
3442: $area = '/'.$tdom.'/'.$tnum;
3443: $trest = $tnum;
3444: if ($tsec ne '') {
3445: $area .= '/'.$tsec;
3446: $trest .= '/'.$tsec;
3447: }
3448: $spec = $trole.'.'.$area;
3449: if ($trole =~ /^cr/) {
3450: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3451: $tdom,$spec,$trest,$area);
3452: } else {
3453: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3454: $tdom,$spec,$trest,$area);
3455: }
3456: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3457: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3458: if ($1) {
3459: $no_userblock = 1;
3460: last;
3461: }
3462: }
1.490 raeburn 3463: } else {
3464: # Resource belongs to current user
3465: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3466: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3467: $no_ownblock = 1;
3468: last;
3469: }
1.474 raeburn 3470: }
3471: }
3472: # if they have the evb priv and are currently not playing student
1.482 raeburn 3473: next if (($no_ownblock) &&
1.491 albertel 3474: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3475: next if ($no_userblock);
1.474 raeburn 3476:
1.490 raeburn 3477: # Retrieve blocking times and identity of blocker for course
3478: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3479:
3480: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3481: if (($start != 0) &&
3482: (($startblock == 0) || ($startblock > $start))) {
3483: $startblock = $start;
3484: }
3485: if (($end != 0) &&
3486: (($endblock == 0) || ($endblock < $end))) {
3487: $endblock = $end;
3488: }
1.490 raeburn 3489: }
3490: return ($startblock,$endblock);
3491: }
3492:
3493: sub get_blocks {
3494: my ($setters,$activity,$cdom,$cnum) = @_;
3495: my $startblock = 0;
3496: my $endblock = 0;
3497: my $course = $cdom.'_'.$cnum;
3498: $setters->{$course} = {};
3499: $setters->{$course}{'staff'} = [];
3500: $setters->{$course}{'times'} = [];
3501: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3502: foreach my $record (keys(%records)) {
3503: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3504: if ($start <= time && $end >= time) {
3505: my ($staff_name,$staff_dom,$title,$blocks) =
3506: &parse_block_record($records{$record});
3507: if ($blocks->{$activity} eq 'on') {
3508: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3509: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3510: if ( ($startblock == 0) || ($startblock > $start) ) {
3511: $startblock = $start;
1.490 raeburn 3512: }
1.491 albertel 3513: if ( ($endblock == 0) || ($endblock < $end) ) {
3514: $endblock = $end;
1.474 raeburn 3515: }
3516: }
3517: }
3518: }
3519: return ($startblock,$endblock);
3520: }
3521:
3522: sub parse_block_record {
3523: my ($record) = @_;
3524: my ($setuname,$setudom,$title,$blocks);
3525: if (ref($record) eq 'HASH') {
3526: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3527: $title = &unescape($record->{'event'});
3528: $blocks = $record->{'blocks'};
3529: } else {
3530: my @data = split(/:/,$record,3);
3531: if (scalar(@data) eq 2) {
3532: $title = $data[1];
3533: ($setuname,$setudom) = split(/@/,$data[0]);
3534: } else {
3535: ($setuname,$setudom,$title) = @data;
3536: }
3537: $blocks = { 'com' => 'on' };
3538: }
3539: return ($setuname,$setudom,$title,$blocks);
3540: }
3541:
3542: sub build_block_table {
3543: my ($startblock,$endblock,$setters) = @_;
3544: my %lt = &Apache::lonlocal::texthash(
3545: 'cacb' => 'Currently active communication blocks',
3546: 'cour' => 'Course',
3547: 'dura' => 'Duration',
3548: 'blse' => 'Block set by'
3549: );
3550: my $output;
1.476 raeburn 3551: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 3552: $output .= &start_data_table();
3553: $output .= '
3554: <tr>
3555: <th>'.$lt{'cour'}.'</th>
3556: <th>'.$lt{'dura'}.'</th>
3557: <th>'.$lt{'blse'}.'</th>
3558: </tr>
3559: ';
3560: foreach my $course (keys(%{$setters})) {
3561: my %courseinfo=&Apache::lonnet::coursedescription($course);
3562: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
3563: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 3564: my $fullname = &plainname($uname,$udom);
3565: if (defined($env{'user.name'}) && defined($env{'user.domain'})
3566: && $env{'user.name'} ne 'public'
3567: && $env{'user.domain'} ne 'public') {
3568: $fullname = &aboutmewrapper($fullname,$uname,$udom);
3569: }
1.474 raeburn 3570: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
3571: $openblock = &Apache::lonlocal::locallocaltime($openblock);
3572: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
3573: $output .= &Apache::loncommon::start_data_table_row().
3574: '<td>'.$courseinfo{'description'}.'</td>'.
3575: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 3576: '<td>'.$fullname.'</td>'.
1.474 raeburn 3577: &Apache::loncommon::end_data_table_row();
3578: }
3579: }
3580: $output .= &end_data_table();
3581: }
3582:
1.490 raeburn 3583: sub blocking_status {
3584: my ($activity,$uname,$udom) = @_;
3585: my %setters;
3586: my ($blocked,$output,$ownitem,$is_course);
3587: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
3588: if ($startblock && $endblock) {
3589: $blocked = 1;
3590: if (wantarray) {
3591: my $category;
3592: if ($activity eq 'boards') {
3593: $category = 'Discussion posts in this course';
3594: } elsif ($activity eq 'blogs') {
3595: $category = 'Blogs';
3596: } elsif ($activity eq 'port') {
3597: if (defined($uname) && defined($udom)) {
3598: if ($uname eq $env{'user.name'} &&
3599: $udom eq $env{'user.domain'}) {
3600: $ownitem = 1;
3601: }
3602: }
3603: $is_course = &Apache::lonnet::is_course($udom,$uname);
3604: if ($ownitem) {
3605: $category = 'Your portfolio files';
3606: } elsif ($is_course) {
3607: my $coursedesc;
3608: foreach my $course (keys(%setters)) {
3609: my %courseinfo =
3610: &Apache::lonnet::coursedescription($course);
3611: $coursedesc = $courseinfo{'description'};
3612: }
3613: $category = "Group files in the course '$coursedesc'";
3614: } else {
3615: $category = 'Portfolio files belonging to ';
3616: if ($env{'user.name'} eq 'public' &&
3617: $env{'user.domain'} eq 'public') {
3618: $category .= &plainname($uname,$udom);
3619: } else {
3620: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
3621: }
3622: }
3623: } elsif ($activity eq 'groups') {
3624: $category = 'Groups in this course';
3625: }
3626: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
3627: my $showend = &Apache::lonlocal::locallocaltime($endblock);
3628: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
3629: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
3630: $output .= &build_block_table($startblock,$endblock,\%setters);
3631: }
3632: }
3633: }
3634: if (wantarray) {
3635: return ($blocked,$output);
3636: } else {
3637: return $blocked;
3638: }
3639: }
3640:
1.60 matthew 3641: ###############################################
3642:
3643: =pod
3644:
1.112 bowersj2 3645: =head1 Domain Template Functions
3646:
3647: =over 4
3648:
3649: =item * &determinedomain()
1.60 matthew 3650:
3651: Inputs: $domain (usually will be undef)
3652:
1.63 www 3653: Returns: Determines which domain should be used for designs
1.60 matthew 3654:
3655: =cut
1.54 www 3656:
1.60 matthew 3657: ###############################################
1.63 www 3658: sub determinedomain {
3659: my $domain=shift;
1.531 albertel 3660: if (! $domain) {
1.60 matthew 3661: # Determine domain if we have not been given one
3662: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258 albertel 3663: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
3664: if ($env{'request.role.domain'}) {
3665: $domain=$env{'request.role.domain'};
1.60 matthew 3666: }
3667: }
1.63 www 3668: return $domain;
3669: }
3670: ###############################################
1.517 raeburn 3671:
1.518 albertel 3672: sub devalidate_domconfig_cache {
3673: my ($udom)=@_;
3674: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
3675: }
3676:
3677: # ---------------------- Get domain configuration for a domain
3678: sub get_domainconf {
3679: my ($udom) = @_;
3680: my $cachetime=1800;
3681: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
3682: if (defined($cached)) { return %{$result}; }
3683:
3684: my %domconfig = &Apache::lonnet::get_dom('configuration',
3685: ['login','rolecolors'],$udom);
1.632 raeburn 3686: my (%designhash,%legacy);
1.518 albertel 3687: if (keys(%domconfig) > 0) {
3688: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 3689: if (keys(%{$domconfig{'login'}})) {
3690: foreach my $key (keys(%{$domconfig{'login'}})) {
3691: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
3692: }
3693: } else {
3694: $legacy{'login'} = 1;
1.518 albertel 3695: }
1.632 raeburn 3696: } else {
3697: $legacy{'login'} = 1;
1.518 albertel 3698: }
3699: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 3700: if (keys(%{$domconfig{'rolecolors'}})) {
3701: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
3702: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
3703: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
3704: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
3705: }
1.518 albertel 3706: }
3707: }
1.632 raeburn 3708: } else {
3709: $legacy{'rolecolors'} = 1;
1.518 albertel 3710: }
1.632 raeburn 3711: } else {
3712: $legacy{'rolecolors'} = 1;
1.518 albertel 3713: }
1.632 raeburn 3714: if (keys(%legacy) > 0) {
3715: my %legacyhash = &get_legacy_domconf($udom);
3716: foreach my $item (keys(%legacyhash)) {
3717: if ($item =~ /^\Q$udom\E\.login/) {
3718: if ($legacy{'login'}) {
3719: $designhash{$item} = $legacyhash{$item};
3720: }
3721: } else {
3722: if ($legacy{'rolecolors'}) {
3723: $designhash{$item} = $legacyhash{$item};
3724: }
1.518 albertel 3725: }
3726: }
3727: }
1.632 raeburn 3728: } else {
3729: %designhash = &get_legacy_domconf($udom);
1.518 albertel 3730: }
3731: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
3732: $cachetime);
3733: return %designhash;
3734: }
3735:
1.632 raeburn 3736: sub get_legacy_domconf {
3737: my ($udom) = @_;
3738: my %legacyhash;
3739: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
3740: my $designfile = $designdir.'/'.$udom.'.tab';
3741: if (-e $designfile) {
3742: if ( open (my $fh,"<$designfile") ) {
3743: while (my $line = <$fh>) {
3744: next if ($line =~ /^\#/);
3745: chomp($line);
3746: my ($key,$val)=(split(/\=/,$line));
3747: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
3748: }
3749: close($fh);
3750: }
3751: }
3752: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
3753: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
3754: }
3755: return %legacyhash;
3756: }
3757:
1.63 www 3758: =pod
3759:
1.112 bowersj2 3760: =item * &domainlogo()
1.63 www 3761:
3762: Inputs: $domain (usually will be undef)
3763:
3764: Returns: A link to a domain logo, if the domain logo exists.
3765: If the domain logo does not exist, a description of the domain.
3766:
3767: =cut
1.112 bowersj2 3768:
1.63 www 3769: ###############################################
3770: sub domainlogo {
1.517 raeburn 3771: my $domain = &determinedomain(shift);
1.518 albertel 3772: my %designhash = &get_domainconf($domain);
1.517 raeburn 3773: # See if there is a logo
3774: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 3775: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 3776: if ($imgsrc =~ m{^/(adm|res)/}) {
3777: if ($imgsrc =~ m{^/res/}) {
3778: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
3779: &Apache::lonnet::repcopy($local_name);
3780: }
3781: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 3782: }
3783: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 3784: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
3785: return &Apache::lonnet::domain($domain,'description');
1.59 www 3786: } else {
1.60 matthew 3787: return '';
1.59 www 3788: }
3789: }
1.63 www 3790: ##############################################
3791:
3792: =pod
3793:
1.112 bowersj2 3794: =item * &designparm()
1.63 www 3795:
3796: Inputs: $which parameter; $domain (usually will be undef)
3797:
3798: Returns: value of designparamter $which
3799:
3800: =cut
1.112 bowersj2 3801:
1.397 albertel 3802:
1.400 albertel 3803: ##############################################
1.397 albertel 3804: sub designparm {
3805: my ($which,$domain)=@_;
1.258 albertel 3806: if ($env{'browser.blackwhite'} eq 'on') {
1.635 raeburn 3807: if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110 www 3808: return '#000000';
3809: }
1.635 raeburn 3810: if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110 www 3811: return '#FFFFFF';
3812: }
3813: if ($which=~/\.tabbg$/) {
3814: return '#CCCCCC';
3815: }
3816: }
1.397 albertel 3817: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 3818: return $env{'environment.color.'.$which};
1.96 www 3819: }
1.63 www 3820: $domain=&determinedomain($domain);
1.518 albertel 3821: my %domdesign = &get_domainconf($domain);
1.520 raeburn 3822: my $output;
1.517 raeburn 3823: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 3824: $output = $domdesign{$domain.'.'.$which};
1.63 www 3825: } else {
1.520 raeburn 3826: $output = $defaultdesign{$which};
3827: }
3828: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 3829: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 3830: if ($output =~ m{^/(adm|res)/}) {
3831: if ($output =~ m{^/res/}) {
3832: my $local_name = &Apache::lonnet::filelocation('',$output);
3833: &Apache::lonnet::repcopy($local_name);
3834: }
1.520 raeburn 3835: $output = &lonhttpdurl($output);
3836: }
1.63 www 3837: }
1.520 raeburn 3838: return $output;
1.63 www 3839: }
1.59 www 3840:
1.60 matthew 3841: ###############################################
3842: ###############################################
3843:
3844: =pod
3845:
1.112 bowersj2 3846: =back
3847:
1.549 albertel 3848: =head1 HTML Helpers
1.112 bowersj2 3849:
3850: =over 4
3851:
3852: =item * &bodytag()
1.60 matthew 3853:
3854: Returns a uniform header for LON-CAPA web pages.
3855:
3856: Inputs:
3857:
1.112 bowersj2 3858: =over 4
3859:
3860: =item * $title, A title to be displayed on the page.
3861:
3862: =item * $function, the current role (can be undef).
3863:
3864: =item * $addentries, extra parameters for the <body> tag.
3865:
3866: =item * $bodyonly, if defined, only return the <body> tag.
3867:
3868: =item * $domain, if defined, force a given domain.
3869:
3870: =item * $forcereg, if page should register as content page (relevant for
1.86 www 3871: text interface only)
1.60 matthew 3872:
1.326 albertel 3873: =item * $customtitle, alternate text to use instead of $title
3874: in the title box that appears, this text
3875: is not auto translated like the $title is
1.309 albertel 3876:
3877: =item * $notopbar, if true, keep the 'what is this' info but remove the
3878: navigational links
1.317 albertel 3879:
1.338 albertel 3880: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
3881:
3882: =item * $notitle, if true keep the nav controls, but remove the title bar
3883:
1.361 albertel 3884: =item * $no_inline_link, if true and in remote mode, don't show the
3885: 'Switch To Inline Menu' link
3886:
1.460 albertel 3887: =item * $args, optional argument valid values are
3888: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 3889: inherit_jsmath -> when creating popup window in a page,
3890: should it have jsmath forced on by the
3891: current page
1.460 albertel 3892:
1.112 bowersj2 3893: =back
3894:
1.60 matthew 3895: Returns: A uniform header for LON-CAPA web pages.
3896: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
3897: If $bodyonly is undef or zero, an html string containing a <body> tag and
3898: other decorations will be returned.
3899:
3900: =cut
3901:
1.54 www 3902: sub bodytag {
1.309 albertel 3903: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 3904: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 3905:
1.460 albertel 3906: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 3907:
1.183 matthew 3908: $function = &get_users_function() if (!$function);
1.339 albertel 3909: my $img = &designparm($function.'.img',$domain);
3910: my $font = &designparm($function.'.font',$domain);
3911: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
3912:
3913: my %design = ( 'style' => 'margin-top: 0px',
1.535 albertel 3914: 'bgcolor' => $pgbg,
1.339 albertel 3915: 'text' => $font,
3916: 'alink' => &designparm($function.'.alink',$domain),
3917: 'vlink' => &designparm($function.'.vlink',$domain),
3918: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 3919: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 3920:
1.63 www 3921: # role and realm
1.378 raeburn 3922: my ($role,$realm) = split(/\./,$env{'request.role'},2);
3923: if ($role eq 'ca') {
1.479 albertel 3924: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 3925: $realm = &plainname($rname,$rdom);
1.378 raeburn 3926: }
1.55 www 3927: # realm
1.258 albertel 3928: if ($env{'request.course.id'}) {
1.378 raeburn 3929: if ($env{'request.role'} !~ /^cr/) {
3930: $role = &Apache::lonnet::plaintext($role,&course_type());
3931: }
1.359 albertel 3932: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 3933: } else {
3934: $role = &Apache::lonnet::plaintext($role);
1.54 www 3935: }
1.433 albertel 3936:
1.359 albertel 3937: if (!$realm) { $realm=' '; }
1.55 www 3938: # Set messages
1.60 matthew 3939: my $messages=&domainlogo($domain);
1.330 albertel 3940:
1.438 albertel 3941: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 3942:
1.101 www 3943: # construct main body tag
1.359 albertel 3944: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 3945: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 3946:
1.530 albertel 3947: if ($bodyonly) {
1.60 matthew 3948: return $bodytag;
1.258 albertel 3949: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 3950: # Accessibility
1.224 raeburn 3951:
1.337 albertel 3952: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 3953: if (!$notitle) {
1.337 albertel 3954: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
3955: }
3956: return $bodytag;
1.359 albertel 3957: }
3958:
1.410 albertel 3959: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 3960: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
3961: undef($role);
1.434 albertel 3962: } else {
3963: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 3964: }
1.359 albertel 3965:
3966: my $roleinfo=(<<ENDROLE);
3967: <td class="LC_title_bar_who">
3968: <div class="LC_title_bar_name">
1.410 albertel 3969: $name
1.361 albertel 3970:
1.359 albertel 3971: </div>
3972: <div class="LC_title_bar_role">
1.361 albertel 3973: $role
1.359 albertel 3974: </div>
3975: <div class="LC_title_bar_realm">
1.361 albertel 3976: $realm
1.359 albertel 3977: </div>
1.206 albertel 3978: </td>
3979: ENDROLE
1.235 raeburn 3980:
1.359 albertel 3981: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
3982: if ($customtitle) {
3983: $titleinfo = $customtitle;
3984: }
3985: #
3986: # Extra info if you are the DC
3987: my $dc_info = '';
3988: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
3989: $env{'course.'.$env{'request.course.id'}.
3990: '.domain'}.'/'})) {
3991: my $cid = $env{'request.course.id'};
3992: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 3993: $dc_info =~ s/\s+$//;
1.359 albertel 3994: $dc_info = '('.$dc_info.')';
3995: }
3996:
1.644 www 3997: if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
1.359 albertel 3998: # No Remote
1.258 albertel 3999: if ($env{'request.state'} eq 'construct') {
1.359 albertel 4000: $forcereg=1;
4001: }
4002:
4003: if (!$customtitle && $env{'request.state'} eq 'construct') {
4004: # this is for resources; directories have customtitle, and crumbs
4005: # and select recent are created in lonpubdir.pm
1.229 albertel 4006: my ($uname,$thisdisfn)=
1.258 albertel 4007: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 4008: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4009: $formaction=~s/\/+/\//g;
4010:
1.359 albertel 4011: my $parentpath = '';
4012: my $lastitem = '';
4013: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4014: $parentpath = $1;
4015: $lastitem = $2;
4016: } else {
4017: $lastitem = $thisdisfn;
4018: }
4019: $titleinfo =
1.640 bisitz 4020: &Apache::loncommon::help_open_menu('','',3,'Authoring')
4021: .'<b>'.&mt('Construction Space').'</b>: '
4022: .'<form name="dirs" method="post" action="'.$formaction
1.359 albertel 4023: .'" target="_top"><tt><b>'
4024: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
4025: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4026: .'</form>'
4027: .&Apache::lonmenu::constspaceform();
1.235 raeburn 4028: }
1.359 albertel 4029:
1.337 albertel 4030: my $titletable;
1.338 albertel 4031: if (!$notitle) {
1.337 albertel 4032: $titletable =
1.359 albertel 4033: '<table id="LC_title_bar">'.
4034: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
4035: '</tr></table>';
1.337 albertel 4036: }
1.359 albertel 4037: if ($notopbar) {
4038: $bodytag .= $titletable;
4039: } else {
4040: if ($env{'request.state'} eq 'construct') {
1.337 albertel 4041: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
4042: $titletable);
1.272 raeburn 4043: } else {
1.336 albertel 4044: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 4045: $titletable;
1.272 raeburn 4046: }
1.235 raeburn 4047: }
4048: return $bodytag;
1.94 www 4049: }
1.95 www 4050:
1.93 www 4051: #
1.95 www 4052: # Top frame rendering, Remote is up
1.93 www 4053: #
1.359 albertel 4054:
1.517 raeburn 4055: my $imgsrc = $img;
4056: if ($img =~ /^\/adm/) {
1.575 albertel 4057: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4058: }
4059: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4060:
1.305 www 4061: # Explicit link to get inline menu
1.361 albertel 4062: my $menu= ($no_inline_link?''
4063: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 4064: #
1.338 albertel 4065: if ($notitle) {
1.337 albertel 4066: return $bodytag;
4067: }
1.94 www 4068: return(<<ENDBODY);
1.60 matthew 4069: $bodytag
1.359 albertel 4070: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4071: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4072: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4073: </tr>
1.359 albertel 4074: <tr><td>$titleinfo $dc_info $menu</td>
4075: $roleinfo
1.368 albertel 4076: </tr>
1.356 albertel 4077: </table>
1.54 www 4078: ENDBODY
1.182 matthew 4079: }
4080:
1.330 albertel 4081: sub make_attr_string {
4082: my ($register,$attr_ref) = @_;
4083:
4084: if ($attr_ref && !ref($attr_ref)) {
4085: die("addentries Must be a hash ref ".
4086: join(':',caller(1))." ".
4087: join(':',caller(0))." ");
4088: }
4089:
4090: if ($register) {
1.339 albertel 4091: my ($on_load,$on_unload);
4092: foreach my $key (keys(%{$attr_ref})) {
4093: if (lc($key) eq 'onload') {
4094: $on_load.=$attr_ref->{$key}.';';
4095: delete($attr_ref->{$key});
4096:
4097: } elsif (lc($key) eq 'onunload') {
4098: $on_unload.=$attr_ref->{$key}.';';
4099: delete($attr_ref->{$key});
4100: }
4101: }
4102: $attr_ref->{'onload'} =
4103: &Apache::lonmenu::loadevents(). $on_load;
4104: $attr_ref->{'onunload'}=
4105: &Apache::lonmenu::unloadevents().$on_unload;
4106: }
4107:
4108: # Accessibility font enhance
4109: if ($env{'browser.fontenhance'} eq 'on') {
4110: my $style;
4111: foreach my $key (keys(%{$attr_ref})) {
4112: if (lc($key) eq 'style') {
4113: $style.=$attr_ref->{$key}.';';
4114: delete($attr_ref->{$key});
4115: }
4116: }
4117: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4118: }
1.339 albertel 4119:
4120: if ($env{'browser.blackwhite'} eq 'on') {
4121: delete($attr_ref->{'font'});
4122: delete($attr_ref->{'link'});
4123: delete($attr_ref->{'alink'});
4124: delete($attr_ref->{'vlink'});
4125: delete($attr_ref->{'bgcolor'});
4126: delete($attr_ref->{'background'});
4127: }
4128:
1.330 albertel 4129: my $attr_string;
4130: foreach my $attr (keys(%$attr_ref)) {
4131: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4132: }
4133: return $attr_string;
4134: }
4135:
4136:
1.182 matthew 4137: ###############################################
1.251 albertel 4138: ###############################################
4139:
4140: =pod
4141:
4142: =item * &endbodytag()
4143:
4144: Returns a uniform footer for LON-CAPA web pages.
4145:
1.635 raeburn 4146: Inputs: 1 - optional reference to an args hash
4147: If in the hash, key for noredirectlink has a value which evaluates to true,
4148: a 'Continue' link is not displayed if the page contains an
4149: internal redirect in the <head></head> section,
4150: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4151:
4152: =cut
4153:
4154: sub endbodytag {
1.635 raeburn 4155: my ($args) = @_;
1.251 albertel 4156: my $endbodytag='</body>';
1.269 albertel 4157: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4158: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4159: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4160: $endbodytag=
4161: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4162: &mt('Continue').'</a>'.
4163: $endbodytag;
4164: }
1.315 albertel 4165: }
1.251 albertel 4166: return $endbodytag;
4167: }
4168:
1.352 albertel 4169: =pod
4170:
4171: =item * &standard_css()
4172:
4173: Returns a style sheet
4174:
4175: Inputs: (all optional)
4176: domain -> force to color decorate a page for a specific
4177: domain
4178: function -> force usage of a specific rolish color scheme
4179: bgcolor -> override the default page bgcolor
4180:
4181: =cut
4182:
1.343 albertel 4183: sub standard_css {
1.345 albertel 4184: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4185: $function = &get_users_function() if (!$function);
4186: my $img = &designparm($function.'.img', $domain);
4187: my $tabbg = &designparm($function.'.tabbg', $domain);
4188: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4189: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4190: my $pgbg_or_bgcolor =
4191: $bgcolor ||
1.352 albertel 4192: &designparm($function.'.pgbg', $domain);
1.382 albertel 4193: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4194: my $alink = &designparm($function.'.alink', $domain);
4195: my $vlink = &designparm($function.'.vlink', $domain);
4196: my $link = &designparm($function.'.link', $domain);
4197:
1.602 albertel 4198: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4199: my $mono = 'monospace';
1.352 albertel 4200: my $data_table_head = $tabbg;
4201: my $data_table_light = '#EEEEEE';
1.470 banghart 4202: my $data_table_dark = '#DDDDDD';
4203: my $data_table_darker = '#CCCCCC';
1.349 albertel 4204: my $data_table_highlight = '#FFFF00';
1.352 albertel 4205: my $mail_new = '#FFBB77';
4206: my $mail_new_hover = '#DD9955';
4207: my $mail_read = '#BBBB77';
4208: my $mail_read_hover = '#999944';
4209: my $mail_replied = '#AAAA88';
4210: my $mail_replied_hover = '#888855';
4211: my $mail_other = '#99BBBB';
4212: my $mail_other_hover = '#669999';
1.391 albertel 4213: my $table_header = '#DDDDDD';
1.489 raeburn 4214: my $feedback_link_bg = '#BBBBBB';
1.392 albertel 4215:
1.608 albertel 4216: my $border = ($env{'browser.type'} eq 'explorer' ||
4217: $env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px'
4218: : '0px 3px 0px 4px';
1.448 albertel 4219:
1.523 albertel 4220:
1.343 albertel 4221: return <<END;
1.345 albertel 4222: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4223: a:focus { color: red; background: yellow }
1.510 albertel 4224: table.thinborder,
1.523 albertel 4225:
1.510 albertel 4226: table.thinborder tr th {
4227: border-style: solid;
4228: border-width: 1px;
4229: background: $tabbg;
4230: }
1.523 albertel 4231: table.thinborder tr td {
1.510 albertel 4232: border-style: solid;
4233: border-width: 1px
4234: }
1.426 albertel 4235:
1.343 albertel 4236: form, .inline { display: inline; }
4237: .center { text-align: center; }
1.593 albertel 4238: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4239: .LC_error {
4240: color: red;
4241: font-size: larger;
4242: }
1.457 albertel 4243: .LC_warning,
4244: .LC_diff_removed {
1.394 albertel 4245: color: red;
4246: }
1.532 albertel 4247:
4248: .LC_info,
1.457 albertel 4249: .LC_success,
4250: .LC_diff_added {
1.350 albertel 4251: color: green;
4252: }
1.543 albertel 4253: .LC_unknown {
4254: color: yellow;
4255: }
4256:
1.440 albertel 4257: .LC_icon {
4258: border: 0px;
4259: }
1.539 albertel 4260: .LC_indexer_icon {
4261: border: 0px;
4262: height: 22px;
4263: }
1.543 albertel 4264: .LC_docs_spacer {
4265: width: 25px;
4266: height: 1px;
4267: border: 0px;
4268: }
1.346 albertel 4269:
1.532 albertel 4270: .LC_internal_info {
4271: color: #999;
4272: }
4273:
1.458 albertel 4274: table.LC_pastsubmission {
4275: border: 1px solid black;
4276: margin: 2px;
4277: }
4278:
1.606 albertel 4279: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4280: width: 100%;
4281: background: $pgbg;
1.392 albertel 4282: border: 2px;
1.402 albertel 4283: border-collapse: separate;
1.403 albertel 4284: padding: 0px;
1.345 albertel 4285: }
1.392 albertel 4286:
1.606 albertel 4287: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4288: table#LC_title_bar.LC_with_remote {
1.359 albertel 4289: width: 100%;
1.392 albertel 4290: border-color: $pgbg;
4291: border-style: solid;
4292: border-width: $border;
4293:
1.379 albertel 4294: background: $pgbg;
4295: font-family: $sans;
1.392 albertel 4296: border-collapse: collapse;
1.403 albertel 4297: padding: 0px;
1.359 albertel 4298: }
1.392 albertel 4299:
1.409 albertel 4300: table.LC_docs_path {
4301: width: 100%;
4302: border: 0;
4303: background: $pgbg;
4304: font-family: $sans;
4305: border-collapse: collapse;
4306: padding: 0px;
4307: }
4308:
1.359 albertel 4309: table#LC_title_bar td {
4310: background: $tabbg;
4311: }
4312: table#LC_title_bar td.LC_title_bar_who {
4313: background: $tabbg;
4314: color: $font;
1.427 albertel 4315: font: small $sans;
1.359 albertel 4316: text-align: right;
4317: }
1.469 banghart 4318: span.LC_metadata {
4319: font-family: $sans;
4320: }
1.359 albertel 4321: span.LC_title_bar_title {
1.416 albertel 4322: font: bold x-large $sans;
1.359 albertel 4323: }
4324: table#LC_title_bar td.LC_title_bar_domain_logo {
4325: background: $sidebg;
4326: text-align: right;
1.368 albertel 4327: padding: 0px;
4328: }
4329: table#LC_title_bar td.LC_title_bar_role_logo {
4330: background: $sidebg;
4331: padding: 0px;
1.359 albertel 4332: }
4333:
1.346 albertel 4334: table#LC_menubuttons_mainmenu {
1.526 www 4335: width: 100%;
1.346 albertel 4336: border: 0px;
4337: border-spacing: 1px;
1.372 albertel 4338: padding: 0px 1px;
1.346 albertel 4339: margin: 0px;
4340: border-collapse: separate;
4341: }
4342: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
4343: border: 0px;
4344: }
1.345 albertel 4345: table#LC_top_nav td {
4346: background: $tabbg;
1.392 albertel 4347: border: 0px;
1.407 albertel 4348: font-size: small;
1.345 albertel 4349: }
4350: table#LC_top_nav td a, div#LC_top_nav a {
4351: color: $font;
4352: font-family: $sans;
4353: }
1.364 albertel 4354: table#LC_top_nav td.LC_top_nav_logo {
4355: background: $tabbg;
1.432 albertel 4356: text-align: left;
1.408 albertel 4357: white-space: nowrap;
1.432 albertel 4358: width: 31px;
1.408 albertel 4359: }
4360: table#LC_top_nav td.LC_top_nav_logo img {
1.432 albertel 4361: border: 0px;
1.408 albertel 4362: vertical-align: bottom;
1.364 albertel 4363: }
1.432 albertel 4364: table#LC_top_nav td.LC_top_nav_exit,
4365: table#LC_top_nav td.LC_top_nav_help {
4366: width: 2.0em;
4367: }
1.442 albertel 4368: table#LC_top_nav td.LC_top_nav_login {
4369: width: 4.0em;
4370: text-align: center;
4371: }
1.409 albertel 4372: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4373: background: $tabbg;
4374: color: $font;
4375: font-family: $sans;
1.358 albertel 4376: font-size: smaller;
1.357 albertel 4377: }
1.411 albertel 4378: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4379: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4380: background: $tabbg;
4381: color: $font;
4382: font-family: $sans;
4383: font-size: larger;
4384: text-align: right;
4385: }
1.383 albertel 4386: td.LC_table_cell_checkbox {
4387: text-align: center;
4388: }
4389:
1.522 albertel 4390: table#LC_mainmenu td.LC_mainmenu_column {
4391: vertical-align: top;
4392: }
4393:
1.346 albertel 4394: .LC_menubuttons_inline_text {
4395: color: $font;
4396: font-family: $sans;
4397: font-size: smaller;
4398: }
4399:
1.526 www 4400: .LC_menubuttons_link {
4401: text-decoration: none;
4402: }
4403:
1.522 albertel 4404: .LC_menubuttons_category {
1.521 www 4405: color: $font;
1.526 www 4406: background: $pgbg;
1.521 www 4407: font-family: $sans;
4408: font-size: larger;
4409: font-weight: bold;
4410: }
4411:
1.346 albertel 4412: td.LC_menubuttons_text {
1.526 www 4413: width: 90%;
1.346 albertel 4414: color: $font;
4415: font-family: $sans;
4416: }
1.526 www 4417:
1.346 albertel 4418: td.LC_menubuttons_img {
4419: }
1.526 www 4420:
1.346 albertel 4421: .LC_current_location {
4422: font-family: $sans;
4423: background: $tabbg;
4424: }
4425: .LC_new_mail {
4426: font-family: $sans;
1.634 www 4427: background: $tabbg;
1.346 albertel 4428: font-weight: bold;
4429: }
1.347 albertel 4430:
1.526 www 4431: .LC_rolesmenu_is {
4432: font-family: $sans;
4433: }
4434:
4435: .LC_rolesmenu_selected {
4436: font-family: $sans;
4437: }
4438:
4439: .LC_rolesmenu_future {
4440: font-family: $sans;
4441: }
4442:
4443:
4444: .LC_rolesmenu_will {
4445: font-family: $sans;
4446: }
4447:
4448: .LC_rolesmenu_will_not {
4449: font-family: $sans;
4450: }
4451:
4452: .LC_rolesmenu_expired {
4453: font-family: $sans;
4454: }
4455:
4456: .LC_rolesinfo {
4457: font-family: $sans;
4458: }
4459:
1.527 www 4460: .LC_dropadd_labeltext {
4461: font-family: $sans;
4462: text-align: right;
4463: }
4464:
4465: .LC_preferences_labeltext {
4466: font-family: $sans;
4467: text-align: right;
4468: }
4469:
1.440 albertel 4470: table.LC_aboutme_port {
4471: border: 0px;
4472: border-collapse: collapse;
4473: border-spacing: 0px;
4474: }
1.349 albertel 4475: table.LC_data_table, table.LC_mail_list {
1.347 albertel 4476: border: 1px solid #000000;
1.402 albertel 4477: border-collapse: separate;
1.426 albertel 4478: border-spacing: 1px;
1.610 albertel 4479: background: $pgbg;
1.347 albertel 4480: }
1.422 albertel 4481: .LC_data_table_dense {
4482: font-size: small;
4483: }
1.507 raeburn 4484: table.LC_nested_outer {
4485: border: 1px solid #000000;
1.589 raeburn 4486: border-collapse: collapse;
1.507 raeburn 4487: border-spacing: 0px;
4488: width: 100%;
4489: }
4490: table.LC_nested {
4491: border: 0px;
1.589 raeburn 4492: border-collapse: collapse;
1.507 raeburn 4493: border-spacing: 0px;
4494: width: 100%;
4495: }
1.523 albertel 4496: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4497: table.LC_prior_tries tr th {
1.349 albertel 4498: font-weight: bold;
4499: background-color: $data_table_head;
1.421 albertel 4500: font-size: smaller;
1.347 albertel 4501: }
1.610 albertel 4502: table.LC_data_table tr.LC_odd_row > td,
1.440 albertel 4503: table.LC_aboutme_port tr td {
1.349 albertel 4504: background-color: $data_table_light;
1.425 albertel 4505: padding: 2px;
1.347 albertel 4506: }
1.610 albertel 4507: table.LC_data_table tr.LC_even_row > td,
1.440 albertel 4508: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4509: background-color: $data_table_dark;
1.347 albertel 4510: }
1.425 albertel 4511: table.LC_data_table tr.LC_data_table_highlight td {
4512: background-color: $data_table_darker;
4513: }
1.639 raeburn 4514: table.LC_data_table tr td.LC_leftcol_header {
4515: background-color: $data_table_head;
4516: font-weight: bold;
4517: }
1.451 albertel 4518: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4519: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4520: background-color: #FFFFFF;
1.421 albertel 4521: font-weight: bold;
4522: font-style: italic;
4523: text-align: center;
4524: padding: 8px;
1.347 albertel 4525: }
1.507 raeburn 4526: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4527: padding: 4ex
4528: }
1.507 raeburn 4529: table.LC_nested_outer tr th {
4530: font-weight: bold;
4531: background-color: $data_table_head;
4532: font-size: smaller;
4533: border-bottom: 1px solid #000000;
4534: }
4535: table.LC_nested_outer tr td.LC_subheader {
4536: background-color: $data_table_head;
4537: font-weight: bold;
4538: font-size: small;
4539: border-bottom: 1px solid #000000;
4540: text-align: right;
1.451 albertel 4541: }
1.507 raeburn 4542: table.LC_nested tr.LC_info_row td {
1.451 albertel 4543: background-color: #CCC;
4544: font-weight: bold;
4545: font-size: small;
1.507 raeburn 4546: text-align: center;
4547: }
1.589 raeburn 4548: table.LC_nested tr.LC_info_row td.LC_left_item,
4549: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4550: text-align: left;
1.451 albertel 4551: }
1.507 raeburn 4552: table.LC_nested td {
1.451 albertel 4553: background-color: #FFF;
4554: font-size: small;
1.507 raeburn 4555: }
4556: table.LC_nested_outer tr th.LC_right_item,
4557: table.LC_nested tr.LC_info_row td.LC_right_item,
4558: table.LC_nested tr.LC_odd_row td.LC_right_item,
4559: table.LC_nested tr td.LC_right_item {
1.451 albertel 4560: text-align: right;
4561: }
4562:
1.507 raeburn 4563: table.LC_nested tr.LC_odd_row td {
1.451 albertel 4564: background-color: #EEE;
4565: }
4566:
1.473 raeburn 4567: table.LC_createuser {
4568: }
4569:
4570: table.LC_createuser tr.LC_section_row td {
4571: font-size: smaller;
4572: }
4573:
4574: table.LC_createuser tr.LC_info_row td {
4575: background-color: #CCC;
4576: font-weight: bold;
4577: text-align: center;
4578: }
4579:
1.349 albertel 4580: table.LC_calendar {
4581: border: 1px solid #000000;
4582: border-collapse: collapse;
4583: }
4584: table.LC_calendar_pickdate {
4585: font-size: xx-small;
4586: }
4587: table.LC_calendar tr td {
4588: border: 1px solid #000000;
4589: vertical-align: top;
4590: }
4591: table.LC_calendar tr td.LC_calendar_day_empty {
4592: background-color: $data_table_dark;
4593: }
4594: table.LC_calendar tr td.LC_calendar_day_current {
4595: background-color: $data_table_highlight;
4596: }
4597:
4598: table.LC_mail_list tr.LC_mail_new {
4599: background-color: $mail_new;
4600: }
4601: table.LC_mail_list tr.LC_mail_new:hover {
4602: background-color: $mail_new_hover;
4603: }
4604: table.LC_mail_list tr.LC_mail_read {
4605: background-color: $mail_read;
4606: }
4607: table.LC_mail_list tr.LC_mail_read:hover {
4608: background-color: $mail_read_hover;
4609: }
4610: table.LC_mail_list tr.LC_mail_replied {
4611: background-color: $mail_replied;
4612: }
4613: table.LC_mail_list tr.LC_mail_replied:hover {
4614: background-color: $mail_replied_hover;
4615: }
4616: table.LC_mail_list tr.LC_mail_other {
4617: background-color: $mail_other;
4618: }
4619: table.LC_mail_list tr.LC_mail_other:hover {
4620: background-color: $mail_other_hover;
4621: }
1.494 raeburn 4622: table.LC_mail_list tr.LC_mail_even {
4623: }
4624: table.LC_mail_list tr.LC_mail_odd {
4625: }
4626:
1.385 albertel 4627:
1.386 albertel 4628: table#LC_portfolio_actions {
4629: width: auto;
4630: background: $pgbg;
4631: border: 0px;
4632: border-spacing: 2px 2px;
4633: padding: 0px;
4634: margin: 0px;
4635: border-collapse: separate;
4636: }
4637: table#LC_portfolio_actions td.LC_label {
4638: background: $tabbg;
4639: text-align: right;
4640: }
4641: table#LC_portfolio_actions td.LC_value {
4642: background: $tabbg;
4643: }
1.385 albertel 4644:
1.391 albertel 4645: table#LC_cstr_controls {
4646: width: 100%;
4647: border-collapse: collapse;
4648: }
4649: table#LC_cstr_controls tr td {
4650: border: 4px solid $pgbg;
4651: padding: 4px;
4652: text-align: center;
4653: background: $tabbg;
4654: }
4655: table#LC_cstr_controls tr th {
4656: border: 4px solid $pgbg;
4657: background: $table_header;
4658: text-align: center;
4659: font-family: $sans;
4660: font-size: smaller;
4661: }
4662:
1.389 albertel 4663: table#LC_browser {
4664:
4665: }
4666: table#LC_browser tr th {
1.391 albertel 4667: background: $table_header;
1.389 albertel 4668: }
1.390 albertel 4669: table#LC_browser tr td {
4670: padding: 2px;
4671: }
1.389 albertel 4672: table#LC_browser tr.LC_browser_file,
4673: table#LC_browser tr.LC_browser_file_published {
4674: background: #CCFF88;
4675: }
4676: table#LC_browser tr.LC_browser_file_locked,
4677: table#LC_browser tr.LC_browser_file_unpublished {
4678: background: #FFAA99;
1.387 albertel 4679: }
1.389 albertel 4680: table#LC_browser tr.LC_browser_file_obsolete {
4681: background: #AAAAAA;
1.387 albertel 4682: }
1.455 albertel 4683: table#LC_browser tr.LC_browser_file_modified,
4684: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 4685: background: #FFFF77;
1.387 albertel 4686: }
1.389 albertel 4687: table#LC_browser tr.LC_browser_folder {
4688: background: #CCCCFF;
1.387 albertel 4689: }
1.388 albertel 4690: span.LC_current_location {
4691: font-size: x-large;
4692: background: $pgbg;
4693: }
1.387 albertel 4694:
1.395 albertel 4695: span.LC_parm_menu_item {
4696: font-size: larger;
4697: font-family: $sans;
4698: }
4699: span.LC_parm_scope_all {
4700: color: red;
4701: }
4702: span.LC_parm_scope_folder {
4703: color: green;
4704: }
4705: span.LC_parm_scope_resource {
4706: color: orange;
4707: }
4708: span.LC_parm_part {
4709: color: blue;
4710: }
4711: span.LC_parm_folder, span.LC_parm_symb {
4712: font-size: x-small;
4713: font-family: $mono;
4714: color: #AAAAAA;
4715: }
4716:
1.396 albertel 4717: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
4718: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
4719: border: 1px solid black;
4720: border-collapse: collapse;
4721: }
4722: table.LC_parm_overview_restrictions td {
4723: border-width: 1px 4px 1px 4px;
4724: border-style: solid;
4725: border-color: $pgbg;
4726: text-align: center;
4727: }
4728: table.LC_parm_overview_restrictions th {
4729: background: $tabbg;
4730: border-width: 1px 4px 1px 4px;
4731: border-style: solid;
4732: border-color: $pgbg;
4733: }
1.398 albertel 4734: table#LC_helpmenu {
4735: border: 0px;
4736: height: 55px;
4737: border-spacing: 0px;
4738: }
4739:
4740: table#LC_helpmenu fieldset legend {
4741: font-size: larger;
4742: font-weight: bold;
4743: }
1.397 albertel 4744: table#LC_helpmenu_links {
4745: width: 100%;
4746: border: 1px solid black;
4747: background: $pgbg;
4748: padding: 0px;
4749: border-spacing: 1px;
4750: }
4751: table#LC_helpmenu_links tr td {
4752: padding: 1px;
4753: background: $tabbg;
1.399 albertel 4754: text-align: center;
4755: font-weight: bold;
1.397 albertel 4756: }
1.396 albertel 4757:
1.397 albertel 4758: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
4759: table#LC_helpmenu_links a:active {
4760: text-decoration: none;
4761: color: $font;
4762: }
4763: table#LC_helpmenu_links a:hover {
4764: text-decoration: underline;
4765: color: $vlink;
4766: }
1.396 albertel 4767:
1.417 albertel 4768: .LC_chrt_popup_exists {
4769: border: 1px solid #339933;
4770: margin: -1px;
4771: }
4772: .LC_chrt_popup_up {
4773: border: 1px solid yellow;
4774: margin: -1px;
4775: }
4776: .LC_chrt_popup {
4777: border: 1px solid #8888FF;
4778: background: #CCCCFF;
4779: }
1.421 albertel 4780: table.LC_pick_box {
4781: border-collapse: separate;
4782: background: white;
4783: border: 1px solid black;
4784: border-spacing: 1px;
4785: }
4786: table.LC_pick_box td.LC_pick_box_title {
4787: background: $tabbg;
4788: font-weight: bold;
4789: text-align: right;
4790: width: 184px;
4791: padding: 8px;
4792: }
1.645 raeburn 4793: table.LC_pick_box td.LC_selfenroll_pick_box_title {
4794: background: $tabbg;
4795: font-weight: bold;
4796: text-align: right;
4797: width: 350px;
4798: padding: 8px;
4799: }
4800:
1.579 raeburn 4801: table.LC_pick_box td.LC_pick_box_value {
4802: text-align: left;
4803: padding: 8px;
4804: }
4805: table.LC_pick_box td.LC_pick_box_select {
4806: text-align: left;
4807: padding: 8px;
4808: }
1.424 albertel 4809: table.LC_pick_box td.LC_pick_box_separator {
1.421 albertel 4810: padding: 0px;
4811: height: 1px;
4812: background: black;
4813: }
4814: table.LC_pick_box td.LC_pick_box_submit {
4815: text-align: right;
4816: }
1.579 raeburn 4817: table.LC_pick_box td.LC_evenrow_value {
4818: text-align: left;
4819: padding: 8px;
4820: background-color: $data_table_light;
4821: }
4822: table.LC_pick_box td.LC_oddrow_value {
4823: text-align: left;
4824: padding: 8px;
4825: background-color: $data_table_light;
4826: }
4827: table.LC_helpform_receipt {
4828: width: 620px;
4829: border-collapse: separate;
4830: background: white;
4831: border: 1px solid black;
4832: border-spacing: 1px;
4833: }
4834: table.LC_helpform_receipt td.LC_pick_box_title {
4835: background: $tabbg;
4836: font-weight: bold;
4837: text-align: right;
4838: width: 184px;
4839: padding: 8px;
4840: }
4841: table.LC_helpform_receipt td.LC_evenrow_value {
4842: text-align: left;
4843: padding: 8px;
4844: background-color: $data_table_light;
4845: }
4846: table.LC_helpform_receipt td.LC_oddrow_value {
4847: text-align: left;
4848: padding: 8px;
4849: background-color: $data_table_light;
4850: }
4851: table.LC_helpform_receipt td.LC_pick_box_separator {
4852: padding: 0px;
4853: height: 1px;
4854: background: black;
4855: }
4856: span.LC_helpform_receipt_cat {
4857: font-weight: bold;
4858: }
1.424 albertel 4859: table.LC_group_priv_box {
4860: background: white;
4861: border: 1px solid black;
4862: border-spacing: 1px;
4863: }
4864: table.LC_group_priv_box td.LC_pick_box_title {
4865: background: $tabbg;
4866: font-weight: bold;
4867: text-align: right;
4868: width: 184px;
4869: }
4870: table.LC_group_priv_box td.LC_groups_fixed {
4871: background: $data_table_light;
4872: text-align: center;
4873: }
4874: table.LC_group_priv_box td.LC_groups_optional {
4875: background: $data_table_dark;
4876: text-align: center;
4877: }
4878: table.LC_group_priv_box td.LC_groups_functionality {
4879: background: $data_table_darker;
4880: text-align: center;
4881: font-weight: bold;
4882: }
4883: table.LC_group_priv td {
4884: text-align: left;
4885: padding: 0px;
4886: }
4887:
1.421 albertel 4888: table.LC_notify_front_page {
4889: background: white;
4890: border: 1px solid black;
4891: padding: 8px;
4892: }
4893: table.LC_notify_front_page td {
4894: padding: 8px;
4895: }
1.424 albertel 4896: .LC_navbuttons {
4897: margin: 2ex 0ex 2ex 0ex;
4898: }
1.423 albertel 4899: .LC_topic_bar {
4900: font-family: $sans;
4901: font-weight: bold;
4902: width: 100%;
4903: background: $tabbg;
4904: vertical-align: middle;
4905: margin: 2ex 0ex 2ex 0ex;
4906: }
4907: .LC_topic_bar span {
4908: vertical-align: middle;
4909: }
4910: .LC_topic_bar img {
4911: vertical-align: bottom;
4912: }
4913: table.LC_course_group_status {
4914: margin: 20px;
4915: }
4916: table.LC_status_selector td {
4917: vertical-align: top;
4918: text-align: center;
1.424 albertel 4919: padding: 4px;
4920: }
4921: table.LC_descriptive_input td.LC_description {
4922: vertical-align: top;
4923: text-align: right;
4924: font-weight: bold;
1.423 albertel 4925: }
1.599 albertel 4926: div.LC_feedback_link {
1.616 albertel 4927: clear: both;
1.599 albertel 4928: background: white;
4929: width: 100%;
1.489 raeburn 4930: }
4931: span.LC_feedback_link {
1.599 albertel 4932: background: $feedback_link_bg;
4933: font-size: larger;
4934: }
4935: span.LC_message_link {
4936: background: $feedback_link_bg;
4937: font-size: larger;
4938: position: absolute;
4939: right: 1em;
1.489 raeburn 4940: }
1.421 albertel 4941:
1.515 albertel 4942: table.LC_prior_tries {
1.524 albertel 4943: border: 1px solid #000000;
4944: border-collapse: separate;
4945: border-spacing: 1px;
1.515 albertel 4946: }
1.523 albertel 4947:
1.515 albertel 4948: table.LC_prior_tries td {
1.524 albertel 4949: padding: 2px;
1.515 albertel 4950: }
1.523 albertel 4951:
4952: .LC_answer_correct {
4953: background: #AAFFAA;
4954: color: black;
4955: }
4956: .LC_answer_charged_try {
4957: background: #FFAAAA ! important;
4958: color: black;
4959: }
4960: .LC_answer_not_charged_try,
4961: .LC_answer_no_grade,
4962: .LC_answer_late {
4963: background: #FFFFAA;
4964: color: black;
4965: }
4966: .LC_answer_previous {
4967: background: #AAAAFF;
4968: color: black;
4969: }
4970: .LC_answer_no_message {
4971: background: #FFFFFF;
4972: color: black;
4973: }
4974: .LC_answer_unknown {
4975: background: orange;
4976: color: black;
4977: }
4978:
4979:
1.529 albertel 4980: span.LC_prior_numerical,
4981: span.LC_prior_string,
4982: span.LC_prior_custom,
4983: span.LC_prior_reaction,
4984: span.LC_prior_math {
1.523 albertel 4985: font-family: monospace;
4986: white-space: pre;
4987: }
4988:
1.525 albertel 4989: span.LC_prior_string {
4990: font-family: monospace;
4991: white-space: pre;
4992: }
4993:
1.523 albertel 4994: table.LC_prior_option {
4995: width: 100%;
4996: border-collapse: collapse;
4997: }
1.528 albertel 4998: table.LC_prior_rank, table.LC_prior_match {
4999: border-collapse: collapse;
5000: }
5001: table.LC_prior_option tr td,
5002: table.LC_prior_rank tr td,
5003: table.LC_prior_match tr td {
1.524 albertel 5004: border: 1px solid #000000;
1.515 albertel 5005: }
5006:
1.519 raeburn 5007: span.LC_nobreak {
1.544 albertel 5008: white-space: nowrap;
1.519 raeburn 5009: }
5010:
1.576 raeburn 5011: span.LC_cusr_emph {
5012: font-style: italic;
5013: }
5014:
1.633 raeburn 5015: span.LC_cusr_subheading {
5016: font-weight: normal;
5017: font-size: 85%;
5018: }
5019:
1.545 albertel 5020: table.LC_docs_documents {
5021: background: #BBBBBB;
1.547 albertel 5022: border-width: 0px;
1.545 albertel 5023: border-collapse: collapse;
5024: }
5025:
5026: table.LC_docs_documents td.LC_docs_document {
5027: border: 2px solid black;
5028: padding: 4px;
5029: }
5030:
5031: .LC_docs_course_commands div {
5032: float: left;
5033: border: 4px solid #AAAAAA;
5034: padding: 4px;
5035: background: #DDDDCC;
5036: }
5037:
5038: .LC_docs_entry_move {
5039: border: 0px;
5040: border-collapse: collapse;
1.544 albertel 5041: }
5042:
1.545 albertel 5043: .LC_docs_entry_move td {
5044: border: 2px solid #BBBBBB;
5045: background: #DDDDDD;
5046: }
5047:
5048: .LC_docs_editor td.LC_docs_entry_commands {
5049: background: #DDDDDD;
5050: font-size: x-small;
5051: }
1.544 albertel 5052: .LC_docs_copy {
1.545 albertel 5053: color: #000099;
1.544 albertel 5054: }
5055: .LC_docs_cut {
1.545 albertel 5056: color: #550044;
1.544 albertel 5057: }
5058: .LC_docs_rename {
1.545 albertel 5059: color: #009900;
1.544 albertel 5060: }
5061: .LC_docs_remove {
1.545 albertel 5062: color: #990000;
5063: }
5064:
1.547 albertel 5065: .LC_docs_reinit_warn,
5066: .LC_docs_ext_edit {
5067: font-size: x-small;
5068: }
5069:
1.545 albertel 5070: .LC_docs_editor td.LC_docs_entry_title,
5071: .LC_docs_editor td.LC_docs_entry_icon {
5072: background: #FFFFBB;
5073: }
5074: .LC_docs_editor td.LC_docs_entry_parameter {
5075: background: #BBBBFF;
5076: font-size: x-small;
5077: white-space: nowrap;
5078: }
5079:
5080: table.LC_docs_adddocs td,
5081: table.LC_docs_adddocs th {
5082: border: 1px solid #BBBBBB;
5083: padding: 4px;
5084: background: #DDDDDD;
1.543 albertel 5085: }
5086:
1.584 albertel 5087: table.LC_sty_begin {
5088: background: #BBFFBB;
5089: }
5090: table.LC_sty_end {
5091: background: #FFBBBB;
5092: }
5093:
1.589 raeburn 5094: table.LC_double_column {
5095: border-width: 0px;
5096: border-collapse: collapse;
5097: width: 100%;
5098: padding: 2px;
5099: }
5100:
5101: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5102: top: 2px;
1.589 raeburn 5103: left: 2px;
5104: width: 47%;
5105: vertical-align: top;
5106: }
5107:
5108: table.LC_double_column tr td.LC_right_col {
5109: top: 2px;
5110: right: 2px;
5111: width: 47%;
5112: vertical-align: top;
5113: }
5114:
1.594 raeburn 5115: span.LC_role_level {
5116: font-weight: bold;
5117: }
5118:
1.591 raeburn 5119: div.LC_left_float {
5120: float: left;
5121: padding-right: 5%;
1.597 albertel 5122: padding-bottom: 4px;
1.591 raeburn 5123: }
5124:
5125: div.LC_clear_float_header {
1.597 albertel 5126: padding-bottom: 2px;
1.591 raeburn 5127: }
5128:
5129: div.LC_clear_float_footer {
1.597 albertel 5130: padding-top: 10px;
1.591 raeburn 5131: clear: both;
5132: }
5133:
1.597 albertel 5134:
1.601 albertel 5135: div.LC_grade_select_mode {
1.604 albertel 5136: font-family: $sans;
1.601 albertel 5137: }
5138: div.LC_grade_select_mode div div {
5139: margin: 5px;
5140: }
5141: div.LC_grade_select_mode_selector {
5142: margin: 5px;
5143: float: left;
5144: }
5145: div.LC_grade_select_mode_selector_header {
5146: font: bold medium $sans;
5147: }
5148: div.LC_grade_select_mode_type {
5149: clear: left;
5150: }
5151:
1.597 albertel 5152: div.LC_grade_show_user {
5153: margin-top: 20px;
5154: border: 1px solid black;
5155: }
5156: div.LC_grade_user_name {
5157: background: #DDDDEE;
5158: border-bottom: 1px solid black;
5159: font: bold large $sans;
5160: }
5161: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5162: background: #DDEEDD;
5163: }
5164:
5165: div.LC_grade_show_problem,
5166: div.LC_grade_submissions,
5167: div.LC_grade_message_center,
5168: div.LC_grade_info_links,
5169: div.LC_grade_assign {
5170: margin: 5px;
5171: width: 99%;
5172: background: #FFFFFF;
5173: }
5174: div.LC_grade_show_problem_header,
5175: div.LC_grade_submissions_header,
5176: div.LC_grade_message_center_header,
5177: div.LC_grade_assign_header {
5178: font: bold large $sans;
5179: }
5180: div.LC_grade_show_problem_problem,
5181: div.LC_grade_submissions_body,
5182: div.LC_grade_message_center_body,
5183: div.LC_grade_assign_body {
5184: border: 1px solid black;
5185: width: 99%;
5186: background: #FFFFFF;
5187: }
1.598 albertel 5188: span.LC_grade_check_note {
5189: font: normal medium $sans;
5190: display: inline;
5191: position: absolute;
5192: right: 1em;
5193: }
1.597 albertel 5194:
1.613 albertel 5195: table.LC_scantron_action {
5196: width: 100%;
5197: }
5198: table.LC_scantron_action tr th {
5199: font: normal bold $sans;
5200: }
1.600 albertel 5201:
1.614 albertel 5202: div.LC_edit_problem_header,
5203: div.LC_edit_problem_footer {
1.600 albertel 5204: font: normal medium $sans;
1.602 albertel 5205: margin: 2px;
1.600 albertel 5206: }
5207: div.LC_edit_problem_header,
1.602 albertel 5208: div.LC_edit_problem_header div,
1.614 albertel 5209: div.LC_edit_problem_footer,
5210: div.LC_edit_problem_footer div,
1.602 albertel 5211: div.LC_edit_problem_editxml_header,
5212: div.LC_edit_problem_editxml_header div {
1.600 albertel 5213: margin-top: 5px;
5214: }
1.602 albertel 5215: div.LC_edit_problem_header_edit_row {
5216: background: $tabbg;
5217: padding: 3px;
5218: margin-bottom: 5px;
5219: }
1.600 albertel 5220: div.LC_edit_problem_header_title {
1.602 albertel 5221: font: larger bold $sans;
5222: background: $tabbg;
5223: padding: 3px;
5224: }
5225: table.LC_edit_problem_header_title {
5226: font: larger bold $sans;
5227: width: 100%;
5228: border-color: $pgbg;
5229: border-style: solid;
5230: border-width: $border;
5231:
1.600 albertel 5232: background: $tabbg;
1.602 albertel 5233: border-collapse: collapse;
5234: padding: 0px
5235: }
5236:
5237: div.LC_edit_problem_discards {
5238: float: left;
5239: padding-bottom: 5px;
5240: }
5241: div.LC_edit_problem_saves {
5242: float: right;
5243: padding-bottom: 5px;
1.600 albertel 5244: }
5245: hr.LC_edit_problem_divide {
1.602 albertel 5246: clear: both;
1.600 albertel 5247: color: $tabbg;
5248: background-color: $tabbg;
5249: height: 3px;
5250: border: 0px;
5251: }
1.343 albertel 5252: END
5253: }
5254:
1.306 albertel 5255: =pod
5256:
5257: =item * &headtag()
5258:
5259: Returns a uniform footer for LON-CAPA web pages.
5260:
1.307 albertel 5261: Inputs: $title - optional title for the head
5262: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5263: $args - optional arguments
1.319 albertel 5264: force_register - if is true call registerurl so the remote is
5265: informed
1.415 albertel 5266: redirect -> array ref of
5267: 1- seconds before redirect occurs
5268: 2- url to redirect to
5269: 3- whether the side effect should occur
1.315 albertel 5270: (side effect of setting
5271: $env{'internal.head.redirect'} to the url
5272: redirected too)
1.352 albertel 5273: domain -> force to color decorate a page for a specific
5274: domain
5275: function -> force usage of a specific rolish color scheme
5276: bgcolor -> override the default page bgcolor
1.460 albertel 5277: no_auto_mt_title
5278: -> prevent &mt()ing the title arg
1.464 albertel 5279:
1.306 albertel 5280: =cut
5281:
5282: sub headtag {
1.313 albertel 5283: my ($title,$head_extra,$args) = @_;
1.306 albertel 5284:
1.363 albertel 5285: my $function = $args->{'function'} || &get_users_function();
5286: my $domain = $args->{'domain'} || &determinedomain();
5287: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5288: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5289: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5290: #time(),
1.418 albertel 5291: $env{'environment.color.timestamp'},
1.363 albertel 5292: $function,$domain,$bgcolor);
5293:
1.369 www 5294: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5295:
1.308 albertel 5296: my $result =
5297: '<head>'.
1.461 albertel 5298: &font_settings();
1.319 albertel 5299:
1.461 albertel 5300: if (!$args->{'frameset'}) {
5301: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5302: }
1.319 albertel 5303: if ($args->{'force_register'}) {
5304: $result .= &Apache::lonmenu::registerurl(1);
5305: }
1.436 albertel 5306: if (!$args->{'no_nav_bar'}
5307: && !$args->{'only_body'}
5308: && !$args->{'frameset'}) {
5309: $result .= &help_menu_js();
5310: }
1.319 albertel 5311:
1.314 albertel 5312: if (ref($args->{'redirect'})) {
1.414 albertel 5313: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5314: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5315: if (!$inhibit_continue) {
5316: $env{'internal.head.redirect'} = $url;
5317: }
1.313 albertel 5318: $result.=<<ADDMETA
5319: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5320: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5321: ADDMETA
5322: }
1.306 albertel 5323: if (!defined($title)) {
5324: $title = 'The LearningOnline Network with CAPA';
5325: }
1.460 albertel 5326: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5327: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5328: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5329: .$head_extra;
1.306 albertel 5330: return $result;
5331: }
5332:
5333: =pod
5334:
1.340 albertel 5335: =item * &font_settings()
5336:
5337: Returns neccessary <meta> to set the proper encoding
5338:
5339: Inputs: none
5340:
5341: =cut
5342:
5343: sub font_settings {
5344: my $headerstring='';
1.647 ! www 5345: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 5346: $headerstring.=
5347: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5348: }
5349: return $headerstring;
5350: }
5351:
1.341 albertel 5352: =pod
5353:
5354: =item * &xml_begin()
5355:
5356: Returns the needed doctype and <html>
5357:
5358: Inputs: none
5359:
5360: =cut
5361:
5362: sub xml_begin {
5363: my $output='';
5364:
1.592 albertel 5365: if ($env{'internal.start_page'}==1) {
5366: &Apache::lonhtmlcommon::init_htmlareafields();
5367: }
1.342 albertel 5368:
1.341 albertel 5369: if ($env{'browser.mathml'}) {
5370: $output='<?xml version="1.0"?>'
5371: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5372: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5373:
5374: # .'<!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">] >'
5375: .'<!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">'
5376: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5377: .'xmlns="http://www.w3.org/1999/xhtml">';
5378: } else {
5379: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
5380: }
5381: return $output;
5382: }
1.340 albertel 5383:
5384: =pod
5385:
1.306 albertel 5386: =item * &endheadtag()
5387:
5388: Returns a uniform </head> for LON-CAPA web pages.
5389:
5390: Inputs: none
5391:
5392: =cut
5393:
5394: sub endheadtag {
5395: return '</head>';
5396: }
5397:
5398: =pod
5399:
5400: =item * &head()
5401:
5402: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5403:
5404: Inputs: $title - optional title for the page
1.307 albertel 5405: $head_extra - optional extra HTML to put inside the <head>
1.405 albertel 5406:
1.306 albertel 5407: =cut
5408:
5409: sub head {
1.325 albertel 5410: my ($title,$head_extra,$args) = @_;
5411: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5412: }
5413:
5414: =pod
5415:
5416: =item * &start_page()
5417:
5418: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5419:
5420: Inputs: $title - optional title for the page
5421: $head_extra - optional extra HTML to incude inside the <head>
1.315 albertel 5422: $args - additional optional args supported are:
1.317 albertel 5423: only_body -> is true will set &bodytag() onlybodytag
5424: arg on
5425: no_nav_bar -> is true will set &bodytag() notopbar arg on
5426: add_entries -> additional attributes to add to the <body>
5427: domain -> force to color decorate a page for a
5428: specific domain
5429: function -> force usage of a specific rolish color
5430: scheme
5431: redirect -> see &headtag()
5432: bgcolor -> override the default page bg color
5433: js_ready -> return a string ready for being used in
5434: a javascript writeln
1.320 albertel 5435: html_encode -> return a string ready for being used in
5436: a html attribute
1.317 albertel 5437: force_register -> if is true will turn on the &bodytag()
5438: $forcereg arg
1.326 albertel 5439: body_title -> alternate text to use instead of $title
5440: in the title box that appears, this text
5441: is not auto translated like the $title is
1.330 albertel 5442: frameset -> if true will start with a <frameset>
5443: rather than <body>
1.338 albertel 5444: no_title -> if true the title bar won't be shown
5445: skip_phases -> hash ref of
5446: head -> skip the <html><head> generation
5447: body -> skip all <body> generation
1.337 albertel 5448:
1.361 albertel 5449: no_inline_link -> if true and in remote mode, don't show the
5450: 'Switch To Inline Menu' link
5451:
1.460 albertel 5452: no_auto_mt_title -> prevent &mt()ing the title arg
5453:
1.562 albertel 5454: inherit_jsmath -> when creating popup window in a page,
5455: should it have jsmath forced on by the
5456: current page
5457:
1.306 albertel 5458: =cut
5459:
5460: sub start_page {
1.309 albertel 5461: my ($title,$head_extra,$args) = @_;
1.318 albertel 5462: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5463: my %head_args;
1.352 albertel 5464: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5465: 'bgcolor','frameset','no_nav_bar','only_body',
5466: 'no_auto_mt_title') {
1.319 albertel 5467: if (defined($args->{$arg})) {
1.324 raeburn 5468: $head_args{$arg} = $args->{$arg};
1.319 albertel 5469: }
1.313 albertel 5470: }
1.319 albertel 5471:
1.315 albertel 5472: $env{'internal.start_page'}++;
1.338 albertel 5473: my $result;
5474: if (! exists($args->{'skip_phases'}{'head'}) ) {
5475: $result.=
1.341 albertel 5476: &xml_begin().
1.338 albertel 5477: &headtag($title,$head_extra,\%head_args).&endheadtag();
5478: }
5479:
5480: if (! exists($args->{'skip_phases'}{'body'}) ) {
5481: if ($args->{'frameset'}) {
5482: my $attr_string = &make_attr_string($args->{'force_register'},
5483: $args->{'add_entries'});
5484: $result .= "\n<frameset $attr_string>\n";
5485: } else {
5486: $result .=
5487: &bodytag($title,
5488: $args->{'function'}, $args->{'add_entries'},
5489: $args->{'only_body'}, $args->{'domain'},
5490: $args->{'force_register'}, $args->{'body_title'},
5491: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5492: $args->{'no_title'}, $args->{'no_inline_link'},
5493: $args);
1.338 albertel 5494: }
1.330 albertel 5495: }
1.338 albertel 5496:
1.315 albertel 5497: if ($args->{'js_ready'}) {
1.317 albertel 5498: $result = &js_ready($result);
1.315 albertel 5499: }
1.320 albertel 5500: if ($args->{'html_encode'}) {
5501: $result = &html_encode($result);
5502: }
1.315 albertel 5503: return $result;
1.306 albertel 5504: }
5505:
1.330 albertel 5506:
1.306 albertel 5507: =pod
5508:
5509: =item * &head()
5510:
5511: Returns a complete </body></html> section for LON-CAPA web pages.
5512:
1.315 albertel 5513: Inputs: $args - additional optional args supported are:
5514: js_ready -> return a string ready for being used in
5515: a javascript writeln
1.320 albertel 5516: html_encode -> return a string ready for being used in
5517: a html attribute
1.330 albertel 5518: frameset -> if true will start with a <frameset>
5519: rather than <body>
1.493 albertel 5520: dicsussion -> if true will get discussion from
5521: lonxml::xmlend
5522: (you can pass the target and parser arguments
5523: through optional 'target' and 'parser' args
5524: to this routine)
1.306 albertel 5525:
5526: =cut
5527:
5528: sub end_page {
1.315 albertel 5529: my ($args) = @_;
5530: $env{'internal.end_page'}++;
1.330 albertel 5531: my $result;
1.335 albertel 5532: if ($args->{'discussion'}) {
5533: my ($target,$parser);
5534: if (ref($args->{'discussion'})) {
5535: ($target,$parser) =($args->{'discussion'}{'target'},
5536: $args->{'discussion'}{'parser'});
5537: }
5538: $result .= &Apache::lonxml::xmlend($target,$parser);
5539: }
5540:
1.330 albertel 5541: if ($args->{'frameset'}) {
5542: $result .= '</frameset>';
5543: } else {
1.635 raeburn 5544: $result .= &endbodytag($args);
1.330 albertel 5545: }
5546: $result .= "\n</html>";
5547:
1.315 albertel 5548: if ($args->{'js_ready'}) {
1.317 albertel 5549: $result = &js_ready($result);
1.315 albertel 5550: }
1.335 albertel 5551:
1.320 albertel 5552: if ($args->{'html_encode'}) {
5553: $result = &html_encode($result);
5554: }
1.335 albertel 5555:
1.315 albertel 5556: return $result;
5557: }
5558:
1.320 albertel 5559: sub html_encode {
5560: my ($result) = @_;
5561:
1.322 albertel 5562: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 5563:
5564: return $result;
5565: }
1.317 albertel 5566: sub js_ready {
5567: my ($result) = @_;
5568:
1.323 albertel 5569: $result =~ s/[\n\r]/ /xmsg;
5570: $result =~ s/\\/\\\\/xmsg;
5571: $result =~ s/'/\\'/xmsg;
1.372 albertel 5572: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 5573:
5574: return $result;
5575: }
5576:
1.315 albertel 5577: sub validate_page {
5578: if ( exists($env{'internal.start_page'})
1.316 albertel 5579: && $env{'internal.start_page'} > 1) {
5580: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 5581: $env{'internal.start_page'}.' '.
1.316 albertel 5582: $ENV{'request.filename'});
1.315 albertel 5583: }
5584: if ( exists($env{'internal.end_page'})
1.316 albertel 5585: && $env{'internal.end_page'} > 1) {
5586: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 5587: $env{'internal.end_page'}.' '.
1.316 albertel 5588: $env{'request.filename'});
1.315 albertel 5589: }
5590: if ( exists($env{'internal.start_page'})
5591: && ! exists($env{'internal.end_page'})) {
1.316 albertel 5592: &Apache::lonnet::logthis('start_page called without end_page '.
5593: $env{'request.filename'});
1.315 albertel 5594: }
5595: if ( ! exists($env{'internal.start_page'})
5596: && exists($env{'internal.end_page'})) {
1.316 albertel 5597: &Apache::lonnet::logthis('end_page called without start_page'.
5598: $env{'request.filename'});
1.315 albertel 5599: }
1.306 albertel 5600: }
1.315 albertel 5601:
1.318 albertel 5602: sub simple_error_page {
5603: my ($r,$title,$msg) = @_;
5604: my $page =
5605: &Apache::loncommon::start_page($title).
5606: &mt($msg).
5607: &Apache::loncommon::end_page();
5608: if (ref($r)) {
5609: $r->print($page);
1.327 albertel 5610: return;
1.318 albertel 5611: }
5612: return $page;
5613: }
1.347 albertel 5614:
5615: {
1.610 albertel 5616: my @row_count;
1.347 albertel 5617: sub start_data_table {
1.422 albertel 5618: my ($add_class) = @_;
5619: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 5620: unshift(@row_count,0);
1.422 albertel 5621: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 5622: }
5623:
5624: sub end_data_table {
1.610 albertel 5625: shift(@row_count);
1.389 albertel 5626: return '</table>'."\n";;
1.347 albertel 5627: }
5628:
5629: sub start_data_table_row {
1.422 albertel 5630: my ($add_class) = @_;
1.610 albertel 5631: $row_count[0]++;
5632: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 5633: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 5634: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 5635: }
1.471 banghart 5636:
5637: sub continue_data_table_row {
5638: my ($add_class) = @_;
1.610 albertel 5639: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 5640: $css_class = (join(' ',$css_class,$add_class));
5641: return '<tr class="'.$css_class.'">'."\n";;
5642: }
1.347 albertel 5643:
5644: sub end_data_table_row {
1.389 albertel 5645: return '</tr>'."\n";;
1.347 albertel 5646: }
1.367 www 5647:
1.421 albertel 5648: sub start_data_table_empty_row {
1.610 albertel 5649: $row_count[0]++;
1.421 albertel 5650: return '<tr class="LC_empty_row" >'."\n";;
5651: }
5652:
5653: sub end_data_table_empty_row {
5654: return '</tr>'."\n";;
5655: }
5656:
1.367 www 5657: sub start_data_table_header_row {
1.389 albertel 5658: return '<tr class="LC_header_row">'."\n";;
1.367 www 5659: }
5660:
5661: sub end_data_table_header_row {
1.389 albertel 5662: return '</tr>'."\n";;
1.367 www 5663: }
1.347 albertel 5664: }
5665:
1.548 albertel 5666: =pod
5667:
5668: =item * &inhibit_menu_check($arg)
5669:
5670: Checks for a inhibitmenu state and generates output to preserve it
5671:
5672: Inputs: $arg - can be any of
5673: - undef - in which case the return value is a string
5674: to add into arguments list of a uri
5675: - 'input' - in which case the return value is a HTML
5676: <form> <input> field of type hidden to
5677: preserve the value
5678: - a url - in which case the return value is the url with
5679: the neccesary cgi args added to preserve the
5680: inhibitmenu state
5681: - a ref to a url - no return value, but the string is
5682: updated to include the neccessary cgi
5683: args to preserve the inhibitmenu state
5684:
5685: =cut
5686:
5687: sub inhibit_menu_check {
5688: my ($arg) = @_;
5689: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5690: if ($arg eq 'input') {
5691: if ($env{'form.inhibitmenu'}) {
5692: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
5693: } else {
5694: return
5695: }
5696: }
5697: if ($env{'form.inhibitmenu'}) {
5698: if (ref($arg)) {
5699: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5700: } elsif ($arg eq '') {
5701: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
5702: } else {
5703: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5704: }
5705: }
5706: if (!ref($arg)) {
5707: return $arg;
5708: }
5709: }
5710:
1.251 albertel 5711: ###############################################
1.182 matthew 5712:
5713: =pod
5714:
1.549 albertel 5715: =back
5716:
5717: =head1 User Information Routines
5718:
5719: =over 4
5720:
1.405 albertel 5721: =item * &get_users_function()
1.182 matthew 5722:
5723: Used by &bodytag to determine the current users primary role.
5724: Returns either 'student','coordinator','admin', or 'author'.
5725:
5726: =cut
5727:
5728: ###############################################
5729: sub get_users_function {
5730: my $function = 'student';
1.258 albertel 5731: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 5732: $function='coordinator';
5733: }
1.258 albertel 5734: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 5735: $function='admin';
5736: }
1.258 albertel 5737: if (($env{'request.role'}=~/^(au|ca)/) ||
1.182 matthew 5738: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
5739: $function='author';
5740: }
5741: return $function;
1.54 www 5742: }
1.99 www 5743:
5744: ###############################################
5745:
1.233 raeburn 5746: =pod
5747:
1.542 raeburn 5748: =item * &check_user_status()
1.274 raeburn 5749:
5750: Determines current status of supplied role for a
5751: specific user. Roles can be active, previous or future.
5752:
5753: Inputs:
5754: user's domain, user's username, course's domain,
1.375 raeburn 5755: course's number, optional section ID.
1.274 raeburn 5756:
5757: Outputs:
5758: role status: active, previous or future.
5759:
5760: =cut
5761:
5762: sub check_user_status {
1.412 raeburn 5763: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 5764: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
5765: my @uroles = keys %userinfo;
5766: my $srchstr;
5767: my $active_chk = 'none';
1.412 raeburn 5768: my $now = time;
1.274 raeburn 5769: if (@uroles > 0) {
1.412 raeburn 5770: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 5771: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
5772: } else {
1.412 raeburn 5773: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
5774: }
5775: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 5776: my $role_end = 0;
5777: my $role_start = 0;
5778: $active_chk = 'active';
1.412 raeburn 5779: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
5780: $role_end = $1;
5781: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
5782: $role_start = $1;
1.274 raeburn 5783: }
5784: }
5785: if ($role_start > 0) {
1.412 raeburn 5786: if ($now < $role_start) {
1.274 raeburn 5787: $active_chk = 'future';
5788: }
5789: }
5790: if ($role_end > 0) {
1.412 raeburn 5791: if ($now > $role_end) {
1.274 raeburn 5792: $active_chk = 'previous';
5793: }
5794: }
5795: }
5796: }
5797: return $active_chk;
5798: }
5799:
5800: ###############################################
5801:
5802: =pod
5803:
1.405 albertel 5804: =item * &get_sections()
1.233 raeburn 5805:
5806: Determines all the sections for a course including
5807: sections with students and sections containing other roles.
1.419 raeburn 5808: Incoming parameters:
5809:
5810: 1. domain
5811: 2. course number
5812: 3. reference to array containing roles for which sections should
5813: be gathered (optional).
5814: 4. reference to array containing status types for which sections
5815: should be gathered (optional).
5816:
5817: If the third argument is undefined, sections are gathered for any role.
5818: If the fourth argument is undefined, sections are gathered for any status.
5819: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 5820:
1.374 raeburn 5821: Returns section hash (keys are section IDs, values are
5822: number of users in each section), subject to the
1.419 raeburn 5823: optional roles filter, optional status filter
1.233 raeburn 5824:
5825: =cut
5826:
5827: ###############################################
5828: sub get_sections {
1.419 raeburn 5829: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 5830: if (!defined($cdom) || !defined($cnum)) {
5831: my $cid = $env{'request.course.id'};
5832:
5833: return if (!defined($cid));
5834:
5835: $cdom = $env{'course.'.$cid.'.domain'};
5836: $cnum = $env{'course.'.$cid.'.num'};
5837: }
5838:
5839: my %sectioncount;
1.419 raeburn 5840: my $now = time;
1.240 albertel 5841:
1.366 albertel 5842: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 5843: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 5844: my $sec_index = &Apache::loncoursedata::CL_SECTION();
5845: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 5846: my $start_index = &Apache::loncoursedata::CL_START();
5847: my $end_index = &Apache::loncoursedata::CL_END();
5848: my $status;
1.366 albertel 5849: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 5850: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
5851: $data->[$status_index],
5852: $data->[$start_index],
5853: $data->[$end_index]);
5854: if ($stu_status eq 'Active') {
5855: $status = 'active';
5856: } elsif ($end < $now) {
5857: $status = 'previous';
5858: } elsif ($start > $now) {
5859: $status = 'future';
5860: }
5861: if ($section ne '-1' && $section !~ /^\s*$/) {
5862: if ((!defined($possible_status)) || (($status ne '') &&
5863: (grep/^\Q$status\E$/,@{$possible_status}))) {
5864: $sectioncount{$section}++;
5865: }
1.240 albertel 5866: }
5867: }
5868: }
5869: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5870: foreach my $user (sort(keys(%courseroles))) {
5871: if ($user !~ /^(\w{2})/) { next; }
5872: my ($role) = ($user =~ /^(\w{2})/);
5873: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 5874: my ($section,$status);
1.240 albertel 5875: if ($role eq 'cr' &&
5876: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
5877: $section=$1;
5878: }
5879: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
5880: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 5881: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
5882: if ($end == -1 && $start == -1) {
5883: next; #deleted role
5884: }
5885: if (!defined($possible_status)) {
5886: $sectioncount{$section}++;
5887: } else {
5888: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
5889: $status = 'active';
5890: } elsif ($end < $now) {
5891: $status = 'future';
5892: } elsif ($start > $now) {
5893: $status = 'previous';
5894: }
5895: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
5896: $sectioncount{$section}++;
5897: }
5898: }
1.233 raeburn 5899: }
1.366 albertel 5900: return %sectioncount;
1.233 raeburn 5901: }
5902:
1.274 raeburn 5903: ###############################################
1.294 raeburn 5904:
5905: =pod
1.405 albertel 5906:
5907: =item * &get_course_users()
5908:
1.275 raeburn 5909: Retrieves usernames:domains for users in the specified course
5910: with specific role(s), and access status.
5911:
5912: Incoming parameters:
1.277 albertel 5913: 1. course domain
5914: 2. course number
5915: 3. access status: users must have - either active,
1.275 raeburn 5916: previous, future, or all.
1.277 albertel 5917: 4. reference to array of permissible roles
1.288 raeburn 5918: 5. reference to array of section restrictions (optional)
5919: 6. reference to results object (hash of hashes).
5920: 7. reference to optional userdata hash
1.609 raeburn 5921: 8. reference to optional statushash
1.630 raeburn 5922: 9. flag if privileged users (except those set to unhide in
5923: course settings) should be excluded
1.609 raeburn 5924: Keys of top level results hash are roles.
1.275 raeburn 5925: Keys of inner hashes are username:domain, with
5926: values set to access type.
1.288 raeburn 5927: Optional userdata hash returns an array with arguments in the
5928: same order as loncoursedata::get_classlist() for student data.
5929:
1.609 raeburn 5930: Optional statushash returns
5931:
1.288 raeburn 5932: Entries for end, start, section and status are blank because
5933: of the possibility of multiple values for non-student roles.
5934:
1.275 raeburn 5935: =cut
1.405 albertel 5936:
1.275 raeburn 5937: ###############################################
1.405 albertel 5938:
1.275 raeburn 5939: sub get_course_users {
1.630 raeburn 5940: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 5941: my %idx = ();
1.419 raeburn 5942: my %seclists;
1.288 raeburn 5943:
5944: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
5945: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
5946: $idx{end} = &Apache::loncoursedata::CL_END();
5947: $idx{start} = &Apache::loncoursedata::CL_START();
5948: $idx{id} = &Apache::loncoursedata::CL_ID();
5949: $idx{section} = &Apache::loncoursedata::CL_SECTION();
5950: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
5951: $idx{status} = &Apache::loncoursedata::CL_STATUS();
5952:
1.290 albertel 5953: if (grep(/^st$/,@{$roles})) {
1.276 albertel 5954: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 5955: my $now = time;
1.277 albertel 5956: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 5957: my $match = 0;
1.412 raeburn 5958: my $secmatch = 0;
1.419 raeburn 5959: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 5960: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 5961: if ($section eq '') {
5962: $section = 'none';
5963: }
1.291 albertel 5964: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 5965: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 5966: $secmatch = 1;
5967: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 5968: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 5969: $secmatch = 1;
5970: }
5971: } else {
1.419 raeburn 5972: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 5973: $secmatch = 1;
5974: }
1.290 albertel 5975: }
1.412 raeburn 5976: if (!$secmatch) {
5977: next;
5978: }
1.419 raeburn 5979: }
1.275 raeburn 5980: if (defined($$types{'active'})) {
1.288 raeburn 5981: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 5982: push(@{$$users{st}{$student}},'active');
1.288 raeburn 5983: $match = 1;
1.275 raeburn 5984: }
5985: }
5986: if (defined($$types{'previous'})) {
1.609 raeburn 5987: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 5988: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 5989: $match = 1;
1.275 raeburn 5990: }
5991: }
5992: if (defined($$types{'future'})) {
1.609 raeburn 5993: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 5994: push(@{$$users{st}{$student}},'future');
1.288 raeburn 5995: $match = 1;
1.275 raeburn 5996: }
5997: }
1.609 raeburn 5998: if ($match) {
5999: push(@{$seclists{$student}},$section);
6000: if (ref($userdata) eq 'HASH') {
6001: $$userdata{$student} = $$classlist{$student};
6002: }
6003: if (ref($statushash) eq 'HASH') {
6004: $statushash->{$student}{'st'}{$section} = $status;
6005: }
1.288 raeburn 6006: }
1.275 raeburn 6007: }
6008: }
1.412 raeburn 6009: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 6010: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6011: my $now = time;
1.609 raeburn 6012: my %displaystatus = ( previous => 'Expired',
6013: active => 'Active',
6014: future => 'Future',
6015: );
1.630 raeburn 6016: my %nothide;
6017: if ($hidepriv) {
6018: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
6019: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
6020: if ($user !~ /:/) {
6021: $nothide{join(':',split(/[\@]/,$user))}=1;
6022: } else {
6023: $nothide{$user} = 1;
6024: }
6025: }
6026: }
1.439 raeburn 6027: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 6028: my $match = 0;
1.412 raeburn 6029: my $secmatch = 0;
1.439 raeburn 6030: my $status;
1.412 raeburn 6031: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 6032: $user =~ s/:$//;
1.439 raeburn 6033: my ($end,$start) = split(/:/,$coursepersonnel{$person});
6034: if ($end == -1 || $start == -1) {
6035: next;
6036: }
6037: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
6038: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 6039: my ($uname,$udom) = split(/:/,$user);
6040: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6041: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6042: $secmatch = 1;
6043: } elsif ($usec eq '') {
1.420 albertel 6044: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6045: $secmatch = 1;
6046: }
6047: } else {
6048: if (grep(/^\Q$usec\E$/,@{$sections})) {
6049: $secmatch = 1;
6050: }
6051: }
6052: if (!$secmatch) {
6053: next;
6054: }
1.288 raeburn 6055: }
1.419 raeburn 6056: if ($usec eq '') {
6057: $usec = 'none';
6058: }
1.275 raeburn 6059: if ($uname ne '' && $udom ne '') {
1.630 raeburn 6060: if ($hidepriv) {
6061: if ((&Apache::lonnet::privileged($uname,$udom)) &&
6062: (!$nothide{$uname.':'.$udom})) {
6063: next;
6064: }
6065: }
1.503 raeburn 6066: if ($end > 0 && $end < $now) {
1.439 raeburn 6067: $status = 'previous';
6068: } elsif ($start > $now) {
6069: $status = 'future';
6070: } else {
6071: $status = 'active';
6072: }
1.277 albertel 6073: foreach my $type (keys(%{$types})) {
1.275 raeburn 6074: if ($status eq $type) {
1.420 albertel 6075: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 6076: push(@{$$users{$role}{$user}},$type);
6077: }
1.288 raeburn 6078: $match = 1;
6079: }
6080: }
1.419 raeburn 6081: if (($match) && (ref($userdata) eq 'HASH')) {
6082: if (!exists($$userdata{$uname.':'.$udom})) {
6083: &get_user_info($udom,$uname,\%idx,$userdata);
6084: }
1.420 albertel 6085: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 6086: push(@{$seclists{$uname.':'.$udom}},$usec);
6087: }
1.609 raeburn 6088: if (ref($statushash) eq 'HASH') {
6089: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
6090: }
1.275 raeburn 6091: }
6092: }
6093: }
6094: }
1.290 albertel 6095: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 6096: if ((defined($cdom)) && (defined($cnum))) {
6097: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
6098: if ( defined($csettings{'internal.courseowner'}) ) {
6099: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 6100: next if ($owner eq '');
6101: my ($ownername,$ownerdom);
6102: if ($owner =~ /^([^:]+):([^:]+)$/) {
6103: $ownername = $1;
6104: $ownerdom = $2;
6105: } else {
6106: $ownername = $owner;
6107: $ownerdom = $cdom;
6108: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 6109: }
6110: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 6111: if (defined($userdata) &&
1.609 raeburn 6112: !exists($$userdata{$owner})) {
6113: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
6114: if (!grep(/^none$/,@{$seclists{$owner}})) {
6115: push(@{$seclists{$owner}},'none');
6116: }
6117: if (ref($statushash) eq 'HASH') {
6118: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 6119: }
1.290 albertel 6120: }
1.279 raeburn 6121: }
6122: }
6123: }
1.419 raeburn 6124: foreach my $user (keys(%seclists)) {
6125: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6126: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6127: }
1.275 raeburn 6128: }
6129: return;
6130: }
6131:
1.288 raeburn 6132: sub get_user_info {
6133: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6134: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6135: &plainname($uname,$udom,'lastname');
1.291 albertel 6136: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6137: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6138: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6139: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6140: return;
6141: }
1.275 raeburn 6142:
1.472 raeburn 6143: ###############################################
6144:
6145: =pod
6146:
6147: =item * &get_user_quota()
6148:
6149: Retrieves quota assigned for storage of portfolio files for a user
6150:
6151: Incoming parameters:
6152: 1. user's username
6153: 2. user's domain
6154:
6155: Returns:
1.536 raeburn 6156: 1. Disk quota (in Mb) assigned to student.
6157: 2. (Optional) Type of setting: custom or default
6158: (individually assigned or default for user's
6159: institutional status).
6160: 3. (Optional) - User's institutional status (e.g., faculty, staff
6161: or student - types as defined in localenroll::inst_usertypes
6162: for user's domain, which determines default quota for user.
6163: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6164:
6165: If a value has been stored in the user's environment,
1.536 raeburn 6166: it will return that, otherwise it returns the maximal default
6167: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6168:
6169: =cut
6170:
6171: ###############################################
6172:
6173:
6174: sub get_user_quota {
6175: my ($uname,$udom) = @_;
1.536 raeburn 6176: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6177: if (!defined($udom)) {
6178: $udom = $env{'user.domain'};
6179: }
6180: if (!defined($uname)) {
6181: $uname = $env{'user.name'};
6182: }
6183: if (($udom eq '' || $uname eq '') ||
6184: ($udom eq 'public') && ($uname eq 'public')) {
6185: $quota = 0;
1.536 raeburn 6186: $quotatype = 'default';
6187: $defquota = 0;
1.472 raeburn 6188: } else {
1.536 raeburn 6189: my $inststatus;
1.472 raeburn 6190: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6191: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6192: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6193: } else {
1.536 raeburn 6194: my %userenv =
6195: &Apache::lonnet::get('environment',['portfolioquota',
6196: 'inststatus'],$udom,$uname);
1.472 raeburn 6197: my ($tmp) = keys(%userenv);
6198: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6199: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6200: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6201: } else {
6202: undef(%userenv);
6203: }
6204: }
1.536 raeburn 6205: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6206: if ($quota eq '') {
1.536 raeburn 6207: $quota = $defquota;
6208: $quotatype = 'default';
6209: } else {
6210: $quotatype = 'custom';
1.472 raeburn 6211: }
6212: }
1.536 raeburn 6213: if (wantarray) {
6214: return ($quota,$quotatype,$settingstatus,$defquota);
6215: } else {
6216: return $quota;
6217: }
1.472 raeburn 6218: }
6219:
6220: ###############################################
6221:
6222: =pod
6223:
6224: =item * &default_quota()
6225:
1.536 raeburn 6226: Retrieves default quota assigned for storage of user portfolio files,
6227: given an (optional) user's institutional status.
1.472 raeburn 6228:
6229: Incoming parameters:
6230: 1. domain
1.536 raeburn 6231: 2. (Optional) institutional status(es). This is a : separated list of
6232: status types (e.g., faculty, staff, student etc.)
6233: which apply to the user for whom the default is being retrieved.
6234: If the institutional status string in undefined, the domain
6235: default quota will be returned.
1.472 raeburn 6236:
6237: Returns:
6238: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6239: 2. (Optional) institutional type which determined the value of the
6240: default quota.
1.472 raeburn 6241:
6242: If a value has been stored in the domain's configuration db,
6243: it will return that, otherwise it returns 20 (for backwards
6244: compatibility with domains which have not set up a configuration
6245: db file; the original statically defined portfolio quota was 20 Mb).
6246:
1.536 raeburn 6247: If the user's status includes multiple types (e.g., staff and student),
6248: the largest default quota which applies to the user determines the
6249: default quota returned.
6250:
1.472 raeburn 6251: =cut
6252:
6253: ###############################################
6254:
6255:
6256: sub default_quota {
1.536 raeburn 6257: my ($udom,$inststatus) = @_;
6258: my ($defquota,$settingstatus);
6259: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 6260: ['quotas'],$udom);
6261: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 6262: if ($inststatus ne '') {
6263: my @statuses = split(/:/,$inststatus);
6264: foreach my $item (@statuses) {
1.622 raeburn 6265: if ($quotahash{'quotas'}{$item} ne '') {
1.536 raeburn 6266: if ($defquota eq '') {
1.622 raeburn 6267: $defquota = $quotahash{'quotas'}{$item};
1.536 raeburn 6268: $settingstatus = $item;
1.622 raeburn 6269: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
6270: $defquota = $quotahash{'quotas'}{$item};
1.536 raeburn 6271: $settingstatus = $item;
6272: }
6273: }
6274: }
6275: }
6276: if ($defquota eq '') {
1.622 raeburn 6277: $defquota = $quotahash{'quotas'}{'default'};
1.536 raeburn 6278: $settingstatus = 'default';
6279: }
6280: } else {
6281: $settingstatus = 'default';
6282: $defquota = 20;
6283: }
6284: if (wantarray) {
6285: return ($defquota,$settingstatus);
1.472 raeburn 6286: } else {
1.536 raeburn 6287: return $defquota;
1.472 raeburn 6288: }
6289: }
6290:
1.384 raeburn 6291: sub get_secgrprole_info {
6292: my ($cdom,$cnum,$needroles,$type) = @_;
6293: my %sections_count = &get_sections($cdom,$cnum);
6294: my @sections = (sort {$a <=> $b} keys(%sections_count));
6295: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6296: my @groups = sort(keys(%curr_groups));
6297: my $allroles = [];
6298: my $rolehash;
6299: my $accesshash = {
6300: active => 'Currently has access',
6301: future => 'Will have future access',
6302: previous => 'Previously had access',
6303: };
6304: if ($needroles) {
6305: $rolehash = {'all' => 'all'};
1.385 albertel 6306: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6307: if (&Apache::lonnet::error(%user_roles)) {
6308: undef(%user_roles);
6309: }
6310: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6311: my ($role)=split(/\:/,$item,2);
6312: if ($role eq 'cr') { next; }
6313: if ($role =~ /^cr/) {
6314: $$rolehash{$role} = (split('/',$role))[3];
6315: } else {
6316: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6317: }
6318: }
6319: foreach my $key (sort(keys(%{$rolehash}))) {
6320: push(@{$allroles},$key);
6321: }
6322: push (@{$allroles},'st');
6323: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6324: }
6325: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6326: }
6327:
1.555 raeburn 6328: sub user_picker {
1.627 raeburn 6329: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 6330: my $currdom = $dom;
6331: my %curr_selected = (
6332: srchin => 'dom',
1.580 raeburn 6333: srchby => 'lastname',
1.555 raeburn 6334: );
6335: my $srchterm;
1.625 raeburn 6336: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 6337: if ($srch->{'srchby'} ne '') {
6338: $curr_selected{'srchby'} = $srch->{'srchby'};
6339: }
6340: if ($srch->{'srchin'} ne '') {
6341: $curr_selected{'srchin'} = $srch->{'srchin'};
6342: }
6343: if ($srch->{'srchtype'} ne '') {
6344: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6345: }
6346: if ($srch->{'srchdomain'} ne '') {
6347: $currdom = $srch->{'srchdomain'};
6348: }
6349: $srchterm = $srch->{'srchterm'};
6350: }
6351: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6352: 'usr' => 'Search criteria',
1.563 raeburn 6353: 'doma' => 'Domain/institution to search',
1.558 albertel 6354: 'uname' => 'username',
6355: 'lastname' => 'last name',
1.555 raeburn 6356: 'lastfirst' => 'last name, first name',
1.558 albertel 6357: 'crs' => 'in this course',
1.576 raeburn 6358: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6359: 'alc' => 'all LON-CAPA',
1.573 raeburn 6360: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6361: 'exact' => 'is',
6362: 'contains' => 'contains',
1.569 raeburn 6363: 'begins' => 'begins with',
1.571 raeburn 6364: 'youm' => "You must include some text to search for.",
6365: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6366: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6367: 'yomc' => "You must choose a domain when using an institutional directory search.",
6368: 'ymcd' => "You must choose a domain when using a domain search.",
6369: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6370: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6371: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6372: );
1.563 raeburn 6373: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6374: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6375:
6376: my @srchins = ('crs','dom','alc','instd');
6377:
6378: foreach my $option (@srchins) {
6379: # FIXME 'alc' option unavailable until
6380: # loncreateuser::print_user_query_page()
6381: # has been completed.
6382: next if ($option eq 'alc');
6383: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6384: if ($curr_selected{'srchin'} eq $option) {
6385: $srchinsel .= '
6386: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6387: } else {
6388: $srchinsel .= '
6389: <option value="'.$option.'">'.$lt{$option}.'</option>';
6390: }
1.555 raeburn 6391: }
1.563 raeburn 6392: $srchinsel .= "\n </select>\n";
1.555 raeburn 6393:
6394: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6395: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6396: if ($curr_selected{'srchby'} eq $option) {
6397: $srchbysel .= '
6398: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6399: } else {
6400: $srchbysel .= '
6401: <option value="'.$option.'">'.$lt{$option}.'</option>';
6402: }
6403: }
6404: $srchbysel .= "\n </select>\n";
6405:
6406: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6407: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6408: if ($curr_selected{'srchtype'} eq $option) {
6409: $srchtypesel .= '
6410: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6411: } else {
6412: $srchtypesel .= '
6413: <option value="'.$option.'">'.$lt{$option}.'</option>';
6414: }
6415: }
6416: $srchtypesel .= "\n </select>\n";
6417:
1.558 albertel 6418: my ($newuserscript,$new_user_create);
1.556 raeburn 6419:
6420: if ($forcenewuser) {
1.576 raeburn 6421: if (ref($srch) eq 'HASH') {
6422: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 6423: if ($cancreate) {
6424: $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>';
6425: } else {
6426: my $helplink = ' href="javascript:helpMenu('."'display'".')"';
6427: my %usertypetext = (
6428: official => 'institutional',
6429: unofficial => 'non-institutional',
6430: );
6431: $new_user_create = '<br /><span class="LC_warning">'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the <a[_1]>helpdesk</a> for assistance.',$helplink).'</span><br /><br />';
6432: }
1.576 raeburn 6433: }
6434: }
6435:
1.556 raeburn 6436: $newuserscript = <<"ENDSCRIPT";
6437:
1.570 raeburn 6438: function setSearch(createnew,callingForm) {
1.556 raeburn 6439: if (createnew == 1) {
1.570 raeburn 6440: for (var i=0; i<callingForm.srchby.length; i++) {
6441: if (callingForm.srchby.options[i].value == 'uname') {
6442: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6443: }
6444: }
1.570 raeburn 6445: for (var i=0; i<callingForm.srchin.length; i++) {
6446: if ( callingForm.srchin.options[i].value == 'dom') {
6447: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6448: }
6449: }
1.570 raeburn 6450: for (var i=0; i<callingForm.srchtype.length; i++) {
6451: if (callingForm.srchtype.options[i].value == 'exact') {
6452: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6453: }
6454: }
1.570 raeburn 6455: for (var i=0; i<callingForm.srchdomain.length; i++) {
6456: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6457: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6458: }
6459: }
6460: }
6461: }
6462: ENDSCRIPT
1.558 albertel 6463:
1.556 raeburn 6464: }
6465:
1.555 raeburn 6466: my $output = <<"END_BLOCK";
1.556 raeburn 6467: <script type="text/javascript">
1.570 raeburn 6468: function validateEntry(callingForm) {
1.558 albertel 6469:
1.556 raeburn 6470: var checkok = 1;
1.558 albertel 6471: var srchin;
1.570 raeburn 6472: for (var i=0; i<callingForm.srchin.length; i++) {
6473: if ( callingForm.srchin[i].checked ) {
6474: srchin = callingForm.srchin[i].value;
1.558 albertel 6475: }
6476: }
6477:
1.570 raeburn 6478: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6479: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6480: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6481: var srchterm = callingForm.srchterm.value;
6482: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6483: var msg = "";
6484:
6485: if (srchterm == "") {
6486: checkok = 0;
1.571 raeburn 6487: msg += "$lt{'youm'}\\n";
1.556 raeburn 6488: }
6489:
1.569 raeburn 6490: if (srchtype== 'begins') {
6491: if (srchterm.length < 2) {
6492: checkok = 0;
1.571 raeburn 6493: msg += "$lt{'thte'}\\n";
1.569 raeburn 6494: }
6495: }
6496:
1.556 raeburn 6497: if (srchtype== 'contains') {
6498: if (srchterm.length < 3) {
6499: checkok = 0;
1.571 raeburn 6500: msg += "$lt{'thet'}\\n";
1.556 raeburn 6501: }
6502: }
6503: if (srchin == 'instd') {
6504: if (srchdomain == '') {
6505: checkok = 0;
1.571 raeburn 6506: msg += "$lt{'yomc'}\\n";
1.556 raeburn 6507: }
6508: }
6509: if (srchin == 'dom') {
6510: if (srchdomain == '') {
6511: checkok = 0;
1.571 raeburn 6512: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 6513: }
6514: }
6515: if (srchby == 'lastfirst') {
6516: if (srchterm.indexOf(",") == -1) {
6517: checkok = 0;
1.571 raeburn 6518: msg += "$lt{'whus'}\\n";
1.556 raeburn 6519: }
6520: if (srchterm.indexOf(",") == srchterm.length -1) {
6521: checkok = 0;
1.571 raeburn 6522: msg += "$lt{'whse'}\\n";
1.556 raeburn 6523: }
6524: }
6525: if (checkok == 0) {
1.571 raeburn 6526: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 6527: return;
6528: }
6529: if (checkok == 1) {
1.570 raeburn 6530: callingForm.submit();
1.556 raeburn 6531: }
6532: }
6533:
6534: $newuserscript
6535:
6536: </script>
1.558 albertel 6537:
6538: $new_user_create
6539:
1.555 raeburn 6540: <table>
1.558 albertel 6541: <tr>
1.573 raeburn 6542: <td>$lt{'doma'}:</td>
6543: <td>$domform</td>
6544: </td>
6545: </tr>
6546: <tr>
6547: <td>$lt{'usr'}:</td>
1.563 raeburn 6548: <td>$srchbysel
6549: $srchtypesel
6550: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 6551: $srchinsel
1.563 raeburn 6552: </td>
6553: </tr>
1.555 raeburn 6554: </table>
6555: <br />
6556: END_BLOCK
1.558 albertel 6557:
1.555 raeburn 6558: return $output;
6559: }
6560:
1.612 raeburn 6561: sub user_rule_check {
1.615 raeburn 6562: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 6563: my $response;
6564: if (ref($usershash) eq 'HASH') {
6565: foreach my $user (keys(%{$usershash})) {
6566: my ($uname,$udom) = split(/:/,$user);
6567: next if ($udom eq '' || $uname eq '');
1.615 raeburn 6568: my ($id,$newuser);
1.612 raeburn 6569: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 6570: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 6571: $id = $usershash->{$user}->{'id'};
6572: }
6573: my $inst_response;
6574: if (ref($checks) eq 'HASH') {
6575: if (defined($checks->{'username'})) {
1.615 raeburn 6576: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 6577: &Apache::lonnet::get_instuser($udom,$uname);
6578: } elsif (defined($checks->{'id'})) {
1.615 raeburn 6579: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 6580: &Apache::lonnet::get_instuser($udom,undef,$id);
6581: }
1.615 raeburn 6582: } else {
6583: ($inst_response,%{$inst_results->{$user}}) =
6584: &Apache::lonnet::get_instuser($udom,$uname);
6585: return;
1.612 raeburn 6586: }
1.615 raeburn 6587: if (!$got_rules->{$udom}) {
1.612 raeburn 6588: my %domconfig = &Apache::lonnet::get_dom('configuration',
6589: ['usercreation'],$udom);
6590: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 6591: foreach my $item ('username','id') {
1.612 raeburn 6592: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
6593: $$curr_rules{$udom}{$item} =
6594: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 6595: }
6596: }
6597: }
1.615 raeburn 6598: $got_rules->{$udom} = 1;
1.585 raeburn 6599: }
1.612 raeburn 6600: foreach my $item (keys(%{$checks})) {
6601: if (ref($$curr_rules{$udom}) eq 'HASH') {
6602: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
6603: if (@{$$curr_rules{$udom}{$item}} > 0) {
6604: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
6605: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
6606: if ($rule_check{$rule}) {
6607: $$rulematch{$user}{$item} = $rule;
6608: if ($inst_response eq 'ok') {
1.615 raeburn 6609: if (ref($inst_results) eq 'HASH') {
6610: if (ref($inst_results->{$user}) eq 'HASH') {
6611: if (keys(%{$inst_results->{$user}}) == 0) {
6612: $$alerts{$item}{$udom}{$uname} = 1;
6613: }
1.612 raeburn 6614: }
6615: }
1.615 raeburn 6616: }
6617: last;
1.585 raeburn 6618: }
6619: }
6620: }
6621: }
6622: }
6623: }
6624: }
6625: }
1.612 raeburn 6626: return;
6627: }
6628:
6629: sub user_rule_formats {
6630: my ($domain,$domdesc,$curr_rules,$check) = @_;
6631: my %text = (
6632: 'username' => 'Usernames',
6633: 'id' => 'IDs',
6634: );
6635: my $output;
6636: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
6637: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
6638: if (@{$ruleorder} > 0) {
6639: $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
6640: foreach my $rule (@{$ruleorder}) {
6641: if (ref($curr_rules) eq 'ARRAY') {
6642: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
6643: if (ref($rules->{$rule}) eq 'HASH') {
6644: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
6645: $rules->{$rule}{'desc'}.'</li>';
6646: }
6647: }
6648: }
6649: }
6650: $output .= '</ul>';
6651: }
6652: }
6653: return $output;
6654: }
6655:
6656: sub instrule_disallow_msg {
1.615 raeburn 6657: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 6658: my $response;
6659: my %text = (
6660: item => 'username',
6661: items => 'usernames',
6662: match => 'matches',
6663: do => 'does',
6664: action => 'a username',
6665: one => 'one',
6666: );
6667: if ($count > 1) {
6668: $text{'item'} = 'usernames';
6669: $text{'match'} ='match';
6670: $text{'do'} = 'do';
6671: $text{'action'} = 'usernames',
6672: $text{'one'} = 'ones';
6673: }
6674: if ($checkitem eq 'id') {
6675: $text{'items'} = 'IDs';
6676: $text{'item'} = 'ID';
6677: $text{'action'} = 'an ID';
1.615 raeburn 6678: if ($count > 1) {
6679: $text{'item'} = 'IDs';
6680: $text{'action'} = 'IDs';
6681: }
1.612 raeburn 6682: }
6683: $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for <span class=\"LC_cusr_emph\">[_1]</span>, but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'<br />';
1.615 raeburn 6684: if ($mode eq 'upload') {
6685: if ($checkitem eq 'username') {
6686: $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
6687: } elsif ($checkitem eq 'id') {
6688: $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field.");
6689: }
6690: } else {
6691: if ($checkitem eq 'username') {
6692: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
6693: } elsif ($checkitem eq 'id') {
6694: $response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
6695: }
1.612 raeburn 6696: }
6697: return $response;
1.585 raeburn 6698: }
6699:
1.624 raeburn 6700: sub personal_data_fieldtitles {
6701: my %fieldtitles = &Apache::lonlocal::texthash (
6702: id => 'Student/Employee ID',
6703: permanentemail => 'E-mail address',
6704: lastname => 'Last Name',
6705: firstname => 'First Name',
6706: middlename => 'Middle Name',
6707: generation => 'Generation',
6708: gen => 'Generation',
6709: );
6710: return %fieldtitles;
6711: }
6712:
1.642 raeburn 6713: sub sorted_inst_types {
6714: my ($dom) = @_;
6715: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
6716: my $othertitle = &mt('All users');
6717: if ($env{'request.course.id'}) {
6718: $othertitle = 'any';
6719: }
6720: my @types;
6721: if (ref($order) eq 'ARRAY') {
6722: @types = @{$order};
6723: }
6724: if (@types == 0) {
6725: if (ref($usertypes) eq 'HASH') {
6726: @types = sort(keys(%{$usertypes}));
6727: }
6728: }
6729: if (keys(%{$usertypes}) > 0) {
6730: $othertitle = &mt('Other users');
6731: if ($env{'request.course.id'}) {
6732: $othertitle = 'other';
6733: }
6734: }
6735: return ($othertitle,$usertypes,\@types);
6736: }
6737:
1.645 raeburn 6738: sub get_institutional_codes {
6739: my ($settings,$allcourses,$LC_code) = @_;
6740: # Get complete list of course sections to update
6741: my @currsections = ();
6742: my @currxlists = ();
6743: my $coursecode = $$settings{'internal.coursecode'};
6744:
6745: if ($$settings{'internal.sectionnums'} ne '') {
6746: @currsections = split(/,/,$$settings{'internal.sectionnums'});
6747: }
6748:
6749: if ($$settings{'internal.crosslistings'} ne '') {
6750: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
6751: }
6752:
6753: if (@currxlists > 0) {
6754: foreach (@currxlists) {
6755: if (m/^([^:]+):(\w*)$/) {
6756: unless (grep/^$1$/,@{$allcourses}) {
6757: push @{$allcourses},$1;
6758: $$LC_code{$1} = $2;
6759: }
6760: }
6761: }
6762: }
6763:
6764: if (@currsections > 0) {
6765: foreach (@currsections) {
6766: if (m/^(\w+):(\w*)$/) {
6767: my $sec = $coursecode.$1;
6768: my $lc_sec = $2;
6769: unless (grep/^$sec$/,@{$allcourses}) {
6770: push @{$allcourses},$sec;
6771: $$LC_code{$sec} = $lc_sec;
6772: }
6773: }
6774: }
6775: }
6776: return;
6777: }
6778:
1.112 bowersj2 6779: =pod
6780:
1.549 albertel 6781: =back
6782:
6783: =head1 HTTP Helpers
6784:
6785: =over 4
6786:
1.112 bowersj2 6787: =item * get_unprocessed_cgi($query,$possible_names)
6788:
1.258 albertel 6789: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 6790: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 6791: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 6792:
6793: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
6794: $possible_names is an ref to an array of form element names. As an example:
6795: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 6796: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 6797:
6798: =cut
1.1 albertel 6799:
1.6 albertel 6800: sub get_unprocessed_cgi {
1.25 albertel 6801: my ($query,$possible_names)= @_;
1.26 matthew 6802: # $Apache::lonxml::debug=1;
1.356 albertel 6803: foreach my $pair (split(/&/,$query)) {
6804: my ($name, $value) = split(/=/,$pair);
1.369 www 6805: $name = &unescape($name);
1.25 albertel 6806: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
6807: $value =~ tr/+/ /;
6808: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 6809: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 6810: }
1.16 harris41 6811: }
1.6 albertel 6812: }
6813:
1.112 bowersj2 6814: =pod
6815:
6816: =item * cacheheader()
6817:
6818: returns cache-controlling header code
6819:
6820: =cut
6821:
1.7 albertel 6822: sub cacheheader {
1.258 albertel 6823: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 6824: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
6825: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 6826: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
6827: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 6828: return $output;
1.7 albertel 6829: }
6830:
1.112 bowersj2 6831: =pod
6832:
6833: =item * no_cache($r)
6834:
6835: specifies header code to not have cache
6836:
6837: =cut
6838:
1.9 albertel 6839: sub no_cache {
1.216 albertel 6840: my ($r) = @_;
6841: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 6842: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 6843: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
6844: $r->no_cache(1);
6845: $r->header_out("Expires" => $date);
6846: $r->header_out("Pragma" => "no-cache");
1.123 www 6847: }
6848:
6849: sub content_type {
1.181 albertel 6850: my ($r,$type,$charset) = @_;
1.299 foxr 6851: if ($r) {
6852: # Note that printout.pl calls this with undef for $r.
6853: &no_cache($r);
6854: }
1.258 albertel 6855: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 6856: unless ($charset) {
6857: $charset=&Apache::lonlocal::current_encoding;
6858: }
6859: if ($charset) { $type.='; charset='.$charset; }
6860: if ($r) {
6861: $r->content_type($type);
6862: } else {
6863: print("Content-type: $type\n\n");
6864: }
1.9 albertel 6865: }
1.25 albertel 6866:
1.112 bowersj2 6867: =pod
6868:
6869: =item * add_to_env($name,$value)
6870:
1.258 albertel 6871: adds $name to the %env hash with value
1.112 bowersj2 6872: $value, if $name already exists, the entry is converted to an array
6873: reference and $value is added to the array.
6874:
6875: =cut
6876:
1.25 albertel 6877: sub add_to_env {
6878: my ($name,$value)=@_;
1.258 albertel 6879: if (defined($env{$name})) {
6880: if (ref($env{$name})) {
1.25 albertel 6881: #already have multiple values
1.258 albertel 6882: push(@{ $env{$name} },$value);
1.25 albertel 6883: } else {
6884: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 6885: my $first=$env{$name};
6886: undef($env{$name});
6887: push(@{ $env{$name} },$first,$value);
1.25 albertel 6888: }
6889: } else {
1.258 albertel 6890: $env{$name}=$value;
1.25 albertel 6891: }
1.31 albertel 6892: }
1.149 albertel 6893:
6894: =pod
6895:
6896: =item * get_env_multiple($name)
6897:
1.258 albertel 6898: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 6899: values may be defined and end up as an array ref.
6900:
6901: returns an array of values
6902:
6903: =cut
6904:
6905: sub get_env_multiple {
6906: my ($name) = @_;
6907: my @values;
1.258 albertel 6908: if (defined($env{$name})) {
1.149 albertel 6909: # exists is it an array
1.258 albertel 6910: if (ref($env{$name})) {
6911: @values=@{ $env{$name} };
1.149 albertel 6912: } else {
1.258 albertel 6913: $values[0]=$env{$name};
1.149 albertel 6914: }
6915: }
6916: return(@values);
6917: }
6918:
1.31 albertel 6919:
1.41 ng 6920: =pod
1.45 matthew 6921:
1.464 albertel 6922: =back
1.41 ng 6923:
1.112 bowersj2 6924: =head1 CSV Upload/Handling functions
1.38 albertel 6925:
1.41 ng 6926: =over 4
6927:
1.112 bowersj2 6928: =item * upfile_store($r)
1.41 ng 6929:
6930: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 6931: needs $env{'form.upfile'}
1.41 ng 6932: returns $datatoken to be put into hidden field
6933:
6934: =cut
1.31 albertel 6935:
6936: sub upfile_store {
6937: my $r=shift;
1.258 albertel 6938: $env{'form.upfile'}=~s/\r/\n/gs;
6939: $env{'form.upfile'}=~s/\f/\n/gs;
6940: $env{'form.upfile'}=~s/\n+/\n/gs;
6941: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 6942:
1.258 albertel 6943: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
6944: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 6945: {
1.158 raeburn 6946: my $datafile = $r->dir_config('lonDaemons').
6947: '/tmp/'.$datatoken.'.tmp';
6948: if ( open(my $fh,">$datafile") ) {
1.258 albertel 6949: print $fh $env{'form.upfile'};
1.158 raeburn 6950: close($fh);
6951: }
1.31 albertel 6952: }
6953: return $datatoken;
6954: }
6955:
1.56 matthew 6956: =pod
6957:
1.112 bowersj2 6958: =item * load_tmp_file($r)
1.41 ng 6959:
6960: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 6961: needs $env{'form.datatoken'},
6962: sets $env{'form.upfile'} to the contents of the file
1.41 ng 6963:
6964: =cut
1.31 albertel 6965:
6966: sub load_tmp_file {
6967: my $r=shift;
6968: my @studentdata=();
6969: {
1.158 raeburn 6970: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 6971: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 6972: if ( open(my $fh,"<$studentfile") ) {
6973: @studentdata=<$fh>;
6974: close($fh);
6975: }
1.31 albertel 6976: }
1.258 albertel 6977: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 6978: }
6979:
1.56 matthew 6980: =pod
6981:
1.112 bowersj2 6982: =item * upfile_record_sep()
1.41 ng 6983:
6984: Separate uploaded file into records
6985: returns array of records,
1.258 albertel 6986: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 6987:
6988: =cut
1.31 albertel 6989:
6990: sub upfile_record_sep {
1.258 albertel 6991: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 6992: } else {
1.248 albertel 6993: my @records;
1.258 albertel 6994: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 6995: if ($line=~/^\s*$/) { next; }
6996: push(@records,$line);
6997: }
6998: return @records;
1.31 albertel 6999: }
7000: }
7001:
1.56 matthew 7002: =pod
7003:
1.112 bowersj2 7004: =item * record_sep($record)
1.41 ng 7005:
1.258 albertel 7006: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 7007:
7008: =cut
7009:
1.263 www 7010: sub takeleft {
7011: my $index=shift;
7012: return substr('0000'.$index,-4,4);
7013: }
7014:
1.31 albertel 7015: sub record_sep {
7016: my $record=shift;
7017: my %components=();
1.258 albertel 7018: if ($env{'form.upfiletype'} eq 'xml') {
7019: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 7020: my $i=0;
1.356 albertel 7021: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 7022: $field=~s/^(\"|\')//;
7023: $field=~s/(\"|\')$//;
1.263 www 7024: $components{&takeleft($i)}=$field;
1.31 albertel 7025: $i++;
7026: }
1.258 albertel 7027: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 7028: my $i=0;
1.356 albertel 7029: foreach my $field (split(/\t/,$record)) {
1.31 albertel 7030: $field=~s/^(\"|\')//;
7031: $field=~s/(\"|\')$//;
1.263 www 7032: $components{&takeleft($i)}=$field;
1.31 albertel 7033: $i++;
7034: }
7035: } else {
1.561 www 7036: my $separator=',';
1.480 banghart 7037: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 7038: $separator=';';
1.480 banghart 7039: }
1.31 albertel 7040: my $i=0;
1.561 www 7041: # the character we are looking for to indicate the end of a quote or a record
7042: my $looking_for=$separator;
7043: # do not add the characters to the fields
7044: my $ignore=0;
7045: # we just encountered a separator (or the beginning of the record)
7046: my $just_found_separator=1;
7047: # store the field we are working on here
7048: my $field='';
7049: # work our way through all characters in record
7050: foreach my $character ($record=~/(.)/g) {
7051: if ($character eq $looking_for) {
7052: if ($character ne $separator) {
7053: # Found the end of a quote, again looking for separator
7054: $looking_for=$separator;
7055: $ignore=1;
7056: } else {
7057: # Found a separator, store away what we got
7058: $components{&takeleft($i)}=$field;
7059: $i++;
7060: $just_found_separator=1;
7061: $ignore=0;
7062: $field='';
7063: }
7064: next;
7065: }
7066: # single or double quotation marks after a separator indicate beginning of a quote
7067: # we are now looking for the end of the quote and need to ignore separators
7068: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
7069: $looking_for=$character;
7070: next;
7071: }
7072: # ignore would be true after we reached the end of a quote
7073: if ($ignore) { next; }
7074: if (($just_found_separator) && ($character=~/\s/)) { next; }
7075: $field.=$character;
7076: $just_found_separator=0;
1.31 albertel 7077: }
1.561 www 7078: # catch the very last entry, since we never encountered the separator
7079: $components{&takeleft($i)}=$field;
1.31 albertel 7080: }
7081: return %components;
7082: }
7083:
1.144 matthew 7084: ######################################################
7085: ######################################################
7086:
1.56 matthew 7087: =pod
7088:
1.112 bowersj2 7089: =item * upfile_select_html()
1.41 ng 7090:
1.144 matthew 7091: Return HTML code to select a file from the users machine and specify
7092: the file type.
1.41 ng 7093:
7094: =cut
7095:
1.144 matthew 7096: ######################################################
7097: ######################################################
1.31 albertel 7098: sub upfile_select_html {
1.144 matthew 7099: my %Types = (
7100: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 7101: semisv => &mt('Semicolon separated values'),
1.144 matthew 7102: space => &mt('Space separated'),
7103: tab => &mt('Tabulator separated'),
7104: # xml => &mt('HTML/XML'),
7105: );
7106: my $Str = '<input type="file" name="upfile" size="50" />'.
7107: '<br />Type: <select name="upfiletype">';
7108: foreach my $type (sort(keys(%Types))) {
7109: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
7110: }
7111: $Str .= "</select>\n";
7112: return $Str;
1.31 albertel 7113: }
7114:
1.301 albertel 7115: sub get_samples {
7116: my ($records,$toget) = @_;
7117: my @samples=({});
7118: my $got=0;
7119: foreach my $rec (@$records) {
7120: my %temp = &record_sep($rec);
7121: if (! grep(/\S/, values(%temp))) { next; }
7122: if (%temp) {
7123: $samples[$got]=\%temp;
7124: $got++;
7125: if ($got == $toget) { last; }
7126: }
7127: }
7128: return \@samples;
7129: }
7130:
1.144 matthew 7131: ######################################################
7132: ######################################################
7133:
1.56 matthew 7134: =pod
7135:
1.112 bowersj2 7136: =item * csv_print_samples($r,$records)
1.41 ng 7137:
7138: Prints a table of sample values from each column uploaded $r is an
7139: Apache Request ref, $records is an arrayref from
7140: &Apache::loncommon::upfile_record_sep
7141:
7142: =cut
7143:
1.144 matthew 7144: ######################################################
7145: ######################################################
1.31 albertel 7146: sub csv_print_samples {
7147: my ($r,$records) = @_;
1.301 albertel 7148: my $samples = &get_samples($records,3);
7149:
1.594 raeburn 7150: $r->print(&mt('Samples').'<br />'.&start_data_table().
7151: &start_data_table_header_row());
1.356 albertel 7152: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7153: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 7154: $r->print(&end_data_table_header_row());
1.301 albertel 7155: foreach my $hash (@$samples) {
1.594 raeburn 7156: $r->print(&start_data_table_row());
1.356 albertel 7157: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 7158: $r->print('<td>');
1.356 albertel 7159: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 7160: $r->print('</td>');
7161: }
1.594 raeburn 7162: $r->print(&end_data_table_row());
1.31 albertel 7163: }
1.594 raeburn 7164: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 7165: }
7166:
1.144 matthew 7167: ######################################################
7168: ######################################################
7169:
1.56 matthew 7170: =pod
7171:
1.112 bowersj2 7172: =item * csv_print_select_table($r,$records,$d)
1.41 ng 7173:
7174: Prints a table to create associations between values and table columns.
1.144 matthew 7175:
1.41 ng 7176: $r is an Apache Request ref,
7177: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 7178: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 7179:
7180: =cut
7181:
1.144 matthew 7182: ######################################################
7183: ######################################################
1.31 albertel 7184: sub csv_print_select_table {
7185: my ($r,$records,$d) = @_;
1.301 albertel 7186: my $i=0;
7187: my $samples = &get_samples($records,1);
1.144 matthew 7188: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 7189: &start_data_table().&start_data_table_header_row().
1.144 matthew 7190: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 7191: '<th>'.&mt('Column').'</th>'.
7192: &end_data_table_header_row()."\n");
1.356 albertel 7193: foreach my $array_ref (@$d) {
7194: my ($value,$display,$defaultcol)=@{ $array_ref };
1.594 raeburn 7195: $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
1.31 albertel 7196:
7197: $r->print('<td><select name=f'.$i.
1.32 matthew 7198: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 7199: $r->print('<option value="none"></option>');
1.356 albertel 7200: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7201: $r->print('<option value="'.$sample.'"'.
7202: ($sample eq $defaultcol ? ' selected="selected" ' : '').
7203: '>Column '.($sample+1).'</option>');
1.31 albertel 7204: }
1.594 raeburn 7205: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 7206: $i++;
7207: }
1.594 raeburn 7208: $r->print(&end_data_table());
1.31 albertel 7209: $i--;
7210: return $i;
7211: }
1.56 matthew 7212:
1.144 matthew 7213: ######################################################
7214: ######################################################
7215:
1.56 matthew 7216: =pod
1.31 albertel 7217:
1.112 bowersj2 7218: =item * csv_samples_select_table($r,$records,$d)
1.41 ng 7219:
7220: Prints a table of sample values from the upload and can make associate samples to internal names.
7221:
7222: $r is an Apache Request ref,
7223: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
7224: $d is an array of 2 element arrays (internal name, displayed name)
7225:
7226: =cut
7227:
1.144 matthew 7228: ######################################################
7229: ######################################################
1.31 albertel 7230: sub csv_samples_select_table {
7231: my ($r,$records,$d) = @_;
7232: my $i=0;
1.144 matthew 7233: #
1.301 albertel 7234: my $samples = &get_samples($records,3);
1.594 raeburn 7235: $r->print(&start_data_table().
7236: &start_data_table_header_row().'<th>'.
7237: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
7238: &end_data_table_header_row());
1.301 albertel 7239:
7240: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 7241: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 7242: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 7243: foreach my $option (@$d) {
7244: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 7245: $r->print('<option value="'.$value.'"'.
1.253 albertel 7246: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 7247: $display.'</option>');
1.31 albertel 7248: }
7249: $r->print('</select></td><td>');
1.301 albertel 7250: foreach my $line (0..2) {
7251: if (defined($samples->[$line]{$key})) {
7252: $r->print($samples->[$line]{$key}."<br />\n");
7253: }
7254: }
1.594 raeburn 7255: $r->print('</td>'.&end_data_table_row());
1.31 albertel 7256: $i++;
7257: }
1.594 raeburn 7258: $r->print(&end_data_table());
1.31 albertel 7259: $i--;
7260: return($i);
1.115 matthew 7261: }
7262:
1.144 matthew 7263: ######################################################
7264: ######################################################
7265:
1.115 matthew 7266: =pod
7267:
7268: =item clean_excel_name($name)
7269:
7270: Returns a replacement for $name which does not contain any illegal characters.
7271:
7272: =cut
7273:
1.144 matthew 7274: ######################################################
7275: ######################################################
1.115 matthew 7276: sub clean_excel_name {
7277: my ($name) = @_;
7278: $name =~ s/[:\*\?\/\\]//g;
7279: if (length($name) > 31) {
7280: $name = substr($name,0,31);
7281: }
7282: return $name;
1.25 albertel 7283: }
1.84 albertel 7284:
1.85 albertel 7285: =pod
7286:
1.112 bowersj2 7287: =item * check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 7288:
7289: Returns either 1 or undef
7290:
7291: 1 if the part is to be hidden, undef if it is to be shown
7292:
7293: Arguments are:
7294:
7295: $id the id of the part to be checked
7296: $symb, optional the symb of the resource to check
7297: $udom, optional the domain of the user to check for
7298: $uname, optional the username of the user to check for
7299:
7300: =cut
1.84 albertel 7301:
7302: sub check_if_partid_hidden {
7303: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 7304: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 7305: $symb,$udom,$uname);
1.141 albertel 7306: my $truth=1;
7307: #if the string starts with !, then the list is the list to show not hide
7308: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 7309: my @hiddenlist=split(/,/,$hiddenparts);
7310: foreach my $checkid (@hiddenlist) {
1.141 albertel 7311: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 7312: }
1.141 albertel 7313: return !$truth;
1.84 albertel 7314: }
1.127 matthew 7315:
1.138 matthew 7316:
7317: ############################################################
7318: ############################################################
7319:
7320: =pod
7321:
1.157 matthew 7322: =back
7323:
1.138 matthew 7324: =head1 cgi-bin script and graphing routines
7325:
1.157 matthew 7326: =over 4
7327:
1.138 matthew 7328: =item get_cgi_id
7329:
7330: Inputs: none
7331:
7332: Returns an id which can be used to pass environment variables
7333: to various cgi-bin scripts. These environment variables will
7334: be removed from the users environment after a given time by
7335: the routine &Apache::lonnet::transfer_profile_to_env.
7336:
7337: =cut
7338:
7339: ############################################################
7340: ############################################################
1.152 albertel 7341: my $uniq=0;
1.136 matthew 7342: sub get_cgi_id {
1.154 albertel 7343: $uniq=($uniq+1)%100000;
1.280 albertel 7344: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 7345: }
7346:
1.127 matthew 7347: ############################################################
7348: ############################################################
7349:
7350: =pod
7351:
1.134 matthew 7352: =item DrawBarGraph
1.127 matthew 7353:
1.138 matthew 7354: Facilitates the plotting of data in a (stacked) bar graph.
7355: Puts plot definition data into the users environment in order for
7356: graph.png to plot it. Returns an <img> tag for the plot.
7357: The bars on the plot are labeled '1','2',...,'n'.
7358:
7359: Inputs:
7360:
7361: =over 4
7362:
7363: =item $Title: string, the title of the plot
7364:
7365: =item $xlabel: string, text describing the X-axis of the plot
7366:
7367: =item $ylabel: string, text describing the Y-axis of the plot
7368:
7369: =item $Max: scalar, the maximum Y value to use in the plot
7370: If $Max is < any data point, the graph will not be rendered.
7371:
1.140 matthew 7372: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 7373: they are plotted. If undefined, default values will be used.
7374:
1.178 matthew 7375: =item $labels: array ref holding the labels to use on the x-axis for the bars.
7376:
1.138 matthew 7377: =item @Values: An array of array references. Each array reference holds data
7378: to be plotted in a stacked bar chart.
7379:
1.239 matthew 7380: =item If the final element of @Values is a hash reference the key/value
7381: pairs will be added to the graph definition.
7382:
1.138 matthew 7383: =back
7384:
7385: Returns:
7386:
7387: An <img> tag which references graph.png and the appropriate identifying
7388: information for the plot.
7389:
1.127 matthew 7390: =cut
7391:
7392: ############################################################
7393: ############################################################
1.134 matthew 7394: sub DrawBarGraph {
1.178 matthew 7395: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 7396: #
7397: if (! defined($colors)) {
7398: $colors = ['#33ff00',
7399: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
7400: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
7401: ];
7402: }
1.228 matthew 7403: my $extra_settings = {};
7404: if (ref($Values[-1]) eq 'HASH') {
7405: $extra_settings = pop(@Values);
7406: }
1.127 matthew 7407: #
1.136 matthew 7408: my $identifier = &get_cgi_id();
7409: my $id = 'cgi.'.$identifier;
1.129 matthew 7410: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 7411: return '';
7412: }
1.225 matthew 7413: #
7414: my @Labels;
7415: if (defined($labels)) {
7416: @Labels = @$labels;
7417: } else {
7418: for (my $i=0;$i<@{$Values[0]};$i++) {
7419: push (@Labels,$i+1);
7420: }
7421: }
7422: #
1.129 matthew 7423: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 7424: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 7425: my %ValuesHash;
7426: my $NumSets=1;
7427: foreach my $array (@Values) {
7428: next if (! ref($array));
1.136 matthew 7429: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 7430: join(',',@$array);
1.129 matthew 7431: }
1.127 matthew 7432: #
1.136 matthew 7433: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 7434: if ($NumBars < 3) {
7435: $width = 120+$NumBars*32;
1.220 matthew 7436: $xskip = 1;
1.225 matthew 7437: $bar_width = 30;
7438: } elsif ($NumBars < 5) {
7439: $width = 120+$NumBars*20;
7440: $xskip = 1;
7441: $bar_width = 20;
1.220 matthew 7442: } elsif ($NumBars < 10) {
1.136 matthew 7443: $width = 120+$NumBars*15;
7444: $xskip = 1;
7445: $bar_width = 15;
7446: } elsif ($NumBars <= 25) {
7447: $width = 120+$NumBars*11;
7448: $xskip = 5;
7449: $bar_width = 8;
7450: } elsif ($NumBars <= 50) {
7451: $width = 120+$NumBars*8;
7452: $xskip = 5;
7453: $bar_width = 4;
7454: } else {
7455: $width = 120+$NumBars*8;
7456: $xskip = 5;
7457: $bar_width = 4;
7458: }
7459: #
1.137 matthew 7460: $Max = 1 if ($Max < 1);
7461: if ( int($Max) < $Max ) {
7462: $Max++;
7463: $Max = int($Max);
7464: }
1.127 matthew 7465: $Title = '' if (! defined($Title));
7466: $xlabel = '' if (! defined($xlabel));
7467: $ylabel = '' if (! defined($ylabel));
1.369 www 7468: $ValuesHash{$id.'.title'} = &escape($Title);
7469: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
7470: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 7471: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 7472: $ValuesHash{$id.'.NumBars'} = $NumBars;
7473: $ValuesHash{$id.'.NumSets'} = $NumSets;
7474: $ValuesHash{$id.'.PlotType'} = 'bar';
7475: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7476: $ValuesHash{$id.'.height'} = $height;
7477: $ValuesHash{$id.'.width'} = $width;
7478: $ValuesHash{$id.'.xskip'} = $xskip;
7479: $ValuesHash{$id.'.bar_width'} = $bar_width;
7480: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 7481: #
1.228 matthew 7482: # Deal with other parameters
7483: while (my ($key,$value) = each(%$extra_settings)) {
7484: $ValuesHash{$id.'.'.$key} = $value;
7485: }
7486: #
1.646 raeburn 7487: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 7488: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7489: }
7490:
7491: ############################################################
7492: ############################################################
7493:
7494: =pod
7495:
7496: =item DrawXYGraph
7497:
1.138 matthew 7498: Facilitates the plotting of data in an XY graph.
7499: Puts plot definition data into the users environment in order for
7500: graph.png to plot it. Returns an <img> tag for the plot.
7501:
7502: Inputs:
7503:
7504: =over 4
7505:
7506: =item $Title: string, the title of the plot
7507:
7508: =item $xlabel: string, text describing the X-axis of the plot
7509:
7510: =item $ylabel: string, text describing the Y-axis of the plot
7511:
7512: =item $Max: scalar, the maximum Y value to use in the plot
7513: If $Max is < any data point, the graph will not be rendered.
7514:
7515: =item $colors: Array ref containing the hex color codes for the data to be
7516: plotted in. If undefined, default values will be used.
7517:
7518: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7519:
7520: =item $Ydata: Array ref containing Array refs.
1.185 www 7521: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 7522:
7523: =item %Values: hash indicating or overriding any default values which are
7524: passed to graph.png.
7525: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7526:
7527: =back
7528:
7529: Returns:
7530:
7531: An <img> tag which references graph.png and the appropriate identifying
7532: information for the plot.
7533:
1.137 matthew 7534: =cut
7535:
7536: ############################################################
7537: ############################################################
7538: sub DrawXYGraph {
7539: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
7540: #
7541: # Create the identifier for the graph
7542: my $identifier = &get_cgi_id();
7543: my $id = 'cgi.'.$identifier;
7544: #
7545: $Title = '' if (! defined($Title));
7546: $xlabel = '' if (! defined($xlabel));
7547: $ylabel = '' if (! defined($ylabel));
7548: my %ValuesHash =
7549: (
1.369 www 7550: $id.'.title' => &escape($Title),
7551: $id.'.xlabel' => &escape($xlabel),
7552: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 7553: $id.'.y_max_value'=> $Max,
7554: $id.'.labels' => join(',',@$Xlabels),
7555: $id.'.PlotType' => 'XY',
7556: );
7557: #
7558: if (defined($colors) && ref($colors) eq 'ARRAY') {
7559: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7560: }
7561: #
7562: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
7563: return '';
7564: }
7565: my $NumSets=1;
1.138 matthew 7566: foreach my $array (@{$Ydata}){
1.137 matthew 7567: next if (! ref($array));
7568: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
7569: }
1.138 matthew 7570: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 7571: #
7572: # Deal with other parameters
7573: while (my ($key,$value) = each(%Values)) {
7574: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 7575: }
7576: #
1.646 raeburn 7577: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 7578: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7579: }
7580:
7581: ############################################################
7582: ############################################################
7583:
7584: =pod
7585:
1.138 matthew 7586: =item DrawXYYGraph
7587:
7588: Facilitates the plotting of data in an XY graph with two Y axes.
7589: Puts plot definition data into the users environment in order for
7590: graph.png to plot it. Returns an <img> tag for the plot.
7591:
7592: Inputs:
7593:
7594: =over 4
7595:
7596: =item $Title: string, the title of the plot
7597:
7598: =item $xlabel: string, text describing the X-axis of the plot
7599:
7600: =item $ylabel: string, text describing the Y-axis of the plot
7601:
7602: =item $colors: Array ref containing the hex color codes for the data to be
7603: plotted in. If undefined, default values will be used.
7604:
7605: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7606:
7607: =item $Ydata1: The first data set
7608:
7609: =item $Min1: The minimum value of the left Y-axis
7610:
7611: =item $Max1: The maximum value of the left Y-axis
7612:
7613: =item $Ydata2: The second data set
7614:
7615: =item $Min2: The minimum value of the right Y-axis
7616:
7617: =item $Max2: The maximum value of the left Y-axis
7618:
7619: =item %Values: hash indicating or overriding any default values which are
7620: passed to graph.png.
7621: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7622:
7623: =back
7624:
7625: Returns:
7626:
7627: An <img> tag which references graph.png and the appropriate identifying
7628: information for the plot.
1.136 matthew 7629:
7630: =cut
7631:
7632: ############################################################
7633: ############################################################
1.137 matthew 7634: sub DrawXYYGraph {
7635: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
7636: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 7637: #
7638: # Create the identifier for the graph
7639: my $identifier = &get_cgi_id();
7640: my $id = 'cgi.'.$identifier;
7641: #
7642: $Title = '' if (! defined($Title));
7643: $xlabel = '' if (! defined($xlabel));
7644: $ylabel = '' if (! defined($ylabel));
7645: my %ValuesHash =
7646: (
1.369 www 7647: $id.'.title' => &escape($Title),
7648: $id.'.xlabel' => &escape($xlabel),
7649: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 7650: $id.'.labels' => join(',',@$Xlabels),
7651: $id.'.PlotType' => 'XY',
7652: $id.'.NumSets' => 2,
1.137 matthew 7653: $id.'.two_axes' => 1,
7654: $id.'.y1_max_value' => $Max1,
7655: $id.'.y1_min_value' => $Min1,
7656: $id.'.y2_max_value' => $Max2,
7657: $id.'.y2_min_value' => $Min2,
1.136 matthew 7658: );
7659: #
1.137 matthew 7660: if (defined($colors) && ref($colors) eq 'ARRAY') {
7661: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7662: }
7663: #
7664: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
7665: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 7666: return '';
7667: }
7668: my $NumSets=1;
1.137 matthew 7669: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 7670: next if (! ref($array));
7671: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 7672: }
7673: #
7674: # Deal with other parameters
7675: while (my ($key,$value) = each(%Values)) {
7676: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 7677: }
7678: #
1.646 raeburn 7679: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 7680: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 7681: }
7682:
7683: ############################################################
7684: ############################################################
7685:
7686: =pod
7687:
1.157 matthew 7688: =back
7689:
1.139 matthew 7690: =head1 Statistics helper routines?
7691:
7692: Bad place for them but what the hell.
7693:
1.157 matthew 7694: =over 4
7695:
1.139 matthew 7696: =item &chartlink
7697:
7698: Returns a link to the chart for a specific student.
7699:
7700: Inputs:
7701:
7702: =over 4
7703:
7704: =item $linktext: The text of the link
7705:
7706: =item $sname: The students username
7707:
7708: =item $sdomain: The students domain
7709:
7710: =back
7711:
1.157 matthew 7712: =back
7713:
1.139 matthew 7714: =cut
7715:
7716: ############################################################
7717: ############################################################
7718: sub chartlink {
7719: my ($linktext, $sname, $sdomain) = @_;
7720: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 7721: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 7722: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 7723: '">'.$linktext.'</a>';
1.153 matthew 7724: }
7725:
7726: #######################################################
7727: #######################################################
7728:
7729: =pod
7730:
7731: =head1 Course Environment Routines
1.157 matthew 7732:
7733: =over 4
1.153 matthew 7734:
7735: =item &restore_course_settings
7736:
7737: =item &store_course_settings
7738:
7739: Restores/Store indicated form parameters from the course environment.
7740: Will not overwrite existing values of the form parameters.
7741:
7742: Inputs:
7743: a scalar describing the data (e.g. 'chart', 'problem_analysis')
7744:
7745: a hash ref describing the data to be stored. For example:
7746:
7747: %Save_Parameters = ('Status' => 'scalar',
7748: 'chartoutputmode' => 'scalar',
7749: 'chartoutputdata' => 'scalar',
7750: 'Section' => 'array',
1.373 raeburn 7751: 'Group' => 'array',
1.153 matthew 7752: 'StudentData' => 'array',
7753: 'Maps' => 'array');
7754:
7755: Returns: both routines return nothing
7756:
1.631 raeburn 7757: =back
7758:
1.153 matthew 7759: =cut
7760:
7761: #######################################################
7762: #######################################################
7763: sub store_course_settings {
1.496 albertel 7764: return &store_settings($env{'request.course.id'},@_);
7765: }
7766:
7767: sub store_settings {
1.153 matthew 7768: # save to the environment
7769: # appenv the same items, just to be safe
1.300 albertel 7770: my $udom = $env{'user.domain'};
7771: my $uname = $env{'user.name'};
1.496 albertel 7772: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7773: my %SaveHash;
7774: my %AppHash;
7775: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 7776: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 7777: my $envname = 'environment.'.$basename;
1.258 albertel 7778: if (exists($env{'form.'.$setting})) {
1.153 matthew 7779: # Save this value away
7780: if ($type eq 'scalar' &&
1.258 albertel 7781: (! exists($env{$envname}) ||
7782: $env{$envname} ne $env{'form.'.$setting})) {
7783: $SaveHash{$basename} = $env{'form.'.$setting};
7784: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 7785: } elsif ($type eq 'array') {
7786: my $stored_form;
1.258 albertel 7787: if (ref($env{'form.'.$setting})) {
1.153 matthew 7788: $stored_form = join(',',
7789: map {
1.369 www 7790: &escape($_);
1.258 albertel 7791: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 7792: } else {
7793: $stored_form =
1.369 www 7794: &escape($env{'form.'.$setting});
1.153 matthew 7795: }
7796: # Determine if the array contents are the same.
1.258 albertel 7797: if ($stored_form ne $env{$envname}) {
1.153 matthew 7798: $SaveHash{$basename} = $stored_form;
7799: $AppHash{$envname} = $stored_form;
7800: }
7801: }
7802: }
7803: }
7804: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 7805: $udom,$uname);
1.153 matthew 7806: if ($put_result !~ /^(ok|delayed)/) {
7807: &Apache::lonnet::logthis('unable to save form parameters, '.
7808: 'got error:'.$put_result);
7809: }
7810: # Make sure these settings stick around in this session, too
1.646 raeburn 7811: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 7812: return;
7813: }
7814:
7815: sub restore_course_settings {
1.499 albertel 7816: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 7817: }
7818:
7819: sub restore_settings {
7820: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7821: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 7822: next if (exists($env{'form.'.$setting}));
1.496 albertel 7823: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 7824: '.'.$setting;
1.258 albertel 7825: if (exists($env{$envname})) {
1.153 matthew 7826: if ($type eq 'scalar') {
1.258 albertel 7827: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 7828: } elsif ($type eq 'array') {
1.258 albertel 7829: $env{'form.'.$setting} = [
1.153 matthew 7830: map {
1.369 www 7831: &unescape($_);
1.258 albertel 7832: } split(',',$env{$envname})
1.153 matthew 7833: ];
7834: }
7835: }
7836: }
1.127 matthew 7837: }
7838:
1.618 raeburn 7839: #######################################################
7840: #######################################################
7841:
7842: =pod
7843:
7844: =head1 Domain E-mail Routines
7845:
7846: =over 4
7847:
7848: =item &build_recipient_list
7849:
7850: Build recipient lists for three types of e-mail:
7851: (a) Error Reports, (b) Package Updates, (c) Help requests, generated by
1.619 raeburn 7852: lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively.
1.618 raeburn 7853:
7854: Inputs:
1.619 raeburn 7855: defmail (scalar - email address of default recipient),
1.618 raeburn 7856: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 7857: defdom (domain for which to retrieve configuration settings),
7858: origmail (scalar - email address of recipient from loncapa.conf,
7859: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 7860:
7861: Returns: comma separated list of addresses to which to send e-mail.
7862:
7863: =cut
7864:
7865: ############################################################
7866: ############################################################
7867: sub build_recipient_list {
1.619 raeburn 7868: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 7869: my @recipients;
7870: my $otheremails;
7871: my %domconfig =
7872: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
7873: if (ref($domconfig{'contacts'}) eq 'HASH') {
7874: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
7875: my @contacts = ('adminemail','supportemail');
7876: foreach my $item (@contacts) {
7877: if ($domconfig{'contacts'}{$mailing}{$item}) {
1.619 raeburn 7878: my $addr = $domconfig{'contacts'}{$item};
7879: if (!grep(/^\Q$addr\E$/,@recipients)) {
7880: push(@recipients,$addr);
7881: }
1.618 raeburn 7882: }
7883: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
7884: }
7885: }
1.619 raeburn 7886: } elsif ($origmail ne '') {
7887: push(@recipients,$origmail);
1.618 raeburn 7888: }
7889: if ($defmail ne '') {
7890: push(@recipients,$defmail);
7891: }
7892: if ($otheremails) {
1.619 raeburn 7893: my @others;
7894: if ($otheremails =~ /,/) {
7895: @others = split(/,/,$otheremails);
1.618 raeburn 7896: } else {
1.619 raeburn 7897: push(@others,$otheremails);
7898: }
7899: foreach my $addr (@others) {
7900: if (!grep(/^\Q$addr\E$/,@recipients)) {
7901: push(@recipients,$addr);
7902: }
1.618 raeburn 7903: }
7904: }
1.619 raeburn 7905: my $recipientlist = join(',',@recipients);
1.618 raeburn 7906: return $recipientlist;
7907: }
7908:
1.127 matthew 7909: ############################################################
7910: ############################################################
1.154 albertel 7911:
1.443 albertel 7912: sub commit_customrole {
7913: my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
1.630 raeburn 7914: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 7915: ($start?', '.&mt('starting').' '.localtime($start):'').
7916: ($end?', ending '.localtime($end):'').': <b>'.
7917: &Apache::lonnet::assigncustomrole(
7918: $udom,$uname,$url,$three,$four,$five,$end,$start).
7919: '</b><br />';
7920: return $output;
7921: }
7922:
7923: sub commit_standardrole {
1.541 raeburn 7924: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7925: my ($output,$logmsg,$linefeed);
7926: if ($context eq 'auto') {
7927: $linefeed = "\n";
7928: } else {
7929: $linefeed = "<br />\n";
7930: }
1.443 albertel 7931: if ($three eq 'st') {
1.541 raeburn 7932: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
7933: $one,$two,$sec,$context);
7934: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 7935: ($result eq 'unknown_course') || ($result eq 'refused')) {
7936: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 7937: } else {
1.541 raeburn 7938: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 7939: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7940: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7941: if ($context eq 'auto') {
7942: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
7943: } else {
7944: $output .= '<b>'.$result.'</b>'.$linefeed.
7945: &mt('Add to classlist').': <b>ok</b>';
7946: }
7947: $output .= $linefeed;
1.443 albertel 7948: }
7949: } else {
7950: $output = &mt('Assigning').' '.$three.' in '.$url.
7951: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7952: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7953: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
7954: if ($context eq 'auto') {
7955: $output .= $result.$linefeed;
7956: } else {
7957: $output .= '<b>'.$result.'</b>'.$linefeed;
7958: }
1.443 albertel 7959: }
7960: return $output;
7961: }
7962:
7963: sub commit_studentrole {
1.541 raeburn 7964: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 7965: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 7966: if ($context eq 'auto') {
7967: $linefeed = "\n";
7968: } else {
7969: $linefeed = '<br />'."\n";
7970: }
1.443 albertel 7971: if (defined($one) && defined($two)) {
7972: my $cid=$one.'_'.$two;
7973: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
7974: my $secchange = 0;
7975: my $expire_role_result;
7976: my $modify_section_result;
1.628 raeburn 7977: if ($oldsec ne '-1') {
7978: if ($oldsec ne $sec) {
1.443 albertel 7979: $secchange = 1;
1.628 raeburn 7980: my $now = time;
1.443 albertel 7981: my $uurl='/'.$cid;
7982: $uurl=~s/\_/\//g;
7983: if ($oldsec) {
7984: $uurl.='/'.$oldsec;
7985: }
1.626 raeburn 7986: $oldsecurl = $uurl;
1.628 raeburn 7987: $expire_role_result =
7988: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);
7989: if ($env{'request.course.sec'} ne '') {
7990: if ($expire_role_result eq 'refused') {
7991: my @roles = ('st');
7992: my @statuses = ('previous');
7993: my @roledoms = ($one);
7994: my $withsec = 1;
7995: my %roleshash =
7996: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
7997: \@statuses,\@roles,\@roledoms,$withsec);
7998: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
7999: my ($oldstart,$oldend) =
8000: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
8001: if ($oldend > 0 && $oldend <= $now) {
8002: $expire_role_result = 'ok';
8003: }
8004: }
8005: }
8006: }
1.443 albertel 8007: $result = $expire_role_result;
8008: }
8009: }
8010: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
8011: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
8012: if ($modify_section_result =~ /^ok/) {
8013: if ($secchange == 1) {
1.628 raeburn 8014: if ($sec eq '') {
8015: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
8016: } else {
8017: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
8018: }
1.443 albertel 8019: } elsif ($oldsec eq '-1') {
1.628 raeburn 8020: if ($sec eq '') {
8021: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
8022: } else {
8023: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
8024: }
1.443 albertel 8025: } else {
1.628 raeburn 8026: if ($sec eq '') {
8027: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
8028: } else {
8029: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
8030: }
1.443 albertel 8031: }
8032: } else {
1.628 raeburn 8033: if ($secchange) {
8034: $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
8035: } else {
8036: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
8037: }
1.443 albertel 8038: }
8039: $result = $modify_section_result;
8040: } elsif ($secchange == 1) {
1.628 raeburn 8041: if ($oldsec eq '') {
8042: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
8043: } else {
8044: $$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
8045: }
1.626 raeburn 8046: if ($expire_role_result eq 'refused') {
8047: my $newsecurl = '/'.$cid;
8048: $newsecurl =~ s/\_/\//g;
8049: if ($sec ne '') {
8050: $newsecurl.='/'.$sec;
8051: }
8052: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
8053: if ($sec eq '') {
8054: $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed;
8055: } else {
8056: $$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed;
8057: }
8058: }
8059: }
1.443 albertel 8060: }
8061: } else {
1.626 raeburn 8062: $$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed;
1.443 albertel 8063: $result = "error: incomplete course id\n";
8064: }
8065: return $result;
8066: }
8067:
8068: ############################################################
8069: ############################################################
8070:
1.566 albertel 8071: sub check_clone {
1.578 raeburn 8072: my ($args,$linefeed) = @_;
1.566 albertel 8073: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
8074: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
8075: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
8076: my $clonemsg;
8077: my $can_clone = 0;
8078:
8079: if ($clonehome eq 'no_host') {
1.578 raeburn 8080: $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 8081: } else {
8082: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 8083: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 8084: $can_clone = 1;
8085: } else {
8086: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
8087: $args->{'clonedomain'},$args->{'clonecourse'});
8088: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 8089: if (grep(/^\*$/,@cloners)) {
8090: $can_clone = 1;
8091: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
8092: $can_clone = 1;
8093: } else {
8094: my %roleshash =
8095: &Apache::lonnet::get_my_roles($args->{'ccuname'},
8096: $args->{'ccdomain'},
8097: 'userroles',['active'],['cc'],
8098: [$args->{'clonedomain'}]);
8099: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
8100: $can_clone = 1;
8101: } else {
8102: $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'});
8103: }
1.566 albertel 8104: }
1.578 raeburn 8105: }
1.566 albertel 8106: }
8107: return ($can_clone, $clonemsg, $cloneid, $clonehome);
8108: }
8109:
1.444 albertel 8110: sub construct_course {
1.541 raeburn 8111: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 8112: my $outcome;
1.541 raeburn 8113: my $linefeed = '<br />'."\n";
8114: if ($context eq 'auto') {
8115: $linefeed = "\n";
8116: }
1.566 albertel 8117:
8118: #
8119: # Are we cloning?
8120: #
8121: my ($can_clone, $clonemsg, $cloneid, $clonehome);
8122: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 8123: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 8124: if ($context ne 'auto') {
1.578 raeburn 8125: if ($clonemsg ne '') {
8126: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
8127: }
1.566 albertel 8128: }
8129: $outcome .= $clonemsg.$linefeed;
8130:
8131: if (!$can_clone) {
8132: return (0,$outcome);
8133: }
8134: }
8135:
1.444 albertel 8136: #
8137: # Open course
8138: #
8139: my $crstype = lc($args->{'crstype'});
8140: my %cenv=();
8141: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
8142: $args->{'cdescr'},
8143: $args->{'curl'},
8144: $args->{'course_home'},
8145: $args->{'nonstandard'},
8146: $args->{'crscode'},
8147: $args->{'ccuname'}.':'.
8148: $args->{'ccdomain'},
8149: $args->{'crstype'});
8150:
8151: # Note: The testing routines depend on this being output; see
8152: # Utils::Course. This needs to at least be output as a comment
8153: # if anyone ever decides to not show this, and Utils::Course::new
8154: # will need to be suitably modified.
1.541 raeburn 8155: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 8156: #
8157: # Check if created correctly
8158: #
1.479 albertel 8159: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 8160: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 8161: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 8162:
1.444 albertel 8163: #
1.566 albertel 8164: # Do the cloning
8165: #
8166: if ($can_clone && $cloneid) {
8167: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
8168: if ($context ne 'auto') {
8169: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
8170: }
8171: $outcome .= $clonemsg.$linefeed;
8172: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 8173: # Copy all files
1.637 www 8174: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 8175: # Restore URL
1.566 albertel 8176: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 8177: # Restore title
1.566 albertel 8178: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 8179: # Mark as cloned
1.566 albertel 8180: $cenv{'clonedfrom'}=$cloneid;
1.638 www 8181: # Need to clone grading mode
8182: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
8183: $cenv{'grading'}=$newenv{'grading'};
8184: # Do not clone these environment entries
8185: &Apache::lonnet::del('environment',
8186: ['default_enrollment_start_date',
8187: 'default_enrollment_end_date',
8188: 'question.email',
8189: 'policy.email',
8190: 'comment.email',
8191: 'pch.users.denied',
8192: 'plc.users.denied'],
8193: $$crsudom,$$crsunum);
1.444 albertel 8194: }
1.566 albertel 8195:
1.444 albertel 8196: #
8197: # Set environment (will override cloned, if existing)
8198: #
8199: my @sections = ();
8200: my @xlists = ();
8201: if ($args->{'crstype'}) {
8202: $cenv{'type'}=$args->{'crstype'};
8203: }
8204: if ($args->{'crsid'}) {
8205: $cenv{'courseid'}=$args->{'crsid'};
8206: }
8207: if ($args->{'crscode'}) {
8208: $cenv{'internal.coursecode'}=$args->{'crscode'};
8209: }
8210: if ($args->{'crsquota'} ne '') {
8211: $cenv{'internal.coursequota'}=$args->{'crsquota'};
8212: } else {
8213: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
8214: }
8215: if ($args->{'ccuname'}) {
8216: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
8217: ':'.$args->{'ccdomain'};
8218: } else {
8219: $cenv{'internal.courseowner'} = $args->{'curruser'};
8220: }
8221: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
8222: if ($args->{'crssections'}) {
8223: $cenv{'internal.sectionnums'} = '';
8224: if ($args->{'crssections'} =~ m/,/) {
8225: @sections = split/,/,$args->{'crssections'};
8226: } else {
8227: $sections[0] = $args->{'crssections'};
8228: }
8229: if (@sections > 0) {
8230: foreach my $item (@sections) {
8231: my ($sec,$gp) = split/:/,$item;
8232: my $class = $args->{'crscode'}.$sec;
8233: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
8234: $cenv{'internal.sectionnums'} .= $item.',';
8235: unless ($addcheck eq 'ok') {
8236: push @badclasses, $class;
8237: }
8238: }
8239: $cenv{'internal.sectionnums'} =~ s/,$//;
8240: }
8241: }
8242: # do not hide course coordinator from staff listing,
8243: # even if privileged
8244: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8245: # add crosslistings
8246: if ($args->{'crsxlist'}) {
8247: $cenv{'internal.crosslistings'}='';
8248: if ($args->{'crsxlist'} =~ m/,/) {
8249: @xlists = split/,/,$args->{'crsxlist'};
8250: } else {
8251: $xlists[0] = $args->{'crsxlist'};
8252: }
8253: if (@xlists > 0) {
8254: foreach my $item (@xlists) {
8255: my ($xl,$gp) = split/:/,$item;
8256: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
8257: $cenv{'internal.crosslistings'} .= $item.',';
8258: unless ($addcheck eq 'ok') {
8259: push @badclasses, $xl;
8260: }
8261: }
8262: $cenv{'internal.crosslistings'} =~ s/,$//;
8263: }
8264: }
8265: if ($args->{'autoadds'}) {
8266: $cenv{'internal.autoadds'}=$args->{'autoadds'};
8267: }
8268: if ($args->{'autodrops'}) {
8269: $cenv{'internal.autodrops'}=$args->{'autodrops'};
8270: }
8271: # check for notification of enrollment changes
8272: my @notified = ();
8273: if ($args->{'notify_owner'}) {
8274: if ($args->{'ccuname'} ne '') {
8275: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
8276: }
8277: }
8278: if ($args->{'notify_dc'}) {
8279: if ($uname ne '') {
1.630 raeburn 8280: push(@notified,$uname.':'.$udom);
1.444 albertel 8281: }
8282: }
8283: if (@notified > 0) {
8284: my $notifylist;
8285: if (@notified > 1) {
8286: $notifylist = join(',',@notified);
8287: } else {
8288: $notifylist = $notified[0];
8289: }
8290: $cenv{'internal.notifylist'} = $notifylist;
8291: }
8292: if (@badclasses > 0) {
8293: my %lt=&Apache::lonlocal::texthash(
8294: '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',
8295: 'dnhr' => 'does not have rights to access enrollment in these classes',
8296: 'adby' => 'as determined by the policies of your institution on access to official classlists'
8297: );
1.541 raeburn 8298: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
8299: ' ('.$lt{'adby'}.')';
8300: if ($context eq 'auto') {
8301: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 8302: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 8303: foreach my $item (@badclasses) {
8304: if ($context eq 'auto') {
8305: $outcome .= " - $item\n";
8306: } else {
8307: $outcome .= "<li>$item</li>\n";
8308: }
8309: }
8310: if ($context eq 'auto') {
8311: $outcome .= $linefeed;
8312: } else {
1.566 albertel 8313: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 8314: }
8315: }
1.444 albertel 8316: }
8317: if ($args->{'no_end_date'}) {
8318: $args->{'endaccess'} = 0;
8319: }
8320: $cenv{'internal.autostart'}=$args->{'enrollstart'};
8321: $cenv{'internal.autoend'}=$args->{'enrollend'};
8322: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
8323: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
8324: if ($args->{'showphotos'}) {
8325: $cenv{'internal.showphotos'}=$args->{'showphotos'};
8326: }
8327: $cenv{'internal.authtype'} = $args->{'authtype'};
8328: $cenv{'internal.autharg'} = $args->{'autharg'};
8329: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
8330: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 8331: 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');
8332: if ($context eq 'auto') {
8333: $outcome .= $krb_msg;
8334: } else {
1.566 albertel 8335: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 8336: }
8337: $outcome .= $linefeed;
1.444 albertel 8338: }
8339: }
8340: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
8341: if ($args->{'setpolicy'}) {
8342: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8343: }
8344: if ($args->{'setcontent'}) {
8345: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8346: }
8347: }
8348: if ($args->{'reshome'}) {
8349: $cenv{'reshome'}=$args->{'reshome'}.'/';
8350: $cenv{'reshome'}=~s/\/+$/\//;
8351: }
8352: #
8353: # course has keyed access
8354: #
8355: if ($args->{'setkeys'}) {
8356: $cenv{'keyaccess'}='yes';
8357: }
8358: # if specified, key authority is not course, but user
8359: # only active if keyaccess is yes
8360: if ($args->{'keyauth'}) {
1.487 albertel 8361: my ($user,$domain) = split(':',$args->{'keyauth'});
8362: $user = &LONCAPA::clean_username($user);
8363: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 8364: if ($user ne '' && $domain ne '') {
1.487 albertel 8365: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 8366: }
8367: }
8368:
8369: if ($args->{'disresdis'}) {
8370: $cenv{'pch.roles.denied'}='st';
8371: }
8372: if ($args->{'disablechat'}) {
8373: $cenv{'plc.roles.denied'}='st';
8374: }
8375:
8376: # Record we've not yet viewed the Course Initialization Helper for this
8377: # course
8378: $cenv{'course.helper.not.run'} = 1;
8379: #
8380: # Use new Randomseed
8381: #
8382: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
8383: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
8384: #
8385: # The encryption code and receipt prefix for this course
8386: #
8387: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
8388: $cenv{'internal.encpref'}=100+int(9*rand(99));
8389: #
8390: # By default, use standard grading
8391: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
8392:
1.541 raeburn 8393: $outcome .= $linefeed.&mt('Setting environment').': '.
8394: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 8395: #
8396: # Open all assignments
8397: #
8398: if ($args->{'openall'}) {
8399: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
8400: my %storecontent = ($storeunder => time,
8401: $storeunder.'.type' => 'date_start');
8402:
8403: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 8404: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 8405: }
8406: #
8407: # Set first page
8408: #
8409: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
8410: || ($cloneid)) {
1.445 albertel 8411: use LONCAPA::map;
1.444 albertel 8412: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 8413:
8414: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
8415: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
8416:
1.444 albertel 8417: $outcome .= ($fatal?$errtext:'read ok').' - ';
8418: my $title; my $url;
8419: if ($args->{'firstres'} eq 'syl') {
8420: $title='Syllabus';
8421: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
8422: } else {
8423: $title='Navigate Contents';
8424: $url='/adm/navmaps';
8425: }
1.445 albertel 8426:
8427: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
8428: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
8429:
8430: if ($errtext) { $fatal=2; }
1.541 raeburn 8431: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 8432: }
1.566 albertel 8433:
8434: return (1,$outcome);
1.444 albertel 8435: }
8436:
8437: ############################################################
8438: ############################################################
8439:
1.378 raeburn 8440: sub course_type {
8441: my ($cid) = @_;
8442: if (!defined($cid)) {
8443: $cid = $env{'request.course.id'};
8444: }
1.404 albertel 8445: if (defined($env{'course.'.$cid.'.type'})) {
8446: return $env{'course.'.$cid.'.type'};
1.378 raeburn 8447: } else {
8448: return 'Course';
1.377 raeburn 8449: }
8450: }
1.156 albertel 8451:
1.406 raeburn 8452: sub group_term {
8453: my $crstype = &course_type();
8454: my %names = (
8455: 'Course' => 'group',
8456: 'Group' => 'team',
8457: );
8458: return $names{$crstype};
8459: }
8460:
1.156 albertel 8461: sub icon {
8462: my ($file)=@_;
1.505 albertel 8463: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 8464: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 8465: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 8466: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
8467: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
8468: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8469: $curfext.".gif") {
8470: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8471: $curfext.".gif";
8472: }
8473: }
1.249 albertel 8474: return &lonhttpdurl($iconname);
1.154 albertel 8475: }
1.84 albertel 8476:
1.575 albertel 8477: sub lonhttpd_port {
1.215 albertel 8478: my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
8479: if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
1.574 albertel 8480: # IE doesn't like a secure page getting images from a non-secure
8481: # port (when logging we haven't parsed the browser type so default
8482: # back to secure
8483: if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
8484: && $ENV{'SERVER_PORT'} == 443) {
1.575 albertel 8485: return 443;
8486: }
8487: return $lonhttpd_port;
8488:
8489: }
8490:
8491: sub lonhttpdurl {
8492: my ($url)=@_;
8493:
8494: my $lonhttpd_port = &lonhttpd_port();
8495: if ($lonhttpd_port == 443) {
1.574 albertel 8496: return 'https://'.$ENV{'SERVER_NAME'}.$url;
8497: }
1.215 albertel 8498: return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
8499: }
8500:
1.213 albertel 8501: sub connection_aborted {
8502: my ($r)=@_;
8503: $r->print(" ");$r->rflush();
8504: my $c = $r->connection;
8505: return $c->aborted();
8506: }
8507:
1.221 foxr 8508: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 8509: # strings as 'strings'.
8510: sub escape_single {
1.221 foxr 8511: my ($input) = @_;
1.223 albertel 8512: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 8513: $input =~ s/\'/\\\'/g; # Esacpe the 's....
8514: return $input;
8515: }
1.223 albertel 8516:
1.222 foxr 8517: # Same as escape_single, but escape's "'s This
8518: # can be used for "strings"
8519: sub escape_double {
8520: my ($input) = @_;
8521: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
8522: $input =~ s/\"/\\\"/g; # Esacpe the "s....
8523: return $input;
8524: }
1.223 albertel 8525:
1.222 foxr 8526: # Escapes the last element of a full URL.
8527: sub escape_url {
8528: my ($url) = @_;
1.238 raeburn 8529: my @urlslices = split(/\//, $url,-1);
1.369 www 8530: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 8531: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 8532: }
1.462 albertel 8533:
8534: # -------------------------------------------------------- Initliaze user login
8535: sub init_user_environment {
1.463 albertel 8536: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 8537: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
8538:
8539: my $public=($username eq 'public' && $domain eq 'public');
8540:
8541: # See if old ID present, if so, remove
8542:
8543: my ($filename,$cookie,$userroles);
8544: my $now=time;
8545:
8546: if ($public) {
8547: my $max_public=100;
8548: my $oldest;
8549: my $oldest_time=0;
8550: for(my $next=1;$next<=$max_public;$next++) {
8551: if (-e $lonids."/publicuser_$next.id") {
8552: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
8553: if ($mtime<$oldest_time || !$oldest_time) {
8554: $oldest_time=$mtime;
8555: $oldest=$next;
8556: }
8557: } else {
8558: $cookie="publicuser_$next";
8559: last;
8560: }
8561: }
8562: if (!$cookie) { $cookie="publicuser_$oldest"; }
8563: } else {
1.463 albertel 8564: # if this isn't a robot, kill any existing non-robot sessions
8565: if (!$args->{'robot'}) {
8566: opendir(DIR,$lonids);
8567: while ($filename=readdir(DIR)) {
8568: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
8569: unlink($lonids.'/'.$filename);
8570: }
1.462 albertel 8571: }
1.463 albertel 8572: closedir(DIR);
1.462 albertel 8573: }
8574: # Give them a new cookie
1.463 albertel 8575: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
8576: : $now);
8577: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 8578:
8579: # Initialize roles
8580:
8581: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
8582: }
8583: # ------------------------------------ Check browser type and MathML capability
8584:
8585: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
8586: $clientunicode,$clientos) = &decode_user_agent($r);
8587:
8588: # -------------------------------------- Any accessibility options to remember?
8589: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
8590: foreach my $option ('imagesuppress','appletsuppress',
8591: 'embedsuppress','fontenhance','blackwhite') {
8592: if ($form->{$option} eq 'true') {
8593: &Apache::lonnet::put('environment',{$option => 'on'},
8594: $domain,$username);
8595: } else {
8596: &Apache::lonnet::del('environment',[$option],
8597: $domain,$username);
8598: }
8599: }
8600: }
8601: # ------------------------------------------------------------- Get environment
8602:
8603: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
8604: my ($tmp) = keys(%userenv);
8605: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8606: # default remote control to off
8607: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
8608: } else {
8609: undef(%userenv);
8610: }
8611: if (($userenv{'interface'}) && (!$form->{'interface'})) {
8612: $form->{'interface'}=$userenv{'interface'};
8613: }
8614: $env{'environment.remote'}=$userenv{'remote'};
8615: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
8616:
8617: # --------------- Do not trust query string to be put directly into environment
8618: foreach my $option ('imagesuppress','appletsuppress',
8619: 'embedsuppress','fontenhance','blackwhite',
8620: 'interface','localpath','localres') {
8621: $form->{$option}=~s/[\n\r\=]//gs;
8622: }
8623: # --------------------------------------------------------- Write first profile
8624:
8625: {
8626: my %initial_env =
8627: ("user.name" => $username,
8628: "user.domain" => $domain,
8629: "user.home" => $authhost,
8630: "browser.type" => $clientbrowser,
8631: "browser.version" => $clientversion,
8632: "browser.mathml" => $clientmathml,
8633: "browser.unicode" => $clientunicode,
8634: "browser.os" => $clientos,
8635: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
8636: "request.course.fn" => '',
8637: "request.course.uri" => '',
8638: "request.course.sec" => '',
8639: "request.role" => 'cm',
8640: "request.role.adv" => $env{'user.adv'},
8641: "request.host" => $ENV{'REMOTE_ADDR'},);
8642:
8643: if ($form->{'localpath'}) {
8644: $initial_env{"browser.localpath"} = $form->{'localpath'};
8645: $initial_env{"browser.localres"} = $form->{'localres'};
8646: }
8647:
8648: if ($public) {
8649: $initial_env{"environment.remote"} = "off";
8650: }
8651: if ($form->{'interface'}) {
8652: $form->{'interface'}=~s/\W//gs;
8653: $initial_env{"browser.interface"} = $form->{'interface'};
8654: $env{'browser.interface'}=$form->{'interface'};
8655: foreach my $option ('imagesuppress','appletsuppress',
8656: 'embedsuppress','fontenhance','blackwhite') {
8657: if (($form->{$option} eq 'true') ||
8658: ($userenv{$option} eq 'on')) {
8659: $initial_env{"browser.$option"} = "on";
8660: }
8661: }
8662: }
8663:
8664: $env{'user.environment'} = "$lonids/$cookie.id";
8665:
8666: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
8667: &GDBM_WRCREAT(),0640)) {
8668: &_add_to_env(\%disk_env,\%initial_env);
8669: &_add_to_env(\%disk_env,\%userenv,'environment.');
8670: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 8671: if (ref($args->{'extra_env'})) {
8672: &_add_to_env(\%disk_env,$args->{'extra_env'});
8673: }
1.462 albertel 8674: untie(%disk_env);
8675: } else {
8676: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
8677: 'Could not create environment storage in lonauth: '.$!.'</font>');
8678: return 'error: '.$!;
8679: }
8680: }
8681: $env{'request.role'}='cm';
8682: $env{'request.role.adv'}=$env{'user.adv'};
8683: $env{'browser.type'}=$clientbrowser;
8684:
8685: return $cookie;
8686:
8687: }
8688:
8689: sub _add_to_env {
8690: my ($idf,$env_data,$prefix) = @_;
8691: while (my ($key,$value) = each(%$env_data)) {
8692: $idf->{$prefix.$key} = $value;
8693: $env{$prefix.$key} = $value;
8694: }
8695: }
8696:
8697:
1.41 ng 8698: =pod
8699:
8700: =back
8701:
1.112 bowersj2 8702: =cut
1.41 ng 8703:
1.112 bowersj2 8704: 1;
8705: __END__;
1.41 ng 8706:
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