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