Annotation of loncom/interface/loncommon.pm, revision 1.636.2.4
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.636.2.4! raeburn 4: # $Id: loncommon.pm,v 1.636.2.3 2008/03/18 23:00:51 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.636.2.4! raeburn 81: # ----------------------------------------------- SSI with retries:
! 82: #
! 83:
! 84: =pod
! 85:
! 86: =head1 Server Side include with retries:
! 87:
! 88: =over 4
! 89:
! 90: =item * &ssi_with_retries(resource,retries form)
! 91:
! 92: Performs an ssi with some number of retries. Retries continue either
! 93: until the result is ok or until the retry count supplied by the
! 94: caller is exhausted.
! 95:
! 96: Inputs:
! 97:
! 98: =over 4
! 99:
! 100: resource - Identifies the resource to insert.
! 101:
! 102: retries - Count of the number of retries allowed.
! 103:
! 104: form - Hash that identifies the rendering options.
! 105:
! 106: =back
! 107:
! 108: Returns:
! 109:
! 110: =over 4
! 111:
! 112: content - The content of the response. If retries were exhausted this is empty.
! 113:
! 114: response - The response from the last attempt (which may or may not have been successful.
! 115:
! 116: =back
! 117:
! 118: =back
! 119:
! 120: =cut
! 121:
! 122: sub ssi_with_retries {
! 123: my ($resource, $retries, %form) = @_;
! 124:
! 125:
! 126: my $ok = 0; # True if we got a good response.
! 127: my $content;
! 128: my $response;
! 129:
! 130: # Try to get the ssi done. within the retries count:
! 131:
! 132: do {
! 133: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
! 134: $ok = $response->is_success;
! 135: $retries--;
! 136: } while (!$ok && ($retries > 0));
! 137:
! 138: if (!$ok) {
! 139: $content = ''; # On error return an empty content.
! 140: }
! 141: return ($content, $response);
! 142:
! 143: }
! 144:
! 145:
! 146:
1.20 www 147: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 148: my %language;
1.124 www 149: my %supported_language;
1.12 harris41 150: my %cprtag;
1.192 taceyjo1 151: my %scprtag;
1.351 www 152: my %fe; my %fd; my %fm;
1.41 ng 153: my %category_extensions;
1.12 harris41 154:
1.46 matthew 155: # ---------------------------------------------- Thesaurus variables
1.144 matthew 156: #
157: # %Keywords:
158: # A hash used by &keyword to determine if a word is considered a keyword.
159: # $thesaurus_db_file
160: # Scalar containing the full path to the thesaurus database.
1.46 matthew 161:
162: my %Keywords;
163: my $thesaurus_db_file;
164:
1.144 matthew 165: #
166: # Initialize values from language.tab, copyright.tab, filetypes.tab,
167: # thesaurus.tab, and filecategories.tab.
168: #
1.18 www 169: BEGIN {
1.46 matthew 170: # Variable initialization
171: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
172: #
1.22 www 173: unless ($readit) {
1.12 harris41 174: # ------------------------------------------------------------------- languages
175: {
1.158 raeburn 176: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
177: '/language.tab';
178: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 179: while (my $line = <$fh>) {
180: next if ($line=~/^\#/);
181: chomp($line);
182: my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158 raeburn 183: $language{$key}=$val.' - '.$enc;
184: if ($sup) {
185: $supported_language{$key}=$sup;
186: }
187: }
188: close($fh);
189: }
1.12 harris41 190: }
191: # ------------------------------------------------------------------ copyrights
192: {
1.158 raeburn 193: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
194: '/copyright.tab';
195: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 196: while (my $line = <$fh>) {
197: next if ($line=~/^\#/);
198: chomp($line);
199: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 200: $cprtag{$key}=$val;
201: }
202: close($fh);
203: }
1.12 harris41 204: }
1.351 www 205: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 206: {
207: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
208: '/source_copyright.tab';
209: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 210: while (my $line = <$fh>) {
211: next if ($line =~ /^\#/);
212: chomp($line);
213: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 214: $scprtag{$key}=$val;
215: }
216: close($fh);
217: }
218: }
1.63 www 219:
1.517 raeburn 220: # -------------------------------------------------------------- default domain designs
1.63 www 221: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 222: my $designfile = $designdir.'/default.tab';
223: if ( open (my $fh,"<$designfile") ) {
224: while (my $line = <$fh>) {
225: next if ($line =~ /^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\=/,$line));
228: if ($val) { $defaultdesign{$key}=$val; }
229: }
230: close($fh);
1.63 www 231: }
232:
1.15 harris41 233: # ------------------------------------------------------------- file categories
234: {
1.158 raeburn 235: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
236: '/filecategories.tab';
237: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 242: push @{$category_extensions{lc($category)}},$extension;
243: }
244: close($fh);
245: }
246:
1.15 harris41 247: }
1.12 harris41 248: # ------------------------------------------------------------------ file types
249: {
1.158 raeburn 250: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
251: '/filetypes.tab';
252: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 253: while (my $line = <$fh>) {
254: next if ($line =~ /^\#/);
255: chomp($line);
256: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 257: if ($descr ne '') {
258: $fe{$ending}=lc($emb);
259: $fd{$ending}=$descr;
1.351 www 260: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 261: }
262: }
263: close($fh);
264: }
1.12 harris41 265: }
1.22 www 266: &Apache::lonnet::logthis(
1.46 matthew 267: "<font color=yellow>INFO: Read file types</font>");
1.22 www 268: $readit=1;
1.46 matthew 269: } # end of unless($readit)
1.32 matthew 270:
271: }
1.112 bowersj2 272:
1.42 matthew 273: ###############################################################
274: ## HTML and Javascript Helper Functions ##
275: ###############################################################
276:
277: =pod
278:
1.112 bowersj2 279: =head1 HTML and Javascript Functions
1.42 matthew 280:
1.112 bowersj2 281: =over 4
282:
283: =item * browser_and_searcher_javascript ()
284:
285: X<browsing, javascript>X<searching, javascript>Returns a string
286: containing javascript with two functions, C<openbrowser> and
287: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
288: tags.
1.42 matthew 289:
1.112 bowersj2 290: =item * openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 291:
292: inputs: formname, elementname, only, omit
293:
294: formname and elementname indicate the name of the html form and name of
295: the element that the results of the browsing selection are to be placed in.
296:
297: Specifying 'only' will restrict the browser to displaying only files
1.185 www 298: with the given extension. Can be a comma separated list.
1.42 matthew 299:
300: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 301: with the given extension. Can be a comma separated list.
1.42 matthew 302:
1.112 bowersj2 303: =item * opensearcher(formname, elementname) [javascript]
1.42 matthew 304:
305: Inputs: formname, elementname
306:
307: formname and elementname specify the name of the html form and the name
308: of the element the selection from the search results will be placed in.
1.542 raeburn 309:
1.42 matthew 310: =cut
311:
312: sub browser_and_searcher_javascript {
1.199 albertel 313: my ($mode)=@_;
314: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 315: my $resurl=&escape_single(&lastresurl());
1.42 matthew 316: return <<END;
1.219 albertel 317: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 318: var editbrowser = null;
1.135 albertel 319: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 320: var url = '$resurl/?';
1.42 matthew 321: if (editbrowser == null) {
322: url += 'launch=1&';
323: }
324: url += 'catalogmode=interactive&';
1.199 albertel 325: url += 'mode=$mode&';
1.611 albertel 326: url += 'inhibitmenu=yes&';
1.42 matthew 327: url += 'form=' + formname + '&';
328: if (only != null) {
329: url += 'only=' + only + '&';
1.217 albertel 330: } else {
331: url += 'only=&';
332: }
1.42 matthew 333: if (omit != null) {
334: url += 'omit=' + omit + '&';
1.217 albertel 335: } else {
336: url += 'omit=&';
337: }
1.135 albertel 338: if (titleelement != null) {
339: url += 'titleelement=' + titleelement + '&';
1.217 albertel 340: } else {
341: url += 'titleelement=&';
342: }
1.42 matthew 343: url += 'element=' + elementname + '';
344: var title = 'Browser';
1.435 albertel 345: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 346: options += ',width=700,height=600';
347: editbrowser = open(url,title,options,'1');
348: editbrowser.focus();
349: }
350: var editsearcher;
1.135 albertel 351: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 352: var url = '/adm/searchcat?';
353: if (editsearcher == null) {
354: url += 'launch=1&';
355: }
356: url += 'catalogmode=interactive&';
1.199 albertel 357: url += 'mode=$mode&';
1.42 matthew 358: url += 'form=' + formname + '&';
1.135 albertel 359: if (titleelement != null) {
360: url += 'titleelement=' + titleelement + '&';
1.217 albertel 361: } else {
362: url += 'titleelement=&';
363: }
1.42 matthew 364: url += 'element=' + elementname + '';
365: var title = 'Search';
1.435 albertel 366: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 367: options += ',width=700,height=600';
368: editsearcher = open(url,title,options,'1');
369: editsearcher.focus();
370: }
1.219 albertel 371: // END LON-CAPA Internal -->
1.42 matthew 372: END
1.170 www 373: }
374:
375: sub lastresurl {
1.258 albertel 376: if ($env{'environment.lastresurl'}) {
377: return $env{'environment.lastresurl'}
1.170 www 378: } else {
379: return '/res';
380: }
381: }
382:
383: sub storeresurl {
384: my $resurl=&Apache::lonnet::clutter(shift);
385: unless ($resurl=~/^\/res/) { return 0; }
386: $resurl=~s/\/$//;
387: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
388: &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
389: return 1;
1.42 matthew 390: }
391:
1.74 www 392: sub studentbrowser_javascript {
1.111 www 393: unless (
1.258 albertel 394: (($env{'request.course.id'}) &&
1.302 albertel 395: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
396: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
397: '/'.$env{'request.course.sec'})
398: ))
1.258 albertel 399: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 400: ) { return ''; }
1.74 www 401: return (<<'ENDSTDBRW');
402: <script type="text/javascript" language="Javascript" >
403: var stdeditbrowser;
1.558 albertel 404: function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {
1.74 www 405: var url = '/adm/pickstudent?';
406: var filter;
1.558 albertel 407: if (!ignorefilter) {
408: eval('filter=document.'+formname+'.'+uname+'.value;');
409: }
1.74 www 410: if (filter != null) {
411: if (filter != '') {
412: url += 'filter='+filter+'&';
413: }
414: }
415: url += 'form=' + formname + '&unameelement='+uname+
416: '&udomelement='+udom;
1.111 www 417: if (roleflag) { url+="&roles=1"; }
1.102 www 418: var title = 'Student_Browser';
1.74 www 419: var options = 'scrollbars=1,resizable=1,menubar=0';
420: options += ',width=700,height=600';
421: stdeditbrowser = open(url,title,options,'1');
422: stdeditbrowser.focus();
423: }
424: </script>
425: ENDSTDBRW
426: }
1.42 matthew 427:
1.74 www 428: sub selectstudent_link {
1.111 www 429: my ($form,$unameele,$udomele)=@_;
1.258 albertel 430: if ($env{'request.course.id'}) {
1.302 albertel 431: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
432: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
433: '/'.$env{'request.course.sec'})) {
1.111 www 434: return '';
435: }
436: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.607 albertel 437: '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
1.74 www 438: }
1.258 albertel 439: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.111 www 440: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
1.119 www 441: '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
1.111 www 442: }
443: return '';
1.91 www 444: }
445:
446: sub coursebrowser_javascript {
1.468 raeburn 447: my ($domainfilter,$sec_element,$formname)=@_;
1.377 raeburn 448: 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 449: my $output = '
1.538 albertel 450: <script type="text/javascript">
1.468 raeburn 451: var stdeditbrowser;'."\n";
452: $output .= <<"ENDSTDBRW";
1.377 raeburn 453: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91 www 454: var url = '/adm/pickcourse?';
1.468 raeburn 455: var domainfilter = '';
456: var formid = getFormIdByName(formname);
457: if (formid > -1) {
458: var domid = getIndexByName(formid,udom);
459: if (domid > -1) {
460: if (document.forms[formid].elements[domid].type == 'select-one') {
461: domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
462: }
463: if (document.forms[formid].elements[domid].type == 'hidden') {
464: domainfilter=document.forms[formid].elements[domid].value;
465: }
466: }
1.91 www 467: }
1.128 albertel 468: if (domainfilter != null) {
469: if (domainfilter != '') {
470: url += 'domainfilter='+domainfilter+'&';
471: }
472: }
1.91 www 473: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 474: '&cdomelement='+udom+
475: '&cnameelement='+desc;
1.468 raeburn 476: if (extra_element !=null && extra_element != '') {
1.594 raeburn 477: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 478: url += '&roleelement='+extra_element;
479: if (domainfilter == null || domainfilter == '') {
480: url += '&domainfilter='+extra_element;
481: }
1.234 raeburn 482: }
1.468 raeburn 483: else {
484: if (formname == 'portform') {
485: url += '&setroles='+extra_element;
486: }
487: }
1.230 raeburn 488: }
1.293 raeburn 489: if (multflag !=null && multflag != '') {
490: url += '&multiple='+multflag;
491: }
1.377 raeburn 492: if (crstype == 'Course/Group') {
493: if (formname == 'cu') {
494: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
495: if (crstype == "") {
496: alert("$crs_or_grp_alert");
497: return;
498: }
499: }
500: }
501: if (crstype !=null && crstype != '') {
502: url += '&type='+crstype;
503: }
1.102 www 504: var title = 'Course_Browser';
1.91 www 505: var options = 'scrollbars=1,resizable=1,menubar=0';
506: options += ',width=700,height=600';
507: stdeditbrowser = open(url,title,options,'1');
508: stdeditbrowser.focus();
509: }
1.468 raeburn 510:
511: function getFormIdByName(formname) {
512: for (var i=0;i<document.forms.length;i++) {
513: if (document.forms[i].name == formname) {
514: return i;
515: }
516: }
517: return -1;
518: }
519:
520: function getIndexByName(formid,item) {
521: for (var i=0;i<document.forms[formid].elements.length;i++) {
522: if (document.forms[formid].elements[i].name == item) {
523: return i;
524: }
525: }
526: return -1;
527: }
1.91 www 528: ENDSTDBRW
1.468 raeburn 529: if ($sec_element ne '') {
530: $output .= &setsec_javascript($sec_element,$formname);
531: }
532: $output .= '
533: </script>';
534: return $output;
535: }
536:
537: sub setsec_javascript {
538: my ($sec_element,$formname) = @_;
539: my $setsections = qq|
540: function setSect(sectionlist) {
1.629 raeburn 541: var sectionsArray = new Array();
542: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
543: sectionsArray = sectionlist.split(",");
544: }
1.468 raeburn 545: var numSections = sectionsArray.length;
546: document.$formname.$sec_element.length = 0;
547: if (numSections == 0) {
548: document.$formname.$sec_element.multiple=false;
549: document.$formname.$sec_element.size=1;
550: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
551: } else {
552: if (numSections == 1) {
553: document.$formname.$sec_element.multiple=false;
554: document.$formname.$sec_element.size=1;
555: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
556: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
557: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
558: } else {
559: for (var i=0; i<numSections; i++) {
560: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
561: }
562: document.$formname.$sec_element.multiple=true
563: if (numSections < 3) {
564: document.$formname.$sec_element.size=numSections;
565: } else {
566: document.$formname.$sec_element.size=3;
567: }
568: document.$formname.$sec_element.options[0].selected = false
569: }
570: }
1.91 www 571: }
1.468 raeburn 572: |;
573: return $setsections;
574: }
575:
1.91 www 576:
577: sub selectcourse_link {
1.377 raeburn 578: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.492 albertel 579: return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
580: '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";
1.74 www 581: }
1.42 matthew 582:
1.273 raeburn 583: sub check_uncheck_jscript {
584: my $jscript = <<"ENDSCRT";
585: function checkAll(field) {
586: if (field.length > 0) {
587: for (i = 0; i < field.length; i++) {
588: field[i].checked = true ;
589: }
590: } else {
591: field.checked = true
592: }
593: }
594:
595: function uncheckAll(field) {
596: if (field.length > 0) {
597: for (i = 0; i < field.length; i++) {
598: field[i].checked = false ;
1.543 albertel 599: }
600: } else {
1.273 raeburn 601: field.checked = false ;
602: }
603: }
604: ENDSCRT
605: return $jscript;
606: }
607:
608:
1.42 matthew 609: =pod
1.36 matthew 610:
1.112 bowersj2 611: =item * linked_select_forms(...)
1.36 matthew 612:
613: linked_select_forms returns a string containing a <script></script> block
614: and html for two <select> menus. The select menus will be linked in that
615: changing the value of the first menu will result in new values being placed
616: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 617: order unless a defined order is provided.
1.36 matthew 618:
619: linked_select_forms takes the following ordered inputs:
620:
621: =over 4
622:
1.112 bowersj2 623: =item * $formname, the name of the <form> tag
1.36 matthew 624:
1.112 bowersj2 625: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 626:
1.112 bowersj2 627: =item * $firstdefault, the default value for the first menu
1.36 matthew 628:
1.112 bowersj2 629: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 630:
1.112 bowersj2 631: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 632:
1.112 bowersj2 633: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 634:
1.609 raeburn 635: =item * $menuorder, the order of values in the first menu
636:
1.41 ng 637: =back
638:
1.36 matthew 639: Below is an example of such a hash. Only the 'text', 'default', and
640: 'select2' keys must appear as stated. keys(%menu) are the possible
641: values for the first select menu. The text that coincides with the
1.41 ng 642: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 643: and text for the second menu are given in the hash pointed to by
644: $menu{$choice1}->{'select2'}.
645:
1.112 bowersj2 646: my %menu = ( A1 => { text =>"Choice A1" ,
647: default => "B3",
648: select2 => {
649: B1 => "Choice B1",
650: B2 => "Choice B2",
651: B3 => "Choice B3",
652: B4 => "Choice B4"
1.609 raeburn 653: },
654: order => ['B4','B3','B1','B2'],
1.112 bowersj2 655: },
656: A2 => { text =>"Choice A2" ,
657: default => "C2",
658: select2 => {
659: C1 => "Choice C1",
660: C2 => "Choice C2",
661: C3 => "Choice C3"
1.609 raeburn 662: },
663: order => ['C2','C1','C3'],
1.112 bowersj2 664: },
665: A3 => { text =>"Choice A3" ,
666: default => "D6",
667: select2 => {
668: D1 => "Choice D1",
669: D2 => "Choice D2",
670: D3 => "Choice D3",
671: D4 => "Choice D4",
672: D5 => "Choice D5",
673: D6 => "Choice D6",
674: D7 => "Choice D7"
1.609 raeburn 675: },
676: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 677: }
678: );
1.36 matthew 679:
680: =cut
681:
682: sub linked_select_forms {
683: my ($formname,
684: $middletext,
685: $firstdefault,
686: $firstselectname,
687: $secondselectname,
1.609 raeburn 688: $hashref,
689: $menuorder,
1.36 matthew 690: ) = @_;
691: my $second = "document.$formname.$secondselectname";
692: my $first = "document.$formname.$firstselectname";
693: # output the javascript to do the changing
694: my $result = '';
1.219 albertel 695: $result.="<script type=\"text/javascript\">\n";
1.36 matthew 696: $result.="var select2data = new Object();\n";
697: $" = '","';
698: my $debug = '';
699: foreach my $s1 (sort(keys(%$hashref))) {
700: $result.="select2data.d_$s1 = new Object();\n";
701: $result.="select2data.d_$s1.def = new String('".
702: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 703: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 704: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 705: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
706: @s2values = @{$hashref->{$s1}->{'order'}};
707: }
1.36 matthew 708: $result.="\"@s2values\");\n";
709: $result.="select2data.d_$s1.texts = new Array(";
710: my @s2texts;
711: foreach my $value (@s2values) {
712: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
713: }
714: $result.="\"@s2texts\");\n";
715: }
716: $"=' ';
717: $result.= <<"END";
718:
719: function select1_changed() {
720: // Determine new choice
721: var newvalue = "d_" + $first.value;
722: // update select2
723: var values = select2data[newvalue].values;
724: var texts = select2data[newvalue].texts;
725: var select2def = select2data[newvalue].def;
726: var i;
727: // out with the old
728: for (i = 0; i < $second.options.length; i++) {
729: $second.options[i] = null;
730: }
731: // in with the nuclear
732: for (i=0;i<values.length; i++) {
733: $second.options[i] = new Option(values[i]);
1.143 matthew 734: $second.options[i].value = values[i];
1.36 matthew 735: $second.options[i].text = texts[i];
736: if (values[i] == select2def) {
737: $second.options[i].selected = true;
738: }
739: }
740: }
741: </script>
742: END
743: # output the initial values for the selection lists
744: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 745: my @order = sort(keys(%{$hashref}));
746: if (ref($menuorder) eq 'ARRAY') {
747: @order = @{$menuorder};
748: }
749: foreach my $value (@order) {
1.36 matthew 750: $result.=" <option value=\"$value\" ";
1.253 albertel 751: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 752: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 753: }
754: $result .= "</select>\n";
755: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
756: $result .= $middletext;
757: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
758: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 759:
760: my @secondorder = sort(keys(%select2));
761: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
762: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
763: }
764: foreach my $value (@secondorder) {
1.36 matthew 765: $result.=" <option value=\"$value\" ";
1.253 albertel 766: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 767: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 768: }
769: $result .= "</select>\n";
770: # return $debug;
771: return $result;
772: } # end of sub linked_select_forms {
773:
1.45 matthew 774: =pod
1.44 bowersj2 775:
1.112 bowersj2 776: =item * help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44 bowersj2 777:
1.112 bowersj2 778: Returns a string corresponding to an HTML link to the given help
779: $topic, where $topic corresponds to the name of a .tex file in
780: /home/httpd/html/adm/help/tex, with underscores replaced by
781: spaces.
782:
783: $text will optionally be linked to the same topic, allowing you to
784: link text in addition to the graphic. If you do not want to link
785: text, but wish to specify one of the later parameters, pass an
786: empty string.
787:
788: $stayOnPage is a value that will be interpreted as a boolean. If true,
789: the link will not open a new window. If false, the link will open
790: a new window using Javascript. (Default is false.)
791:
792: $width and $height are optional numerical parameters that will
793: override the width and height of the popped up window, which may
794: be useful for certain help topics with big pictures included.
1.44 bowersj2 795:
796: =cut
797:
798: sub help_open_topic {
1.48 bowersj2 799: my ($topic, $text, $stayOnPage, $width, $height) = @_;
800: $text = "" if (not defined $text);
1.44 bowersj2 801: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 802: if ($env{'browser.interface'} eq 'textual') {
1.79 www 803: $stayOnPage=1;
804: }
1.44 bowersj2 805: $width = 350 if (not defined $width);
806: $height = 400 if (not defined $height);
807: my $filename = $topic;
808: $filename =~ s/ /_/g;
809:
1.48 bowersj2 810: my $template = "";
811: my $link;
1.572 banghart 812:
1.159 www 813: $topic=~s/\W/\_/g;
1.44 bowersj2 814:
1.572 banghart 815: if (!$stayOnPage) {
1.72 bowersj2 816: $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 817: } else {
1.48 bowersj2 818: $link = "/adm/help/${filename}.hlp";
819: }
820:
821: # Add the text
1.572 banghart 822: if ($text ne "") {
1.77 www 823: $template .=
1.572 banghart 824: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
825: "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 826: }
827:
828: # Add the graphic
1.179 matthew 829: my $title = &mt('Online Help');
1.215 albertel 830: my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
1.48 bowersj2 831: $template .= <<"ENDTEMPLATE";
1.436 albertel 832: <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
1.44 bowersj2 833: ENDTEMPLATE
1.78 www 834: if ($text ne '') { $template.='</td></tr></table>' };
1.44 bowersj2 835: return $template;
836:
1.106 bowersj2 837: }
838:
839: # This is a quicky function for Latex cheatsheet editing, since it
840: # appears in at least four places
841: sub helpLatexCheatsheet {
842: my $other = shift;
843: my $addOther = '';
844: if ($other) {
845: $addOther = Apache::loncommon::help_open_topic($other, shift,
846: undef, undef, 600) .
847: '</td><td>';
848: }
849: return '<table><tr><td>'.
850: $addOther .
1.636 raeburn 851: &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
1.106 bowersj2 852: undef,undef,600)
853: .'</td><td>'.
1.636 raeburn 854: &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
1.106 bowersj2 855: undef,undef,600)
856: .'</td></tr></table>';
1.172 www 857: }
858:
1.430 albertel 859: sub general_help {
860: my $helptopic='Student_Intro';
861: if ($env{'request.role'}=~/^(ca|au)/) {
862: $helptopic='Authoring_Intro';
863: } elsif ($env{'request.role'}=~/^cc/) {
864: $helptopic='Course_Coordination_Intro';
865: }
866: return $helptopic;
867: }
868:
869: sub update_help_link {
870: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
871: my $origurl = $ENV{'REQUEST_URI'};
872: $origurl=~s|^/~|/priv/|;
873: my $timestamp = time;
874: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
875: $$datum = &escape($$datum);
876: }
877:
878: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
879: my $output .= <<"ENDOUTPUT";
880: <script type="text/javascript">
881: banner_link = '$banner_link';
882: </script>
883: ENDOUTPUT
884: return $output;
885: }
886:
887: # now just updates the help link and generates a blue icon
1.193 raeburn 888: sub help_open_menu {
1.430 albertel 889: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 890: = @_;
1.430 albertel 891: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 892: # only use pop-up help (stayOnPage == 0)
1.552 banghart 893: # if environment.remote is on (using remote control UI)
1.572 banghart 894: if ($env{'browser.interface'} eq 'textual' ||
895: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 896: $stayOnPage=1;
1.430 albertel 897: }
898: my $output;
899: if ($component_help) {
900: if (!$text) {
901: $output=&help_open_topic($component_help,undef,$stayOnPage,
902: $width,$height);
903: } else {
904: my $help_text;
905: $help_text=&unescape($topic);
906: $output='<table><tr><td>'.
907: &help_open_topic($component_help,$help_text,$stayOnPage,
908: $width,$height).'</td></tr></table>';
909: }
910: }
911: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
912: return $output.$banner_link;
913: }
914:
915: sub top_nav_help {
916: my ($text) = @_;
1.436 albertel 917: $text = &mt($text);
1.572 banghart 918: my $stay_on_page =
1.436 albertel 919: ($env{'browser.interface'} eq 'textual' ||
920: $env{'environment.remote'} eq 'off' );
1.572 banghart 921: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 922: : "javascript:helpMenu('open')";
1.572 banghart 923: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 924:
1.201 raeburn 925: my $title = &mt('Get help');
1.436 albertel 926:
927: return <<"END";
928: $banner_link
929: <a href="$link" title="$title">$text</a>
930: END
931: }
932:
933: sub help_menu_js {
934: my ($text) = @_;
935:
936: my $stayOnPage =
937: ($env{'browser.interface'} eq 'textual' ||
938: $env{'environment.remote'} eq 'off' );
939:
940: my $width = 620;
941: my $height = 600;
1.430 albertel 942: my $helptopic=&general_help();
943: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 944: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 945: my $start_page =
946: &Apache::loncommon::start_page('Help Menu', undef,
947: {'frameset' => 1,
948: 'js_ready' => 1,
949: 'add_entries' => {
950: 'border' => '0',
1.579 raeburn 951: 'rows' => "110,*",},});
1.331 albertel 952: my $end_page =
953: &Apache::loncommon::end_page({'frameset' => 1,
954: 'js_ready' => 1,});
955:
1.436 albertel 956: my $template .= <<"ENDTEMPLATE";
957: <script type="text/javascript">
1.253 albertel 958: // <!-- BEGIN LON-CAPA Internal
959: // <![CDATA[
1.430 albertel 960: var banner_link = '';
1.243 raeburn 961: function helpMenu(target) {
962: var caller = this;
963: if (target == 'open') {
964: var newWindow = null;
965: try {
1.262 albertel 966: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 967: }
968: catch(error) {
969: writeHelp(caller);
970: return;
971: }
972: if (newWindow) {
973: caller = newWindow;
974: }
1.193 raeburn 975: }
1.243 raeburn 976: writeHelp(caller);
977: return;
978: }
979: function writeHelp(caller) {
1.430 albertel 980: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 981: caller.document.close()
982: caller.focus()
1.193 raeburn 983: }
1.253 albertel 984: // ]]>
1.219 albertel 985: // END LON-CAPA Internal -->
1.436 albertel 986: </script>
1.193 raeburn 987: ENDTEMPLATE
988: return $template;
989: }
990:
1.172 www 991: sub help_open_bug {
992: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 993: unless ($env{'user.adv'}) { return ''; }
1.172 www 994: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
995: $text = "" if (not defined $text);
996: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 997: if ($env{'browser.interface'} eq 'textual' ||
998: $env{'environment.remote'} eq 'off' ) {
1.172 www 999: $stayOnPage=1;
1000: }
1.184 albertel 1001: $width = 600 if (not defined $width);
1002: $height = 600 if (not defined $height);
1.172 www 1003:
1004: $topic=~s/\W+/\+/g;
1005: my $link='';
1006: my $template='';
1.379 albertel 1007: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1008: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1009: if (!$stayOnPage)
1010: {
1011: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1012: }
1013: else
1014: {
1015: $link = $url;
1016: }
1017: # Add the text
1018: if ($text ne "")
1019: {
1020: $template .=
1021: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1022: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1023: }
1024:
1025: # Add the graphic
1.179 matthew 1026: my $title = &mt('Report a Bug');
1.215 albertel 1027: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1028: $template .= <<"ENDTEMPLATE";
1.436 albertel 1029: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1030: ENDTEMPLATE
1031: if ($text ne '') { $template.='</td></tr></table>' };
1032: return $template;
1033:
1034: }
1035:
1036: sub help_open_faq {
1037: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1038: unless ($env{'user.adv'}) { return ''; }
1.172 www 1039: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1040: $text = "" if (not defined $text);
1041: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1042: if ($env{'browser.interface'} eq 'textual' ||
1043: $env{'environment.remote'} eq 'off' ) {
1.172 www 1044: $stayOnPage=1;
1045: }
1046: $width = 350 if (not defined $width);
1047: $height = 400 if (not defined $height);
1048:
1049: $topic=~s/\W+/\+/g;
1050: my $link='';
1051: my $template='';
1052: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1053: if (!$stayOnPage)
1054: {
1055: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1056: }
1057: else
1058: {
1059: $link = $url;
1060: }
1061:
1062: # Add the text
1063: if ($text ne "")
1064: {
1065: $template .=
1.173 www 1066: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1067: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1068: }
1069:
1070: # Add the graphic
1.179 matthew 1071: my $title = &mt('View the FAQ');
1.215 albertel 1072: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1073: $template .= <<"ENDTEMPLATE";
1.436 albertel 1074: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1075: ENDTEMPLATE
1076: if ($text ne '') { $template.='</td></tr></table>' };
1077: return $template;
1078:
1.44 bowersj2 1079: }
1.37 matthew 1080:
1.180 matthew 1081: ###############################################################
1082: ###############################################################
1083:
1.45 matthew 1084: =pod
1085:
1.256 matthew 1086: =item * change_content_javascript():
1087:
1088: This and the next function allow you to create small sections of an
1089: otherwise static HTML page that you can update on the fly with
1090: Javascript, even in Netscape 4.
1091:
1092: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1093: must be written to the HTML page once. It will prove the Javascript
1094: function "change(name, content)". Calling the change function with the
1095: name of the section
1096: you want to update, matching the name passed to C<changable_area>, and
1097: the new content you want to put in there, will put the content into
1098: that area.
1099:
1100: B<Note>: Netscape 4 only reserves enough space for the changable area
1101: to contain room for the original contents. You need to "make space"
1102: for whatever changes you wish to make, and be B<sure> to check your
1103: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1104: it's adequate for updating a one-line status display, but little more.
1105: This script will set the space to 100% width, so you only need to
1106: worry about height in Netscape 4.
1107:
1108: Modern browsers are much less limiting, and if you can commit to the
1109: user not using Netscape 4, this feature may be used freely with
1110: pretty much any HTML.
1111:
1112: =cut
1113:
1114: sub change_content_javascript {
1115: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1116: if ($env{'browser.type'} eq 'netscape' &&
1117: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1118: return (<<NETSCAPE4);
1119: function change(name, content) {
1120: doc = document.layers[name+"___escape"].layers[0].document;
1121: doc.open();
1122: doc.write(content);
1123: doc.close();
1124: }
1125: NETSCAPE4
1126: } else {
1127: # Otherwise, we need to use semi-standards-compliant code
1128: # (technically, "innerHTML" isn't standard but the equivalent
1129: # is really scary, and every useful browser supports it
1130: return (<<DOMBASED);
1131: function change(name, content) {
1132: element = document.getElementById(name);
1133: element.innerHTML = content;
1134: }
1135: DOMBASED
1136: }
1137: }
1138:
1139: =pod
1140:
1141: =item * changable_area($name, $origContent):
1142:
1143: This provides a "changable area" that can be modified on the fly via
1144: the Javascript code provided in C<change_content_javascript>. $name is
1145: the name you will use to reference the area later; do not repeat the
1146: same name on a given HTML page more then once. $origContent is what
1147: the area will originally contain, which can be left blank.
1148:
1149: =cut
1150:
1151: sub changable_area {
1152: my ($name, $origContent) = @_;
1153:
1.258 albertel 1154: if ($env{'browser.type'} eq 'netscape' &&
1155: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1156: # If this is netscape 4, we need to use the Layer tag
1157: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1158: } else {
1159: return "<span id='$name'>$origContent</span>";
1160: }
1161: }
1162:
1163: =pod
1164:
1.590 raeburn 1165: =item * viewport_geometry_js {
1166:
1167: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1168:
1169: =cut
1170:
1171:
1172: sub viewport_geometry_js {
1173: return <<"GEOMETRY";
1174: var Geometry = {};
1175: function init_geometry() {
1176: if (Geometry.init) { return };
1177: Geometry.init=1;
1178: if (window.innerHeight) {
1179: Geometry.getViewportHeight = function() { return window.innerHeight; };
1180: Geometry.getViewportWidth = function() { return window.innerWidth; };
1181: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1182: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1183: }
1184: else if (document.documentElement && document.documentElement.clientHeight) {
1185: Geometry.getViewportHeight =
1186: function() { return document.documentElement.clientHeight; };
1187: Geometry.getViewportWidth =
1188: function() { return document.documentElement.clientWidth; };
1189:
1190: Geometry.getHorizontalScroll =
1191: function() { return document.documentElement.scrollLeft; };
1192: Geometry.getVerticalScroll =
1193: function() { return document.documentElement.scrollTop; };
1194: }
1195: else if (document.body.clientHeight) {
1196: Geometry.getViewportHeight =
1197: function() { return document.body.clientHeight; };
1198: Geometry.getViewportWidth =
1199: function() { return document.body.clientWidth; };
1200: Geometry.getHorizontalScroll =
1201: function() { return document.body.scrollLeft; };
1202: Geometry.getVerticalScroll =
1203: function() { return document.body.scrollTop; };
1204: }
1205: }
1206:
1207: GEOMETRY
1208: }
1209:
1210: =pod
1211:
1212: =item * viewport_size_js {
1213:
1214: 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.
1215:
1216: =cut
1217:
1218: sub viewport_size_js {
1219: my $geometry = &viewport_geometry_js();
1220: return <<"DIMS";
1221:
1222: $geometry
1223:
1224: function getViewportDims(width,height) {
1225: init_geometry();
1226: width.value = Geometry.getViewportWidth();
1227: height.value = Geometry.getViewportHeight();
1228: return;
1229: }
1230:
1231: DIMS
1232: }
1233:
1234: =pod
1235:
1.565 albertel 1236: =item * resize_textarea_js
1237:
1238: emits the needed javascript to resize a textarea to be as big as possible
1239:
1240: creates a function resize_textrea that takes two IDs first should be
1241: the id of the element to resize, second should be the id of a div that
1242: surrounds everything that comes after the textarea, this routine needs
1243: to be attached to the <body> for the onload and onresize events.
1244:
1245:
1246: =cut
1247:
1248: sub resize_textarea_js {
1.590 raeburn 1249: my $geometry = &viewport_geometry_js();
1.565 albertel 1250: return <<"RESIZE";
1251: <script type="text/javascript">
1.590 raeburn 1252: $geometry
1.565 albertel 1253:
1.588 albertel 1254: function getX(element) {
1255: var x = 0;
1256: while (element) {
1257: x += element.offsetLeft;
1258: element = element.offsetParent;
1259: }
1260: return x;
1261: }
1262: function getY(element) {
1263: var y = 0;
1264: while (element) {
1265: y += element.offsetTop;
1266: element = element.offsetParent;
1267: }
1268: return y;
1269: }
1270:
1271:
1.565 albertel 1272: function resize_textarea(textarea_id,bottom_id) {
1273: init_geometry();
1274: var textarea = document.getElementById(textarea_id);
1275: //alert(textarea);
1276:
1.588 albertel 1277: var textarea_top = getY(textarea);
1.565 albertel 1278: var textarea_height = textarea.offsetHeight;
1279: var bottom = document.getElementById(bottom_id);
1.588 albertel 1280: var bottom_top = getY(bottom);
1.565 albertel 1281: var bottom_height = bottom.offsetHeight;
1282: var window_height = Geometry.getViewportHeight();
1.588 albertel 1283: var fudge = 23;
1.565 albertel 1284: var new_height = window_height-fudge-textarea_top-bottom_height;
1285: if (new_height < 300) {
1286: new_height = 300;
1287: }
1288: textarea.style.height=new_height+'px';
1289: }
1290: </script>
1291: RESIZE
1292:
1293: }
1294:
1295: =pod
1296:
1.256 matthew 1297: =back
1.542 raeburn 1298:
1.256 matthew 1299: =head1 Excel and CSV file utility routines
1300:
1301: =over 4
1302:
1303: =cut
1304:
1305: ###############################################################
1306: ###############################################################
1307:
1308: =pod
1309:
1.112 bowersj2 1310: =item * csv_translate($text)
1.37 matthew 1311:
1.185 www 1312: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1313: format.
1314:
1315: =cut
1316:
1.180 matthew 1317: ###############################################################
1318: ###############################################################
1.37 matthew 1319: sub csv_translate {
1320: my $text = shift;
1321: $text =~ s/\"/\"\"/g;
1.209 albertel 1322: $text =~ s/\n/ /g;
1.37 matthew 1323: return $text;
1324: }
1.180 matthew 1325:
1326: ###############################################################
1327: ###############################################################
1328:
1329: =pod
1330:
1331: =item * define_excel_formats
1332:
1333: Define some commonly used Excel cell formats.
1334:
1335: Currently supported formats:
1336:
1337: =over 4
1338:
1339: =item header
1340:
1341: =item bold
1342:
1343: =item h1
1344:
1345: =item h2
1346:
1347: =item h3
1348:
1.256 matthew 1349: =item h4
1350:
1351: =item i
1352:
1.180 matthew 1353: =item date
1354:
1355: =back
1356:
1357: Inputs: $workbook
1358:
1359: Returns: $format, a hash reference.
1360:
1361: =cut
1362:
1363: ###############################################################
1364: ###############################################################
1365: sub define_excel_formats {
1366: my ($workbook) = @_;
1367: my $format;
1368: $format->{'header'} = $workbook->add_format(bold => 1,
1369: bottom => 1,
1370: align => 'center');
1371: $format->{'bold'} = $workbook->add_format(bold=>1);
1372: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1373: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1374: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1375: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1376: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1377: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1378: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1379: return $format;
1380: }
1381:
1382: ###############################################################
1383: ###############################################################
1.113 bowersj2 1384:
1385: =pod
1386:
1.256 matthew 1387: =item * create_workbook
1.255 matthew 1388:
1389: Create an Excel worksheet. If it fails, output message on the
1390: request object and return undefs.
1391:
1392: Inputs: Apache request object
1393:
1394: Returns (undef) on failure,
1395: Excel worksheet object, scalar with filename, and formats
1396: from &Apache::loncommon::define_excel_formats on success
1397:
1398: =cut
1399:
1400: ###############################################################
1401: ###############################################################
1402: sub create_workbook {
1403: my ($r) = @_;
1404: #
1405: # Create the excel spreadsheet
1406: my $filename = '/prtspool/'.
1.258 albertel 1407: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1408: time.'_'.rand(1000000000).'.xls';
1409: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1410: if (! defined($workbook)) {
1411: $r->log_error("Error creating excel spreadsheet $filename: $!");
1412: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1413: "This error has been logged. ".
1414: "Please alert your LON-CAPA administrator").
1415: '</p>');
1416: return (undef);
1417: }
1418: #
1419: $workbook->set_tempdir('/home/httpd/perl/tmp');
1420: #
1421: my $format = &Apache::loncommon::define_excel_formats($workbook);
1422: return ($workbook,$filename,$format);
1423: }
1424:
1425: ###############################################################
1426: ###############################################################
1427:
1428: =pod
1429:
1.256 matthew 1430: =item * create_text_file
1.113 bowersj2 1431:
1.542 raeburn 1432: Create a file to write to and eventually make available to the user.
1.256 matthew 1433: If file creation fails, outputs an error message on the request object and
1434: return undefs.
1.113 bowersj2 1435:
1.256 matthew 1436: Inputs: Apache request object, and file suffix
1.113 bowersj2 1437:
1.256 matthew 1438: Returns (undef) on failure,
1439: Filehandle and filename on success.
1.113 bowersj2 1440:
1441: =cut
1442:
1.256 matthew 1443: ###############################################################
1444: ###############################################################
1445: sub create_text_file {
1446: my ($r,$suffix) = @_;
1447: if (! defined($suffix)) { $suffix = 'txt'; };
1448: my $fh;
1449: my $filename = '/prtspool/'.
1.258 albertel 1450: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1451: time.'_'.rand(1000000000).'.'.$suffix;
1452: $fh = Apache::File->new('>/home/httpd'.$filename);
1453: if (! defined($fh)) {
1454: $r->log_error("Couldn't open $filename for output $!");
1455: $r->print("Problems occured in creating the output file. ".
1456: "This error has been logged. ".
1457: "Please alert your LON-CAPA administrator.");
1.113 bowersj2 1458: }
1.256 matthew 1459: return ($fh,$filename)
1.113 bowersj2 1460: }
1461:
1462:
1.256 matthew 1463: =pod
1.113 bowersj2 1464:
1465: =back
1466:
1467: =cut
1.37 matthew 1468:
1469: ###############################################################
1.33 matthew 1470: ## Home server <option> list generating code ##
1471: ###############################################################
1.35 matthew 1472:
1.169 www 1473: # ------------------------------------------
1474:
1475: sub domain_select {
1476: my ($name,$value,$multiple)=@_;
1477: my %domains=map {
1.514 albertel 1478: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1479: } &Apache::lonnet::all_domains();
1.169 www 1480: if ($multiple) {
1481: $domains{''}=&mt('Any domain');
1.550 albertel 1482: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1483: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1484: } else {
1.550 albertel 1485: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1486: return &select_form($name,$value,%domains);
1487: }
1488: }
1489:
1.282 albertel 1490: #-------------------------------------------
1491:
1492: =pod
1493:
1.519 raeburn 1494: =head1 Routines for form select boxes
1495:
1496: =over 4
1497:
1.287 albertel 1498: =item * multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1499:
1500: Returns a string containing a <select> element int multiple mode
1501:
1502:
1503: Args:
1504: $name - name of the <select> element
1.506 raeburn 1505: $value - scalar or array ref of values that should already be selected
1.282 albertel 1506: $size - number of rows long the select element is
1.283 albertel 1507: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1508: (shown text should already have been &mt())
1.506 raeburn 1509: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1510:
1.282 albertel 1511: =cut
1512:
1513: #-------------------------------------------
1.169 www 1514: sub multiple_select_form {
1.284 albertel 1515: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1516: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1517: my $output='';
1.191 matthew 1518: if (! defined($size)) {
1519: $size = 4;
1.283 albertel 1520: if (scalar(keys(%$hash))<4) {
1521: $size = scalar(keys(%$hash));
1.191 matthew 1522: }
1523: }
1.169 www 1524: $output.="\n<select name='$name' size='$size' multiple='1'>";
1.501 banghart 1525: my @order;
1.506 raeburn 1526: if (ref($order) eq 'ARRAY') {
1527: @order = @{$order};
1528: } else {
1529: @order = sort(keys(%$hash));
1.501 banghart 1530: }
1531: if (exists($$hash{'select_form_order'})) {
1532: @order = @{$$hash{'select_form_order'}};
1533: }
1534:
1.284 albertel 1535: foreach my $key (@order) {
1.356 albertel 1536: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1537: $output.='selected="selected" ' if ($selected{$key});
1538: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1539: }
1540: $output.="</select>\n";
1541: return $output;
1542: }
1543:
1.88 www 1544: #-------------------------------------------
1545:
1546: =pod
1547:
1.112 bowersj2 1548: =item * select_form($defdom,$name,%hash)
1.88 www 1549:
1550: Returns a string containing a <select name='$name' size='1'> form to
1551: allow a user to select options from a hash option_name => displayed text.
1552: See lonrights.pm for an example invocation and use.
1553:
1554: =cut
1555:
1556: #-------------------------------------------
1557: sub select_form {
1558: my ($def,$name,%hash) = @_;
1559: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1560: my @keys;
1561: if (exists($hash{'select_form_order'})) {
1562: @keys=@{$hash{'select_form_order'}};
1563: } else {
1564: @keys=sort(keys(%hash));
1565: }
1.356 albertel 1566: foreach my $key (@keys) {
1567: $selectform.=
1568: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1569: ($key eq $def ? 'selected="selected" ' : '').
1570: ">".&mt($hash{$key})."</option>\n";
1.88 www 1571: }
1572: $selectform.="</select>";
1573: return $selectform;
1574: }
1575:
1.475 www 1576: # For display filters
1577:
1578: sub display_filter {
1579: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1580: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.475 www 1581: return '<nobr><label>'.&mt('Records [_1]',
1582: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1583: (&mt('all'),10,20,50,100,1000,10000))).
1.478 www 1584: '</label></nobr> <nobr>'.
1.475 www 1585: &mt('Filter [_1]',
1.477 www 1586: &select_form($env{'form.displayfilter'},
1587: 'displayfilter',
1588: ('currentfolder' => 'Current folder/page',
1589: 'containing' => 'Containing phrase',
1590: 'none' => 'None'))).
1.478 www 1591: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
1.475 www 1592: }
1593:
1.167 www 1594: sub gradeleveldescription {
1595: my $gradelevel=shift;
1596: my %gradelevels=(0 => 'Not specified',
1597: 1 => 'Grade 1',
1598: 2 => 'Grade 2',
1599: 3 => 'Grade 3',
1600: 4 => 'Grade 4',
1601: 5 => 'Grade 5',
1602: 6 => 'Grade 6',
1603: 7 => 'Grade 7',
1604: 8 => 'Grade 8',
1605: 9 => 'Grade 9',
1606: 10 => 'Grade 10',
1607: 11 => 'Grade 11',
1608: 12 => 'Grade 12',
1609: 13 => 'Grade 13',
1610: 14 => '100 Level',
1611: 15 => '200 Level',
1612: 16 => '300 Level',
1613: 17 => '400 Level',
1614: 18 => 'Graduate Level');
1615: return &mt($gradelevels{$gradelevel});
1616: }
1617:
1.163 www 1618: sub select_level_form {
1619: my ($deflevel,$name)=@_;
1620: unless ($deflevel) { $deflevel=0; }
1.167 www 1621: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1622: for (my $i=0; $i<=18; $i++) {
1623: $selectform.="<option value=\"$i\" ".
1.253 albertel 1624: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1625: ">".&gradeleveldescription($i)."</option>\n";
1626: }
1627: $selectform.="</select>";
1628: return $selectform;
1.163 www 1629: }
1.167 www 1630:
1.35 matthew 1631: #-------------------------------------------
1632:
1.45 matthew 1633: =pod
1634:
1.563 raeburn 1635: =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
1.35 matthew 1636:
1637: Returns a string containing a <select name='$name' size='1'> form to
1638: allow a user to select the domain to preform an operation in.
1639: See loncreateuser.pm for an example invocation and use.
1640:
1.90 www 1641: If the $includeempty flag is set, it also includes an empty choice ("no domain
1642: selected");
1643:
1.563 raeburn 1644: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1645:
1.35 matthew 1646: =cut
1647:
1648: #-------------------------------------------
1.34 matthew 1649: sub select_dom_form {
1.563 raeburn 1650: my ($defdom,$name,$includeempty,$showdomdesc) = @_;
1.550 albertel 1651: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1652: if ($includeempty) { @domains=('',@domains); }
1.34 matthew 1653: my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
1.356 albertel 1654: foreach my $dom (@domains) {
1655: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1656: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1657: if ($showdomdesc) {
1658: if ($dom ne '') {
1659: my $domdesc = &Apache::lonnet::domain($dom,'description');
1660: if ($domdesc ne '') {
1661: $selectdomain .= ' ('.$domdesc.')';
1662: }
1663: }
1664: }
1665: $selectdomain .= "</option>\n";
1.34 matthew 1666: }
1667: $selectdomain.="</select>";
1668: return $selectdomain;
1669: }
1670:
1.35 matthew 1671: #-------------------------------------------
1672:
1.45 matthew 1673: =pod
1674:
1.586 raeburn 1675: =item * home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1676:
1.586 raeburn 1677: input: 4 arguments (two required, two optional) -
1678: $domain - domain of new user
1679: $name - name of form element
1680: $default - Value of 'default' causes a default item to be first
1681: option, and selected by default.
1682: $hide - Value of 'hide' causes hiding of the name of the server,
1683: if 1 server found, or default, if 0 found.
1.594 raeburn 1684: output: returns 2 items:
1.586 raeburn 1685: (a) form element which contains either:
1686: (i) <select name="$name">
1687: <option value="$hostid1">$hostid $servers{$hostid}</option>
1688: <option value="$hostid2">$hostid $servers{$hostid}</option>
1689: </select>
1690: form item if there are multiple library servers in $domain, or
1691: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1692: if there is only one library server in $domain.
1693:
1694: (b) number of library servers found.
1695:
1696: See loncreateuser.pm for example of use.
1.35 matthew 1697:
1698: =cut
1699:
1700: #-------------------------------------------
1.586 raeburn 1701: sub home_server_form_item {
1702: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1703: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1704: my $result;
1705: my $numlib = keys(%servers);
1706: if ($numlib > 1) {
1707: $result .= '<select name="'.$name.'" />'."\n";
1708: if ($default) {
1709: $result .= '<option value="default" selected>'.&mt('default').
1710: '</option>'."\n";
1711: }
1712: foreach my $hostid (sort(keys(%servers))) {
1713: $result.= '<option value="'.$hostid.'">'.
1714: $hostid.' '.$servers{$hostid}."</option>\n";
1715: }
1716: $result .= '</select>'."\n";
1717: } elsif ($numlib == 1) {
1718: my $hostid;
1719: foreach my $item (keys(%servers)) {
1720: $hostid = $item;
1721: }
1722: $result .= '<input type="hidden" name="'.$name.'" value="'.
1723: $hostid.'" />';
1724: if (!$hide) {
1725: $result .= $hostid.' '.$servers{$hostid};
1726: }
1727: $result .= "\n";
1728: } elsif ($default) {
1729: $result .= '<input type="hidden" name="'.$name.
1730: '" value="default" />';
1731: if (!$hide) {
1732: $result .= &mt('default');
1733: }
1734: $result .= "\n";
1.33 matthew 1735: }
1.586 raeburn 1736: return ($result,$numlib);
1.33 matthew 1737: }
1.112 bowersj2 1738:
1739: =pod
1740:
1.534 albertel 1741: =back
1742:
1.112 bowersj2 1743: =cut
1.87 matthew 1744:
1745: ###############################################################
1.112 bowersj2 1746: ## Decoding User Agent ##
1.87 matthew 1747: ###############################################################
1748:
1749: =pod
1750:
1.112 bowersj2 1751: =head1 Decoding the User Agent
1752:
1753: =over 4
1754:
1755: =item * &decode_user_agent()
1.87 matthew 1756:
1757: Inputs: $r
1758:
1759: Outputs:
1760:
1761: =over 4
1762:
1.112 bowersj2 1763: =item * $httpbrowser
1.87 matthew 1764:
1.112 bowersj2 1765: =item * $clientbrowser
1.87 matthew 1766:
1.112 bowersj2 1767: =item * $clientversion
1.87 matthew 1768:
1.112 bowersj2 1769: =item * $clientmathml
1.87 matthew 1770:
1.112 bowersj2 1771: =item * $clientunicode
1.87 matthew 1772:
1.112 bowersj2 1773: =item * $clientos
1.87 matthew 1774:
1775: =back
1776:
1.157 matthew 1777: =back
1778:
1.87 matthew 1779: =cut
1780:
1781: ###############################################################
1782: ###############################################################
1783: sub decode_user_agent {
1.247 albertel 1784: my ($r)=@_;
1.87 matthew 1785: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
1786: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
1787: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 1788: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 1789: my $clientbrowser='unknown';
1790: my $clientversion='0';
1791: my $clientmathml='';
1792: my $clientunicode='0';
1793: for (my $i=0;$i<=$#browsertype;$i++) {
1794: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
1795: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
1796: $clientbrowser=$bname;
1797: $httpbrowser=~/$vreg/i;
1798: $clientversion=$1;
1799: $clientmathml=($clientversion>=$minv);
1800: $clientunicode=($clientversion>=$univ);
1801: }
1802: }
1803: my $clientos='unknown';
1804: if (($httpbrowser=~/linux/i) ||
1805: ($httpbrowser=~/unix/i) ||
1806: ($httpbrowser=~/ux/i) ||
1807: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
1808: if (($httpbrowser=~/vax/i) ||
1809: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
1810: if ($httpbrowser=~/next/i) { $clientos='next'; }
1811: if (($httpbrowser=~/mac/i) ||
1812: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1813: if ($httpbrowser=~/win/i) { $clientos='win'; }
1814: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1815: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1816: $clientunicode,$clientos,);
1817: }
1818:
1.32 matthew 1819: ###############################################################
1820: ## Authentication changing form generation subroutines ##
1821: ###############################################################
1822: ##
1823: ## All of the authform_xxxxxxx subroutines take their inputs in a
1824: ## hash, and have reasonable default values.
1825: ##
1826: ## formname = the name given in the <form> tag.
1.35 matthew 1827: #-------------------------------------------
1828:
1.45 matthew 1829: =pod
1830:
1.112 bowersj2 1831: =head1 Authentication Routines
1832:
1833: =over 4
1834:
1835: =item * authform_xxxxxx
1.35 matthew 1836:
1837: The authform_xxxxxx subroutines provide javascript and html forms which
1838: handle some of the conveniences required for authentication forms.
1839: This is not an optimal method, but it works.
1840:
1841: See loncreateuser.pm for invocation and use examples.
1842:
1843: =over 4
1844:
1.112 bowersj2 1845: =item * authform_header
1.35 matthew 1846:
1.112 bowersj2 1847: =item * authform_authorwarning
1.35 matthew 1848:
1.112 bowersj2 1849: =item * authform_nochange
1.35 matthew 1850:
1.112 bowersj2 1851: =item * authform_kerberos
1.35 matthew 1852:
1.112 bowersj2 1853: =item * authform_internal
1.35 matthew 1854:
1.112 bowersj2 1855: =item * authform_filesystem
1.35 matthew 1856:
1857: =back
1858:
1.157 matthew 1859: =back
1860:
1.35 matthew 1861: =cut
1862:
1863: #-------------------------------------------
1.32 matthew 1864: sub authform_header{
1865: my %in = (
1866: formname => 'cu',
1.80 albertel 1867: kerb_def_dom => '',
1.32 matthew 1868: @_,
1869: );
1870: $in{'formname'} = 'document.' . $in{'formname'};
1871: my $result='';
1.80 albertel 1872:
1873: #---------------------------------------------- Code for upper case translation
1874: my $Javascript_toUpperCase;
1875: unless ($in{kerb_def_dom}) {
1876: $Javascript_toUpperCase =<<"END";
1877: switch (choice) {
1878: case 'krb': currentform.elements[choicearg].value =
1879: currentform.elements[choicearg].value.toUpperCase();
1880: break;
1881: default:
1882: }
1883: END
1884: } else {
1885: $Javascript_toUpperCase = "";
1886: }
1887:
1.165 raeburn 1888: my $radioval = "'nochange'";
1.591 raeburn 1889: if (defined($in{'curr_authtype'})) {
1890: if ($in{'curr_authtype'} ne '') {
1891: $radioval = "'".$in{'curr_authtype'}."arg'";
1892: }
1.174 matthew 1893: }
1.165 raeburn 1894: my $argfield = 'null';
1.591 raeburn 1895: if (defined($in{'mode'})) {
1.165 raeburn 1896: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 1897: if (defined($in{'curr_autharg'})) {
1898: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 1899: $argfield = "'$in{'curr_autharg'}'";
1900: }
1901: }
1902: }
1903: }
1904:
1.32 matthew 1905: $result.=<<"END";
1906: var current = new Object();
1.165 raeburn 1907: current.radiovalue = $radioval;
1908: current.argfield = $argfield;
1.32 matthew 1909:
1910: function changed_radio(choice,currentform) {
1911: var choicearg = choice + 'arg';
1912: // If a radio button in changed, we need to change the argfield
1913: if (current.radiovalue != choice) {
1914: current.radiovalue = choice;
1915: if (current.argfield != null) {
1916: currentform.elements[current.argfield].value = '';
1917: }
1918: if (choice == 'nochange') {
1919: current.argfield = null;
1920: } else {
1921: current.argfield = choicearg;
1922: switch(choice) {
1923: case 'krb':
1924: currentform.elements[current.argfield].value =
1925: "$in{'kerb_def_dom'}";
1926: break;
1927: default:
1928: break;
1929: }
1930: }
1931: }
1932: return;
1933: }
1.22 www 1934:
1.32 matthew 1935: function changed_text(choice,currentform) {
1936: var choicearg = choice + 'arg';
1937: if (currentform.elements[choicearg].value !='') {
1.80 albertel 1938: $Javascript_toUpperCase
1.32 matthew 1939: // clear old field
1940: if ((current.argfield != choicearg) && (current.argfield != null)) {
1941: currentform.elements[current.argfield].value = '';
1942: }
1943: current.argfield = choicearg;
1944: }
1945: set_auth_radio_buttons(choice,currentform);
1946: return;
1.20 www 1947: }
1.32 matthew 1948:
1949: function set_auth_radio_buttons(newvalue,currentform) {
1950: var i=0;
1951: while (i < currentform.login.length) {
1952: if (currentform.login[i].value == newvalue) { break; }
1953: i++;
1954: }
1955: if (i == currentform.login.length) {
1956: return;
1957: }
1958: current.radiovalue = newvalue;
1959: currentform.login[i].checked = true;
1960: return;
1961: }
1962: END
1963: return $result;
1964: }
1965:
1966: sub authform_authorwarning{
1967: my $result='';
1.144 matthew 1968: $result='<i>'.
1969: &mt('As a general rule, only authors or co-authors should be '.
1970: 'filesystem authenticated '.
1971: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 1972: return $result;
1973: }
1974:
1975: sub authform_nochange{
1976: my %in = (
1977: formname => 'document.cu',
1978: kerb_def_dom => 'MSU.EDU',
1979: @_,
1980: );
1.586 raeburn 1981: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1982: my $result;
1983: if (keys(%can_assign) == 0) {
1984: $result = &mt('Under you current role you are not permitted to change login settings for this user');
1985: } else {
1986: $result = '<label>'.&mt('[_1] Do not change login data',
1987: '<input type="radio" name="login" value="nochange" '.
1988: 'checked="checked" onclick="'.
1.281 albertel 1989: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
1990: '</label>';
1.586 raeburn 1991: }
1.32 matthew 1992: return $result;
1993: }
1994:
1.591 raeburn 1995: sub authform_kerberos {
1.32 matthew 1996: my %in = (
1997: formname => 'document.cu',
1998: kerb_def_dom => 'MSU.EDU',
1.80 albertel 1999: kerb_def_auth => 'krb4',
1.32 matthew 2000: @_,
2001: );
1.586 raeburn 2002: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2003: $autharg,$jscall);
2004: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2005: if ($in{'kerb_def_auth'} eq 'krb5') {
1.586 raeburn 2006: $check5 = ' checked="on"';
1.80 albertel 2007: } else {
1.586 raeburn 2008: $check4 = ' checked="on"';
1.80 albertel 2009: }
1.165 raeburn 2010: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2011: if (defined($in{'curr_authtype'})) {
2012: if ($in{'curr_authtype'} eq 'krb') {
1.586 raeburn 2013: $krbcheck = ' checked="on"';
1.623 raeburn 2014: if (defined($in{'mode'})) {
2015: if ($in{'mode'} eq 'modifyuser') {
2016: $krbcheck = '';
2017: }
2018: }
1.591 raeburn 2019: if (defined($in{'curr_kerb_ver'})) {
2020: if ($in{'curr_krb_ver'} eq '5') {
2021: $check5 = ' checked="on"';
2022: $check4 = '';
2023: } else {
2024: $check4 = ' checked="on"';
2025: $check5 = '';
2026: }
1.586 raeburn 2027: }
1.591 raeburn 2028: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2029: $krbarg = $in{'curr_autharg'};
2030: }
1.586 raeburn 2031: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2032: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2033: $result =
2034: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2035: $in{'curr_autharg'},$krbver);
2036: } else {
2037: $result =
2038: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2039: }
2040: return $result;
2041: }
2042: }
2043: } else {
2044: if ($authnum == 1) {
2045: $authtype = '<input type="hidden" name="login" value="krb">';
1.165 raeburn 2046: }
2047: }
1.586 raeburn 2048: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2049: return;
1.587 raeburn 2050: } elsif ($authtype eq '') {
1.591 raeburn 2051: if (defined($in{'mode'})) {
1.587 raeburn 2052: if ($in{'mode'} eq 'modifycourse') {
2053: if ($authnum == 1) {
2054: $authtype = '<input type="hidden" name="login" value="krb">';
2055: }
2056: }
2057: }
1.586 raeburn 2058: }
2059: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2060: if ($authtype eq '') {
2061: $authtype = '<input type="radio" name="login" value="krb" '.
2062: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2063: $krbcheck.' />';
2064: }
2065: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2066: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2067: $in{'curr_authtype'} eq 'krb5') ||
2068: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2069: $in{'curr_authtype'} eq 'krb4')) {
2070: $result .= &mt
1.144 matthew 2071: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2072: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2073: '<label>'.$authtype,
1.281 albertel 2074: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2075: 'value="'.$krbarg.'" '.
1.144 matthew 2076: 'onchange="'.$jscall.'" />',
1.281 albertel 2077: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2078: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2079: '</label>');
1.586 raeburn 2080: } elsif ($can_assign{'krb4'}) {
2081: $result .= &mt
2082: ('[_1] Kerberos authenticated with domain [_2] '.
2083: '[_3] Version 4 [_4]',
2084: '<label>'.$authtype,
2085: '</label><input type="text" size="10" name="krbarg" '.
2086: 'value="'.$krbarg.'" '.
2087: 'onchange="'.$jscall.'" />',
2088: '<label><input type="hidden" name="krbver" value="4" />',
2089: '</label>');
2090: } elsif ($can_assign{'krb5'}) {
2091: $result .= &mt
2092: ('[_1] Kerberos authenticated with domain [_2] '.
2093: '[_3] Version 5 [_4]',
2094: '<label>'.$authtype,
2095: '</label><input type="text" size="10" name="krbarg" '.
2096: 'value="'.$krbarg.'" '.
2097: 'onchange="'.$jscall.'" />',
2098: '<label><input type="hidden" name="krbver" value="5" />',
2099: '</label>');
2100: }
1.32 matthew 2101: return $result;
2102: }
2103:
2104: sub authform_internal{
1.586 raeburn 2105: my %in = (
1.32 matthew 2106: formname => 'document.cu',
2107: kerb_def_dom => 'MSU.EDU',
2108: @_,
2109: );
1.586 raeburn 2110: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2111: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2112: if (defined($in{'curr_authtype'})) {
2113: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2114: if ($can_assign{'int'}) {
2115: $intcheck = 'checked="on" ';
1.623 raeburn 2116: if (defined($in{'mode'})) {
2117: if ($in{'mode'} eq 'modifyuser') {
2118: $intcheck = '';
2119: }
2120: }
1.591 raeburn 2121: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2122: $intarg = $in{'curr_autharg'};
2123: }
2124: } else {
2125: $result = &mt('Currently internally authenticated.');
2126: return $result;
1.165 raeburn 2127: }
2128: }
1.586 raeburn 2129: } else {
2130: if ($authnum == 1) {
2131: $authtype = '<input type="hidden" name="login" value="int">';
2132: }
2133: }
2134: if (!$can_assign{'int'}) {
2135: return;
1.587 raeburn 2136: } elsif ($authtype eq '') {
1.591 raeburn 2137: if (defined($in{'mode'})) {
1.587 raeburn 2138: if ($in{'mode'} eq 'modifycourse') {
2139: if ($authnum == 1) {
2140: $authtype = '<input type="hidden" name="login" value="int">';
2141: }
2142: }
2143: }
1.165 raeburn 2144: }
1.586 raeburn 2145: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2146: if ($authtype eq '') {
2147: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2148: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2149: }
1.605 bisitz 2150: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2151: $intarg.'" onchange="'.$jscall.'" />';
2152: $result = &mt
1.144 matthew 2153: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2154: '<label>'.$authtype,'</label>'.$autharg);
1.620 www 2155: $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 2156: return $result;
2157: }
2158:
2159: sub authform_local{
2160: my %in = (
2161: formname => 'document.cu',
2162: kerb_def_dom => 'MSU.EDU',
2163: @_,
2164: );
1.586 raeburn 2165: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2166: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2167: if (defined($in{'curr_authtype'})) {
2168: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2169: if ($can_assign{'loc'}) {
2170: $loccheck = 'checked="on" ';
1.623 raeburn 2171: if (defined($in{'mode'})) {
2172: if ($in{'mode'} eq 'modifyuser') {
2173: $loccheck = '';
2174: }
2175: }
1.591 raeburn 2176: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2177: $locarg = $in{'curr_autharg'};
2178: }
2179: } else {
2180: $result = &mt('Currently using local (institutional) authentication.');
2181: return $result;
1.165 raeburn 2182: }
2183: }
1.586 raeburn 2184: } else {
2185: if ($authnum == 1) {
2186: $authtype = '<input type="hidden" name="login" value="loc">';
2187: }
2188: }
2189: if (!$can_assign{'loc'}) {
2190: return;
1.587 raeburn 2191: } elsif ($authtype eq '') {
1.591 raeburn 2192: if (defined($in{'mode'})) {
1.587 raeburn 2193: if ($in{'mode'} eq 'modifycourse') {
2194: if ($authnum == 1) {
2195: $authtype = '<input type="hidden" name="login" value="loc">';
2196: }
2197: }
2198: }
1.165 raeburn 2199: }
1.586 raeburn 2200: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2201: if ($authtype eq '') {
2202: $authtype = '<input type="radio" name="login" value="loc" '.
2203: $loccheck.' onchange="'.$jscall.'" onclick="'.
2204: $jscall.'" />';
2205: }
2206: $autharg = '<input type="text" size="10" name="locarg" value="'.
2207: $locarg.'" onchange="'.$jscall.'" />';
2208: $result = &mt('[_1] Local Authentication with argument [_2]',
2209: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2210: return $result;
2211: }
2212:
2213: sub authform_filesystem{
2214: my %in = (
2215: formname => 'document.cu',
2216: kerb_def_dom => 'MSU.EDU',
2217: @_,
2218: );
1.586 raeburn 2219: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2220: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2221: if (defined($in{'curr_authtype'})) {
2222: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2223: if ($can_assign{'fsys'}) {
2224: $fsyscheck = 'checked="on" ';
1.623 raeburn 2225: if (defined($in{'mode'})) {
2226: if ($in{'mode'} eq 'modifyuser') {
2227: $fsyscheck = '';
2228: }
2229: }
1.586 raeburn 2230: } else {
2231: $result = &mt('Currently Filesystem Authenticated.');
2232: return $result;
2233: }
2234: }
2235: } else {
2236: if ($authnum == 1) {
2237: $authtype = '<input type="hidden" name="login" value="fsys">';
2238: }
2239: }
2240: if (!$can_assign{'fsys'}) {
2241: return;
1.587 raeburn 2242: } elsif ($authtype eq '') {
1.591 raeburn 2243: if (defined($in{'mode'})) {
1.587 raeburn 2244: if ($in{'mode'} eq 'modifycourse') {
2245: if ($authnum == 1) {
2246: $authtype = '<input type="hidden" name="login" value="fsys">';
2247: }
2248: }
2249: }
1.586 raeburn 2250: }
2251: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2252: if ($authtype eq '') {
2253: $authtype = '<input type="radio" name="login" value="fsys" '.
2254: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2255: $jscall.'" />';
2256: }
2257: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2258: ' onchange="'.$jscall.'" />';
2259: $result = &mt
1.144 matthew 2260: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2261: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2262: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2263: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2264: 'onchange="'.$jscall.'" />');
1.32 matthew 2265: return $result;
2266: }
2267:
1.586 raeburn 2268: sub get_assignable_auth {
2269: my ($dom) = @_;
2270: if ($dom eq '') {
2271: $dom = $env{'request.role.domain'};
2272: }
2273: my %can_assign = (
2274: krb4 => 1,
2275: krb5 => 1,
2276: int => 1,
2277: loc => 1,
2278: );
2279: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2280: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2281: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2282: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2283: my $context;
2284: if ($env{'request.role'} =~ /^au/) {
2285: $context = 'author';
2286: } elsif ($env{'request.role'} =~ /^dc/) {
2287: $context = 'domain';
2288: } elsif ($env{'request.course.id'}) {
2289: $context = 'course';
2290: }
2291: if ($context) {
2292: if (ref($authhash->{$context}) eq 'HASH') {
2293: %can_assign = %{$authhash->{$context}};
2294: }
2295: }
2296: }
2297: }
2298: my $authnum = 0;
2299: foreach my $key (keys(%can_assign)) {
2300: if ($can_assign{$key}) {
2301: $authnum ++;
2302: }
2303: }
2304: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2305: $authnum --;
2306: }
2307: return ($authnum,%can_assign);
2308: }
2309:
1.80 albertel 2310: ###############################################################
2311: ## Get Authentication Defaults for Domain ##
2312: ###############################################################
2313:
2314: =pod
2315:
1.112 bowersj2 2316: =head1 Domains and Authentication
2317:
2318: Returns default authentication type and an associated argument as
2319: listed in file 'domain.tab'.
2320:
2321: =over 4
2322:
2323: =item * get_auth_defaults
1.80 albertel 2324:
2325: get_auth_defaults($target_domain) returns the default authentication
2326: type and an associated argument (initial password or a kerberos domain).
2327: These values are stored in lonTabs/domain.tab
2328:
2329: ($def_auth, $def_arg) = &get_auth_defaults($target_domain);
2330:
2331: If target_domain is not found in domain.tab, returns nothing ('').
2332:
2333: =cut
2334:
2335: #-------------------------------------------
2336: sub get_auth_defaults {
2337: my $domain=shift;
1.514 albertel 2338: return (&Apache::lonnet::domain($domain,'auth_def'),
2339: &Apache::lonnet::domain($domain,'auth_arg_def'));
2340:
1.80 albertel 2341: }
2342: ###############################################################
2343: ## End Get Authentication Defaults for Domain ##
2344: ###############################################################
2345:
2346: ###############################################################
2347: ## Get Kerberos Defaults for Domain ##
2348: ###############################################################
2349: ##
2350: ## Returns default kerberos version and an associated argument
2351: ## as listed in file domain.tab. If not listed, provides
2352: ## appropriate default domain and kerberos version.
2353: ##
2354: #-------------------------------------------
2355:
2356: =pod
2357:
1.112 bowersj2 2358: =item * get_kerberos_defaults
1.80 albertel 2359:
2360: get_kerberos_defaults($target_domain) returns the default kerberos
2361: version and domain. If not found in domain.tabs, it defaults to
2362: version 4 and the domain of the server.
2363:
2364: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2365:
2366: =cut
2367:
2368: #-------------------------------------------
2369: sub get_kerberos_defaults {
2370: my $domain=shift;
2371: my ($krbdef,$krbdefdom) =
2372: &Apache::loncommon::get_auth_defaults($domain);
2373: unless ($krbdef =~/^krb/ && $krbdefdom) {
2374: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2375: my $krbdefdom=$1;
2376: $krbdefdom=~tr/a-z/A-Z/;
2377: $krbdef = "krb4";
2378: }
2379: return ($krbdef,$krbdefdom);
2380: }
1.112 bowersj2 2381:
2382: =pod
2383:
2384: =back
2385:
2386: =cut
1.32 matthew 2387:
1.46 matthew 2388: ###############################################################
2389: ## Thesaurus Functions ##
2390: ###############################################################
1.20 www 2391:
1.46 matthew 2392: =pod
1.20 www 2393:
1.112 bowersj2 2394: =head1 Thesaurus Functions
2395:
2396: =over 4
2397:
2398: =item * initialize_keywords
1.46 matthew 2399:
2400: Initializes the package variable %Keywords if it is empty. Uses the
2401: package variable $thesaurus_db_file.
2402:
2403: =cut
2404:
2405: ###################################################
2406:
2407: sub initialize_keywords {
2408: return 1 if (scalar keys(%Keywords));
2409: # If we are here, %Keywords is empty, so fill it up
2410: # Make sure the file we need exists...
2411: if (! -e $thesaurus_db_file) {
2412: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2413: " failed because it does not exist");
2414: return 0;
2415: }
2416: # Set up the hash as a database
2417: my %thesaurus_db;
2418: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2419: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2420: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2421: $thesaurus_db_file);
2422: return 0;
2423: }
2424: # Get the average number of appearances of a word.
2425: my $avecount = $thesaurus_db{'average.count'};
2426: # Put keywords (those that appear > average) into %Keywords
2427: while (my ($word,$data)=each (%thesaurus_db)) {
2428: my ($count,undef) = split /:/,$data;
2429: $Keywords{$word}++ if ($count > $avecount);
2430: }
2431: untie %thesaurus_db;
2432: # Remove special values from %Keywords.
1.356 albertel 2433: foreach my $value ('total.count','average.count') {
2434: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2435: }
1.46 matthew 2436: return 1;
2437: }
2438:
2439: ###################################################
2440:
2441: =pod
2442:
1.112 bowersj2 2443: =item * keyword($word)
1.46 matthew 2444:
2445: Returns true if $word is a keyword. A keyword is a word that appears more
2446: than the average number of times in the thesaurus database. Calls
2447: &initialize_keywords
2448:
2449: =cut
2450:
2451: ###################################################
1.20 www 2452:
2453: sub keyword {
1.46 matthew 2454: return if (!&initialize_keywords());
2455: my $word=lc(shift());
2456: $word=~s/\W//g;
2457: return exists($Keywords{$word});
1.20 www 2458: }
1.46 matthew 2459:
2460: ###############################################################
2461:
2462: =pod
1.20 www 2463:
1.112 bowersj2 2464: =item * get_related_words
1.46 matthew 2465:
1.160 matthew 2466: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2467: an array of words. If the keyword is not in the thesaurus, an empty array
2468: will be returned. The order of the words returned is determined by the
2469: database which holds them.
2470:
2471: Uses global $thesaurus_db_file.
2472:
2473: =cut
2474:
2475: ###############################################################
2476: sub get_related_words {
2477: my $keyword = shift;
2478: my %thesaurus_db;
2479: if (! -e $thesaurus_db_file) {
2480: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2481: "failed because the file does not exist");
2482: return ();
2483: }
2484: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2485: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2486: return ();
2487: }
2488: my @Words=();
1.429 www 2489: my $count=0;
1.46 matthew 2490: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2491: # The first element is the number of times
2492: # the word appears. We do not need it now.
1.429 www 2493: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2494: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2495: my $threshold=$mostfrequentcount/10;
2496: foreach my $possibleword (@RelatedWords) {
2497: my ($word,$wordcount)=split(/\,/,$possibleword);
2498: if ($wordcount>$threshold) {
2499: push(@Words,$word);
2500: $count++;
2501: if ($count>10) { last; }
2502: }
1.20 www 2503: }
2504: }
1.46 matthew 2505: untie %thesaurus_db;
2506: return @Words;
1.14 harris41 2507: }
1.46 matthew 2508:
1.112 bowersj2 2509: =pod
2510:
2511: =back
2512:
2513: =cut
1.61 www 2514:
2515: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2516: =pod
2517:
1.112 bowersj2 2518: =head1 User Name Functions
2519:
2520: =over 4
2521:
1.226 albertel 2522: =item * plainname($uname,$udom,$first)
1.81 albertel 2523:
1.112 bowersj2 2524: Takes a users logon name and returns it as a string in
1.226 albertel 2525: "first middle last generation" form
2526: if $first is set to 'lastname' then it returns it as
2527: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2528:
2529: =cut
1.61 www 2530:
1.295 www 2531:
1.81 albertel 2532: ###############################################################
1.61 www 2533: sub plainname {
1.226 albertel 2534: my ($uname,$udom,$first)=@_;
1.537 albertel 2535: return if (!defined($uname) || !defined($udom));
1.295 www 2536: my %names=&getnames($uname,$udom);
1.226 albertel 2537: my $name=&Apache::lonnet::format_name($names{'firstname'},
2538: $names{'middlename'},
2539: $names{'lastname'},
2540: $names{'generation'},$first);
2541: $name=~s/^\s+//;
1.62 www 2542: $name=~s/\s+$//;
2543: $name=~s/\s+/ /g;
1.353 albertel 2544: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2545: return $name;
1.61 www 2546: }
1.66 www 2547:
2548: # -------------------------------------------------------------------- Nickname
1.81 albertel 2549: =pod
2550:
1.112 bowersj2 2551: =item * nickname($uname,$udom)
1.81 albertel 2552:
2553: Gets a users name and returns it as a string as
2554:
2555: ""nickname""
1.66 www 2556:
1.81 albertel 2557: if the user has a nickname or
2558:
2559: "first middle last generation"
2560:
2561: if the user does not
2562:
2563: =cut
1.66 www 2564:
2565: sub nickname {
2566: my ($uname,$udom)=@_;
1.537 albertel 2567: return if (!defined($uname) || !defined($udom));
1.295 www 2568: my %names=&getnames($uname,$udom);
1.68 albertel 2569: my $name=$names{'nickname'};
1.66 www 2570: if ($name) {
2571: $name='"'.$name.'"';
2572: } else {
2573: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2574: $names{'lastname'}.' '.$names{'generation'};
2575: $name=~s/\s+$//;
2576: $name=~s/\s+/ /g;
2577: }
2578: return $name;
2579: }
2580:
1.295 www 2581: sub getnames {
2582: my ($uname,$udom)=@_;
1.537 albertel 2583: return if (!defined($uname) || !defined($udom));
1.433 albertel 2584: if ($udom eq 'public' && $uname eq 'public') {
2585: return ('lastname' => &mt('Public'));
2586: }
1.295 www 2587: my $id=$uname.':'.$udom;
2588: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2589: if ($cached) {
2590: return %{$names};
2591: } else {
2592: my %loadnames=&Apache::lonnet::get('environment',
2593: ['firstname','middlename','lastname','generation','nickname'],
2594: $udom,$uname);
2595: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2596: return %loadnames;
2597: }
2598: }
1.61 www 2599:
1.542 raeburn 2600: # -------------------------------------------------------------------- getemails
2601: =pod
2602:
2603: =item * getemails($uname,$udom)
2604:
2605: Gets a user's email information and returns it as a hash with keys:
2606: notification, critnotification, permanentemail
2607:
2608: For notification and critnotification, values are comma-separated lists
2609: of e-mail address(es); for permanentemail, value is a single e-mail address.
2610:
2611: =cut
2612:
1.466 albertel 2613: sub getemails {
2614: my ($uname,$udom)=@_;
2615: if ($udom eq 'public' && $uname eq 'public') {
2616: return;
2617: }
1.467 www 2618: if (!$udom) { $udom=$env{'user.domain'}; }
2619: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2620: my $id=$uname.':'.$udom;
2621: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2622: if ($cached) {
2623: return %{$names};
2624: } else {
2625: my %loadnames=&Apache::lonnet::get('environment',
2626: ['notification','critnotification',
2627: 'permanentemail'],
2628: $udom,$uname);
2629: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2630: return %loadnames;
2631: }
2632: }
2633:
1.551 albertel 2634: sub flush_email_cache {
2635: my ($uname,$udom)=@_;
2636: if (!$udom) { $udom =$env{'user.domain'}; }
2637: if (!$uname) { $uname=$env{'user.name'}; }
2638: return if ($udom eq 'public' && $uname eq 'public');
2639: my $id=$uname.':'.$udom;
2640: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2641: }
2642:
1.61 www 2643: # ------------------------------------------------------------------ Screenname
1.81 albertel 2644:
2645: =pod
2646:
1.112 bowersj2 2647: =item * screenname($uname,$udom)
1.81 albertel 2648:
2649: Gets a users screenname and returns it as a string
2650:
2651: =cut
1.61 www 2652:
2653: sub screenname {
2654: my ($uname,$udom)=@_;
1.258 albertel 2655: if ($uname eq $env{'user.name'} &&
2656: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2657: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2658: return $names{'screenname'};
1.62 www 2659: }
2660:
1.212 albertel 2661:
1.62 www 2662: # ------------------------------------------------------------- Message Wrapper
2663:
2664: sub messagewrapper {
1.369 www 2665: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2666: return
1.441 albertel 2667: '<a href="/adm/email?compose=individual&'.
2668: 'recname='.$username.'&recdom='.$domain.
2669: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2670: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2671: }
2672: # --------------------------------------------------------------- Notes Wrapper
2673:
2674: sub noteswrapper {
2675: my ($link,$un,$do)=@_;
2676: return
2677: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2678: }
2679: # ------------------------------------------------------------- Aboutme Wrapper
2680:
2681: sub aboutmewrapper {
1.166 www 2682: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2683: if (!defined($username) && !defined($domain)) {
2684: return;
2685: }
1.205 www 2686: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.454 banghart 2687: ($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';
1.62 www 2688: }
2689:
2690: # ------------------------------------------------------------ Syllabus Wrapper
2691:
2692:
2693: sub syllabuswrapper {
1.109 matthew 2694: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
2695: if ($fontcolor) {
2696: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
2697: }
1.208 matthew 2698: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2699: }
1.14 harris41 2700:
1.208 matthew 2701: sub track_student_link {
1.268 albertel 2702: my ($linktext,$sname,$sdom,$target,$start) = @_;
2703: my $link ="/adm/trackstudent?";
1.208 matthew 2704: my $title = 'View recent activity';
2705: if (defined($sname) && $sname !~ /^\s*$/ &&
2706: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2707: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2708: $title .= ' of this student';
1.268 albertel 2709: }
1.208 matthew 2710: if (defined($target) && $target !~ /^\s*$/) {
2711: $target = qq{target="$target"};
2712: } else {
2713: $target = '';
2714: }
1.268 albertel 2715: if ($start) { $link.='&start='.$start; }
1.554 albertel 2716: $title = &mt($title);
2717: $linktext = &mt($linktext);
1.448 albertel 2718: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2719: &help_open_topic('View_recent_activity');
1.208 matthew 2720: }
2721:
1.508 www 2722: # ===================================================== Display a student photo
2723:
2724:
1.509 albertel 2725: sub student_image_tag {
1.508 www 2726: my ($domain,$user)=@_;
2727: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
2728: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
2729: return '<img src="'.$imgsrc.'" align="right" />';
2730: } else {
2731: return '';
2732: }
2733: }
2734:
1.112 bowersj2 2735: =pod
2736:
2737: =back
2738:
2739: =head1 Access .tab File Data
2740:
2741: =over 4
2742:
2743: =item * languageids()
2744:
2745: returns list of all language ids
2746:
2747: =cut
2748:
1.14 harris41 2749: sub languageids {
1.16 harris41 2750: return sort(keys(%language));
1.14 harris41 2751: }
2752:
1.112 bowersj2 2753: =pod
2754:
2755: =item * languagedescription()
2756:
2757: returns description of a specified language id
2758:
2759: =cut
2760:
1.14 harris41 2761: sub languagedescription {
1.125 www 2762: my $code=shift;
2763: return ($supported_language{$code}?'* ':'').
2764: $language{$code}.
1.126 www 2765: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 2766: }
2767:
2768: sub plainlanguagedescription {
2769: my $code=shift;
2770: return $language{$code};
2771: }
2772:
2773: sub supportedlanguagecode {
2774: my $code=shift;
2775: return $supported_language{$code};
1.97 www 2776: }
2777:
1.112 bowersj2 2778: =pod
2779:
2780: =item * copyrightids()
2781:
2782: returns list of all copyrights
2783:
2784: =cut
2785:
2786: sub copyrightids {
2787: return sort(keys(%cprtag));
2788: }
2789:
2790: =pod
2791:
2792: =item * copyrightdescription()
2793:
2794: returns description of a specified copyright id
2795:
2796: =cut
2797:
2798: sub copyrightdescription {
1.166 www 2799: return &mt($cprtag{shift(@_)});
1.112 bowersj2 2800: }
1.197 matthew 2801:
2802: =pod
2803:
1.192 taceyjo1 2804: =item * source_copyrightids()
2805:
2806: returns list of all source copyrights
2807:
2808: =cut
2809:
2810: sub source_copyrightids {
2811: return sort(keys(%scprtag));
2812: }
2813:
2814: =pod
2815:
2816: =item * source_copyrightdescription()
2817:
2818: returns description of a specified source copyright id
2819:
2820: =cut
2821:
2822: sub source_copyrightdescription {
2823: return &mt($scprtag{shift(@_)});
2824: }
1.112 bowersj2 2825:
2826: =pod
2827:
2828: =item * filecategories()
2829:
2830: returns list of all file categories
2831:
2832: =cut
2833:
2834: sub filecategories {
2835: return sort(keys(%category_extensions));
2836: }
2837:
2838: =pod
2839:
2840: =item * filecategorytypes()
2841:
2842: returns list of file types belonging to a given file
2843: category
2844:
2845: =cut
2846:
2847: sub filecategorytypes {
1.356 albertel 2848: my ($cat) = @_;
2849: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 2850: }
2851:
2852: =pod
2853:
2854: =item * fileembstyle()
2855:
2856: returns embedding style for a specified file type
2857:
2858: =cut
2859:
2860: sub fileembstyle {
2861: return $fe{lc(shift(@_))};
1.169 www 2862: }
2863:
1.351 www 2864: sub filemimetype {
2865: return $fm{lc(shift(@_))};
2866: }
2867:
1.169 www 2868:
2869: sub filecategoryselect {
2870: my ($name,$value)=@_;
1.189 matthew 2871: return &select_form($value,$name,
1.169 www 2872: '' => &mt('Any category'),
2873: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 2874: }
2875:
2876: =pod
2877:
2878: =item * filedescription()
2879:
2880: returns description for a specified file type
2881:
2882: =cut
2883:
2884: sub filedescription {
1.188 matthew 2885: my $file_description = $fd{lc(shift())};
2886: $file_description =~ s:([\[\]]):~$1:g;
2887: return &mt($file_description);
1.112 bowersj2 2888: }
2889:
2890: =pod
2891:
2892: =item * filedescriptionex()
2893:
2894: returns description for a specified file type with
2895: extra formatting
2896:
2897: =cut
2898:
2899: sub filedescriptionex {
2900: my $ex=shift;
1.188 matthew 2901: my $file_description = $fd{lc($ex)};
2902: $file_description =~ s:([\[\]]):~$1:g;
2903: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 2904: }
2905:
2906: # End of .tab access
2907: =pod
2908:
2909: =back
2910:
2911: =cut
2912:
2913: # ------------------------------------------------------------------ File Types
2914: sub fileextensions {
2915: return sort(keys(%fe));
2916: }
2917:
1.97 www 2918: # ----------------------------------------------------------- Display Languages
2919: # returns a hash with all desired display languages
2920: #
2921:
2922: sub display_languages {
2923: my %languages=();
1.356 albertel 2924: foreach my $lang (&preferred_languages()) {
2925: $languages{$lang}=1;
1.97 www 2926: }
2927: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 2928: if ($env{'form.displaylanguage'}) {
1.356 albertel 2929: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
2930: $languages{$lang}=1;
1.97 www 2931: }
2932: }
2933: return %languages;
1.14 harris41 2934: }
2935:
1.117 www 2936: sub preferred_languages {
2937: my @languages=();
1.258 albertel 2938: if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
1.117 www 2939: @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
1.258 albertel 2940: $env{'course.'.$env{'request.course.id'}.'.languages'}));
1.177 www 2941: }
1.258 albertel 2942: if ($env{'environment.languages'}) {
1.459 albertel 2943: @languages=(@languages,
2944: split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
1.118 www 2945: }
1.583 albertel 2946: my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
1.162 www 2947: if ($browser) {
1.583 albertel 2948: my @browser =
2949: map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
2950: push(@languages,@browser);
1.162 www 2951: }
1.514 albertel 2952: if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
1.118 www 2953: @languages=(@languages,
1.514 albertel 2954: &Apache::lonnet::domain($env{'user.domain'},
2955: 'lang_def'));
1.118 www 2956: }
1.514 albertel 2957: if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
1.118 www 2958: @languages=(@languages,
1.514 albertel 2959: &Apache::lonnet::domain($env{'request.role.domain'},
2960: 'lang_def'));
1.118 www 2961: }
1.514 albertel 2962: if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
2963: 'lang_def')) {
1.118 www 2964: @languages=(@languages,
1.514 albertel 2965: &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
2966: 'lang_def'));
1.118 www 2967: }
2968: # turn "en-ca" into "en-ca,en"
2969: my @genlanguages;
1.356 albertel 2970: foreach my $lang (@languages) {
2971: unless ($lang=~/\w/) { next; }
1.583 albertel 2972: push(@genlanguages,$lang);
1.356 albertel 2973: if ($lang=~/(\-|\_)/) {
2974: push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
1.118 www 2975: }
2976: }
1.583 albertel 2977: #uniqueify the languages list
2978: my %count;
2979: @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
1.118 www 2980: return @genlanguages;
1.117 www 2981: }
2982:
1.582 albertel 2983: sub languages {
2984: my ($possible_langs) = @_;
2985: my @preferred_langs = &preferred_languages();
2986: if (!ref($possible_langs)) {
2987: if( wantarray ) {
2988: return @preferred_langs;
2989: } else {
2990: return $preferred_langs[0];
2991: }
2992: }
2993: my %possibilities = map { $_ => 1 } (@$possible_langs);
2994: my @preferred_possibilities;
2995: foreach my $preferred_lang (@preferred_langs) {
2996: if (exists($possibilities{$preferred_lang})) {
2997: push(@preferred_possibilities, $preferred_lang);
2998: }
2999: }
3000: if( wantarray ) {
3001: return @preferred_possibilities;
3002: }
3003: return $preferred_possibilities[0];
3004: }
3005:
1.112 bowersj2 3006: ###############################################################
3007: ## Student Answer Attempts ##
3008: ###############################################################
3009:
3010: =pod
3011:
3012: =head1 Alternate Problem Views
3013:
3014: =over 4
3015:
3016: =item * get_previous_attempt($symb, $username, $domain, $course,
3017: $getattempt, $regexp, $gradesub)
3018:
3019: Return string with previous attempt on problem. Arguments:
3020:
3021: =over 4
3022:
3023: =item * $symb: Problem, including path
3024:
3025: =item * $username: username of the desired student
3026:
3027: =item * $domain: domain of the desired student
1.14 harris41 3028:
1.112 bowersj2 3029: =item * $course: Course ID
1.14 harris41 3030:
1.112 bowersj2 3031: =item * $getattempt: Leave blank for all attempts, otherwise put
3032: something
1.14 harris41 3033:
1.112 bowersj2 3034: =item * $regexp: if string matches this regexp, the string will be
3035: sent to $gradesub
1.14 harris41 3036:
1.112 bowersj2 3037: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3038:
1.112 bowersj2 3039: =back
1.14 harris41 3040:
1.112 bowersj2 3041: The output string is a table containing all desired attempts, if any.
1.16 harris41 3042:
1.112 bowersj2 3043: =cut
1.1 albertel 3044:
3045: sub get_previous_attempt {
1.43 ng 3046: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3047: my $prevattempts='';
1.43 ng 3048: no strict 'refs';
1.1 albertel 3049: if ($symb) {
1.3 albertel 3050: my (%returnhash)=
3051: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3052: if ($returnhash{'version'}) {
3053: my %lasthash=();
3054: my $version;
3055: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3056: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3057: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3058: }
1.1 albertel 3059: }
1.596 albertel 3060: $prevattempts=&start_data_table().&start_data_table_header_row();
3061: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3062: foreach my $key (sort(keys(%lasthash))) {
3063: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3064: if ($#parts > 0) {
1.31 albertel 3065: my $data=$parts[-1];
3066: pop(@parts);
1.596 albertel 3067: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3068: } else {
1.41 ng 3069: if ($#parts == 0) {
3070: $prevattempts.='<th>'.$parts[0].'</th>';
3071: } else {
3072: $prevattempts.='<th>'.$ign.'</th>';
3073: }
1.31 albertel 3074: }
1.16 harris41 3075: }
1.596 albertel 3076: $prevattempts.=&end_data_table_header_row();
1.40 ng 3077: if ($getattempt eq '') {
3078: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3079: $prevattempts.=&start_data_table_row().
3080: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3081: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3082: my $value = &format_previous_attempt_value($key,
3083: $returnhash{$version.':'.$key});
3084: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3085: }
1.596 albertel 3086: $prevattempts.=&end_data_table_row();
1.40 ng 3087: }
1.1 albertel 3088: }
1.596 albertel 3089: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3090: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3091: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3092: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3093: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3094: }
1.596 albertel 3095: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3096: } else {
1.596 albertel 3097: $prevattempts=
3098: &start_data_table().&start_data_table_row().
3099: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3100: &end_data_table_row().&end_data_table();
1.1 albertel 3101: }
3102: } else {
1.596 albertel 3103: $prevattempts=
3104: &start_data_table().&start_data_table_row().
3105: '<td>'.&mt('No data.').'</td>'.
3106: &end_data_table_row().&end_data_table();
1.1 albertel 3107: }
1.10 albertel 3108: }
3109:
1.581 albertel 3110: sub format_previous_attempt_value {
3111: my ($key,$value) = @_;
3112: if ($key =~ /timestamp/) {
3113: $value = &Apache::lonlocal::locallocaltime($value);
3114: } elsif (ref($value) eq 'ARRAY') {
3115: $value = '('.join(', ', @{ $value }).')';
3116: } else {
3117: $value = &unescape($value);
3118: }
3119: return $value;
3120: }
3121:
3122:
1.107 albertel 3123: sub relative_to_absolute {
3124: my ($url,$output)=@_;
3125: my $parser=HTML::TokeParser->new(\$output);
3126: my $token;
3127: my $thisdir=$url;
3128: my @rlinks=();
3129: while ($token=$parser->get_token) {
3130: if ($token->[0] eq 'S') {
3131: if ($token->[1] eq 'a') {
3132: if ($token->[2]->{'href'}) {
3133: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3134: }
3135: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3136: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3137: } elsif ($token->[1] eq 'base') {
3138: $thisdir=$token->[2]->{'href'};
3139: }
3140: }
3141: }
3142: $thisdir=~s-/[^/]*$--;
1.356 albertel 3143: foreach my $link (@rlinks) {
3144: unless (($link=~/^http:\/\//i) ||
3145: ($link=~/^\//) ||
3146: ($link=~/^javascript:/i) ||
3147: ($link=~/^mailto:/i) ||
3148: ($link=~/^\#/)) {
3149: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3150: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3151: }
3152: }
3153: # -------------------------------------------------- Deal with Applet codebases
3154: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3155: return $output;
3156: }
3157:
1.112 bowersj2 3158: =pod
3159:
3160: =item * get_student_view
3161:
3162: show a snapshot of what student was looking at
3163:
3164: =cut
3165:
1.10 albertel 3166: sub get_student_view {
1.186 albertel 3167: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3168: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3169: my (%form);
1.10 albertel 3170: my @elements=('symb','courseid','domain','username');
3171: foreach my $element (@elements) {
1.186 albertel 3172: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3173: }
1.186 albertel 3174: if (defined($moreenv)) {
3175: %form=(%form,%{$moreenv});
3176: }
1.236 albertel 3177: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3178: $feedurl=&Apache::lonnet::clutter($feedurl);
1.186 albertel 3179: my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3180: $userview=~s/\<body[^\>]*\>//gi;
3181: $userview=~s/\<\/body\>//gi;
3182: $userview=~s/\<html\>//gi;
3183: $userview=~s/\<\/html\>//gi;
3184: $userview=~s/\<head\>//gi;
3185: $userview=~s/\<\/head\>//gi;
3186: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3187: $userview=&relative_to_absolute($feedurl,$userview);
1.11 albertel 3188: return $userview;
3189: }
3190:
1.112 bowersj2 3191: =pod
3192:
3193: =item * get_student_answers()
3194:
3195: show a snapshot of how student was answering problem
3196:
3197: =cut
3198:
1.11 albertel 3199: sub get_student_answers {
1.100 sakharuk 3200: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3201: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3202: my (%moreenv);
1.11 albertel 3203: my @elements=('symb','courseid','domain','username');
3204: foreach my $element (@elements) {
1.186 albertel 3205: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3206: }
1.186 albertel 3207: $moreenv{'grade_target'}='answer';
3208: %moreenv=(%form,%moreenv);
1.497 raeburn 3209: $feedurl = &Apache::lonnet::clutter($feedurl);
3210: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3211: return $userview;
1.1 albertel 3212: }
1.116 albertel 3213:
3214: =pod
3215:
3216: =item * &submlink()
3217:
1.242 albertel 3218: Inputs: $text $uname $udom $symb $target
1.116 albertel 3219:
3220: Returns: A link to grades.pm such as to see the SUBM view of a student
3221:
3222: =cut
3223:
3224: ###############################################
3225: sub submlink {
1.242 albertel 3226: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3227: if (!($uname && $udom)) {
3228: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3229: &Apache::lonnet::whichuser($symb);
1.116 albertel 3230: if (!$symb) { $symb=$cursymb; }
3231: }
1.254 matthew 3232: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3233: $symb=&escape($symb);
1.242 albertel 3234: if ($target) { $target="target=\"$target\""; }
3235: return '<a href="/adm/grades?&command=submission&'.
3236: 'symb='.$symb.'&student='.$uname.
3237: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3238: }
3239: ##############################################
3240:
3241: =pod
3242:
3243: =item * &pgrdlink()
3244:
3245: Inputs: $text $uname $udom $symb $target
3246:
3247: Returns: A link to grades.pm such as to see the PGRD view of a student
3248:
3249: =cut
3250:
3251: ###############################################
3252: sub pgrdlink {
3253: my $link=&submlink(@_);
3254: $link=~s/(&command=submission)/$1&showgrading=yes/;
3255: return $link;
3256: }
3257: ##############################################
3258:
3259: =pod
3260:
3261: =item * &pprmlink()
3262:
3263: Inputs: $text $uname $udom $symb $target
3264:
3265: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3266: student and a specific resource
1.242 albertel 3267:
3268: =cut
3269:
3270: ###############################################
3271: sub pprmlink {
3272: my ($text,$uname,$udom,$symb,$target)=@_;
3273: if (!($uname && $udom)) {
3274: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3275: &Apache::lonnet::whichuser($symb);
1.242 albertel 3276: if (!$symb) { $symb=$cursymb; }
3277: }
1.254 matthew 3278: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3279: $symb=&escape($symb);
1.242 albertel 3280: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3281: return '<a href="/adm/parmset?command=set&'.
3282: 'symb='.$symb.'&uname='.$uname.
3283: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3284: }
3285: ##############################################
1.37 matthew 3286:
1.112 bowersj2 3287: =pod
3288:
3289: =back
3290:
3291: =cut
3292:
1.37 matthew 3293: ###############################################
1.51 www 3294:
3295:
3296: sub timehash {
3297: my @ltime=localtime(shift);
3298: return ( 'seconds' => $ltime[0],
3299: 'minutes' => $ltime[1],
3300: 'hours' => $ltime[2],
3301: 'day' => $ltime[3],
3302: 'month' => $ltime[4]+1,
3303: 'year' => $ltime[5]+1900,
3304: 'weekday' => $ltime[6],
3305: 'dayyear' => $ltime[7]+1,
3306: 'dlsav' => $ltime[8] );
3307: }
3308:
1.370 www 3309: sub utc_string {
3310: my ($date)=@_;
1.371 www 3311: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3312: }
3313:
1.51 www 3314: sub maketime {
3315: my %th=@_;
3316: return POSIX::mktime(
3317: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3318: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3319: }
3320:
3321: #########################################
1.51 www 3322:
3323: sub findallcourses {
1.482 raeburn 3324: my ($roles,$uname,$udom) = @_;
1.355 albertel 3325: my %roles;
3326: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3327: my %courses;
1.51 www 3328: my $now=time;
1.482 raeburn 3329: if (!defined($uname)) {
3330: $uname = $env{'user.name'};
3331: }
3332: if (!defined($udom)) {
3333: $udom = $env{'user.domain'};
3334: }
3335: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3336: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3337: if (!%roles) {
3338: %roles = (
3339: cc => 1,
3340: in => 1,
3341: ep => 1,
3342: ta => 1,
3343: cr => 1,
3344: st => 1,
3345: );
3346: }
3347: foreach my $entry (keys(%roleshash)) {
3348: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3349: if ($trole =~ /^cr/) {
3350: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3351: } else {
3352: next if (!exists($roles{$trole}));
3353: }
3354: if ($tend) {
3355: next if ($tend < $now);
3356: }
3357: if ($tstart) {
3358: next if ($tstart > $now);
3359: }
3360: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3361: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3362: if ($secpart eq '') {
3363: ($cnum,$role) = split(/_/,$cnumpart);
3364: $sec = 'none';
3365: $realsec = '';
3366: } else {
3367: $cnum = $cnumpart;
3368: ($sec,$role) = split(/_/,$secpart);
3369: $realsec = $sec;
1.490 raeburn 3370: }
1.482 raeburn 3371: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3372: }
3373: } else {
3374: foreach my $key (keys(%env)) {
1.483 albertel 3375: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3376: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3377: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3378: next if ($role eq 'ca' || $role eq 'aa');
3379: next if (%roles && !exists($roles{$role}));
3380: my ($starttime,$endtime)=split(/\./,$env{$key});
3381: my $active=1;
3382: if ($starttime) {
3383: if ($now<$starttime) { $active=0; }
3384: }
3385: if ($endtime) {
3386: if ($now>$endtime) { $active=0; }
3387: }
3388: if ($active) {
3389: if ($sec eq '') {
3390: $sec = 'none';
3391: }
3392: $courses{$cdom.'_'.$cnum}{$sec} =
3393: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3394: }
3395: }
1.51 www 3396: }
3397: }
1.474 raeburn 3398: return %courses;
1.51 www 3399: }
1.37 matthew 3400:
1.54 www 3401: ###############################################
1.474 raeburn 3402:
3403: sub blockcheck {
1.482 raeburn 3404: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3405:
3406: if (!defined($udom)) {
3407: $udom = $env{'user.domain'};
3408: }
3409: if (!defined($uname)) {
3410: $uname = $env{'user.name'};
3411: }
3412:
3413: # If uname and udom are for a course, check for blocks in the course.
3414:
3415: if (&Apache::lonnet::is_course($udom,$uname)) {
3416: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3417: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3418: return ($startblock,$endblock);
3419: }
1.474 raeburn 3420:
1.502 raeburn 3421: my $startblock = 0;
3422: my $endblock = 0;
1.482 raeburn 3423: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3424:
1.490 raeburn 3425: # If uname is for a user, and activity is course-specific, i.e.,
3426: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3427:
1.490 raeburn 3428: if (($activity eq 'boards' || $activity eq 'chat' ||
3429: $activity eq 'groups') && ($env{'request.course.id'})) {
3430: foreach my $key (keys(%live_courses)) {
3431: if ($key ne $env{'request.course.id'}) {
3432: delete($live_courses{$key});
3433: }
3434: }
3435: }
3436:
3437: my $otheruser = 0;
3438: my %own_courses;
3439: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3440: # Resource belongs to user other than current user.
3441: $otheruser = 1;
3442: # Gather courses for current user
3443: %own_courses =
3444: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3445: }
3446:
3447: # Gather active course roles - course coordinator, instructor,
3448: # exam proctor, ta, student, or custom role.
1.474 raeburn 3449:
3450: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3451: my ($cdom,$cnum);
3452: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3453: $cdom = $env{'course.'.$course.'.domain'};
3454: $cnum = $env{'course.'.$course.'.num'};
3455: } else {
1.490 raeburn 3456: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3457: }
3458: my $no_ownblock = 0;
3459: my $no_userblock = 0;
1.533 raeburn 3460: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3461: # Check if current user has 'evb' priv for this
3462: if (defined($own_courses{$course})) {
3463: foreach my $sec (keys(%{$own_courses{$course}})) {
3464: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3465: if ($sec ne 'none') {
3466: $checkrole .= '/'.$sec;
3467: }
3468: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3469: $no_ownblock = 1;
3470: last;
3471: }
3472: }
3473: }
3474: # if they have 'evb' priv and are currently not playing student
3475: next if (($no_ownblock) &&
3476: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3477: }
1.474 raeburn 3478: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3479: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3480: if ($sec ne 'none') {
1.482 raeburn 3481: $checkrole .= '/'.$sec;
1.474 raeburn 3482: }
1.490 raeburn 3483: if ($otheruser) {
3484: # Resource belongs to user other than current user.
3485: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3486: my ($trole,$tdom,$tnum,$tsec);
3487: my $entry = $live_courses{$course}{$sec};
3488: if ($entry =~ /^cr/) {
3489: ($trole,$tdom,$tnum,$tsec) =
3490: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3491: } else {
3492: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3493: }
3494: my ($spec,$area,$trest,%allroles,%userroles);
3495: $area = '/'.$tdom.'/'.$tnum;
3496: $trest = $tnum;
3497: if ($tsec ne '') {
3498: $area .= '/'.$tsec;
3499: $trest .= '/'.$tsec;
3500: }
3501: $spec = $trole.'.'.$area;
3502: if ($trole =~ /^cr/) {
3503: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3504: $tdom,$spec,$trest,$area);
3505: } else {
3506: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3507: $tdom,$spec,$trest,$area);
3508: }
3509: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3510: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3511: if ($1) {
3512: $no_userblock = 1;
3513: last;
3514: }
3515: }
1.490 raeburn 3516: } else {
3517: # Resource belongs to current user
3518: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3519: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3520: $no_ownblock = 1;
3521: last;
3522: }
1.474 raeburn 3523: }
3524: }
3525: # if they have the evb priv and are currently not playing student
1.482 raeburn 3526: next if (($no_ownblock) &&
1.491 albertel 3527: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3528: next if ($no_userblock);
1.474 raeburn 3529:
1.490 raeburn 3530: # Retrieve blocking times and identity of blocker for course
3531: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3532:
3533: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3534: if (($start != 0) &&
3535: (($startblock == 0) || ($startblock > $start))) {
3536: $startblock = $start;
3537: }
3538: if (($end != 0) &&
3539: (($endblock == 0) || ($endblock < $end))) {
3540: $endblock = $end;
3541: }
1.490 raeburn 3542: }
3543: return ($startblock,$endblock);
3544: }
3545:
3546: sub get_blocks {
3547: my ($setters,$activity,$cdom,$cnum) = @_;
3548: my $startblock = 0;
3549: my $endblock = 0;
3550: my $course = $cdom.'_'.$cnum;
3551: $setters->{$course} = {};
3552: $setters->{$course}{'staff'} = [];
3553: $setters->{$course}{'times'} = [];
3554: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3555: foreach my $record (keys(%records)) {
3556: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3557: if ($start <= time && $end >= time) {
3558: my ($staff_name,$staff_dom,$title,$blocks) =
3559: &parse_block_record($records{$record});
3560: if ($blocks->{$activity} eq 'on') {
3561: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3562: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3563: if ( ($startblock == 0) || ($startblock > $start) ) {
3564: $startblock = $start;
1.490 raeburn 3565: }
1.491 albertel 3566: if ( ($endblock == 0) || ($endblock < $end) ) {
3567: $endblock = $end;
1.474 raeburn 3568: }
3569: }
3570: }
3571: }
3572: return ($startblock,$endblock);
3573: }
3574:
3575: sub parse_block_record {
3576: my ($record) = @_;
3577: my ($setuname,$setudom,$title,$blocks);
3578: if (ref($record) eq 'HASH') {
3579: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3580: $title = &unescape($record->{'event'});
3581: $blocks = $record->{'blocks'};
3582: } else {
3583: my @data = split(/:/,$record,3);
3584: if (scalar(@data) eq 2) {
3585: $title = $data[1];
3586: ($setuname,$setudom) = split(/@/,$data[0]);
3587: } else {
3588: ($setuname,$setudom,$title) = @data;
3589: }
3590: $blocks = { 'com' => 'on' };
3591: }
3592: return ($setuname,$setudom,$title,$blocks);
3593: }
3594:
3595: sub build_block_table {
3596: my ($startblock,$endblock,$setters) = @_;
3597: my %lt = &Apache::lonlocal::texthash(
3598: 'cacb' => 'Currently active communication blocks',
3599: 'cour' => 'Course',
3600: 'dura' => 'Duration',
3601: 'blse' => 'Block set by'
3602: );
3603: my $output;
1.476 raeburn 3604: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 3605: $output .= &start_data_table();
3606: $output .= '
3607: <tr>
3608: <th>'.$lt{'cour'}.'</th>
3609: <th>'.$lt{'dura'}.'</th>
3610: <th>'.$lt{'blse'}.'</th>
3611: </tr>
3612: ';
3613: foreach my $course (keys(%{$setters})) {
3614: my %courseinfo=&Apache::lonnet::coursedescription($course);
3615: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
3616: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 3617: my $fullname = &plainname($uname,$udom);
3618: if (defined($env{'user.name'}) && defined($env{'user.domain'})
3619: && $env{'user.name'} ne 'public'
3620: && $env{'user.domain'} ne 'public') {
3621: $fullname = &aboutmewrapper($fullname,$uname,$udom);
3622: }
1.474 raeburn 3623: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
3624: $openblock = &Apache::lonlocal::locallocaltime($openblock);
3625: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
3626: $output .= &Apache::loncommon::start_data_table_row().
3627: '<td>'.$courseinfo{'description'}.'</td>'.
3628: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 3629: '<td>'.$fullname.'</td>'.
1.474 raeburn 3630: &Apache::loncommon::end_data_table_row();
3631: }
3632: }
3633: $output .= &end_data_table();
3634: }
3635:
1.490 raeburn 3636: sub blocking_status {
3637: my ($activity,$uname,$udom) = @_;
3638: my %setters;
3639: my ($blocked,$output,$ownitem,$is_course);
3640: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
3641: if ($startblock && $endblock) {
3642: $blocked = 1;
3643: if (wantarray) {
3644: my $category;
3645: if ($activity eq 'boards') {
3646: $category = 'Discussion posts in this course';
3647: } elsif ($activity eq 'blogs') {
3648: $category = 'Blogs';
3649: } elsif ($activity eq 'port') {
3650: if (defined($uname) && defined($udom)) {
3651: if ($uname eq $env{'user.name'} &&
3652: $udom eq $env{'user.domain'}) {
3653: $ownitem = 1;
3654: }
3655: }
3656: $is_course = &Apache::lonnet::is_course($udom,$uname);
3657: if ($ownitem) {
3658: $category = 'Your portfolio files';
3659: } elsif ($is_course) {
3660: my $coursedesc;
3661: foreach my $course (keys(%setters)) {
3662: my %courseinfo =
3663: &Apache::lonnet::coursedescription($course);
3664: $coursedesc = $courseinfo{'description'};
3665: }
3666: $category = "Group files in the course '$coursedesc'";
3667: } else {
3668: $category = 'Portfolio files belonging to ';
3669: if ($env{'user.name'} eq 'public' &&
3670: $env{'user.domain'} eq 'public') {
3671: $category .= &plainname($uname,$udom);
3672: } else {
3673: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
3674: }
3675: }
3676: } elsif ($activity eq 'groups') {
3677: $category = 'Groups in this course';
3678: }
3679: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
3680: my $showend = &Apache::lonlocal::locallocaltime($endblock);
3681: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
3682: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
3683: $output .= &build_block_table($startblock,$endblock,\%setters);
3684: }
3685: }
3686: }
3687: if (wantarray) {
3688: return ($blocked,$output);
3689: } else {
3690: return $blocked;
3691: }
3692: }
3693:
1.60 matthew 3694: ###############################################
3695:
3696: =pod
3697:
1.112 bowersj2 3698: =head1 Domain Template Functions
3699:
3700: =over 4
3701:
3702: =item * &determinedomain()
1.60 matthew 3703:
3704: Inputs: $domain (usually will be undef)
3705:
1.63 www 3706: Returns: Determines which domain should be used for designs
1.60 matthew 3707:
3708: =cut
1.54 www 3709:
1.60 matthew 3710: ###############################################
1.63 www 3711: sub determinedomain {
3712: my $domain=shift;
1.531 albertel 3713: if (! $domain) {
1.60 matthew 3714: # Determine domain if we have not been given one
3715: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258 albertel 3716: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
3717: if ($env{'request.role.domain'}) {
3718: $domain=$env{'request.role.domain'};
1.60 matthew 3719: }
3720: }
1.63 www 3721: return $domain;
3722: }
3723: ###############################################
1.517 raeburn 3724:
1.518 albertel 3725: sub devalidate_domconfig_cache {
3726: my ($udom)=@_;
3727: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
3728: }
3729:
3730: # ---------------------- Get domain configuration for a domain
3731: sub get_domainconf {
3732: my ($udom) = @_;
3733: my $cachetime=1800;
3734: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
3735: if (defined($cached)) { return %{$result}; }
3736:
3737: my %domconfig = &Apache::lonnet::get_dom('configuration',
3738: ['login','rolecolors'],$udom);
1.632 raeburn 3739: my (%designhash,%legacy);
1.518 albertel 3740: if (keys(%domconfig) > 0) {
3741: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 3742: if (keys(%{$domconfig{'login'}})) {
3743: foreach my $key (keys(%{$domconfig{'login'}})) {
3744: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
3745: }
3746: } else {
3747: $legacy{'login'} = 1;
1.518 albertel 3748: }
1.632 raeburn 3749: } else {
3750: $legacy{'login'} = 1;
1.518 albertel 3751: }
3752: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 3753: if (keys(%{$domconfig{'rolecolors'}})) {
3754: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
3755: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
3756: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
3757: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
3758: }
1.518 albertel 3759: }
3760: }
1.632 raeburn 3761: } else {
3762: $legacy{'rolecolors'} = 1;
1.518 albertel 3763: }
1.632 raeburn 3764: } else {
3765: $legacy{'rolecolors'} = 1;
1.518 albertel 3766: }
1.632 raeburn 3767: if (keys(%legacy) > 0) {
3768: my %legacyhash = &get_legacy_domconf($udom);
3769: foreach my $item (keys(%legacyhash)) {
3770: if ($item =~ /^\Q$udom\E\.login/) {
3771: if ($legacy{'login'}) {
3772: $designhash{$item} = $legacyhash{$item};
3773: }
3774: } else {
3775: if ($legacy{'rolecolors'}) {
3776: $designhash{$item} = $legacyhash{$item};
3777: }
1.518 albertel 3778: }
3779: }
3780: }
1.632 raeburn 3781: } else {
3782: %designhash = &get_legacy_domconf($udom);
1.518 albertel 3783: }
3784: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
3785: $cachetime);
3786: return %designhash;
3787: }
3788:
1.632 raeburn 3789: sub get_legacy_domconf {
3790: my ($udom) = @_;
3791: my %legacyhash;
3792: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
3793: my $designfile = $designdir.'/'.$udom.'.tab';
3794: if (-e $designfile) {
3795: if ( open (my $fh,"<$designfile") ) {
3796: while (my $line = <$fh>) {
3797: next if ($line =~ /^\#/);
3798: chomp($line);
3799: my ($key,$val)=(split(/\=/,$line));
3800: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
3801: }
3802: close($fh);
3803: }
3804: }
3805: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
3806: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
3807: }
3808: return %legacyhash;
3809: }
3810:
1.63 www 3811: =pod
3812:
1.112 bowersj2 3813: =item * &domainlogo()
1.63 www 3814:
3815: Inputs: $domain (usually will be undef)
3816:
3817: Returns: A link to a domain logo, if the domain logo exists.
3818: If the domain logo does not exist, a description of the domain.
3819:
3820: =cut
1.112 bowersj2 3821:
1.63 www 3822: ###############################################
3823: sub domainlogo {
1.517 raeburn 3824: my $domain = &determinedomain(shift);
1.518 albertel 3825: my %designhash = &get_domainconf($domain);
1.517 raeburn 3826: # See if there is a logo
3827: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 3828: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 3829: if ($imgsrc =~ m{^/(adm|res)/}) {
3830: if ($imgsrc =~ m{^/res/}) {
3831: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
3832: &Apache::lonnet::repcopy($local_name);
3833: }
3834: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 3835: }
3836: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 3837: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
3838: return &Apache::lonnet::domain($domain,'description');
1.59 www 3839: } else {
1.60 matthew 3840: return '';
1.59 www 3841: }
3842: }
1.63 www 3843: ##############################################
3844:
3845: =pod
3846:
1.112 bowersj2 3847: =item * &designparm()
1.63 www 3848:
3849: Inputs: $which parameter; $domain (usually will be undef)
3850:
3851: Returns: value of designparamter $which
3852:
3853: =cut
1.112 bowersj2 3854:
1.397 albertel 3855:
1.400 albertel 3856: ##############################################
1.397 albertel 3857: sub designparm {
3858: my ($which,$domain)=@_;
1.258 albertel 3859: if ($env{'browser.blackwhite'} eq 'on') {
1.635 raeburn 3860: if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110 www 3861: return '#000000';
3862: }
1.635 raeburn 3863: if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110 www 3864: return '#FFFFFF';
3865: }
3866: if ($which=~/\.tabbg$/) {
3867: return '#CCCCCC';
3868: }
3869: }
1.397 albertel 3870: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 3871: return $env{'environment.color.'.$which};
1.96 www 3872: }
1.63 www 3873: $domain=&determinedomain($domain);
1.518 albertel 3874: my %domdesign = &get_domainconf($domain);
1.520 raeburn 3875: my $output;
1.517 raeburn 3876: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 3877: $output = $domdesign{$domain.'.'.$which};
1.63 www 3878: } else {
1.520 raeburn 3879: $output = $defaultdesign{$which};
3880: }
3881: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 3882: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 3883: if ($output =~ m{^/(adm|res)/}) {
3884: if ($output =~ m{^/res/}) {
3885: my $local_name = &Apache::lonnet::filelocation('',$output);
3886: &Apache::lonnet::repcopy($local_name);
3887: }
1.520 raeburn 3888: $output = &lonhttpdurl($output);
3889: }
1.63 www 3890: }
1.520 raeburn 3891: return $output;
1.63 www 3892: }
1.59 www 3893:
1.60 matthew 3894: ###############################################
3895: ###############################################
3896:
3897: =pod
3898:
1.112 bowersj2 3899: =back
3900:
1.549 albertel 3901: =head1 HTML Helpers
1.112 bowersj2 3902:
3903: =over 4
3904:
3905: =item * &bodytag()
1.60 matthew 3906:
3907: Returns a uniform header for LON-CAPA web pages.
3908:
3909: Inputs:
3910:
1.112 bowersj2 3911: =over 4
3912:
3913: =item * $title, A title to be displayed on the page.
3914:
3915: =item * $function, the current role (can be undef).
3916:
3917: =item * $addentries, extra parameters for the <body> tag.
3918:
3919: =item * $bodyonly, if defined, only return the <body> tag.
3920:
3921: =item * $domain, if defined, force a given domain.
3922:
3923: =item * $forcereg, if page should register as content page (relevant for
1.86 www 3924: text interface only)
1.60 matthew 3925:
1.326 albertel 3926: =item * $customtitle, alternate text to use instead of $title
3927: in the title box that appears, this text
3928: is not auto translated like the $title is
1.309 albertel 3929:
3930: =item * $notopbar, if true, keep the 'what is this' info but remove the
3931: navigational links
1.317 albertel 3932:
1.338 albertel 3933: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
3934:
3935: =item * $notitle, if true keep the nav controls, but remove the title bar
3936:
1.361 albertel 3937: =item * $no_inline_link, if true and in remote mode, don't show the
3938: 'Switch To Inline Menu' link
3939:
1.460 albertel 3940: =item * $args, optional argument valid values are
3941: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 3942: inherit_jsmath -> when creating popup window in a page,
3943: should it have jsmath forced on by the
3944: current page
1.460 albertel 3945:
1.112 bowersj2 3946: =back
3947:
1.60 matthew 3948: Returns: A uniform header for LON-CAPA web pages.
3949: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
3950: If $bodyonly is undef or zero, an html string containing a <body> tag and
3951: other decorations will be returned.
3952:
3953: =cut
3954:
1.54 www 3955: sub bodytag {
1.309 albertel 3956: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 3957: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 3958:
1.460 albertel 3959: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 3960:
1.183 matthew 3961: $function = &get_users_function() if (!$function);
1.339 albertel 3962: my $img = &designparm($function.'.img',$domain);
3963: my $font = &designparm($function.'.font',$domain);
3964: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
3965:
3966: my %design = ( 'style' => 'margin-top: 0px',
1.535 albertel 3967: 'bgcolor' => $pgbg,
1.339 albertel 3968: 'text' => $font,
3969: 'alink' => &designparm($function.'.alink',$domain),
3970: 'vlink' => &designparm($function.'.vlink',$domain),
3971: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 3972: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 3973:
1.63 www 3974: # role and realm
1.378 raeburn 3975: my ($role,$realm) = split(/\./,$env{'request.role'},2);
3976: if ($role eq 'ca') {
1.479 albertel 3977: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 3978: $realm = &plainname($rname,$rdom);
1.378 raeburn 3979: }
1.55 www 3980: # realm
1.258 albertel 3981: if ($env{'request.course.id'}) {
1.378 raeburn 3982: if ($env{'request.role'} !~ /^cr/) {
3983: $role = &Apache::lonnet::plaintext($role,&course_type());
3984: }
1.359 albertel 3985: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 3986: } else {
3987: $role = &Apache::lonnet::plaintext($role);
1.54 www 3988: }
1.433 albertel 3989:
1.359 albertel 3990: if (!$realm) { $realm=' '; }
1.55 www 3991: # Set messages
1.60 matthew 3992: my $messages=&domainlogo($domain);
1.330 albertel 3993:
1.438 albertel 3994: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 3995:
1.101 www 3996: # construct main body tag
1.359 albertel 3997: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 3998: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 3999:
1.530 albertel 4000: if ($bodyonly) {
1.60 matthew 4001: return $bodytag;
1.258 albertel 4002: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 4003: # Accessibility
1.224 raeburn 4004:
1.337 albertel 4005: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 4006: if (!$notitle) {
1.337 albertel 4007: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
4008: }
4009: return $bodytag;
1.359 albertel 4010: }
4011:
1.410 albertel 4012: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4013: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4014: undef($role);
1.434 albertel 4015: } else {
4016: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4017: }
1.359 albertel 4018:
4019: my $roleinfo=(<<ENDROLE);
4020: <td class="LC_title_bar_who">
4021: <div class="LC_title_bar_name">
1.410 albertel 4022: $name
1.361 albertel 4023:
1.359 albertel 4024: </div>
4025: <div class="LC_title_bar_role">
1.361 albertel 4026: $role
1.359 albertel 4027: </div>
4028: <div class="LC_title_bar_realm">
1.361 albertel 4029: $realm
1.359 albertel 4030: </div>
1.206 albertel 4031: </td>
4032: ENDROLE
1.235 raeburn 4033:
1.359 albertel 4034: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
4035: if ($customtitle) {
4036: $titleinfo = $customtitle;
4037: }
4038: #
4039: # Extra info if you are the DC
4040: my $dc_info = '';
4041: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4042: $env{'course.'.$env{'request.course.id'}.
4043: '.domain'}.'/'})) {
4044: my $cid = $env{'request.course.id'};
4045: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4046: $dc_info =~ s/\s+$//;
1.359 albertel 4047: $dc_info = '('.$dc_info.')';
4048: }
4049:
4050: if ($env{'environment.remote'} eq 'off') {
4051: # No Remote
1.258 albertel 4052: if ($env{'request.state'} eq 'construct') {
1.359 albertel 4053: $forcereg=1;
4054: }
4055:
4056: if (!$customtitle && $env{'request.state'} eq 'construct') {
4057: # this is for resources; directories have customtitle, and crumbs
4058: # and select recent are created in lonpubdir.pm
1.229 albertel 4059: my ($uname,$thisdisfn)=
1.258 albertel 4060: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 4061: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4062: $formaction=~s/\/+/\//g;
4063:
1.359 albertel 4064: my $parentpath = '';
4065: my $lastitem = '';
4066: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4067: $parentpath = $1;
4068: $lastitem = $2;
4069: } else {
4070: $lastitem = $thisdisfn;
4071: }
4072: $titleinfo =
1.636.2.3 raeburn 4073: &Apache::loncommon::help_open_menu('','',3,'Authoring')
4074: .'<b>'.&mt('Construction Space').'</b>: '
4075: .'<form name="dirs" method="post" action="'.$formaction.'"'
4076: .' target="_top"><tt><b>'
1.359 albertel 4077: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
4078: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4079: .'</form>'
4080: .&Apache::lonmenu::constspaceform();
1.235 raeburn 4081: }
1.359 albertel 4082:
1.337 albertel 4083: my $titletable;
1.338 albertel 4084: if (!$notitle) {
1.337 albertel 4085: $titletable =
1.359 albertel 4086: '<table id="LC_title_bar">'.
4087: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
4088: '</tr></table>';
1.337 albertel 4089: }
1.359 albertel 4090: if ($notopbar) {
4091: $bodytag .= $titletable;
4092: } else {
4093: if ($env{'request.state'} eq 'construct') {
1.337 albertel 4094: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
4095: $titletable);
1.272 raeburn 4096: } else {
1.336 albertel 4097: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 4098: $titletable;
1.272 raeburn 4099: }
1.235 raeburn 4100: }
4101: return $bodytag;
1.94 www 4102: }
1.95 www 4103:
1.93 www 4104: #
1.95 www 4105: # Top frame rendering, Remote is up
1.93 www 4106: #
1.359 albertel 4107:
1.517 raeburn 4108: my $imgsrc = $img;
4109: if ($img =~ /^\/adm/) {
1.575 albertel 4110: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4111: }
4112: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4113:
1.305 www 4114: # Explicit link to get inline menu
1.361 albertel 4115: my $menu= ($no_inline_link?''
4116: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 4117: #
1.338 albertel 4118: if ($notitle) {
1.337 albertel 4119: return $bodytag;
4120: }
1.94 www 4121: return(<<ENDBODY);
1.60 matthew 4122: $bodytag
1.359 albertel 4123: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4124: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4125: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4126: </tr>
1.359 albertel 4127: <tr><td>$titleinfo $dc_info $menu</td>
4128: $roleinfo
1.368 albertel 4129: </tr>
1.356 albertel 4130: </table>
1.54 www 4131: ENDBODY
1.182 matthew 4132: }
4133:
1.330 albertel 4134: sub make_attr_string {
4135: my ($register,$attr_ref) = @_;
4136:
4137: if ($attr_ref && !ref($attr_ref)) {
4138: die("addentries Must be a hash ref ".
4139: join(':',caller(1))." ".
4140: join(':',caller(0))." ");
4141: }
4142:
4143: if ($register) {
1.339 albertel 4144: my ($on_load,$on_unload);
4145: foreach my $key (keys(%{$attr_ref})) {
4146: if (lc($key) eq 'onload') {
4147: $on_load.=$attr_ref->{$key}.';';
4148: delete($attr_ref->{$key});
4149:
4150: } elsif (lc($key) eq 'onunload') {
4151: $on_unload.=$attr_ref->{$key}.';';
4152: delete($attr_ref->{$key});
4153: }
4154: }
4155: $attr_ref->{'onload'} =
4156: &Apache::lonmenu::loadevents(). $on_load;
4157: $attr_ref->{'onunload'}=
4158: &Apache::lonmenu::unloadevents().$on_unload;
4159: }
4160:
4161: # Accessibility font enhance
4162: if ($env{'browser.fontenhance'} eq 'on') {
4163: my $style;
4164: foreach my $key (keys(%{$attr_ref})) {
4165: if (lc($key) eq 'style') {
4166: $style.=$attr_ref->{$key}.';';
4167: delete($attr_ref->{$key});
4168: }
4169: }
4170: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4171: }
1.339 albertel 4172:
4173: if ($env{'browser.blackwhite'} eq 'on') {
4174: delete($attr_ref->{'font'});
4175: delete($attr_ref->{'link'});
4176: delete($attr_ref->{'alink'});
4177: delete($attr_ref->{'vlink'});
4178: delete($attr_ref->{'bgcolor'});
4179: delete($attr_ref->{'background'});
4180: }
4181:
1.330 albertel 4182: my $attr_string;
4183: foreach my $attr (keys(%$attr_ref)) {
4184: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4185: }
4186: return $attr_string;
4187: }
4188:
4189:
1.182 matthew 4190: ###############################################
1.251 albertel 4191: ###############################################
4192:
4193: =pod
4194:
4195: =item * &endbodytag()
4196:
4197: Returns a uniform footer for LON-CAPA web pages.
4198:
1.635 raeburn 4199: Inputs: 1 - optional reference to an args hash
4200: If in the hash, key for noredirectlink has a value which evaluates to true,
4201: a 'Continue' link is not displayed if the page contains an
4202: internal redirect in the <head></head> section,
4203: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4204:
4205: =cut
4206:
4207: sub endbodytag {
1.635 raeburn 4208: my ($args) = @_;
1.251 albertel 4209: my $endbodytag='</body>';
1.269 albertel 4210: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4211: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4212: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4213: $endbodytag=
4214: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4215: &mt('Continue').'</a>'.
4216: $endbodytag;
4217: }
1.315 albertel 4218: }
1.251 albertel 4219: return $endbodytag;
4220: }
4221:
1.352 albertel 4222: =pod
4223:
4224: =item * &standard_css()
4225:
4226: Returns a style sheet
4227:
4228: Inputs: (all optional)
4229: domain -> force to color decorate a page for a specific
4230: domain
4231: function -> force usage of a specific rolish color scheme
4232: bgcolor -> override the default page bgcolor
4233:
4234: =cut
4235:
1.343 albertel 4236: sub standard_css {
1.345 albertel 4237: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4238: $function = &get_users_function() if (!$function);
4239: my $img = &designparm($function.'.img', $domain);
4240: my $tabbg = &designparm($function.'.tabbg', $domain);
4241: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4242: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4243: my $pgbg_or_bgcolor =
4244: $bgcolor ||
1.352 albertel 4245: &designparm($function.'.pgbg', $domain);
1.382 albertel 4246: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4247: my $alink = &designparm($function.'.alink', $domain);
4248: my $vlink = &designparm($function.'.vlink', $domain);
4249: my $link = &designparm($function.'.link', $domain);
4250:
1.602 albertel 4251: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4252: my $mono = 'monospace';
1.352 albertel 4253: my $data_table_head = $tabbg;
4254: my $data_table_light = '#EEEEEE';
1.470 banghart 4255: my $data_table_dark = '#DDDDDD';
4256: my $data_table_darker = '#CCCCCC';
1.349 albertel 4257: my $data_table_highlight = '#FFFF00';
1.352 albertel 4258: my $mail_new = '#FFBB77';
4259: my $mail_new_hover = '#DD9955';
4260: my $mail_read = '#BBBB77';
4261: my $mail_read_hover = '#999944';
4262: my $mail_replied = '#AAAA88';
4263: my $mail_replied_hover = '#888855';
4264: my $mail_other = '#99BBBB';
4265: my $mail_other_hover = '#669999';
1.391 albertel 4266: my $table_header = '#DDDDDD';
1.489 raeburn 4267: my $feedback_link_bg = '#BBBBBB';
1.392 albertel 4268:
1.608 albertel 4269: my $border = ($env{'browser.type'} eq 'explorer' ||
4270: $env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px'
4271: : '0px 3px 0px 4px';
1.448 albertel 4272:
1.523 albertel 4273:
1.343 albertel 4274: return <<END;
1.345 albertel 4275: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4276: a:focus { color: red; background: yellow }
1.510 albertel 4277: table.thinborder,
1.523 albertel 4278:
1.510 albertel 4279: table.thinborder tr th {
4280: border-style: solid;
4281: border-width: 1px;
4282: background: $tabbg;
4283: }
1.523 albertel 4284: table.thinborder tr td {
1.510 albertel 4285: border-style: solid;
4286: border-width: 1px
4287: }
1.426 albertel 4288:
1.343 albertel 4289: form, .inline { display: inline; }
4290: .center { text-align: center; }
1.593 albertel 4291: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4292: .LC_error {
4293: color: red;
4294: font-size: larger;
4295: }
1.457 albertel 4296: .LC_warning,
4297: .LC_diff_removed {
1.394 albertel 4298: color: red;
4299: }
1.532 albertel 4300:
4301: .LC_info,
1.457 albertel 4302: .LC_success,
4303: .LC_diff_added {
1.350 albertel 4304: color: green;
4305: }
1.543 albertel 4306: .LC_unknown {
4307: color: yellow;
4308: }
4309:
1.440 albertel 4310: .LC_icon {
4311: border: 0px;
4312: }
1.539 albertel 4313: .LC_indexer_icon {
4314: border: 0px;
4315: height: 22px;
4316: }
1.543 albertel 4317: .LC_docs_spacer {
4318: width: 25px;
4319: height: 1px;
4320: border: 0px;
4321: }
1.346 albertel 4322:
1.532 albertel 4323: .LC_internal_info {
4324: color: #999;
4325: }
4326:
1.458 albertel 4327: table.LC_pastsubmission {
4328: border: 1px solid black;
4329: margin: 2px;
4330: }
4331:
1.606 albertel 4332: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4333: width: 100%;
4334: background: $pgbg;
1.392 albertel 4335: border: 2px;
1.402 albertel 4336: border-collapse: separate;
1.403 albertel 4337: padding: 0px;
1.345 albertel 4338: }
1.392 albertel 4339:
1.606 albertel 4340: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4341: table#LC_title_bar.LC_with_remote {
1.359 albertel 4342: width: 100%;
1.392 albertel 4343: border-color: $pgbg;
4344: border-style: solid;
4345: border-width: $border;
4346:
1.379 albertel 4347: background: $pgbg;
4348: font-family: $sans;
1.392 albertel 4349: border-collapse: collapse;
1.403 albertel 4350: padding: 0px;
1.359 albertel 4351: }
1.392 albertel 4352:
1.409 albertel 4353: table.LC_docs_path {
4354: width: 100%;
4355: border: 0;
4356: background: $pgbg;
4357: font-family: $sans;
4358: border-collapse: collapse;
4359: padding: 0px;
4360: }
4361:
1.359 albertel 4362: table#LC_title_bar td {
4363: background: $tabbg;
4364: }
4365: table#LC_title_bar td.LC_title_bar_who {
4366: background: $tabbg;
4367: color: $font;
1.427 albertel 4368: font: small $sans;
1.359 albertel 4369: text-align: right;
4370: }
1.469 banghart 4371: span.LC_metadata {
4372: font-family: $sans;
4373: }
1.359 albertel 4374: span.LC_title_bar_title {
1.416 albertel 4375: font: bold x-large $sans;
1.359 albertel 4376: }
4377: table#LC_title_bar td.LC_title_bar_domain_logo {
4378: background: $sidebg;
4379: text-align: right;
1.368 albertel 4380: padding: 0px;
4381: }
4382: table#LC_title_bar td.LC_title_bar_role_logo {
4383: background: $sidebg;
4384: padding: 0px;
1.359 albertel 4385: }
4386:
1.346 albertel 4387: table#LC_menubuttons_mainmenu {
1.526 www 4388: width: 100%;
1.346 albertel 4389: border: 0px;
4390: border-spacing: 1px;
1.372 albertel 4391: padding: 0px 1px;
1.346 albertel 4392: margin: 0px;
4393: border-collapse: separate;
4394: }
4395: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
4396: border: 0px;
4397: }
1.345 albertel 4398: table#LC_top_nav td {
4399: background: $tabbg;
1.392 albertel 4400: border: 0px;
1.407 albertel 4401: font-size: small;
1.345 albertel 4402: }
4403: table#LC_top_nav td a, div#LC_top_nav a {
4404: color: $font;
4405: font-family: $sans;
4406: }
1.364 albertel 4407: table#LC_top_nav td.LC_top_nav_logo {
4408: background: $tabbg;
1.432 albertel 4409: text-align: left;
1.408 albertel 4410: white-space: nowrap;
1.432 albertel 4411: width: 31px;
1.408 albertel 4412: }
4413: table#LC_top_nav td.LC_top_nav_logo img {
1.432 albertel 4414: border: 0px;
1.408 albertel 4415: vertical-align: bottom;
1.364 albertel 4416: }
1.432 albertel 4417: table#LC_top_nav td.LC_top_nav_exit,
4418: table#LC_top_nav td.LC_top_nav_help {
4419: width: 2.0em;
4420: }
1.442 albertel 4421: table#LC_top_nav td.LC_top_nav_login {
4422: width: 4.0em;
4423: text-align: center;
4424: }
1.409 albertel 4425: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4426: background: $tabbg;
4427: color: $font;
4428: font-family: $sans;
1.358 albertel 4429: font-size: smaller;
1.357 albertel 4430: }
1.411 albertel 4431: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4432: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4433: background: $tabbg;
4434: color: $font;
4435: font-family: $sans;
4436: font-size: larger;
4437: text-align: right;
4438: }
1.383 albertel 4439: td.LC_table_cell_checkbox {
4440: text-align: center;
4441: }
4442:
1.522 albertel 4443: table#LC_mainmenu td.LC_mainmenu_column {
4444: vertical-align: top;
4445: }
4446:
1.346 albertel 4447: .LC_menubuttons_inline_text {
4448: color: $font;
4449: font-family: $sans;
4450: font-size: smaller;
4451: }
4452:
1.526 www 4453: .LC_menubuttons_link {
4454: text-decoration: none;
4455: }
4456:
1.522 albertel 4457: .LC_menubuttons_category {
1.521 www 4458: color: $font;
1.526 www 4459: background: $pgbg;
1.521 www 4460: font-family: $sans;
4461: font-size: larger;
4462: font-weight: bold;
4463: }
4464:
1.346 albertel 4465: td.LC_menubuttons_text {
1.526 www 4466: width: 90%;
1.346 albertel 4467: color: $font;
4468: font-family: $sans;
4469: }
1.526 www 4470:
1.346 albertel 4471: td.LC_menubuttons_img {
4472: }
1.526 www 4473:
1.346 albertel 4474: .LC_current_location {
4475: font-family: $sans;
4476: background: $tabbg;
4477: }
4478: .LC_new_mail {
4479: font-family: $sans;
1.634 www 4480: background: $tabbg;
1.346 albertel 4481: font-weight: bold;
4482: }
1.347 albertel 4483:
1.526 www 4484: .LC_rolesmenu_is {
4485: font-family: $sans;
4486: }
4487:
4488: .LC_rolesmenu_selected {
4489: font-family: $sans;
4490: }
4491:
4492: .LC_rolesmenu_future {
4493: font-family: $sans;
4494: }
4495:
4496:
4497: .LC_rolesmenu_will {
4498: font-family: $sans;
4499: }
4500:
4501: .LC_rolesmenu_will_not {
4502: font-family: $sans;
4503: }
4504:
4505: .LC_rolesmenu_expired {
4506: font-family: $sans;
4507: }
4508:
4509: .LC_rolesinfo {
4510: font-family: $sans;
4511: }
4512:
1.527 www 4513: .LC_dropadd_labeltext {
4514: font-family: $sans;
4515: text-align: right;
4516: }
4517:
4518: .LC_preferences_labeltext {
4519: font-family: $sans;
4520: text-align: right;
4521: }
4522:
1.440 albertel 4523: table.LC_aboutme_port {
4524: border: 0px;
4525: border-collapse: collapse;
4526: border-spacing: 0px;
4527: }
1.349 albertel 4528: table.LC_data_table, table.LC_mail_list {
1.347 albertel 4529: border: 1px solid #000000;
1.402 albertel 4530: border-collapse: separate;
1.426 albertel 4531: border-spacing: 1px;
1.610 albertel 4532: background: $pgbg;
1.347 albertel 4533: }
1.422 albertel 4534: .LC_data_table_dense {
4535: font-size: small;
4536: }
1.507 raeburn 4537: table.LC_nested_outer {
4538: border: 1px solid #000000;
1.589 raeburn 4539: border-collapse: collapse;
1.507 raeburn 4540: border-spacing: 0px;
4541: width: 100%;
4542: }
4543: table.LC_nested {
4544: border: 0px;
1.589 raeburn 4545: border-collapse: collapse;
1.507 raeburn 4546: border-spacing: 0px;
4547: width: 100%;
4548: }
1.523 albertel 4549: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4550: table.LC_prior_tries tr th {
1.349 albertel 4551: font-weight: bold;
4552: background-color: $data_table_head;
1.421 albertel 4553: font-size: smaller;
1.347 albertel 4554: }
1.610 albertel 4555: table.LC_data_table tr.LC_odd_row > td,
1.440 albertel 4556: table.LC_aboutme_port tr td {
1.349 albertel 4557: background-color: $data_table_light;
1.425 albertel 4558: padding: 2px;
1.347 albertel 4559: }
1.610 albertel 4560: table.LC_data_table tr.LC_even_row > td,
1.440 albertel 4561: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4562: background-color: $data_table_dark;
1.347 albertel 4563: }
1.425 albertel 4564: table.LC_data_table tr.LC_data_table_highlight td {
4565: background-color: $data_table_darker;
4566: }
1.636.2.2 raeburn 4567: table.LC_data_table tr td.LC_leftcol_header {
4568: background-color: $data_table_head;
4569: font-weight: bold;
4570: }
1.451 albertel 4571: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4572: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4573: background-color: #FFFFFF;
1.421 albertel 4574: font-weight: bold;
4575: font-style: italic;
4576: text-align: center;
4577: padding: 8px;
1.347 albertel 4578: }
1.507 raeburn 4579: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4580: padding: 4ex
4581: }
1.507 raeburn 4582: table.LC_nested_outer tr th {
4583: font-weight: bold;
4584: background-color: $data_table_head;
4585: font-size: smaller;
4586: border-bottom: 1px solid #000000;
4587: }
4588: table.LC_nested_outer tr td.LC_subheader {
4589: background-color: $data_table_head;
4590: font-weight: bold;
4591: font-size: small;
4592: border-bottom: 1px solid #000000;
4593: text-align: right;
1.451 albertel 4594: }
1.507 raeburn 4595: table.LC_nested tr.LC_info_row td {
1.451 albertel 4596: background-color: #CCC;
4597: font-weight: bold;
4598: font-size: small;
1.507 raeburn 4599: text-align: center;
4600: }
1.589 raeburn 4601: table.LC_nested tr.LC_info_row td.LC_left_item,
4602: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4603: text-align: left;
1.451 albertel 4604: }
1.507 raeburn 4605: table.LC_nested td {
1.451 albertel 4606: background-color: #FFF;
4607: font-size: small;
1.507 raeburn 4608: }
4609: table.LC_nested_outer tr th.LC_right_item,
4610: table.LC_nested tr.LC_info_row td.LC_right_item,
4611: table.LC_nested tr.LC_odd_row td.LC_right_item,
4612: table.LC_nested tr td.LC_right_item {
1.451 albertel 4613: text-align: right;
4614: }
4615:
1.507 raeburn 4616: table.LC_nested tr.LC_odd_row td {
1.451 albertel 4617: background-color: #EEE;
4618: }
4619:
1.473 raeburn 4620: table.LC_createuser {
4621: }
4622:
4623: table.LC_createuser tr.LC_section_row td {
4624: font-size: smaller;
4625: }
4626:
4627: table.LC_createuser tr.LC_info_row td {
4628: background-color: #CCC;
4629: font-weight: bold;
4630: text-align: center;
4631: }
4632:
1.349 albertel 4633: table.LC_calendar {
4634: border: 1px solid #000000;
4635: border-collapse: collapse;
4636: }
4637: table.LC_calendar_pickdate {
4638: font-size: xx-small;
4639: }
4640: table.LC_calendar tr td {
4641: border: 1px solid #000000;
4642: vertical-align: top;
4643: }
4644: table.LC_calendar tr td.LC_calendar_day_empty {
4645: background-color: $data_table_dark;
4646: }
4647: table.LC_calendar tr td.LC_calendar_day_current {
4648: background-color: $data_table_highlight;
4649: }
4650:
4651: table.LC_mail_list tr.LC_mail_new {
4652: background-color: $mail_new;
4653: }
4654: table.LC_mail_list tr.LC_mail_new:hover {
4655: background-color: $mail_new_hover;
4656: }
4657: table.LC_mail_list tr.LC_mail_read {
4658: background-color: $mail_read;
4659: }
4660: table.LC_mail_list tr.LC_mail_read:hover {
4661: background-color: $mail_read_hover;
4662: }
4663: table.LC_mail_list tr.LC_mail_replied {
4664: background-color: $mail_replied;
4665: }
4666: table.LC_mail_list tr.LC_mail_replied:hover {
4667: background-color: $mail_replied_hover;
4668: }
4669: table.LC_mail_list tr.LC_mail_other {
4670: background-color: $mail_other;
4671: }
4672: table.LC_mail_list tr.LC_mail_other:hover {
4673: background-color: $mail_other_hover;
4674: }
1.494 raeburn 4675: table.LC_mail_list tr.LC_mail_even {
4676: }
4677: table.LC_mail_list tr.LC_mail_odd {
4678: }
4679:
1.385 albertel 4680:
1.386 albertel 4681: table#LC_portfolio_actions {
4682: width: auto;
4683: background: $pgbg;
4684: border: 0px;
4685: border-spacing: 2px 2px;
4686: padding: 0px;
4687: margin: 0px;
4688: border-collapse: separate;
4689: }
4690: table#LC_portfolio_actions td.LC_label {
4691: background: $tabbg;
4692: text-align: right;
4693: }
4694: table#LC_portfolio_actions td.LC_value {
4695: background: $tabbg;
4696: }
1.385 albertel 4697:
1.391 albertel 4698: table#LC_cstr_controls {
4699: width: 100%;
4700: border-collapse: collapse;
4701: }
4702: table#LC_cstr_controls tr td {
4703: border: 4px solid $pgbg;
4704: padding: 4px;
4705: text-align: center;
4706: background: $tabbg;
4707: }
4708: table#LC_cstr_controls tr th {
4709: border: 4px solid $pgbg;
4710: background: $table_header;
4711: text-align: center;
4712: font-family: $sans;
4713: font-size: smaller;
4714: }
4715:
1.389 albertel 4716: table#LC_browser {
4717:
4718: }
4719: table#LC_browser tr th {
1.391 albertel 4720: background: $table_header;
1.389 albertel 4721: }
1.390 albertel 4722: table#LC_browser tr td {
4723: padding: 2px;
4724: }
1.389 albertel 4725: table#LC_browser tr.LC_browser_file,
4726: table#LC_browser tr.LC_browser_file_published {
4727: background: #CCFF88;
4728: }
4729: table#LC_browser tr.LC_browser_file_locked,
4730: table#LC_browser tr.LC_browser_file_unpublished {
4731: background: #FFAA99;
1.387 albertel 4732: }
1.389 albertel 4733: table#LC_browser tr.LC_browser_file_obsolete {
4734: background: #AAAAAA;
1.387 albertel 4735: }
1.455 albertel 4736: table#LC_browser tr.LC_browser_file_modified,
4737: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 4738: background: #FFFF77;
1.387 albertel 4739: }
1.389 albertel 4740: table#LC_browser tr.LC_browser_folder {
4741: background: #CCCCFF;
1.387 albertel 4742: }
1.388 albertel 4743: span.LC_current_location {
4744: font-size: x-large;
4745: background: $pgbg;
4746: }
1.387 albertel 4747:
1.395 albertel 4748: span.LC_parm_menu_item {
4749: font-size: larger;
4750: font-family: $sans;
4751: }
4752: span.LC_parm_scope_all {
4753: color: red;
4754: }
4755: span.LC_parm_scope_folder {
4756: color: green;
4757: }
4758: span.LC_parm_scope_resource {
4759: color: orange;
4760: }
4761: span.LC_parm_part {
4762: color: blue;
4763: }
4764: span.LC_parm_folder, span.LC_parm_symb {
4765: font-size: x-small;
4766: font-family: $mono;
4767: color: #AAAAAA;
4768: }
4769:
1.396 albertel 4770: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
4771: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
4772: border: 1px solid black;
4773: border-collapse: collapse;
4774: }
4775: table.LC_parm_overview_restrictions td {
4776: border-width: 1px 4px 1px 4px;
4777: border-style: solid;
4778: border-color: $pgbg;
4779: text-align: center;
4780: }
4781: table.LC_parm_overview_restrictions th {
4782: background: $tabbg;
4783: border-width: 1px 4px 1px 4px;
4784: border-style: solid;
4785: border-color: $pgbg;
4786: }
1.398 albertel 4787: table#LC_helpmenu {
4788: border: 0px;
4789: height: 55px;
4790: border-spacing: 0px;
4791: }
4792:
4793: table#LC_helpmenu fieldset legend {
4794: font-size: larger;
4795: font-weight: bold;
4796: }
1.397 albertel 4797: table#LC_helpmenu_links {
4798: width: 100%;
4799: border: 1px solid black;
4800: background: $pgbg;
4801: padding: 0px;
4802: border-spacing: 1px;
4803: }
4804: table#LC_helpmenu_links tr td {
4805: padding: 1px;
4806: background: $tabbg;
1.399 albertel 4807: text-align: center;
4808: font-weight: bold;
1.397 albertel 4809: }
1.396 albertel 4810:
1.397 albertel 4811: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
4812: table#LC_helpmenu_links a:active {
4813: text-decoration: none;
4814: color: $font;
4815: }
4816: table#LC_helpmenu_links a:hover {
4817: text-decoration: underline;
4818: color: $vlink;
4819: }
1.396 albertel 4820:
1.417 albertel 4821: .LC_chrt_popup_exists {
4822: border: 1px solid #339933;
4823: margin: -1px;
4824: }
4825: .LC_chrt_popup_up {
4826: border: 1px solid yellow;
4827: margin: -1px;
4828: }
4829: .LC_chrt_popup {
4830: border: 1px solid #8888FF;
4831: background: #CCCCFF;
4832: }
1.421 albertel 4833: table.LC_pick_box {
4834: border-collapse: separate;
4835: background: white;
4836: border: 1px solid black;
4837: border-spacing: 1px;
4838: }
4839: table.LC_pick_box td.LC_pick_box_title {
4840: background: $tabbg;
4841: font-weight: bold;
4842: text-align: right;
4843: width: 184px;
4844: padding: 8px;
4845: }
1.579 raeburn 4846: table.LC_pick_box td.LC_pick_box_value {
4847: text-align: left;
4848: padding: 8px;
4849: }
4850: table.LC_pick_box td.LC_pick_box_select {
4851: text-align: left;
4852: padding: 8px;
4853: }
1.424 albertel 4854: table.LC_pick_box td.LC_pick_box_separator {
1.421 albertel 4855: padding: 0px;
4856: height: 1px;
4857: background: black;
4858: }
4859: table.LC_pick_box td.LC_pick_box_submit {
4860: text-align: right;
4861: }
1.579 raeburn 4862: table.LC_pick_box td.LC_evenrow_value {
4863: text-align: left;
4864: padding: 8px;
4865: background-color: $data_table_light;
4866: }
4867: table.LC_pick_box td.LC_oddrow_value {
4868: text-align: left;
4869: padding: 8px;
4870: background-color: $data_table_light;
4871: }
4872: table.LC_helpform_receipt {
4873: width: 620px;
4874: border-collapse: separate;
4875: background: white;
4876: border: 1px solid black;
4877: border-spacing: 1px;
4878: }
4879: table.LC_helpform_receipt td.LC_pick_box_title {
4880: background: $tabbg;
4881: font-weight: bold;
4882: text-align: right;
4883: width: 184px;
4884: padding: 8px;
4885: }
4886: table.LC_helpform_receipt td.LC_evenrow_value {
4887: text-align: left;
4888: padding: 8px;
4889: background-color: $data_table_light;
4890: }
4891: table.LC_helpform_receipt td.LC_oddrow_value {
4892: text-align: left;
4893: padding: 8px;
4894: background-color: $data_table_light;
4895: }
4896: table.LC_helpform_receipt td.LC_pick_box_separator {
4897: padding: 0px;
4898: height: 1px;
4899: background: black;
4900: }
4901: span.LC_helpform_receipt_cat {
4902: font-weight: bold;
4903: }
1.424 albertel 4904: table.LC_group_priv_box {
4905: background: white;
4906: border: 1px solid black;
4907: border-spacing: 1px;
4908: }
4909: table.LC_group_priv_box td.LC_pick_box_title {
4910: background: $tabbg;
4911: font-weight: bold;
4912: text-align: right;
4913: width: 184px;
4914: }
4915: table.LC_group_priv_box td.LC_groups_fixed {
4916: background: $data_table_light;
4917: text-align: center;
4918: }
4919: table.LC_group_priv_box td.LC_groups_optional {
4920: background: $data_table_dark;
4921: text-align: center;
4922: }
4923: table.LC_group_priv_box td.LC_groups_functionality {
4924: background: $data_table_darker;
4925: text-align: center;
4926: font-weight: bold;
4927: }
4928: table.LC_group_priv td {
4929: text-align: left;
4930: padding: 0px;
4931: }
4932:
1.421 albertel 4933: table.LC_notify_front_page {
4934: background: white;
4935: border: 1px solid black;
4936: padding: 8px;
4937: }
4938: table.LC_notify_front_page td {
4939: padding: 8px;
4940: }
1.424 albertel 4941: .LC_navbuttons {
4942: margin: 2ex 0ex 2ex 0ex;
4943: }
1.423 albertel 4944: .LC_topic_bar {
4945: font-family: $sans;
4946: font-weight: bold;
4947: width: 100%;
4948: background: $tabbg;
4949: vertical-align: middle;
4950: margin: 2ex 0ex 2ex 0ex;
4951: }
4952: .LC_topic_bar span {
4953: vertical-align: middle;
4954: }
4955: .LC_topic_bar img {
4956: vertical-align: bottom;
4957: }
4958: table.LC_course_group_status {
4959: margin: 20px;
4960: }
4961: table.LC_status_selector td {
4962: vertical-align: top;
4963: text-align: center;
1.424 albertel 4964: padding: 4px;
4965: }
4966: table.LC_descriptive_input td.LC_description {
4967: vertical-align: top;
4968: text-align: right;
4969: font-weight: bold;
1.423 albertel 4970: }
1.599 albertel 4971: div.LC_feedback_link {
1.616 albertel 4972: clear: both;
1.599 albertel 4973: background: white;
4974: width: 100%;
1.489 raeburn 4975: }
4976: span.LC_feedback_link {
1.599 albertel 4977: background: $feedback_link_bg;
4978: font-size: larger;
4979: }
4980: span.LC_message_link {
4981: background: $feedback_link_bg;
4982: font-size: larger;
4983: position: absolute;
4984: right: 1em;
1.489 raeburn 4985: }
1.421 albertel 4986:
1.515 albertel 4987: table.LC_prior_tries {
1.524 albertel 4988: border: 1px solid #000000;
4989: border-collapse: separate;
4990: border-spacing: 1px;
1.515 albertel 4991: }
1.523 albertel 4992:
1.515 albertel 4993: table.LC_prior_tries td {
1.524 albertel 4994: padding: 2px;
1.515 albertel 4995: }
1.523 albertel 4996:
4997: .LC_answer_correct {
4998: background: #AAFFAA;
4999: color: black;
5000: }
5001: .LC_answer_charged_try {
5002: background: #FFAAAA ! important;
5003: color: black;
5004: }
5005: .LC_answer_not_charged_try,
5006: .LC_answer_no_grade,
5007: .LC_answer_late {
5008: background: #FFFFAA;
5009: color: black;
5010: }
5011: .LC_answer_previous {
5012: background: #AAAAFF;
5013: color: black;
5014: }
5015: .LC_answer_no_message {
5016: background: #FFFFFF;
5017: color: black;
5018: }
5019: .LC_answer_unknown {
5020: background: orange;
5021: color: black;
5022: }
5023:
5024:
1.529 albertel 5025: span.LC_prior_numerical,
5026: span.LC_prior_string,
5027: span.LC_prior_custom,
5028: span.LC_prior_reaction,
5029: span.LC_prior_math {
1.523 albertel 5030: font-family: monospace;
5031: white-space: pre;
5032: }
5033:
1.525 albertel 5034: span.LC_prior_string {
5035: font-family: monospace;
5036: white-space: pre;
5037: }
5038:
1.523 albertel 5039: table.LC_prior_option {
5040: width: 100%;
5041: border-collapse: collapse;
5042: }
1.528 albertel 5043: table.LC_prior_rank, table.LC_prior_match {
5044: border-collapse: collapse;
5045: }
5046: table.LC_prior_option tr td,
5047: table.LC_prior_rank tr td,
5048: table.LC_prior_match tr td {
1.524 albertel 5049: border: 1px solid #000000;
1.515 albertel 5050: }
5051:
1.519 raeburn 5052: span.LC_nobreak {
1.544 albertel 5053: white-space: nowrap;
1.519 raeburn 5054: }
5055:
1.576 raeburn 5056: span.LC_cusr_emph {
5057: font-style: italic;
5058: }
5059:
1.633 raeburn 5060: span.LC_cusr_subheading {
5061: font-weight: normal;
5062: font-size: 85%;
5063: }
5064:
1.545 albertel 5065: table.LC_docs_documents {
5066: background: #BBBBBB;
1.547 albertel 5067: border-width: 0px;
1.545 albertel 5068: border-collapse: collapse;
5069: }
5070:
5071: table.LC_docs_documents td.LC_docs_document {
5072: border: 2px solid black;
5073: padding: 4px;
5074: }
5075:
5076: .LC_docs_course_commands div {
5077: float: left;
5078: border: 4px solid #AAAAAA;
5079: padding: 4px;
5080: background: #DDDDCC;
5081: }
5082:
5083: .LC_docs_entry_move {
5084: border: 0px;
5085: border-collapse: collapse;
1.544 albertel 5086: }
5087:
1.545 albertel 5088: .LC_docs_entry_move td {
5089: border: 2px solid #BBBBBB;
5090: background: #DDDDDD;
5091: }
5092:
5093: .LC_docs_editor td.LC_docs_entry_commands {
5094: background: #DDDDDD;
5095: font-size: x-small;
5096: }
1.544 albertel 5097: .LC_docs_copy {
1.545 albertel 5098: color: #000099;
1.544 albertel 5099: }
5100: .LC_docs_cut {
1.545 albertel 5101: color: #550044;
1.544 albertel 5102: }
5103: .LC_docs_rename {
1.545 albertel 5104: color: #009900;
1.544 albertel 5105: }
5106: .LC_docs_remove {
1.545 albertel 5107: color: #990000;
5108: }
5109:
1.547 albertel 5110: .LC_docs_reinit_warn,
5111: .LC_docs_ext_edit {
5112: font-size: x-small;
5113: }
5114:
1.545 albertel 5115: .LC_docs_editor td.LC_docs_entry_title,
5116: .LC_docs_editor td.LC_docs_entry_icon {
5117: background: #FFFFBB;
5118: }
5119: .LC_docs_editor td.LC_docs_entry_parameter {
5120: background: #BBBBFF;
5121: font-size: x-small;
5122: white-space: nowrap;
5123: }
5124:
5125: table.LC_docs_adddocs td,
5126: table.LC_docs_adddocs th {
5127: border: 1px solid #BBBBBB;
5128: padding: 4px;
5129: background: #DDDDDD;
1.543 albertel 5130: }
5131:
1.584 albertel 5132: table.LC_sty_begin {
5133: background: #BBFFBB;
5134: }
5135: table.LC_sty_end {
5136: background: #FFBBBB;
5137: }
5138:
1.589 raeburn 5139: table.LC_double_column {
5140: border-width: 0px;
5141: border-collapse: collapse;
5142: width: 100%;
5143: padding: 2px;
5144: }
5145:
5146: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5147: top: 2px;
1.589 raeburn 5148: left: 2px;
5149: width: 47%;
5150: vertical-align: top;
5151: }
5152:
5153: table.LC_double_column tr td.LC_right_col {
5154: top: 2px;
5155: right: 2px;
5156: width: 47%;
5157: vertical-align: top;
5158: }
5159:
1.594 raeburn 5160: span.LC_role_level {
5161: font-weight: bold;
5162: }
5163:
1.591 raeburn 5164: div.LC_left_float {
5165: float: left;
5166: padding-right: 5%;
1.597 albertel 5167: padding-bottom: 4px;
1.591 raeburn 5168: }
5169:
5170: div.LC_clear_float_header {
1.597 albertel 5171: padding-bottom: 2px;
1.591 raeburn 5172: }
5173:
5174: div.LC_clear_float_footer {
1.597 albertel 5175: padding-top: 10px;
1.591 raeburn 5176: clear: both;
5177: }
5178:
1.597 albertel 5179:
1.601 albertel 5180: div.LC_grade_select_mode {
1.604 albertel 5181: font-family: $sans;
1.601 albertel 5182: }
5183: div.LC_grade_select_mode div div {
5184: margin: 5px;
5185: }
5186: div.LC_grade_select_mode_selector {
5187: margin: 5px;
5188: float: left;
5189: }
5190: div.LC_grade_select_mode_selector_header {
5191: font: bold medium $sans;
5192: }
5193: div.LC_grade_select_mode_type {
5194: clear: left;
5195: }
5196:
1.597 albertel 5197: div.LC_grade_show_user {
5198: margin-top: 20px;
5199: border: 1px solid black;
5200: }
5201: div.LC_grade_user_name {
5202: background: #DDDDEE;
5203: border-bottom: 1px solid black;
5204: font: bold large $sans;
5205: }
5206: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5207: background: #DDEEDD;
5208: }
5209:
5210: div.LC_grade_show_problem,
5211: div.LC_grade_submissions,
5212: div.LC_grade_message_center,
5213: div.LC_grade_info_links,
5214: div.LC_grade_assign {
5215: margin: 5px;
5216: width: 99%;
5217: background: #FFFFFF;
5218: }
5219: div.LC_grade_show_problem_header,
5220: div.LC_grade_submissions_header,
5221: div.LC_grade_message_center_header,
5222: div.LC_grade_assign_header {
5223: font: bold large $sans;
5224: }
5225: div.LC_grade_show_problem_problem,
5226: div.LC_grade_submissions_body,
5227: div.LC_grade_message_center_body,
5228: div.LC_grade_assign_body {
5229: border: 1px solid black;
5230: width: 99%;
5231: background: #FFFFFF;
5232: }
1.598 albertel 5233: span.LC_grade_check_note {
5234: font: normal medium $sans;
5235: display: inline;
5236: position: absolute;
5237: right: 1em;
5238: }
1.597 albertel 5239:
1.613 albertel 5240: table.LC_scantron_action {
5241: width: 100%;
5242: }
5243: table.LC_scantron_action tr th {
5244: font: normal bold $sans;
5245: }
1.600 albertel 5246:
1.614 albertel 5247: div.LC_edit_problem_header,
5248: div.LC_edit_problem_footer {
1.600 albertel 5249: font: normal medium $sans;
1.602 albertel 5250: margin: 2px;
1.600 albertel 5251: }
5252: div.LC_edit_problem_header,
1.602 albertel 5253: div.LC_edit_problem_header div,
1.614 albertel 5254: div.LC_edit_problem_footer,
5255: div.LC_edit_problem_footer div,
1.602 albertel 5256: div.LC_edit_problem_editxml_header,
5257: div.LC_edit_problem_editxml_header div {
1.600 albertel 5258: margin-top: 5px;
5259: }
1.602 albertel 5260: div.LC_edit_problem_header_edit_row {
5261: background: $tabbg;
5262: padding: 3px;
5263: margin-bottom: 5px;
5264: }
1.600 albertel 5265: div.LC_edit_problem_header_title {
1.602 albertel 5266: font: larger bold $sans;
5267: background: $tabbg;
5268: padding: 3px;
5269: }
5270: table.LC_edit_problem_header_title {
5271: font: larger bold $sans;
5272: width: 100%;
5273: border-color: $pgbg;
5274: border-style: solid;
5275: border-width: $border;
5276:
1.600 albertel 5277: background: $tabbg;
1.602 albertel 5278: border-collapse: collapse;
5279: padding: 0px
5280: }
5281:
5282: div.LC_edit_problem_discards {
5283: float: left;
5284: padding-bottom: 5px;
5285: }
5286: div.LC_edit_problem_saves {
5287: float: right;
5288: padding-bottom: 5px;
1.600 albertel 5289: }
5290: hr.LC_edit_problem_divide {
1.602 albertel 5291: clear: both;
1.600 albertel 5292: color: $tabbg;
5293: background-color: $tabbg;
5294: height: 3px;
5295: border: 0px;
5296: }
1.343 albertel 5297: END
5298: }
5299:
1.306 albertel 5300: =pod
5301:
5302: =item * &headtag()
5303:
5304: Returns a uniform footer for LON-CAPA web pages.
5305:
1.307 albertel 5306: Inputs: $title - optional title for the head
5307: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5308: $args - optional arguments
1.319 albertel 5309: force_register - if is true call registerurl so the remote is
5310: informed
1.415 albertel 5311: redirect -> array ref of
5312: 1- seconds before redirect occurs
5313: 2- url to redirect to
5314: 3- whether the side effect should occur
1.315 albertel 5315: (side effect of setting
5316: $env{'internal.head.redirect'} to the url
5317: redirected too)
1.352 albertel 5318: domain -> force to color decorate a page for a specific
5319: domain
5320: function -> force usage of a specific rolish color scheme
5321: bgcolor -> override the default page bgcolor
1.460 albertel 5322: no_auto_mt_title
5323: -> prevent &mt()ing the title arg
1.464 albertel 5324:
1.306 albertel 5325: =cut
5326:
5327: sub headtag {
1.313 albertel 5328: my ($title,$head_extra,$args) = @_;
1.306 albertel 5329:
1.363 albertel 5330: my $function = $args->{'function'} || &get_users_function();
5331: my $domain = $args->{'domain'} || &determinedomain();
5332: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5333: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5334: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5335: #time(),
1.418 albertel 5336: $env{'environment.color.timestamp'},
1.363 albertel 5337: $function,$domain,$bgcolor);
5338:
1.369 www 5339: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5340:
1.308 albertel 5341: my $result =
5342: '<head>'.
1.461 albertel 5343: &font_settings();
1.319 albertel 5344:
1.461 albertel 5345: if (!$args->{'frameset'}) {
5346: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5347: }
1.319 albertel 5348: if ($args->{'force_register'}) {
5349: $result .= &Apache::lonmenu::registerurl(1);
5350: }
1.436 albertel 5351: if (!$args->{'no_nav_bar'}
5352: && !$args->{'only_body'}
5353: && !$args->{'frameset'}) {
5354: $result .= &help_menu_js();
5355: }
1.319 albertel 5356:
1.314 albertel 5357: if (ref($args->{'redirect'})) {
1.414 albertel 5358: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5359: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5360: if (!$inhibit_continue) {
5361: $env{'internal.head.redirect'} = $url;
5362: }
1.313 albertel 5363: $result.=<<ADDMETA
5364: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5365: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5366: ADDMETA
5367: }
1.306 albertel 5368: if (!defined($title)) {
5369: $title = 'The LearningOnline Network with CAPA';
5370: }
1.460 albertel 5371: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5372: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5373: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5374: .$head_extra;
1.306 albertel 5375: return $result;
5376: }
5377:
5378: =pod
5379:
1.340 albertel 5380: =item * &font_settings()
5381:
5382: Returns neccessary <meta> to set the proper encoding
5383:
5384: Inputs: none
5385:
5386: =cut
5387:
5388: sub font_settings {
5389: my $headerstring='';
5390: if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
5391: $headerstring.=
5392: '<meta Content-Type="text/html; charset=x-mac-roman" />';
5393: } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
5394: $headerstring.=
5395: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5396: }
5397: return $headerstring;
5398: }
5399:
1.341 albertel 5400: =pod
5401:
5402: =item * &xml_begin()
5403:
5404: Returns the needed doctype and <html>
5405:
5406: Inputs: none
5407:
5408: =cut
5409:
5410: sub xml_begin {
5411: my $output='';
5412:
1.592 albertel 5413: if ($env{'internal.start_page'}==1) {
5414: &Apache::lonhtmlcommon::init_htmlareafields();
5415: }
1.342 albertel 5416:
1.341 albertel 5417: if ($env{'browser.mathml'}) {
5418: $output='<?xml version="1.0"?>'
5419: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5420: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5421:
5422: # .'<!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">] >'
5423: .'<!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">'
5424: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5425: .'xmlns="http://www.w3.org/1999/xhtml">';
5426: } else {
5427: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
5428: }
5429: return $output;
5430: }
1.340 albertel 5431:
5432: =pod
5433:
1.306 albertel 5434: =item * &endheadtag()
5435:
5436: Returns a uniform </head> for LON-CAPA web pages.
5437:
5438: Inputs: none
5439:
5440: =cut
5441:
5442: sub endheadtag {
5443: return '</head>';
5444: }
5445:
5446: =pod
5447:
5448: =item * &head()
5449:
5450: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5451:
5452: Inputs: $title - optional title for the page
1.307 albertel 5453: $head_extra - optional extra HTML to put inside the <head>
1.405 albertel 5454:
1.306 albertel 5455: =cut
5456:
5457: sub head {
1.325 albertel 5458: my ($title,$head_extra,$args) = @_;
5459: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5460: }
5461:
5462: =pod
5463:
5464: =item * &start_page()
5465:
5466: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5467:
5468: Inputs: $title - optional title for the page
5469: $head_extra - optional extra HTML to incude inside the <head>
1.315 albertel 5470: $args - additional optional args supported are:
1.317 albertel 5471: only_body -> is true will set &bodytag() onlybodytag
5472: arg on
5473: no_nav_bar -> is true will set &bodytag() notopbar arg on
5474: add_entries -> additional attributes to add to the <body>
5475: domain -> force to color decorate a page for a
5476: specific domain
5477: function -> force usage of a specific rolish color
5478: scheme
5479: redirect -> see &headtag()
5480: bgcolor -> override the default page bg color
5481: js_ready -> return a string ready for being used in
5482: a javascript writeln
1.320 albertel 5483: html_encode -> return a string ready for being used in
5484: a html attribute
1.317 albertel 5485: force_register -> if is true will turn on the &bodytag()
5486: $forcereg arg
1.326 albertel 5487: body_title -> alternate text to use instead of $title
5488: in the title box that appears, this text
5489: is not auto translated like the $title is
1.330 albertel 5490: frameset -> if true will start with a <frameset>
5491: rather than <body>
1.338 albertel 5492: no_title -> if true the title bar won't be shown
5493: skip_phases -> hash ref of
5494: head -> skip the <html><head> generation
5495: body -> skip all <body> generation
1.337 albertel 5496:
1.361 albertel 5497: no_inline_link -> if true and in remote mode, don't show the
5498: 'Switch To Inline Menu' link
5499:
1.460 albertel 5500: no_auto_mt_title -> prevent &mt()ing the title arg
5501:
1.562 albertel 5502: inherit_jsmath -> when creating popup window in a page,
5503: should it have jsmath forced on by the
5504: current page
5505:
1.306 albertel 5506: =cut
5507:
5508: sub start_page {
1.309 albertel 5509: my ($title,$head_extra,$args) = @_;
1.318 albertel 5510: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5511: my %head_args;
1.352 albertel 5512: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5513: 'bgcolor','frameset','no_nav_bar','only_body',
5514: 'no_auto_mt_title') {
1.319 albertel 5515: if (defined($args->{$arg})) {
1.324 raeburn 5516: $head_args{$arg} = $args->{$arg};
1.319 albertel 5517: }
1.313 albertel 5518: }
1.319 albertel 5519:
1.315 albertel 5520: $env{'internal.start_page'}++;
1.338 albertel 5521: my $result;
5522: if (! exists($args->{'skip_phases'}{'head'}) ) {
5523: $result.=
1.341 albertel 5524: &xml_begin().
1.338 albertel 5525: &headtag($title,$head_extra,\%head_args).&endheadtag();
5526: }
5527:
5528: if (! exists($args->{'skip_phases'}{'body'}) ) {
5529: if ($args->{'frameset'}) {
5530: my $attr_string = &make_attr_string($args->{'force_register'},
5531: $args->{'add_entries'});
5532: $result .= "\n<frameset $attr_string>\n";
5533: } else {
5534: $result .=
5535: &bodytag($title,
5536: $args->{'function'}, $args->{'add_entries'},
5537: $args->{'only_body'}, $args->{'domain'},
5538: $args->{'force_register'}, $args->{'body_title'},
5539: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5540: $args->{'no_title'}, $args->{'no_inline_link'},
5541: $args);
1.338 albertel 5542: }
1.330 albertel 5543: }
1.338 albertel 5544:
1.315 albertel 5545: if ($args->{'js_ready'}) {
1.317 albertel 5546: $result = &js_ready($result);
1.315 albertel 5547: }
1.320 albertel 5548: if ($args->{'html_encode'}) {
5549: $result = &html_encode($result);
5550: }
1.315 albertel 5551: return $result;
1.306 albertel 5552: }
5553:
1.330 albertel 5554:
1.306 albertel 5555: =pod
5556:
5557: =item * &head()
5558:
5559: Returns a complete </body></html> section for LON-CAPA web pages.
5560:
1.315 albertel 5561: Inputs: $args - additional optional args supported are:
5562: js_ready -> return a string ready for being used in
5563: a javascript writeln
1.320 albertel 5564: html_encode -> return a string ready for being used in
5565: a html attribute
1.330 albertel 5566: frameset -> if true will start with a <frameset>
5567: rather than <body>
1.493 albertel 5568: dicsussion -> if true will get discussion from
5569: lonxml::xmlend
5570: (you can pass the target and parser arguments
5571: through optional 'target' and 'parser' args
5572: to this routine)
1.306 albertel 5573:
5574: =cut
5575:
5576: sub end_page {
1.315 albertel 5577: my ($args) = @_;
5578: $env{'internal.end_page'}++;
1.330 albertel 5579: my $result;
1.335 albertel 5580: if ($args->{'discussion'}) {
5581: my ($target,$parser);
5582: if (ref($args->{'discussion'})) {
5583: ($target,$parser) =($args->{'discussion'}{'target'},
5584: $args->{'discussion'}{'parser'});
5585: }
5586: $result .= &Apache::lonxml::xmlend($target,$parser);
5587: }
5588:
1.330 albertel 5589: if ($args->{'frameset'}) {
5590: $result .= '</frameset>';
5591: } else {
1.635 raeburn 5592: $result .= &endbodytag($args);
1.330 albertel 5593: }
5594: $result .= "\n</html>";
5595:
1.315 albertel 5596: if ($args->{'js_ready'}) {
1.317 albertel 5597: $result = &js_ready($result);
1.315 albertel 5598: }
1.335 albertel 5599:
1.320 albertel 5600: if ($args->{'html_encode'}) {
5601: $result = &html_encode($result);
5602: }
1.335 albertel 5603:
1.315 albertel 5604: return $result;
5605: }
5606:
1.320 albertel 5607: sub html_encode {
5608: my ($result) = @_;
5609:
1.322 albertel 5610: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 5611:
5612: return $result;
5613: }
1.317 albertel 5614: sub js_ready {
5615: my ($result) = @_;
5616:
1.323 albertel 5617: $result =~ s/[\n\r]/ /xmsg;
5618: $result =~ s/\\/\\\\/xmsg;
5619: $result =~ s/'/\\'/xmsg;
1.372 albertel 5620: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 5621:
5622: return $result;
5623: }
5624:
1.315 albertel 5625: sub validate_page {
5626: if ( exists($env{'internal.start_page'})
1.316 albertel 5627: && $env{'internal.start_page'} > 1) {
5628: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 5629: $env{'internal.start_page'}.' '.
1.316 albertel 5630: $ENV{'request.filename'});
1.315 albertel 5631: }
5632: if ( exists($env{'internal.end_page'})
1.316 albertel 5633: && $env{'internal.end_page'} > 1) {
5634: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 5635: $env{'internal.end_page'}.' '.
1.316 albertel 5636: $env{'request.filename'});
1.315 albertel 5637: }
5638: if ( exists($env{'internal.start_page'})
5639: && ! exists($env{'internal.end_page'})) {
1.316 albertel 5640: &Apache::lonnet::logthis('start_page called without end_page '.
5641: $env{'request.filename'});
1.315 albertel 5642: }
5643: if ( ! exists($env{'internal.start_page'})
5644: && exists($env{'internal.end_page'})) {
1.316 albertel 5645: &Apache::lonnet::logthis('end_page called without start_page'.
5646: $env{'request.filename'});
1.315 albertel 5647: }
1.306 albertel 5648: }
1.315 albertel 5649:
1.318 albertel 5650: sub simple_error_page {
5651: my ($r,$title,$msg) = @_;
5652: my $page =
5653: &Apache::loncommon::start_page($title).
5654: &mt($msg).
5655: &Apache::loncommon::end_page();
5656: if (ref($r)) {
5657: $r->print($page);
1.327 albertel 5658: return;
1.318 albertel 5659: }
5660: return $page;
5661: }
1.347 albertel 5662:
5663: {
1.610 albertel 5664: my @row_count;
1.347 albertel 5665: sub start_data_table {
1.422 albertel 5666: my ($add_class) = @_;
5667: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 5668: unshift(@row_count,0);
1.422 albertel 5669: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 5670: }
5671:
5672: sub end_data_table {
1.610 albertel 5673: shift(@row_count);
1.389 albertel 5674: return '</table>'."\n";;
1.347 albertel 5675: }
5676:
5677: sub start_data_table_row {
1.422 albertel 5678: my ($add_class) = @_;
1.610 albertel 5679: $row_count[0]++;
5680: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 5681: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 5682: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 5683: }
1.471 banghart 5684:
5685: sub continue_data_table_row {
5686: my ($add_class) = @_;
1.610 albertel 5687: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 5688: $css_class = (join(' ',$css_class,$add_class));
5689: return '<tr class="'.$css_class.'">'."\n";;
5690: }
1.347 albertel 5691:
5692: sub end_data_table_row {
1.389 albertel 5693: return '</tr>'."\n";;
1.347 albertel 5694: }
1.367 www 5695:
1.421 albertel 5696: sub start_data_table_empty_row {
1.610 albertel 5697: $row_count[0]++;
1.421 albertel 5698: return '<tr class="LC_empty_row" >'."\n";;
5699: }
5700:
5701: sub end_data_table_empty_row {
5702: return '</tr>'."\n";;
5703: }
5704:
1.367 www 5705: sub start_data_table_header_row {
1.389 albertel 5706: return '<tr class="LC_header_row">'."\n";;
1.367 www 5707: }
5708:
5709: sub end_data_table_header_row {
1.389 albertel 5710: return '</tr>'."\n";;
1.367 www 5711: }
1.347 albertel 5712: }
5713:
1.548 albertel 5714: =pod
5715:
5716: =item * &inhibit_menu_check($arg)
5717:
5718: Checks for a inhibitmenu state and generates output to preserve it
5719:
5720: Inputs: $arg - can be any of
5721: - undef - in which case the return value is a string
5722: to add into arguments list of a uri
5723: - 'input' - in which case the return value is a HTML
5724: <form> <input> field of type hidden to
5725: preserve the value
5726: - a url - in which case the return value is the url with
5727: the neccesary cgi args added to preserve the
5728: inhibitmenu state
5729: - a ref to a url - no return value, but the string is
5730: updated to include the neccessary cgi
5731: args to preserve the inhibitmenu state
5732:
5733: =cut
5734:
5735: sub inhibit_menu_check {
5736: my ($arg) = @_;
5737: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5738: if ($arg eq 'input') {
5739: if ($env{'form.inhibitmenu'}) {
5740: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
5741: } else {
5742: return
5743: }
5744: }
5745: if ($env{'form.inhibitmenu'}) {
5746: if (ref($arg)) {
5747: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5748: } elsif ($arg eq '') {
5749: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
5750: } else {
5751: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
5752: }
5753: }
5754: if (!ref($arg)) {
5755: return $arg;
5756: }
5757: }
5758:
1.251 albertel 5759: ###############################################
1.182 matthew 5760:
5761: =pod
5762:
1.549 albertel 5763: =back
5764:
5765: =head1 User Information Routines
5766:
5767: =over 4
5768:
1.405 albertel 5769: =item * &get_users_function()
1.182 matthew 5770:
5771: Used by &bodytag to determine the current users primary role.
5772: Returns either 'student','coordinator','admin', or 'author'.
5773:
5774: =cut
5775:
5776: ###############################################
5777: sub get_users_function {
5778: my $function = 'student';
1.258 albertel 5779: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 5780: $function='coordinator';
5781: }
1.258 albertel 5782: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 5783: $function='admin';
5784: }
1.258 albertel 5785: if (($env{'request.role'}=~/^(au|ca)/) ||
1.182 matthew 5786: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
5787: $function='author';
5788: }
5789: return $function;
1.54 www 5790: }
1.99 www 5791:
5792: ###############################################
5793:
1.233 raeburn 5794: =pod
5795:
1.542 raeburn 5796: =item * &check_user_status()
1.274 raeburn 5797:
5798: Determines current status of supplied role for a
5799: specific user. Roles can be active, previous or future.
5800:
5801: Inputs:
5802: user's domain, user's username, course's domain,
1.375 raeburn 5803: course's number, optional section ID.
1.274 raeburn 5804:
5805: Outputs:
5806: role status: active, previous or future.
5807:
5808: =cut
5809:
5810: sub check_user_status {
1.412 raeburn 5811: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 5812: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
5813: my @uroles = keys %userinfo;
5814: my $srchstr;
5815: my $active_chk = 'none';
1.412 raeburn 5816: my $now = time;
1.274 raeburn 5817: if (@uroles > 0) {
1.412 raeburn 5818: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 5819: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
5820: } else {
1.412 raeburn 5821: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
5822: }
5823: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 5824: my $role_end = 0;
5825: my $role_start = 0;
5826: $active_chk = 'active';
1.412 raeburn 5827: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
5828: $role_end = $1;
5829: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
5830: $role_start = $1;
1.274 raeburn 5831: }
5832: }
5833: if ($role_start > 0) {
1.412 raeburn 5834: if ($now < $role_start) {
1.274 raeburn 5835: $active_chk = 'future';
5836: }
5837: }
5838: if ($role_end > 0) {
1.412 raeburn 5839: if ($now > $role_end) {
1.274 raeburn 5840: $active_chk = 'previous';
5841: }
5842: }
5843: }
5844: }
5845: return $active_chk;
5846: }
5847:
5848: ###############################################
5849:
5850: =pod
5851:
1.405 albertel 5852: =item * &get_sections()
1.233 raeburn 5853:
5854: Determines all the sections for a course including
5855: sections with students and sections containing other roles.
1.419 raeburn 5856: Incoming parameters:
5857:
5858: 1. domain
5859: 2. course number
5860: 3. reference to array containing roles for which sections should
5861: be gathered (optional).
5862: 4. reference to array containing status types for which sections
5863: should be gathered (optional).
5864:
5865: If the third argument is undefined, sections are gathered for any role.
5866: If the fourth argument is undefined, sections are gathered for any status.
5867: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 5868:
1.374 raeburn 5869: Returns section hash (keys are section IDs, values are
5870: number of users in each section), subject to the
1.419 raeburn 5871: optional roles filter, optional status filter
1.233 raeburn 5872:
5873: =cut
5874:
5875: ###############################################
5876: sub get_sections {
1.419 raeburn 5877: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 5878: if (!defined($cdom) || !defined($cnum)) {
5879: my $cid = $env{'request.course.id'};
5880:
5881: return if (!defined($cid));
5882:
5883: $cdom = $env{'course.'.$cid.'.domain'};
5884: $cnum = $env{'course.'.$cid.'.num'};
5885: }
5886:
5887: my %sectioncount;
1.419 raeburn 5888: my $now = time;
1.240 albertel 5889:
1.366 albertel 5890: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 5891: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 5892: my $sec_index = &Apache::loncoursedata::CL_SECTION();
5893: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 5894: my $start_index = &Apache::loncoursedata::CL_START();
5895: my $end_index = &Apache::loncoursedata::CL_END();
5896: my $status;
1.366 albertel 5897: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 5898: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
5899: $data->[$status_index],
5900: $data->[$start_index],
5901: $data->[$end_index]);
5902: if ($stu_status eq 'Active') {
5903: $status = 'active';
5904: } elsif ($end < $now) {
5905: $status = 'previous';
5906: } elsif ($start > $now) {
5907: $status = 'future';
5908: }
5909: if ($section ne '-1' && $section !~ /^\s*$/) {
5910: if ((!defined($possible_status)) || (($status ne '') &&
5911: (grep/^\Q$status\E$/,@{$possible_status}))) {
5912: $sectioncount{$section}++;
5913: }
1.240 albertel 5914: }
5915: }
5916: }
5917: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
5918: foreach my $user (sort(keys(%courseroles))) {
5919: if ($user !~ /^(\w{2})/) { next; }
5920: my ($role) = ($user =~ /^(\w{2})/);
5921: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 5922: my ($section,$status);
1.240 albertel 5923: if ($role eq 'cr' &&
5924: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
5925: $section=$1;
5926: }
5927: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
5928: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 5929: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
5930: if ($end == -1 && $start == -1) {
5931: next; #deleted role
5932: }
5933: if (!defined($possible_status)) {
5934: $sectioncount{$section}++;
5935: } else {
5936: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
5937: $status = 'active';
5938: } elsif ($end < $now) {
5939: $status = 'future';
5940: } elsif ($start > $now) {
5941: $status = 'previous';
5942: }
5943: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
5944: $sectioncount{$section}++;
5945: }
5946: }
1.233 raeburn 5947: }
1.366 albertel 5948: return %sectioncount;
1.233 raeburn 5949: }
5950:
1.274 raeburn 5951: ###############################################
1.294 raeburn 5952:
5953: =pod
1.405 albertel 5954:
5955: =item * &get_course_users()
5956:
1.275 raeburn 5957: Retrieves usernames:domains for users in the specified course
5958: with specific role(s), and access status.
5959:
5960: Incoming parameters:
1.277 albertel 5961: 1. course domain
5962: 2. course number
5963: 3. access status: users must have - either active,
1.275 raeburn 5964: previous, future, or all.
1.277 albertel 5965: 4. reference to array of permissible roles
1.288 raeburn 5966: 5. reference to array of section restrictions (optional)
5967: 6. reference to results object (hash of hashes).
5968: 7. reference to optional userdata hash
1.609 raeburn 5969: 8. reference to optional statushash
1.630 raeburn 5970: 9. flag if privileged users (except those set to unhide in
5971: course settings) should be excluded
1.609 raeburn 5972: Keys of top level results hash are roles.
1.275 raeburn 5973: Keys of inner hashes are username:domain, with
5974: values set to access type.
1.288 raeburn 5975: Optional userdata hash returns an array with arguments in the
5976: same order as loncoursedata::get_classlist() for student data.
5977:
1.609 raeburn 5978: Optional statushash returns
5979:
1.288 raeburn 5980: Entries for end, start, section and status are blank because
5981: of the possibility of multiple values for non-student roles.
5982:
1.275 raeburn 5983: =cut
1.405 albertel 5984:
1.275 raeburn 5985: ###############################################
1.405 albertel 5986:
1.275 raeburn 5987: sub get_course_users {
1.630 raeburn 5988: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 5989: my %idx = ();
1.419 raeburn 5990: my %seclists;
1.288 raeburn 5991:
5992: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
5993: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
5994: $idx{end} = &Apache::loncoursedata::CL_END();
5995: $idx{start} = &Apache::loncoursedata::CL_START();
5996: $idx{id} = &Apache::loncoursedata::CL_ID();
5997: $idx{section} = &Apache::loncoursedata::CL_SECTION();
5998: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
5999: $idx{status} = &Apache::loncoursedata::CL_STATUS();
6000:
1.290 albertel 6001: if (grep(/^st$/,@{$roles})) {
1.276 albertel 6002: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 6003: my $now = time;
1.277 albertel 6004: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 6005: my $match = 0;
1.412 raeburn 6006: my $secmatch = 0;
1.419 raeburn 6007: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 6008: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 6009: if ($section eq '') {
6010: $section = 'none';
6011: }
1.291 albertel 6012: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6013: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6014: $secmatch = 1;
6015: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 6016: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6017: $secmatch = 1;
6018: }
6019: } else {
1.419 raeburn 6020: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 6021: $secmatch = 1;
6022: }
1.290 albertel 6023: }
1.412 raeburn 6024: if (!$secmatch) {
6025: next;
6026: }
1.419 raeburn 6027: }
1.275 raeburn 6028: if (defined($$types{'active'})) {
1.288 raeburn 6029: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 6030: push(@{$$users{st}{$student}},'active');
1.288 raeburn 6031: $match = 1;
1.275 raeburn 6032: }
6033: }
6034: if (defined($$types{'previous'})) {
1.609 raeburn 6035: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 6036: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 6037: $match = 1;
1.275 raeburn 6038: }
6039: }
6040: if (defined($$types{'future'})) {
1.609 raeburn 6041: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 6042: push(@{$$users{st}{$student}},'future');
1.288 raeburn 6043: $match = 1;
1.275 raeburn 6044: }
6045: }
1.609 raeburn 6046: if ($match) {
6047: push(@{$seclists{$student}},$section);
6048: if (ref($userdata) eq 'HASH') {
6049: $$userdata{$student} = $$classlist{$student};
6050: }
6051: if (ref($statushash) eq 'HASH') {
6052: $statushash->{$student}{'st'}{$section} = $status;
6053: }
1.288 raeburn 6054: }
1.275 raeburn 6055: }
6056: }
1.412 raeburn 6057: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 6058: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6059: my $now = time;
1.609 raeburn 6060: my %displaystatus = ( previous => 'Expired',
6061: active => 'Active',
6062: future => 'Future',
6063: );
1.630 raeburn 6064: my %nothide;
6065: if ($hidepriv) {
6066: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
6067: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
6068: if ($user !~ /:/) {
6069: $nothide{join(':',split(/[\@]/,$user))}=1;
6070: } else {
6071: $nothide{$user} = 1;
6072: }
6073: }
6074: }
1.439 raeburn 6075: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 6076: my $match = 0;
1.412 raeburn 6077: my $secmatch = 0;
1.439 raeburn 6078: my $status;
1.412 raeburn 6079: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 6080: $user =~ s/:$//;
1.439 raeburn 6081: my ($end,$start) = split(/:/,$coursepersonnel{$person});
6082: if ($end == -1 || $start == -1) {
6083: next;
6084: }
6085: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
6086: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 6087: my ($uname,$udom) = split(/:/,$user);
6088: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6089: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6090: $secmatch = 1;
6091: } elsif ($usec eq '') {
1.420 albertel 6092: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6093: $secmatch = 1;
6094: }
6095: } else {
6096: if (grep(/^\Q$usec\E$/,@{$sections})) {
6097: $secmatch = 1;
6098: }
6099: }
6100: if (!$secmatch) {
6101: next;
6102: }
1.288 raeburn 6103: }
1.419 raeburn 6104: if ($usec eq '') {
6105: $usec = 'none';
6106: }
1.275 raeburn 6107: if ($uname ne '' && $udom ne '') {
1.630 raeburn 6108: if ($hidepriv) {
6109: if ((&Apache::lonnet::privileged($uname,$udom)) &&
6110: (!$nothide{$uname.':'.$udom})) {
6111: next;
6112: }
6113: }
1.503 raeburn 6114: if ($end > 0 && $end < $now) {
1.439 raeburn 6115: $status = 'previous';
6116: } elsif ($start > $now) {
6117: $status = 'future';
6118: } else {
6119: $status = 'active';
6120: }
1.277 albertel 6121: foreach my $type (keys(%{$types})) {
1.275 raeburn 6122: if ($status eq $type) {
1.420 albertel 6123: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 6124: push(@{$$users{$role}{$user}},$type);
6125: }
1.288 raeburn 6126: $match = 1;
6127: }
6128: }
1.419 raeburn 6129: if (($match) && (ref($userdata) eq 'HASH')) {
6130: if (!exists($$userdata{$uname.':'.$udom})) {
6131: &get_user_info($udom,$uname,\%idx,$userdata);
6132: }
1.420 albertel 6133: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 6134: push(@{$seclists{$uname.':'.$udom}},$usec);
6135: }
1.609 raeburn 6136: if (ref($statushash) eq 'HASH') {
6137: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
6138: }
1.275 raeburn 6139: }
6140: }
6141: }
6142: }
1.290 albertel 6143: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 6144: if ((defined($cdom)) && (defined($cnum))) {
6145: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
6146: if ( defined($csettings{'internal.courseowner'}) ) {
6147: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 6148: next if ($owner eq '');
6149: my ($ownername,$ownerdom);
6150: if ($owner =~ /^([^:]+):([^:]+)$/) {
6151: $ownername = $1;
6152: $ownerdom = $2;
6153: } else {
6154: $ownername = $owner;
6155: $ownerdom = $cdom;
6156: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 6157: }
6158: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 6159: if (defined($userdata) &&
1.609 raeburn 6160: !exists($$userdata{$owner})) {
6161: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
6162: if (!grep(/^none$/,@{$seclists{$owner}})) {
6163: push(@{$seclists{$owner}},'none');
6164: }
6165: if (ref($statushash) eq 'HASH') {
6166: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 6167: }
1.290 albertel 6168: }
1.279 raeburn 6169: }
6170: }
6171: }
1.419 raeburn 6172: foreach my $user (keys(%seclists)) {
6173: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6174: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6175: }
1.275 raeburn 6176: }
6177: return;
6178: }
6179:
1.288 raeburn 6180: sub get_user_info {
6181: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6182: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6183: &plainname($uname,$udom,'lastname');
1.291 albertel 6184: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6185: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6186: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6187: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6188: return;
6189: }
1.275 raeburn 6190:
1.472 raeburn 6191: ###############################################
6192:
6193: =pod
6194:
6195: =item * &get_user_quota()
6196:
6197: Retrieves quota assigned for storage of portfolio files for a user
6198:
6199: Incoming parameters:
6200: 1. user's username
6201: 2. user's domain
6202:
6203: Returns:
1.536 raeburn 6204: 1. Disk quota (in Mb) assigned to student.
6205: 2. (Optional) Type of setting: custom or default
6206: (individually assigned or default for user's
6207: institutional status).
6208: 3. (Optional) - User's institutional status (e.g., faculty, staff
6209: or student - types as defined in localenroll::inst_usertypes
6210: for user's domain, which determines default quota for user.
6211: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6212:
6213: If a value has been stored in the user's environment,
1.536 raeburn 6214: it will return that, otherwise it returns the maximal default
6215: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6216:
6217: =cut
6218:
6219: ###############################################
6220:
6221:
6222: sub get_user_quota {
6223: my ($uname,$udom) = @_;
1.536 raeburn 6224: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6225: if (!defined($udom)) {
6226: $udom = $env{'user.domain'};
6227: }
6228: if (!defined($uname)) {
6229: $uname = $env{'user.name'};
6230: }
6231: if (($udom eq '' || $uname eq '') ||
6232: ($udom eq 'public') && ($uname eq 'public')) {
6233: $quota = 0;
1.536 raeburn 6234: $quotatype = 'default';
6235: $defquota = 0;
1.472 raeburn 6236: } else {
1.536 raeburn 6237: my $inststatus;
1.472 raeburn 6238: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6239: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6240: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6241: } else {
1.536 raeburn 6242: my %userenv =
6243: &Apache::lonnet::get('environment',['portfolioquota',
6244: 'inststatus'],$udom,$uname);
1.472 raeburn 6245: my ($tmp) = keys(%userenv);
6246: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6247: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6248: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6249: } else {
6250: undef(%userenv);
6251: }
6252: }
1.536 raeburn 6253: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6254: if ($quota eq '') {
1.536 raeburn 6255: $quota = $defquota;
6256: $quotatype = 'default';
6257: } else {
6258: $quotatype = 'custom';
1.472 raeburn 6259: }
6260: }
1.536 raeburn 6261: if (wantarray) {
6262: return ($quota,$quotatype,$settingstatus,$defquota);
6263: } else {
6264: return $quota;
6265: }
1.472 raeburn 6266: }
6267:
6268: ###############################################
6269:
6270: =pod
6271:
6272: =item * &default_quota()
6273:
1.536 raeburn 6274: Retrieves default quota assigned for storage of user portfolio files,
6275: given an (optional) user's institutional status.
1.472 raeburn 6276:
6277: Incoming parameters:
6278: 1. domain
1.536 raeburn 6279: 2. (Optional) institutional status(es). This is a : separated list of
6280: status types (e.g., faculty, staff, student etc.)
6281: which apply to the user for whom the default is being retrieved.
6282: If the institutional status string in undefined, the domain
6283: default quota will be returned.
1.472 raeburn 6284:
6285: Returns:
6286: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6287: 2. (Optional) institutional type which determined the value of the
6288: default quota.
1.472 raeburn 6289:
6290: If a value has been stored in the domain's configuration db,
6291: it will return that, otherwise it returns 20 (for backwards
6292: compatibility with domains which have not set up a configuration
6293: db file; the original statically defined portfolio quota was 20 Mb).
6294:
1.536 raeburn 6295: If the user's status includes multiple types (e.g., staff and student),
6296: the largest default quota which applies to the user determines the
6297: default quota returned.
6298:
1.472 raeburn 6299: =cut
6300:
6301: ###############################################
6302:
6303:
6304: sub default_quota {
1.536 raeburn 6305: my ($udom,$inststatus) = @_;
6306: my ($defquota,$settingstatus);
6307: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 6308: ['quotas'],$udom);
6309: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 6310: if ($inststatus ne '') {
6311: my @statuses = split(/:/,$inststatus);
6312: foreach my $item (@statuses) {
1.622 raeburn 6313: if ($quotahash{'quotas'}{$item} ne '') {
1.536 raeburn 6314: if ($defquota eq '') {
1.622 raeburn 6315: $defquota = $quotahash{'quotas'}{$item};
1.536 raeburn 6316: $settingstatus = $item;
1.622 raeburn 6317: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
6318: $defquota = $quotahash{'quotas'}{$item};
1.536 raeburn 6319: $settingstatus = $item;
6320: }
6321: }
6322: }
6323: }
6324: if ($defquota eq '') {
1.622 raeburn 6325: $defquota = $quotahash{'quotas'}{'default'};
1.536 raeburn 6326: $settingstatus = 'default';
6327: }
6328: } else {
6329: $settingstatus = 'default';
6330: $defquota = 20;
6331: }
6332: if (wantarray) {
6333: return ($defquota,$settingstatus);
1.472 raeburn 6334: } else {
1.536 raeburn 6335: return $defquota;
1.472 raeburn 6336: }
6337: }
6338:
1.384 raeburn 6339: sub get_secgrprole_info {
6340: my ($cdom,$cnum,$needroles,$type) = @_;
6341: my %sections_count = &get_sections($cdom,$cnum);
6342: my @sections = (sort {$a <=> $b} keys(%sections_count));
6343: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6344: my @groups = sort(keys(%curr_groups));
6345: my $allroles = [];
6346: my $rolehash;
6347: my $accesshash = {
6348: active => 'Currently has access',
6349: future => 'Will have future access',
6350: previous => 'Previously had access',
6351: };
6352: if ($needroles) {
6353: $rolehash = {'all' => 'all'};
1.385 albertel 6354: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6355: if (&Apache::lonnet::error(%user_roles)) {
6356: undef(%user_roles);
6357: }
6358: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6359: my ($role)=split(/\:/,$item,2);
6360: if ($role eq 'cr') { next; }
6361: if ($role =~ /^cr/) {
6362: $$rolehash{$role} = (split('/',$role))[3];
6363: } else {
6364: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6365: }
6366: }
6367: foreach my $key (sort(keys(%{$rolehash}))) {
6368: push(@{$allroles},$key);
6369: }
6370: push (@{$allroles},'st');
6371: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6372: }
6373: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6374: }
6375:
1.555 raeburn 6376: sub user_picker {
1.627 raeburn 6377: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 6378: my $currdom = $dom;
6379: my %curr_selected = (
6380: srchin => 'dom',
1.580 raeburn 6381: srchby => 'lastname',
1.555 raeburn 6382: );
6383: my $srchterm;
1.625 raeburn 6384: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 6385: if ($srch->{'srchby'} ne '') {
6386: $curr_selected{'srchby'} = $srch->{'srchby'};
6387: }
6388: if ($srch->{'srchin'} ne '') {
6389: $curr_selected{'srchin'} = $srch->{'srchin'};
6390: }
6391: if ($srch->{'srchtype'} ne '') {
6392: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6393: }
6394: if ($srch->{'srchdomain'} ne '') {
6395: $currdom = $srch->{'srchdomain'};
6396: }
6397: $srchterm = $srch->{'srchterm'};
6398: }
6399: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6400: 'usr' => 'Search criteria',
1.563 raeburn 6401: 'doma' => 'Domain/institution to search',
1.558 albertel 6402: 'uname' => 'username',
6403: 'lastname' => 'last name',
1.555 raeburn 6404: 'lastfirst' => 'last name, first name',
1.558 albertel 6405: 'crs' => 'in this course',
1.576 raeburn 6406: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6407: 'alc' => 'all LON-CAPA',
1.573 raeburn 6408: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6409: 'exact' => 'is',
6410: 'contains' => 'contains',
1.569 raeburn 6411: 'begins' => 'begins with',
1.571 raeburn 6412: 'youm' => "You must include some text to search for.",
6413: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6414: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6415: 'yomc' => "You must choose a domain when using an institutional directory search.",
6416: 'ymcd' => "You must choose a domain when using a domain search.",
6417: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6418: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6419: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6420: );
1.563 raeburn 6421: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6422: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6423:
6424: my @srchins = ('crs','dom','alc','instd');
6425:
6426: foreach my $option (@srchins) {
6427: # FIXME 'alc' option unavailable until
6428: # loncreateuser::print_user_query_page()
6429: # has been completed.
6430: next if ($option eq 'alc');
6431: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6432: if ($curr_selected{'srchin'} eq $option) {
6433: $srchinsel .= '
6434: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6435: } else {
6436: $srchinsel .= '
6437: <option value="'.$option.'">'.$lt{$option}.'</option>';
6438: }
1.555 raeburn 6439: }
1.563 raeburn 6440: $srchinsel .= "\n </select>\n";
1.555 raeburn 6441:
6442: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6443: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6444: if ($curr_selected{'srchby'} eq $option) {
6445: $srchbysel .= '
6446: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6447: } else {
6448: $srchbysel .= '
6449: <option value="'.$option.'">'.$lt{$option}.'</option>';
6450: }
6451: }
6452: $srchbysel .= "\n </select>\n";
6453:
6454: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6455: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6456: if ($curr_selected{'srchtype'} eq $option) {
6457: $srchtypesel .= '
6458: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6459: } else {
6460: $srchtypesel .= '
6461: <option value="'.$option.'">'.$lt{$option}.'</option>';
6462: }
6463: }
6464: $srchtypesel .= "\n </select>\n";
6465:
1.558 albertel 6466: my ($newuserscript,$new_user_create);
1.556 raeburn 6467:
6468: if ($forcenewuser) {
1.576 raeburn 6469: if (ref($srch) eq 'HASH') {
6470: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 6471: if ($cancreate) {
6472: $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>';
6473: } else {
6474: my $helplink = ' href="javascript:helpMenu('."'display'".')"';
6475: my %usertypetext = (
6476: official => 'institutional',
6477: unofficial => 'non-institutional',
6478: );
6479: $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 />';
6480: }
1.576 raeburn 6481: }
6482: }
6483:
1.556 raeburn 6484: $newuserscript = <<"ENDSCRIPT";
6485:
1.570 raeburn 6486: function setSearch(createnew,callingForm) {
1.556 raeburn 6487: if (createnew == 1) {
1.570 raeburn 6488: for (var i=0; i<callingForm.srchby.length; i++) {
6489: if (callingForm.srchby.options[i].value == 'uname') {
6490: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6491: }
6492: }
1.570 raeburn 6493: for (var i=0; i<callingForm.srchin.length; i++) {
6494: if ( callingForm.srchin.options[i].value == 'dom') {
6495: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6496: }
6497: }
1.570 raeburn 6498: for (var i=0; i<callingForm.srchtype.length; i++) {
6499: if (callingForm.srchtype.options[i].value == 'exact') {
6500: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6501: }
6502: }
1.570 raeburn 6503: for (var i=0; i<callingForm.srchdomain.length; i++) {
6504: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6505: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6506: }
6507: }
6508: }
6509: }
6510: ENDSCRIPT
1.558 albertel 6511:
1.556 raeburn 6512: }
6513:
1.555 raeburn 6514: my $output = <<"END_BLOCK";
1.556 raeburn 6515: <script type="text/javascript">
1.570 raeburn 6516: function validateEntry(callingForm) {
1.558 albertel 6517:
1.556 raeburn 6518: var checkok = 1;
1.558 albertel 6519: var srchin;
1.570 raeburn 6520: for (var i=0; i<callingForm.srchin.length; i++) {
6521: if ( callingForm.srchin[i].checked ) {
6522: srchin = callingForm.srchin[i].value;
1.558 albertel 6523: }
6524: }
6525:
1.570 raeburn 6526: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6527: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6528: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6529: var srchterm = callingForm.srchterm.value;
6530: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6531: var msg = "";
6532:
6533: if (srchterm == "") {
6534: checkok = 0;
1.571 raeburn 6535: msg += "$lt{'youm'}\\n";
1.556 raeburn 6536: }
6537:
1.569 raeburn 6538: if (srchtype== 'begins') {
6539: if (srchterm.length < 2) {
6540: checkok = 0;
1.571 raeburn 6541: msg += "$lt{'thte'}\\n";
1.569 raeburn 6542: }
6543: }
6544:
1.556 raeburn 6545: if (srchtype== 'contains') {
6546: if (srchterm.length < 3) {
6547: checkok = 0;
1.571 raeburn 6548: msg += "$lt{'thet'}\\n";
1.556 raeburn 6549: }
6550: }
6551: if (srchin == 'instd') {
6552: if (srchdomain == '') {
6553: checkok = 0;
1.571 raeburn 6554: msg += "$lt{'yomc'}\\n";
1.556 raeburn 6555: }
6556: }
6557: if (srchin == 'dom') {
6558: if (srchdomain == '') {
6559: checkok = 0;
1.571 raeburn 6560: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 6561: }
6562: }
6563: if (srchby == 'lastfirst') {
6564: if (srchterm.indexOf(",") == -1) {
6565: checkok = 0;
1.571 raeburn 6566: msg += "$lt{'whus'}\\n";
1.556 raeburn 6567: }
6568: if (srchterm.indexOf(",") == srchterm.length -1) {
6569: checkok = 0;
1.571 raeburn 6570: msg += "$lt{'whse'}\\n";
1.556 raeburn 6571: }
6572: }
6573: if (checkok == 0) {
1.571 raeburn 6574: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 6575: return;
6576: }
6577: if (checkok == 1) {
1.570 raeburn 6578: callingForm.submit();
1.556 raeburn 6579: }
6580: }
6581:
6582: $newuserscript
6583:
6584: </script>
1.558 albertel 6585:
6586: $new_user_create
6587:
1.555 raeburn 6588: <table>
1.558 albertel 6589: <tr>
1.573 raeburn 6590: <td>$lt{'doma'}:</td>
6591: <td>$domform</td>
6592: </td>
6593: </tr>
6594: <tr>
6595: <td>$lt{'usr'}:</td>
1.563 raeburn 6596: <td>$srchbysel
6597: $srchtypesel
6598: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 6599: $srchinsel
1.563 raeburn 6600: </td>
6601: </tr>
1.555 raeburn 6602: </table>
6603: <br />
6604: END_BLOCK
1.558 albertel 6605:
1.555 raeburn 6606: return $output;
6607: }
6608:
1.612 raeburn 6609: sub user_rule_check {
1.615 raeburn 6610: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 6611: my $response;
6612: if (ref($usershash) eq 'HASH') {
6613: foreach my $user (keys(%{$usershash})) {
6614: my ($uname,$udom) = split(/:/,$user);
6615: next if ($udom eq '' || $uname eq '');
1.615 raeburn 6616: my ($id,$newuser);
1.612 raeburn 6617: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 6618: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 6619: $id = $usershash->{$user}->{'id'};
6620: }
6621: my $inst_response;
6622: if (ref($checks) eq 'HASH') {
6623: if (defined($checks->{'username'})) {
1.615 raeburn 6624: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 6625: &Apache::lonnet::get_instuser($udom,$uname);
6626: } elsif (defined($checks->{'id'})) {
1.615 raeburn 6627: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 6628: &Apache::lonnet::get_instuser($udom,undef,$id);
6629: }
1.615 raeburn 6630: } else {
6631: ($inst_response,%{$inst_results->{$user}}) =
6632: &Apache::lonnet::get_instuser($udom,$uname);
6633: return;
1.612 raeburn 6634: }
1.615 raeburn 6635: if (!$got_rules->{$udom}) {
1.612 raeburn 6636: my %domconfig = &Apache::lonnet::get_dom('configuration',
6637: ['usercreation'],$udom);
6638: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 6639: foreach my $item ('username','id') {
1.612 raeburn 6640: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
6641: $$curr_rules{$udom}{$item} =
6642: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 6643: }
6644: }
6645: }
1.615 raeburn 6646: $got_rules->{$udom} = 1;
1.585 raeburn 6647: }
1.612 raeburn 6648: foreach my $item (keys(%{$checks})) {
6649: if (ref($$curr_rules{$udom}) eq 'HASH') {
6650: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
6651: if (@{$$curr_rules{$udom}{$item}} > 0) {
6652: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
6653: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
6654: if ($rule_check{$rule}) {
6655: $$rulematch{$user}{$item} = $rule;
6656: if ($inst_response eq 'ok') {
1.615 raeburn 6657: if (ref($inst_results) eq 'HASH') {
6658: if (ref($inst_results->{$user}) eq 'HASH') {
6659: if (keys(%{$inst_results->{$user}}) == 0) {
6660: $$alerts{$item}{$udom}{$uname} = 1;
6661: }
1.612 raeburn 6662: }
6663: }
1.615 raeburn 6664: }
6665: last;
1.585 raeburn 6666: }
6667: }
6668: }
6669: }
6670: }
6671: }
6672: }
6673: }
1.612 raeburn 6674: return;
6675: }
6676:
6677: sub user_rule_formats {
6678: my ($domain,$domdesc,$curr_rules,$check) = @_;
6679: my %text = (
6680: 'username' => 'Usernames',
6681: 'id' => 'IDs',
6682: );
6683: my $output;
6684: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
6685: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
6686: if (@{$ruleorder} > 0) {
6687: $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>';
6688: foreach my $rule (@{$ruleorder}) {
6689: if (ref($curr_rules) eq 'ARRAY') {
6690: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
6691: if (ref($rules->{$rule}) eq 'HASH') {
6692: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
6693: $rules->{$rule}{'desc'}.'</li>';
6694: }
6695: }
6696: }
6697: }
6698: $output .= '</ul>';
6699: }
6700: }
6701: return $output;
6702: }
6703:
6704: sub instrule_disallow_msg {
1.615 raeburn 6705: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 6706: my $response;
6707: my %text = (
6708: item => 'username',
6709: items => 'usernames',
6710: match => 'matches',
6711: do => 'does',
6712: action => 'a username',
6713: one => 'one',
6714: );
6715: if ($count > 1) {
6716: $text{'item'} = 'usernames';
6717: $text{'match'} ='match';
6718: $text{'do'} = 'do';
6719: $text{'action'} = 'usernames',
6720: $text{'one'} = 'ones';
6721: }
6722: if ($checkitem eq 'id') {
6723: $text{'items'} = 'IDs';
6724: $text{'item'} = 'ID';
6725: $text{'action'} = 'an ID';
1.615 raeburn 6726: if ($count > 1) {
6727: $text{'item'} = 'IDs';
6728: $text{'action'} = 'IDs';
6729: }
1.612 raeburn 6730: }
6731: $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 6732: if ($mode eq 'upload') {
6733: if ($checkitem eq 'username') {
6734: $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'}.");
6735: } elsif ($checkitem eq 'id') {
6736: $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.");
6737: }
6738: } else {
6739: if ($checkitem eq 'username') {
6740: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
6741: } elsif ($checkitem eq 'id') {
6742: $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.");
6743: }
1.612 raeburn 6744: }
6745: return $response;
1.585 raeburn 6746: }
6747:
1.624 raeburn 6748: sub personal_data_fieldtitles {
6749: my %fieldtitles = &Apache::lonlocal::texthash (
6750: id => 'Student/Employee ID',
6751: permanentemail => 'E-mail address',
6752: lastname => 'Last Name',
6753: firstname => 'First Name',
6754: middlename => 'Middle Name',
6755: generation => 'Generation',
6756: gen => 'Generation',
6757: );
6758: return %fieldtitles;
6759: }
6760:
1.112 bowersj2 6761: =pod
6762:
1.549 albertel 6763: =back
6764:
6765: =head1 HTTP Helpers
6766:
6767: =over 4
6768:
1.112 bowersj2 6769: =item * get_unprocessed_cgi($query,$possible_names)
6770:
1.258 albertel 6771: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 6772: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 6773: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 6774:
6775: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
6776: $possible_names is an ref to an array of form element names. As an example:
6777: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 6778: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 6779:
6780: =cut
1.1 albertel 6781:
1.6 albertel 6782: sub get_unprocessed_cgi {
1.25 albertel 6783: my ($query,$possible_names)= @_;
1.26 matthew 6784: # $Apache::lonxml::debug=1;
1.356 albertel 6785: foreach my $pair (split(/&/,$query)) {
6786: my ($name, $value) = split(/=/,$pair);
1.369 www 6787: $name = &unescape($name);
1.25 albertel 6788: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
6789: $value =~ tr/+/ /;
6790: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 6791: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 6792: }
1.16 harris41 6793: }
1.6 albertel 6794: }
6795:
1.112 bowersj2 6796: =pod
6797:
6798: =item * cacheheader()
6799:
6800: returns cache-controlling header code
6801:
6802: =cut
6803:
1.7 albertel 6804: sub cacheheader {
1.258 albertel 6805: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 6806: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
6807: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 6808: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
6809: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 6810: return $output;
1.7 albertel 6811: }
6812:
1.112 bowersj2 6813: =pod
6814:
6815: =item * no_cache($r)
6816:
6817: specifies header code to not have cache
6818:
6819: =cut
6820:
1.9 albertel 6821: sub no_cache {
1.216 albertel 6822: my ($r) = @_;
6823: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 6824: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 6825: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
6826: $r->no_cache(1);
6827: $r->header_out("Expires" => $date);
6828: $r->header_out("Pragma" => "no-cache");
1.123 www 6829: }
6830:
6831: sub content_type {
1.181 albertel 6832: my ($r,$type,$charset) = @_;
1.299 foxr 6833: if ($r) {
6834: # Note that printout.pl calls this with undef for $r.
6835: &no_cache($r);
6836: }
1.258 albertel 6837: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 6838: unless ($charset) {
6839: $charset=&Apache::lonlocal::current_encoding;
6840: }
6841: if ($charset) { $type.='; charset='.$charset; }
6842: if ($r) {
6843: $r->content_type($type);
6844: } else {
6845: print("Content-type: $type\n\n");
6846: }
1.9 albertel 6847: }
1.25 albertel 6848:
1.112 bowersj2 6849: =pod
6850:
6851: =item * add_to_env($name,$value)
6852:
1.258 albertel 6853: adds $name to the %env hash with value
1.112 bowersj2 6854: $value, if $name already exists, the entry is converted to an array
6855: reference and $value is added to the array.
6856:
6857: =cut
6858:
1.25 albertel 6859: sub add_to_env {
6860: my ($name,$value)=@_;
1.258 albertel 6861: if (defined($env{$name})) {
6862: if (ref($env{$name})) {
1.25 albertel 6863: #already have multiple values
1.258 albertel 6864: push(@{ $env{$name} },$value);
1.25 albertel 6865: } else {
6866: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 6867: my $first=$env{$name};
6868: undef($env{$name});
6869: push(@{ $env{$name} },$first,$value);
1.25 albertel 6870: }
6871: } else {
1.258 albertel 6872: $env{$name}=$value;
1.25 albertel 6873: }
1.31 albertel 6874: }
1.149 albertel 6875:
6876: =pod
6877:
6878: =item * get_env_multiple($name)
6879:
1.258 albertel 6880: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 6881: values may be defined and end up as an array ref.
6882:
6883: returns an array of values
6884:
6885: =cut
6886:
6887: sub get_env_multiple {
6888: my ($name) = @_;
6889: my @values;
1.258 albertel 6890: if (defined($env{$name})) {
1.149 albertel 6891: # exists is it an array
1.258 albertel 6892: if (ref($env{$name})) {
6893: @values=@{ $env{$name} };
1.149 albertel 6894: } else {
1.258 albertel 6895: $values[0]=$env{$name};
1.149 albertel 6896: }
6897: }
6898: return(@values);
6899: }
6900:
1.31 albertel 6901:
1.41 ng 6902: =pod
1.45 matthew 6903:
1.464 albertel 6904: =back
1.41 ng 6905:
1.112 bowersj2 6906: =head1 CSV Upload/Handling functions
1.38 albertel 6907:
1.41 ng 6908: =over 4
6909:
1.112 bowersj2 6910: =item * upfile_store($r)
1.41 ng 6911:
6912: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 6913: needs $env{'form.upfile'}
1.41 ng 6914: returns $datatoken to be put into hidden field
6915:
6916: =cut
1.31 albertel 6917:
6918: sub upfile_store {
6919: my $r=shift;
1.258 albertel 6920: $env{'form.upfile'}=~s/\r/\n/gs;
6921: $env{'form.upfile'}=~s/\f/\n/gs;
6922: $env{'form.upfile'}=~s/\n+/\n/gs;
6923: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 6924:
1.258 albertel 6925: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
6926: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 6927: {
1.158 raeburn 6928: my $datafile = $r->dir_config('lonDaemons').
6929: '/tmp/'.$datatoken.'.tmp';
6930: if ( open(my $fh,">$datafile") ) {
1.258 albertel 6931: print $fh $env{'form.upfile'};
1.158 raeburn 6932: close($fh);
6933: }
1.31 albertel 6934: }
6935: return $datatoken;
6936: }
6937:
1.56 matthew 6938: =pod
6939:
1.112 bowersj2 6940: =item * load_tmp_file($r)
1.41 ng 6941:
6942: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 6943: needs $env{'form.datatoken'},
6944: sets $env{'form.upfile'} to the contents of the file
1.41 ng 6945:
6946: =cut
1.31 albertel 6947:
6948: sub load_tmp_file {
6949: my $r=shift;
6950: my @studentdata=();
6951: {
1.158 raeburn 6952: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 6953: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 6954: if ( open(my $fh,"<$studentfile") ) {
6955: @studentdata=<$fh>;
6956: close($fh);
6957: }
1.31 albertel 6958: }
1.258 albertel 6959: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 6960: }
6961:
1.56 matthew 6962: =pod
6963:
1.112 bowersj2 6964: =item * upfile_record_sep()
1.41 ng 6965:
6966: Separate uploaded file into records
6967: returns array of records,
1.258 albertel 6968: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 6969:
6970: =cut
1.31 albertel 6971:
6972: sub upfile_record_sep {
1.258 albertel 6973: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 6974: } else {
1.248 albertel 6975: my @records;
1.258 albertel 6976: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 6977: if ($line=~/^\s*$/) { next; }
6978: push(@records,$line);
6979: }
6980: return @records;
1.31 albertel 6981: }
6982: }
6983:
1.56 matthew 6984: =pod
6985:
1.112 bowersj2 6986: =item * record_sep($record)
1.41 ng 6987:
1.258 albertel 6988: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 6989:
6990: =cut
6991:
1.263 www 6992: sub takeleft {
6993: my $index=shift;
6994: return substr('0000'.$index,-4,4);
6995: }
6996:
1.31 albertel 6997: sub record_sep {
6998: my $record=shift;
6999: my %components=();
1.258 albertel 7000: if ($env{'form.upfiletype'} eq 'xml') {
7001: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 7002: my $i=0;
1.356 albertel 7003: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 7004: $field=~s/^(\"|\')//;
7005: $field=~s/(\"|\')$//;
1.263 www 7006: $components{&takeleft($i)}=$field;
1.31 albertel 7007: $i++;
7008: }
1.258 albertel 7009: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 7010: my $i=0;
1.356 albertel 7011: foreach my $field (split(/\t/,$record)) {
1.31 albertel 7012: $field=~s/^(\"|\')//;
7013: $field=~s/(\"|\')$//;
1.263 www 7014: $components{&takeleft($i)}=$field;
1.31 albertel 7015: $i++;
7016: }
7017: } else {
1.561 www 7018: my $separator=',';
1.480 banghart 7019: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 7020: $separator=';';
1.480 banghart 7021: }
1.31 albertel 7022: my $i=0;
1.561 www 7023: # the character we are looking for to indicate the end of a quote or a record
7024: my $looking_for=$separator;
7025: # do not add the characters to the fields
7026: my $ignore=0;
7027: # we just encountered a separator (or the beginning of the record)
7028: my $just_found_separator=1;
7029: # store the field we are working on here
7030: my $field='';
7031: # work our way through all characters in record
7032: foreach my $character ($record=~/(.)/g) {
7033: if ($character eq $looking_for) {
7034: if ($character ne $separator) {
7035: # Found the end of a quote, again looking for separator
7036: $looking_for=$separator;
7037: $ignore=1;
7038: } else {
7039: # Found a separator, store away what we got
7040: $components{&takeleft($i)}=$field;
7041: $i++;
7042: $just_found_separator=1;
7043: $ignore=0;
7044: $field='';
7045: }
7046: next;
7047: }
7048: # single or double quotation marks after a separator indicate beginning of a quote
7049: # we are now looking for the end of the quote and need to ignore separators
7050: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
7051: $looking_for=$character;
7052: next;
7053: }
7054: # ignore would be true after we reached the end of a quote
7055: if ($ignore) { next; }
7056: if (($just_found_separator) && ($character=~/\s/)) { next; }
7057: $field.=$character;
7058: $just_found_separator=0;
1.31 albertel 7059: }
1.561 www 7060: # catch the very last entry, since we never encountered the separator
7061: $components{&takeleft($i)}=$field;
1.31 albertel 7062: }
7063: return %components;
7064: }
7065:
1.144 matthew 7066: ######################################################
7067: ######################################################
7068:
1.56 matthew 7069: =pod
7070:
1.112 bowersj2 7071: =item * upfile_select_html()
1.41 ng 7072:
1.144 matthew 7073: Return HTML code to select a file from the users machine and specify
7074: the file type.
1.41 ng 7075:
7076: =cut
7077:
1.144 matthew 7078: ######################################################
7079: ######################################################
1.31 albertel 7080: sub upfile_select_html {
1.144 matthew 7081: my %Types = (
7082: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 7083: semisv => &mt('Semicolon separated values'),
1.144 matthew 7084: space => &mt('Space separated'),
7085: tab => &mt('Tabulator separated'),
7086: # xml => &mt('HTML/XML'),
7087: );
7088: my $Str = '<input type="file" name="upfile" size="50" />'.
7089: '<br />Type: <select name="upfiletype">';
7090: foreach my $type (sort(keys(%Types))) {
7091: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
7092: }
7093: $Str .= "</select>\n";
7094: return $Str;
1.31 albertel 7095: }
7096:
1.301 albertel 7097: sub get_samples {
7098: my ($records,$toget) = @_;
7099: my @samples=({});
7100: my $got=0;
7101: foreach my $rec (@$records) {
7102: my %temp = &record_sep($rec);
7103: if (! grep(/\S/, values(%temp))) { next; }
7104: if (%temp) {
7105: $samples[$got]=\%temp;
7106: $got++;
7107: if ($got == $toget) { last; }
7108: }
7109: }
7110: return \@samples;
7111: }
7112:
1.144 matthew 7113: ######################################################
7114: ######################################################
7115:
1.56 matthew 7116: =pod
7117:
1.112 bowersj2 7118: =item * csv_print_samples($r,$records)
1.41 ng 7119:
7120: Prints a table of sample values from each column uploaded $r is an
7121: Apache Request ref, $records is an arrayref from
7122: &Apache::loncommon::upfile_record_sep
7123:
7124: =cut
7125:
1.144 matthew 7126: ######################################################
7127: ######################################################
1.31 albertel 7128: sub csv_print_samples {
7129: my ($r,$records) = @_;
1.301 albertel 7130: my $samples = &get_samples($records,3);
7131:
1.594 raeburn 7132: $r->print(&mt('Samples').'<br />'.&start_data_table().
7133: &start_data_table_header_row());
1.356 albertel 7134: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7135: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 7136: $r->print(&end_data_table_header_row());
1.301 albertel 7137: foreach my $hash (@$samples) {
1.594 raeburn 7138: $r->print(&start_data_table_row());
1.356 albertel 7139: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 7140: $r->print('<td>');
1.356 albertel 7141: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 7142: $r->print('</td>');
7143: }
1.594 raeburn 7144: $r->print(&end_data_table_row());
1.31 albertel 7145: }
1.594 raeburn 7146: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 7147: }
7148:
1.144 matthew 7149: ######################################################
7150: ######################################################
7151:
1.56 matthew 7152: =pod
7153:
1.112 bowersj2 7154: =item * csv_print_select_table($r,$records,$d)
1.41 ng 7155:
7156: Prints a table to create associations between values and table columns.
1.144 matthew 7157:
1.41 ng 7158: $r is an Apache Request ref,
7159: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 7160: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 7161:
7162: =cut
7163:
1.144 matthew 7164: ######################################################
7165: ######################################################
1.31 albertel 7166: sub csv_print_select_table {
7167: my ($r,$records,$d) = @_;
1.301 albertel 7168: my $i=0;
7169: my $samples = &get_samples($records,1);
1.144 matthew 7170: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 7171: &start_data_table().&start_data_table_header_row().
1.144 matthew 7172: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 7173: '<th>'.&mt('Column').'</th>'.
7174: &end_data_table_header_row()."\n");
1.356 albertel 7175: foreach my $array_ref (@$d) {
7176: my ($value,$display,$defaultcol)=@{ $array_ref };
1.594 raeburn 7177: $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
1.31 albertel 7178:
7179: $r->print('<td><select name=f'.$i.
1.32 matthew 7180: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 7181: $r->print('<option value="none"></option>');
1.356 albertel 7182: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7183: $r->print('<option value="'.$sample.'"'.
7184: ($sample eq $defaultcol ? ' selected="selected" ' : '').
7185: '>Column '.($sample+1).'</option>');
1.31 albertel 7186: }
1.594 raeburn 7187: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 7188: $i++;
7189: }
1.594 raeburn 7190: $r->print(&end_data_table());
1.31 albertel 7191: $i--;
7192: return $i;
7193: }
1.56 matthew 7194:
1.144 matthew 7195: ######################################################
7196: ######################################################
7197:
1.56 matthew 7198: =pod
1.31 albertel 7199:
1.112 bowersj2 7200: =item * csv_samples_select_table($r,$records,$d)
1.41 ng 7201:
7202: Prints a table of sample values from the upload and can make associate samples to internal names.
7203:
7204: $r is an Apache Request ref,
7205: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
7206: $d is an array of 2 element arrays (internal name, displayed name)
7207:
7208: =cut
7209:
1.144 matthew 7210: ######################################################
7211: ######################################################
1.31 albertel 7212: sub csv_samples_select_table {
7213: my ($r,$records,$d) = @_;
7214: my $i=0;
1.144 matthew 7215: #
1.301 albertel 7216: my $samples = &get_samples($records,3);
1.594 raeburn 7217: $r->print(&start_data_table().
7218: &start_data_table_header_row().'<th>'.
7219: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
7220: &end_data_table_header_row());
1.301 albertel 7221:
7222: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 7223: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 7224: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 7225: foreach my $option (@$d) {
7226: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 7227: $r->print('<option value="'.$value.'"'.
1.253 albertel 7228: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 7229: $display.'</option>');
1.31 albertel 7230: }
7231: $r->print('</select></td><td>');
1.301 albertel 7232: foreach my $line (0..2) {
7233: if (defined($samples->[$line]{$key})) {
7234: $r->print($samples->[$line]{$key}."<br />\n");
7235: }
7236: }
1.594 raeburn 7237: $r->print('</td>'.&end_data_table_row());
1.31 albertel 7238: $i++;
7239: }
1.594 raeburn 7240: $r->print(&end_data_table());
1.31 albertel 7241: $i--;
7242: return($i);
1.115 matthew 7243: }
7244:
1.144 matthew 7245: ######################################################
7246: ######################################################
7247:
1.115 matthew 7248: =pod
7249:
7250: =item clean_excel_name($name)
7251:
7252: Returns a replacement for $name which does not contain any illegal characters.
7253:
7254: =cut
7255:
1.144 matthew 7256: ######################################################
7257: ######################################################
1.115 matthew 7258: sub clean_excel_name {
7259: my ($name) = @_;
7260: $name =~ s/[:\*\?\/\\]//g;
7261: if (length($name) > 31) {
7262: $name = substr($name,0,31);
7263: }
7264: return $name;
1.25 albertel 7265: }
1.84 albertel 7266:
1.85 albertel 7267: =pod
7268:
1.112 bowersj2 7269: =item * check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 7270:
7271: Returns either 1 or undef
7272:
7273: 1 if the part is to be hidden, undef if it is to be shown
7274:
7275: Arguments are:
7276:
7277: $id the id of the part to be checked
7278: $symb, optional the symb of the resource to check
7279: $udom, optional the domain of the user to check for
7280: $uname, optional the username of the user to check for
7281:
7282: =cut
1.84 albertel 7283:
7284: sub check_if_partid_hidden {
7285: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 7286: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 7287: $symb,$udom,$uname);
1.141 albertel 7288: my $truth=1;
7289: #if the string starts with !, then the list is the list to show not hide
7290: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 7291: my @hiddenlist=split(/,/,$hiddenparts);
7292: foreach my $checkid (@hiddenlist) {
1.141 albertel 7293: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 7294: }
1.141 albertel 7295: return !$truth;
1.84 albertel 7296: }
1.127 matthew 7297:
1.138 matthew 7298:
7299: ############################################################
7300: ############################################################
7301:
7302: =pod
7303:
1.157 matthew 7304: =back
7305:
1.138 matthew 7306: =head1 cgi-bin script and graphing routines
7307:
1.157 matthew 7308: =over 4
7309:
1.138 matthew 7310: =item get_cgi_id
7311:
7312: Inputs: none
7313:
7314: Returns an id which can be used to pass environment variables
7315: to various cgi-bin scripts. These environment variables will
7316: be removed from the users environment after a given time by
7317: the routine &Apache::lonnet::transfer_profile_to_env.
7318:
7319: =cut
7320:
7321: ############################################################
7322: ############################################################
1.152 albertel 7323: my $uniq=0;
1.136 matthew 7324: sub get_cgi_id {
1.154 albertel 7325: $uniq=($uniq+1)%100000;
1.280 albertel 7326: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 7327: }
7328:
1.127 matthew 7329: ############################################################
7330: ############################################################
7331:
7332: =pod
7333:
1.134 matthew 7334: =item DrawBarGraph
1.127 matthew 7335:
1.138 matthew 7336: Facilitates the plotting of data in a (stacked) bar graph.
7337: Puts plot definition data into the users environment in order for
7338: graph.png to plot it. Returns an <img> tag for the plot.
7339: The bars on the plot are labeled '1','2',...,'n'.
7340:
7341: Inputs:
7342:
7343: =over 4
7344:
7345: =item $Title: string, the title of the plot
7346:
7347: =item $xlabel: string, text describing the X-axis of the plot
7348:
7349: =item $ylabel: string, text describing the Y-axis of the plot
7350:
7351: =item $Max: scalar, the maximum Y value to use in the plot
7352: If $Max is < any data point, the graph will not be rendered.
7353:
1.140 matthew 7354: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 7355: they are plotted. If undefined, default values will be used.
7356:
1.178 matthew 7357: =item $labels: array ref holding the labels to use on the x-axis for the bars.
7358:
1.138 matthew 7359: =item @Values: An array of array references. Each array reference holds data
7360: to be plotted in a stacked bar chart.
7361:
1.239 matthew 7362: =item If the final element of @Values is a hash reference the key/value
7363: pairs will be added to the graph definition.
7364:
1.138 matthew 7365: =back
7366:
7367: Returns:
7368:
7369: An <img> tag which references graph.png and the appropriate identifying
7370: information for the plot.
7371:
1.127 matthew 7372: =cut
7373:
7374: ############################################################
7375: ############################################################
1.134 matthew 7376: sub DrawBarGraph {
1.178 matthew 7377: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 7378: #
7379: if (! defined($colors)) {
7380: $colors = ['#33ff00',
7381: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
7382: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
7383: ];
7384: }
1.228 matthew 7385: my $extra_settings = {};
7386: if (ref($Values[-1]) eq 'HASH') {
7387: $extra_settings = pop(@Values);
7388: }
1.127 matthew 7389: #
1.136 matthew 7390: my $identifier = &get_cgi_id();
7391: my $id = 'cgi.'.$identifier;
1.129 matthew 7392: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 7393: return '';
7394: }
1.225 matthew 7395: #
7396: my @Labels;
7397: if (defined($labels)) {
7398: @Labels = @$labels;
7399: } else {
7400: for (my $i=0;$i<@{$Values[0]};$i++) {
7401: push (@Labels,$i+1);
7402: }
7403: }
7404: #
1.129 matthew 7405: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 7406: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 7407: my %ValuesHash;
7408: my $NumSets=1;
7409: foreach my $array (@Values) {
7410: next if (! ref($array));
1.136 matthew 7411: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 7412: join(',',@$array);
1.129 matthew 7413: }
1.127 matthew 7414: #
1.136 matthew 7415: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 7416: if ($NumBars < 3) {
7417: $width = 120+$NumBars*32;
1.220 matthew 7418: $xskip = 1;
1.225 matthew 7419: $bar_width = 30;
7420: } elsif ($NumBars < 5) {
7421: $width = 120+$NumBars*20;
7422: $xskip = 1;
7423: $bar_width = 20;
1.220 matthew 7424: } elsif ($NumBars < 10) {
1.136 matthew 7425: $width = 120+$NumBars*15;
7426: $xskip = 1;
7427: $bar_width = 15;
7428: } elsif ($NumBars <= 25) {
7429: $width = 120+$NumBars*11;
7430: $xskip = 5;
7431: $bar_width = 8;
7432: } elsif ($NumBars <= 50) {
7433: $width = 120+$NumBars*8;
7434: $xskip = 5;
7435: $bar_width = 4;
7436: } else {
7437: $width = 120+$NumBars*8;
7438: $xskip = 5;
7439: $bar_width = 4;
7440: }
7441: #
1.137 matthew 7442: $Max = 1 if ($Max < 1);
7443: if ( int($Max) < $Max ) {
7444: $Max++;
7445: $Max = int($Max);
7446: }
1.127 matthew 7447: $Title = '' if (! defined($Title));
7448: $xlabel = '' if (! defined($xlabel));
7449: $ylabel = '' if (! defined($ylabel));
1.369 www 7450: $ValuesHash{$id.'.title'} = &escape($Title);
7451: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
7452: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 7453: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 7454: $ValuesHash{$id.'.NumBars'} = $NumBars;
7455: $ValuesHash{$id.'.NumSets'} = $NumSets;
7456: $ValuesHash{$id.'.PlotType'} = 'bar';
7457: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7458: $ValuesHash{$id.'.height'} = $height;
7459: $ValuesHash{$id.'.width'} = $width;
7460: $ValuesHash{$id.'.xskip'} = $xskip;
7461: $ValuesHash{$id.'.bar_width'} = $bar_width;
7462: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 7463: #
1.228 matthew 7464: # Deal with other parameters
7465: while (my ($key,$value) = each(%$extra_settings)) {
7466: $ValuesHash{$id.'.'.$key} = $value;
7467: }
7468: #
1.137 matthew 7469: &Apache::lonnet::appenv(%ValuesHash);
7470: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7471: }
7472:
7473: ############################################################
7474: ############################################################
7475:
7476: =pod
7477:
7478: =item DrawXYGraph
7479:
1.138 matthew 7480: Facilitates the plotting of data in an XY graph.
7481: Puts plot definition data into the users environment in order for
7482: graph.png to plot it. Returns an <img> tag for the plot.
7483:
7484: Inputs:
7485:
7486: =over 4
7487:
7488: =item $Title: string, the title of the plot
7489:
7490: =item $xlabel: string, text describing the X-axis of the plot
7491:
7492: =item $ylabel: string, text describing the Y-axis of the plot
7493:
7494: =item $Max: scalar, the maximum Y value to use in the plot
7495: If $Max is < any data point, the graph will not be rendered.
7496:
7497: =item $colors: Array ref containing the hex color codes for the data to be
7498: plotted in. If undefined, default values will be used.
7499:
7500: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7501:
7502: =item $Ydata: Array ref containing Array refs.
1.185 www 7503: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 7504:
7505: =item %Values: hash indicating or overriding any default values which are
7506: passed to graph.png.
7507: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7508:
7509: =back
7510:
7511: Returns:
7512:
7513: An <img> tag which references graph.png and the appropriate identifying
7514: information for the plot.
7515:
1.137 matthew 7516: =cut
7517:
7518: ############################################################
7519: ############################################################
7520: sub DrawXYGraph {
7521: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
7522: #
7523: # Create the identifier for the graph
7524: my $identifier = &get_cgi_id();
7525: my $id = 'cgi.'.$identifier;
7526: #
7527: $Title = '' if (! defined($Title));
7528: $xlabel = '' if (! defined($xlabel));
7529: $ylabel = '' if (! defined($ylabel));
7530: my %ValuesHash =
7531: (
1.369 www 7532: $id.'.title' => &escape($Title),
7533: $id.'.xlabel' => &escape($xlabel),
7534: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 7535: $id.'.y_max_value'=> $Max,
7536: $id.'.labels' => join(',',@$Xlabels),
7537: $id.'.PlotType' => 'XY',
7538: );
7539: #
7540: if (defined($colors) && ref($colors) eq 'ARRAY') {
7541: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7542: }
7543: #
7544: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
7545: return '';
7546: }
7547: my $NumSets=1;
1.138 matthew 7548: foreach my $array (@{$Ydata}){
1.137 matthew 7549: next if (! ref($array));
7550: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
7551: }
1.138 matthew 7552: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 7553: #
7554: # Deal with other parameters
7555: while (my ($key,$value) = each(%Values)) {
7556: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 7557: }
7558: #
1.136 matthew 7559: &Apache::lonnet::appenv(%ValuesHash);
7560: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
7561: }
7562:
7563: ############################################################
7564: ############################################################
7565:
7566: =pod
7567:
1.138 matthew 7568: =item DrawXYYGraph
7569:
7570: Facilitates the plotting of data in an XY graph with two Y axes.
7571: Puts plot definition data into the users environment in order for
7572: graph.png to plot it. Returns an <img> tag for the plot.
7573:
7574: Inputs:
7575:
7576: =over 4
7577:
7578: =item $Title: string, the title of the plot
7579:
7580: =item $xlabel: string, text describing the X-axis of the plot
7581:
7582: =item $ylabel: string, text describing the Y-axis of the plot
7583:
7584: =item $colors: Array ref containing the hex color codes for the data to be
7585: plotted in. If undefined, default values will be used.
7586:
7587: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
7588:
7589: =item $Ydata1: The first data set
7590:
7591: =item $Min1: The minimum value of the left Y-axis
7592:
7593: =item $Max1: The maximum value of the left Y-axis
7594:
7595: =item $Ydata2: The second data set
7596:
7597: =item $Min2: The minimum value of the right Y-axis
7598:
7599: =item $Max2: The maximum value of the left Y-axis
7600:
7601: =item %Values: hash indicating or overriding any default values which are
7602: passed to graph.png.
7603: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
7604:
7605: =back
7606:
7607: Returns:
7608:
7609: An <img> tag which references graph.png and the appropriate identifying
7610: information for the plot.
1.136 matthew 7611:
7612: =cut
7613:
7614: ############################################################
7615: ############################################################
1.137 matthew 7616: sub DrawXYYGraph {
7617: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
7618: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 7619: #
7620: # Create the identifier for the graph
7621: my $identifier = &get_cgi_id();
7622: my $id = 'cgi.'.$identifier;
7623: #
7624: $Title = '' if (! defined($Title));
7625: $xlabel = '' if (! defined($xlabel));
7626: $ylabel = '' if (! defined($ylabel));
7627: my %ValuesHash =
7628: (
1.369 www 7629: $id.'.title' => &escape($Title),
7630: $id.'.xlabel' => &escape($xlabel),
7631: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 7632: $id.'.labels' => join(',',@$Xlabels),
7633: $id.'.PlotType' => 'XY',
7634: $id.'.NumSets' => 2,
1.137 matthew 7635: $id.'.two_axes' => 1,
7636: $id.'.y1_max_value' => $Max1,
7637: $id.'.y1_min_value' => $Min1,
7638: $id.'.y2_max_value' => $Max2,
7639: $id.'.y2_min_value' => $Min2,
1.136 matthew 7640: );
7641: #
1.137 matthew 7642: if (defined($colors) && ref($colors) eq 'ARRAY') {
7643: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
7644: }
7645: #
7646: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
7647: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 7648: return '';
7649: }
7650: my $NumSets=1;
1.137 matthew 7651: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 7652: next if (! ref($array));
7653: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 7654: }
7655: #
7656: # Deal with other parameters
7657: while (my ($key,$value) = each(%Values)) {
7658: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 7659: }
7660: #
7661: &Apache::lonnet::appenv(%ValuesHash);
1.130 albertel 7662: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 7663: }
7664:
7665: ############################################################
7666: ############################################################
7667:
7668: =pod
7669:
1.157 matthew 7670: =back
7671:
1.139 matthew 7672: =head1 Statistics helper routines?
7673:
7674: Bad place for them but what the hell.
7675:
1.157 matthew 7676: =over 4
7677:
1.139 matthew 7678: =item &chartlink
7679:
7680: Returns a link to the chart for a specific student.
7681:
7682: Inputs:
7683:
7684: =over 4
7685:
7686: =item $linktext: The text of the link
7687:
7688: =item $sname: The students username
7689:
7690: =item $sdomain: The students domain
7691:
7692: =back
7693:
1.157 matthew 7694: =back
7695:
1.139 matthew 7696: =cut
7697:
7698: ############################################################
7699: ############################################################
7700: sub chartlink {
7701: my ($linktext, $sname, $sdomain) = @_;
7702: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 7703: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 7704: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 7705: '">'.$linktext.'</a>';
1.153 matthew 7706: }
7707:
7708: #######################################################
7709: #######################################################
7710:
7711: =pod
7712:
7713: =head1 Course Environment Routines
1.157 matthew 7714:
7715: =over 4
1.153 matthew 7716:
7717: =item &restore_course_settings
7718:
7719: =item &store_course_settings
7720:
7721: Restores/Store indicated form parameters from the course environment.
7722: Will not overwrite existing values of the form parameters.
7723:
7724: Inputs:
7725: a scalar describing the data (e.g. 'chart', 'problem_analysis')
7726:
7727: a hash ref describing the data to be stored. For example:
7728:
7729: %Save_Parameters = ('Status' => 'scalar',
7730: 'chartoutputmode' => 'scalar',
7731: 'chartoutputdata' => 'scalar',
7732: 'Section' => 'array',
1.373 raeburn 7733: 'Group' => 'array',
1.153 matthew 7734: 'StudentData' => 'array',
7735: 'Maps' => 'array');
7736:
7737: Returns: both routines return nothing
7738:
1.631 raeburn 7739: =back
7740:
1.153 matthew 7741: =cut
7742:
7743: #######################################################
7744: #######################################################
7745: sub store_course_settings {
1.496 albertel 7746: return &store_settings($env{'request.course.id'},@_);
7747: }
7748:
7749: sub store_settings {
1.153 matthew 7750: # save to the environment
7751: # appenv the same items, just to be safe
1.300 albertel 7752: my $udom = $env{'user.domain'};
7753: my $uname = $env{'user.name'};
1.496 albertel 7754: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7755: my %SaveHash;
7756: my %AppHash;
7757: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 7758: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 7759: my $envname = 'environment.'.$basename;
1.258 albertel 7760: if (exists($env{'form.'.$setting})) {
1.153 matthew 7761: # Save this value away
7762: if ($type eq 'scalar' &&
1.258 albertel 7763: (! exists($env{$envname}) ||
7764: $env{$envname} ne $env{'form.'.$setting})) {
7765: $SaveHash{$basename} = $env{'form.'.$setting};
7766: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 7767: } elsif ($type eq 'array') {
7768: my $stored_form;
1.258 albertel 7769: if (ref($env{'form.'.$setting})) {
1.153 matthew 7770: $stored_form = join(',',
7771: map {
1.369 www 7772: &escape($_);
1.258 albertel 7773: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 7774: } else {
7775: $stored_form =
1.369 www 7776: &escape($env{'form.'.$setting});
1.153 matthew 7777: }
7778: # Determine if the array contents are the same.
1.258 albertel 7779: if ($stored_form ne $env{$envname}) {
1.153 matthew 7780: $SaveHash{$basename} = $stored_form;
7781: $AppHash{$envname} = $stored_form;
7782: }
7783: }
7784: }
7785: }
7786: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 7787: $udom,$uname);
1.153 matthew 7788: if ($put_result !~ /^(ok|delayed)/) {
7789: &Apache::lonnet::logthis('unable to save form parameters, '.
7790: 'got error:'.$put_result);
7791: }
7792: # Make sure these settings stick around in this session, too
7793: &Apache::lonnet::appenv(%AppHash);
7794: return;
7795: }
7796:
7797: sub restore_course_settings {
1.499 albertel 7798: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 7799: }
7800:
7801: sub restore_settings {
7802: my ($context,$prefix,$Settings) = @_;
1.153 matthew 7803: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 7804: next if (exists($env{'form.'.$setting}));
1.496 albertel 7805: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 7806: '.'.$setting;
1.258 albertel 7807: if (exists($env{$envname})) {
1.153 matthew 7808: if ($type eq 'scalar') {
1.258 albertel 7809: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 7810: } elsif ($type eq 'array') {
1.258 albertel 7811: $env{'form.'.$setting} = [
1.153 matthew 7812: map {
1.369 www 7813: &unescape($_);
1.258 albertel 7814: } split(',',$env{$envname})
1.153 matthew 7815: ];
7816: }
7817: }
7818: }
1.127 matthew 7819: }
7820:
1.618 raeburn 7821: #######################################################
7822: #######################################################
7823:
7824: =pod
7825:
7826: =head1 Domain E-mail Routines
7827:
7828: =over 4
7829:
7830: =item &build_recipient_list
7831:
7832: Build recipient lists for three types of e-mail:
7833: (a) Error Reports, (b) Package Updates, (c) Help requests, generated by
1.619 raeburn 7834: lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively.
1.618 raeburn 7835:
7836: Inputs:
1.619 raeburn 7837: defmail (scalar - email address of default recipient),
1.618 raeburn 7838: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 7839: defdom (domain for which to retrieve configuration settings),
7840: origmail (scalar - email address of recipient from loncapa.conf,
7841: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 7842:
7843: Returns: comma separated list of addresses to which to send e-mail.
7844:
7845: =cut
7846:
7847: ############################################################
7848: ############################################################
7849: sub build_recipient_list {
1.619 raeburn 7850: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 7851: my @recipients;
7852: my $otheremails;
7853: my %domconfig =
7854: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
7855: if (ref($domconfig{'contacts'}) eq 'HASH') {
7856: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
7857: my @contacts = ('adminemail','supportemail');
7858: foreach my $item (@contacts) {
7859: if ($domconfig{'contacts'}{$mailing}{$item}) {
1.619 raeburn 7860: my $addr = $domconfig{'contacts'}{$item};
7861: if (!grep(/^\Q$addr\E$/,@recipients)) {
7862: push(@recipients,$addr);
7863: }
1.618 raeburn 7864: }
7865: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
7866: }
7867: }
1.619 raeburn 7868: } elsif ($origmail ne '') {
7869: push(@recipients,$origmail);
1.618 raeburn 7870: }
7871: if ($defmail ne '') {
7872: push(@recipients,$defmail);
7873: }
7874: if ($otheremails) {
1.619 raeburn 7875: my @others;
7876: if ($otheremails =~ /,/) {
7877: @others = split(/,/,$otheremails);
1.618 raeburn 7878: } else {
1.619 raeburn 7879: push(@others,$otheremails);
7880: }
7881: foreach my $addr (@others) {
7882: if (!grep(/^\Q$addr\E$/,@recipients)) {
7883: push(@recipients,$addr);
7884: }
1.618 raeburn 7885: }
7886: }
1.619 raeburn 7887: my $recipientlist = join(',',@recipients);
1.618 raeburn 7888: return $recipientlist;
7889: }
7890:
1.127 matthew 7891: ############################################################
7892: ############################################################
1.154 albertel 7893:
1.443 albertel 7894: sub commit_customrole {
7895: my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
1.630 raeburn 7896: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 7897: ($start?', '.&mt('starting').' '.localtime($start):'').
7898: ($end?', ending '.localtime($end):'').': <b>'.
7899: &Apache::lonnet::assigncustomrole(
7900: $udom,$uname,$url,$three,$four,$five,$end,$start).
7901: '</b><br />';
7902: return $output;
7903: }
7904:
7905: sub commit_standardrole {
1.541 raeburn 7906: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
7907: my ($output,$logmsg,$linefeed);
7908: if ($context eq 'auto') {
7909: $linefeed = "\n";
7910: } else {
7911: $linefeed = "<br />\n";
7912: }
1.443 albertel 7913: if ($three eq 'st') {
1.541 raeburn 7914: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
7915: $one,$two,$sec,$context);
7916: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 7917: ($result eq 'unknown_course') || ($result eq 'refused')) {
7918: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 7919: } else {
1.541 raeburn 7920: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 7921: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7922: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7923: if ($context eq 'auto') {
7924: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
7925: } else {
7926: $output .= '<b>'.$result.'</b>'.$linefeed.
7927: &mt('Add to classlist').': <b>ok</b>';
7928: }
7929: $output .= $linefeed;
1.443 albertel 7930: }
7931: } else {
7932: $output = &mt('Assigning').' '.$three.' in '.$url.
7933: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 7934: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
7935: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);
7936: if ($context eq 'auto') {
7937: $output .= $result.$linefeed;
7938: } else {
7939: $output .= '<b>'.$result.'</b>'.$linefeed;
7940: }
1.443 albertel 7941: }
7942: return $output;
7943: }
7944:
7945: sub commit_studentrole {
1.541 raeburn 7946: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 7947: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 7948: if ($context eq 'auto') {
7949: $linefeed = "\n";
7950: } else {
7951: $linefeed = '<br />'."\n";
7952: }
1.443 albertel 7953: if (defined($one) && defined($two)) {
7954: my $cid=$one.'_'.$two;
7955: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
7956: my $secchange = 0;
7957: my $expire_role_result;
7958: my $modify_section_result;
1.628 raeburn 7959: if ($oldsec ne '-1') {
7960: if ($oldsec ne $sec) {
1.443 albertel 7961: $secchange = 1;
1.628 raeburn 7962: my $now = time;
1.443 albertel 7963: my $uurl='/'.$cid;
7964: $uurl=~s/\_/\//g;
7965: if ($oldsec) {
7966: $uurl.='/'.$oldsec;
7967: }
1.626 raeburn 7968: $oldsecurl = $uurl;
1.628 raeburn 7969: $expire_role_result =
7970: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);
7971: if ($env{'request.course.sec'} ne '') {
7972: if ($expire_role_result eq 'refused') {
7973: my @roles = ('st');
7974: my @statuses = ('previous');
7975: my @roledoms = ($one);
7976: my $withsec = 1;
7977: my %roleshash =
7978: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
7979: \@statuses,\@roles,\@roledoms,$withsec);
7980: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
7981: my ($oldstart,$oldend) =
7982: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
7983: if ($oldend > 0 && $oldend <= $now) {
7984: $expire_role_result = 'ok';
7985: }
7986: }
7987: }
7988: }
1.443 albertel 7989: $result = $expire_role_result;
7990: }
7991: }
7992: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
7993: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
7994: if ($modify_section_result =~ /^ok/) {
7995: if ($secchange == 1) {
1.628 raeburn 7996: if ($sec eq '') {
7997: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
7998: } else {
7999: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
8000: }
1.443 albertel 8001: } elsif ($oldsec eq '-1') {
1.628 raeburn 8002: if ($sec eq '') {
8003: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
8004: } else {
8005: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
8006: }
1.443 albertel 8007: } else {
1.628 raeburn 8008: if ($sec eq '') {
8009: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
8010: } else {
8011: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
8012: }
1.443 albertel 8013: }
8014: } else {
1.628 raeburn 8015: if ($secchange) {
8016: $$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;
8017: } else {
8018: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
8019: }
1.443 albertel 8020: }
8021: $result = $modify_section_result;
8022: } elsif ($secchange == 1) {
1.628 raeburn 8023: if ($oldsec eq '') {
8024: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
8025: } else {
8026: $$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;
8027: }
1.626 raeburn 8028: if ($expire_role_result eq 'refused') {
8029: my $newsecurl = '/'.$cid;
8030: $newsecurl =~ s/\_/\//g;
8031: if ($sec ne '') {
8032: $newsecurl.='/'.$sec;
8033: }
8034: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
8035: if ($sec eq '') {
8036: $$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;
8037: } else {
8038: $$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;
8039: }
8040: }
8041: }
1.443 albertel 8042: }
8043: } else {
1.626 raeburn 8044: $$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 8045: $result = "error: incomplete course id\n";
8046: }
8047: return $result;
8048: }
8049:
8050: ############################################################
8051: ############################################################
8052:
1.566 albertel 8053: sub check_clone {
1.578 raeburn 8054: my ($args,$linefeed) = @_;
1.566 albertel 8055: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
8056: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
8057: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
8058: my $clonemsg;
8059: my $can_clone = 0;
8060:
8061: if ($clonehome eq 'no_host') {
1.578 raeburn 8062: $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 8063: } else {
8064: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 8065: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 8066: $can_clone = 1;
8067: } else {
8068: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
8069: $args->{'clonedomain'},$args->{'clonecourse'});
8070: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 8071: if (grep(/^\*$/,@cloners)) {
8072: $can_clone = 1;
8073: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
8074: $can_clone = 1;
8075: } else {
8076: my %roleshash =
8077: &Apache::lonnet::get_my_roles($args->{'ccuname'},
8078: $args->{'ccdomain'},
8079: 'userroles',['active'],['cc'],
8080: [$args->{'clonedomain'}]);
8081: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
8082: $can_clone = 1;
8083: } else {
8084: $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'});
8085: }
1.566 albertel 8086: }
1.578 raeburn 8087: }
1.566 albertel 8088: }
8089: return ($can_clone, $clonemsg, $cloneid, $clonehome);
8090: }
8091:
1.444 albertel 8092: sub construct_course {
1.541 raeburn 8093: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 8094: my $outcome;
1.541 raeburn 8095: my $linefeed = '<br />'."\n";
8096: if ($context eq 'auto') {
8097: $linefeed = "\n";
8098: }
1.566 albertel 8099:
8100: #
8101: # Are we cloning?
8102: #
8103: my ($can_clone, $clonemsg, $cloneid, $clonehome);
8104: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 8105: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 8106: if ($context ne 'auto') {
1.578 raeburn 8107: if ($clonemsg ne '') {
8108: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
8109: }
1.566 albertel 8110: }
8111: $outcome .= $clonemsg.$linefeed;
8112:
8113: if (!$can_clone) {
8114: return (0,$outcome);
8115: }
8116: }
8117:
1.444 albertel 8118: #
8119: # Open course
8120: #
8121: my $crstype = lc($args->{'crstype'});
8122: my %cenv=();
8123: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
8124: $args->{'cdescr'},
8125: $args->{'curl'},
8126: $args->{'course_home'},
8127: $args->{'nonstandard'},
8128: $args->{'crscode'},
8129: $args->{'ccuname'}.':'.
8130: $args->{'ccdomain'},
8131: $args->{'crstype'});
8132:
8133: # Note: The testing routines depend on this being output; see
8134: # Utils::Course. This needs to at least be output as a comment
8135: # if anyone ever decides to not show this, and Utils::Course::new
8136: # will need to be suitably modified.
1.541 raeburn 8137: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 8138: #
8139: # Check if created correctly
8140: #
1.479 albertel 8141: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 8142: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 8143: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 8144:
1.444 albertel 8145: #
1.566 albertel 8146: # Do the cloning
8147: #
8148: if ($can_clone && $cloneid) {
8149: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
8150: if ($context ne 'auto') {
8151: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
8152: }
8153: $outcome .= $clonemsg.$linefeed;
8154: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 8155: # Copy all files
1.566 albertel 8156: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
1.444 albertel 8157: # Restore URL
1.566 albertel 8158: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 8159: # Restore title
1.566 albertel 8160: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 8161: # Mark as cloned
1.566 albertel 8162: $cenv{'clonedfrom'}=$cloneid;
1.636.2.1 raeburn 8163: # Need to clone grading mode
8164: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
8165: $cenv{'grading'}=$newenv{'grading'};
8166: # Do not clone these environment entries
8167: &Apache::lonnet::del('environment',
8168: ['default_enrollment_start_date',
8169: 'default_enrollment_end_date',
8170: 'question.email',
8171: 'policy.email',
8172: 'comment.email',
8173: 'pch.users.denied',
8174: 'plc.users.denied'],
8175: $$crsudom,$$crsunum);
1.444 albertel 8176: }
1.566 albertel 8177:
1.444 albertel 8178: #
8179: # Set environment (will override cloned, if existing)
8180: #
8181: my @sections = ();
8182: my @xlists = ();
8183: if ($args->{'crstype'}) {
8184: $cenv{'type'}=$args->{'crstype'};
8185: }
8186: if ($args->{'crsid'}) {
8187: $cenv{'courseid'}=$args->{'crsid'};
8188: }
8189: if ($args->{'crscode'}) {
8190: $cenv{'internal.coursecode'}=$args->{'crscode'};
8191: }
8192: if ($args->{'crsquota'} ne '') {
8193: $cenv{'internal.coursequota'}=$args->{'crsquota'};
8194: } else {
8195: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
8196: }
8197: if ($args->{'ccuname'}) {
8198: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
8199: ':'.$args->{'ccdomain'};
8200: } else {
8201: $cenv{'internal.courseowner'} = $args->{'curruser'};
8202: }
8203:
8204: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
8205: if ($args->{'crssections'}) {
8206: $cenv{'internal.sectionnums'} = '';
8207: if ($args->{'crssections'} =~ m/,/) {
8208: @sections = split/,/,$args->{'crssections'};
8209: } else {
8210: $sections[0] = $args->{'crssections'};
8211: }
8212: if (@sections > 0) {
8213: foreach my $item (@sections) {
8214: my ($sec,$gp) = split/:/,$item;
8215: my $class = $args->{'crscode'}.$sec;
8216: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
8217: $cenv{'internal.sectionnums'} .= $item.',';
8218: unless ($addcheck eq 'ok') {
8219: push @badclasses, $class;
8220: }
8221: }
8222: $cenv{'internal.sectionnums'} =~ s/,$//;
8223: }
8224: }
8225: # do not hide course coordinator from staff listing,
8226: # even if privileged
8227: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8228: # add crosslistings
8229: if ($args->{'crsxlist'}) {
8230: $cenv{'internal.crosslistings'}='';
8231: if ($args->{'crsxlist'} =~ m/,/) {
8232: @xlists = split/,/,$args->{'crsxlist'};
8233: } else {
8234: $xlists[0] = $args->{'crsxlist'};
8235: }
8236: if (@xlists > 0) {
8237: foreach my $item (@xlists) {
8238: my ($xl,$gp) = split/:/,$item;
8239: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
8240: $cenv{'internal.crosslistings'} .= $item.',';
8241: unless ($addcheck eq 'ok') {
8242: push @badclasses, $xl;
8243: }
8244: }
8245: $cenv{'internal.crosslistings'} =~ s/,$//;
8246: }
8247: }
8248: if ($args->{'autoadds'}) {
8249: $cenv{'internal.autoadds'}=$args->{'autoadds'};
8250: }
8251: if ($args->{'autodrops'}) {
8252: $cenv{'internal.autodrops'}=$args->{'autodrops'};
8253: }
8254: # check for notification of enrollment changes
8255: my @notified = ();
8256: if ($args->{'notify_owner'}) {
8257: if ($args->{'ccuname'} ne '') {
8258: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
8259: }
8260: }
8261: if ($args->{'notify_dc'}) {
8262: if ($uname ne '') {
1.630 raeburn 8263: push(@notified,$uname.':'.$udom);
1.444 albertel 8264: }
8265: }
8266: if (@notified > 0) {
8267: my $notifylist;
8268: if (@notified > 1) {
8269: $notifylist = join(',',@notified);
8270: } else {
8271: $notifylist = $notified[0];
8272: }
8273: $cenv{'internal.notifylist'} = $notifylist;
8274: }
8275: if (@badclasses > 0) {
8276: my %lt=&Apache::lonlocal::texthash(
8277: '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',
8278: 'dnhr' => 'does not have rights to access enrollment in these classes',
8279: 'adby' => 'as determined by the policies of your institution on access to official classlists'
8280: );
1.541 raeburn 8281: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
8282: ' ('.$lt{'adby'}.')';
8283: if ($context eq 'auto') {
8284: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 8285: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 8286: foreach my $item (@badclasses) {
8287: if ($context eq 'auto') {
8288: $outcome .= " - $item\n";
8289: } else {
8290: $outcome .= "<li>$item</li>\n";
8291: }
8292: }
8293: if ($context eq 'auto') {
8294: $outcome .= $linefeed;
8295: } else {
1.566 albertel 8296: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 8297: }
8298: }
1.444 albertel 8299: }
8300: if ($args->{'no_end_date'}) {
8301: $args->{'endaccess'} = 0;
8302: }
8303: $cenv{'internal.autostart'}=$args->{'enrollstart'};
8304: $cenv{'internal.autoend'}=$args->{'enrollend'};
8305: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
8306: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
8307: if ($args->{'showphotos'}) {
8308: $cenv{'internal.showphotos'}=$args->{'showphotos'};
8309: }
8310: $cenv{'internal.authtype'} = $args->{'authtype'};
8311: $cenv{'internal.autharg'} = $args->{'autharg'};
8312: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
8313: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 8314: 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');
8315: if ($context eq 'auto') {
8316: $outcome .= $krb_msg;
8317: } else {
1.566 albertel 8318: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 8319: }
8320: $outcome .= $linefeed;
1.444 albertel 8321: }
8322: }
8323: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
8324: if ($args->{'setpolicy'}) {
8325: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8326: }
8327: if ($args->{'setcontent'}) {
8328: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
8329: }
8330: }
8331: if ($args->{'reshome'}) {
8332: $cenv{'reshome'}=$args->{'reshome'}.'/';
8333: $cenv{'reshome'}=~s/\/+$/\//;
8334: }
8335: #
8336: # course has keyed access
8337: #
8338: if ($args->{'setkeys'}) {
8339: $cenv{'keyaccess'}='yes';
8340: }
8341: # if specified, key authority is not course, but user
8342: # only active if keyaccess is yes
8343: if ($args->{'keyauth'}) {
1.487 albertel 8344: my ($user,$domain) = split(':',$args->{'keyauth'});
8345: $user = &LONCAPA::clean_username($user);
8346: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 8347: if ($user ne '' && $domain ne '') {
1.487 albertel 8348: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 8349: }
8350: }
8351:
8352: if ($args->{'disresdis'}) {
8353: $cenv{'pch.roles.denied'}='st';
8354: }
8355: if ($args->{'disablechat'}) {
8356: $cenv{'plc.roles.denied'}='st';
8357: }
8358:
8359: # Record we've not yet viewed the Course Initialization Helper for this
8360: # course
8361: $cenv{'course.helper.not.run'} = 1;
8362: #
8363: # Use new Randomseed
8364: #
8365: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
8366: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
8367: #
8368: # The encryption code and receipt prefix for this course
8369: #
8370: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
8371: $cenv{'internal.encpref'}=100+int(9*rand(99));
8372: #
8373: # By default, use standard grading
8374: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
8375:
1.541 raeburn 8376: $outcome .= $linefeed.&mt('Setting environment').': '.
8377: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 8378: #
8379: # Open all assignments
8380: #
8381: if ($args->{'openall'}) {
8382: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
8383: my %storecontent = ($storeunder => time,
8384: $storeunder.'.type' => 'date_start');
8385:
8386: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 8387: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 8388: }
8389: #
8390: # Set first page
8391: #
8392: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
8393: || ($cloneid)) {
1.445 albertel 8394: use LONCAPA::map;
1.444 albertel 8395: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 8396:
8397: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
8398: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
8399:
1.444 albertel 8400: $outcome .= ($fatal?$errtext:'read ok').' - ';
8401: my $title; my $url;
8402: if ($args->{'firstres'} eq 'syl') {
8403: $title='Syllabus';
8404: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
8405: } else {
8406: $title='Navigate Contents';
8407: $url='/adm/navmaps';
8408: }
1.445 albertel 8409:
8410: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
8411: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
8412:
8413: if ($errtext) { $fatal=2; }
1.541 raeburn 8414: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 8415: }
1.566 albertel 8416:
8417: return (1,$outcome);
1.444 albertel 8418: }
8419:
8420: ############################################################
8421: ############################################################
8422:
1.378 raeburn 8423: sub course_type {
8424: my ($cid) = @_;
8425: if (!defined($cid)) {
8426: $cid = $env{'request.course.id'};
8427: }
1.404 albertel 8428: if (defined($env{'course.'.$cid.'.type'})) {
8429: return $env{'course.'.$cid.'.type'};
1.378 raeburn 8430: } else {
8431: return 'Course';
1.377 raeburn 8432: }
8433: }
1.156 albertel 8434:
1.406 raeburn 8435: sub group_term {
8436: my $crstype = &course_type();
8437: my %names = (
8438: 'Course' => 'group',
8439: 'Group' => 'team',
8440: );
8441: return $names{$crstype};
8442: }
8443:
1.156 albertel 8444: sub icon {
8445: my ($file)=@_;
1.505 albertel 8446: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 8447: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 8448: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 8449: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
8450: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
8451: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8452: $curfext.".gif") {
8453: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
8454: $curfext.".gif";
8455: }
8456: }
1.249 albertel 8457: return &lonhttpdurl($iconname);
1.154 albertel 8458: }
1.84 albertel 8459:
1.575 albertel 8460: sub lonhttpd_port {
1.215 albertel 8461: my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
8462: if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
1.574 albertel 8463: # IE doesn't like a secure page getting images from a non-secure
8464: # port (when logging we haven't parsed the browser type so default
8465: # back to secure
8466: if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
8467: && $ENV{'SERVER_PORT'} == 443) {
1.575 albertel 8468: return 443;
8469: }
8470: return $lonhttpd_port;
8471:
8472: }
8473:
8474: sub lonhttpdurl {
8475: my ($url)=@_;
8476:
8477: my $lonhttpd_port = &lonhttpd_port();
8478: if ($lonhttpd_port == 443) {
1.574 albertel 8479: return 'https://'.$ENV{'SERVER_NAME'}.$url;
8480: }
1.215 albertel 8481: return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
8482: }
8483:
1.213 albertel 8484: sub connection_aborted {
8485: my ($r)=@_;
8486: $r->print(" ");$r->rflush();
8487: my $c = $r->connection;
8488: return $c->aborted();
8489: }
8490:
1.221 foxr 8491: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 8492: # strings as 'strings'.
8493: sub escape_single {
1.221 foxr 8494: my ($input) = @_;
1.223 albertel 8495: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 8496: $input =~ s/\'/\\\'/g; # Esacpe the 's....
8497: return $input;
8498: }
1.223 albertel 8499:
1.222 foxr 8500: # Same as escape_single, but escape's "'s This
8501: # can be used for "strings"
8502: sub escape_double {
8503: my ($input) = @_;
8504: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
8505: $input =~ s/\"/\\\"/g; # Esacpe the "s....
8506: return $input;
8507: }
1.223 albertel 8508:
1.222 foxr 8509: # Escapes the last element of a full URL.
8510: sub escape_url {
8511: my ($url) = @_;
1.238 raeburn 8512: my @urlslices = split(/\//, $url,-1);
1.369 www 8513: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 8514: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 8515: }
1.462 albertel 8516:
8517: # -------------------------------------------------------- Initliaze user login
8518: sub init_user_environment {
1.463 albertel 8519: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 8520: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
8521:
8522: my $public=($username eq 'public' && $domain eq 'public');
8523:
8524: # See if old ID present, if so, remove
8525:
8526: my ($filename,$cookie,$userroles);
8527: my $now=time;
8528:
8529: if ($public) {
8530: my $max_public=100;
8531: my $oldest;
8532: my $oldest_time=0;
8533: for(my $next=1;$next<=$max_public;$next++) {
8534: if (-e $lonids."/publicuser_$next.id") {
8535: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
8536: if ($mtime<$oldest_time || !$oldest_time) {
8537: $oldest_time=$mtime;
8538: $oldest=$next;
8539: }
8540: } else {
8541: $cookie="publicuser_$next";
8542: last;
8543: }
8544: }
8545: if (!$cookie) { $cookie="publicuser_$oldest"; }
8546: } else {
1.463 albertel 8547: # if this isn't a robot, kill any existing non-robot sessions
8548: if (!$args->{'robot'}) {
8549: opendir(DIR,$lonids);
8550: while ($filename=readdir(DIR)) {
8551: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
8552: unlink($lonids.'/'.$filename);
8553: }
1.462 albertel 8554: }
1.463 albertel 8555: closedir(DIR);
1.462 albertel 8556: }
8557: # Give them a new cookie
1.463 albertel 8558: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
8559: : $now);
8560: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 8561:
8562: # Initialize roles
8563:
8564: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
8565: }
8566: # ------------------------------------ Check browser type and MathML capability
8567:
8568: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
8569: $clientunicode,$clientos) = &decode_user_agent($r);
8570:
8571: # -------------------------------------- Any accessibility options to remember?
8572: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
8573: foreach my $option ('imagesuppress','appletsuppress',
8574: 'embedsuppress','fontenhance','blackwhite') {
8575: if ($form->{$option} eq 'true') {
8576: &Apache::lonnet::put('environment',{$option => 'on'},
8577: $domain,$username);
8578: } else {
8579: &Apache::lonnet::del('environment',[$option],
8580: $domain,$username);
8581: }
8582: }
8583: }
8584: # ------------------------------------------------------------- Get environment
8585:
8586: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
8587: my ($tmp) = keys(%userenv);
8588: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8589: # default remote control to off
8590: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
8591: } else {
8592: undef(%userenv);
8593: }
8594: if (($userenv{'interface'}) && (!$form->{'interface'})) {
8595: $form->{'interface'}=$userenv{'interface'};
8596: }
8597: $env{'environment.remote'}=$userenv{'remote'};
8598: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
8599:
8600: # --------------- Do not trust query string to be put directly into environment
8601: foreach my $option ('imagesuppress','appletsuppress',
8602: 'embedsuppress','fontenhance','blackwhite',
8603: 'interface','localpath','localres') {
8604: $form->{$option}=~s/[\n\r\=]//gs;
8605: }
8606: # --------------------------------------------------------- Write first profile
8607:
8608: {
8609: my %initial_env =
8610: ("user.name" => $username,
8611: "user.domain" => $domain,
8612: "user.home" => $authhost,
8613: "browser.type" => $clientbrowser,
8614: "browser.version" => $clientversion,
8615: "browser.mathml" => $clientmathml,
8616: "browser.unicode" => $clientunicode,
8617: "browser.os" => $clientos,
8618: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
8619: "request.course.fn" => '',
8620: "request.course.uri" => '',
8621: "request.course.sec" => '',
8622: "request.role" => 'cm',
8623: "request.role.adv" => $env{'user.adv'},
8624: "request.host" => $ENV{'REMOTE_ADDR'},);
8625:
8626: if ($form->{'localpath'}) {
8627: $initial_env{"browser.localpath"} = $form->{'localpath'};
8628: $initial_env{"browser.localres"} = $form->{'localres'};
8629: }
8630:
8631: if ($public) {
8632: $initial_env{"environment.remote"} = "off";
8633: }
8634: if ($form->{'interface'}) {
8635: $form->{'interface'}=~s/\W//gs;
8636: $initial_env{"browser.interface"} = $form->{'interface'};
8637: $env{'browser.interface'}=$form->{'interface'};
8638: foreach my $option ('imagesuppress','appletsuppress',
8639: 'embedsuppress','fontenhance','blackwhite') {
8640: if (($form->{$option} eq 'true') ||
8641: ($userenv{$option} eq 'on')) {
8642: $initial_env{"browser.$option"} = "on";
8643: }
8644: }
8645: }
8646:
8647: $env{'user.environment'} = "$lonids/$cookie.id";
8648:
8649: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
8650: &GDBM_WRCREAT(),0640)) {
8651: &_add_to_env(\%disk_env,\%initial_env);
8652: &_add_to_env(\%disk_env,\%userenv,'environment.');
8653: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 8654: if (ref($args->{'extra_env'})) {
8655: &_add_to_env(\%disk_env,$args->{'extra_env'});
8656: }
1.462 albertel 8657: untie(%disk_env);
8658: } else {
8659: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
8660: 'Could not create environment storage in lonauth: '.$!.'</font>');
8661: return 'error: '.$!;
8662: }
8663: }
8664: $env{'request.role'}='cm';
8665: $env{'request.role.adv'}=$env{'user.adv'};
8666: $env{'browser.type'}=$clientbrowser;
8667:
8668: return $cookie;
8669:
8670: }
8671:
8672: sub _add_to_env {
8673: my ($idf,$env_data,$prefix) = @_;
8674: while (my ($key,$value) = each(%$env_data)) {
8675: $idf->{$prefix.$key} = $value;
8676: $env{$prefix.$key} = $value;
8677: }
8678: }
8679:
8680:
1.41 ng 8681: =pod
8682:
8683: =back
8684:
1.112 bowersj2 8685: =cut
1.41 ng 8686:
1.112 bowersj2 8687: 1;
8688: __END__;
1.41 ng 8689:
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