Annotation of loncom/interface/loncommon.pm, revision 1.692.4.4
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.692.4.4! raeburn 4: # $Id: loncommon.pm,v 1.692.4.3 2009/05/21 15:43:52 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.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.479 albertel 70: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 71: use DateTime::TimeZone;
1.687 raeburn 72: use DateTime::Locale::Catalog;
1.117 www 73:
1.517 raeburn 74: # ---------------------------------------------- Designs
75: use vars qw(%defaultdesign);
76:
1.22 www 77: my $readit;
78:
1.517 raeburn 79:
1.157 matthew 80: ##
81: ## Global Variables
82: ##
1.46 matthew 83:
1.643 foxr 84:
85: # ----------------------------------------------- SSI with retries:
86: #
87:
88: =pod
89:
1.648 raeburn 90: =head1 Server Side include with retries:
1.643 foxr 91:
92: =over 4
93:
1.648 raeburn 94: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 95:
96: Performs an ssi with some number of retries. Retries continue either
97: until the result is ok or until the retry count supplied by the
98: caller is exhausted.
99:
100: Inputs:
1.648 raeburn 101:
102: =over 4
103:
1.643 foxr 104: resource - Identifies the resource to insert.
1.648 raeburn 105:
1.643 foxr 106: retries - Count of the number of retries allowed.
1.648 raeburn 107:
1.643 foxr 108: form - Hash that identifies the rendering options.
109:
1.648 raeburn 110: =back
111:
112: Returns:
113:
114: =over 4
115:
1.643 foxr 116: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 117:
1.643 foxr 118: response - The response from the last attempt (which may or may not have been successful.
119:
1.648 raeburn 120: =back
121:
122: =back
123:
1.643 foxr 124: =cut
125:
126: sub ssi_with_retries {
127: my ($resource, $retries, %form) = @_;
128:
129:
130: my $ok = 0; # True if we got a good response.
131: my $content;
132: my $response;
133:
134: # Try to get the ssi done. within the retries count:
135:
136: do {
137: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
138: $ok = $response->is_success;
1.650 www 139: if (!$ok) {
140: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
141: }
1.643 foxr 142: $retries--;
143: } while (!$ok && ($retries > 0));
144:
145: if (!$ok) {
146: $content = ''; # On error return an empty content.
147: }
148: return ($content, $response);
149:
150: }
151:
152:
153:
1.20 www 154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 155: my %language;
1.124 www 156: my %supported_language;
1.12 harris41 157: my %cprtag;
1.192 taceyjo1 158: my %scprtag;
1.351 www 159: my %fe; my %fd; my %fm;
1.41 ng 160: my %category_extensions;
1.12 harris41 161:
1.46 matthew 162: # ---------------------------------------------- Thesaurus variables
1.144 matthew 163: #
164: # %Keywords:
165: # A hash used by &keyword to determine if a word is considered a keyword.
166: # $thesaurus_db_file
167: # Scalar containing the full path to the thesaurus database.
1.46 matthew 168:
169: my %Keywords;
170: my $thesaurus_db_file;
171:
1.144 matthew 172: #
173: # Initialize values from language.tab, copyright.tab, filetypes.tab,
174: # thesaurus.tab, and filecategories.tab.
175: #
1.18 www 176: BEGIN {
1.46 matthew 177: # Variable initialization
178: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
179: #
1.22 www 180: unless ($readit) {
1.12 harris41 181: # ------------------------------------------------------------------- languages
182: {
1.158 raeburn 183: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
184: '/language.tab';
185: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 186: while (my $line = <$fh>) {
187: next if ($line=~/^\#/);
188: chomp($line);
189: my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
1.158 raeburn 190: $language{$key}=$val.' - '.$enc;
191: if ($sup) {
192: $supported_language{$key}=$sup;
193: }
194: }
195: close($fh);
196: }
1.12 harris41 197: }
198: # ------------------------------------------------------------------ copyrights
199: {
1.158 raeburn 200: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
201: '/copyright.tab';
202: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 203: while (my $line = <$fh>) {
204: next if ($line=~/^\#/);
205: chomp($line);
206: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 207: $cprtag{$key}=$val;
208: }
209: close($fh);
210: }
1.12 harris41 211: }
1.351 www 212: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 213: {
214: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
215: '/source_copyright.tab';
216: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 217: while (my $line = <$fh>) {
218: next if ($line =~ /^\#/);
219: chomp($line);
220: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 221: $scprtag{$key}=$val;
222: }
223: close($fh);
224: }
225: }
1.63 www 226:
1.517 raeburn 227: # -------------------------------------------------------------- default domain designs
1.63 www 228: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 229: my $designfile = $designdir.'/default.tab';
230: if ( open (my $fh,"<$designfile") ) {
231: while (my $line = <$fh>) {
232: next if ($line =~ /^\#/);
233: chomp($line);
234: my ($key,$val)=(split(/\=/,$line));
235: if ($val) { $defaultdesign{$key}=$val; }
236: }
237: close($fh);
1.63 www 238: }
239:
1.15 harris41 240: # ------------------------------------------------------------- file categories
241: {
1.158 raeburn 242: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
243: '/filecategories.tab';
244: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 245: while (my $line = <$fh>) {
246: next if ($line =~ /^\#/);
247: chomp($line);
248: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 249: push @{$category_extensions{lc($category)}},$extension;
250: }
251: close($fh);
252: }
253:
1.15 harris41 254: }
1.12 harris41 255: # ------------------------------------------------------------------ file types
256: {
1.158 raeburn 257: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
258: '/filetypes.tab';
259: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 260: while (my $line = <$fh>) {
261: next if ($line =~ /^\#/);
262: chomp($line);
263: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 264: if ($descr ne '') {
265: $fe{$ending}=lc($emb);
266: $fd{$ending}=$descr;
1.351 www 267: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 268: }
269: }
270: close($fh);
271: }
1.12 harris41 272: }
1.22 www 273: &Apache::lonnet::logthis(
1.46 matthew 274: "<font color=yellow>INFO: Read file types</font>");
1.22 www 275: $readit=1;
1.46 matthew 276: } # end of unless($readit)
1.32 matthew 277:
278: }
1.112 bowersj2 279:
1.42 matthew 280: ###############################################################
281: ## HTML and Javascript Helper Functions ##
282: ###############################################################
283:
284: =pod
285:
1.112 bowersj2 286: =head1 HTML and Javascript Functions
1.42 matthew 287:
1.112 bowersj2 288: =over 4
289:
1.648 raeburn 290: =item * &browser_and_searcher_javascript()
1.112 bowersj2 291:
292: X<browsing, javascript>X<searching, javascript>Returns a string
293: containing javascript with two functions, C<openbrowser> and
294: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
295: tags.
1.42 matthew 296:
1.648 raeburn 297: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 298:
299: inputs: formname, elementname, only, omit
300:
301: formname and elementname indicate the name of the html form and name of
302: the element that the results of the browsing selection are to be placed in.
303:
304: Specifying 'only' will restrict the browser to displaying only files
1.185 www 305: with the given extension. Can be a comma separated list.
1.42 matthew 306:
307: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 308: with the given extension. Can be a comma separated list.
1.42 matthew 309:
1.648 raeburn 310: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 311:
312: Inputs: formname, elementname
313:
314: formname and elementname specify the name of the html form and the name
315: of the element the selection from the search results will be placed in.
1.542 raeburn 316:
1.42 matthew 317: =cut
318:
319: sub browser_and_searcher_javascript {
1.199 albertel 320: my ($mode)=@_;
321: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 322: my $resurl=&escape_single(&lastresurl());
1.42 matthew 323: return <<END;
1.219 albertel 324: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 325: var editbrowser = null;
1.135 albertel 326: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 327: var url = '$resurl/?';
1.42 matthew 328: if (editbrowser == null) {
329: url += 'launch=1&';
330: }
331: url += 'catalogmode=interactive&';
1.199 albertel 332: url += 'mode=$mode&';
1.611 albertel 333: url += 'inhibitmenu=yes&';
1.42 matthew 334: url += 'form=' + formname + '&';
335: if (only != null) {
336: url += 'only=' + only + '&';
1.217 albertel 337: } else {
338: url += 'only=&';
339: }
1.42 matthew 340: if (omit != null) {
341: url += 'omit=' + omit + '&';
1.217 albertel 342: } else {
343: url += 'omit=&';
344: }
1.135 albertel 345: if (titleelement != null) {
346: url += 'titleelement=' + titleelement + '&';
1.217 albertel 347: } else {
348: url += 'titleelement=&';
349: }
1.42 matthew 350: url += 'element=' + elementname + '';
351: var title = 'Browser';
1.435 albertel 352: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 353: options += ',width=700,height=600';
354: editbrowser = open(url,title,options,'1');
355: editbrowser.focus();
356: }
357: var editsearcher;
1.135 albertel 358: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 359: var url = '/adm/searchcat?';
360: if (editsearcher == null) {
361: url += 'launch=1&';
362: }
363: url += 'catalogmode=interactive&';
1.199 albertel 364: url += 'mode=$mode&';
1.42 matthew 365: url += 'form=' + formname + '&';
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Search';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editsearcher = open(url,title,options,'1');
376: editsearcher.focus();
377: }
1.219 albertel 378: // END LON-CAPA Internal -->
1.42 matthew 379: END
1.170 www 380: }
381:
382: sub lastresurl {
1.258 albertel 383: if ($env{'environment.lastresurl'}) {
384: return $env{'environment.lastresurl'}
1.170 www 385: } else {
386: return '/res';
387: }
388: }
389:
390: sub storeresurl {
391: my $resurl=&Apache::lonnet::clutter(shift);
392: unless ($resurl=~/^\/res/) { return 0; }
393: $resurl=~s/\/$//;
394: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 395: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 396: return 1;
1.42 matthew 397: }
398:
1.74 www 399: sub studentbrowser_javascript {
1.111 www 400: unless (
1.258 albertel 401: (($env{'request.course.id'}) &&
1.302 albertel 402: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
403: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
404: '/'.$env{'request.course.sec'})
405: ))
1.258 albertel 406: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 407: ) { return ''; }
1.74 www 408: return (<<'ENDSTDBRW');
1.692.4.2 raeburn 409: <script type="text/javascript" language="Javascript">
1.692.4.4! raeburn 410: // <![CDATA[
1.74 www 411: var stdeditbrowser;
1.692.4.2 raeburn 412: function openstdbrowser(formname,uname,udom,roleflag,ignorefilter,courseadvonly) {
1.74 www 413: var url = '/adm/pickstudent?';
414: var filter;
1.558 albertel 415: if (!ignorefilter) {
416: eval('filter=document.'+formname+'.'+uname+'.value;');
417: }
1.74 www 418: if (filter != null) {
419: if (filter != '') {
420: url += 'filter='+filter+'&';
421: }
422: }
423: url += 'form=' + formname + '&unameelement='+uname+
424: '&udomelement='+udom;
1.111 www 425: if (roleflag) { url+="&roles=1"; }
1.692.4.2 raeburn 426: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 427: var title = 'Student_Browser';
1.74 www 428: var options = 'scrollbars=1,resizable=1,menubar=0';
429: options += ',width=700,height=600';
430: stdeditbrowser = open(url,title,options,'1');
431: stdeditbrowser.focus();
432: }
1.692.4.4! raeburn 433: // ]]>
1.74 www 434: </script>
435: ENDSTDBRW
436: }
1.42 matthew 437:
1.74 www 438: sub selectstudent_link {
1.692.4.2 raeburn 439: my ($form,$unameele,$udomele,$courseadvonly)=@_;
440: my $callargs = "'".$form."','".$unameele."','".$udomele."'";
1.258 albertel 441: if ($env{'request.course.id'}) {
1.302 albertel 442: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
443: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
444: '/'.$env{'request.course.sec'})) {
1.111 www 445: return '';
446: }
1.692.4.2 raeburn 447: if ($courseadvonly) {
448: $callargs .= ",'',1,1";
449: }
450: return '<span class="LC_nobreak">'.
451: '<a href="javascript:openstdbrowser('.$callargs.');">'.
452: &mt('Select User').'</a></span>';
1.74 www 453: }
1.258 albertel 454: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.692.4.2 raeburn 455: $callargs .= ",1";
456: return '<span class="LC_nobreak">'.
457: '<a href="javascript:openstdbrowser('.$callargs.');">'.
458: &mt('Select User').'</a></span>';
1.111 www 459: }
460: return '';
1.91 www 461: }
462:
1.653 raeburn 463: sub authorbrowser_javascript {
464: return <<"ENDAUTHORBRW";
465: <script type="text/javascript">
1.692.4.4! raeburn 466: // <![CDATA[
1.653 raeburn 467: var stdeditbrowser;
468:
469: function openauthorbrowser(formname,udom) {
470: var url = '/adm/pickauthor?';
471: url += 'form='+formname+'&roledom='+udom;
472: var title = 'Author_Browser';
473: var options = 'scrollbars=1,resizable=1,menubar=0';
474: options += ',width=700,height=600';
475: stdeditbrowser = open(url,title,options,'1');
476: stdeditbrowser.focus();
477: }
1.692.4.4! raeburn 478: // ]]>
1.653 raeburn 479: </script>
480: ENDAUTHORBRW
481: }
482:
1.91 www 483: sub coursebrowser_javascript {
1.468 raeburn 484: my ($domainfilter,$sec_element,$formname)=@_;
1.377 raeburn 485: 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 486: my $output = '
1.692.4.2 raeburn 487: <script type="text/javascript" language="JavaScript">
1.692.4.4! raeburn 488: // <![CDATA[
1.468 raeburn 489: var stdeditbrowser;'."\n";
490: $output .= <<"ENDSTDBRW";
1.377 raeburn 491: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91 www 492: var url = '/adm/pickcourse?';
1.468 raeburn 493: var domainfilter = '';
494: var formid = getFormIdByName(formname);
495: if (formid > -1) {
496: var domid = getIndexByName(formid,udom);
497: if (domid > -1) {
498: if (document.forms[formid].elements[domid].type == 'select-one') {
499: domainfilter=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
500: }
501: if (document.forms[formid].elements[domid].type == 'hidden') {
502: domainfilter=document.forms[formid].elements[domid].value;
503: }
504: }
1.91 www 505: }
1.128 albertel 506: if (domainfilter != null) {
507: if (domainfilter != '') {
508: url += 'domainfilter='+domainfilter+'&';
509: }
510: }
1.91 www 511: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 512: '&cdomelement='+udom+
513: '&cnameelement='+desc;
1.468 raeburn 514: if (extra_element !=null && extra_element != '') {
1.594 raeburn 515: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 516: url += '&roleelement='+extra_element;
517: if (domainfilter == null || domainfilter == '') {
518: url += '&domainfilter='+extra_element;
519: }
1.234 raeburn 520: }
1.468 raeburn 521: else {
522: if (formname == 'portform') {
523: url += '&setroles='+extra_element;
524: }
525: }
1.230 raeburn 526: }
1.293 raeburn 527: if (multflag !=null && multflag != '') {
528: url += '&multiple='+multflag;
529: }
1.377 raeburn 530: if (crstype == 'Course/Group') {
531: if (formname == 'cu') {
532: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
533: if (crstype == "") {
534: alert("$crs_or_grp_alert");
535: return;
536: }
537: }
538: }
539: if (crstype !=null && crstype != '') {
540: url += '&type='+crstype;
541: }
1.102 www 542: var title = 'Course_Browser';
1.91 www 543: var options = 'scrollbars=1,resizable=1,menubar=0';
544: options += ',width=700,height=600';
545: stdeditbrowser = open(url,title,options,'1');
546: stdeditbrowser.focus();
547: }
1.468 raeburn 548:
549: function getFormIdByName(formname) {
550: for (var i=0;i<document.forms.length;i++) {
551: if (document.forms[i].name == formname) {
552: return i;
553: }
554: }
555: return -1;
556: }
557:
558: function getIndexByName(formid,item) {
559: for (var i=0;i<document.forms[formid].elements.length;i++) {
560: if (document.forms[formid].elements[i].name == item) {
561: return i;
562: }
563: }
564: return -1;
565: }
1.91 www 566: ENDSTDBRW
1.468 raeburn 567: if ($sec_element ne '') {
568: $output .= &setsec_javascript($sec_element,$formname);
569: }
570: $output .= '
1.692.4.4! raeburn 571: // ]]>
1.468 raeburn 572: </script>';
573: return $output;
574: }
575:
576: sub setsec_javascript {
577: my ($sec_element,$formname) = @_;
578: my $setsections = qq|
579: function setSect(sectionlist) {
1.629 raeburn 580: var sectionsArray = new Array();
581: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
582: sectionsArray = sectionlist.split(",");
583: }
1.468 raeburn 584: var numSections = sectionsArray.length;
585: document.$formname.$sec_element.length = 0;
586: if (numSections == 0) {
587: document.$formname.$sec_element.multiple=false;
588: document.$formname.$sec_element.size=1;
589: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
590: } else {
591: if (numSections == 1) {
592: document.$formname.$sec_element.multiple=false;
593: document.$formname.$sec_element.size=1;
594: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
595: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
596: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
597: } else {
598: for (var i=0; i<numSections; i++) {
599: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
600: }
601: document.$formname.$sec_element.multiple=true
602: if (numSections < 3) {
603: document.$formname.$sec_element.size=numSections;
604: } else {
605: document.$formname.$sec_element.size=3;
606: }
607: document.$formname.$sec_element.options[0].selected = false
608: }
609: }
1.91 www 610: }
1.468 raeburn 611: |;
612: return $setsections;
613: }
614:
1.91 www 615:
616: sub selectcourse_link {
1.377 raeburn 617: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.692.4.2 raeburn 618: return '<span class="LC_nobreak">'
619: ."<a href='"
620: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
621: .'","'.$udomele.'","'.$desc.'","'.$extra_element
622: .'","'.$multflag.'","'.$selecttype.'");'
623: ."'>".&mt('Select Course').'</a>'
624: .'</span>';
1.74 www 625: }
1.42 matthew 626:
1.653 raeburn 627: sub selectauthor_link {
628: my ($form,$udom)=@_;
629: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
630: &mt('Select Author').'</a>';
631: }
632:
1.273 raeburn 633: sub check_uncheck_jscript {
634: my $jscript = <<"ENDSCRT";
635: function checkAll(field) {
636: if (field.length > 0) {
637: for (i = 0; i < field.length; i++) {
638: field[i].checked = true ;
639: }
640: } else {
641: field.checked = true
642: }
643: }
644:
645: function uncheckAll(field) {
646: if (field.length > 0) {
647: for (i = 0; i < field.length; i++) {
648: field[i].checked = false ;
1.543 albertel 649: }
650: } else {
1.273 raeburn 651: field.checked = false ;
652: }
653: }
654: ENDSCRT
655: return $jscript;
656: }
657:
1.656 www 658: sub select_timezone {
1.659 raeburn 659: my ($name,$selected,$onchange,$includeempty)=@_;
660: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
661: if ($includeempty) {
662: $output .= '<option value=""';
663: if (($selected eq '') || ($selected eq 'local')) {
664: $output .= ' selected="selected" ';
665: }
666: $output .= '> </option>';
667: }
1.657 raeburn 668: my @timezones = DateTime::TimeZone->all_names;
669: foreach my $tzone (@timezones) {
670: $output.= '<option value="'.$tzone.'"';
671: if ($tzone eq $selected) {
672: $output.=' selected="selected"';
673: }
674: $output.=">$tzone</option>\n";
1.656 www 675: }
676: $output.="</select>";
677: return $output;
678: }
1.273 raeburn 679:
1.687 raeburn 680: sub select_datelocale {
681: my ($name,$selected,$onchange,$includeempty)=@_;
682: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
683: if ($includeempty) {
684: $output .= '<option value=""';
685: if ($selected eq '') {
686: $output .= ' selected="selected" ';
687: }
688: $output .= '> </option>';
689: }
690: my (@possibles,%locale_names);
691: my @locales = DateTime::Locale::Catalog::Locales;
692: foreach my $locale (@locales) {
693: if (ref($locale) eq 'HASH') {
694: my $id = $locale->{'id'};
695: if ($id ne '') {
696: my $en_terr = $locale->{'en_territory'};
697: my $native_terr = $locale->{'native_territory'};
1.692.4.1 raeburn 698: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 699: if (grep(/^en$/,@languages) || !@languages) {
700: if ($en_terr ne '') {
701: $locale_names{$id} = '('.$en_terr.')';
702: } elsif ($native_terr ne '') {
703: $locale_names{$id} = $native_terr;
704: }
705: } else {
706: if ($native_terr ne '') {
707: $locale_names{$id} = $native_terr.' ';
708: } elsif ($en_terr ne '') {
709: $locale_names{$id} = '('.$en_terr.')';
710: }
711: }
712: push (@possibles,$id);
713: }
714: }
715: }
716: foreach my $item (sort(@possibles)) {
717: $output.= '<option value="'.$item.'"';
718: if ($item eq $selected) {
719: $output.=' selected="selected"';
720: }
721: $output.=">$item";
722: if ($locale_names{$item} ne '') {
723: $output.=" $locale_names{$item}</option>\n";
724: }
725: $output.="</option>\n";
726: }
727: $output.="</select>";
728: return $output;
729: }
730:
1.692.4.2 raeburn 731: sub select_language {
732: my ($name,$selected,$includeempty) = @_;
733: my %langchoices;
734: if ($includeempty) {
735: %langchoices = ('' => 'No language preference');
736: }
737: foreach my $id (&languageids()) {
738: my $code = &supportedlanguagecode($id);
739: if ($code) {
740: $langchoices{$code} = &plainlanguagedescription($id);
741: }
742: }
743: return &select_form($selected,$name,%langchoices);
744: }
745:
1.42 matthew 746: =pod
1.36 matthew 747:
1.648 raeburn 748: =item * &linked_select_forms(...)
1.36 matthew 749:
750: linked_select_forms returns a string containing a <script></script> block
751: and html for two <select> menus. The select menus will be linked in that
752: changing the value of the first menu will result in new values being placed
753: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 754: order unless a defined order is provided.
1.36 matthew 755:
756: linked_select_forms takes the following ordered inputs:
757:
758: =over 4
759:
1.112 bowersj2 760: =item * $formname, the name of the <form> tag
1.36 matthew 761:
1.112 bowersj2 762: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 763:
1.112 bowersj2 764: =item * $firstdefault, the default value for the first menu
1.36 matthew 765:
1.112 bowersj2 766: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 767:
1.112 bowersj2 768: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 769:
1.112 bowersj2 770: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 771:
1.609 raeburn 772: =item * $menuorder, the order of values in the first menu
773:
1.41 ng 774: =back
775:
1.36 matthew 776: Below is an example of such a hash. Only the 'text', 'default', and
777: 'select2' keys must appear as stated. keys(%menu) are the possible
778: values for the first select menu. The text that coincides with the
1.41 ng 779: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 780: and text for the second menu are given in the hash pointed to by
781: $menu{$choice1}->{'select2'}.
782:
1.112 bowersj2 783: my %menu = ( A1 => { text =>"Choice A1" ,
784: default => "B3",
785: select2 => {
786: B1 => "Choice B1",
787: B2 => "Choice B2",
788: B3 => "Choice B3",
789: B4 => "Choice B4"
1.609 raeburn 790: },
791: order => ['B4','B3','B1','B2'],
1.112 bowersj2 792: },
793: A2 => { text =>"Choice A2" ,
794: default => "C2",
795: select2 => {
796: C1 => "Choice C1",
797: C2 => "Choice C2",
798: C3 => "Choice C3"
1.609 raeburn 799: },
800: order => ['C2','C1','C3'],
1.112 bowersj2 801: },
802: A3 => { text =>"Choice A3" ,
803: default => "D6",
804: select2 => {
805: D1 => "Choice D1",
806: D2 => "Choice D2",
807: D3 => "Choice D3",
808: D4 => "Choice D4",
809: D5 => "Choice D5",
810: D6 => "Choice D6",
811: D7 => "Choice D7"
1.609 raeburn 812: },
813: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 814: }
815: );
1.36 matthew 816:
817: =cut
818:
819: sub linked_select_forms {
820: my ($formname,
821: $middletext,
822: $firstdefault,
823: $firstselectname,
824: $secondselectname,
1.609 raeburn 825: $hashref,
826: $menuorder,
1.36 matthew 827: ) = @_;
828: my $second = "document.$formname.$secondselectname";
829: my $first = "document.$formname.$firstselectname";
830: # output the javascript to do the changing
831: my $result = '';
1.692.4.2 raeburn 832: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.692.4.4! raeburn 833: $result.="// <![CDATA[\n";
1.36 matthew 834: $result.="var select2data = new Object();\n";
835: $" = '","';
836: my $debug = '';
837: foreach my $s1 (sort(keys(%$hashref))) {
838: $result.="select2data.d_$s1 = new Object();\n";
839: $result.="select2data.d_$s1.def = new String('".
840: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 841: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 842: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 843: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
844: @s2values = @{$hashref->{$s1}->{'order'}};
845: }
1.36 matthew 846: $result.="\"@s2values\");\n";
847: $result.="select2data.d_$s1.texts = new Array(";
848: my @s2texts;
849: foreach my $value (@s2values) {
850: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
851: }
852: $result.="\"@s2texts\");\n";
853: }
854: $"=' ';
855: $result.= <<"END";
856:
857: function select1_changed() {
858: // Determine new choice
859: var newvalue = "d_" + $first.value;
860: // update select2
861: var values = select2data[newvalue].values;
862: var texts = select2data[newvalue].texts;
863: var select2def = select2data[newvalue].def;
864: var i;
865: // out with the old
866: for (i = 0; i < $second.options.length; i++) {
867: $second.options[i] = null;
868: }
869: // in with the nuclear
870: for (i=0;i<values.length; i++) {
871: $second.options[i] = new Option(values[i]);
1.143 matthew 872: $second.options[i].value = values[i];
1.36 matthew 873: $second.options[i].text = texts[i];
874: if (values[i] == select2def) {
875: $second.options[i].selected = true;
876: }
877: }
878: }
1.692.4.4! raeburn 879: // ]]>
1.36 matthew 880: </script>
881: END
882: # output the initial values for the selection lists
883: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 884: my @order = sort(keys(%{$hashref}));
885: if (ref($menuorder) eq 'ARRAY') {
886: @order = @{$menuorder};
887: }
888: foreach my $value (@order) {
1.36 matthew 889: $result.=" <option value=\"$value\" ";
1.253 albertel 890: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 891: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 892: }
893: $result .= "</select>\n";
894: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
895: $result .= $middletext;
896: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
897: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 898:
899: my @secondorder = sort(keys(%select2));
900: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
901: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
902: }
903: foreach my $value (@secondorder) {
1.36 matthew 904: $result.=" <option value=\"$value\" ";
1.253 albertel 905: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 906: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 907: }
908: $result .= "</select>\n";
909: # return $debug;
910: return $result;
911: } # end of sub linked_select_forms {
912:
1.45 matthew 913: =pod
1.44 bowersj2 914:
1.648 raeburn 915: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44 bowersj2 916:
1.112 bowersj2 917: Returns a string corresponding to an HTML link to the given help
918: $topic, where $topic corresponds to the name of a .tex file in
919: /home/httpd/html/adm/help/tex, with underscores replaced by
920: spaces.
921:
922: $text will optionally be linked to the same topic, allowing you to
923: link text in addition to the graphic. If you do not want to link
924: text, but wish to specify one of the later parameters, pass an
925: empty string.
926:
927: $stayOnPage is a value that will be interpreted as a boolean. If true,
928: the link will not open a new window. If false, the link will open
929: a new window using Javascript. (Default is false.)
930:
931: $width and $height are optional numerical parameters that will
932: override the width and height of the popped up window, which may
933: be useful for certain help topics with big pictures included.
1.44 bowersj2 934:
935: =cut
936:
937: sub help_open_topic {
1.48 bowersj2 938: my ($topic, $text, $stayOnPage, $width, $height) = @_;
939: $text = "" if (not defined $text);
1.44 bowersj2 940: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 941: if ($env{'browser.interface'} eq 'textual') {
1.79 www 942: $stayOnPage=1;
943: }
1.44 bowersj2 944: $width = 350 if (not defined $width);
945: $height = 400 if (not defined $height);
946: my $filename = $topic;
947: $filename =~ s/ /_/g;
948:
1.48 bowersj2 949: my $template = "";
950: my $link;
1.572 banghart 951:
1.159 www 952: $topic=~s/\W/\_/g;
1.44 bowersj2 953:
1.572 banghart 954: if (!$stayOnPage) {
1.72 bowersj2 955: $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 956: } else {
1.48 bowersj2 957: $link = "/adm/help/${filename}.hlp";
958: }
959:
960: # Add the text
1.572 banghart 961: if ($text ne "") {
1.77 www 962: $template .=
1.572 banghart 963: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.691 bisitz 964: "<td bgcolor='#5555FF'><span class=\"LC_nobreak\"><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 965: }
966:
967: # Add the graphic
1.179 matthew 968: my $title = &mt('Online Help');
1.667 raeburn 969: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.692.4.2 raeburn 970: $template .= '<a target="_top" href="'.$link.'" title="'.$title.'">'.
971: '<img src="'.$helpicon.'" border="0" alt="'.&mt('Help: [_1]',$topic).
972: '" title="'.$title.'" /></a>';
973: if ($text ne '') {
974: $template.='</span></td></tr></table>';
975: }
1.44 bowersj2 976: return $template;
977:
1.106 bowersj2 978: }
979:
980: # This is a quicky function for Latex cheatsheet editing, since it
981: # appears in at least four places
982: sub helpLatexCheatsheet {
1.692.4.2 raeburn 983: my ($topic,$text,$not_author) = @_;
984: my $out;
1.106 bowersj2 985: my $addOther = '';
1.692.4.3 raeburn 986: if ($topic) {
1.692.4.2 raeburn 987: $addOther = &Apache::loncommon::help_open_topic($topic,$text,
1.106 bowersj2 988: undef, undef, 600) .
989: '</td><td>';
990: }
1.692.4.2 raeburn 991: $out = '<table><tr><td>'.
992: $addOther .
993: &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
994: undef,undef,600).
995: '</td><td>'.
996: &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
997: undef,undef,600).
998: '</td>';
999: unless ($not_author) {
1000: $out .= '<td>'.
1001: &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
1002: undef,undef,600).
1003: '</td>';
1004: }
1005: $out .= '</tr></table>';
1006: return $out;
1.172 www 1007: }
1008:
1.430 albertel 1009: sub general_help {
1010: my $helptopic='Student_Intro';
1011: if ($env{'request.role'}=~/^(ca|au)/) {
1012: $helptopic='Authoring_Intro';
1013: } elsif ($env{'request.role'}=~/^cc/) {
1014: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1015: } elsif ($env{'request.role'}=~/^dc/) {
1016: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1017: }
1018: return $helptopic;
1019: }
1020:
1021: sub update_help_link {
1022: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1023: my $origurl = $ENV{'REQUEST_URI'};
1024: $origurl=~s|^/~|/priv/|;
1025: my $timestamp = time;
1026: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1027: $$datum = &escape($$datum);
1028: }
1029:
1030: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1031: my $output .= <<"ENDOUTPUT";
1032: <script type="text/javascript">
1.692.4.4! raeburn 1033: // <![CDATA[
1.430 albertel 1034: banner_link = '$banner_link';
1.692.4.4! raeburn 1035: // ]]>
1.430 albertel 1036: </script>
1037: ENDOUTPUT
1038: return $output;
1039: }
1040:
1041: # now just updates the help link and generates a blue icon
1.193 raeburn 1042: sub help_open_menu {
1.430 albertel 1043: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1044: = @_;
1.430 albertel 1045: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 1046: # only use pop-up help (stayOnPage == 0)
1.552 banghart 1047: # if environment.remote is on (using remote control UI)
1.572 banghart 1048: if ($env{'browser.interface'} eq 'textual' ||
1049: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 1050: $stayOnPage=1;
1.430 albertel 1051: }
1052: my $output;
1053: if ($component_help) {
1054: if (!$text) {
1055: $output=&help_open_topic($component_help,undef,$stayOnPage,
1056: $width,$height);
1057: } else {
1058: my $help_text;
1059: $help_text=&unescape($topic);
1060: $output='<table><tr><td>'.
1061: &help_open_topic($component_help,$help_text,$stayOnPage,
1062: $width,$height).'</td></tr></table>';
1063: }
1064: }
1065: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1066: return $output.$banner_link;
1067: }
1068:
1069: sub top_nav_help {
1070: my ($text) = @_;
1.436 albertel 1071: $text = &mt($text);
1.572 banghart 1072: my $stay_on_page =
1.436 albertel 1073: ($env{'browser.interface'} eq 'textual' ||
1074: $env{'environment.remote'} eq 'off' );
1.572 banghart 1075: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1076: : "javascript:helpMenu('open')";
1.572 banghart 1077: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1078:
1.201 raeburn 1079: my $title = &mt('Get help');
1.436 albertel 1080:
1081: return <<"END";
1082: $banner_link
1083: <a href="$link" title="$title">$text</a>
1084: END
1085: }
1086:
1087: sub help_menu_js {
1088: my ($text) = @_;
1089:
1090: my $stayOnPage =
1091: ($env{'browser.interface'} eq 'textual' ||
1092: $env{'environment.remote'} eq 'off' );
1093:
1094: my $width = 620;
1095: my $height = 600;
1.430 albertel 1096: my $helptopic=&general_help();
1097: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1098: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1099: my $start_page =
1100: &Apache::loncommon::start_page('Help Menu', undef,
1101: {'frameset' => 1,
1102: 'js_ready' => 1,
1103: 'add_entries' => {
1104: 'border' => '0',
1.579 raeburn 1105: 'rows' => "110,*",},});
1.331 albertel 1106: my $end_page =
1107: &Apache::loncommon::end_page({'frameset' => 1,
1108: 'js_ready' => 1,});
1109:
1.436 albertel 1110: my $template .= <<"ENDTEMPLATE";
1111: <script type="text/javascript">
1.253 albertel 1112: // <!-- BEGIN LON-CAPA Internal
1113: // <![CDATA[
1.430 albertel 1114: var banner_link = '';
1.243 raeburn 1115: function helpMenu(target) {
1116: var caller = this;
1117: if (target == 'open') {
1118: var newWindow = null;
1119: try {
1.262 albertel 1120: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1121: }
1122: catch(error) {
1123: writeHelp(caller);
1124: return;
1125: }
1126: if (newWindow) {
1127: caller = newWindow;
1128: }
1.193 raeburn 1129: }
1.243 raeburn 1130: writeHelp(caller);
1131: return;
1132: }
1133: function writeHelp(caller) {
1.430 albertel 1134: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 1135: caller.document.close()
1136: caller.focus()
1.193 raeburn 1137: }
1.253 albertel 1138: // ]]>
1.219 albertel 1139: // END LON-CAPA Internal -->
1.436 albertel 1140: </script>
1.193 raeburn 1141: ENDTEMPLATE
1142: return $template;
1143: }
1144:
1.172 www 1145: sub help_open_bug {
1146: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1147: unless ($env{'user.adv'}) { return ''; }
1.172 www 1148: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1149: $text = "" if (not defined $text);
1150: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1151: if ($env{'browser.interface'} eq 'textual' ||
1152: $env{'environment.remote'} eq 'off' ) {
1.172 www 1153: $stayOnPage=1;
1154: }
1.184 albertel 1155: $width = 600 if (not defined $width);
1156: $height = 600 if (not defined $height);
1.172 www 1157:
1158: $topic=~s/\W+/\+/g;
1159: my $link='';
1160: my $template='';
1.379 albertel 1161: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1162: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1163: if (!$stayOnPage)
1164: {
1165: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1166: }
1167: else
1168: {
1169: $link = $url;
1170: }
1171: # Add the text
1172: if ($text ne "")
1173: {
1174: $template .=
1175: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1176: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1177: }
1178:
1179: # Add the graphic
1.179 matthew 1180: my $title = &mt('Report a Bug');
1.215 albertel 1181: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1182: $template .= <<"ENDTEMPLATE";
1.436 albertel 1183: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1184: ENDTEMPLATE
1185: if ($text ne '') { $template.='</td></tr></table>' };
1186: return $template;
1187:
1188: }
1189:
1190: sub help_open_faq {
1191: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1192: unless ($env{'user.adv'}) { return ''; }
1.172 www 1193: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1194: $text = "" if (not defined $text);
1195: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1196: if ($env{'browser.interface'} eq 'textual' ||
1197: $env{'environment.remote'} eq 'off' ) {
1.172 www 1198: $stayOnPage=1;
1199: }
1200: $width = 350 if (not defined $width);
1201: $height = 400 if (not defined $height);
1202:
1203: $topic=~s/\W+/\+/g;
1204: my $link='';
1205: my $template='';
1206: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1207: if (!$stayOnPage)
1208: {
1209: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1210: }
1211: else
1212: {
1213: $link = $url;
1214: }
1215:
1216: # Add the text
1217: if ($text ne "")
1218: {
1219: $template .=
1.173 www 1220: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1221: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1222: }
1223:
1224: # Add the graphic
1.179 matthew 1225: my $title = &mt('View the FAQ');
1.215 albertel 1226: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1227: $template .= <<"ENDTEMPLATE";
1.436 albertel 1228: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1229: ENDTEMPLATE
1230: if ($text ne '') { $template.='</td></tr></table>' };
1231: return $template;
1232:
1.44 bowersj2 1233: }
1.37 matthew 1234:
1.180 matthew 1235: ###############################################################
1236: ###############################################################
1237:
1.45 matthew 1238: =pod
1239:
1.648 raeburn 1240: =item * &change_content_javascript():
1.256 matthew 1241:
1242: This and the next function allow you to create small sections of an
1243: otherwise static HTML page that you can update on the fly with
1244: Javascript, even in Netscape 4.
1245:
1246: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1247: must be written to the HTML page once. It will prove the Javascript
1248: function "change(name, content)". Calling the change function with the
1249: name of the section
1250: you want to update, matching the name passed to C<changable_area>, and
1251: the new content you want to put in there, will put the content into
1252: that area.
1253:
1254: B<Note>: Netscape 4 only reserves enough space for the changable area
1255: to contain room for the original contents. You need to "make space"
1256: for whatever changes you wish to make, and be B<sure> to check your
1257: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1258: it's adequate for updating a one-line status display, but little more.
1259: This script will set the space to 100% width, so you only need to
1260: worry about height in Netscape 4.
1261:
1262: Modern browsers are much less limiting, and if you can commit to the
1263: user not using Netscape 4, this feature may be used freely with
1264: pretty much any HTML.
1265:
1266: =cut
1267:
1268: sub change_content_javascript {
1269: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1270: if ($env{'browser.type'} eq 'netscape' &&
1271: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1272: return (<<NETSCAPE4);
1273: function change(name, content) {
1274: doc = document.layers[name+"___escape"].layers[0].document;
1275: doc.open();
1276: doc.write(content);
1277: doc.close();
1278: }
1279: NETSCAPE4
1280: } else {
1281: # Otherwise, we need to use semi-standards-compliant code
1282: # (technically, "innerHTML" isn't standard but the equivalent
1283: # is really scary, and every useful browser supports it
1284: return (<<DOMBASED);
1285: function change(name, content) {
1286: element = document.getElementById(name);
1287: element.innerHTML = content;
1288: }
1289: DOMBASED
1290: }
1291: }
1292:
1293: =pod
1294:
1.648 raeburn 1295: =item * &changable_area($name,$origContent):
1.256 matthew 1296:
1297: This provides a "changable area" that can be modified on the fly via
1298: the Javascript code provided in C<change_content_javascript>. $name is
1299: the name you will use to reference the area later; do not repeat the
1300: same name on a given HTML page more then once. $origContent is what
1301: the area will originally contain, which can be left blank.
1302:
1303: =cut
1304:
1305: sub changable_area {
1306: my ($name, $origContent) = @_;
1307:
1.258 albertel 1308: if ($env{'browser.type'} eq 'netscape' &&
1309: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1310: # If this is netscape 4, we need to use the Layer tag
1311: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1312: } else {
1313: return "<span id='$name'>$origContent</span>";
1314: }
1315: }
1316:
1317: =pod
1318:
1.648 raeburn 1319: =item * &viewport_geometry_js
1.590 raeburn 1320:
1321: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1322:
1323: =cut
1324:
1325:
1326: sub viewport_geometry_js {
1327: return <<"GEOMETRY";
1328: var Geometry = {};
1329: function init_geometry() {
1330: if (Geometry.init) { return };
1331: Geometry.init=1;
1332: if (window.innerHeight) {
1333: Geometry.getViewportHeight = function() { return window.innerHeight; };
1334: Geometry.getViewportWidth = function() { return window.innerWidth; };
1335: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1336: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1337: }
1338: else if (document.documentElement && document.documentElement.clientHeight) {
1339: Geometry.getViewportHeight =
1340: function() { return document.documentElement.clientHeight; };
1341: Geometry.getViewportWidth =
1342: function() { return document.documentElement.clientWidth; };
1343:
1344: Geometry.getHorizontalScroll =
1345: function() { return document.documentElement.scrollLeft; };
1346: Geometry.getVerticalScroll =
1347: function() { return document.documentElement.scrollTop; };
1348: }
1349: else if (document.body.clientHeight) {
1350: Geometry.getViewportHeight =
1351: function() { return document.body.clientHeight; };
1352: Geometry.getViewportWidth =
1353: function() { return document.body.clientWidth; };
1354: Geometry.getHorizontalScroll =
1355: function() { return document.body.scrollLeft; };
1356: Geometry.getVerticalScroll =
1357: function() { return document.body.scrollTop; };
1358: }
1359: }
1360:
1361: GEOMETRY
1362: }
1363:
1364: =pod
1365:
1.648 raeburn 1366: =item * &viewport_size_js()
1.590 raeburn 1367:
1368: 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.
1369:
1370: =cut
1371:
1372: sub viewport_size_js {
1373: my $geometry = &viewport_geometry_js();
1374: return <<"DIMS";
1375:
1376: $geometry
1377:
1378: function getViewportDims(width,height) {
1379: init_geometry();
1380: width.value = Geometry.getViewportWidth();
1381: height.value = Geometry.getViewportHeight();
1382: return;
1383: }
1384:
1385: DIMS
1386: }
1387:
1388: =pod
1389:
1.648 raeburn 1390: =item * &resize_textarea_js()
1.565 albertel 1391:
1392: emits the needed javascript to resize a textarea to be as big as possible
1393:
1394: creates a function resize_textrea that takes two IDs first should be
1395: the id of the element to resize, second should be the id of a div that
1396: surrounds everything that comes after the textarea, this routine needs
1397: to be attached to the <body> for the onload and onresize events.
1398:
1.648 raeburn 1399: =back
1.565 albertel 1400:
1401: =cut
1402:
1403: sub resize_textarea_js {
1.590 raeburn 1404: my $geometry = &viewport_geometry_js();
1.565 albertel 1405: return <<"RESIZE";
1406: <script type="text/javascript">
1.692.4.4! raeburn 1407: // <![CDATA[
1.590 raeburn 1408: $geometry
1.565 albertel 1409:
1.588 albertel 1410: function getX(element) {
1411: var x = 0;
1412: while (element) {
1413: x += element.offsetLeft;
1414: element = element.offsetParent;
1415: }
1416: return x;
1417: }
1418: function getY(element) {
1419: var y = 0;
1420: while (element) {
1421: y += element.offsetTop;
1422: element = element.offsetParent;
1423: }
1424: return y;
1425: }
1426:
1427:
1.565 albertel 1428: function resize_textarea(textarea_id,bottom_id) {
1429: init_geometry();
1430: var textarea = document.getElementById(textarea_id);
1431: //alert(textarea);
1432:
1.588 albertel 1433: var textarea_top = getY(textarea);
1.565 albertel 1434: var textarea_height = textarea.offsetHeight;
1435: var bottom = document.getElementById(bottom_id);
1.588 albertel 1436: var bottom_top = getY(bottom);
1.565 albertel 1437: var bottom_height = bottom.offsetHeight;
1438: var window_height = Geometry.getViewportHeight();
1.588 albertel 1439: var fudge = 23;
1.565 albertel 1440: var new_height = window_height-fudge-textarea_top-bottom_height;
1441: if (new_height < 300) {
1442: new_height = 300;
1443: }
1444: textarea.style.height=new_height+'px';
1445: }
1.692.4.4! raeburn 1446: // ]]>
1.565 albertel 1447: </script>
1448: RESIZE
1449:
1450: }
1451:
1452: =pod
1453:
1.256 matthew 1454: =head1 Excel and CSV file utility routines
1455:
1456: =over 4
1457:
1458: =cut
1459:
1460: ###############################################################
1461: ###############################################################
1462:
1463: =pod
1464:
1.648 raeburn 1465: =item * &csv_translate($text)
1.37 matthew 1466:
1.185 www 1467: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1468: format.
1469:
1470: =cut
1471:
1.180 matthew 1472: ###############################################################
1473: ###############################################################
1.37 matthew 1474: sub csv_translate {
1475: my $text = shift;
1476: $text =~ s/\"/\"\"/g;
1.209 albertel 1477: $text =~ s/\n/ /g;
1.37 matthew 1478: return $text;
1479: }
1.180 matthew 1480:
1481: ###############################################################
1482: ###############################################################
1483:
1484: =pod
1485:
1.648 raeburn 1486: =item * &define_excel_formats()
1.180 matthew 1487:
1488: Define some commonly used Excel cell formats.
1489:
1490: Currently supported formats:
1491:
1492: =over 4
1493:
1494: =item header
1495:
1496: =item bold
1497:
1498: =item h1
1499:
1500: =item h2
1501:
1502: =item h3
1503:
1.256 matthew 1504: =item h4
1505:
1506: =item i
1507:
1.180 matthew 1508: =item date
1509:
1510: =back
1511:
1512: Inputs: $workbook
1513:
1514: Returns: $format, a hash reference.
1515:
1516: =cut
1517:
1518: ###############################################################
1519: ###############################################################
1520: sub define_excel_formats {
1521: my ($workbook) = @_;
1522: my $format;
1523: $format->{'header'} = $workbook->add_format(bold => 1,
1524: bottom => 1,
1525: align => 'center');
1526: $format->{'bold'} = $workbook->add_format(bold=>1);
1527: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1528: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1529: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1530: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1531: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1532: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1533: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1534: return $format;
1535: }
1536:
1537: ###############################################################
1538: ###############################################################
1.113 bowersj2 1539:
1540: =pod
1541:
1.648 raeburn 1542: =item * &create_workbook()
1.255 matthew 1543:
1544: Create an Excel worksheet. If it fails, output message on the
1545: request object and return undefs.
1546:
1547: Inputs: Apache request object
1548:
1549: Returns (undef) on failure,
1550: Excel worksheet object, scalar with filename, and formats
1551: from &Apache::loncommon::define_excel_formats on success
1552:
1553: =cut
1554:
1555: ###############################################################
1556: ###############################################################
1557: sub create_workbook {
1558: my ($r) = @_;
1559: #
1560: # Create the excel spreadsheet
1561: my $filename = '/prtspool/'.
1.258 albertel 1562: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1563: time.'_'.rand(1000000000).'.xls';
1564: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1565: if (! defined($workbook)) {
1566: $r->log_error("Error creating excel spreadsheet $filename: $!");
1567: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1568: "This error has been logged. ".
1569: "Please alert your LON-CAPA administrator").
1570: '</p>');
1571: return (undef);
1572: }
1573: #
1574: $workbook->set_tempdir('/home/httpd/perl/tmp');
1575: #
1576: my $format = &Apache::loncommon::define_excel_formats($workbook);
1577: return ($workbook,$filename,$format);
1578: }
1579:
1580: ###############################################################
1581: ###############################################################
1582:
1583: =pod
1584:
1.648 raeburn 1585: =item * &create_text_file()
1.113 bowersj2 1586:
1.542 raeburn 1587: Create a file to write to and eventually make available to the user.
1.256 matthew 1588: If file creation fails, outputs an error message on the request object and
1589: return undefs.
1.113 bowersj2 1590:
1.256 matthew 1591: Inputs: Apache request object, and file suffix
1.113 bowersj2 1592:
1.256 matthew 1593: Returns (undef) on failure,
1594: Filehandle and filename on success.
1.113 bowersj2 1595:
1596: =cut
1597:
1.256 matthew 1598: ###############################################################
1599: ###############################################################
1600: sub create_text_file {
1601: my ($r,$suffix) = @_;
1602: if (! defined($suffix)) { $suffix = 'txt'; };
1603: my $fh;
1604: my $filename = '/prtspool/'.
1.258 albertel 1605: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1606: time.'_'.rand(1000000000).'.'.$suffix;
1607: $fh = Apache::File->new('>/home/httpd'.$filename);
1608: if (! defined($fh)) {
1609: $r->log_error("Couldn't open $filename for output $!");
1.683 bisitz 1610: $r->print(&mt('Problems occurred in creating the output file. '
1611: .'This error has been logged. '
1612: .'Please alert your LON-CAPA administrator.'));
1.113 bowersj2 1613: }
1.256 matthew 1614: return ($fh,$filename)
1.113 bowersj2 1615: }
1616:
1617:
1.256 matthew 1618: =pod
1.113 bowersj2 1619:
1620: =back
1621:
1622: =cut
1.37 matthew 1623:
1624: ###############################################################
1.33 matthew 1625: ## Home server <option> list generating code ##
1626: ###############################################################
1.35 matthew 1627:
1.169 www 1628: # ------------------------------------------
1629:
1630: sub domain_select {
1631: my ($name,$value,$multiple)=@_;
1632: my %domains=map {
1.514 albertel 1633: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1634: } &Apache::lonnet::all_domains();
1.169 www 1635: if ($multiple) {
1636: $domains{''}=&mt('Any domain');
1.550 albertel 1637: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1638: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1639: } else {
1.550 albertel 1640: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1641: return &select_form($name,$value,%domains);
1642: }
1643: }
1644:
1.282 albertel 1645: #-------------------------------------------
1646:
1647: =pod
1648:
1.519 raeburn 1649: =head1 Routines for form select boxes
1650:
1651: =over 4
1652:
1.648 raeburn 1653: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1654:
1655: Returns a string containing a <select> element int multiple mode
1656:
1657:
1658: Args:
1659: $name - name of the <select> element
1.506 raeburn 1660: $value - scalar or array ref of values that should already be selected
1.282 albertel 1661: $size - number of rows long the select element is
1.283 albertel 1662: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1663: (shown text should already have been &mt())
1.506 raeburn 1664: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1665:
1.282 albertel 1666: =cut
1667:
1668: #-------------------------------------------
1.169 www 1669: sub multiple_select_form {
1.284 albertel 1670: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1671: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1672: my $output='';
1.191 matthew 1673: if (! defined($size)) {
1674: $size = 4;
1.283 albertel 1675: if (scalar(keys(%$hash))<4) {
1676: $size = scalar(keys(%$hash));
1.191 matthew 1677: }
1678: }
1.692.4.2 raeburn 1679: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1680: my @order;
1.506 raeburn 1681: if (ref($order) eq 'ARRAY') {
1682: @order = @{$order};
1683: } else {
1684: @order = sort(keys(%$hash));
1.501 banghart 1685: }
1686: if (exists($$hash{'select_form_order'})) {
1687: @order = @{$$hash{'select_form_order'}};
1688: }
1689:
1.284 albertel 1690: foreach my $key (@order) {
1.356 albertel 1691: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1692: $output.='selected="selected" ' if ($selected{$key});
1693: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1694: }
1695: $output.="</select>\n";
1696: return $output;
1697: }
1698:
1.88 www 1699: #-------------------------------------------
1700:
1701: =pod
1702:
1.648 raeburn 1703: =item * &select_form($defdom,$name,%hash)
1.88 www 1704:
1705: Returns a string containing a <select name='$name' size='1'> form to
1706: allow a user to select options from a hash option_name => displayed text.
1707: See lonrights.pm for an example invocation and use.
1708:
1709: =cut
1710:
1711: #-------------------------------------------
1712: sub select_form {
1713: my ($def,$name,%hash) = @_;
1714: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1715: my @keys;
1716: if (exists($hash{'select_form_order'})) {
1717: @keys=@{$hash{'select_form_order'}};
1718: } else {
1719: @keys=sort(keys(%hash));
1720: }
1.356 albertel 1721: foreach my $key (@keys) {
1722: $selectform.=
1723: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1724: ($key eq $def ? 'selected="selected" ' : '').
1725: ">".&mt($hash{$key})."</option>\n";
1.88 www 1726: }
1727: $selectform.="</select>";
1728: return $selectform;
1729: }
1730:
1.475 www 1731: # For display filters
1732:
1733: sub display_filter {
1734: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1735: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.692.4.2 raeburn 1736: return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475 www 1737: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1738: (&mt('all'),10,20,50,100,1000,10000))).
1.692.4.2 raeburn 1739: '</label></span> <span class="LC_nobreak">'.
1.475 www 1740: &mt('Filter [_1]',
1.477 www 1741: &select_form($env{'form.displayfilter'},
1742: 'displayfilter',
1743: ('currentfolder' => 'Current folder/page',
1744: 'containing' => 'Containing phrase',
1745: 'none' => 'None'))).
1.692.4.2 raeburn 1746: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475 www 1747: }
1748:
1.167 www 1749: sub gradeleveldescription {
1750: my $gradelevel=shift;
1751: my %gradelevels=(0 => 'Not specified',
1752: 1 => 'Grade 1',
1753: 2 => 'Grade 2',
1754: 3 => 'Grade 3',
1755: 4 => 'Grade 4',
1756: 5 => 'Grade 5',
1757: 6 => 'Grade 6',
1758: 7 => 'Grade 7',
1759: 8 => 'Grade 8',
1760: 9 => 'Grade 9',
1761: 10 => 'Grade 10',
1762: 11 => 'Grade 11',
1763: 12 => 'Grade 12',
1764: 13 => 'Grade 13',
1765: 14 => '100 Level',
1766: 15 => '200 Level',
1767: 16 => '300 Level',
1768: 17 => '400 Level',
1769: 18 => 'Graduate Level');
1770: return &mt($gradelevels{$gradelevel});
1771: }
1772:
1.163 www 1773: sub select_level_form {
1774: my ($deflevel,$name)=@_;
1775: unless ($deflevel) { $deflevel=0; }
1.167 www 1776: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1777: for (my $i=0; $i<=18; $i++) {
1778: $selectform.="<option value=\"$i\" ".
1.253 albertel 1779: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1780: ">".&gradeleveldescription($i)."</option>\n";
1781: }
1782: $selectform.="</select>";
1783: return $selectform;
1.163 www 1784: }
1.167 www 1785:
1.35 matthew 1786: #-------------------------------------------
1787:
1.45 matthew 1788: =pod
1789:
1.692.4.2 raeburn 1790: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$autosubmit)
1.35 matthew 1791:
1792: Returns a string containing a <select name='$name' size='1'> form to
1793: allow a user to select the domain to preform an operation in.
1794: See loncreateuser.pm for an example invocation and use.
1795:
1.90 www 1796: If the $includeempty flag is set, it also includes an empty choice ("no domain
1797: selected");
1798:
1.692.4.2 raeburn 1799: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1800:
1801: If the $autosubmit flag is set, the form containing the domain selector will be auto-submitted by an onchange action.
1.563 raeburn 1802:
1.35 matthew 1803: =cut
1804:
1805: #-------------------------------------------
1.34 matthew 1806: sub select_dom_form {
1.692.4.2 raeburn 1807: my ($defdom,$name,$includeempty,$showdomdesc,$autosubmit) = @_;
1808: my $onchange;
1809: if ($autosubmit) {
1810: $onchange = ' onchange="this.form.submit()"';
1811: }
1.550 albertel 1812: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1813: if ($includeempty) { @domains=('',@domains); }
1.692.4.2 raeburn 1814: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 1815: foreach my $dom (@domains) {
1816: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1817: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1818: if ($showdomdesc) {
1819: if ($dom ne '') {
1820: my $domdesc = &Apache::lonnet::domain($dom,'description');
1821: if ($domdesc ne '') {
1822: $selectdomain .= ' ('.$domdesc.')';
1823: }
1824: }
1825: }
1826: $selectdomain .= "</option>\n";
1.34 matthew 1827: }
1828: $selectdomain.="</select>";
1829: return $selectdomain;
1830: }
1831:
1.35 matthew 1832: #-------------------------------------------
1833:
1.45 matthew 1834: =pod
1835:
1.648 raeburn 1836: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1837:
1.586 raeburn 1838: input: 4 arguments (two required, two optional) -
1839: $domain - domain of new user
1840: $name - name of form element
1841: $default - Value of 'default' causes a default item to be first
1842: option, and selected by default.
1843: $hide - Value of 'hide' causes hiding of the name of the server,
1844: if 1 server found, or default, if 0 found.
1.594 raeburn 1845: output: returns 2 items:
1.586 raeburn 1846: (a) form element which contains either:
1847: (i) <select name="$name">
1848: <option value="$hostid1">$hostid $servers{$hostid}</option>
1849: <option value="$hostid2">$hostid $servers{$hostid}</option>
1850: </select>
1851: form item if there are multiple library servers in $domain, or
1852: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1853: if there is only one library server in $domain.
1854:
1855: (b) number of library servers found.
1856:
1857: See loncreateuser.pm for example of use.
1.35 matthew 1858:
1859: =cut
1860:
1861: #-------------------------------------------
1.586 raeburn 1862: sub home_server_form_item {
1863: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1864: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1865: my $result;
1866: my $numlib = keys(%servers);
1867: if ($numlib > 1) {
1868: $result .= '<select name="'.$name.'" />'."\n";
1869: if ($default) {
1.692.4.2 raeburn 1870: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 1871: '</option>'."\n";
1872: }
1873: foreach my $hostid (sort(keys(%servers))) {
1874: $result.= '<option value="'.$hostid.'">'.
1875: $hostid.' '.$servers{$hostid}."</option>\n";
1876: }
1877: $result .= '</select>'."\n";
1878: } elsif ($numlib == 1) {
1879: my $hostid;
1880: foreach my $item (keys(%servers)) {
1881: $hostid = $item;
1882: }
1883: $result .= '<input type="hidden" name="'.$name.'" value="'.
1884: $hostid.'" />';
1885: if (!$hide) {
1886: $result .= $hostid.' '.$servers{$hostid};
1887: }
1888: $result .= "\n";
1889: } elsif ($default) {
1890: $result .= '<input type="hidden" name="'.$name.
1891: '" value="default" />';
1892: if (!$hide) {
1893: $result .= &mt('default');
1894: }
1895: $result .= "\n";
1.33 matthew 1896: }
1.586 raeburn 1897: return ($result,$numlib);
1.33 matthew 1898: }
1.112 bowersj2 1899:
1900: =pod
1901:
1.534 albertel 1902: =back
1903:
1.112 bowersj2 1904: =cut
1.87 matthew 1905:
1906: ###############################################################
1.112 bowersj2 1907: ## Decoding User Agent ##
1.87 matthew 1908: ###############################################################
1909:
1910: =pod
1911:
1.112 bowersj2 1912: =head1 Decoding the User Agent
1913:
1914: =over 4
1915:
1916: =item * &decode_user_agent()
1.87 matthew 1917:
1918: Inputs: $r
1919:
1920: Outputs:
1921:
1922: =over 4
1923:
1.112 bowersj2 1924: =item * $httpbrowser
1.87 matthew 1925:
1.112 bowersj2 1926: =item * $clientbrowser
1.87 matthew 1927:
1.112 bowersj2 1928: =item * $clientversion
1.87 matthew 1929:
1.112 bowersj2 1930: =item * $clientmathml
1.87 matthew 1931:
1.112 bowersj2 1932: =item * $clientunicode
1.87 matthew 1933:
1.112 bowersj2 1934: =item * $clientos
1.87 matthew 1935:
1936: =back
1937:
1.157 matthew 1938: =back
1939:
1.87 matthew 1940: =cut
1941:
1942: ###############################################################
1943: ###############################################################
1944: sub decode_user_agent {
1.247 albertel 1945: my ($r)=@_;
1.87 matthew 1946: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
1947: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
1948: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 1949: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 1950: my $clientbrowser='unknown';
1951: my $clientversion='0';
1952: my $clientmathml='';
1953: my $clientunicode='0';
1954: for (my $i=0;$i<=$#browsertype;$i++) {
1955: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
1956: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
1957: $clientbrowser=$bname;
1958: $httpbrowser=~/$vreg/i;
1959: $clientversion=$1;
1960: $clientmathml=($clientversion>=$minv);
1961: $clientunicode=($clientversion>=$univ);
1962: }
1963: }
1964: my $clientos='unknown';
1965: if (($httpbrowser=~/linux/i) ||
1966: ($httpbrowser=~/unix/i) ||
1967: ($httpbrowser=~/ux/i) ||
1968: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
1969: if (($httpbrowser=~/vax/i) ||
1970: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
1971: if ($httpbrowser=~/next/i) { $clientos='next'; }
1972: if (($httpbrowser=~/mac/i) ||
1973: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1974: if ($httpbrowser=~/win/i) { $clientos='win'; }
1975: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1976: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1977: $clientunicode,$clientos,);
1978: }
1979:
1.32 matthew 1980: ###############################################################
1981: ## Authentication changing form generation subroutines ##
1982: ###############################################################
1983: ##
1984: ## All of the authform_xxxxxxx subroutines take their inputs in a
1985: ## hash, and have reasonable default values.
1986: ##
1987: ## formname = the name given in the <form> tag.
1.35 matthew 1988: #-------------------------------------------
1989:
1.45 matthew 1990: =pod
1991:
1.112 bowersj2 1992: =head1 Authentication Routines
1993:
1994: =over 4
1995:
1.648 raeburn 1996: =item * &authform_xxxxxx()
1.35 matthew 1997:
1998: The authform_xxxxxx subroutines provide javascript and html forms which
1999: handle some of the conveniences required for authentication forms.
2000: This is not an optimal method, but it works.
2001:
2002: =over 4
2003:
1.112 bowersj2 2004: =item * authform_header
1.35 matthew 2005:
1.112 bowersj2 2006: =item * authform_authorwarning
1.35 matthew 2007:
1.112 bowersj2 2008: =item * authform_nochange
1.35 matthew 2009:
1.112 bowersj2 2010: =item * authform_kerberos
1.35 matthew 2011:
1.112 bowersj2 2012: =item * authform_internal
1.35 matthew 2013:
1.112 bowersj2 2014: =item * authform_filesystem
1.35 matthew 2015:
2016: =back
2017:
1.648 raeburn 2018: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2019:
1.35 matthew 2020: =cut
2021:
2022: #-------------------------------------------
1.32 matthew 2023: sub authform_header{
2024: my %in = (
2025: formname => 'cu',
1.80 albertel 2026: kerb_def_dom => '',
1.32 matthew 2027: @_,
2028: );
2029: $in{'formname'} = 'document.' . $in{'formname'};
2030: my $result='';
1.80 albertel 2031:
2032: #---------------------------------------------- Code for upper case translation
2033: my $Javascript_toUpperCase;
2034: unless ($in{kerb_def_dom}) {
2035: $Javascript_toUpperCase =<<"END";
2036: switch (choice) {
2037: case 'krb': currentform.elements[choicearg].value =
2038: currentform.elements[choicearg].value.toUpperCase();
2039: break;
2040: default:
2041: }
2042: END
2043: } else {
2044: $Javascript_toUpperCase = "";
2045: }
2046:
1.165 raeburn 2047: my $radioval = "'nochange'";
1.591 raeburn 2048: if (defined($in{'curr_authtype'})) {
2049: if ($in{'curr_authtype'} ne '') {
2050: $radioval = "'".$in{'curr_authtype'}."arg'";
2051: }
1.174 matthew 2052: }
1.165 raeburn 2053: my $argfield = 'null';
1.591 raeburn 2054: if (defined($in{'mode'})) {
1.165 raeburn 2055: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2056: if (defined($in{'curr_autharg'})) {
2057: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2058: $argfield = "'$in{'curr_autharg'}'";
2059: }
2060: }
2061: }
2062: }
2063:
1.32 matthew 2064: $result.=<<"END";
2065: var current = new Object();
1.165 raeburn 2066: current.radiovalue = $radioval;
2067: current.argfield = $argfield;
1.32 matthew 2068:
2069: function changed_radio(choice,currentform) {
2070: var choicearg = choice + 'arg';
2071: // If a radio button in changed, we need to change the argfield
2072: if (current.radiovalue != choice) {
2073: current.radiovalue = choice;
2074: if (current.argfield != null) {
2075: currentform.elements[current.argfield].value = '';
2076: }
2077: if (choice == 'nochange') {
2078: current.argfield = null;
2079: } else {
2080: current.argfield = choicearg;
2081: switch(choice) {
2082: case 'krb':
2083: currentform.elements[current.argfield].value =
2084: "$in{'kerb_def_dom'}";
2085: break;
2086: default:
2087: break;
2088: }
2089: }
2090: }
2091: return;
2092: }
1.22 www 2093:
1.32 matthew 2094: function changed_text(choice,currentform) {
2095: var choicearg = choice + 'arg';
2096: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2097: $Javascript_toUpperCase
1.32 matthew 2098: // clear old field
2099: if ((current.argfield != choicearg) && (current.argfield != null)) {
2100: currentform.elements[current.argfield].value = '';
2101: }
2102: current.argfield = choicearg;
2103: }
2104: set_auth_radio_buttons(choice,currentform);
2105: return;
1.20 www 2106: }
1.32 matthew 2107:
2108: function set_auth_radio_buttons(newvalue,currentform) {
2109: var i=0;
2110: while (i < currentform.login.length) {
2111: if (currentform.login[i].value == newvalue) { break; }
2112: i++;
2113: }
2114: if (i == currentform.login.length) {
2115: return;
2116: }
2117: current.radiovalue = newvalue;
2118: currentform.login[i].checked = true;
2119: return;
2120: }
2121: END
2122: return $result;
2123: }
2124:
2125: sub authform_authorwarning{
2126: my $result='';
1.144 matthew 2127: $result='<i>'.
2128: &mt('As a general rule, only authors or co-authors should be '.
2129: 'filesystem authenticated '.
2130: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2131: return $result;
2132: }
2133:
2134: sub authform_nochange{
2135: my %in = (
2136: formname => 'document.cu',
2137: kerb_def_dom => 'MSU.EDU',
2138: @_,
2139: );
1.586 raeburn 2140: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2141: my $result;
2142: if (keys(%can_assign) == 0) {
2143: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2144: } else {
2145: $result = '<label>'.&mt('[_1] Do not change login data',
2146: '<input type="radio" name="login" value="nochange" '.
2147: 'checked="checked" onclick="'.
1.281 albertel 2148: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2149: '</label>';
1.586 raeburn 2150: }
1.32 matthew 2151: return $result;
2152: }
2153:
1.591 raeburn 2154: sub authform_kerberos {
1.32 matthew 2155: my %in = (
2156: formname => 'document.cu',
2157: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2158: kerb_def_auth => 'krb4',
1.32 matthew 2159: @_,
2160: );
1.586 raeburn 2161: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2162: $autharg,$jscall);
2163: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2164: if ($in{'kerb_def_auth'} eq 'krb5') {
1.692.4.2 raeburn 2165: $check5 = ' checked="checked"';
1.80 albertel 2166: } else {
1.692.4.2 raeburn 2167: $check4 = ' checked="checked"';
1.80 albertel 2168: }
1.165 raeburn 2169: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2170: if (defined($in{'curr_authtype'})) {
2171: if ($in{'curr_authtype'} eq 'krb') {
1.692.4.2 raeburn 2172: $krbcheck = ' checked="checked"';
1.623 raeburn 2173: if (defined($in{'mode'})) {
2174: if ($in{'mode'} eq 'modifyuser') {
2175: $krbcheck = '';
2176: }
2177: }
1.591 raeburn 2178: if (defined($in{'curr_kerb_ver'})) {
2179: if ($in{'curr_krb_ver'} eq '5') {
1.692.4.2 raeburn 2180: $check5 = ' checked="checked"';
1.591 raeburn 2181: $check4 = '';
2182: } else {
1.692.4.2 raeburn 2183: $check4 = ' checked="checked"';
1.591 raeburn 2184: $check5 = '';
2185: }
1.586 raeburn 2186: }
1.591 raeburn 2187: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2188: $krbarg = $in{'curr_autharg'};
2189: }
1.586 raeburn 2190: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2191: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2192: $result =
2193: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2194: $in{'curr_autharg'},$krbver);
2195: } else {
2196: $result =
2197: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2198: }
2199: return $result;
2200: }
2201: }
2202: } else {
2203: if ($authnum == 1) {
1.692.4.2 raeburn 2204: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2205: }
2206: }
1.586 raeburn 2207: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2208: return;
1.587 raeburn 2209: } elsif ($authtype eq '') {
1.591 raeburn 2210: if (defined($in{'mode'})) {
1.587 raeburn 2211: if ($in{'mode'} eq 'modifycourse') {
2212: if ($authnum == 1) {
1.692.4.2 raeburn 2213: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2214: }
2215: }
2216: }
1.586 raeburn 2217: }
2218: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2219: if ($authtype eq '') {
2220: $authtype = '<input type="radio" name="login" value="krb" '.
2221: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2222: $krbcheck.' />';
2223: }
2224: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2225: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2226: $in{'curr_authtype'} eq 'krb5') ||
2227: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2228: $in{'curr_authtype'} eq 'krb4')) {
2229: $result .= &mt
1.144 matthew 2230: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2231: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2232: '<label>'.$authtype,
1.281 albertel 2233: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2234: 'value="'.$krbarg.'" '.
1.144 matthew 2235: 'onchange="'.$jscall.'" />',
1.281 albertel 2236: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2237: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2238: '</label>');
1.586 raeburn 2239: } elsif ($can_assign{'krb4'}) {
2240: $result .= &mt
2241: ('[_1] Kerberos authenticated with domain [_2] '.
2242: '[_3] Version 4 [_4]',
2243: '<label>'.$authtype,
2244: '</label><input type="text" size="10" name="krbarg" '.
2245: 'value="'.$krbarg.'" '.
2246: 'onchange="'.$jscall.'" />',
2247: '<label><input type="hidden" name="krbver" value="4" />',
2248: '</label>');
2249: } elsif ($can_assign{'krb5'}) {
2250: $result .= &mt
2251: ('[_1] Kerberos authenticated with domain [_2] '.
2252: '[_3] Version 5 [_4]',
2253: '<label>'.$authtype,
2254: '</label><input type="text" size="10" name="krbarg" '.
2255: 'value="'.$krbarg.'" '.
2256: 'onchange="'.$jscall.'" />',
2257: '<label><input type="hidden" name="krbver" value="5" />',
2258: '</label>');
2259: }
1.32 matthew 2260: return $result;
2261: }
2262:
2263: sub authform_internal{
1.586 raeburn 2264: my %in = (
1.32 matthew 2265: formname => 'document.cu',
2266: kerb_def_dom => 'MSU.EDU',
2267: @_,
2268: );
1.586 raeburn 2269: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2270: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2271: if (defined($in{'curr_authtype'})) {
2272: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2273: if ($can_assign{'int'}) {
1.692.4.2 raeburn 2274: $intcheck = 'checked="checked" ';
1.623 raeburn 2275: if (defined($in{'mode'})) {
2276: if ($in{'mode'} eq 'modifyuser') {
2277: $intcheck = '';
2278: }
2279: }
1.591 raeburn 2280: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2281: $intarg = $in{'curr_autharg'};
2282: }
2283: } else {
2284: $result = &mt('Currently internally authenticated.');
2285: return $result;
1.165 raeburn 2286: }
2287: }
1.586 raeburn 2288: } else {
2289: if ($authnum == 1) {
1.692.4.2 raeburn 2290: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2291: }
2292: }
2293: if (!$can_assign{'int'}) {
2294: return;
1.587 raeburn 2295: } elsif ($authtype eq '') {
1.591 raeburn 2296: if (defined($in{'mode'})) {
1.587 raeburn 2297: if ($in{'mode'} eq 'modifycourse') {
2298: if ($authnum == 1) {
1.692.4.2 raeburn 2299: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2300: }
2301: }
2302: }
1.165 raeburn 2303: }
1.586 raeburn 2304: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2305: if ($authtype eq '') {
2306: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2307: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2308: }
1.605 bisitz 2309: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2310: $intarg.'" onchange="'.$jscall.'" />';
2311: $result = &mt
1.144 matthew 2312: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2313: '<label>'.$authtype,'</label>'.$autharg);
1.692.4.4! raeburn 2314: $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 2315: return $result;
2316: }
2317:
2318: sub authform_local{
2319: my %in = (
2320: formname => 'document.cu',
2321: kerb_def_dom => 'MSU.EDU',
2322: @_,
2323: );
1.586 raeburn 2324: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2325: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2326: if (defined($in{'curr_authtype'})) {
2327: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2328: if ($can_assign{'loc'}) {
1.692.4.2 raeburn 2329: $loccheck = 'checked="checked" ';
1.623 raeburn 2330: if (defined($in{'mode'})) {
2331: if ($in{'mode'} eq 'modifyuser') {
2332: $loccheck = '';
2333: }
2334: }
1.591 raeburn 2335: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2336: $locarg = $in{'curr_autharg'};
2337: }
2338: } else {
2339: $result = &mt('Currently using local (institutional) authentication.');
2340: return $result;
1.165 raeburn 2341: }
2342: }
1.586 raeburn 2343: } else {
2344: if ($authnum == 1) {
1.692.4.2 raeburn 2345: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2346: }
2347: }
2348: if (!$can_assign{'loc'}) {
2349: return;
1.587 raeburn 2350: } elsif ($authtype eq '') {
1.591 raeburn 2351: if (defined($in{'mode'})) {
1.587 raeburn 2352: if ($in{'mode'} eq 'modifycourse') {
2353: if ($authnum == 1) {
1.692.4.2 raeburn 2354: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2355: }
2356: }
2357: }
1.165 raeburn 2358: }
1.586 raeburn 2359: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2360: if ($authtype eq '') {
2361: $authtype = '<input type="radio" name="login" value="loc" '.
2362: $loccheck.' onchange="'.$jscall.'" onclick="'.
2363: $jscall.'" />';
2364: }
2365: $autharg = '<input type="text" size="10" name="locarg" value="'.
2366: $locarg.'" onchange="'.$jscall.'" />';
2367: $result = &mt('[_1] Local Authentication with argument [_2]',
2368: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2369: return $result;
2370: }
2371:
2372: sub authform_filesystem{
2373: my %in = (
2374: formname => 'document.cu',
2375: kerb_def_dom => 'MSU.EDU',
2376: @_,
2377: );
1.586 raeburn 2378: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2379: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2380: if (defined($in{'curr_authtype'})) {
2381: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2382: if ($can_assign{'fsys'}) {
1.692.4.2 raeburn 2383: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2384: if (defined($in{'mode'})) {
2385: if ($in{'mode'} eq 'modifyuser') {
2386: $fsyscheck = '';
2387: }
2388: }
1.586 raeburn 2389: } else {
2390: $result = &mt('Currently Filesystem Authenticated.');
2391: return $result;
2392: }
2393: }
2394: } else {
2395: if ($authnum == 1) {
1.692.4.2 raeburn 2396: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2397: }
2398: }
2399: if (!$can_assign{'fsys'}) {
2400: return;
1.587 raeburn 2401: } elsif ($authtype eq '') {
1.591 raeburn 2402: if (defined($in{'mode'})) {
1.587 raeburn 2403: if ($in{'mode'} eq 'modifycourse') {
2404: if ($authnum == 1) {
1.692.4.2 raeburn 2405: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2406: }
2407: }
2408: }
1.586 raeburn 2409: }
2410: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2411: if ($authtype eq '') {
2412: $authtype = '<input type="radio" name="login" value="fsys" '.
2413: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2414: $jscall.'" />';
2415: }
2416: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2417: ' onchange="'.$jscall.'" />';
2418: $result = &mt
1.144 matthew 2419: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2420: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2421: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2422: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2423: 'onchange="'.$jscall.'" />');
1.32 matthew 2424: return $result;
2425: }
2426:
1.586 raeburn 2427: sub get_assignable_auth {
2428: my ($dom) = @_;
2429: if ($dom eq '') {
2430: $dom = $env{'request.role.domain'};
2431: }
2432: my %can_assign = (
2433: krb4 => 1,
2434: krb5 => 1,
2435: int => 1,
2436: loc => 1,
2437: );
2438: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2439: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2440: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2441: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2442: my $context;
2443: if ($env{'request.role'} =~ /^au/) {
2444: $context = 'author';
2445: } elsif ($env{'request.role'} =~ /^dc/) {
2446: $context = 'domain';
2447: } elsif ($env{'request.course.id'}) {
2448: $context = 'course';
2449: }
2450: if ($context) {
2451: if (ref($authhash->{$context}) eq 'HASH') {
2452: %can_assign = %{$authhash->{$context}};
2453: }
2454: }
2455: }
2456: }
2457: my $authnum = 0;
2458: foreach my $key (keys(%can_assign)) {
2459: if ($can_assign{$key}) {
2460: $authnum ++;
2461: }
2462: }
2463: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2464: $authnum --;
2465: }
2466: return ($authnum,%can_assign);
2467: }
2468:
1.80 albertel 2469: ###############################################################
2470: ## Get Kerberos Defaults for Domain ##
2471: ###############################################################
2472: ##
2473: ## Returns default kerberos version and an associated argument
2474: ## as listed in file domain.tab. If not listed, provides
2475: ## appropriate default domain and kerberos version.
2476: ##
2477: #-------------------------------------------
2478:
2479: =pod
2480:
1.648 raeburn 2481: =item * &get_kerberos_defaults()
1.80 albertel 2482:
2483: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2484: version and domain. If not found, it defaults to version 4 and the
2485: domain of the server.
1.80 albertel 2486:
1.648 raeburn 2487: =over 4
2488:
1.80 albertel 2489: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2490:
1.648 raeburn 2491: =back
2492:
2493: =back
2494:
1.80 albertel 2495: =cut
2496:
2497: #-------------------------------------------
2498: sub get_kerberos_defaults {
2499: my $domain=shift;
1.641 raeburn 2500: my ($krbdef,$krbdefdom);
2501: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2502: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2503: $krbdef = $domdefaults{'auth_def'};
2504: $krbdefdom = $domdefaults{'auth_arg_def'};
2505: } else {
1.80 albertel 2506: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2507: my $krbdefdom=$1;
2508: $krbdefdom=~tr/a-z/A-Z/;
2509: $krbdef = "krb4";
2510: }
2511: return ($krbdef,$krbdefdom);
2512: }
1.112 bowersj2 2513:
1.32 matthew 2514:
1.46 matthew 2515: ###############################################################
2516: ## Thesaurus Functions ##
2517: ###############################################################
1.20 www 2518:
1.46 matthew 2519: =pod
1.20 www 2520:
1.112 bowersj2 2521: =head1 Thesaurus Functions
2522:
2523: =over 4
2524:
1.648 raeburn 2525: =item * &initialize_keywords()
1.46 matthew 2526:
2527: Initializes the package variable %Keywords if it is empty. Uses the
2528: package variable $thesaurus_db_file.
2529:
2530: =cut
2531:
2532: ###################################################
2533:
2534: sub initialize_keywords {
2535: return 1 if (scalar keys(%Keywords));
2536: # If we are here, %Keywords is empty, so fill it up
2537: # Make sure the file we need exists...
2538: if (! -e $thesaurus_db_file) {
2539: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2540: " failed because it does not exist");
2541: return 0;
2542: }
2543: # Set up the hash as a database
2544: my %thesaurus_db;
2545: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2546: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2547: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2548: $thesaurus_db_file);
2549: return 0;
2550: }
2551: # Get the average number of appearances of a word.
2552: my $avecount = $thesaurus_db{'average.count'};
2553: # Put keywords (those that appear > average) into %Keywords
2554: while (my ($word,$data)=each (%thesaurus_db)) {
2555: my ($count,undef) = split /:/,$data;
2556: $Keywords{$word}++ if ($count > $avecount);
2557: }
2558: untie %thesaurus_db;
2559: # Remove special values from %Keywords.
1.356 albertel 2560: foreach my $value ('total.count','average.count') {
2561: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2562: }
1.46 matthew 2563: return 1;
2564: }
2565:
2566: ###################################################
2567:
2568: =pod
2569:
1.648 raeburn 2570: =item * &keyword($word)
1.46 matthew 2571:
2572: Returns true if $word is a keyword. A keyword is a word that appears more
2573: than the average number of times in the thesaurus database. Calls
2574: &initialize_keywords
2575:
2576: =cut
2577:
2578: ###################################################
1.20 www 2579:
2580: sub keyword {
1.46 matthew 2581: return if (!&initialize_keywords());
2582: my $word=lc(shift());
2583: $word=~s/\W//g;
2584: return exists($Keywords{$word});
1.20 www 2585: }
1.46 matthew 2586:
2587: ###############################################################
2588:
2589: =pod
1.20 www 2590:
1.648 raeburn 2591: =item * &get_related_words()
1.46 matthew 2592:
1.160 matthew 2593: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2594: an array of words. If the keyword is not in the thesaurus, an empty array
2595: will be returned. The order of the words returned is determined by the
2596: database which holds them.
2597:
2598: Uses global $thesaurus_db_file.
2599:
2600: =cut
2601:
2602: ###############################################################
2603: sub get_related_words {
2604: my $keyword = shift;
2605: my %thesaurus_db;
2606: if (! -e $thesaurus_db_file) {
2607: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2608: "failed because the file does not exist");
2609: return ();
2610: }
2611: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2612: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2613: return ();
2614: }
2615: my @Words=();
1.429 www 2616: my $count=0;
1.46 matthew 2617: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2618: # The first element is the number of times
2619: # the word appears. We do not need it now.
1.429 www 2620: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2621: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2622: my $threshold=$mostfrequentcount/10;
2623: foreach my $possibleword (@RelatedWords) {
2624: my ($word,$wordcount)=split(/\,/,$possibleword);
2625: if ($wordcount>$threshold) {
2626: push(@Words,$word);
2627: $count++;
2628: if ($count>10) { last; }
2629: }
1.20 www 2630: }
2631: }
1.46 matthew 2632: untie %thesaurus_db;
2633: return @Words;
1.14 harris41 2634: }
1.46 matthew 2635:
1.112 bowersj2 2636: =pod
2637:
2638: =back
2639:
2640: =cut
1.61 www 2641:
2642: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2643: =pod
2644:
1.112 bowersj2 2645: =head1 User Name Functions
2646:
2647: =over 4
2648:
1.648 raeburn 2649: =item * &plainname($uname,$udom,$first)
1.81 albertel 2650:
1.112 bowersj2 2651: Takes a users logon name and returns it as a string in
1.226 albertel 2652: "first middle last generation" form
2653: if $first is set to 'lastname' then it returns it as
2654: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2655:
2656: =cut
1.61 www 2657:
1.295 www 2658:
1.81 albertel 2659: ###############################################################
1.61 www 2660: sub plainname {
1.226 albertel 2661: my ($uname,$udom,$first)=@_;
1.537 albertel 2662: return if (!defined($uname) || !defined($udom));
1.295 www 2663: my %names=&getnames($uname,$udom);
1.226 albertel 2664: my $name=&Apache::lonnet::format_name($names{'firstname'},
2665: $names{'middlename'},
2666: $names{'lastname'},
2667: $names{'generation'},$first);
2668: $name=~s/^\s+//;
1.62 www 2669: $name=~s/\s+$//;
2670: $name=~s/\s+/ /g;
1.353 albertel 2671: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2672: return $name;
1.61 www 2673: }
1.66 www 2674:
2675: # -------------------------------------------------------------------- Nickname
1.81 albertel 2676: =pod
2677:
1.648 raeburn 2678: =item * &nickname($uname,$udom)
1.81 albertel 2679:
2680: Gets a users name and returns it as a string as
2681:
2682: ""nickname""
1.66 www 2683:
1.81 albertel 2684: if the user has a nickname or
2685:
2686: "first middle last generation"
2687:
2688: if the user does not
2689:
2690: =cut
1.66 www 2691:
2692: sub nickname {
2693: my ($uname,$udom)=@_;
1.537 albertel 2694: return if (!defined($uname) || !defined($udom));
1.295 www 2695: my %names=&getnames($uname,$udom);
1.68 albertel 2696: my $name=$names{'nickname'};
1.66 www 2697: if ($name) {
2698: $name='"'.$name.'"';
2699: } else {
2700: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2701: $names{'lastname'}.' '.$names{'generation'};
2702: $name=~s/\s+$//;
2703: $name=~s/\s+/ /g;
2704: }
2705: return $name;
2706: }
2707:
1.295 www 2708: sub getnames {
2709: my ($uname,$udom)=@_;
1.537 albertel 2710: return if (!defined($uname) || !defined($udom));
1.433 albertel 2711: if ($udom eq 'public' && $uname eq 'public') {
2712: return ('lastname' => &mt('Public'));
2713: }
1.295 www 2714: my $id=$uname.':'.$udom;
2715: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2716: if ($cached) {
2717: return %{$names};
2718: } else {
2719: my %loadnames=&Apache::lonnet::get('environment',
2720: ['firstname','middlename','lastname','generation','nickname'],
2721: $udom,$uname);
2722: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2723: return %loadnames;
2724: }
2725: }
1.61 www 2726:
1.542 raeburn 2727: # -------------------------------------------------------------------- getemails
1.648 raeburn 2728:
1.542 raeburn 2729: =pod
2730:
1.648 raeburn 2731: =item * &getemails($uname,$udom)
1.542 raeburn 2732:
2733: Gets a user's email information and returns it as a hash with keys:
2734: notification, critnotification, permanentemail
2735:
2736: For notification and critnotification, values are comma-separated lists
1.648 raeburn 2737: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 2738:
1.648 raeburn 2739:
1.542 raeburn 2740: =cut
2741:
1.648 raeburn 2742:
1.466 albertel 2743: sub getemails {
2744: my ($uname,$udom)=@_;
2745: if ($udom eq 'public' && $uname eq 'public') {
2746: return;
2747: }
1.467 www 2748: if (!$udom) { $udom=$env{'user.domain'}; }
2749: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2750: my $id=$uname.':'.$udom;
2751: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2752: if ($cached) {
2753: return %{$names};
2754: } else {
2755: my %loadnames=&Apache::lonnet::get('environment',
2756: ['notification','critnotification',
2757: 'permanentemail'],
2758: $udom,$uname);
2759: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2760: return %loadnames;
2761: }
2762: }
2763:
1.551 albertel 2764: sub flush_email_cache {
2765: my ($uname,$udom)=@_;
2766: if (!$udom) { $udom =$env{'user.domain'}; }
2767: if (!$uname) { $uname=$env{'user.name'}; }
2768: return if ($udom eq 'public' && $uname eq 'public');
2769: my $id=$uname.':'.$udom;
2770: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2771: }
2772:
1.692.4.2 raeburn 2773: # -------------------------------------------------------------------- getlangs
2774:
2775: =pod
2776:
2777: =item * &getlangs($uname,$udom)
2778:
2779: Gets a user's language preference and returns it as a hash with key:
2780: language.
2781:
2782: =cut
2783:
2784:
2785: sub getlangs {
2786: my ($uname,$udom) = @_;
2787: if (!$udom) { $udom =$env{'user.domain'}; }
2788: if (!$uname) { $uname=$env{'user.name'}; }
2789: my $id=$uname.':'.$udom;
2790: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
2791: if ($cached) {
2792: return %{$langs};
2793: } else {
2794: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
2795: $udom,$uname);
2796: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
2797: return %loadlangs;
2798: }
2799: }
2800:
2801: sub flush_langs_cache {
2802: my ($uname,$udom)=@_;
2803: if (!$udom) { $udom =$env{'user.domain'}; }
2804: if (!$uname) { $uname=$env{'user.name'}; }
2805: return if ($udom eq 'public' && $uname eq 'public');
2806: my $id=$uname.':'.$udom;
2807: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
2808: }
2809:
1.61 www 2810: # ------------------------------------------------------------------ Screenname
1.81 albertel 2811:
2812: =pod
2813:
1.648 raeburn 2814: =item * &screenname($uname,$udom)
1.81 albertel 2815:
2816: Gets a users screenname and returns it as a string
2817:
2818: =cut
1.61 www 2819:
2820: sub screenname {
2821: my ($uname,$udom)=@_;
1.258 albertel 2822: if ($uname eq $env{'user.name'} &&
2823: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2824: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2825: return $names{'screenname'};
1.62 www 2826: }
2827:
1.692.4.2 raeburn 2828: # ------------------------------------------------------------- Confirm Wrapper
2829: =pod
2830:
2831: =item confirmwrapper
2832:
2833: Wrap messages about completion of operation in box
2834:
2835: =cut
2836:
2837: sub confirmwrapper {
2838: my ($message)=@_;
2839: if ($message) {
2840: return "\n".'<div class="LC_confirm_box">'."\n"
2841: .$message."\n"
2842: .'</div>'."\n";
2843: } else {
2844: return $message;
2845: }
2846: }
1.212 albertel 2847:
1.62 www 2848: # ------------------------------------------------------------- Message Wrapper
2849:
2850: sub messagewrapper {
1.369 www 2851: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2852: return
1.441 albertel 2853: '<a href="/adm/email?compose=individual&'.
2854: 'recname='.$username.'&recdom='.$domain.
2855: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2856: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2857: }
2858: # --------------------------------------------------------------- Notes Wrapper
2859:
2860: sub noteswrapper {
2861: my ($link,$un,$do)=@_;
2862: return
2863: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2864: }
2865: # ------------------------------------------------------------- Aboutme Wrapper
2866:
2867: sub aboutmewrapper {
1.166 www 2868: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2869: if (!defined($username) && !defined($domain)) {
2870: return;
2871: }
1.205 www 2872: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.692.4.2 raeburn 2873: ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 2874: }
2875:
2876: # ------------------------------------------------------------ Syllabus Wrapper
2877:
2878:
2879: sub syllabuswrapper {
1.109 matthew 2880: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
2881: if ($fontcolor) {
2882: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
2883: }
1.208 matthew 2884: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2885: }
1.14 harris41 2886:
1.208 matthew 2887: sub track_student_link {
1.268 albertel 2888: my ($linktext,$sname,$sdom,$target,$start) = @_;
2889: my $link ="/adm/trackstudent?";
1.208 matthew 2890: my $title = 'View recent activity';
2891: if (defined($sname) && $sname !~ /^\s*$/ &&
2892: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2893: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2894: $title .= ' of this student';
1.268 albertel 2895: }
1.208 matthew 2896: if (defined($target) && $target !~ /^\s*$/) {
2897: $target = qq{target="$target"};
2898: } else {
2899: $target = '';
2900: }
1.268 albertel 2901: if ($start) { $link.='&start='.$start; }
1.554 albertel 2902: $title = &mt($title);
2903: $linktext = &mt($linktext);
1.448 albertel 2904: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2905: &help_open_topic('View_recent_activity');
1.208 matthew 2906: }
2907:
1.692.4.2 raeburn 2908: sub slot_reservations_link {
2909: my ($linktext,$sname,$sdom,$target) = @_;
2910: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
2911: my $title = 'View slot reservation history';
2912: if (defined($sname) && $sname !~ /^\s*$/ &&
2913: defined($sdom) && $sdom !~ /^\s*$/) {
2914: $link .= "&uname=$sname&udom=$sdom";
2915: $title .= ' of this student';
2916: }
2917: if (defined($target) && $target !~ /^\s*$/) {
2918: $target = qq{target="$target"};
2919: } else {
2920: $target = '';
2921: }
2922: $title = &mt($title);
2923: $linktext = &mt($linktext);
2924: return qq{<a href="$link" title="$title" $target>$linktext</a>};
2925: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
2926:
2927: }
2928:
1.508 www 2929: # ===================================================== Display a student photo
2930:
2931:
1.509 albertel 2932: sub student_image_tag {
1.508 www 2933: my ($domain,$user)=@_;
2934: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
2935: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
2936: return '<img src="'.$imgsrc.'" align="right" />';
2937: } else {
2938: return '';
2939: }
2940: }
2941:
1.112 bowersj2 2942: =pod
2943:
2944: =back
2945:
2946: =head1 Access .tab File Data
2947:
2948: =over 4
2949:
1.648 raeburn 2950: =item * &languageids()
1.112 bowersj2 2951:
2952: returns list of all language ids
2953:
2954: =cut
2955:
1.14 harris41 2956: sub languageids {
1.16 harris41 2957: return sort(keys(%language));
1.14 harris41 2958: }
2959:
1.112 bowersj2 2960: =pod
2961:
1.648 raeburn 2962: =item * &languagedescription()
1.112 bowersj2 2963:
2964: returns description of a specified language id
2965:
2966: =cut
2967:
1.14 harris41 2968: sub languagedescription {
1.125 www 2969: my $code=shift;
2970: return ($supported_language{$code}?'* ':'').
2971: $language{$code}.
1.126 www 2972: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 2973: }
2974:
2975: sub plainlanguagedescription {
2976: my $code=shift;
2977: return $language{$code};
2978: }
2979:
2980: sub supportedlanguagecode {
2981: my $code=shift;
2982: return $supported_language{$code};
1.97 www 2983: }
2984:
1.112 bowersj2 2985: =pod
2986:
1.648 raeburn 2987: =item * ©rightids()
1.112 bowersj2 2988:
2989: returns list of all copyrights
2990:
2991: =cut
2992:
2993: sub copyrightids {
2994: return sort(keys(%cprtag));
2995: }
2996:
2997: =pod
2998:
1.648 raeburn 2999: =item * ©rightdescription()
1.112 bowersj2 3000:
3001: returns description of a specified copyright id
3002:
3003: =cut
3004:
3005: sub copyrightdescription {
1.166 www 3006: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3007: }
1.197 matthew 3008:
3009: =pod
3010:
1.648 raeburn 3011: =item * &source_copyrightids()
1.192 taceyjo1 3012:
3013: returns list of all source copyrights
3014:
3015: =cut
3016:
3017: sub source_copyrightids {
3018: return sort(keys(%scprtag));
3019: }
3020:
3021: =pod
3022:
1.648 raeburn 3023: =item * &source_copyrightdescription()
1.192 taceyjo1 3024:
3025: returns description of a specified source copyright id
3026:
3027: =cut
3028:
3029: sub source_copyrightdescription {
3030: return &mt($scprtag{shift(@_)});
3031: }
1.112 bowersj2 3032:
3033: =pod
3034:
1.648 raeburn 3035: =item * &filecategories()
1.112 bowersj2 3036:
3037: returns list of all file categories
3038:
3039: =cut
3040:
3041: sub filecategories {
3042: return sort(keys(%category_extensions));
3043: }
3044:
3045: =pod
3046:
1.648 raeburn 3047: =item * &filecategorytypes()
1.112 bowersj2 3048:
3049: returns list of file types belonging to a given file
3050: category
3051:
3052: =cut
3053:
3054: sub filecategorytypes {
1.356 albertel 3055: my ($cat) = @_;
3056: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3057: }
3058:
3059: =pod
3060:
1.648 raeburn 3061: =item * &fileembstyle()
1.112 bowersj2 3062:
3063: returns embedding style for a specified file type
3064:
3065: =cut
3066:
3067: sub fileembstyle {
3068: return $fe{lc(shift(@_))};
1.169 www 3069: }
3070:
1.351 www 3071: sub filemimetype {
3072: return $fm{lc(shift(@_))};
3073: }
3074:
1.169 www 3075:
3076: sub filecategoryselect {
3077: my ($name,$value)=@_;
1.189 matthew 3078: return &select_form($value,$name,
1.169 www 3079: '' => &mt('Any category'),
3080: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 3081: }
3082:
3083: =pod
3084:
1.648 raeburn 3085: =item * &filedescription()
1.112 bowersj2 3086:
3087: returns description for a specified file type
3088:
3089: =cut
3090:
3091: sub filedescription {
1.188 matthew 3092: my $file_description = $fd{lc(shift())};
3093: $file_description =~ s:([\[\]]):~$1:g;
3094: return &mt($file_description);
1.112 bowersj2 3095: }
3096:
3097: =pod
3098:
1.648 raeburn 3099: =item * &filedescriptionex()
1.112 bowersj2 3100:
3101: returns description for a specified file type with
3102: extra formatting
3103:
3104: =cut
3105:
3106: sub filedescriptionex {
3107: my $ex=shift;
1.188 matthew 3108: my $file_description = $fd{lc($ex)};
3109: $file_description =~ s:([\[\]]):~$1:g;
3110: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3111: }
3112:
3113: # End of .tab access
3114: =pod
3115:
3116: =back
3117:
3118: =cut
3119:
3120: # ------------------------------------------------------------------ File Types
3121: sub fileextensions {
3122: return sort(keys(%fe));
3123: }
3124:
1.97 www 3125: # ----------------------------------------------------------- Display Languages
3126: # returns a hash with all desired display languages
3127: #
3128:
3129: sub display_languages {
3130: my %languages=();
1.692.4.1 raeburn 3131: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3132: $languages{$lang}=1;
1.97 www 3133: }
3134: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3135: if ($env{'form.displaylanguage'}) {
1.356 albertel 3136: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3137: $languages{$lang}=1;
1.97 www 3138: }
3139: }
3140: return %languages;
1.14 harris41 3141: }
3142:
1.582 albertel 3143: sub languages {
3144: my ($possible_langs) = @_;
1.692.4.1 raeburn 3145: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3146: if (!ref($possible_langs)) {
3147: if( wantarray ) {
3148: return @preferred_langs;
3149: } else {
3150: return $preferred_langs[0];
3151: }
3152: }
3153: my %possibilities = map { $_ => 1 } (@$possible_langs);
3154: my @preferred_possibilities;
3155: foreach my $preferred_lang (@preferred_langs) {
3156: if (exists($possibilities{$preferred_lang})) {
3157: push(@preferred_possibilities, $preferred_lang);
3158: }
3159: }
3160: if( wantarray ) {
3161: return @preferred_possibilities;
3162: }
3163: return $preferred_possibilities[0];
3164: }
3165:
1.692.4.2 raeburn 3166: sub user_lang {
3167: my ($touname,$toudom,$fromcid) = @_;
3168: my @userlangs;
3169: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3170: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3171: $env{'course.'.$fromcid.'.languages'}));
3172: } else {
3173: my %langhash = &getlangs($touname,$toudom);
3174: if ($langhash{'languages'} ne '') {
3175: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3176: } else {
3177: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3178: if ($domdefs{'lang_def'} ne '') {
3179: @userlangs = ($domdefs{'lang_def'});
3180: }
3181: }
3182: }
3183: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3184: my $user_lh = Apache::localize->get_handle(@languages);
3185: return $user_lh;
3186: }
3187:
1.112 bowersj2 3188: ###############################################################
3189: ## Student Answer Attempts ##
3190: ###############################################################
3191:
3192: =pod
3193:
3194: =head1 Alternate Problem Views
3195:
3196: =over 4
3197:
1.648 raeburn 3198: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3199: $getattempt, $regexp, $gradesub)
3200:
3201: Return string with previous attempt on problem. Arguments:
3202:
3203: =over 4
3204:
3205: =item * $symb: Problem, including path
3206:
3207: =item * $username: username of the desired student
3208:
3209: =item * $domain: domain of the desired student
1.14 harris41 3210:
1.112 bowersj2 3211: =item * $course: Course ID
1.14 harris41 3212:
1.112 bowersj2 3213: =item * $getattempt: Leave blank for all attempts, otherwise put
3214: something
1.14 harris41 3215:
1.112 bowersj2 3216: =item * $regexp: if string matches this regexp, the string will be
3217: sent to $gradesub
1.14 harris41 3218:
1.112 bowersj2 3219: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3220:
1.112 bowersj2 3221: =back
1.14 harris41 3222:
1.112 bowersj2 3223: The output string is a table containing all desired attempts, if any.
1.16 harris41 3224:
1.112 bowersj2 3225: =cut
1.1 albertel 3226:
3227: sub get_previous_attempt {
1.43 ng 3228: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3229: my $prevattempts='';
1.43 ng 3230: no strict 'refs';
1.1 albertel 3231: if ($symb) {
1.3 albertel 3232: my (%returnhash)=
3233: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3234: if ($returnhash{'version'}) {
3235: my %lasthash=();
3236: my $version;
3237: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3238: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3239: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3240: }
1.1 albertel 3241: }
1.596 albertel 3242: $prevattempts=&start_data_table().&start_data_table_header_row();
3243: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3244: foreach my $key (sort(keys(%lasthash))) {
3245: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3246: if ($#parts > 0) {
1.31 albertel 3247: my $data=$parts[-1];
3248: pop(@parts);
1.596 albertel 3249: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3250: } else {
1.41 ng 3251: if ($#parts == 0) {
3252: $prevattempts.='<th>'.$parts[0].'</th>';
3253: } else {
3254: $prevattempts.='<th>'.$ign.'</th>';
3255: }
1.31 albertel 3256: }
1.16 harris41 3257: }
1.596 albertel 3258: $prevattempts.=&end_data_table_header_row();
1.40 ng 3259: if ($getattempt eq '') {
3260: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3261: $prevattempts.=&start_data_table_row().
3262: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3263: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3264: my $value = &format_previous_attempt_value($key,
3265: $returnhash{$version.':'.$key});
3266: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3267: }
1.596 albertel 3268: $prevattempts.=&end_data_table_row();
1.40 ng 3269: }
1.1 albertel 3270: }
1.596 albertel 3271: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3272: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3273: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3274: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3275: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3276: }
1.596 albertel 3277: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3278: } else {
1.596 albertel 3279: $prevattempts=
3280: &start_data_table().&start_data_table_row().
3281: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3282: &end_data_table_row().&end_data_table();
1.1 albertel 3283: }
3284: } else {
1.596 albertel 3285: $prevattempts=
3286: &start_data_table().&start_data_table_row().
3287: '<td>'.&mt('No data.').'</td>'.
3288: &end_data_table_row().&end_data_table();
1.1 albertel 3289: }
1.10 albertel 3290: }
3291:
1.581 albertel 3292: sub format_previous_attempt_value {
3293: my ($key,$value) = @_;
3294: if ($key =~ /timestamp/) {
3295: $value = &Apache::lonlocal::locallocaltime($value);
3296: } elsif (ref($value) eq 'ARRAY') {
3297: $value = '('.join(', ', @{ $value }).')';
3298: } else {
3299: $value = &unescape($value);
3300: }
3301: return $value;
3302: }
3303:
3304:
1.107 albertel 3305: sub relative_to_absolute {
3306: my ($url,$output)=@_;
3307: my $parser=HTML::TokeParser->new(\$output);
3308: my $token;
3309: my $thisdir=$url;
3310: my @rlinks=();
3311: while ($token=$parser->get_token) {
3312: if ($token->[0] eq 'S') {
3313: if ($token->[1] eq 'a') {
3314: if ($token->[2]->{'href'}) {
3315: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3316: }
3317: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3318: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3319: } elsif ($token->[1] eq 'base') {
3320: $thisdir=$token->[2]->{'href'};
3321: }
3322: }
3323: }
3324: $thisdir=~s-/[^/]*$--;
1.356 albertel 3325: foreach my $link (@rlinks) {
1.692.4.2 raeburn 3326: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3327: ($link=~/^\//) ||
3328: ($link=~/^javascript:/i) ||
3329: ($link=~/^mailto:/i) ||
3330: ($link=~/^\#/)) {
3331: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3332: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3333: }
3334: }
3335: # -------------------------------------------------- Deal with Applet codebases
3336: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3337: return $output;
3338: }
3339:
1.112 bowersj2 3340: =pod
3341:
1.648 raeburn 3342: =item * &get_student_view()
1.112 bowersj2 3343:
3344: show a snapshot of what student was looking at
3345:
3346: =cut
3347:
1.10 albertel 3348: sub get_student_view {
1.186 albertel 3349: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3350: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3351: my (%form);
1.10 albertel 3352: my @elements=('symb','courseid','domain','username');
3353: foreach my $element (@elements) {
1.186 albertel 3354: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3355: }
1.186 albertel 3356: if (defined($moreenv)) {
3357: %form=(%form,%{$moreenv});
3358: }
1.236 albertel 3359: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3360: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3361: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3362: $userview=~s/\<body[^\>]*\>//gi;
3363: $userview=~s/\<\/body\>//gi;
3364: $userview=~s/\<html\>//gi;
3365: $userview=~s/\<\/html\>//gi;
3366: $userview=~s/\<head\>//gi;
3367: $userview=~s/\<\/head\>//gi;
3368: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3369: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3370: if (wantarray) {
3371: return ($userview,$response);
3372: } else {
3373: return $userview;
3374: }
3375: }
3376:
3377: sub get_student_view_with_retries {
3378: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3379:
3380: my $ok = 0; # True if we got a good response.
3381: my $content;
3382: my $response;
3383:
3384: # Try to get the student_view done. within the retries count:
3385:
3386: do {
3387: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3388: $ok = $response->is_success;
3389: if (!$ok) {
3390: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3391: }
3392: $retries--;
3393: } while (!$ok && ($retries > 0));
3394:
3395: if (!$ok) {
3396: $content = ''; # On error return an empty content.
3397: }
1.651 www 3398: if (wantarray) {
3399: return ($content, $response);
3400: } else {
3401: return $content;
3402: }
1.11 albertel 3403: }
3404:
1.112 bowersj2 3405: =pod
3406:
1.648 raeburn 3407: =item * &get_student_answers()
1.112 bowersj2 3408:
3409: show a snapshot of how student was answering problem
3410:
3411: =cut
3412:
1.11 albertel 3413: sub get_student_answers {
1.100 sakharuk 3414: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3415: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3416: my (%moreenv);
1.11 albertel 3417: my @elements=('symb','courseid','domain','username');
3418: foreach my $element (@elements) {
1.186 albertel 3419: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3420: }
1.186 albertel 3421: $moreenv{'grade_target'}='answer';
3422: %moreenv=(%form,%moreenv);
1.497 raeburn 3423: $feedurl = &Apache::lonnet::clutter($feedurl);
3424: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3425: return $userview;
1.1 albertel 3426: }
1.116 albertel 3427:
3428: =pod
3429:
3430: =item * &submlink()
3431:
1.242 albertel 3432: Inputs: $text $uname $udom $symb $target
1.116 albertel 3433:
3434: Returns: A link to grades.pm such as to see the SUBM view of a student
3435:
3436: =cut
3437:
3438: ###############################################
3439: sub submlink {
1.242 albertel 3440: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3441: if (!($uname && $udom)) {
3442: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3443: &Apache::lonnet::whichuser($symb);
1.116 albertel 3444: if (!$symb) { $symb=$cursymb; }
3445: }
1.254 matthew 3446: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3447: $symb=&escape($symb);
1.242 albertel 3448: if ($target) { $target="target=\"$target\""; }
3449: return '<a href="/adm/grades?&command=submission&'.
3450: 'symb='.$symb.'&student='.$uname.
3451: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3452: }
3453: ##############################################
3454:
3455: =pod
3456:
3457: =item * &pgrdlink()
3458:
3459: Inputs: $text $uname $udom $symb $target
3460:
3461: Returns: A link to grades.pm such as to see the PGRD view of a student
3462:
3463: =cut
3464:
3465: ###############################################
3466: sub pgrdlink {
3467: my $link=&submlink(@_);
3468: $link=~s/(&command=submission)/$1&showgrading=yes/;
3469: return $link;
3470: }
3471: ##############################################
3472:
3473: =pod
3474:
3475: =item * &pprmlink()
3476:
3477: Inputs: $text $uname $udom $symb $target
3478:
3479: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3480: student and a specific resource
1.242 albertel 3481:
3482: =cut
3483:
3484: ###############################################
3485: sub pprmlink {
3486: my ($text,$uname,$udom,$symb,$target)=@_;
3487: if (!($uname && $udom)) {
3488: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3489: &Apache::lonnet::whichuser($symb);
1.242 albertel 3490: if (!$symb) { $symb=$cursymb; }
3491: }
1.254 matthew 3492: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3493: $symb=&escape($symb);
1.242 albertel 3494: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3495: return '<a href="/adm/parmset?command=set&'.
3496: 'symb='.$symb.'&uname='.$uname.
3497: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3498: }
3499: ##############################################
1.37 matthew 3500:
1.112 bowersj2 3501: =pod
3502:
3503: =back
3504:
3505: =cut
3506:
1.37 matthew 3507: ###############################################
1.51 www 3508:
3509:
3510: sub timehash {
1.687 raeburn 3511: my ($thistime) = @_;
3512: my $timezone = &Apache::lonlocal::gettimezone();
3513: my $dt = DateTime->from_epoch(epoch => $thistime)
3514: ->set_time_zone($timezone);
3515: my $wday = $dt->day_of_week();
3516: if ($wday == 7) { $wday = 0; }
3517: return ( 'second' => $dt->second(),
3518: 'minute' => $dt->minute(),
3519: 'hour' => $dt->hour(),
3520: 'day' => $dt->day_of_month(),
3521: 'month' => $dt->month(),
3522: 'year' => $dt->year(),
3523: 'weekday' => $wday,
3524: 'dayyear' => $dt->day_of_year(),
3525: 'dlsav' => $dt->is_dst() );
1.51 www 3526: }
3527:
1.370 www 3528: sub utc_string {
3529: my ($date)=@_;
1.371 www 3530: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3531: }
3532:
1.51 www 3533: sub maketime {
3534: my %th=@_;
1.687 raeburn 3535: my ($epoch_time,$timezone,$dt);
3536: $timezone = &Apache::lonlocal::gettimezone();
3537: eval {
3538: $dt = DateTime->new( year => $th{'year'},
3539: month => $th{'month'},
3540: day => $th{'day'},
3541: hour => $th{'hour'},
3542: minute => $th{'minute'},
3543: second => $th{'second'},
3544: time_zone => $timezone,
3545: );
3546: };
3547: if (!$@) {
3548: $epoch_time = $dt->epoch;
3549: if ($epoch_time) {
3550: return $epoch_time;
3551: }
3552: }
1.51 www 3553: return POSIX::mktime(
3554: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3555: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3556: }
3557:
3558: #########################################
1.51 www 3559:
3560: sub findallcourses {
1.482 raeburn 3561: my ($roles,$uname,$udom) = @_;
1.355 albertel 3562: my %roles;
3563: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3564: my %courses;
1.51 www 3565: my $now=time;
1.482 raeburn 3566: if (!defined($uname)) {
3567: $uname = $env{'user.name'};
3568: }
3569: if (!defined($udom)) {
3570: $udom = $env{'user.domain'};
3571: }
3572: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3573: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3574: if (!%roles) {
3575: %roles = (
3576: cc => 1,
3577: in => 1,
3578: ep => 1,
3579: ta => 1,
3580: cr => 1,
3581: st => 1,
3582: );
3583: }
3584: foreach my $entry (keys(%roleshash)) {
3585: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3586: if ($trole =~ /^cr/) {
3587: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3588: } else {
3589: next if (!exists($roles{$trole}));
3590: }
3591: if ($tend) {
3592: next if ($tend < $now);
3593: }
3594: if ($tstart) {
3595: next if ($tstart > $now);
3596: }
3597: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3598: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3599: if ($secpart eq '') {
3600: ($cnum,$role) = split(/_/,$cnumpart);
3601: $sec = 'none';
3602: $realsec = '';
3603: } else {
3604: $cnum = $cnumpart;
3605: ($sec,$role) = split(/_/,$secpart);
3606: $realsec = $sec;
1.490 raeburn 3607: }
1.482 raeburn 3608: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3609: }
3610: } else {
3611: foreach my $key (keys(%env)) {
1.483 albertel 3612: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3613: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3614: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3615: next if ($role eq 'ca' || $role eq 'aa');
3616: next if (%roles && !exists($roles{$role}));
3617: my ($starttime,$endtime)=split(/\./,$env{$key});
3618: my $active=1;
3619: if ($starttime) {
3620: if ($now<$starttime) { $active=0; }
3621: }
3622: if ($endtime) {
3623: if ($now>$endtime) { $active=0; }
3624: }
3625: if ($active) {
3626: if ($sec eq '') {
3627: $sec = 'none';
3628: }
3629: $courses{$cdom.'_'.$cnum}{$sec} =
3630: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3631: }
3632: }
1.51 www 3633: }
3634: }
1.474 raeburn 3635: return %courses;
1.51 www 3636: }
1.37 matthew 3637:
1.54 www 3638: ###############################################
1.474 raeburn 3639:
3640: sub blockcheck {
1.482 raeburn 3641: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3642:
3643: if (!defined($udom)) {
3644: $udom = $env{'user.domain'};
3645: }
3646: if (!defined($uname)) {
3647: $uname = $env{'user.name'};
3648: }
3649:
3650: # If uname and udom are for a course, check for blocks in the course.
3651:
3652: if (&Apache::lonnet::is_course($udom,$uname)) {
3653: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3654: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3655: return ($startblock,$endblock);
3656: }
1.474 raeburn 3657:
1.502 raeburn 3658: my $startblock = 0;
3659: my $endblock = 0;
1.482 raeburn 3660: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3661:
1.490 raeburn 3662: # If uname is for a user, and activity is course-specific, i.e.,
3663: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3664:
1.490 raeburn 3665: if (($activity eq 'boards' || $activity eq 'chat' ||
3666: $activity eq 'groups') && ($env{'request.course.id'})) {
3667: foreach my $key (keys(%live_courses)) {
3668: if ($key ne $env{'request.course.id'}) {
3669: delete($live_courses{$key});
3670: }
3671: }
3672: }
3673:
3674: my $otheruser = 0;
3675: my %own_courses;
3676: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3677: # Resource belongs to user other than current user.
3678: $otheruser = 1;
3679: # Gather courses for current user
3680: %own_courses =
3681: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3682: }
3683:
3684: # Gather active course roles - course coordinator, instructor,
3685: # exam proctor, ta, student, or custom role.
1.474 raeburn 3686:
3687: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3688: my ($cdom,$cnum);
3689: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3690: $cdom = $env{'course.'.$course.'.domain'};
3691: $cnum = $env{'course.'.$course.'.num'};
3692: } else {
1.490 raeburn 3693: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3694: }
3695: my $no_ownblock = 0;
3696: my $no_userblock = 0;
1.533 raeburn 3697: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3698: # Check if current user has 'evb' priv for this
3699: if (defined($own_courses{$course})) {
3700: foreach my $sec (keys(%{$own_courses{$course}})) {
3701: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3702: if ($sec ne 'none') {
3703: $checkrole .= '/'.$sec;
3704: }
3705: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3706: $no_ownblock = 1;
3707: last;
3708: }
3709: }
3710: }
3711: # if they have 'evb' priv and are currently not playing student
3712: next if (($no_ownblock) &&
3713: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3714: }
1.474 raeburn 3715: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3716: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3717: if ($sec ne 'none') {
1.482 raeburn 3718: $checkrole .= '/'.$sec;
1.474 raeburn 3719: }
1.490 raeburn 3720: if ($otheruser) {
3721: # Resource belongs to user other than current user.
3722: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3723: my ($trole,$tdom,$tnum,$tsec);
3724: my $entry = $live_courses{$course}{$sec};
3725: if ($entry =~ /^cr/) {
3726: ($trole,$tdom,$tnum,$tsec) =
3727: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3728: } else {
3729: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3730: }
3731: my ($spec,$area,$trest,%allroles,%userroles);
3732: $area = '/'.$tdom.'/'.$tnum;
3733: $trest = $tnum;
3734: if ($tsec ne '') {
3735: $area .= '/'.$tsec;
3736: $trest .= '/'.$tsec;
3737: }
3738: $spec = $trole.'.'.$area;
3739: if ($trole =~ /^cr/) {
3740: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3741: $tdom,$spec,$trest,$area);
3742: } else {
3743: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3744: $tdom,$spec,$trest,$area);
3745: }
3746: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3747: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3748: if ($1) {
3749: $no_userblock = 1;
3750: last;
3751: }
3752: }
1.490 raeburn 3753: } else {
3754: # Resource belongs to current user
3755: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3756: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3757: $no_ownblock = 1;
3758: last;
3759: }
1.474 raeburn 3760: }
3761: }
3762: # if they have the evb priv and are currently not playing student
1.482 raeburn 3763: next if (($no_ownblock) &&
1.491 albertel 3764: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3765: next if ($no_userblock);
1.474 raeburn 3766:
1.490 raeburn 3767: # Retrieve blocking times and identity of blocker for course
3768: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3769:
3770: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3771: if (($start != 0) &&
3772: (($startblock == 0) || ($startblock > $start))) {
3773: $startblock = $start;
3774: }
3775: if (($end != 0) &&
3776: (($endblock == 0) || ($endblock < $end))) {
3777: $endblock = $end;
3778: }
1.490 raeburn 3779: }
3780: return ($startblock,$endblock);
3781: }
3782:
3783: sub get_blocks {
3784: my ($setters,$activity,$cdom,$cnum) = @_;
3785: my $startblock = 0;
3786: my $endblock = 0;
3787: my $course = $cdom.'_'.$cnum;
3788: $setters->{$course} = {};
3789: $setters->{$course}{'staff'} = [];
3790: $setters->{$course}{'times'} = [];
3791: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3792: foreach my $record (keys(%records)) {
3793: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3794: if ($start <= time && $end >= time) {
3795: my ($staff_name,$staff_dom,$title,$blocks) =
3796: &parse_block_record($records{$record});
3797: if ($blocks->{$activity} eq 'on') {
3798: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3799: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3800: if ( ($startblock == 0) || ($startblock > $start) ) {
3801: $startblock = $start;
1.490 raeburn 3802: }
1.491 albertel 3803: if ( ($endblock == 0) || ($endblock < $end) ) {
3804: $endblock = $end;
1.474 raeburn 3805: }
3806: }
3807: }
3808: }
3809: return ($startblock,$endblock);
3810: }
3811:
3812: sub parse_block_record {
3813: my ($record) = @_;
3814: my ($setuname,$setudom,$title,$blocks);
3815: if (ref($record) eq 'HASH') {
3816: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3817: $title = &unescape($record->{'event'});
3818: $blocks = $record->{'blocks'};
3819: } else {
3820: my @data = split(/:/,$record,3);
3821: if (scalar(@data) eq 2) {
3822: $title = $data[1];
3823: ($setuname,$setudom) = split(/@/,$data[0]);
3824: } else {
3825: ($setuname,$setudom,$title) = @data;
3826: }
3827: $blocks = { 'com' => 'on' };
3828: }
3829: return ($setuname,$setudom,$title,$blocks);
3830: }
3831:
3832: sub build_block_table {
3833: my ($startblock,$endblock,$setters) = @_;
3834: my %lt = &Apache::lonlocal::texthash(
3835: 'cacb' => 'Currently active communication blocks',
3836: 'cour' => 'Course',
3837: 'dura' => 'Duration',
3838: 'blse' => 'Block set by'
3839: );
3840: my $output;
1.476 raeburn 3841: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 3842: $output .= &start_data_table();
3843: $output .= '
3844: <tr>
3845: <th>'.$lt{'cour'}.'</th>
3846: <th>'.$lt{'dura'}.'</th>
3847: <th>'.$lt{'blse'}.'</th>
3848: </tr>
3849: ';
3850: foreach my $course (keys(%{$setters})) {
3851: my %courseinfo=&Apache::lonnet::coursedescription($course);
3852: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
3853: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 3854: my $fullname = &plainname($uname,$udom);
3855: if (defined($env{'user.name'}) && defined($env{'user.domain'})
3856: && $env{'user.name'} ne 'public'
3857: && $env{'user.domain'} ne 'public') {
3858: $fullname = &aboutmewrapper($fullname,$uname,$udom);
3859: }
1.474 raeburn 3860: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
3861: $openblock = &Apache::lonlocal::locallocaltime($openblock);
3862: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
3863: $output .= &Apache::loncommon::start_data_table_row().
3864: '<td>'.$courseinfo{'description'}.'</td>'.
3865: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 3866: '<td>'.$fullname.'</td>'.
1.474 raeburn 3867: &Apache::loncommon::end_data_table_row();
3868: }
3869: }
3870: $output .= &end_data_table();
3871: }
3872:
1.490 raeburn 3873: sub blocking_status {
3874: my ($activity,$uname,$udom) = @_;
3875: my %setters;
3876: my ($blocked,$output,$ownitem,$is_course);
3877: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
3878: if ($startblock && $endblock) {
3879: $blocked = 1;
3880: if (wantarray) {
3881: my $category;
3882: if ($activity eq 'boards') {
3883: $category = 'Discussion posts in this course';
3884: } elsif ($activity eq 'blogs') {
3885: $category = 'Blogs';
3886: } elsif ($activity eq 'port') {
3887: if (defined($uname) && defined($udom)) {
3888: if ($uname eq $env{'user.name'} &&
3889: $udom eq $env{'user.domain'}) {
3890: $ownitem = 1;
3891: }
3892: }
3893: $is_course = &Apache::lonnet::is_course($udom,$uname);
3894: if ($ownitem) {
3895: $category = 'Your portfolio files';
3896: } elsif ($is_course) {
3897: my $coursedesc;
3898: foreach my $course (keys(%setters)) {
3899: my %courseinfo =
3900: &Apache::lonnet::coursedescription($course);
3901: $coursedesc = $courseinfo{'description'};
3902: }
1.692.4.2 raeburn 3903: $category = "Group portfolio files in the course '$coursedesc'";
1.490 raeburn 3904: } else {
3905: $category = 'Portfolio files belonging to ';
3906: if ($env{'user.name'} eq 'public' &&
3907: $env{'user.domain'} eq 'public') {
3908: $category .= &plainname($uname,$udom);
3909: } else {
3910: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
3911: }
3912: }
3913: } elsif ($activity eq 'groups') {
3914: $category = 'Groups in this course';
3915: }
3916: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
3917: my $showend = &Apache::lonlocal::locallocaltime($endblock);
3918: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
3919: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
3920: $output .= &build_block_table($startblock,$endblock,\%setters);
3921: }
3922: }
3923: }
3924: if (wantarray) {
3925: return ($blocked,$output);
3926: } else {
3927: return $blocked;
3928: }
3929: }
3930:
1.60 matthew 3931: ###############################################
3932:
1.682 raeburn 3933: sub check_ip_acc {
3934: my ($acc)=@_;
3935: &Apache::lonxml::debug("acc is $acc");
3936: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
3937: return 1;
3938: }
3939: my $allowed=0;
3940: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
3941:
3942: my $name;
3943: foreach my $pattern (split(',',$acc)) {
3944: $pattern =~ s/^\s*//;
3945: $pattern =~ s/\s*$//;
3946: if ($pattern =~ /\*$/) {
3947: #35.8.*
3948: $pattern=~s/\*//;
3949: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
3950: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
3951: #35.8.3.[34-56]
3952: my $low=$2;
3953: my $high=$3;
3954: $pattern=$1;
3955: if ($ip =~ /^\Q$pattern\E/) {
3956: my $last=(split(/\./,$ip))[3];
3957: if ($last <=$high && $last >=$low) { $allowed=1; }
3958: }
3959: } elsif ($pattern =~ /^\*/) {
3960: #*.msu.edu
3961: $pattern=~s/\*//;
3962: if (!defined($name)) {
3963: use Socket;
3964: my $netaddr=inet_aton($ip);
3965: ($name)=gethostbyaddr($netaddr,AF_INET);
3966: }
3967: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
3968: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
3969: #127.0.0.1
3970: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
3971: } else {
3972: #some.name.com
3973: if (!defined($name)) {
3974: use Socket;
3975: my $netaddr=inet_aton($ip);
3976: ($name)=gethostbyaddr($netaddr,AF_INET);
3977: }
3978: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
3979: }
3980: if ($allowed) { last; }
3981: }
3982: return $allowed;
3983: }
3984:
3985: ###############################################
3986:
1.60 matthew 3987: =pod
3988:
1.112 bowersj2 3989: =head1 Domain Template Functions
3990:
3991: =over 4
3992:
3993: =item * &determinedomain()
1.60 matthew 3994:
3995: Inputs: $domain (usually will be undef)
3996:
1.63 www 3997: Returns: Determines which domain should be used for designs
1.60 matthew 3998:
3999: =cut
1.54 www 4000:
1.60 matthew 4001: ###############################################
1.63 www 4002: sub determinedomain {
4003: my $domain=shift;
1.531 albertel 4004: if (! $domain) {
1.60 matthew 4005: # Determine domain if we have not been given one
4006: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258 albertel 4007: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4008: if ($env{'request.role.domain'}) {
4009: $domain=$env{'request.role.domain'};
1.60 matthew 4010: }
4011: }
1.63 www 4012: return $domain;
4013: }
4014: ###############################################
1.517 raeburn 4015:
1.518 albertel 4016: sub devalidate_domconfig_cache {
4017: my ($udom)=@_;
4018: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4019: }
4020:
4021: # ---------------------- Get domain configuration for a domain
4022: sub get_domainconf {
4023: my ($udom) = @_;
4024: my $cachetime=1800;
4025: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4026: if (defined($cached)) { return %{$result}; }
4027:
4028: my %domconfig = &Apache::lonnet::get_dom('configuration',
4029: ['login','rolecolors'],$udom);
1.632 raeburn 4030: my (%designhash,%legacy);
1.518 albertel 4031: if (keys(%domconfig) > 0) {
4032: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4033: if (keys(%{$domconfig{'login'}})) {
4034: foreach my $key (keys(%{$domconfig{'login'}})) {
1.692.4.2 raeburn 4035: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4036: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4037: $designhash{$udom.'.login.'.$key.'_'.$img} =
4038: $domconfig{'login'}{$key}{$img};
4039: }
4040: } else {
4041: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4042: }
1.632 raeburn 4043: }
4044: } else {
4045: $legacy{'login'} = 1;
1.518 albertel 4046: }
1.632 raeburn 4047: } else {
4048: $legacy{'login'} = 1;
1.518 albertel 4049: }
4050: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4051: if (keys(%{$domconfig{'rolecolors'}})) {
4052: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4053: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4054: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4055: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4056: }
1.518 albertel 4057: }
4058: }
1.632 raeburn 4059: } else {
4060: $legacy{'rolecolors'} = 1;
1.518 albertel 4061: }
1.632 raeburn 4062: } else {
4063: $legacy{'rolecolors'} = 1;
1.518 albertel 4064: }
1.632 raeburn 4065: if (keys(%legacy) > 0) {
4066: my %legacyhash = &get_legacy_domconf($udom);
4067: foreach my $item (keys(%legacyhash)) {
4068: if ($item =~ /^\Q$udom\E\.login/) {
4069: if ($legacy{'login'}) {
4070: $designhash{$item} = $legacyhash{$item};
4071: }
4072: } else {
4073: if ($legacy{'rolecolors'}) {
4074: $designhash{$item} = $legacyhash{$item};
4075: }
1.518 albertel 4076: }
4077: }
4078: }
1.632 raeburn 4079: } else {
4080: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4081: }
4082: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4083: $cachetime);
4084: return %designhash;
4085: }
4086:
1.632 raeburn 4087: sub get_legacy_domconf {
4088: my ($udom) = @_;
4089: my %legacyhash;
4090: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4091: my $designfile = $designdir.'/'.$udom.'.tab';
4092: if (-e $designfile) {
4093: if ( open (my $fh,"<$designfile") ) {
4094: while (my $line = <$fh>) {
4095: next if ($line =~ /^\#/);
4096: chomp($line);
4097: my ($key,$val)=(split(/\=/,$line));
4098: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4099: }
4100: close($fh);
4101: }
4102: }
4103: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
4104: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4105: }
4106: return %legacyhash;
4107: }
4108:
1.63 www 4109: =pod
4110:
1.112 bowersj2 4111: =item * &domainlogo()
1.63 www 4112:
4113: Inputs: $domain (usually will be undef)
4114:
4115: Returns: A link to a domain logo, if the domain logo exists.
4116: If the domain logo does not exist, a description of the domain.
4117:
4118: =cut
1.112 bowersj2 4119:
1.63 www 4120: ###############################################
4121: sub domainlogo {
1.517 raeburn 4122: my $domain = &determinedomain(shift);
1.518 albertel 4123: my %designhash = &get_domainconf($domain);
1.517 raeburn 4124: # See if there is a logo
4125: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4126: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4127: if ($imgsrc =~ m{^/(adm|res)/}) {
4128: if ($imgsrc =~ m{^/res/}) {
4129: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4130: &Apache::lonnet::repcopy($local_name);
4131: }
4132: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4133: }
4134: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4135: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4136: return &Apache::lonnet::domain($domain,'description');
1.59 www 4137: } else {
1.60 matthew 4138: return '';
1.59 www 4139: }
4140: }
1.63 www 4141: ##############################################
4142:
4143: =pod
4144:
1.112 bowersj2 4145: =item * &designparm()
1.63 www 4146:
4147: Inputs: $which parameter; $domain (usually will be undef)
4148:
4149: Returns: value of designparamter $which
4150:
4151: =cut
1.112 bowersj2 4152:
1.397 albertel 4153:
1.400 albertel 4154: ##############################################
1.397 albertel 4155: sub designparm {
4156: my ($which,$domain)=@_;
1.258 albertel 4157: if ($env{'browser.blackwhite'} eq 'on') {
1.635 raeburn 4158: if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110 www 4159: return '#000000';
4160: }
1.635 raeburn 4161: if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110 www 4162: return '#FFFFFF';
4163: }
4164: if ($which=~/\.tabbg$/) {
4165: return '#CCCCCC';
4166: }
4167: }
1.397 albertel 4168: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 4169: return $env{'environment.color.'.$which};
1.96 www 4170: }
1.63 www 4171: $domain=&determinedomain($domain);
1.518 albertel 4172: my %domdesign = &get_domainconf($domain);
1.520 raeburn 4173: my $output;
1.517 raeburn 4174: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 4175: $output = $domdesign{$domain.'.'.$which};
1.63 www 4176: } else {
1.520 raeburn 4177: $output = $defaultdesign{$which};
4178: }
4179: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4180: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4181: if ($output =~ m{^/(adm|res)/}) {
4182: if ($output =~ m{^/res/}) {
4183: my $local_name = &Apache::lonnet::filelocation('',$output);
4184: &Apache::lonnet::repcopy($local_name);
4185: }
1.520 raeburn 4186: $output = &lonhttpdurl($output);
4187: }
1.63 www 4188: }
1.520 raeburn 4189: return $output;
1.63 www 4190: }
1.59 www 4191:
1.60 matthew 4192: ###############################################
4193: ###############################################
4194:
4195: =pod
4196:
1.112 bowersj2 4197: =back
4198:
1.549 albertel 4199: =head1 HTML Helpers
1.112 bowersj2 4200:
4201: =over 4
4202:
4203: =item * &bodytag()
1.60 matthew 4204:
4205: Returns a uniform header for LON-CAPA web pages.
4206:
4207: Inputs:
4208:
1.112 bowersj2 4209: =over 4
4210:
4211: =item * $title, A title to be displayed on the page.
4212:
4213: =item * $function, the current role (can be undef).
4214:
4215: =item * $addentries, extra parameters for the <body> tag.
4216:
4217: =item * $bodyonly, if defined, only return the <body> tag.
4218:
4219: =item * $domain, if defined, force a given domain.
4220:
4221: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4222: text interface only)
1.60 matthew 4223:
1.326 albertel 4224: =item * $customtitle, alternate text to use instead of $title
4225: in the title box that appears, this text
4226: is not auto translated like the $title is
1.309 albertel 4227:
4228: =item * $notopbar, if true, keep the 'what is this' info but remove the
4229: navigational links
1.317 albertel 4230:
1.338 albertel 4231: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4232:
4233: =item * $notitle, if true keep the nav controls, but remove the title bar
4234:
1.361 albertel 4235: =item * $no_inline_link, if true and in remote mode, don't show the
4236: 'Switch To Inline Menu' link
4237:
1.460 albertel 4238: =item * $args, optional argument valid values are
4239: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4240: inherit_jsmath -> when creating popup window in a page,
4241: should it have jsmath forced on by the
4242: current page
1.460 albertel 4243:
1.112 bowersj2 4244: =back
4245:
1.60 matthew 4246: Returns: A uniform header for LON-CAPA web pages.
4247: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
4248: If $bodyonly is undef or zero, an html string containing a <body> tag and
4249: other decorations will be returned.
4250:
4251: =cut
4252:
1.54 www 4253: sub bodytag {
1.309 albertel 4254: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 4255: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 4256:
1.460 albertel 4257: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 4258:
1.183 matthew 4259: $function = &get_users_function() if (!$function);
1.339 albertel 4260: my $img = &designparm($function.'.img',$domain);
4261: my $font = &designparm($function.'.font',$domain);
4262: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
4263:
1.692.4.2 raeburn 4264: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 4265: 'bgcolor' => $pgbg,
1.339 albertel 4266: 'text' => $font,
4267: 'alink' => &designparm($function.'.alink',$domain),
4268: 'vlink' => &designparm($function.'.vlink',$domain),
4269: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 4270: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 4271:
1.63 www 4272: # role and realm
1.378 raeburn 4273: my ($role,$realm) = split(/\./,$env{'request.role'},2);
4274: if ($role eq 'ca') {
1.479 albertel 4275: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 4276: $realm = &plainname($rname,$rdom);
1.378 raeburn 4277: }
1.55 www 4278: # realm
1.258 albertel 4279: if ($env{'request.course.id'}) {
1.378 raeburn 4280: if ($env{'request.role'} !~ /^cr/) {
4281: $role = &Apache::lonnet::plaintext($role,&course_type());
4282: }
1.359 albertel 4283: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 4284: } else {
4285: $role = &Apache::lonnet::plaintext($role);
1.54 www 4286: }
1.433 albertel 4287:
1.359 albertel 4288: if (!$realm) { $realm=' '; }
1.55 www 4289: # Set messages
1.60 matthew 4290: my $messages=&domainlogo($domain);
1.330 albertel 4291:
1.438 albertel 4292: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 4293:
1.101 www 4294: # construct main body tag
1.359 albertel 4295: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 4296: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 4297:
1.530 albertel 4298: if ($bodyonly) {
1.60 matthew 4299: return $bodytag;
1.258 albertel 4300: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 4301: # Accessibility
1.224 raeburn 4302:
1.337 albertel 4303: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 4304: if (!$notitle) {
1.337 albertel 4305: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
4306: }
4307: return $bodytag;
1.359 albertel 4308: }
4309:
1.410 albertel 4310: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4311: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4312: undef($role);
1.434 albertel 4313: } else {
4314: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4315: }
1.359 albertel 4316:
4317: my $roleinfo=(<<ENDROLE);
4318: <td class="LC_title_bar_who">
4319: <div class="LC_title_bar_name">
1.410 albertel 4320: $name
1.361 albertel 4321:
1.359 albertel 4322: </div>
4323: <div class="LC_title_bar_role">
1.361 albertel 4324: $role
1.359 albertel 4325: </div>
4326: <div class="LC_title_bar_realm">
1.361 albertel 4327: $realm
1.359 albertel 4328: </div>
1.206 albertel 4329: </td>
4330: ENDROLE
1.235 raeburn 4331:
1.359 albertel 4332: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
4333: if ($customtitle) {
4334: $titleinfo = $customtitle;
4335: }
4336: #
4337: # Extra info if you are the DC
4338: my $dc_info = '';
4339: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4340: $env{'course.'.$env{'request.course.id'}.
4341: '.domain'}.'/'})) {
4342: my $cid = $env{'request.course.id'};
4343: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4344: $dc_info =~ s/\s+$//;
1.359 albertel 4345: $dc_info = '('.$dc_info.')';
4346: }
4347:
1.644 www 4348: if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
1.359 albertel 4349: # No Remote
1.258 albertel 4350: if ($env{'request.state'} eq 'construct') {
1.359 albertel 4351: $forcereg=1;
4352: }
4353:
4354: if (!$customtitle && $env{'request.state'} eq 'construct') {
4355: # this is for resources; directories have customtitle, and crumbs
4356: # and select recent are created in lonpubdir.pm
1.229 albertel 4357: my ($uname,$thisdisfn)=
1.258 albertel 4358: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 4359: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4360: $formaction=~s/\/+/\//g;
4361:
1.359 albertel 4362: my $parentpath = '';
4363: my $lastitem = '';
4364: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4365: $parentpath = $1;
4366: $lastitem = $2;
4367: } else {
4368: $lastitem = $thisdisfn;
4369: }
4370: $titleinfo =
1.640 bisitz 4371: &Apache::loncommon::help_open_menu('','',3,'Authoring')
4372: .'<b>'.&mt('Construction Space').'</b>: '
4373: .'<form name="dirs" method="post" action="'.$formaction
1.359 albertel 4374: .'" target="_top"><tt><b>'
4375: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
4376: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4377: .'</form>'
4378: .&Apache::lonmenu::constspaceform();
1.235 raeburn 4379: }
1.359 albertel 4380:
1.337 albertel 4381: my $titletable;
1.338 albertel 4382: if (!$notitle) {
1.337 albertel 4383: $titletable =
1.359 albertel 4384: '<table id="LC_title_bar">'.
4385: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
4386: '</tr></table>';
1.337 albertel 4387: }
1.359 albertel 4388: if ($notopbar) {
4389: $bodytag .= $titletable;
4390: } else {
4391: if ($env{'request.state'} eq 'construct') {
1.337 albertel 4392: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
4393: $titletable);
1.272 raeburn 4394: } else {
1.336 albertel 4395: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 4396: $titletable;
1.272 raeburn 4397: }
1.235 raeburn 4398: }
4399: return $bodytag;
1.94 www 4400: }
1.95 www 4401:
1.93 www 4402: #
1.95 www 4403: # Top frame rendering, Remote is up
1.93 www 4404: #
1.359 albertel 4405:
1.517 raeburn 4406: my $imgsrc = $img;
4407: if ($img =~ /^\/adm/) {
1.575 albertel 4408: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4409: }
4410: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4411:
1.305 www 4412: # Explicit link to get inline menu
1.361 albertel 4413: my $menu= ($no_inline_link?''
4414: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 4415: #
1.338 albertel 4416: if ($notitle) {
1.337 albertel 4417: return $bodytag;
4418: }
1.94 www 4419: return(<<ENDBODY);
1.60 matthew 4420: $bodytag
1.359 albertel 4421: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4422: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4423: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4424: </tr>
1.359 albertel 4425: <tr><td>$titleinfo $dc_info $menu</td>
4426: $roleinfo
1.368 albertel 4427: </tr>
1.356 albertel 4428: </table>
1.54 www 4429: ENDBODY
1.182 matthew 4430: }
4431:
1.330 albertel 4432: sub make_attr_string {
4433: my ($register,$attr_ref) = @_;
4434:
4435: if ($attr_ref && !ref($attr_ref)) {
4436: die("addentries Must be a hash ref ".
4437: join(':',caller(1))." ".
4438: join(':',caller(0))." ");
4439: }
4440:
4441: if ($register) {
1.339 albertel 4442: my ($on_load,$on_unload);
4443: foreach my $key (keys(%{$attr_ref})) {
4444: if (lc($key) eq 'onload') {
4445: $on_load.=$attr_ref->{$key}.';';
4446: delete($attr_ref->{$key});
4447:
4448: } elsif (lc($key) eq 'onunload') {
4449: $on_unload.=$attr_ref->{$key}.';';
4450: delete($attr_ref->{$key});
4451: }
4452: }
4453: $attr_ref->{'onload'} =
4454: &Apache::lonmenu::loadevents(). $on_load;
4455: $attr_ref->{'onunload'}=
4456: &Apache::lonmenu::unloadevents().$on_unload;
4457: }
4458:
4459: # Accessibility font enhance
4460: if ($env{'browser.fontenhance'} eq 'on') {
4461: my $style;
4462: foreach my $key (keys(%{$attr_ref})) {
4463: if (lc($key) eq 'style') {
4464: $style.=$attr_ref->{$key}.';';
4465: delete($attr_ref->{$key});
4466: }
4467: }
4468: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4469: }
1.339 albertel 4470:
4471: if ($env{'browser.blackwhite'} eq 'on') {
4472: delete($attr_ref->{'font'});
4473: delete($attr_ref->{'link'});
4474: delete($attr_ref->{'alink'});
4475: delete($attr_ref->{'vlink'});
4476: delete($attr_ref->{'bgcolor'});
4477: delete($attr_ref->{'background'});
4478: }
4479:
1.330 albertel 4480: my $attr_string;
4481: foreach my $attr (keys(%$attr_ref)) {
4482: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4483: }
4484: return $attr_string;
4485: }
4486:
4487:
1.182 matthew 4488: ###############################################
1.251 albertel 4489: ###############################################
4490:
4491: =pod
4492:
4493: =item * &endbodytag()
4494:
4495: Returns a uniform footer for LON-CAPA web pages.
4496:
1.635 raeburn 4497: Inputs: 1 - optional reference to an args hash
4498: If in the hash, key for noredirectlink has a value which evaluates to true,
4499: a 'Continue' link is not displayed if the page contains an
4500: internal redirect in the <head></head> section,
4501: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4502:
4503: =cut
4504:
4505: sub endbodytag {
1.635 raeburn 4506: my ($args) = @_;
1.251 albertel 4507: my $endbodytag='</body>';
1.269 albertel 4508: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4509: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4510: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4511: $endbodytag=
4512: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4513: &mt('Continue').'</a>'.
4514: $endbodytag;
4515: }
1.315 albertel 4516: }
1.251 albertel 4517: return $endbodytag;
4518: }
4519:
1.352 albertel 4520: =pod
4521:
4522: =item * &standard_css()
4523:
4524: Returns a style sheet
4525:
4526: Inputs: (all optional)
4527: domain -> force to color decorate a page for a specific
4528: domain
4529: function -> force usage of a specific rolish color scheme
4530: bgcolor -> override the default page bgcolor
4531:
4532: =cut
4533:
1.343 albertel 4534: sub standard_css {
1.345 albertel 4535: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4536: $function = &get_users_function() if (!$function);
4537: my $img = &designparm($function.'.img', $domain);
4538: my $tabbg = &designparm($function.'.tabbg', $domain);
4539: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4540: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4541: my $pgbg_or_bgcolor =
4542: $bgcolor ||
1.352 albertel 4543: &designparm($function.'.pgbg', $domain);
1.382 albertel 4544: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4545: my $alink = &designparm($function.'.alink', $domain);
4546: my $vlink = &designparm($function.'.vlink', $domain);
4547: my $link = &designparm($function.'.link', $domain);
4548:
1.602 albertel 4549: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4550: my $mono = 'monospace';
1.352 albertel 4551: my $data_table_head = $tabbg;
4552: my $data_table_light = '#EEEEEE';
1.470 banghart 4553: my $data_table_dark = '#DDDDDD';
4554: my $data_table_darker = '#CCCCCC';
1.349 albertel 4555: my $data_table_highlight = '#FFFF00';
1.352 albertel 4556: my $mail_new = '#FFBB77';
4557: my $mail_new_hover = '#DD9955';
4558: my $mail_read = '#BBBB77';
4559: my $mail_read_hover = '#999944';
4560: my $mail_replied = '#AAAA88';
4561: my $mail_replied_hover = '#888855';
4562: my $mail_other = '#99BBBB';
4563: my $mail_other_hover = '#669999';
1.391 albertel 4564: my $table_header = '#DDDDDD';
1.489 raeburn 4565: my $feedback_link_bg = '#BBBBBB';
1.692.4.3 raeburn 4566: my $lg_border_color = '#C8C8C8';
1.392 albertel 4567:
1.608 albertel 4568: my $border = ($env{'browser.type'} eq 'explorer' ||
1.692.4.2 raeburn 4569: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
4570: : '0 3px 0 4px';
1.448 albertel 4571:
1.523 albertel 4572:
1.343 albertel 4573: return <<END;
1.345 albertel 4574: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4575: a:focus { color: red; background: yellow }
1.510 albertel 4576: table.thinborder,
1.523 albertel 4577:
1.510 albertel 4578: table.thinborder tr th {
4579: border-style: solid;
4580: border-width: 1px;
4581: background: $tabbg;
4582: }
1.523 albertel 4583: table.thinborder tr td {
1.510 albertel 4584: border-style: solid;
4585: border-width: 1px
4586: }
1.426 albertel 4587:
1.343 albertel 4588: form, .inline { display: inline; }
4589: .center { text-align: center; }
1.593 albertel 4590: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4591: .LC_error {
4592: color: red;
4593: font-size: larger;
4594: }
1.457 albertel 4595: .LC_warning,
4596: .LC_diff_removed {
1.394 albertel 4597: color: red;
4598: }
1.532 albertel 4599:
4600: .LC_info,
1.457 albertel 4601: .LC_success,
4602: .LC_diff_added {
1.350 albertel 4603: color: green;
4604: }
1.692.4.2 raeburn 4605:
4606: div.LC_confirm_box {
4607: background-color: #FAFAFA;
4608: border: 1px solid $lg_border_color;
4609: margin-right: 0;
4610: padding: 5px;
4611: }
4612:
4613: div.LC_confirm_box .LC_error img,
4614: div.LC_confirm_box .LC_success img {
4615: vertical-align: middle;
1.543 albertel 4616: }
4617:
1.440 albertel 4618: .LC_icon {
1.692.4.2 raeburn 4619: border: none;
1.440 albertel 4620: }
1.539 albertel 4621: .LC_indexer_icon {
1.692.4.2 raeburn 4622: border: 0;
1.539 albertel 4623: height: 22px;
4624: }
1.543 albertel 4625: .LC_docs_spacer {
4626: width: 25px;
4627: height: 1px;
1.692.4.2 raeburn 4628: border: none;
1.543 albertel 4629: }
1.346 albertel 4630:
1.532 albertel 4631: .LC_internal_info {
1.692.4.2 raeburn 4632: color: #999999;
1.532 albertel 4633: }
4634:
1.458 albertel 4635: table.LC_pastsubmission {
4636: border: 1px solid black;
4637: margin: 2px;
4638: }
4639:
1.606 albertel 4640: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4641: width: 100%;
4642: background: $pgbg;
1.392 albertel 4643: border: 2px;
1.402 albertel 4644: border-collapse: separate;
1.692.4.2 raeburn 4645: padding: 0;
1.345 albertel 4646: }
1.392 albertel 4647:
1.606 albertel 4648: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4649: table#LC_title_bar.LC_with_remote {
1.359 albertel 4650: width: 100%;
1.392 albertel 4651: border-color: $pgbg;
4652: border-style: solid;
4653: border-width: $border;
4654:
1.379 albertel 4655: background: $pgbg;
4656: font-family: $sans;
1.392 albertel 4657: border-collapse: collapse;
1.692.4.2 raeburn 4658: padding: 0;
1.359 albertel 4659: }
1.392 albertel 4660:
1.409 albertel 4661: table.LC_docs_path {
4662: width: 100%;
4663: border: 0;
4664: background: $pgbg;
4665: font-family: $sans;
4666: border-collapse: collapse;
1.692.4.2 raeburn 4667: padding: 0;
1.409 albertel 4668: }
4669:
1.359 albertel 4670: table#LC_title_bar td {
4671: background: $tabbg;
4672: }
4673: table#LC_title_bar td.LC_title_bar_who {
4674: background: $tabbg;
4675: color: $font;
1.427 albertel 4676: font: small $sans;
1.359 albertel 4677: text-align: right;
4678: }
1.469 banghart 4679: span.LC_metadata {
4680: font-family: $sans;
4681: }
1.359 albertel 4682: span.LC_title_bar_title {
1.416 albertel 4683: font: bold x-large $sans;
1.359 albertel 4684: }
4685: table#LC_title_bar td.LC_title_bar_domain_logo {
4686: background: $sidebg;
4687: text-align: right;
1.692.4.2 raeburn 4688: padding: 0;
1.368 albertel 4689: }
4690: table#LC_title_bar td.LC_title_bar_role_logo {
4691: background: $sidebg;
1.692.4.2 raeburn 4692: padding: 0;
1.359 albertel 4693: }
4694:
1.346 albertel 4695: table#LC_menubuttons_mainmenu {
1.526 www 4696: width: 100%;
1.692.4.2 raeburn 4697: border: 0;
1.346 albertel 4698: border-spacing: 1px;
1.692.4.2 raeburn 4699: padding: 0 1px;
4700: margin: 0;
1.346 albertel 4701: border-collapse: separate;
4702: }
4703: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
1.692.4.2 raeburn 4704: border: none;
1.346 albertel 4705: }
1.345 albertel 4706: table#LC_top_nav td {
4707: background: $tabbg;
1.692.4.2 raeburn 4708: border: none;
1.407 albertel 4709: font-size: small;
1.345 albertel 4710: }
4711: table#LC_top_nav td a, div#LC_top_nav a {
4712: color: $font;
4713: font-family: $sans;
4714: }
1.364 albertel 4715: table#LC_top_nav td.LC_top_nav_logo {
4716: background: $tabbg;
1.432 albertel 4717: text-align: left;
1.408 albertel 4718: white-space: nowrap;
1.432 albertel 4719: width: 31px;
1.408 albertel 4720: }
4721: table#LC_top_nav td.LC_top_nav_logo img {
1.692.4.2 raeburn 4722: border: none;
1.408 albertel 4723: vertical-align: bottom;
1.364 albertel 4724: }
1.432 albertel 4725: table#LC_top_nav td.LC_top_nav_exit,
4726: table#LC_top_nav td.LC_top_nav_help {
4727: width: 2.0em;
4728: }
1.442 albertel 4729: table#LC_top_nav td.LC_top_nav_login {
4730: width: 4.0em;
4731: text-align: center;
4732: }
1.409 albertel 4733: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4734: background: $tabbg;
4735: color: $font;
4736: font-family: $sans;
1.358 albertel 4737: font-size: smaller;
1.357 albertel 4738: }
1.411 albertel 4739: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4740: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4741: background: $tabbg;
4742: color: $font;
4743: font-family: $sans;
4744: font-size: larger;
4745: text-align: right;
4746: }
1.383 albertel 4747: td.LC_table_cell_checkbox {
4748: text-align: center;
4749: }
1.522 albertel 4750: table#LC_mainmenu td.LC_mainmenu_column {
4751: vertical-align: top;
4752: }
4753:
1.346 albertel 4754: .LC_menubuttons_inline_text {
4755: color: $font;
4756: font-family: $sans;
4757: font-size: smaller;
4758: }
4759:
1.526 www 4760: .LC_menubuttons_link {
4761: text-decoration: none;
4762: }
1.692.4.2 raeburn 4763: /*2008--9-5: new menu style sheet.Changed category*/
1.522 albertel 4764: .LC_menubuttons_category {
1.521 www 4765: color: $font;
1.526 www 4766: background: $pgbg;
1.521 www 4767: font-family: $sans;
4768: font-size: larger;
4769: font-weight: bold;
4770: }
4771:
1.346 albertel 4772: td.LC_menubuttons_text {
1.526 www 4773: width: 90%;
1.346 albertel 4774: color: $font;
4775: font-family: $sans;
4776: }
1.526 www 4777:
1.346 albertel 4778: td.LC_menubuttons_img {
4779: }
1.526 www 4780:
1.346 albertel 4781: .LC_current_location {
4782: font-family: $sans;
4783: background: $tabbg;
4784: }
4785: .LC_new_mail {
4786: font-family: $sans;
1.634 www 4787: background: $tabbg;
1.346 albertel 4788: font-weight: bold;
4789: }
1.347 albertel 4790:
1.527 www 4791: .LC_dropadd_labeltext {
4792: font-family: $sans;
4793: text-align: right;
4794: }
4795:
4796: .LC_preferences_labeltext {
4797: font-family: $sans;
4798: text-align: right;
4799: }
4800:
1.666 raeburn 4801: .LC_roleslog_note {
4802: font-size: smaller;
4803: }
4804:
1.692.4.2 raeburn 4805: .LC_mail_functions {
4806: font-weight: bold;
4807: }
4808:
1.440 albertel 4809: table.LC_aboutme_port {
1.692.4.2 raeburn 4810: border: none;
1.440 albertel 4811: border-collapse: collapse;
1.692.4.2 raeburn 4812: border-spacing: 0;
1.440 albertel 4813: }
1.349 albertel 4814: table.LC_data_table, table.LC_mail_list {
1.347 albertel 4815: border: 1px solid #000000;
1.402 albertel 4816: border-collapse: separate;
1.426 albertel 4817: border-spacing: 1px;
1.610 albertel 4818: background: $pgbg;
1.347 albertel 4819: }
1.422 albertel 4820: .LC_data_table_dense {
4821: font-size: small;
4822: }
1.507 raeburn 4823: table.LC_nested_outer {
4824: border: 1px solid #000000;
1.589 raeburn 4825: border-collapse: collapse;
1.692.4.2 raeburn 4826: border-spacing: 0;
1.507 raeburn 4827: width: 100%;
4828: }
4829: table.LC_nested {
1.692.4.2 raeburn 4830: border: none;
1.589 raeburn 4831: border-collapse: collapse;
1.692.4.2 raeburn 4832: border-spacing: 0;
1.507 raeburn 4833: width: 100%;
4834: }
1.523 albertel 4835: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4836: table.LC_prior_tries tr th {
1.349 albertel 4837: font-weight: bold;
4838: background-color: $data_table_head;
1.421 albertel 4839: font-size: smaller;
1.347 albertel 4840: }
1.692.4.2 raeburn 4841: table.LC_data_table tr.LC_info_row > td {
4842: background-color: #CCCCCC;
4843: font-weight: bold;
4844: text-align: left;
4845: }
1.610 albertel 4846: table.LC_data_table tr.LC_odd_row > td,
1.692.4.2 raeburn 4847: table.LC_pick_box tr > td.LC_odd_row,
1.440 albertel 4848: table.LC_aboutme_port tr td {
1.349 albertel 4849: background-color: $data_table_light;
1.425 albertel 4850: padding: 2px;
1.347 albertel 4851: }
1.610 albertel 4852: table.LC_data_table tr.LC_even_row > td,
1.692.4.2 raeburn 4853: table.LC_pick_box tr > td.LC_even_row,
1.440 albertel 4854: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4855: background-color: $data_table_dark;
1.692.4.2 raeburn 4856: padding: 2px;
1.347 albertel 4857: }
1.425 albertel 4858: table.LC_data_table tr.LC_data_table_highlight td {
4859: background-color: $data_table_darker;
4860: }
1.639 raeburn 4861: table.LC_data_table tr td.LC_leftcol_header {
4862: background-color: $data_table_head;
4863: font-weight: bold;
4864: }
1.451 albertel 4865: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4866: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4867: background-color: #FFFFFF;
1.421 albertel 4868: font-weight: bold;
4869: font-style: italic;
4870: text-align: center;
4871: padding: 8px;
1.347 albertel 4872: }
1.507 raeburn 4873: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4874: padding: 4ex
4875: }
1.507 raeburn 4876: table.LC_nested_outer tr th {
4877: font-weight: bold;
4878: background-color: $data_table_head;
4879: font-size: smaller;
4880: border-bottom: 1px solid #000000;
4881: }
4882: table.LC_nested_outer tr td.LC_subheader {
4883: background-color: $data_table_head;
4884: font-weight: bold;
4885: font-size: small;
4886: border-bottom: 1px solid #000000;
4887: text-align: right;
1.451 albertel 4888: }
1.507 raeburn 4889: table.LC_nested tr.LC_info_row td {
1.692.4.2 raeburn 4890: background-color: #CCCCCC;
1.451 albertel 4891: font-weight: bold;
4892: font-size: small;
1.507 raeburn 4893: text-align: center;
4894: }
1.589 raeburn 4895: table.LC_nested tr.LC_info_row td.LC_left_item,
4896: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4897: text-align: left;
1.451 albertel 4898: }
1.507 raeburn 4899: table.LC_nested td {
1.692.4.2 raeburn 4900: background-color: #FFFFFF;
1.451 albertel 4901: font-size: small;
1.507 raeburn 4902: }
4903: table.LC_nested_outer tr th.LC_right_item,
4904: table.LC_nested tr.LC_info_row td.LC_right_item,
4905: table.LC_nested tr.LC_odd_row td.LC_right_item,
4906: table.LC_nested tr td.LC_right_item {
1.451 albertel 4907: text-align: right;
4908: }
4909:
1.507 raeburn 4910: table.LC_nested tr.LC_odd_row td {
1.692.4.2 raeburn 4911: background-color: #EEEEEE;
1.451 albertel 4912: }
4913:
1.473 raeburn 4914: table.LC_createuser {
4915: }
4916:
4917: table.LC_createuser tr.LC_section_row td {
4918: font-size: smaller;
4919: }
4920:
4921: table.LC_createuser tr.LC_info_row td {
1.692.4.2 raeburn 4922: background-color: #CCCCCC;
1.473 raeburn 4923: font-weight: bold;
4924: text-align: center;
4925: }
4926:
1.349 albertel 4927: table.LC_calendar {
4928: border: 1px solid #000000;
4929: border-collapse: collapse;
4930: }
4931: table.LC_calendar_pickdate {
4932: font-size: xx-small;
4933: }
4934: table.LC_calendar tr td {
4935: border: 1px solid #000000;
4936: vertical-align: top;
4937: }
4938: table.LC_calendar tr td.LC_calendar_day_empty {
4939: background-color: $data_table_dark;
4940: }
4941: table.LC_calendar tr td.LC_calendar_day_current {
4942: background-color: $data_table_highlight;
4943: }
4944:
4945: table.LC_mail_list tr.LC_mail_new {
4946: background-color: $mail_new;
4947: }
4948: table.LC_mail_list tr.LC_mail_new:hover {
4949: background-color: $mail_new_hover;
4950: }
4951: table.LC_mail_list tr.LC_mail_read {
4952: background-color: $mail_read;
4953: }
4954: table.LC_mail_list tr.LC_mail_read:hover {
4955: background-color: $mail_read_hover;
4956: }
4957: table.LC_mail_list tr.LC_mail_replied {
4958: background-color: $mail_replied;
4959: }
4960: table.LC_mail_list tr.LC_mail_replied:hover {
4961: background-color: $mail_replied_hover;
4962: }
4963: table.LC_mail_list tr.LC_mail_other {
4964: background-color: $mail_other;
4965: }
4966: table.LC_mail_list tr.LC_mail_other:hover {
4967: background-color: $mail_other_hover;
4968: }
1.494 raeburn 4969: table.LC_mail_list tr.LC_mail_even {
4970: }
4971: table.LC_mail_list tr.LC_mail_odd {
4972: }
4973:
1.385 albertel 4974:
1.386 albertel 4975: table#LC_portfolio_actions {
4976: width: auto;
4977: background: $pgbg;
1.692.4.2 raeburn 4978: border: none;
1.386 albertel 4979: border-spacing: 2px 2px;
1.692.4.2 raeburn 4980: padding: 0;
4981: margin: 0;
1.386 albertel 4982: border-collapse: separate;
4983: }
4984: table#LC_portfolio_actions td.LC_label {
4985: background: $tabbg;
4986: text-align: right;
4987: }
4988: table#LC_portfolio_actions td.LC_value {
4989: background: $tabbg;
4990: }
1.385 albertel 4991:
1.391 albertel 4992: table#LC_cstr_controls {
4993: width: 100%;
4994: border-collapse: collapse;
4995: }
4996: table#LC_cstr_controls tr td {
4997: border: 4px solid $pgbg;
4998: padding: 4px;
4999: text-align: center;
5000: background: $tabbg;
5001: }
5002: table#LC_cstr_controls tr th {
5003: border: 4px solid $pgbg;
5004: background: $table_header;
5005: text-align: center;
5006: font-family: $sans;
5007: font-size: smaller;
5008: }
5009:
1.389 albertel 5010: table#LC_browser {
5011:
5012: }
5013: table#LC_browser tr th {
1.391 albertel 5014: background: $table_header;
1.389 albertel 5015: }
1.390 albertel 5016: table#LC_browser tr td {
5017: padding: 2px;
5018: }
1.389 albertel 5019: table#LC_browser tr.LC_browser_file,
5020: table#LC_browser tr.LC_browser_file_published {
5021: background: #CCFF88;
5022: }
5023: table#LC_browser tr.LC_browser_file_locked,
5024: table#LC_browser tr.LC_browser_file_unpublished {
5025: background: #FFAA99;
1.387 albertel 5026: }
1.389 albertel 5027: table#LC_browser tr.LC_browser_file_obsolete {
5028: background: #AAAAAA;
1.387 albertel 5029: }
1.455 albertel 5030: table#LC_browser tr.LC_browser_file_modified,
5031: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 5032: background: #FFFF77;
1.387 albertel 5033: }
1.389 albertel 5034: table#LC_browser tr.LC_browser_folder {
5035: background: #CCCCFF;
1.387 albertel 5036: }
1.692.4.2 raeburn 5037:
5038: table.LC_data_table tr > td.LC_roles_is {
5039: /* background: #77FF77; */
5040: }
5041: table.LC_data_table tr > td.LC_roles_future {
5042: background: #FFFF77;
5043: }
5044: table.LC_data_table tr > td.LC_roles_will {
5045: background: #FFAA77;
5046: }
5047: table.LC_data_table tr > td.LC_roles_expired {
5048: background: #FF7777;
5049: }
5050: table.LC_data_table tr > td.LC_roles_will_not {
5051: background: #AAFF77;
5052: }
5053: table.LC_data_table tr > td.LC_roles_selected {
5054: background: #11CC55;
5055: }
5056:
1.388 albertel 5057: span.LC_current_location {
5058: font-size: x-large;
5059: background: $pgbg;
5060: }
1.387 albertel 5061:
1.395 albertel 5062: span.LC_parm_menu_item {
5063: font-size: larger;
5064: font-family: $sans;
5065: }
5066: span.LC_parm_scope_all {
5067: color: red;
5068: }
5069: span.LC_parm_scope_folder {
5070: color: green;
5071: }
5072: span.LC_parm_scope_resource {
5073: color: orange;
5074: }
5075: span.LC_parm_part {
5076: color: blue;
5077: }
5078: span.LC_parm_folder, span.LC_parm_symb {
5079: font-size: x-small;
5080: font-family: $mono;
5081: color: #AAAAAA;
5082: }
5083:
1.396 albertel 5084: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
5085: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
5086: border: 1px solid black;
5087: border-collapse: collapse;
5088: }
5089: table.LC_parm_overview_restrictions td {
5090: border-width: 1px 4px 1px 4px;
5091: border-style: solid;
5092: border-color: $pgbg;
5093: text-align: center;
5094: }
5095: table.LC_parm_overview_restrictions th {
5096: background: $tabbg;
5097: border-width: 1px 4px 1px 4px;
5098: border-style: solid;
5099: border-color: $pgbg;
5100: }
1.398 albertel 5101: table#LC_helpmenu {
1.692.4.2 raeburn 5102: border: none;
1.398 albertel 5103: height: 55px;
1.692.4.2 raeburn 5104: border-spacing: 0;
1.398 albertel 5105: }
5106:
5107: table#LC_helpmenu fieldset legend {
5108: font-size: larger;
5109: font-weight: bold;
5110: }
1.397 albertel 5111: table#LC_helpmenu_links {
5112: width: 100%;
5113: border: 1px solid black;
5114: background: $pgbg;
1.692.4.2 raeburn 5115: padding: 0;
1.397 albertel 5116: border-spacing: 1px;
5117: }
5118: table#LC_helpmenu_links tr td {
5119: padding: 1px;
5120: background: $tabbg;
1.399 albertel 5121: text-align: center;
5122: font-weight: bold;
1.397 albertel 5123: }
1.396 albertel 5124:
1.397 albertel 5125: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
5126: table#LC_helpmenu_links a:active {
5127: text-decoration: none;
5128: color: $font;
5129: }
5130: table#LC_helpmenu_links a:hover {
5131: text-decoration: underline;
5132: color: $vlink;
5133: }
1.396 albertel 5134:
1.417 albertel 5135: .LC_chrt_popup_exists {
5136: border: 1px solid #339933;
5137: margin: -1px;
5138: }
5139: .LC_chrt_popup_up {
5140: border: 1px solid yellow;
5141: margin: -1px;
5142: }
5143: .LC_chrt_popup {
5144: border: 1px solid #8888FF;
5145: background: #CCCCFF;
5146: }
1.421 albertel 5147: table.LC_pick_box {
5148: border-collapse: separate;
5149: background: white;
5150: border: 1px solid black;
5151: border-spacing: 1px;
5152: }
5153: table.LC_pick_box td.LC_pick_box_title {
5154: background: $tabbg;
5155: font-weight: bold;
5156: text-align: right;
1.692.4.2 raeburn 5157: vertical-align: top;
1.421 albertel 5158: width: 184px;
5159: padding: 8px;
5160: }
1.645 raeburn 5161: table.LC_pick_box td.LC_selfenroll_pick_box_title {
5162: background: $tabbg;
5163: font-weight: bold;
5164: text-align: right;
5165: width: 350px;
5166: padding: 8px;
5167: }
5168:
1.579 raeburn 5169: table.LC_pick_box td.LC_pick_box_value {
5170: text-align: left;
5171: padding: 8px;
5172: }
5173: table.LC_pick_box td.LC_pick_box_select {
5174: text-align: left;
5175: padding: 8px;
5176: }
1.424 albertel 5177: table.LC_pick_box td.LC_pick_box_separator {
1.692.4.2 raeburn 5178: padding: 0;
1.421 albertel 5179: height: 1px;
5180: background: black;
5181: }
5182: table.LC_pick_box td.LC_pick_box_submit {
5183: text-align: right;
5184: }
1.579 raeburn 5185: table.LC_pick_box td.LC_evenrow_value {
5186: text-align: left;
5187: padding: 8px;
5188: background-color: $data_table_light;
5189: }
5190: table.LC_pick_box td.LC_oddrow_value {
5191: text-align: left;
5192: padding: 8px;
5193: background-color: $data_table_light;
5194: }
5195: table.LC_helpform_receipt {
5196: width: 620px;
5197: border-collapse: separate;
5198: background: white;
5199: border: 1px solid black;
5200: border-spacing: 1px;
5201: }
5202: table.LC_helpform_receipt td.LC_pick_box_title {
5203: background: $tabbg;
5204: font-weight: bold;
5205: text-align: right;
5206: width: 184px;
5207: padding: 8px;
5208: }
5209: table.LC_helpform_receipt td.LC_evenrow_value {
5210: text-align: left;
5211: padding: 8px;
5212: background-color: $data_table_light;
5213: }
5214: table.LC_helpform_receipt td.LC_oddrow_value {
5215: text-align: left;
5216: padding: 8px;
5217: background-color: $data_table_light;
5218: }
5219: table.LC_helpform_receipt td.LC_pick_box_separator {
1.692.4.2 raeburn 5220: padding: 0;
1.579 raeburn 5221: height: 1px;
5222: background: black;
5223: }
5224: span.LC_helpform_receipt_cat {
5225: font-weight: bold;
5226: }
1.424 albertel 5227: table.LC_group_priv_box {
5228: background: white;
5229: border: 1px solid black;
5230: border-spacing: 1px;
5231: }
5232: table.LC_group_priv_box td.LC_pick_box_title {
5233: background: $tabbg;
5234: font-weight: bold;
5235: text-align: right;
5236: width: 184px;
5237: }
5238: table.LC_group_priv_box td.LC_groups_fixed {
5239: background: $data_table_light;
5240: text-align: center;
5241: }
5242: table.LC_group_priv_box td.LC_groups_optional {
5243: background: $data_table_dark;
5244: text-align: center;
5245: }
5246: table.LC_group_priv_box td.LC_groups_functionality {
5247: background: $data_table_darker;
5248: text-align: center;
5249: font-weight: bold;
5250: }
5251: table.LC_group_priv td {
5252: text-align: left;
1.692.4.2 raeburn 5253: padding: 0;
1.424 albertel 5254: }
5255:
1.421 albertel 5256: table.LC_notify_front_page {
5257: background: white;
5258: border: 1px solid black;
5259: padding: 8px;
5260: }
5261: table.LC_notify_front_page td {
5262: padding: 8px;
5263: }
1.424 albertel 5264: .LC_navbuttons {
5265: margin: 2ex 0ex 2ex 0ex;
5266: }
1.423 albertel 5267: .LC_topic_bar {
5268: font-family: $sans;
5269: font-weight: bold;
5270: width: 100%;
5271: background: $tabbg;
5272: vertical-align: middle;
5273: margin: 2ex 0ex 2ex 0ex;
1.692.4.2 raeburn 5274: padding: 3px;
1.423 albertel 5275: }
5276: .LC_topic_bar span {
5277: vertical-align: middle;
5278: }
5279: .LC_topic_bar img {
5280: vertical-align: bottom;
5281: }
5282: table.LC_course_group_status {
5283: margin: 20px;
5284: }
5285: table.LC_status_selector td {
5286: vertical-align: top;
5287: text-align: center;
1.424 albertel 5288: padding: 4px;
5289: }
5290: table.LC_descriptive_input td.LC_description {
5291: vertical-align: top;
5292: text-align: right;
5293: font-weight: bold;
1.423 albertel 5294: }
1.599 albertel 5295: div.LC_feedback_link {
1.616 albertel 5296: clear: both;
1.599 albertel 5297: background: white;
5298: width: 100%;
1.489 raeburn 5299: }
5300: span.LC_feedback_link {
1.599 albertel 5301: background: $feedback_link_bg;
5302: font-size: larger;
5303: }
5304: span.LC_message_link {
5305: background: $feedback_link_bg;
5306: font-size: larger;
5307: position: absolute;
5308: right: 1em;
1.489 raeburn 5309: }
1.421 albertel 5310:
1.515 albertel 5311: table.LC_prior_tries {
1.524 albertel 5312: border: 1px solid #000000;
5313: border-collapse: separate;
5314: border-spacing: 1px;
1.515 albertel 5315: }
1.523 albertel 5316:
1.515 albertel 5317: table.LC_prior_tries td {
1.524 albertel 5318: padding: 2px;
1.515 albertel 5319: }
1.523 albertel 5320:
5321: .LC_answer_correct {
5322: background: #AAFFAA;
5323: color: black;
5324: }
5325: .LC_answer_charged_try {
5326: background: #FFAAAA ! important;
5327: color: black;
5328: }
5329: .LC_answer_not_charged_try,
5330: .LC_answer_no_grade,
5331: .LC_answer_late {
5332: background: #FFFFAA;
5333: color: black;
5334: }
5335: .LC_answer_previous {
5336: background: #AAAAFF;
5337: color: black;
5338: }
5339: .LC_answer_no_message {
5340: background: #FFFFFF;
5341: color: black;
5342: }
5343: .LC_answer_unknown {
5344: background: orange;
5345: color: black;
5346: }
5347:
5348:
1.529 albertel 5349: span.LC_prior_numerical,
5350: span.LC_prior_string,
5351: span.LC_prior_custom,
5352: span.LC_prior_reaction,
5353: span.LC_prior_math {
1.523 albertel 5354: font-family: monospace;
5355: white-space: pre;
5356: }
5357:
1.525 albertel 5358: span.LC_prior_string {
5359: font-family: monospace;
5360: white-space: pre;
5361: }
5362:
1.523 albertel 5363: table.LC_prior_option {
5364: width: 100%;
5365: border-collapse: collapse;
5366: }
1.528 albertel 5367: table.LC_prior_rank, table.LC_prior_match {
5368: border-collapse: collapse;
5369: }
5370: table.LC_prior_option tr td,
5371: table.LC_prior_rank tr td,
5372: table.LC_prior_match tr td {
1.524 albertel 5373: border: 1px solid #000000;
1.515 albertel 5374: }
5375:
1.519 raeburn 5376: span.LC_nobreak {
1.544 albertel 5377: white-space: nowrap;
1.519 raeburn 5378: }
5379:
1.576 raeburn 5380: span.LC_cusr_emph {
5381: font-style: italic;
5382: }
5383:
1.633 raeburn 5384: span.LC_cusr_subheading {
5385: font-weight: normal;
5386: font-size: 85%;
5387: }
5388:
1.545 albertel 5389: table.LC_docs_documents {
5390: background: #BBBBBB;
1.692.4.2 raeburn 5391: border-width: 0;
1.545 albertel 5392: border-collapse: collapse;
5393: }
5394:
5395: table.LC_docs_documents td.LC_docs_document {
5396: border: 2px solid black;
5397: padding: 4px;
5398: }
5399:
5400: .LC_docs_course_commands div {
5401: float: left;
5402: border: 4px solid #AAAAAA;
5403: padding: 4px;
5404: background: #DDDDCC;
5405: }
5406:
5407: .LC_docs_entry_move {
1.692.4.2 raeburn 5408: border: none;
1.545 albertel 5409: border-collapse: collapse;
1.544 albertel 5410: }
5411:
1.545 albertel 5412: .LC_docs_entry_move td {
5413: border: 2px solid #BBBBBB;
5414: background: #DDDDDD;
5415: }
5416:
5417: .LC_docs_editor td.LC_docs_entry_commands {
5418: background: #DDDDDD;
5419: font-size: x-small;
5420: }
1.544 albertel 5421: .LC_docs_copy {
1.545 albertel 5422: color: #000099;
1.544 albertel 5423: }
5424: .LC_docs_cut {
1.545 albertel 5425: color: #550044;
1.544 albertel 5426: }
5427: .LC_docs_rename {
1.545 albertel 5428: color: #009900;
1.544 albertel 5429: }
5430: .LC_docs_remove {
1.545 albertel 5431: color: #990000;
5432: }
5433:
1.547 albertel 5434: .LC_docs_reinit_warn,
5435: .LC_docs_ext_edit {
5436: font-size: x-small;
5437: }
5438:
1.545 albertel 5439: .LC_docs_editor td.LC_docs_entry_title,
5440: .LC_docs_editor td.LC_docs_entry_icon {
5441: background: #FFFFBB;
5442: }
5443: .LC_docs_editor td.LC_docs_entry_parameter {
5444: background: #BBBBFF;
5445: font-size: x-small;
5446: white-space: nowrap;
5447: }
5448:
5449: table.LC_docs_adddocs td,
5450: table.LC_docs_adddocs th {
5451: border: 1px solid #BBBBBB;
5452: padding: 4px;
5453: background: #DDDDDD;
1.543 albertel 5454: }
5455:
1.584 albertel 5456: table.LC_sty_begin {
5457: background: #BBFFBB;
5458: }
5459: table.LC_sty_end {
5460: background: #FFBBBB;
5461: }
5462:
1.589 raeburn 5463: table.LC_double_column {
1.692.4.2 raeburn 5464: border-width: 0;
1.589 raeburn 5465: border-collapse: collapse;
5466: width: 100%;
5467: padding: 2px;
5468: }
5469:
5470: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5471: top: 2px;
1.589 raeburn 5472: left: 2px;
5473: width: 47%;
5474: vertical-align: top;
5475: }
5476:
5477: table.LC_double_column tr td.LC_right_col {
5478: top: 2px;
5479: right: 2px;
5480: width: 47%;
5481: vertical-align: top;
5482: }
5483:
1.594 raeburn 5484: span.LC_role_level {
5485: font-weight: bold;
5486: }
5487:
1.591 raeburn 5488: div.LC_left_float {
5489: float: left;
5490: padding-right: 5%;
1.597 albertel 5491: padding-bottom: 4px;
1.591 raeburn 5492: }
5493:
5494: div.LC_clear_float_header {
1.597 albertel 5495: padding-bottom: 2px;
1.591 raeburn 5496: }
5497:
5498: div.LC_clear_float_footer {
1.597 albertel 5499: padding-top: 10px;
1.591 raeburn 5500: clear: both;
5501: }
5502:
1.597 albertel 5503:
1.601 albertel 5504: div.LC_grade_select_mode {
1.604 albertel 5505: font-family: $sans;
1.601 albertel 5506: }
5507: div.LC_grade_select_mode div div {
5508: margin: 5px;
5509: }
5510: div.LC_grade_select_mode_selector {
5511: margin: 5px;
5512: float: left;
5513: }
5514: div.LC_grade_select_mode_selector_header {
5515: font: bold medium $sans;
5516: }
5517: div.LC_grade_select_mode_type {
5518: clear: left;
5519: }
5520:
1.597 albertel 5521: div.LC_grade_show_user {
5522: margin-top: 20px;
5523: border: 1px solid black;
5524: }
5525: div.LC_grade_user_name {
5526: background: #DDDDEE;
5527: border-bottom: 1px solid black;
5528: font: bold large $sans;
5529: }
5530: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5531: background: #DDEEDD;
5532: }
5533:
5534: div.LC_grade_show_problem,
5535: div.LC_grade_submissions,
5536: div.LC_grade_message_center,
5537: div.LC_grade_info_links,
5538: div.LC_grade_assign {
5539: margin: 5px;
5540: width: 99%;
5541: background: #FFFFFF;
5542: }
5543: div.LC_grade_show_problem_header,
5544: div.LC_grade_submissions_header,
5545: div.LC_grade_message_center_header,
5546: div.LC_grade_assign_header {
5547: font: bold large $sans;
5548: }
5549: div.LC_grade_show_problem_problem,
5550: div.LC_grade_submissions_body,
5551: div.LC_grade_message_center_body,
5552: div.LC_grade_assign_body {
5553: border: 1px solid black;
5554: width: 99%;
5555: background: #FFFFFF;
5556: }
1.598 albertel 5557: span.LC_grade_check_note {
5558: font: normal medium $sans;
5559: display: inline;
5560: position: absolute;
5561: right: 1em;
5562: }
1.597 albertel 5563:
1.613 albertel 5564: table.LC_scantron_action {
5565: width: 100%;
5566: }
5567: table.LC_scantron_action tr th {
5568: font: normal bold $sans;
5569: }
1.600 albertel 5570:
1.614 albertel 5571: div.LC_edit_problem_header,
5572: div.LC_edit_problem_footer {
1.600 albertel 5573: font: normal medium $sans;
1.602 albertel 5574: margin: 2px;
1.600 albertel 5575: }
5576: div.LC_edit_problem_header,
1.602 albertel 5577: div.LC_edit_problem_header div,
1.614 albertel 5578: div.LC_edit_problem_footer,
5579: div.LC_edit_problem_footer div,
1.602 albertel 5580: div.LC_edit_problem_editxml_header,
5581: div.LC_edit_problem_editxml_header div {
1.600 albertel 5582: margin-top: 5px;
5583: }
1.602 albertel 5584: div.LC_edit_problem_header_edit_row {
5585: background: $tabbg;
5586: padding: 3px;
5587: margin-bottom: 5px;
5588: }
1.600 albertel 5589: div.LC_edit_problem_header_title {
1.602 albertel 5590: font: larger bold $sans;
5591: background: $tabbg;
5592: padding: 3px;
5593: }
5594: table.LC_edit_problem_header_title {
5595: font: larger bold $sans;
5596: width: 100%;
5597: border-color: $pgbg;
5598: border-style: solid;
5599: border-width: $border;
5600:
1.600 albertel 5601: background: $tabbg;
1.602 albertel 5602: border-collapse: collapse;
1.692.4.2 raeburn 5603: padding: 0;
1.602 albertel 5604: }
5605:
5606: div.LC_edit_problem_discards {
5607: float: left;
5608: padding-bottom: 5px;
5609: }
5610: div.LC_edit_problem_saves {
5611: float: right;
5612: padding-bottom: 5px;
1.600 albertel 5613: }
5614: hr.LC_edit_problem_divide {
1.602 albertel 5615: clear: both;
1.600 albertel 5616: color: $tabbg;
5617: background-color: $tabbg;
5618: height: 3px;
1.692.4.2 raeburn 5619: border: none;
1.600 albertel 5620: }
1.679 riegler 5621: img.stift{
1.678 riegler 5622: border-width:0;
1.679 riegler 5623: vertical-align:middle;
1.677 riegler 5624: }
1.680 riegler 5625:
1.681 riegler 5626: table#LC_mainmenu{
5627: margin-top:10px;
5628: width:80%;
5629:
5630: }
5631:
1.680 riegler 5632: table#LC_mainmenu td.LC_mainmenu_col_fieldset{
5633: vertical-align: top;
5634: width: 45%;
5635: }
5636: .LC_mainmenu_fieldset_category {
5637: color: $font;
5638: background: $pgbg;
5639: font-family: $sans;
5640: font-size: small;
5641: font-weight: bold;
5642: }
5643: fieldset#LC_mainmenu_fieldset {
1.692.4.2 raeburn 5644: margin:0 10px 10px 0;
5645:
5646: }
1.680 riegler 5647:
1.692.4.2 raeburn 5648: div.LC_createcourse {
5649: margin: 10px 10px 10px 10px;
1.680 riegler 5650: }
1.692.4.2 raeburn 5651:
1.343 albertel 5652: END
5653: }
5654:
1.306 albertel 5655: =pod
5656:
5657: =item * &headtag()
5658:
5659: Returns a uniform footer for LON-CAPA web pages.
5660:
1.307 albertel 5661: Inputs: $title - optional title for the head
5662: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5663: $args - optional arguments
1.319 albertel 5664: force_register - if is true call registerurl so the remote is
5665: informed
1.415 albertel 5666: redirect -> array ref of
5667: 1- seconds before redirect occurs
5668: 2- url to redirect to
5669: 3- whether the side effect should occur
1.315 albertel 5670: (side effect of setting
5671: $env{'internal.head.redirect'} to the url
5672: redirected too)
1.352 albertel 5673: domain -> force to color decorate a page for a specific
5674: domain
5675: function -> force usage of a specific rolish color scheme
5676: bgcolor -> override the default page bgcolor
1.460 albertel 5677: no_auto_mt_title
5678: -> prevent &mt()ing the title arg
1.464 albertel 5679:
1.306 albertel 5680: =cut
5681:
5682: sub headtag {
1.313 albertel 5683: my ($title,$head_extra,$args) = @_;
1.306 albertel 5684:
1.363 albertel 5685: my $function = $args->{'function'} || &get_users_function();
5686: my $domain = $args->{'domain'} || &determinedomain();
5687: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5688: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5689: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5690: #time(),
1.418 albertel 5691: $env{'environment.color.timestamp'},
1.363 albertel 5692: $function,$domain,$bgcolor);
5693:
1.369 www 5694: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5695:
1.308 albertel 5696: my $result =
5697: '<head>'.
1.461 albertel 5698: &font_settings();
1.319 albertel 5699:
1.461 albertel 5700: if (!$args->{'frameset'}) {
5701: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5702: }
1.319 albertel 5703: if ($args->{'force_register'}) {
5704: $result .= &Apache::lonmenu::registerurl(1);
5705: }
1.436 albertel 5706: if (!$args->{'no_nav_bar'}
5707: && !$args->{'only_body'}
5708: && !$args->{'frameset'}) {
5709: $result .= &help_menu_js();
5710: }
1.319 albertel 5711:
1.314 albertel 5712: if (ref($args->{'redirect'})) {
1.414 albertel 5713: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5714: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5715: if (!$inhibit_continue) {
5716: $env{'internal.head.redirect'} = $url;
5717: }
1.313 albertel 5718: $result.=<<ADDMETA
5719: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5720: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5721: ADDMETA
5722: }
1.306 albertel 5723: if (!defined($title)) {
5724: $title = 'The LearningOnline Network with CAPA';
5725: }
1.460 albertel 5726: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5727: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5728: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5729: .$head_extra;
1.306 albertel 5730: return $result;
5731: }
5732:
5733: =pod
5734:
1.340 albertel 5735: =item * &font_settings()
5736:
5737: Returns neccessary <meta> to set the proper encoding
5738:
5739: Inputs: none
5740:
5741: =cut
5742:
5743: sub font_settings {
5744: my $headerstring='';
1.647 www 5745: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 5746: $headerstring.=
5747: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5748: }
5749: return $headerstring;
5750: }
5751:
1.341 albertel 5752: =pod
5753:
5754: =item * &xml_begin()
5755:
5756: Returns the needed doctype and <html>
5757:
5758: Inputs: none
5759:
5760: =cut
5761:
5762: sub xml_begin {
5763: my $output='';
5764:
1.592 albertel 5765: if ($env{'internal.start_page'}==1) {
5766: &Apache::lonhtmlcommon::init_htmlareafields();
5767: }
1.342 albertel 5768:
1.341 albertel 5769: if ($env{'browser.mathml'}) {
5770: $output='<?xml version="1.0"?>'
5771: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5772: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5773:
5774: # .'<!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">] >'
5775: .'<!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">'
5776: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5777: .'xmlns="http://www.w3.org/1999/xhtml">';
5778: } else {
5779: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
5780: }
5781: return $output;
5782: }
1.340 albertel 5783:
5784: =pod
5785:
1.306 albertel 5786: =item * &endheadtag()
5787:
5788: Returns a uniform </head> for LON-CAPA web pages.
5789:
5790: Inputs: none
5791:
5792: =cut
5793:
5794: sub endheadtag {
5795: return '</head>';
5796: }
5797:
5798: =pod
5799:
5800: =item * &head()
5801:
5802: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5803:
1.648 raeburn 5804: Inputs:
5805:
5806: =over 4
5807:
5808: $title - optional title for the page
5809:
5810: $head_extra - optional extra HTML to put inside the <head>
5811:
5812: =back
1.405 albertel 5813:
1.306 albertel 5814: =cut
5815:
5816: sub head {
1.325 albertel 5817: my ($title,$head_extra,$args) = @_;
5818: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5819: }
5820:
5821: =pod
5822:
5823: =item * &start_page()
5824:
5825: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5826:
1.648 raeburn 5827: Inputs:
5828:
5829: =over 4
5830:
5831: $title - optional title for the page
5832:
5833: $head_extra - optional extra HTML to incude inside the <head>
5834:
5835: $args - additional optional args supported are:
5836:
5837: =over 8
5838:
5839: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 5840: arg on
1.648 raeburn 5841: no_nav_bar -> is true will set &bodytag() notopbar arg on
5842: add_entries -> additional attributes to add to the <body>
5843: domain -> force to color decorate a page for a
1.317 albertel 5844: specific domain
1.648 raeburn 5845: function -> force usage of a specific rolish color
1.317 albertel 5846: scheme
1.648 raeburn 5847: redirect -> see &headtag()
5848: bgcolor -> override the default page bg color
5849: js_ready -> return a string ready for being used in
1.317 albertel 5850: a javascript writeln
1.648 raeburn 5851: html_encode -> return a string ready for being used in
1.320 albertel 5852: a html attribute
1.648 raeburn 5853: force_register -> if is true will turn on the &bodytag()
1.317 albertel 5854: $forcereg arg
1.648 raeburn 5855: body_title -> alternate text to use instead of $title
1.326 albertel 5856: in the title box that appears, this text
5857: is not auto translated like the $title is
1.648 raeburn 5858: frameset -> if true will start with a <frameset>
1.330 albertel 5859: rather than <body>
1.648 raeburn 5860: no_title -> if true the title bar won't be shown
5861: skip_phases -> hash ref of
1.338 albertel 5862: head -> skip the <html><head> generation
5863: body -> skip all <body> generation
1.648 raeburn 5864: no_inline_link -> if true and in remote mode, don't show the
1.361 albertel 5865: 'Switch To Inline Menu' link
1.648 raeburn 5866: no_auto_mt_title -> prevent &mt()ing the title arg
5867: inherit_jsmath -> when creating popup window in a page,
5868: should it have jsmath forced on by the
5869: current page
1.361 albertel 5870:
1.648 raeburn 5871: =back
1.460 albertel 5872:
1.648 raeburn 5873: =back
1.562 albertel 5874:
1.306 albertel 5875: =cut
5876:
5877: sub start_page {
1.309 albertel 5878: my ($title,$head_extra,$args) = @_;
1.318 albertel 5879: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5880: my %head_args;
1.352 albertel 5881: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5882: 'bgcolor','frameset','no_nav_bar','only_body',
5883: 'no_auto_mt_title') {
1.319 albertel 5884: if (defined($args->{$arg})) {
1.324 raeburn 5885: $head_args{$arg} = $args->{$arg};
1.319 albertel 5886: }
1.313 albertel 5887: }
1.319 albertel 5888:
1.315 albertel 5889: $env{'internal.start_page'}++;
1.338 albertel 5890: my $result;
5891: if (! exists($args->{'skip_phases'}{'head'}) ) {
5892: $result.=
1.341 albertel 5893: &xml_begin().
1.338 albertel 5894: &headtag($title,$head_extra,\%head_args).&endheadtag();
5895: }
5896:
5897: if (! exists($args->{'skip_phases'}{'body'}) ) {
5898: if ($args->{'frameset'}) {
5899: my $attr_string = &make_attr_string($args->{'force_register'},
5900: $args->{'add_entries'});
5901: $result .= "\n<frameset $attr_string>\n";
5902: } else {
5903: $result .=
5904: &bodytag($title,
5905: $args->{'function'}, $args->{'add_entries'},
5906: $args->{'only_body'}, $args->{'domain'},
5907: $args->{'force_register'}, $args->{'body_title'},
5908: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5909: $args->{'no_title'}, $args->{'no_inline_link'},
5910: $args);
1.338 albertel 5911: }
1.330 albertel 5912: }
1.338 albertel 5913:
1.315 albertel 5914: if ($args->{'js_ready'}) {
1.317 albertel 5915: $result = &js_ready($result);
1.315 albertel 5916: }
1.320 albertel 5917: if ($args->{'html_encode'}) {
5918: $result = &html_encode($result);
5919: }
1.692.4.2 raeburn 5920: #Breadcrumbs
5921: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
5922: &Apache::lonhtmlcommon::clear_breadcrumbs();
5923: #if any br links exists, add them to the breadcrumbs
5924: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5925: foreach my $crumb (@{$args->{'bread_crumbs'}}){
5926: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
5927: }
5928: }
1.306 albertel 5929:
1.692.4.2 raeburn 5930: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
5931: if (exists($args->{'bread_crumbs_component'})){
5932: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
5933: } else {
5934: $result .= &Apache::lonhtmlcommon::breadcrumbs();
5935: }
5936: }
5937: return $result;
1.692.4.3 raeburn 5938: }
1.330 albertel 5939:
1.306 albertel 5940: =pod
5941:
5942: =item * &head()
5943:
5944: Returns a complete </body></html> section for LON-CAPA web pages.
5945:
1.315 albertel 5946: Inputs: $args - additional optional args supported are:
5947: js_ready -> return a string ready for being used in
5948: a javascript writeln
1.320 albertel 5949: html_encode -> return a string ready for being used in
5950: a html attribute
1.330 albertel 5951: frameset -> if true will start with a <frameset>
5952: rather than <body>
1.493 albertel 5953: dicsussion -> if true will get discussion from
5954: lonxml::xmlend
5955: (you can pass the target and parser arguments
5956: through optional 'target' and 'parser' args
5957: to this routine)
1.306 albertel 5958:
5959: =cut
5960:
5961: sub end_page {
1.315 albertel 5962: my ($args) = @_;
5963: $env{'internal.end_page'}++;
1.330 albertel 5964: my $result;
1.335 albertel 5965: if ($args->{'discussion'}) {
5966: my ($target,$parser);
5967: if (ref($args->{'discussion'})) {
5968: ($target,$parser) =($args->{'discussion'}{'target'},
5969: $args->{'discussion'}{'parser'});
5970: }
5971: $result .= &Apache::lonxml::xmlend($target,$parser);
5972: }
5973:
1.330 albertel 5974: if ($args->{'frameset'}) {
5975: $result .= '</frameset>';
5976: } else {
1.635 raeburn 5977: $result .= &endbodytag($args);
1.330 albertel 5978: }
5979: $result .= "\n</html>";
5980:
1.315 albertel 5981: if ($args->{'js_ready'}) {
1.317 albertel 5982: $result = &js_ready($result);
1.315 albertel 5983: }
1.335 albertel 5984:
1.320 albertel 5985: if ($args->{'html_encode'}) {
5986: $result = &html_encode($result);
5987: }
1.335 albertel 5988:
1.315 albertel 5989: return $result;
5990: }
5991:
1.320 albertel 5992: sub html_encode {
5993: my ($result) = @_;
5994:
1.322 albertel 5995: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 5996:
5997: return $result;
5998: }
1.317 albertel 5999: sub js_ready {
6000: my ($result) = @_;
6001:
1.323 albertel 6002: $result =~ s/[\n\r]/ /xmsg;
6003: $result =~ s/\\/\\\\/xmsg;
6004: $result =~ s/'/\\'/xmsg;
1.372 albertel 6005: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 6006:
6007: return $result;
6008: }
6009:
1.315 albertel 6010: sub validate_page {
6011: if ( exists($env{'internal.start_page'})
1.316 albertel 6012: && $env{'internal.start_page'} > 1) {
6013: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 6014: $env{'internal.start_page'}.' '.
1.316 albertel 6015: $ENV{'request.filename'});
1.315 albertel 6016: }
6017: if ( exists($env{'internal.end_page'})
1.316 albertel 6018: && $env{'internal.end_page'} > 1) {
6019: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 6020: $env{'internal.end_page'}.' '.
1.316 albertel 6021: $env{'request.filename'});
1.315 albertel 6022: }
6023: if ( exists($env{'internal.start_page'})
6024: && ! exists($env{'internal.end_page'})) {
1.316 albertel 6025: &Apache::lonnet::logthis('start_page called without end_page '.
6026: $env{'request.filename'});
1.315 albertel 6027: }
6028: if ( ! exists($env{'internal.start_page'})
6029: && exists($env{'internal.end_page'})) {
1.316 albertel 6030: &Apache::lonnet::logthis('end_page called without start_page'.
6031: $env{'request.filename'});
1.315 albertel 6032: }
1.306 albertel 6033: }
1.315 albertel 6034:
1.318 albertel 6035: sub simple_error_page {
6036: my ($r,$title,$msg) = @_;
6037: my $page =
6038: &Apache::loncommon::start_page($title).
6039: &mt($msg).
6040: &Apache::loncommon::end_page();
6041: if (ref($r)) {
6042: $r->print($page);
1.327 albertel 6043: return;
1.318 albertel 6044: }
6045: return $page;
6046: }
1.347 albertel 6047:
6048: {
1.610 albertel 6049: my @row_count;
1.347 albertel 6050: sub start_data_table {
1.422 albertel 6051: my ($add_class) = @_;
6052: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 6053: unshift(@row_count,0);
1.422 albertel 6054: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 6055: }
6056:
6057: sub end_data_table {
1.610 albertel 6058: shift(@row_count);
1.389 albertel 6059: return '</table>'."\n";;
1.347 albertel 6060: }
6061:
6062: sub start_data_table_row {
1.422 albertel 6063: my ($add_class) = @_;
1.610 albertel 6064: $row_count[0]++;
6065: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 6066: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 6067: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 6068: }
1.471 banghart 6069:
6070: sub continue_data_table_row {
6071: my ($add_class) = @_;
1.610 albertel 6072: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 6073: $css_class = (join(' ',$css_class,$add_class));
6074: return '<tr class="'.$css_class.'">'."\n";;
6075: }
1.347 albertel 6076:
6077: sub end_data_table_row {
1.389 albertel 6078: return '</tr>'."\n";;
1.347 albertel 6079: }
1.367 www 6080:
1.421 albertel 6081: sub start_data_table_empty_row {
1.610 albertel 6082: $row_count[0]++;
1.421 albertel 6083: return '<tr class="LC_empty_row" >'."\n";;
6084: }
6085:
6086: sub end_data_table_empty_row {
6087: return '</tr>'."\n";;
6088: }
6089:
1.367 www 6090: sub start_data_table_header_row {
1.389 albertel 6091: return '<tr class="LC_header_row">'."\n";;
1.367 www 6092: }
6093:
6094: sub end_data_table_header_row {
1.389 albertel 6095: return '</tr>'."\n";;
1.367 www 6096: }
1.347 albertel 6097: }
6098:
1.548 albertel 6099: =pod
6100:
6101: =item * &inhibit_menu_check($arg)
6102:
6103: Checks for a inhibitmenu state and generates output to preserve it
6104:
6105: Inputs: $arg - can be any of
6106: - undef - in which case the return value is a string
6107: to add into arguments list of a uri
6108: - 'input' - in which case the return value is a HTML
6109: <form> <input> field of type hidden to
6110: preserve the value
6111: - a url - in which case the return value is the url with
6112: the neccesary cgi args added to preserve the
6113: inhibitmenu state
6114: - a ref to a url - no return value, but the string is
6115: updated to include the neccessary cgi
6116: args to preserve the inhibitmenu state
6117:
6118: =cut
6119:
6120: sub inhibit_menu_check {
6121: my ($arg) = @_;
6122: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6123: if ($arg eq 'input') {
6124: if ($env{'form.inhibitmenu'}) {
6125: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
6126: } else {
6127: return
6128: }
6129: }
6130: if ($env{'form.inhibitmenu'}) {
6131: if (ref($arg)) {
6132: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6133: } elsif ($arg eq '') {
6134: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
6135: } else {
6136: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6137: }
6138: }
6139: if (!ref($arg)) {
6140: return $arg;
6141: }
6142: }
6143:
1.251 albertel 6144: ###############################################
1.182 matthew 6145:
6146: =pod
6147:
1.549 albertel 6148: =back
6149:
6150: =head1 User Information Routines
6151:
6152: =over 4
6153:
1.405 albertel 6154: =item * &get_users_function()
1.182 matthew 6155:
6156: Used by &bodytag to determine the current users primary role.
6157: Returns either 'student','coordinator','admin', or 'author'.
6158:
6159: =cut
6160:
6161: ###############################################
6162: sub get_users_function {
6163: my $function = 'student';
1.258 albertel 6164: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 6165: $function='coordinator';
6166: }
1.258 albertel 6167: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 6168: $function='admin';
6169: }
1.258 albertel 6170: if (($env{'request.role'}=~/^(au|ca)/) ||
1.182 matthew 6171: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
6172: $function='author';
6173: }
6174: return $function;
1.54 www 6175: }
1.99 www 6176:
6177: ###############################################
6178:
1.233 raeburn 6179: =pod
6180:
1.692.4.2 raeburn 6181: =item * &show_course()
6182:
6183: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
6184: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
6185: Inputs:
6186: None
6187:
6188: Outputs:
6189: Scalar: 1 if 'Course' to be used, 0 otherwise.
6190:
6191: =cut
6192:
6193: ###############################################
6194: sub show_course {
6195: my $course = !$env{'user.adv'};
6196: if (!$env{'user.adv'}) {
6197: foreach my $env (keys(%env)) {
6198: next if ($env !~ m/^user\.priv\./);
6199: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
6200: $course = 0;
6201: last;
6202: }
6203: }
6204: }
6205: return $course;
6206: }
6207:
6208: ###############################################
6209:
6210: =pod
6211:
1.542 raeburn 6212: =item * &check_user_status()
1.274 raeburn 6213:
6214: Determines current status of supplied role for a
6215: specific user. Roles can be active, previous or future.
6216:
6217: Inputs:
6218: user's domain, user's username, course's domain,
1.375 raeburn 6219: course's number, optional section ID.
1.274 raeburn 6220:
6221: Outputs:
6222: role status: active, previous or future.
6223:
6224: =cut
6225:
6226: sub check_user_status {
1.412 raeburn 6227: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 6228: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
6229: my @uroles = keys %userinfo;
6230: my $srchstr;
6231: my $active_chk = 'none';
1.412 raeburn 6232: my $now = time;
1.274 raeburn 6233: if (@uroles > 0) {
1.412 raeburn 6234: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 6235: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
6236: } else {
1.412 raeburn 6237: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
6238: }
6239: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 6240: my $role_end = 0;
6241: my $role_start = 0;
6242: $active_chk = 'active';
1.412 raeburn 6243: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
6244: $role_end = $1;
6245: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
6246: $role_start = $1;
1.274 raeburn 6247: }
6248: }
6249: if ($role_start > 0) {
1.412 raeburn 6250: if ($now < $role_start) {
1.274 raeburn 6251: $active_chk = 'future';
6252: }
6253: }
6254: if ($role_end > 0) {
1.412 raeburn 6255: if ($now > $role_end) {
1.274 raeburn 6256: $active_chk = 'previous';
6257: }
6258: }
6259: }
6260: }
6261: return $active_chk;
6262: }
6263:
6264: ###############################################
6265:
6266: =pod
6267:
1.405 albertel 6268: =item * &get_sections()
1.233 raeburn 6269:
6270: Determines all the sections for a course including
6271: sections with students and sections containing other roles.
1.419 raeburn 6272: Incoming parameters:
6273:
6274: 1. domain
6275: 2. course number
6276: 3. reference to array containing roles for which sections should
6277: be gathered (optional).
6278: 4. reference to array containing status types for which sections
6279: should be gathered (optional).
6280:
6281: If the third argument is undefined, sections are gathered for any role.
6282: If the fourth argument is undefined, sections are gathered for any status.
6283: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 6284:
1.374 raeburn 6285: Returns section hash (keys are section IDs, values are
6286: number of users in each section), subject to the
1.419 raeburn 6287: optional roles filter, optional status filter
1.233 raeburn 6288:
6289: =cut
6290:
6291: ###############################################
6292: sub get_sections {
1.419 raeburn 6293: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 6294: if (!defined($cdom) || !defined($cnum)) {
6295: my $cid = $env{'request.course.id'};
6296:
6297: return if (!defined($cid));
6298:
6299: $cdom = $env{'course.'.$cid.'.domain'};
6300: $cnum = $env{'course.'.$cid.'.num'};
6301: }
6302:
6303: my %sectioncount;
1.419 raeburn 6304: my $now = time;
1.240 albertel 6305:
1.366 albertel 6306: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 6307: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 6308: my $sec_index = &Apache::loncoursedata::CL_SECTION();
6309: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 6310: my $start_index = &Apache::loncoursedata::CL_START();
6311: my $end_index = &Apache::loncoursedata::CL_END();
6312: my $status;
1.366 albertel 6313: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 6314: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
6315: $data->[$status_index],
6316: $data->[$start_index],
6317: $data->[$end_index]);
6318: if ($stu_status eq 'Active') {
6319: $status = 'active';
6320: } elsif ($end < $now) {
6321: $status = 'previous';
6322: } elsif ($start > $now) {
6323: $status = 'future';
6324: }
6325: if ($section ne '-1' && $section !~ /^\s*$/) {
6326: if ((!defined($possible_status)) || (($status ne '') &&
6327: (grep/^\Q$status\E$/,@{$possible_status}))) {
6328: $sectioncount{$section}++;
6329: }
1.240 albertel 6330: }
6331: }
6332: }
6333: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6334: foreach my $user (sort(keys(%courseroles))) {
6335: if ($user !~ /^(\w{2})/) { next; }
6336: my ($role) = ($user =~ /^(\w{2})/);
6337: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 6338: my ($section,$status);
1.240 albertel 6339: if ($role eq 'cr' &&
6340: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
6341: $section=$1;
6342: }
6343: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
6344: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 6345: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
6346: if ($end == -1 && $start == -1) {
6347: next; #deleted role
6348: }
6349: if (!defined($possible_status)) {
6350: $sectioncount{$section}++;
6351: } else {
6352: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
6353: $status = 'active';
6354: } elsif ($end < $now) {
6355: $status = 'future';
6356: } elsif ($start > $now) {
6357: $status = 'previous';
6358: }
6359: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
6360: $sectioncount{$section}++;
6361: }
6362: }
1.233 raeburn 6363: }
1.366 albertel 6364: return %sectioncount;
1.233 raeburn 6365: }
6366:
1.274 raeburn 6367: ###############################################
1.294 raeburn 6368:
6369: =pod
1.405 albertel 6370:
6371: =item * &get_course_users()
6372:
1.275 raeburn 6373: Retrieves usernames:domains for users in the specified course
6374: with specific role(s), and access status.
6375:
6376: Incoming parameters:
1.277 albertel 6377: 1. course domain
6378: 2. course number
6379: 3. access status: users must have - either active,
1.275 raeburn 6380: previous, future, or all.
1.277 albertel 6381: 4. reference to array of permissible roles
1.288 raeburn 6382: 5. reference to array of section restrictions (optional)
6383: 6. reference to results object (hash of hashes).
6384: 7. reference to optional userdata hash
1.609 raeburn 6385: 8. reference to optional statushash
1.630 raeburn 6386: 9. flag if privileged users (except those set to unhide in
6387: course settings) should be excluded
1.609 raeburn 6388: Keys of top level results hash are roles.
1.275 raeburn 6389: Keys of inner hashes are username:domain, with
6390: values set to access type.
1.288 raeburn 6391: Optional userdata hash returns an array with arguments in the
6392: same order as loncoursedata::get_classlist() for student data.
6393:
1.609 raeburn 6394: Optional statushash returns
6395:
1.288 raeburn 6396: Entries for end, start, section and status are blank because
6397: of the possibility of multiple values for non-student roles.
6398:
1.275 raeburn 6399: =cut
1.405 albertel 6400:
1.275 raeburn 6401: ###############################################
1.405 albertel 6402:
1.275 raeburn 6403: sub get_course_users {
1.630 raeburn 6404: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 6405: my %idx = ();
1.419 raeburn 6406: my %seclists;
1.288 raeburn 6407:
6408: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
6409: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
6410: $idx{end} = &Apache::loncoursedata::CL_END();
6411: $idx{start} = &Apache::loncoursedata::CL_START();
6412: $idx{id} = &Apache::loncoursedata::CL_ID();
6413: $idx{section} = &Apache::loncoursedata::CL_SECTION();
6414: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
6415: $idx{status} = &Apache::loncoursedata::CL_STATUS();
6416:
1.290 albertel 6417: if (grep(/^st$/,@{$roles})) {
1.276 albertel 6418: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 6419: my $now = time;
1.277 albertel 6420: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 6421: my $match = 0;
1.412 raeburn 6422: my $secmatch = 0;
1.419 raeburn 6423: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 6424: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 6425: if ($section eq '') {
6426: $section = 'none';
6427: }
1.291 albertel 6428: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6429: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6430: $secmatch = 1;
6431: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 6432: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6433: $secmatch = 1;
6434: }
6435: } else {
1.419 raeburn 6436: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 6437: $secmatch = 1;
6438: }
1.290 albertel 6439: }
1.412 raeburn 6440: if (!$secmatch) {
6441: next;
6442: }
1.419 raeburn 6443: }
1.275 raeburn 6444: if (defined($$types{'active'})) {
1.288 raeburn 6445: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 6446: push(@{$$users{st}{$student}},'active');
1.288 raeburn 6447: $match = 1;
1.275 raeburn 6448: }
6449: }
6450: if (defined($$types{'previous'})) {
1.609 raeburn 6451: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 6452: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 6453: $match = 1;
1.275 raeburn 6454: }
6455: }
6456: if (defined($$types{'future'})) {
1.609 raeburn 6457: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 6458: push(@{$$users{st}{$student}},'future');
1.288 raeburn 6459: $match = 1;
1.275 raeburn 6460: }
6461: }
1.609 raeburn 6462: if ($match) {
6463: push(@{$seclists{$student}},$section);
6464: if (ref($userdata) eq 'HASH') {
6465: $$userdata{$student} = $$classlist{$student};
6466: }
6467: if (ref($statushash) eq 'HASH') {
6468: $statushash->{$student}{'st'}{$section} = $status;
6469: }
1.288 raeburn 6470: }
1.275 raeburn 6471: }
6472: }
1.412 raeburn 6473: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 6474: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6475: my $now = time;
1.609 raeburn 6476: my %displaystatus = ( previous => 'Expired',
6477: active => 'Active',
6478: future => 'Future',
6479: );
1.630 raeburn 6480: my %nothide;
6481: if ($hidepriv) {
6482: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
6483: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
6484: if ($user !~ /:/) {
6485: $nothide{join(':',split(/[\@]/,$user))}=1;
6486: } else {
6487: $nothide{$user} = 1;
6488: }
6489: }
6490: }
1.439 raeburn 6491: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 6492: my $match = 0;
1.412 raeburn 6493: my $secmatch = 0;
1.439 raeburn 6494: my $status;
1.412 raeburn 6495: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 6496: $user =~ s/:$//;
1.439 raeburn 6497: my ($end,$start) = split(/:/,$coursepersonnel{$person});
6498: if ($end == -1 || $start == -1) {
6499: next;
6500: }
6501: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
6502: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 6503: my ($uname,$udom) = split(/:/,$user);
6504: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6505: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6506: $secmatch = 1;
6507: } elsif ($usec eq '') {
1.420 albertel 6508: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6509: $secmatch = 1;
6510: }
6511: } else {
6512: if (grep(/^\Q$usec\E$/,@{$sections})) {
6513: $secmatch = 1;
6514: }
6515: }
6516: if (!$secmatch) {
6517: next;
6518: }
1.288 raeburn 6519: }
1.419 raeburn 6520: if ($usec eq '') {
6521: $usec = 'none';
6522: }
1.275 raeburn 6523: if ($uname ne '' && $udom ne '') {
1.630 raeburn 6524: if ($hidepriv) {
6525: if ((&Apache::lonnet::privileged($uname,$udom)) &&
6526: (!$nothide{$uname.':'.$udom})) {
6527: next;
6528: }
6529: }
1.503 raeburn 6530: if ($end > 0 && $end < $now) {
1.439 raeburn 6531: $status = 'previous';
6532: } elsif ($start > $now) {
6533: $status = 'future';
6534: } else {
6535: $status = 'active';
6536: }
1.277 albertel 6537: foreach my $type (keys(%{$types})) {
1.275 raeburn 6538: if ($status eq $type) {
1.420 albertel 6539: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 6540: push(@{$$users{$role}{$user}},$type);
6541: }
1.288 raeburn 6542: $match = 1;
6543: }
6544: }
1.419 raeburn 6545: if (($match) && (ref($userdata) eq 'HASH')) {
6546: if (!exists($$userdata{$uname.':'.$udom})) {
6547: &get_user_info($udom,$uname,\%idx,$userdata);
6548: }
1.420 albertel 6549: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 6550: push(@{$seclists{$uname.':'.$udom}},$usec);
6551: }
1.609 raeburn 6552: if (ref($statushash) eq 'HASH') {
6553: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
6554: }
1.275 raeburn 6555: }
6556: }
6557: }
6558: }
1.290 albertel 6559: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 6560: if ((defined($cdom)) && (defined($cnum))) {
6561: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
6562: if ( defined($csettings{'internal.courseowner'}) ) {
6563: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 6564: next if ($owner eq '');
6565: my ($ownername,$ownerdom);
6566: if ($owner =~ /^([^:]+):([^:]+)$/) {
6567: $ownername = $1;
6568: $ownerdom = $2;
6569: } else {
6570: $ownername = $owner;
6571: $ownerdom = $cdom;
6572: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 6573: }
6574: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 6575: if (defined($userdata) &&
1.609 raeburn 6576: !exists($$userdata{$owner})) {
6577: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
6578: if (!grep(/^none$/,@{$seclists{$owner}})) {
6579: push(@{$seclists{$owner}},'none');
6580: }
6581: if (ref($statushash) eq 'HASH') {
6582: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 6583: }
1.290 albertel 6584: }
1.279 raeburn 6585: }
6586: }
6587: }
1.419 raeburn 6588: foreach my $user (keys(%seclists)) {
6589: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6590: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6591: }
1.275 raeburn 6592: }
6593: return;
6594: }
6595:
1.288 raeburn 6596: sub get_user_info {
6597: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6598: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6599: &plainname($uname,$udom,'lastname');
1.291 albertel 6600: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6601: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6602: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6603: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6604: return;
6605: }
1.275 raeburn 6606:
1.472 raeburn 6607: ###############################################
6608:
6609: =pod
6610:
6611: =item * &get_user_quota()
6612:
6613: Retrieves quota assigned for storage of portfolio files for a user
6614:
6615: Incoming parameters:
6616: 1. user's username
6617: 2. user's domain
6618:
6619: Returns:
1.536 raeburn 6620: 1. Disk quota (in Mb) assigned to student.
6621: 2. (Optional) Type of setting: custom or default
6622: (individually assigned or default for user's
6623: institutional status).
6624: 3. (Optional) - User's institutional status (e.g., faculty, staff
6625: or student - types as defined in localenroll::inst_usertypes
6626: for user's domain, which determines default quota for user.
6627: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6628:
6629: If a value has been stored in the user's environment,
1.536 raeburn 6630: it will return that, otherwise it returns the maximal default
6631: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6632:
6633: =cut
6634:
6635: ###############################################
6636:
6637:
6638: sub get_user_quota {
6639: my ($uname,$udom) = @_;
1.536 raeburn 6640: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6641: if (!defined($udom)) {
6642: $udom = $env{'user.domain'};
6643: }
6644: if (!defined($uname)) {
6645: $uname = $env{'user.name'};
6646: }
6647: if (($udom eq '' || $uname eq '') ||
6648: ($udom eq 'public') && ($uname eq 'public')) {
6649: $quota = 0;
1.536 raeburn 6650: $quotatype = 'default';
6651: $defquota = 0;
1.472 raeburn 6652: } else {
1.536 raeburn 6653: my $inststatus;
1.472 raeburn 6654: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6655: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6656: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6657: } else {
1.536 raeburn 6658: my %userenv =
6659: &Apache::lonnet::get('environment',['portfolioquota',
6660: 'inststatus'],$udom,$uname);
1.472 raeburn 6661: my ($tmp) = keys(%userenv);
6662: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6663: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6664: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6665: } else {
6666: undef(%userenv);
6667: }
6668: }
1.536 raeburn 6669: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6670: if ($quota eq '') {
1.536 raeburn 6671: $quota = $defquota;
6672: $quotatype = 'default';
6673: } else {
6674: $quotatype = 'custom';
1.472 raeburn 6675: }
6676: }
1.536 raeburn 6677: if (wantarray) {
6678: return ($quota,$quotatype,$settingstatus,$defquota);
6679: } else {
6680: return $quota;
6681: }
1.472 raeburn 6682: }
6683:
6684: ###############################################
6685:
6686: =pod
6687:
6688: =item * &default_quota()
6689:
1.536 raeburn 6690: Retrieves default quota assigned for storage of user portfolio files,
6691: given an (optional) user's institutional status.
1.472 raeburn 6692:
6693: Incoming parameters:
6694: 1. domain
1.536 raeburn 6695: 2. (Optional) institutional status(es). This is a : separated list of
6696: status types (e.g., faculty, staff, student etc.)
6697: which apply to the user for whom the default is being retrieved.
6698: If the institutional status string in undefined, the domain
6699: default quota will be returned.
1.472 raeburn 6700:
6701: Returns:
6702: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6703: 2. (Optional) institutional type which determined the value of the
6704: default quota.
1.472 raeburn 6705:
6706: If a value has been stored in the domain's configuration db,
6707: it will return that, otherwise it returns 20 (for backwards
6708: compatibility with domains which have not set up a configuration
6709: db file; the original statically defined portfolio quota was 20 Mb).
6710:
1.536 raeburn 6711: If the user's status includes multiple types (e.g., staff and student),
6712: the largest default quota which applies to the user determines the
6713: default quota returned.
6714:
1.472 raeburn 6715: =cut
6716:
6717: ###############################################
6718:
6719:
6720: sub default_quota {
1.536 raeburn 6721: my ($udom,$inststatus) = @_;
6722: my ($defquota,$settingstatus);
6723: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 6724: ['quotas'],$udom);
6725: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 6726: if ($inststatus ne '') {
1.692.4.2 raeburn 6727: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 6728: foreach my $item (@statuses) {
1.692.4.2 raeburn 6729: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6730: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
6731: if ($defquota eq '') {
6732: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6733: $settingstatus = $item;
6734: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
6735: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6736: $settingstatus = $item;
6737: }
6738: }
6739: } else {
6740: if ($quotahash{'quotas'}{$item} ne '') {
6741: if ($defquota eq '') {
6742: $defquota = $quotahash{'quotas'}{$item};
6743: $settingstatus = $item;
6744: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
6745: $defquota = $quotahash{'quotas'}{$item};
6746: $settingstatus = $item;
6747: }
1.536 raeburn 6748: }
6749: }
6750: }
6751: }
6752: if ($defquota eq '') {
1.692.4.2 raeburn 6753: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6754: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
6755: } else {
6756: $defquota = $quotahash{'quotas'}{'default'};
6757: }
1.536 raeburn 6758: $settingstatus = 'default';
6759: }
6760: } else {
6761: $settingstatus = 'default';
6762: $defquota = 20;
6763: }
6764: if (wantarray) {
6765: return ($defquota,$settingstatus);
1.472 raeburn 6766: } else {
1.536 raeburn 6767: return $defquota;
1.472 raeburn 6768: }
6769: }
6770:
1.384 raeburn 6771: sub get_secgrprole_info {
6772: my ($cdom,$cnum,$needroles,$type) = @_;
6773: my %sections_count = &get_sections($cdom,$cnum);
6774: my @sections = (sort {$a <=> $b} keys(%sections_count));
6775: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6776: my @groups = sort(keys(%curr_groups));
6777: my $allroles = [];
6778: my $rolehash;
6779: my $accesshash = {
6780: active => 'Currently has access',
6781: future => 'Will have future access',
6782: previous => 'Previously had access',
6783: };
6784: if ($needroles) {
6785: $rolehash = {'all' => 'all'};
1.385 albertel 6786: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6787: if (&Apache::lonnet::error(%user_roles)) {
6788: undef(%user_roles);
6789: }
6790: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6791: my ($role)=split(/\:/,$item,2);
6792: if ($role eq 'cr') { next; }
6793: if ($role =~ /^cr/) {
6794: $$rolehash{$role} = (split('/',$role))[3];
6795: } else {
6796: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6797: }
6798: }
6799: foreach my $key (sort(keys(%{$rolehash}))) {
6800: push(@{$allroles},$key);
6801: }
6802: push (@{$allroles},'st');
6803: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6804: }
6805: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6806: }
6807:
1.555 raeburn 6808: sub user_picker {
1.627 raeburn 6809: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 6810: my $currdom = $dom;
6811: my %curr_selected = (
6812: srchin => 'dom',
1.580 raeburn 6813: srchby => 'lastname',
1.555 raeburn 6814: );
6815: my $srchterm;
1.625 raeburn 6816: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 6817: if ($srch->{'srchby'} ne '') {
6818: $curr_selected{'srchby'} = $srch->{'srchby'};
6819: }
6820: if ($srch->{'srchin'} ne '') {
6821: $curr_selected{'srchin'} = $srch->{'srchin'};
6822: }
6823: if ($srch->{'srchtype'} ne '') {
6824: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6825: }
6826: if ($srch->{'srchdomain'} ne '') {
6827: $currdom = $srch->{'srchdomain'};
6828: }
6829: $srchterm = $srch->{'srchterm'};
6830: }
6831: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6832: 'usr' => 'Search criteria',
1.563 raeburn 6833: 'doma' => 'Domain/institution to search',
1.558 albertel 6834: 'uname' => 'username',
6835: 'lastname' => 'last name',
1.555 raeburn 6836: 'lastfirst' => 'last name, first name',
1.558 albertel 6837: 'crs' => 'in this course',
1.576 raeburn 6838: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6839: 'alc' => 'all LON-CAPA',
1.573 raeburn 6840: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6841: 'exact' => 'is',
6842: 'contains' => 'contains',
1.569 raeburn 6843: 'begins' => 'begins with',
1.571 raeburn 6844: 'youm' => "You must include some text to search for.",
6845: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6846: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6847: 'yomc' => "You must choose a domain when using an institutional directory search.",
6848: 'ymcd' => "You must choose a domain when using a domain search.",
6849: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6850: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6851: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6852: );
1.563 raeburn 6853: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6854: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6855:
6856: my @srchins = ('crs','dom','alc','instd');
6857:
6858: foreach my $option (@srchins) {
6859: # FIXME 'alc' option unavailable until
6860: # loncreateuser::print_user_query_page()
6861: # has been completed.
6862: next if ($option eq 'alc');
6863: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6864: if ($curr_selected{'srchin'} eq $option) {
6865: $srchinsel .= '
6866: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6867: } else {
6868: $srchinsel .= '
6869: <option value="'.$option.'">'.$lt{$option}.'</option>';
6870: }
1.555 raeburn 6871: }
1.563 raeburn 6872: $srchinsel .= "\n </select>\n";
1.555 raeburn 6873:
6874: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6875: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6876: if ($curr_selected{'srchby'} eq $option) {
6877: $srchbysel .= '
6878: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6879: } else {
6880: $srchbysel .= '
6881: <option value="'.$option.'">'.$lt{$option}.'</option>';
6882: }
6883: }
6884: $srchbysel .= "\n </select>\n";
6885:
6886: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6887: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6888: if ($curr_selected{'srchtype'} eq $option) {
6889: $srchtypesel .= '
6890: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6891: } else {
6892: $srchtypesel .= '
6893: <option value="'.$option.'">'.$lt{$option}.'</option>';
6894: }
6895: }
6896: $srchtypesel .= "\n </select>\n";
6897:
1.558 albertel 6898: my ($newuserscript,$new_user_create);
1.556 raeburn 6899:
6900: if ($forcenewuser) {
1.576 raeburn 6901: if (ref($srch) eq 'HASH') {
6902: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 6903: if ($cancreate) {
6904: $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>';
6905: } else {
1.692.4.2 raeburn 6906: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 6907: my %usertypetext = (
6908: official => 'institutional',
6909: unofficial => 'non-institutional',
6910: );
1.692.4.2 raeburn 6911: $new_user_create = '<p class="LC_warning">'.
6912: &mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.
6913: &mt('Please contact the [_1]helpdesk[_2] for assistance.','<a href="'.$helplink.'">','</a>').'</p><br />';
1.627 raeburn 6914: }
1.576 raeburn 6915: }
6916: }
6917:
1.556 raeburn 6918: $newuserscript = <<"ENDSCRIPT";
6919:
1.570 raeburn 6920: function setSearch(createnew,callingForm) {
1.556 raeburn 6921: if (createnew == 1) {
1.570 raeburn 6922: for (var i=0; i<callingForm.srchby.length; i++) {
6923: if (callingForm.srchby.options[i].value == 'uname') {
6924: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6925: }
6926: }
1.570 raeburn 6927: for (var i=0; i<callingForm.srchin.length; i++) {
6928: if ( callingForm.srchin.options[i].value == 'dom') {
6929: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6930: }
6931: }
1.570 raeburn 6932: for (var i=0; i<callingForm.srchtype.length; i++) {
6933: if (callingForm.srchtype.options[i].value == 'exact') {
6934: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6935: }
6936: }
1.570 raeburn 6937: for (var i=0; i<callingForm.srchdomain.length; i++) {
6938: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6939: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6940: }
6941: }
6942: }
6943: }
6944: ENDSCRIPT
1.558 albertel 6945:
1.556 raeburn 6946: }
6947:
1.555 raeburn 6948: my $output = <<"END_BLOCK";
1.556 raeburn 6949: <script type="text/javascript">
1.692.4.4! raeburn 6950: // <![CDATA[
1.570 raeburn 6951: function validateEntry(callingForm) {
1.558 albertel 6952:
1.556 raeburn 6953: var checkok = 1;
1.558 albertel 6954: var srchin;
1.570 raeburn 6955: for (var i=0; i<callingForm.srchin.length; i++) {
6956: if ( callingForm.srchin[i].checked ) {
6957: srchin = callingForm.srchin[i].value;
1.558 albertel 6958: }
6959: }
6960:
1.570 raeburn 6961: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6962: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6963: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6964: var srchterm = callingForm.srchterm.value;
6965: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6966: var msg = "";
6967:
6968: if (srchterm == "") {
6969: checkok = 0;
1.571 raeburn 6970: msg += "$lt{'youm'}\\n";
1.556 raeburn 6971: }
6972:
1.569 raeburn 6973: if (srchtype== 'begins') {
6974: if (srchterm.length < 2) {
6975: checkok = 0;
1.571 raeburn 6976: msg += "$lt{'thte'}\\n";
1.569 raeburn 6977: }
6978: }
6979:
1.556 raeburn 6980: if (srchtype== 'contains') {
6981: if (srchterm.length < 3) {
6982: checkok = 0;
1.571 raeburn 6983: msg += "$lt{'thet'}\\n";
1.556 raeburn 6984: }
6985: }
6986: if (srchin == 'instd') {
6987: if (srchdomain == '') {
6988: checkok = 0;
1.571 raeburn 6989: msg += "$lt{'yomc'}\\n";
1.556 raeburn 6990: }
6991: }
6992: if (srchin == 'dom') {
6993: if (srchdomain == '') {
6994: checkok = 0;
1.571 raeburn 6995: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 6996: }
6997: }
6998: if (srchby == 'lastfirst') {
6999: if (srchterm.indexOf(",") == -1) {
7000: checkok = 0;
1.571 raeburn 7001: msg += "$lt{'whus'}\\n";
1.556 raeburn 7002: }
7003: if (srchterm.indexOf(",") == srchterm.length -1) {
7004: checkok = 0;
1.571 raeburn 7005: msg += "$lt{'whse'}\\n";
1.556 raeburn 7006: }
7007: }
7008: if (checkok == 0) {
1.571 raeburn 7009: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 7010: return;
7011: }
7012: if (checkok == 1) {
1.570 raeburn 7013: callingForm.submit();
1.556 raeburn 7014: }
7015: }
7016:
7017: $newuserscript
7018:
1.692.4.4! raeburn 7019: // ]]>
1.556 raeburn 7020: </script>
1.558 albertel 7021:
7022: $new_user_create
7023:
1.555 raeburn 7024: <table>
1.558 albertel 7025: <tr>
1.573 raeburn 7026: <td>$lt{'doma'}:</td>
7027: <td>$domform</td>
7028: </td>
7029: </tr>
7030: <tr>
7031: <td>$lt{'usr'}:</td>
1.563 raeburn 7032: <td>$srchbysel
7033: $srchtypesel
7034: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 7035: $srchinsel
1.563 raeburn 7036: </td>
7037: </tr>
1.555 raeburn 7038: </table>
7039: <br />
7040: END_BLOCK
1.558 albertel 7041:
1.555 raeburn 7042: return $output;
7043: }
7044:
1.612 raeburn 7045: sub user_rule_check {
1.615 raeburn 7046: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 7047: my $response;
7048: if (ref($usershash) eq 'HASH') {
7049: foreach my $user (keys(%{$usershash})) {
7050: my ($uname,$udom) = split(/:/,$user);
7051: next if ($udom eq '' || $uname eq '');
1.615 raeburn 7052: my ($id,$newuser);
1.612 raeburn 7053: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 7054: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 7055: $id = $usershash->{$user}->{'id'};
7056: }
7057: my $inst_response;
7058: if (ref($checks) eq 'HASH') {
7059: if (defined($checks->{'username'})) {
1.615 raeburn 7060: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7061: &Apache::lonnet::get_instuser($udom,$uname);
7062: } elsif (defined($checks->{'id'})) {
1.615 raeburn 7063: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7064: &Apache::lonnet::get_instuser($udom,undef,$id);
7065: }
1.615 raeburn 7066: } else {
7067: ($inst_response,%{$inst_results->{$user}}) =
7068: &Apache::lonnet::get_instuser($udom,$uname);
7069: return;
1.612 raeburn 7070: }
1.615 raeburn 7071: if (!$got_rules->{$udom}) {
1.612 raeburn 7072: my %domconfig = &Apache::lonnet::get_dom('configuration',
7073: ['usercreation'],$udom);
7074: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 7075: foreach my $item ('username','id') {
1.612 raeburn 7076: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
7077: $$curr_rules{$udom}{$item} =
7078: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 7079: }
7080: }
7081: }
1.615 raeburn 7082: $got_rules->{$udom} = 1;
1.585 raeburn 7083: }
1.612 raeburn 7084: foreach my $item (keys(%{$checks})) {
7085: if (ref($$curr_rules{$udom}) eq 'HASH') {
7086: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
7087: if (@{$$curr_rules{$udom}{$item}} > 0) {
7088: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
7089: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
7090: if ($rule_check{$rule}) {
7091: $$rulematch{$user}{$item} = $rule;
7092: if ($inst_response eq 'ok') {
1.615 raeburn 7093: if (ref($inst_results) eq 'HASH') {
7094: if (ref($inst_results->{$user}) eq 'HASH') {
7095: if (keys(%{$inst_results->{$user}}) == 0) {
7096: $$alerts{$item}{$udom}{$uname} = 1;
7097: }
1.612 raeburn 7098: }
7099: }
1.615 raeburn 7100: }
7101: last;
1.585 raeburn 7102: }
7103: }
7104: }
7105: }
7106: }
7107: }
7108: }
7109: }
1.612 raeburn 7110: return;
7111: }
7112:
7113: sub user_rule_formats {
7114: my ($domain,$domdesc,$curr_rules,$check) = @_;
7115: my %text = (
7116: 'username' => 'Usernames',
7117: 'id' => 'IDs',
7118: );
7119: my $output;
7120: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
7121: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
7122: if (@{$ruleorder} > 0) {
7123: $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>';
7124: foreach my $rule (@{$ruleorder}) {
7125: if (ref($curr_rules) eq 'ARRAY') {
7126: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
7127: if (ref($rules->{$rule}) eq 'HASH') {
7128: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
7129: $rules->{$rule}{'desc'}.'</li>';
7130: }
7131: }
7132: }
7133: }
7134: $output .= '</ul>';
7135: }
7136: }
7137: return $output;
7138: }
7139:
7140: sub instrule_disallow_msg {
1.615 raeburn 7141: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 7142: my $response;
7143: my %text = (
7144: item => 'username',
7145: items => 'usernames',
7146: match => 'matches',
7147: do => 'does',
7148: action => 'a username',
7149: one => 'one',
7150: );
7151: if ($count > 1) {
7152: $text{'item'} = 'usernames';
7153: $text{'match'} ='match';
7154: $text{'do'} = 'do';
7155: $text{'action'} = 'usernames',
7156: $text{'one'} = 'ones';
7157: }
7158: if ($checkitem eq 'id') {
7159: $text{'items'} = 'IDs';
7160: $text{'item'} = 'ID';
7161: $text{'action'} = 'an ID';
1.615 raeburn 7162: if ($count > 1) {
7163: $text{'item'} = 'IDs';
7164: $text{'action'} = 'IDs';
7165: }
1.612 raeburn 7166: }
1.674 bisitz 7167: $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",'<span class="LC_cusr_emph">'.$domdesc.'</span>').'<br />';
1.615 raeburn 7168: if ($mode eq 'upload') {
7169: if ($checkitem eq 'username') {
7170: $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'}.");
7171: } elsif ($checkitem eq 'id') {
1.674 bisitz 7172: $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 Student/Employee ID field.");
1.615 raeburn 7173: }
1.669 raeburn 7174: } elsif ($mode eq 'selfcreate') {
7175: if ($checkitem eq 'id') {
7176: $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.");
7177: }
1.615 raeburn 7178: } else {
7179: if ($checkitem eq 'username') {
7180: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
7181: } elsif ($checkitem eq 'id') {
7182: $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.");
7183: }
1.612 raeburn 7184: }
7185: return $response;
1.585 raeburn 7186: }
7187:
1.624 raeburn 7188: sub personal_data_fieldtitles {
7189: my %fieldtitles = &Apache::lonlocal::texthash (
7190: id => 'Student/Employee ID',
7191: permanentemail => 'E-mail address',
7192: lastname => 'Last Name',
7193: firstname => 'First Name',
7194: middlename => 'Middle Name',
7195: generation => 'Generation',
7196: gen => 'Generation',
1.692.4.2 raeburn 7197: inststatus => 'Affiliation',
1.624 raeburn 7198: );
7199: return %fieldtitles;
7200: }
7201:
1.642 raeburn 7202: sub sorted_inst_types {
7203: my ($dom) = @_;
7204: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
7205: my $othertitle = &mt('All users');
7206: if ($env{'request.course.id'}) {
1.668 raeburn 7207: $othertitle = &mt('Any users');
1.642 raeburn 7208: }
7209: my @types;
7210: if (ref($order) eq 'ARRAY') {
7211: @types = @{$order};
7212: }
7213: if (@types == 0) {
7214: if (ref($usertypes) eq 'HASH') {
7215: @types = sort(keys(%{$usertypes}));
7216: }
7217: }
7218: if (keys(%{$usertypes}) > 0) {
7219: $othertitle = &mt('Other users');
7220: }
7221: return ($othertitle,$usertypes,\@types);
7222: }
7223:
1.645 raeburn 7224: sub get_institutional_codes {
7225: my ($settings,$allcourses,$LC_code) = @_;
7226: # Get complete list of course sections to update
7227: my @currsections = ();
7228: my @currxlists = ();
7229: my $coursecode = $$settings{'internal.coursecode'};
7230:
7231: if ($$settings{'internal.sectionnums'} ne '') {
7232: @currsections = split(/,/,$$settings{'internal.sectionnums'});
7233: }
7234:
7235: if ($$settings{'internal.crosslistings'} ne '') {
7236: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
7237: }
7238:
7239: if (@currxlists > 0) {
7240: foreach (@currxlists) {
7241: if (m/^([^:]+):(\w*)$/) {
7242: unless (grep/^$1$/,@{$allcourses}) {
7243: push @{$allcourses},$1;
7244: $$LC_code{$1} = $2;
7245: }
7246: }
7247: }
7248: }
7249:
7250: if (@currsections > 0) {
7251: foreach (@currsections) {
7252: if (m/^(\w+):(\w*)$/) {
7253: my $sec = $coursecode.$1;
7254: my $lc_sec = $2;
7255: unless (grep/^$sec$/,@{$allcourses}) {
7256: push @{$allcourses},$sec;
7257: $$LC_code{$sec} = $lc_sec;
7258: }
7259: }
7260: }
7261: }
7262: return;
7263: }
7264:
1.112 bowersj2 7265: =pod
7266:
1.692.4.2 raeburn 7267: =head1 Slot Helpers
7268:
7269: =over 4
7270:
7271: =item * sorted_slots()
7272:
7273: Sorts an array of slot names in order of slot start time (earliest first).
7274:
7275: Inputs:
7276:
7277: =over 4
7278:
7279: slotsarr - Reference to array of unsorted slot names.
7280:
7281: slots - Reference to hash of hash, where outer hash keys are slot names.
7282:
7283: =back
7284:
7285: Returns:
7286:
7287: =over 4
7288:
7289: sorted - An array of slot names sorted by the start time of the slot.
7290:
7291: =back
7292:
7293: =back
7294:
7295: =cut
7296:
7297:
7298: sub sorted_slots {
7299: my ($slotsarr,$slots) = @_;
7300: my @sorted;
7301: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
7302: @sorted =
7303: sort {
7304: if (ref($slots->{$a}) && ref($slots->{$b})) {
7305: return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
7306: }
7307: if (ref($slots->{$a})) { return -1;}
7308: if (ref($slots->{$b})) { return 1;}
7309: return 0;
7310: } @{$slotsarr};
7311: }
7312: return @sorted;
7313: }
7314:
7315: =pod
7316:
1.549 albertel 7317: =back
7318:
7319: =head1 HTTP Helpers
7320:
7321: =over 4
7322:
1.648 raeburn 7323: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 7324:
1.258 albertel 7325: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 7326: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 7327: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 7328:
7329: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
7330: $possible_names is an ref to an array of form element names. As an example:
7331: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 7332: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 7333:
7334: =cut
1.1 albertel 7335:
1.6 albertel 7336: sub get_unprocessed_cgi {
1.25 albertel 7337: my ($query,$possible_names)= @_;
1.26 matthew 7338: # $Apache::lonxml::debug=1;
1.356 albertel 7339: foreach my $pair (split(/&/,$query)) {
7340: my ($name, $value) = split(/=/,$pair);
1.369 www 7341: $name = &unescape($name);
1.25 albertel 7342: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
7343: $value =~ tr/+/ /;
7344: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 7345: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 7346: }
1.16 harris41 7347: }
1.6 albertel 7348: }
7349:
1.112 bowersj2 7350: =pod
7351:
1.648 raeburn 7352: =item * &cacheheader()
1.112 bowersj2 7353:
7354: returns cache-controlling header code
7355:
7356: =cut
7357:
1.7 albertel 7358: sub cacheheader {
1.258 albertel 7359: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 7360: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
7361: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 7362: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
7363: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 7364: return $output;
1.7 albertel 7365: }
7366:
1.112 bowersj2 7367: =pod
7368:
1.648 raeburn 7369: =item * &no_cache($r)
1.112 bowersj2 7370:
7371: specifies header code to not have cache
7372:
7373: =cut
7374:
1.9 albertel 7375: sub no_cache {
1.216 albertel 7376: my ($r) = @_;
7377: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 7378: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 7379: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
7380: $r->no_cache(1);
7381: $r->header_out("Expires" => $date);
7382: $r->header_out("Pragma" => "no-cache");
1.123 www 7383: }
7384:
7385: sub content_type {
1.181 albertel 7386: my ($r,$type,$charset) = @_;
1.299 foxr 7387: if ($r) {
7388: # Note that printout.pl calls this with undef for $r.
7389: &no_cache($r);
7390: }
1.258 albertel 7391: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 7392: unless ($charset) {
7393: $charset=&Apache::lonlocal::current_encoding;
7394: }
7395: if ($charset) { $type.='; charset='.$charset; }
7396: if ($r) {
7397: $r->content_type($type);
7398: } else {
7399: print("Content-type: $type\n\n");
7400: }
1.9 albertel 7401: }
1.25 albertel 7402:
1.112 bowersj2 7403: =pod
7404:
1.648 raeburn 7405: =item * &add_to_env($name,$value)
1.112 bowersj2 7406:
1.258 albertel 7407: adds $name to the %env hash with value
1.112 bowersj2 7408: $value, if $name already exists, the entry is converted to an array
7409: reference and $value is added to the array.
7410:
7411: =cut
7412:
1.25 albertel 7413: sub add_to_env {
7414: my ($name,$value)=@_;
1.258 albertel 7415: if (defined($env{$name})) {
7416: if (ref($env{$name})) {
1.25 albertel 7417: #already have multiple values
1.258 albertel 7418: push(@{ $env{$name} },$value);
1.25 albertel 7419: } else {
7420: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 7421: my $first=$env{$name};
7422: undef($env{$name});
7423: push(@{ $env{$name} },$first,$value);
1.25 albertel 7424: }
7425: } else {
1.258 albertel 7426: $env{$name}=$value;
1.25 albertel 7427: }
1.31 albertel 7428: }
1.149 albertel 7429:
7430: =pod
7431:
1.648 raeburn 7432: =item * &get_env_multiple($name)
1.149 albertel 7433:
1.258 albertel 7434: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 7435: values may be defined and end up as an array ref.
7436:
7437: returns an array of values
7438:
7439: =cut
7440:
7441: sub get_env_multiple {
7442: my ($name) = @_;
7443: my @values;
1.258 albertel 7444: if (defined($env{$name})) {
1.149 albertel 7445: # exists is it an array
1.258 albertel 7446: if (ref($env{$name})) {
7447: @values=@{ $env{$name} };
1.149 albertel 7448: } else {
1.258 albertel 7449: $values[0]=$env{$name};
1.149 albertel 7450: }
7451: }
7452: return(@values);
7453: }
7454:
1.660 raeburn 7455: sub ask_for_embedded_content {
7456: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
7457: my $upload_output = '
7458: <form name="upload_embedded" action="'.$actionurl.'"
7459: method="post" enctype="multipart/form-data">';
7460: $upload_output .= $state;
1.661 raeburn 7461: $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660 raeburn 7462:
7463: my $num = 0;
7464: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
7465: $upload_output .= &start_data_table_row().
7466: '<td>'.$embed_file.'</td><td>';
7467: if ($args->{'ignore_remote_references'}
7468: && $embed_file =~ m{^\w+://}) {
7469: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
7470: } elsif ($args->{'error_on_invalid_names'}
7471: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
7472:
7473: $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
7474:
7475: } else {
7476: $upload_output .='
1.661 raeburn 7477: <input name="embedded_item_'.$num.'" type="file" value="" />
1.660 raeburn 7478: <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
7479: my $attrib = join(':',@{$$allfiles{$embed_file}});
7480: $upload_output .=
7481: "\n\t\t".
7482: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
7483: $attrib.'" />';
7484: if (exists($$codebase{$embed_file})) {
7485: $upload_output .=
7486: "\n\t\t".
7487: '<input name="codebase_'.$num.'" type="hidden" value="'.
7488: &escape($$codebase{$embed_file}).'" />';
7489: }
7490: }
7491: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
7492: $num++;
7493: }
7494: $upload_output .= &Apache::loncommon::end_data_table().'<br />
7495: <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
7496: <input type ="submit" value="'.&mt('Upload Listed Files').'" />
7497: '.&mt('(only files for which a location has been provided will be uploaded)').'
7498: </form>';
7499: return $upload_output;
7500: }
7501:
1.661 raeburn 7502: sub upload_embedded {
7503: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
7504: $current_disk_usage) = @_;
7505: my $output;
7506: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
7507: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
7508: my $orig_uploaded_filename =
7509: $env{'form.embedded_item_'.$i.'.filename'};
7510:
7511: $env{'form.embedded_orig_'.$i} =
7512: &unescape($env{'form.embedded_orig_'.$i});
7513: my ($path,$fname) =
7514: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
7515: # no path, whole string is fname
7516: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
7517:
7518: $path = $env{'form.currentpath'}.$path;
7519: $fname = &Apache::lonnet::clean_filename($fname);
7520: # See if there is anything left
7521: next if ($fname eq '');
7522:
7523: # Check if file already exists as a file or directory.
7524: my ($state,$msg);
7525: if ($context eq 'portfolio') {
7526: my $port_path = $dirpath;
7527: if ($group ne '') {
7528: $port_path = "groups/$group/$port_path";
7529: }
7530: ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
7531: $dir_root,$port_path,$disk_quota,
7532: $current_disk_usage,$uname,$udom);
7533: if ($state eq 'will_exceed_quota'
7534: || $state eq 'file_locked'
7535: || $state eq 'file_exists' ) {
7536: $output .= $msg;
7537: next;
7538: }
7539: } elsif (($context eq 'author') || ($context eq 'testbank')) {
7540: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
7541: if ($state eq 'exists') {
7542: $output .= $msg;
7543: next;
7544: }
7545: }
7546: # Check if extension is valid
7547: if (($fname =~ /\.(\w+)$/) &&
7548: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
7549: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
7550: next;
7551: } elsif (($fname =~ /\.(\w+)$/) &&
7552: (!defined(&Apache::loncommon::fileembstyle($1)))) {
7553: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
7554: next;
7555: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
7556: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
7557: next;
7558: }
7559:
7560: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
7561: if ($context eq 'portfolio') {
7562: my $result=
7563: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
7564: $dirpath.$path);
7565: if ($result !~ m|^/uploaded/|) {
7566: $output .= '<span class="LC_error">'
7567: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
7568: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
7569: .'</span><br />';
7570: next;
7571: } else {
7572: $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
7573: $path.$fname.'</span>').'</p>';
7574: }
7575: } else {
7576: # Save the file
7577: my $target = $env{'form.embedded_item_'.$i};
7578: my $fullpath = $dir_root.$dirpath.'/'.$path;
7579: my $dest = $fullpath.$fname;
7580: my $url = $url_root.$dirpath.'/'.$path.$fname;
7581: my @parts=split(/\//,$fullpath);
7582: my $count;
7583: my $filepath = $dir_root;
7584: for ($count=4;$count<=$#parts;$count++) {
7585: $filepath .= "/$parts[$count]";
7586: if ((-e $filepath)!=1) {
7587: mkdir($filepath,0770);
7588: }
7589: }
7590: my $fh;
7591: if (!open($fh,'>'.$dest)) {
7592: &Apache::lonnet::logthis('Failed to create '.$dest);
7593: $output .= '<span class="LC_error">'.
7594: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7595: '</span><br />';
7596: } else {
7597: if (!print $fh $env{'form.embedded_item_'.$i}) {
7598: &Apache::lonnet::logthis('Failed to write to '.$dest);
7599: $output .= '<span class="LC_error">'.
7600: &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7601: '</span><br />';
7602: } else {
7603: if ($context eq 'testbank') {
7604: $output .= &mt('Embedded file uploaded successfully:').
7605: ' <a href="'.$url.'">'.
7606: $orig_uploaded_filename.'</a><br />';
7607: } else {
7608: $output .= '<font size="+2">'.
7609: &mt('View embedded file: [_1]','<a href="'.$url.'">'.
7610: $orig_uploaded_filename.'</a>').'</font><br />';
7611: }
7612: }
7613: close($fh);
7614: }
7615: }
7616: }
7617: return $output;
7618: }
7619:
7620: sub check_for_existing {
7621: my ($path,$fname,$element) = @_;
7622: my ($state,$msg);
7623: if (-d $path.'/'.$fname) {
7624: $state = 'exists';
7625: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7626: } elsif (-e $path.'/'.$fname) {
7627: $state = 'exists';
7628: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7629: }
7630: if ($state eq 'exists') {
7631: $msg = '<span class="LC_error">'.$msg.'</span><br />';
7632: }
7633: return ($state,$msg);
7634: }
7635:
7636: sub check_for_upload {
7637: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
7638: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
7639: my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
7640: my $getpropath = 1;
7641: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
7642: $getpropath);
7643: my $found_file = 0;
7644: my $locked_file = 0;
7645: foreach my $line (@dir_list) {
7646: my ($file_name)=split(/\&/,$line,2);
7647: if ($file_name eq $fname){
7648: $file_name = $path.$file_name;
7649: if ($group ne '') {
7650: $file_name = $group.$file_name;
7651: }
7652: $found_file = 1;
7653: if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
7654: $locked_file = 1;
7655: }
7656: }
7657: }
7658: if (($current_disk_usage + $filesize) > $disk_quota){
7659: my $msg = '<span class="LC_error">'.
7660: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
7661: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
7662: return ('will_exceed_quota',$msg);
7663: } elsif ($found_file) {
7664: if ($locked_file) {
7665: my $msg = '<span class="LC_error">';
7666: $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
7667: $msg .= '</span><br />';
7668: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
7669: return ('file_locked',$msg);
7670: } else {
7671: my $msg = '<span class="LC_error">';
7672: $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
7673: $msg .= '</span>';
7674: $msg .= '<br />';
7675: $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
7676: return ('file_exists',$msg);
7677: }
7678: }
7679: }
7680:
1.31 albertel 7681:
1.41 ng 7682: =pod
1.45 matthew 7683:
1.464 albertel 7684: =back
1.41 ng 7685:
1.112 bowersj2 7686: =head1 CSV Upload/Handling functions
1.38 albertel 7687:
1.41 ng 7688: =over 4
7689:
1.648 raeburn 7690: =item * &upfile_store($r)
1.41 ng 7691:
7692: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 7693: needs $env{'form.upfile'}
1.41 ng 7694: returns $datatoken to be put into hidden field
7695:
7696: =cut
1.31 albertel 7697:
7698: sub upfile_store {
7699: my $r=shift;
1.258 albertel 7700: $env{'form.upfile'}=~s/\r/\n/gs;
7701: $env{'form.upfile'}=~s/\f/\n/gs;
7702: $env{'form.upfile'}=~s/\n+/\n/gs;
7703: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 7704:
1.258 albertel 7705: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
7706: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 7707: {
1.158 raeburn 7708: my $datafile = $r->dir_config('lonDaemons').
7709: '/tmp/'.$datatoken.'.tmp';
7710: if ( open(my $fh,">$datafile") ) {
1.258 albertel 7711: print $fh $env{'form.upfile'};
1.158 raeburn 7712: close($fh);
7713: }
1.31 albertel 7714: }
7715: return $datatoken;
7716: }
7717:
1.56 matthew 7718: =pod
7719:
1.648 raeburn 7720: =item * &load_tmp_file($r)
1.41 ng 7721:
7722: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 7723: needs $env{'form.datatoken'},
7724: sets $env{'form.upfile'} to the contents of the file
1.41 ng 7725:
7726: =cut
1.31 albertel 7727:
7728: sub load_tmp_file {
7729: my $r=shift;
7730: my @studentdata=();
7731: {
1.158 raeburn 7732: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 7733: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 7734: if ( open(my $fh,"<$studentfile") ) {
7735: @studentdata=<$fh>;
7736: close($fh);
7737: }
1.31 albertel 7738: }
1.258 albertel 7739: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 7740: }
7741:
1.56 matthew 7742: =pod
7743:
1.648 raeburn 7744: =item * &upfile_record_sep()
1.41 ng 7745:
7746: Separate uploaded file into records
7747: returns array of records,
1.258 albertel 7748: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 7749:
7750: =cut
1.31 albertel 7751:
7752: sub upfile_record_sep {
1.258 albertel 7753: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 7754: } else {
1.248 albertel 7755: my @records;
1.258 albertel 7756: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 7757: if ($line=~/^\s*$/) { next; }
7758: push(@records,$line);
7759: }
7760: return @records;
1.31 albertel 7761: }
7762: }
7763:
1.56 matthew 7764: =pod
7765:
1.648 raeburn 7766: =item * &record_sep($record)
1.41 ng 7767:
1.258 albertel 7768: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 7769:
7770: =cut
7771:
1.263 www 7772: sub takeleft {
7773: my $index=shift;
7774: return substr('0000'.$index,-4,4);
7775: }
7776:
1.31 albertel 7777: sub record_sep {
7778: my $record=shift;
7779: my %components=();
1.258 albertel 7780: if ($env{'form.upfiletype'} eq 'xml') {
7781: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 7782: my $i=0;
1.356 albertel 7783: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 7784: $field=~s/^(\"|\')//;
7785: $field=~s/(\"|\')$//;
1.263 www 7786: $components{&takeleft($i)}=$field;
1.31 albertel 7787: $i++;
7788: }
1.258 albertel 7789: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 7790: my $i=0;
1.356 albertel 7791: foreach my $field (split(/\t/,$record)) {
1.31 albertel 7792: $field=~s/^(\"|\')//;
7793: $field=~s/(\"|\')$//;
1.263 www 7794: $components{&takeleft($i)}=$field;
1.31 albertel 7795: $i++;
7796: }
7797: } else {
1.561 www 7798: my $separator=',';
1.480 banghart 7799: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 7800: $separator=';';
1.480 banghart 7801: }
1.31 albertel 7802: my $i=0;
1.561 www 7803: # the character we are looking for to indicate the end of a quote or a record
7804: my $looking_for=$separator;
7805: # do not add the characters to the fields
7806: my $ignore=0;
7807: # we just encountered a separator (or the beginning of the record)
7808: my $just_found_separator=1;
7809: # store the field we are working on here
7810: my $field='';
7811: # work our way through all characters in record
7812: foreach my $character ($record=~/(.)/g) {
7813: if ($character eq $looking_for) {
7814: if ($character ne $separator) {
7815: # Found the end of a quote, again looking for separator
7816: $looking_for=$separator;
7817: $ignore=1;
7818: } else {
7819: # Found a separator, store away what we got
7820: $components{&takeleft($i)}=$field;
7821: $i++;
7822: $just_found_separator=1;
7823: $ignore=0;
7824: $field='';
7825: }
7826: next;
7827: }
7828: # single or double quotation marks after a separator indicate beginning of a quote
7829: # we are now looking for the end of the quote and need to ignore separators
7830: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
7831: $looking_for=$character;
7832: next;
7833: }
7834: # ignore would be true after we reached the end of a quote
7835: if ($ignore) { next; }
7836: if (($just_found_separator) && ($character=~/\s/)) { next; }
7837: $field.=$character;
7838: $just_found_separator=0;
1.31 albertel 7839: }
1.561 www 7840: # catch the very last entry, since we never encountered the separator
7841: $components{&takeleft($i)}=$field;
1.31 albertel 7842: }
7843: return %components;
7844: }
7845:
1.144 matthew 7846: ######################################################
7847: ######################################################
7848:
1.56 matthew 7849: =pod
7850:
1.648 raeburn 7851: =item * &upfile_select_html()
1.41 ng 7852:
1.144 matthew 7853: Return HTML code to select a file from the users machine and specify
7854: the file type.
1.41 ng 7855:
7856: =cut
7857:
1.144 matthew 7858: ######################################################
7859: ######################################################
1.31 albertel 7860: sub upfile_select_html {
1.144 matthew 7861: my %Types = (
7862: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 7863: semisv => &mt('Semicolon separated values'),
1.144 matthew 7864: space => &mt('Space separated'),
7865: tab => &mt('Tabulator separated'),
7866: # xml => &mt('HTML/XML'),
7867: );
7868: my $Str = '<input type="file" name="upfile" size="50" />'.
1.692.4.2 raeburn 7869: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 7870: foreach my $type (sort(keys(%Types))) {
7871: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
7872: }
7873: $Str .= "</select>\n";
7874: return $Str;
1.31 albertel 7875: }
7876:
1.301 albertel 7877: sub get_samples {
7878: my ($records,$toget) = @_;
7879: my @samples=({});
7880: my $got=0;
7881: foreach my $rec (@$records) {
7882: my %temp = &record_sep($rec);
7883: if (! grep(/\S/, values(%temp))) { next; }
7884: if (%temp) {
7885: $samples[$got]=\%temp;
7886: $got++;
7887: if ($got == $toget) { last; }
7888: }
7889: }
7890: return \@samples;
7891: }
7892:
1.144 matthew 7893: ######################################################
7894: ######################################################
7895:
1.56 matthew 7896: =pod
7897:
1.648 raeburn 7898: =item * &csv_print_samples($r,$records)
1.41 ng 7899:
7900: Prints a table of sample values from each column uploaded $r is an
7901: Apache Request ref, $records is an arrayref from
7902: &Apache::loncommon::upfile_record_sep
7903:
7904: =cut
7905:
1.144 matthew 7906: ######################################################
7907: ######################################################
1.31 albertel 7908: sub csv_print_samples {
7909: my ($r,$records) = @_;
1.662 bisitz 7910: my $samples = &get_samples($records,5);
1.301 albertel 7911:
1.594 raeburn 7912: $r->print(&mt('Samples').'<br />'.&start_data_table().
7913: &start_data_table_header_row());
1.356 albertel 7914: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7915: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 7916: $r->print(&end_data_table_header_row());
1.301 albertel 7917: foreach my $hash (@$samples) {
1.594 raeburn 7918: $r->print(&start_data_table_row());
1.356 albertel 7919: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 7920: $r->print('<td>');
1.356 albertel 7921: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 7922: $r->print('</td>');
7923: }
1.594 raeburn 7924: $r->print(&end_data_table_row());
1.31 albertel 7925: }
1.594 raeburn 7926: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 7927: }
7928:
1.144 matthew 7929: ######################################################
7930: ######################################################
7931:
1.56 matthew 7932: =pod
7933:
1.648 raeburn 7934: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 7935:
7936: Prints a table to create associations between values and table columns.
1.144 matthew 7937:
1.41 ng 7938: $r is an Apache Request ref,
7939: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 7940: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 7941:
7942: =cut
7943:
1.144 matthew 7944: ######################################################
7945: ######################################################
1.31 albertel 7946: sub csv_print_select_table {
7947: my ($r,$records,$d) = @_;
1.301 albertel 7948: my $i=0;
7949: my $samples = &get_samples($records,1);
1.144 matthew 7950: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 7951: &start_data_table().&start_data_table_header_row().
1.144 matthew 7952: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 7953: '<th>'.&mt('Column').'</th>'.
7954: &end_data_table_header_row()."\n");
1.356 albertel 7955: foreach my $array_ref (@$d) {
7956: my ($value,$display,$defaultcol)=@{ $array_ref };
1.689 bisitz 7957: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 7958:
7959: $r->print('<td><select name=f'.$i.
1.32 matthew 7960: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 7961: $r->print('<option value="none"></option>');
1.356 albertel 7962: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7963: $r->print('<option value="'.$sample.'"'.
7964: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 7965: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 7966: }
1.594 raeburn 7967: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 7968: $i++;
7969: }
1.594 raeburn 7970: $r->print(&end_data_table());
1.31 albertel 7971: $i--;
7972: return $i;
7973: }
1.56 matthew 7974:
1.144 matthew 7975: ######################################################
7976: ######################################################
7977:
1.56 matthew 7978: =pod
1.31 albertel 7979:
1.648 raeburn 7980: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 7981:
7982: Prints a table of sample values from the upload and can make associate samples to internal names.
7983:
7984: $r is an Apache Request ref,
7985: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
7986: $d is an array of 2 element arrays (internal name, displayed name)
7987:
7988: =cut
7989:
1.144 matthew 7990: ######################################################
7991: ######################################################
1.31 albertel 7992: sub csv_samples_select_table {
7993: my ($r,$records,$d) = @_;
7994: my $i=0;
1.144 matthew 7995: #
1.662 bisitz 7996: my $max_samples = 5;
7997: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 7998: $r->print(&start_data_table().
7999: &start_data_table_header_row().'<th>'.
8000: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
8001: &end_data_table_header_row());
1.301 albertel 8002:
8003: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 8004: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 8005: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 8006: foreach my $option (@$d) {
8007: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 8008: $r->print('<option value="'.$value.'"'.
1.253 albertel 8009: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 8010: $display.'</option>');
1.31 albertel 8011: }
8012: $r->print('</select></td><td>');
1.662 bisitz 8013: foreach my $line (0..($max_samples-1)) {
1.301 albertel 8014: if (defined($samples->[$line]{$key})) {
8015: $r->print($samples->[$line]{$key}."<br />\n");
8016: }
8017: }
1.594 raeburn 8018: $r->print('</td>'.&end_data_table_row());
1.31 albertel 8019: $i++;
8020: }
1.594 raeburn 8021: $r->print(&end_data_table());
1.31 albertel 8022: $i--;
8023: return($i);
1.115 matthew 8024: }
8025:
1.144 matthew 8026: ######################################################
8027: ######################################################
8028:
1.115 matthew 8029: =pod
8030:
1.648 raeburn 8031: =item * &clean_excel_name($name)
1.115 matthew 8032:
8033: Returns a replacement for $name which does not contain any illegal characters.
8034:
8035: =cut
8036:
1.144 matthew 8037: ######################################################
8038: ######################################################
1.115 matthew 8039: sub clean_excel_name {
8040: my ($name) = @_;
8041: $name =~ s/[:\*\?\/\\]//g;
8042: if (length($name) > 31) {
8043: $name = substr($name,0,31);
8044: }
8045: return $name;
1.25 albertel 8046: }
1.84 albertel 8047:
1.85 albertel 8048: =pod
8049:
1.648 raeburn 8050: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 8051:
8052: Returns either 1 or undef
8053:
8054: 1 if the part is to be hidden, undef if it is to be shown
8055:
8056: Arguments are:
8057:
8058: $id the id of the part to be checked
8059: $symb, optional the symb of the resource to check
8060: $udom, optional the domain of the user to check for
8061: $uname, optional the username of the user to check for
8062:
8063: =cut
1.84 albertel 8064:
8065: sub check_if_partid_hidden {
8066: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 8067: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 8068: $symb,$udom,$uname);
1.141 albertel 8069: my $truth=1;
8070: #if the string starts with !, then the list is the list to show not hide
8071: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 8072: my @hiddenlist=split(/,/,$hiddenparts);
8073: foreach my $checkid (@hiddenlist) {
1.141 albertel 8074: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 8075: }
1.141 albertel 8076: return !$truth;
1.84 albertel 8077: }
1.127 matthew 8078:
1.138 matthew 8079:
8080: ############################################################
8081: ############################################################
8082:
8083: =pod
8084:
1.157 matthew 8085: =back
8086:
1.138 matthew 8087: =head1 cgi-bin script and graphing routines
8088:
1.157 matthew 8089: =over 4
8090:
1.648 raeburn 8091: =item * &get_cgi_id()
1.138 matthew 8092:
8093: Inputs: none
8094:
8095: Returns an id which can be used to pass environment variables
8096: to various cgi-bin scripts. These environment variables will
8097: be removed from the users environment after a given time by
8098: the routine &Apache::lonnet::transfer_profile_to_env.
8099:
8100: =cut
8101:
8102: ############################################################
8103: ############################################################
1.152 albertel 8104: my $uniq=0;
1.136 matthew 8105: sub get_cgi_id {
1.154 albertel 8106: $uniq=($uniq+1)%100000;
1.280 albertel 8107: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 8108: }
8109:
1.127 matthew 8110: ############################################################
8111: ############################################################
8112:
8113: =pod
8114:
1.648 raeburn 8115: =item * &DrawBarGraph()
1.127 matthew 8116:
1.138 matthew 8117: Facilitates the plotting of data in a (stacked) bar graph.
8118: Puts plot definition data into the users environment in order for
8119: graph.png to plot it. Returns an <img> tag for the plot.
8120: The bars on the plot are labeled '1','2',...,'n'.
8121:
8122: Inputs:
8123:
8124: =over 4
8125:
8126: =item $Title: string, the title of the plot
8127:
8128: =item $xlabel: string, text describing the X-axis of the plot
8129:
8130: =item $ylabel: string, text describing the Y-axis of the plot
8131:
8132: =item $Max: scalar, the maximum Y value to use in the plot
8133: If $Max is < any data point, the graph will not be rendered.
8134:
1.140 matthew 8135: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 8136: they are plotted. If undefined, default values will be used.
8137:
1.178 matthew 8138: =item $labels: array ref holding the labels to use on the x-axis for the bars.
8139:
1.138 matthew 8140: =item @Values: An array of array references. Each array reference holds data
8141: to be plotted in a stacked bar chart.
8142:
1.239 matthew 8143: =item If the final element of @Values is a hash reference the key/value
8144: pairs will be added to the graph definition.
8145:
1.138 matthew 8146: =back
8147:
8148: Returns:
8149:
8150: An <img> tag which references graph.png and the appropriate identifying
8151: information for the plot.
8152:
1.127 matthew 8153: =cut
8154:
8155: ############################################################
8156: ############################################################
1.134 matthew 8157: sub DrawBarGraph {
1.178 matthew 8158: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 8159: #
8160: if (! defined($colors)) {
8161: $colors = ['#33ff00',
8162: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
8163: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
8164: ];
8165: }
1.228 matthew 8166: my $extra_settings = {};
8167: if (ref($Values[-1]) eq 'HASH') {
8168: $extra_settings = pop(@Values);
8169: }
1.127 matthew 8170: #
1.136 matthew 8171: my $identifier = &get_cgi_id();
8172: my $id = 'cgi.'.$identifier;
1.129 matthew 8173: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 8174: return '';
8175: }
1.225 matthew 8176: #
8177: my @Labels;
8178: if (defined($labels)) {
8179: @Labels = @$labels;
8180: } else {
8181: for (my $i=0;$i<@{$Values[0]};$i++) {
8182: push (@Labels,$i+1);
8183: }
8184: }
8185: #
1.129 matthew 8186: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 8187: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 8188: my %ValuesHash;
8189: my $NumSets=1;
8190: foreach my $array (@Values) {
8191: next if (! ref($array));
1.136 matthew 8192: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 8193: join(',',@$array);
1.129 matthew 8194: }
1.127 matthew 8195: #
1.136 matthew 8196: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 8197: if ($NumBars < 3) {
8198: $width = 120+$NumBars*32;
1.220 matthew 8199: $xskip = 1;
1.225 matthew 8200: $bar_width = 30;
8201: } elsif ($NumBars < 5) {
8202: $width = 120+$NumBars*20;
8203: $xskip = 1;
8204: $bar_width = 20;
1.220 matthew 8205: } elsif ($NumBars < 10) {
1.136 matthew 8206: $width = 120+$NumBars*15;
8207: $xskip = 1;
8208: $bar_width = 15;
8209: } elsif ($NumBars <= 25) {
8210: $width = 120+$NumBars*11;
8211: $xskip = 5;
8212: $bar_width = 8;
8213: } elsif ($NumBars <= 50) {
8214: $width = 120+$NumBars*8;
8215: $xskip = 5;
8216: $bar_width = 4;
8217: } else {
8218: $width = 120+$NumBars*8;
8219: $xskip = 5;
8220: $bar_width = 4;
8221: }
8222: #
1.137 matthew 8223: $Max = 1 if ($Max < 1);
8224: if ( int($Max) < $Max ) {
8225: $Max++;
8226: $Max = int($Max);
8227: }
1.127 matthew 8228: $Title = '' if (! defined($Title));
8229: $xlabel = '' if (! defined($xlabel));
8230: $ylabel = '' if (! defined($ylabel));
1.369 www 8231: $ValuesHash{$id.'.title'} = &escape($Title);
8232: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
8233: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 8234: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 8235: $ValuesHash{$id.'.NumBars'} = $NumBars;
8236: $ValuesHash{$id.'.NumSets'} = $NumSets;
8237: $ValuesHash{$id.'.PlotType'} = 'bar';
8238: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8239: $ValuesHash{$id.'.height'} = $height;
8240: $ValuesHash{$id.'.width'} = $width;
8241: $ValuesHash{$id.'.xskip'} = $xskip;
8242: $ValuesHash{$id.'.bar_width'} = $bar_width;
8243: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 8244: #
1.228 matthew 8245: # Deal with other parameters
8246: while (my ($key,$value) = each(%$extra_settings)) {
8247: $ValuesHash{$id.'.'.$key} = $value;
8248: }
8249: #
1.646 raeburn 8250: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 8251: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8252: }
8253:
8254: ############################################################
8255: ############################################################
8256:
8257: =pod
8258:
1.648 raeburn 8259: =item * &DrawXYGraph()
1.137 matthew 8260:
1.138 matthew 8261: Facilitates the plotting of data in an XY graph.
8262: Puts plot definition data into the users environment in order for
8263: graph.png to plot it. Returns an <img> tag for the plot.
8264:
8265: Inputs:
8266:
8267: =over 4
8268:
8269: =item $Title: string, the title of the plot
8270:
8271: =item $xlabel: string, text describing the X-axis of the plot
8272:
8273: =item $ylabel: string, text describing the Y-axis of the plot
8274:
8275: =item $Max: scalar, the maximum Y value to use in the plot
8276: If $Max is < any data point, the graph will not be rendered.
8277:
8278: =item $colors: Array ref containing the hex color codes for the data to be
8279: plotted in. If undefined, default values will be used.
8280:
8281: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8282:
8283: =item $Ydata: Array ref containing Array refs.
1.185 www 8284: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 8285:
8286: =item %Values: hash indicating or overriding any default values which are
8287: passed to graph.png.
8288: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8289:
8290: =back
8291:
8292: Returns:
8293:
8294: An <img> tag which references graph.png and the appropriate identifying
8295: information for the plot.
8296:
1.137 matthew 8297: =cut
8298:
8299: ############################################################
8300: ############################################################
8301: sub DrawXYGraph {
8302: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
8303: #
8304: # Create the identifier for the graph
8305: my $identifier = &get_cgi_id();
8306: my $id = 'cgi.'.$identifier;
8307: #
8308: $Title = '' if (! defined($Title));
8309: $xlabel = '' if (! defined($xlabel));
8310: $ylabel = '' if (! defined($ylabel));
8311: my %ValuesHash =
8312: (
1.369 www 8313: $id.'.title' => &escape($Title),
8314: $id.'.xlabel' => &escape($xlabel),
8315: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 8316: $id.'.y_max_value'=> $Max,
8317: $id.'.labels' => join(',',@$Xlabels),
8318: $id.'.PlotType' => 'XY',
8319: );
8320: #
8321: if (defined($colors) && ref($colors) eq 'ARRAY') {
8322: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8323: }
8324: #
8325: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
8326: return '';
8327: }
8328: my $NumSets=1;
1.138 matthew 8329: foreach my $array (@{$Ydata}){
1.137 matthew 8330: next if (! ref($array));
8331: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
8332: }
1.138 matthew 8333: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 8334: #
8335: # Deal with other parameters
8336: while (my ($key,$value) = each(%Values)) {
8337: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 8338: }
8339: #
1.646 raeburn 8340: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 8341: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8342: }
8343:
8344: ############################################################
8345: ############################################################
8346:
8347: =pod
8348:
1.648 raeburn 8349: =item * &DrawXYYGraph()
1.138 matthew 8350:
8351: Facilitates the plotting of data in an XY graph with two Y axes.
8352: Puts plot definition data into the users environment in order for
8353: graph.png to plot it. Returns an <img> tag for the plot.
8354:
8355: Inputs:
8356:
8357: =over 4
8358:
8359: =item $Title: string, the title of the plot
8360:
8361: =item $xlabel: string, text describing the X-axis of the plot
8362:
8363: =item $ylabel: string, text describing the Y-axis of the plot
8364:
8365: =item $colors: Array ref containing the hex color codes for the data to be
8366: plotted in. If undefined, default values will be used.
8367:
8368: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8369:
8370: =item $Ydata1: The first data set
8371:
8372: =item $Min1: The minimum value of the left Y-axis
8373:
8374: =item $Max1: The maximum value of the left Y-axis
8375:
8376: =item $Ydata2: The second data set
8377:
8378: =item $Min2: The minimum value of the right Y-axis
8379:
8380: =item $Max2: The maximum value of the left Y-axis
8381:
8382: =item %Values: hash indicating or overriding any default values which are
8383: passed to graph.png.
8384: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8385:
8386: =back
8387:
8388: Returns:
8389:
8390: An <img> tag which references graph.png and the appropriate identifying
8391: information for the plot.
1.136 matthew 8392:
8393: =cut
8394:
8395: ############################################################
8396: ############################################################
1.137 matthew 8397: sub DrawXYYGraph {
8398: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
8399: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 8400: #
8401: # Create the identifier for the graph
8402: my $identifier = &get_cgi_id();
8403: my $id = 'cgi.'.$identifier;
8404: #
8405: $Title = '' if (! defined($Title));
8406: $xlabel = '' if (! defined($xlabel));
8407: $ylabel = '' if (! defined($ylabel));
8408: my %ValuesHash =
8409: (
1.369 www 8410: $id.'.title' => &escape($Title),
8411: $id.'.xlabel' => &escape($xlabel),
8412: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 8413: $id.'.labels' => join(',',@$Xlabels),
8414: $id.'.PlotType' => 'XY',
8415: $id.'.NumSets' => 2,
1.137 matthew 8416: $id.'.two_axes' => 1,
8417: $id.'.y1_max_value' => $Max1,
8418: $id.'.y1_min_value' => $Min1,
8419: $id.'.y2_max_value' => $Max2,
8420: $id.'.y2_min_value' => $Min2,
1.136 matthew 8421: );
8422: #
1.137 matthew 8423: if (defined($colors) && ref($colors) eq 'ARRAY') {
8424: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8425: }
8426: #
8427: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
8428: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 8429: return '';
8430: }
8431: my $NumSets=1;
1.137 matthew 8432: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 8433: next if (! ref($array));
8434: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 8435: }
8436: #
8437: # Deal with other parameters
8438: while (my ($key,$value) = each(%Values)) {
8439: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 8440: }
8441: #
1.646 raeburn 8442: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 8443: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 8444: }
8445:
8446: ############################################################
8447: ############################################################
8448:
8449: =pod
8450:
1.157 matthew 8451: =back
8452:
1.139 matthew 8453: =head1 Statistics helper routines?
8454:
8455: Bad place for them but what the hell.
8456:
1.157 matthew 8457: =over 4
8458:
1.648 raeburn 8459: =item * &chartlink()
1.139 matthew 8460:
8461: Returns a link to the chart for a specific student.
8462:
8463: Inputs:
8464:
8465: =over 4
8466:
8467: =item $linktext: The text of the link
8468:
8469: =item $sname: The students username
8470:
8471: =item $sdomain: The students domain
8472:
8473: =back
8474:
1.157 matthew 8475: =back
8476:
1.139 matthew 8477: =cut
8478:
8479: ############################################################
8480: ############################################################
8481: sub chartlink {
8482: my ($linktext, $sname, $sdomain) = @_;
8483: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 8484: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 8485: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 8486: '">'.$linktext.'</a>';
1.153 matthew 8487: }
8488:
8489: #######################################################
8490: #######################################################
8491:
8492: =pod
8493:
8494: =head1 Course Environment Routines
1.157 matthew 8495:
8496: =over 4
1.153 matthew 8497:
1.648 raeburn 8498: =item * &restore_course_settings()
1.153 matthew 8499:
1.648 raeburn 8500: =item * &store_course_settings()
1.153 matthew 8501:
8502: Restores/Store indicated form parameters from the course environment.
8503: Will not overwrite existing values of the form parameters.
8504:
8505: Inputs:
8506: a scalar describing the data (e.g. 'chart', 'problem_analysis')
8507:
8508: a hash ref describing the data to be stored. For example:
8509:
8510: %Save_Parameters = ('Status' => 'scalar',
8511: 'chartoutputmode' => 'scalar',
8512: 'chartoutputdata' => 'scalar',
8513: 'Section' => 'array',
1.373 raeburn 8514: 'Group' => 'array',
1.153 matthew 8515: 'StudentData' => 'array',
8516: 'Maps' => 'array');
8517:
8518: Returns: both routines return nothing
8519:
1.631 raeburn 8520: =back
8521:
1.153 matthew 8522: =cut
8523:
8524: #######################################################
8525: #######################################################
8526: sub store_course_settings {
1.496 albertel 8527: return &store_settings($env{'request.course.id'},@_);
8528: }
8529:
8530: sub store_settings {
1.153 matthew 8531: # save to the environment
8532: # appenv the same items, just to be safe
1.300 albertel 8533: my $udom = $env{'user.domain'};
8534: my $uname = $env{'user.name'};
1.496 albertel 8535: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8536: my %SaveHash;
8537: my %AppHash;
8538: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 8539: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 8540: my $envname = 'environment.'.$basename;
1.258 albertel 8541: if (exists($env{'form.'.$setting})) {
1.153 matthew 8542: # Save this value away
8543: if ($type eq 'scalar' &&
1.258 albertel 8544: (! exists($env{$envname}) ||
8545: $env{$envname} ne $env{'form.'.$setting})) {
8546: $SaveHash{$basename} = $env{'form.'.$setting};
8547: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 8548: } elsif ($type eq 'array') {
8549: my $stored_form;
1.258 albertel 8550: if (ref($env{'form.'.$setting})) {
1.153 matthew 8551: $stored_form = join(',',
8552: map {
1.369 www 8553: &escape($_);
1.258 albertel 8554: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 8555: } else {
8556: $stored_form =
1.369 www 8557: &escape($env{'form.'.$setting});
1.153 matthew 8558: }
8559: # Determine if the array contents are the same.
1.258 albertel 8560: if ($stored_form ne $env{$envname}) {
1.153 matthew 8561: $SaveHash{$basename} = $stored_form;
8562: $AppHash{$envname} = $stored_form;
8563: }
8564: }
8565: }
8566: }
8567: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 8568: $udom,$uname);
1.153 matthew 8569: if ($put_result !~ /^(ok|delayed)/) {
8570: &Apache::lonnet::logthis('unable to save form parameters, '.
8571: 'got error:'.$put_result);
8572: }
8573: # Make sure these settings stick around in this session, too
1.646 raeburn 8574: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 8575: return;
8576: }
8577:
8578: sub restore_course_settings {
1.499 albertel 8579: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 8580: }
8581:
8582: sub restore_settings {
8583: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8584: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 8585: next if (exists($env{'form.'.$setting}));
1.496 albertel 8586: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 8587: '.'.$setting;
1.258 albertel 8588: if (exists($env{$envname})) {
1.153 matthew 8589: if ($type eq 'scalar') {
1.258 albertel 8590: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 8591: } elsif ($type eq 'array') {
1.258 albertel 8592: $env{'form.'.$setting} = [
1.153 matthew 8593: map {
1.369 www 8594: &unescape($_);
1.258 albertel 8595: } split(',',$env{$envname})
1.153 matthew 8596: ];
8597: }
8598: }
8599: }
1.127 matthew 8600: }
8601:
1.618 raeburn 8602: #######################################################
8603: #######################################################
8604:
8605: =pod
8606:
8607: =head1 Domain E-mail Routines
8608:
8609: =over 4
8610:
1.648 raeburn 8611: =item * &build_recipient_list()
1.618 raeburn 8612:
1.692.4.2 raeburn 8613: Build recipient lists for four types of e-mail:
8614: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
8615: (d) Help requests, generated by
8616: lonerrorhandler.pm, CHECKRPMS, loncron, and lonsupportreq.pm respectively.
1.618 raeburn 8617:
8618: Inputs:
1.619 raeburn 8619: defmail (scalar - email address of default recipient),
1.618 raeburn 8620: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 8621: defdom (domain for which to retrieve configuration settings),
8622: origmail (scalar - email address of recipient from loncapa.conf,
8623: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 8624:
1.655 raeburn 8625: Returns: comma separated list of addresses to which to send e-mail.
8626:
8627: =back
1.618 raeburn 8628:
8629: =cut
8630:
8631: ############################################################
8632: ############################################################
8633: sub build_recipient_list {
1.619 raeburn 8634: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 8635: my @recipients;
8636: my $otheremails;
8637: my %domconfig =
8638: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
8639: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.692.4.2 raeburn 8640: if (exists($domconfig{'contacts'}{$mailing})) {
8641: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
8642: my @contacts = ('adminemail','supportemail');
8643: foreach my $item (@contacts) {
8644: if ($domconfig{'contacts'}{$mailing}{$item}) {
8645: my $addr = $domconfig{'contacts'}{$item};
8646: if (!grep(/^\Q$addr\E$/,@recipients)) {
8647: push(@recipients,$addr);
8648: }
1.619 raeburn 8649: }
1.692.4.2 raeburn 8650: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 8651: }
8652: }
1.692.4.2 raeburn 8653: } elsif ($origmail ne '') {
8654: push(@recipients,$origmail);
1.618 raeburn 8655: }
1.619 raeburn 8656: } elsif ($origmail ne '') {
8657: push(@recipients,$origmail);
1.618 raeburn 8658: }
1.688 raeburn 8659: if (defined($defmail)) {
8660: if ($defmail ne '') {
8661: push(@recipients,$defmail);
8662: }
1.618 raeburn 8663: }
8664: if ($otheremails) {
1.619 raeburn 8665: my @others;
8666: if ($otheremails =~ /,/) {
8667: @others = split(/,/,$otheremails);
1.618 raeburn 8668: } else {
1.619 raeburn 8669: push(@others,$otheremails);
8670: }
8671: foreach my $addr (@others) {
8672: if (!grep(/^\Q$addr\E$/,@recipients)) {
8673: push(@recipients,$addr);
8674: }
1.618 raeburn 8675: }
8676: }
1.619 raeburn 8677: my $recipientlist = join(',',@recipients);
1.618 raeburn 8678: return $recipientlist;
8679: }
8680:
1.127 matthew 8681: ############################################################
8682: ############################################################
1.154 albertel 8683:
1.655 raeburn 8684: =pod
8685:
8686: =head1 Course Catalog Routines
8687:
8688: =over 4
8689:
8690: =item * &gather_categories()
8691:
8692: Converts category definitions - keys of categories hash stored in
8693: coursecategories in configuration.db on the primary library server in a
8694: domain - to an array. Also generates javascript and idx hash used to
8695: generate Domain Coordinator interface for editing Course Categories.
8696:
8697: Inputs:
1.663 raeburn 8698:
1.655 raeburn 8699: categories (reference to hash of category definitions).
1.663 raeburn 8700:
1.655 raeburn 8701: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8702: categories and subcategories).
1.663 raeburn 8703:
1.655 raeburn 8704: idx (reference to hash of counters used in Domain Coordinator interface for
8705: editing Course Categories).
1.663 raeburn 8706:
1.655 raeburn 8707: jsarray (reference to array of categories used to create Javascript arrays for
8708: Domain Coordinator interface for editing Course Categories).
8709:
8710: Returns: nothing
8711:
8712: Side effects: populates cats, idx and jsarray.
8713:
8714: =cut
8715:
8716: sub gather_categories {
8717: my ($categories,$cats,$idx,$jsarray) = @_;
8718: my %counters;
8719: my $num = 0;
8720: foreach my $item (keys(%{$categories})) {
8721: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
8722: if ($container eq '' && $depth == 0) {
8723: $cats->[$depth][$categories->{$item}] = $cat;
8724: } else {
8725: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
8726: }
8727: my ($escitem,$tail) = split(/:/,$item,2);
8728: if ($counters{$tail} eq '') {
8729: $counters{$tail} = $num;
8730: $num ++;
8731: }
8732: if (ref($idx) eq 'HASH') {
8733: $idx->{$item} = $counters{$tail};
8734: }
8735: if (ref($jsarray) eq 'ARRAY') {
8736: push(@{$jsarray->[$counters{$tail}]},$item);
8737: }
8738: }
8739: return;
8740: }
8741:
8742: =pod
8743:
8744: =item * &extract_categories()
8745:
8746: Used to generate breadcrumb trails for course categories.
8747:
8748: Inputs:
1.663 raeburn 8749:
1.655 raeburn 8750: categories (reference to hash of category definitions).
1.663 raeburn 8751:
1.655 raeburn 8752: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8753: categories and subcategories).
1.663 raeburn 8754:
1.655 raeburn 8755: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 8756:
1.655 raeburn 8757: allitems (reference to hash - key is category key
8758: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 8759:
1.655 raeburn 8760: idx (reference to hash of counters used in Domain Coordinator interface for
8761: editing Course Categories).
1.663 raeburn 8762:
1.655 raeburn 8763: jsarray (reference to array of categories used to create Javascript arrays for
8764: Domain Coordinator interface for editing Course Categories).
8765:
1.665 raeburn 8766: subcats (reference to hash of arrays containing all subcategories within each
8767: category, -recursive)
8768:
1.655 raeburn 8769: Returns: nothing
8770:
8771: Side effects: populates trails and allitems hash references.
8772:
8773: =cut
8774:
8775: sub extract_categories {
1.665 raeburn 8776: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 8777: if (ref($categories) eq 'HASH') {
8778: &gather_categories($categories,$cats,$idx,$jsarray);
8779: if (ref($cats->[0]) eq 'ARRAY') {
8780: for (my $i=0; $i<@{$cats->[0]}; $i++) {
8781: my $name = $cats->[0][$i];
8782: my $item = &escape($name).'::0';
8783: my $trailstr;
8784: if ($name eq 'instcode') {
8785: $trailstr = &mt('Official courses (with institutional codes)');
8786: } else {
8787: $trailstr = $name;
8788: }
8789: if ($allitems->{$item} eq '') {
8790: push(@{$trails},$trailstr);
8791: $allitems->{$item} = scalar(@{$trails})-1;
8792: }
8793: my @parents = ($name);
8794: if (ref($cats->[1]{$name}) eq 'ARRAY') {
8795: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
8796: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 8797: if (ref($subcats) eq 'HASH') {
8798: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
8799: }
8800: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
8801: }
8802: } else {
8803: if (ref($subcats) eq 'HASH') {
8804: $subcats->{$item} = [];
1.655 raeburn 8805: }
8806: }
8807: }
8808: }
8809: }
8810: return;
8811: }
8812:
8813: =pod
8814:
8815: =item *&recurse_categories()
8816:
8817: Recursively used to generate breadcrumb trails for course categories.
8818:
8819: Inputs:
1.663 raeburn 8820:
1.655 raeburn 8821: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8822: categories and subcategories).
1.663 raeburn 8823:
1.655 raeburn 8824: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 8825:
8826: category (current course category, for which breadcrumb trail is being generated).
8827:
8828: trails (reference to array of breadcrumb trails for each category).
8829:
1.655 raeburn 8830: allitems (reference to hash - key is category key
8831: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 8832:
1.655 raeburn 8833: parents (array containing containers directories for current category,
8834: back to top level).
8835:
8836: Returns: nothing
8837:
8838: Side effects: populates trails and allitems hash references
8839:
8840: =cut
8841:
8842: sub recurse_categories {
1.665 raeburn 8843: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 8844: my $shallower = $depth - 1;
8845: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
8846: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
8847: my $name = $cats->[$depth]{$category}[$k];
8848: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
8849: my $trailstr = join(' -> ',(@{$parents},$category));
8850: if ($allitems->{$item} eq '') {
8851: push(@{$trails},$trailstr);
8852: $allitems->{$item} = scalar(@{$trails})-1;
8853: }
8854: my $deeper = $depth+1;
8855: push(@{$parents},$category);
1.665 raeburn 8856: if (ref($subcats) eq 'HASH') {
8857: my $subcat = &escape($name).':'.$category.':'.$depth;
8858: for (my $j=@{$parents}; $j>=0; $j--) {
8859: my $higher;
8860: if ($j > 0) {
8861: $higher = &escape($parents->[$j]).':'.
8862: &escape($parents->[$j-1]).':'.$j;
8863: } else {
8864: $higher = &escape($parents->[$j]).'::'.$j;
8865: }
8866: push(@{$subcats->{$higher}},$subcat);
8867: }
8868: }
8869: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
8870: $subcats);
1.655 raeburn 8871: pop(@{$parents});
8872: }
8873: } else {
8874: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
8875: my $trailstr = join(' -> ',(@{$parents},$category));
8876: if ($allitems->{$item} eq '') {
8877: push(@{$trails},$trailstr);
8878: $allitems->{$item} = scalar(@{$trails})-1;
8879: }
8880: }
8881: return;
8882: }
8883:
1.663 raeburn 8884: =pod
8885:
8886: =item *&assign_categories_table()
8887:
8888: Create a datatable for display of hierarchical categories in a domain,
8889: with checkboxes to allow a course to be categorized.
8890:
8891: Inputs:
8892:
8893: cathash - reference to hash of categories defined for the domain (from
8894: configuration.db)
8895:
8896: currcat - scalar with an & separated list of categories assigned to a course.
8897:
8898: Returns: $output (markup to be displayed)
8899:
8900: =cut
8901:
8902: sub assign_categories_table {
8903: my ($cathash,$currcat) = @_;
8904: my $output;
8905: if (ref($cathash) eq 'HASH') {
8906: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
8907: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
8908: $maxdepth = scalar(@cats);
8909: if (@cats > 0) {
8910: my $itemcount = 0;
8911: if (ref($cats[0]) eq 'ARRAY') {
8912: $output = &Apache::loncommon::start_data_table();
8913: my @currcategories;
8914: if ($currcat ne '') {
8915: @currcategories = split('&',$currcat);
8916: }
8917: for (my $i=0; $i<@{$cats[0]}; $i++) {
8918: my $parent = $cats[0][$i];
8919: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
8920: next if ($parent eq 'instcode');
8921: my $item = &escape($parent).'::0';
8922: my $checked = '';
8923: if (@currcategories > 0) {
8924: if (grep(/^\Q$item\E$/,@currcategories)) {
8925: $checked = ' checked="checked" ';
8926: }
8927: }
1.675 raeburn 8928: $output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
8929: '<input type="checkbox" name="usecategory" value="'.
8930: $item.'"'.$checked.' />'.$parent.'</span>'.
8931: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 8932: my $depth = 1;
8933: push(@path,$parent);
8934: $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
8935: pop(@path);
8936: $output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
8937: $itemcount ++;
8938: }
8939: $output .= &Apache::loncommon::end_data_table();
8940: }
8941: }
8942: }
8943: return $output;
8944: }
8945:
8946: =pod
8947:
8948: =item *&assign_category_rows()
8949:
8950: Create a datatable row for display of nested categories in a domain,
8951: with checkboxes to allow a course to be categorized,called recursively.
8952:
8953: Inputs:
8954:
8955: itemcount - track row number for alternating colors
8956:
8957: cats - reference to array of arrays/hashes which encapsulates hierarchy of
8958: categories and subcategories.
8959:
8960: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
8961:
8962: parent - parent of current category item
8963:
8964: path - Array containing all categories back up through the hierarchy from the
8965: current category to the top level.
8966:
8967: currcategories - reference to array of current categories assigned to the course
8968:
8969: Returns: $output (markup to be displayed).
8970:
8971: =cut
8972:
8973: sub assign_category_rows {
8974: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
8975: my ($text,$name,$item,$chgstr);
8976: if (ref($cats) eq 'ARRAY') {
8977: my $maxdepth = scalar(@{$cats});
8978: if (ref($cats->[$depth]) eq 'HASH') {
8979: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
8980: my $numchildren = @{$cats->[$depth]{$parent}};
8981: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
8982: $text .= '<td><table class="LC_datatable">';
8983: for (my $j=0; $j<$numchildren; $j++) {
8984: $name = $cats->[$depth]{$parent}[$j];
8985: $item = &escape($name).':'.&escape($parent).':'.$depth;
8986: my $deeper = $depth+1;
8987: my $checked = '';
8988: if (ref($currcategories) eq 'ARRAY') {
8989: if (@{$currcategories} > 0) {
8990: if (grep(/^\Q$item\E$/,@{$currcategories})) {
8991: $checked = ' checked="checked" ';
8992: }
8993: }
8994: }
1.664 raeburn 8995: $text .= '<tr><td><span class="LC_nobreak"><label>'.
8996: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 8997: $item.'"'.$checked.' />'.$name.'</label></span>'.
8998: '<input type="hidden" name="catname" value="'.$name.'" />'.
8999: '</td><td>';
1.663 raeburn 9000: if (ref($path) eq 'ARRAY') {
9001: push(@{$path},$name);
9002: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
9003: pop(@{$path});
9004: }
9005: $text .= '</td></tr>';
9006: }
9007: $text .= '</table></td>';
9008: }
9009: }
9010: }
9011: return $text;
9012: }
9013:
1.655 raeburn 9014: ############################################################
9015: ############################################################
9016:
9017:
1.443 albertel 9018: sub commit_customrole {
1.664 raeburn 9019: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 9020: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 9021: ($start?', '.&mt('starting').' '.localtime($start):'').
9022: ($end?', ending '.localtime($end):'').': <b>'.
9023: &Apache::lonnet::assigncustomrole(
1.664 raeburn 9024: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 9025: '</b><br />';
9026: return $output;
9027: }
9028:
9029: sub commit_standardrole {
1.541 raeburn 9030: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
9031: my ($output,$logmsg,$linefeed);
9032: if ($context eq 'auto') {
9033: $linefeed = "\n";
9034: } else {
9035: $linefeed = "<br />\n";
9036: }
1.443 albertel 9037: if ($three eq 'st') {
1.541 raeburn 9038: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
9039: $one,$two,$sec,$context);
9040: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 9041: ($result eq 'unknown_course') || ($result eq 'refused')) {
9042: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 9043: } else {
1.541 raeburn 9044: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 9045: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9046: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
9047: if ($context eq 'auto') {
9048: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
9049: } else {
9050: $output .= '<b>'.$result.'</b>'.$linefeed.
9051: &mt('Add to classlist').': <b>ok</b>';
9052: }
9053: $output .= $linefeed;
1.443 albertel 9054: }
9055: } else {
9056: $output = &mt('Assigning').' '.$three.' in '.$url.
9057: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9058: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 9059: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 9060: if ($context eq 'auto') {
9061: $output .= $result.$linefeed;
9062: } else {
9063: $output .= '<b>'.$result.'</b>'.$linefeed;
9064: }
1.443 albertel 9065: }
9066: return $output;
9067: }
9068:
9069: sub commit_studentrole {
1.541 raeburn 9070: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 9071: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 9072: if ($context eq 'auto') {
9073: $linefeed = "\n";
9074: } else {
9075: $linefeed = '<br />'."\n";
9076: }
1.443 albertel 9077: if (defined($one) && defined($two)) {
9078: my $cid=$one.'_'.$two;
9079: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
9080: my $secchange = 0;
9081: my $expire_role_result;
9082: my $modify_section_result;
1.628 raeburn 9083: if ($oldsec ne '-1') {
9084: if ($oldsec ne $sec) {
1.443 albertel 9085: $secchange = 1;
1.628 raeburn 9086: my $now = time;
1.443 albertel 9087: my $uurl='/'.$cid;
9088: $uurl=~s/\_/\//g;
9089: if ($oldsec) {
9090: $uurl.='/'.$oldsec;
9091: }
1.626 raeburn 9092: $oldsecurl = $uurl;
1.628 raeburn 9093: $expire_role_result =
1.652 raeburn 9094: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 9095: if ($env{'request.course.sec'} ne '') {
9096: if ($expire_role_result eq 'refused') {
9097: my @roles = ('st');
9098: my @statuses = ('previous');
9099: my @roledoms = ($one);
9100: my $withsec = 1;
9101: my %roleshash =
9102: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
9103: \@statuses,\@roles,\@roledoms,$withsec);
9104: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
9105: my ($oldstart,$oldend) =
9106: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
9107: if ($oldend > 0 && $oldend <= $now) {
9108: $expire_role_result = 'ok';
9109: }
9110: }
9111: }
9112: }
1.443 albertel 9113: $result = $expire_role_result;
9114: }
9115: }
9116: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 9117: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 9118: if ($modify_section_result =~ /^ok/) {
9119: if ($secchange == 1) {
1.628 raeburn 9120: if ($sec eq '') {
9121: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
9122: } else {
9123: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
9124: }
1.443 albertel 9125: } elsif ($oldsec eq '-1') {
1.628 raeburn 9126: if ($sec eq '') {
9127: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
9128: } else {
9129: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9130: }
1.443 albertel 9131: } else {
1.628 raeburn 9132: if ($sec eq '') {
9133: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
9134: } else {
9135: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9136: }
1.443 albertel 9137: }
9138: } else {
1.628 raeburn 9139: if ($secchange) {
9140: $$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;
9141: } else {
9142: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
9143: }
1.443 albertel 9144: }
9145: $result = $modify_section_result;
9146: } elsif ($secchange == 1) {
1.628 raeburn 9147: if ($oldsec eq '') {
9148: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
9149: } else {
9150: $$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;
9151: }
1.626 raeburn 9152: if ($expire_role_result eq 'refused') {
9153: my $newsecurl = '/'.$cid;
9154: $newsecurl =~ s/\_/\//g;
9155: if ($sec ne '') {
9156: $newsecurl.='/'.$sec;
9157: }
9158: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
9159: if ($sec eq '') {
9160: $$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;
9161: } else {
9162: $$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;
9163: }
9164: }
9165: }
1.443 albertel 9166: }
9167: } else {
1.626 raeburn 9168: $$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 9169: $result = "error: incomplete course id\n";
9170: }
9171: return $result;
9172: }
9173:
9174: ############################################################
9175: ############################################################
9176:
1.566 albertel 9177: sub check_clone {
1.578 raeburn 9178: my ($args,$linefeed) = @_;
1.566 albertel 9179: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
9180: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
9181: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
9182: my $clonemsg;
9183: my $can_clone = 0;
9184:
9185: if ($clonehome eq 'no_host') {
1.578 raeburn 9186: $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 9187: } else {
9188: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 9189: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 9190: $can_clone = 1;
9191: } else {
9192: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
9193: $args->{'clonedomain'},$args->{'clonecourse'});
9194: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 9195: if (grep(/^\*$/,@cloners)) {
9196: $can_clone = 1;
9197: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
9198: $can_clone = 1;
9199: } else {
9200: my %roleshash =
9201: &Apache::lonnet::get_my_roles($args->{'ccuname'},
9202: $args->{'ccdomain'},
9203: 'userroles',['active'],['cc'],
9204: [$args->{'clonedomain'}]);
9205: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
9206: $can_clone = 1;
9207: } else {
9208: $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'});
9209: }
1.566 albertel 9210: }
1.578 raeburn 9211: }
1.566 albertel 9212: }
9213: return ($can_clone, $clonemsg, $cloneid, $clonehome);
9214: }
9215:
1.444 albertel 9216: sub construct_course {
1.541 raeburn 9217: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 9218: my $outcome;
1.541 raeburn 9219: my $linefeed = '<br />'."\n";
9220: if ($context eq 'auto') {
9221: $linefeed = "\n";
9222: }
1.566 albertel 9223:
9224: #
9225: # Are we cloning?
9226: #
9227: my ($can_clone, $clonemsg, $cloneid, $clonehome);
9228: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 9229: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 9230: if ($context ne 'auto') {
1.578 raeburn 9231: if ($clonemsg ne '') {
9232: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
9233: }
1.566 albertel 9234: }
9235: $outcome .= $clonemsg.$linefeed;
9236:
9237: if (!$can_clone) {
9238: return (0,$outcome);
9239: }
9240: }
9241:
1.444 albertel 9242: #
9243: # Open course
9244: #
9245: my $crstype = lc($args->{'crstype'});
9246: my %cenv=();
9247: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
9248: $args->{'cdescr'},
9249: $args->{'curl'},
9250: $args->{'course_home'},
9251: $args->{'nonstandard'},
9252: $args->{'crscode'},
9253: $args->{'ccuname'}.':'.
9254: $args->{'ccdomain'},
9255: $args->{'crstype'});
9256:
9257: # Note: The testing routines depend on this being output; see
9258: # Utils::Course. This needs to at least be output as a comment
9259: # if anyone ever decides to not show this, and Utils::Course::new
9260: # will need to be suitably modified.
1.541 raeburn 9261: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 9262: #
9263: # Check if created correctly
9264: #
1.479 albertel 9265: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 9266: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 9267: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 9268:
1.444 albertel 9269: #
1.566 albertel 9270: # Do the cloning
9271: #
9272: if ($can_clone && $cloneid) {
9273: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
9274: if ($context ne 'auto') {
9275: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
9276: }
9277: $outcome .= $clonemsg.$linefeed;
9278: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 9279: # Copy all files
1.637 www 9280: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 9281: # Restore URL
1.566 albertel 9282: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 9283: # Restore title
1.566 albertel 9284: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 9285: # Mark as cloned
1.566 albertel 9286: $cenv{'clonedfrom'}=$cloneid;
1.638 www 9287: # Need to clone grading mode
9288: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
9289: $cenv{'grading'}=$newenv{'grading'};
9290: # Do not clone these environment entries
9291: &Apache::lonnet::del('environment',
9292: ['default_enrollment_start_date',
9293: 'default_enrollment_end_date',
9294: 'question.email',
9295: 'policy.email',
9296: 'comment.email',
9297: 'pch.users.denied',
1.692.4.2 raeburn 9298: 'plc.users.denied',
9299: 'hidefromcat',
9300: 'categories'],
1.638 www 9301: $$crsudom,$$crsunum);
1.444 albertel 9302: }
1.566 albertel 9303:
1.444 albertel 9304: #
9305: # Set environment (will override cloned, if existing)
9306: #
9307: my @sections = ();
9308: my @xlists = ();
9309: if ($args->{'crstype'}) {
9310: $cenv{'type'}=$args->{'crstype'};
9311: }
9312: if ($args->{'crsid'}) {
9313: $cenv{'courseid'}=$args->{'crsid'};
9314: }
9315: if ($args->{'crscode'}) {
9316: $cenv{'internal.coursecode'}=$args->{'crscode'};
9317: }
9318: if ($args->{'crsquota'} ne '') {
9319: $cenv{'internal.coursequota'}=$args->{'crsquota'};
9320: } else {
9321: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
9322: }
9323: if ($args->{'ccuname'}) {
9324: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
9325: ':'.$args->{'ccdomain'};
9326: } else {
9327: $cenv{'internal.courseowner'} = $args->{'curruser'};
9328: }
9329: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
9330: if ($args->{'crssections'}) {
9331: $cenv{'internal.sectionnums'} = '';
9332: if ($args->{'crssections'} =~ m/,/) {
9333: @sections = split/,/,$args->{'crssections'};
9334: } else {
9335: $sections[0] = $args->{'crssections'};
9336: }
9337: if (@sections > 0) {
9338: foreach my $item (@sections) {
9339: my ($sec,$gp) = split/:/,$item;
9340: my $class = $args->{'crscode'}.$sec;
9341: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
9342: $cenv{'internal.sectionnums'} .= $item.',';
9343: unless ($addcheck eq 'ok') {
9344: push @badclasses, $class;
9345: }
9346: }
9347: $cenv{'internal.sectionnums'} =~ s/,$//;
9348: }
9349: }
9350: # do not hide course coordinator from staff listing,
9351: # even if privileged
9352: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9353: # add crosslistings
9354: if ($args->{'crsxlist'}) {
9355: $cenv{'internal.crosslistings'}='';
9356: if ($args->{'crsxlist'} =~ m/,/) {
9357: @xlists = split/,/,$args->{'crsxlist'};
9358: } else {
9359: $xlists[0] = $args->{'crsxlist'};
9360: }
9361: if (@xlists > 0) {
9362: foreach my $item (@xlists) {
9363: my ($xl,$gp) = split/:/,$item;
9364: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
9365: $cenv{'internal.crosslistings'} .= $item.',';
9366: unless ($addcheck eq 'ok') {
9367: push @badclasses, $xl;
9368: }
9369: }
9370: $cenv{'internal.crosslistings'} =~ s/,$//;
9371: }
9372: }
9373: if ($args->{'autoadds'}) {
9374: $cenv{'internal.autoadds'}=$args->{'autoadds'};
9375: }
9376: if ($args->{'autodrops'}) {
9377: $cenv{'internal.autodrops'}=$args->{'autodrops'};
9378: }
9379: # check for notification of enrollment changes
9380: my @notified = ();
9381: if ($args->{'notify_owner'}) {
9382: if ($args->{'ccuname'} ne '') {
9383: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
9384: }
9385: }
9386: if ($args->{'notify_dc'}) {
9387: if ($uname ne '') {
1.630 raeburn 9388: push(@notified,$uname.':'.$udom);
1.444 albertel 9389: }
9390: }
9391: if (@notified > 0) {
9392: my $notifylist;
9393: if (@notified > 1) {
9394: $notifylist = join(',',@notified);
9395: } else {
9396: $notifylist = $notified[0];
9397: }
9398: $cenv{'internal.notifylist'} = $notifylist;
9399: }
9400: if (@badclasses > 0) {
9401: my %lt=&Apache::lonlocal::texthash(
9402: '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',
9403: 'dnhr' => 'does not have rights to access enrollment in these classes',
9404: 'adby' => 'as determined by the policies of your institution on access to official classlists'
9405: );
1.541 raeburn 9406: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
9407: ' ('.$lt{'adby'}.')';
9408: if ($context eq 'auto') {
9409: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 9410: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 9411: foreach my $item (@badclasses) {
9412: if ($context eq 'auto') {
9413: $outcome .= " - $item\n";
9414: } else {
9415: $outcome .= "<li>$item</li>\n";
9416: }
9417: }
9418: if ($context eq 'auto') {
9419: $outcome .= $linefeed;
9420: } else {
1.566 albertel 9421: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 9422: }
9423: }
1.444 albertel 9424: }
9425: if ($args->{'no_end_date'}) {
9426: $args->{'endaccess'} = 0;
9427: }
9428: $cenv{'internal.autostart'}=$args->{'enrollstart'};
9429: $cenv{'internal.autoend'}=$args->{'enrollend'};
9430: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
9431: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
9432: if ($args->{'showphotos'}) {
9433: $cenv{'internal.showphotos'}=$args->{'showphotos'};
9434: }
9435: $cenv{'internal.authtype'} = $args->{'authtype'};
9436: $cenv{'internal.autharg'} = $args->{'autharg'};
9437: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
9438: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 9439: 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');
9440: if ($context eq 'auto') {
9441: $outcome .= $krb_msg;
9442: } else {
1.566 albertel 9443: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 9444: }
9445: $outcome .= $linefeed;
1.444 albertel 9446: }
9447: }
9448: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
9449: if ($args->{'setpolicy'}) {
9450: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9451: }
9452: if ($args->{'setcontent'}) {
9453: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9454: }
9455: }
9456: if ($args->{'reshome'}) {
9457: $cenv{'reshome'}=$args->{'reshome'}.'/';
9458: $cenv{'reshome'}=~s/\/+$/\//;
9459: }
9460: #
9461: # course has keyed access
9462: #
9463: if ($args->{'setkeys'}) {
9464: $cenv{'keyaccess'}='yes';
9465: }
9466: # if specified, key authority is not course, but user
9467: # only active if keyaccess is yes
9468: if ($args->{'keyauth'}) {
1.487 albertel 9469: my ($user,$domain) = split(':',$args->{'keyauth'});
9470: $user = &LONCAPA::clean_username($user);
9471: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 9472: if ($user ne '' && $domain ne '') {
1.487 albertel 9473: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 9474: }
9475: }
9476:
9477: if ($args->{'disresdis'}) {
9478: $cenv{'pch.roles.denied'}='st';
9479: }
9480: if ($args->{'disablechat'}) {
9481: $cenv{'plc.roles.denied'}='st';
9482: }
9483:
9484: # Record we've not yet viewed the Course Initialization Helper for this
9485: # course
9486: $cenv{'course.helper.not.run'} = 1;
9487: #
9488: # Use new Randomseed
9489: #
9490: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
9491: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
9492: #
9493: # The encryption code and receipt prefix for this course
9494: #
9495: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
9496: $cenv{'internal.encpref'}=100+int(9*rand(99));
9497: #
9498: # By default, use standard grading
9499: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
9500:
1.541 raeburn 9501: $outcome .= $linefeed.&mt('Setting environment').': '.
9502: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9503: #
9504: # Open all assignments
9505: #
9506: if ($args->{'openall'}) {
9507: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
9508: my %storecontent = ($storeunder => time,
9509: $storeunder.'.type' => 'date_start');
9510:
9511: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 9512: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9513: }
9514: #
9515: # Set first page
9516: #
9517: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
9518: || ($cloneid)) {
1.445 albertel 9519: use LONCAPA::map;
1.444 albertel 9520: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 9521:
9522: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
9523: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
9524:
1.444 albertel 9525: $outcome .= ($fatal?$errtext:'read ok').' - ';
9526: my $title; my $url;
9527: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 9528: $title=&mt('Syllabus');
1.444 albertel 9529: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
9530: } else {
1.690 bisitz 9531: $title=&mt('Navigate Contents');
1.444 albertel 9532: $url='/adm/navmaps';
9533: }
1.445 albertel 9534:
9535: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
9536: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
9537:
9538: if ($errtext) { $fatal=2; }
1.541 raeburn 9539: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 9540: }
1.566 albertel 9541:
9542: return (1,$outcome);
1.444 albertel 9543: }
9544:
9545: ############################################################
9546: ############################################################
9547:
1.378 raeburn 9548: sub course_type {
9549: my ($cid) = @_;
9550: if (!defined($cid)) {
9551: $cid = $env{'request.course.id'};
9552: }
1.404 albertel 9553: if (defined($env{'course.'.$cid.'.type'})) {
9554: return $env{'course.'.$cid.'.type'};
1.378 raeburn 9555: } else {
9556: return 'Course';
1.377 raeburn 9557: }
9558: }
1.156 albertel 9559:
1.406 raeburn 9560: sub group_term {
9561: my $crstype = &course_type();
9562: my %names = (
9563: 'Course' => 'group',
9564: 'Group' => 'team',
9565: );
9566: return $names{$crstype};
9567: }
9568:
1.156 albertel 9569: sub icon {
9570: my ($file)=@_;
1.505 albertel 9571: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 9572: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 9573: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 9574: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
9575: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
9576: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9577: $curfext.".gif") {
9578: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9579: $curfext.".gif";
9580: }
9581: }
1.249 albertel 9582: return &lonhttpdurl($iconname);
1.154 albertel 9583: }
1.84 albertel 9584:
1.575 albertel 9585: sub lonhttpdurl {
1.692 www 9586: #
9587: # Had been used for "small fry" static images on separate port 8080.
9588: # Modify here if lightweight http functionality desired again.
9589: # Currently eliminated due to increasing firewall issues.
9590: #
1.575 albertel 9591: my ($url)=@_;
1.692 www 9592: return $url;
1.215 albertel 9593: }
9594:
1.213 albertel 9595: sub connection_aborted {
9596: my ($r)=@_;
9597: $r->print(" ");$r->rflush();
9598: my $c = $r->connection;
9599: return $c->aborted();
9600: }
9601:
1.221 foxr 9602: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 9603: # strings as 'strings'.
9604: sub escape_single {
1.221 foxr 9605: my ($input) = @_;
1.223 albertel 9606: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 9607: $input =~ s/\'/\\\'/g; # Esacpe the 's....
9608: return $input;
9609: }
1.223 albertel 9610:
1.222 foxr 9611: # Same as escape_single, but escape's "'s This
9612: # can be used for "strings"
9613: sub escape_double {
9614: my ($input) = @_;
9615: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
9616: $input =~ s/\"/\\\"/g; # Esacpe the "s....
9617: return $input;
9618: }
1.223 albertel 9619:
1.222 foxr 9620: # Escapes the last element of a full URL.
9621: sub escape_url {
9622: my ($url) = @_;
1.238 raeburn 9623: my @urlslices = split(/\//, $url,-1);
1.369 www 9624: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 9625: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 9626: }
1.462 albertel 9627:
1.692.4.2 raeburn 9628: sub compare_arrays {
9629: my ($arrayref1,$arrayref2) = @_;
9630: my (@difference,%count);
9631: @difference = ();
9632: %count = ();
9633: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
9634: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
9635: foreach my $element (keys(%count)) {
9636: if ($count{$element} == 1) {
9637: push(@difference,$element);
9638: }
9639: }
9640: }
9641: return @difference;
9642: }
9643:
1.462 albertel 9644: # -------------------------------------------------------- Initliaze user login
9645: sub init_user_environment {
1.463 albertel 9646: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 9647: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
9648:
9649: my $public=($username eq 'public' && $domain eq 'public');
9650:
9651: # See if old ID present, if so, remove
9652:
9653: my ($filename,$cookie,$userroles);
9654: my $now=time;
9655:
9656: if ($public) {
9657: my $max_public=100;
9658: my $oldest;
9659: my $oldest_time=0;
9660: for(my $next=1;$next<=$max_public;$next++) {
9661: if (-e $lonids."/publicuser_$next.id") {
9662: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
9663: if ($mtime<$oldest_time || !$oldest_time) {
9664: $oldest_time=$mtime;
9665: $oldest=$next;
9666: }
9667: } else {
9668: $cookie="publicuser_$next";
9669: last;
9670: }
9671: }
9672: if (!$cookie) { $cookie="publicuser_$oldest"; }
9673: } else {
1.463 albertel 9674: # if this isn't a robot, kill any existing non-robot sessions
9675: if (!$args->{'robot'}) {
9676: opendir(DIR,$lonids);
9677: while ($filename=readdir(DIR)) {
9678: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
9679: unlink($lonids.'/'.$filename);
9680: }
1.462 albertel 9681: }
1.463 albertel 9682: closedir(DIR);
1.462 albertel 9683: }
9684: # Give them a new cookie
1.463 albertel 9685: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 9686: : $now.$$.int(rand(10000)));
1.463 albertel 9687: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 9688:
9689: # Initialize roles
9690:
9691: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
9692: }
9693: # ------------------------------------ Check browser type and MathML capability
9694:
9695: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
9696: $clientunicode,$clientos) = &decode_user_agent($r);
9697:
9698: # -------------------------------------- Any accessibility options to remember?
9699: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
9700: foreach my $option ('imagesuppress','appletsuppress',
9701: 'embedsuppress','fontenhance','blackwhite') {
9702: if ($form->{$option} eq 'true') {
9703: &Apache::lonnet::put('environment',{$option => 'on'},
9704: $domain,$username);
9705: } else {
9706: &Apache::lonnet::del('environment',[$option],
9707: $domain,$username);
9708: }
9709: }
9710: }
9711: # ------------------------------------------------------------- Get environment
9712:
9713: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
9714: my ($tmp) = keys(%userenv);
9715: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9716: # default remote control to off
9717: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
9718: } else {
9719: undef(%userenv);
9720: }
9721: if (($userenv{'interface'}) && (!$form->{'interface'})) {
9722: $form->{'interface'}=$userenv{'interface'};
9723: }
9724: $env{'environment.remote'}=$userenv{'remote'};
9725: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
9726:
9727: # --------------- Do not trust query string to be put directly into environment
9728: foreach my $option ('imagesuppress','appletsuppress',
9729: 'embedsuppress','fontenhance','blackwhite',
9730: 'interface','localpath','localres') {
9731: $form->{$option}=~s/[\n\r\=]//gs;
9732: }
9733: # --------------------------------------------------------- Write first profile
9734:
9735: {
9736: my %initial_env =
9737: ("user.name" => $username,
9738: "user.domain" => $domain,
9739: "user.home" => $authhost,
9740: "browser.type" => $clientbrowser,
9741: "browser.version" => $clientversion,
9742: "browser.mathml" => $clientmathml,
9743: "browser.unicode" => $clientunicode,
9744: "browser.os" => $clientos,
9745: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
9746: "request.course.fn" => '',
9747: "request.course.uri" => '',
9748: "request.course.sec" => '',
9749: "request.role" => 'cm',
9750: "request.role.adv" => $env{'user.adv'},
9751: "request.host" => $ENV{'REMOTE_ADDR'},);
9752:
9753: if ($form->{'localpath'}) {
9754: $initial_env{"browser.localpath"} = $form->{'localpath'};
9755: $initial_env{"browser.localres"} = $form->{'localres'};
9756: }
9757:
9758: if ($public) {
9759: $initial_env{"environment.remote"} = "off";
9760: }
9761: if ($form->{'interface'}) {
9762: $form->{'interface'}=~s/\W//gs;
9763: $initial_env{"browser.interface"} = $form->{'interface'};
9764: $env{'browser.interface'}=$form->{'interface'};
9765: foreach my $option ('imagesuppress','appletsuppress',
9766: 'embedsuppress','fontenhance','blackwhite') {
9767: if (($form->{$option} eq 'true') ||
9768: ($userenv{$option} eq 'on')) {
9769: $initial_env{"browser.$option"} = "on";
9770: }
9771: }
9772: }
9773:
1.692.4.2 raeburn 9774: foreach my $tool ('aboutme','blog','portfolio') {
9775: $userenv{'availabletools.'.$tool} =
9776: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
9777: }
9778:
9779: foreach my $crstype ('official','unofficial') {
9780: $userenv{'canrequest.'.$crstype} =
9781: &Apache::lonnet::usertools_access($username,$domain,$crstype,
9782: 'reload','requestcourses');
9783: }
9784:
1.462 albertel 9785: $env{'user.environment'} = "$lonids/$cookie.id";
9786:
9787: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
9788: &GDBM_WRCREAT(),0640)) {
9789: &_add_to_env(\%disk_env,\%initial_env);
9790: &_add_to_env(\%disk_env,\%userenv,'environment.');
9791: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 9792: if (ref($args->{'extra_env'})) {
9793: &_add_to_env(\%disk_env,$args->{'extra_env'});
9794: }
1.462 albertel 9795: untie(%disk_env);
9796: } else {
9797: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
9798: 'Could not create environment storage in lonauth: '.$!.'</font>');
9799: return 'error: '.$!;
9800: }
9801: }
9802: $env{'request.role'}='cm';
9803: $env{'request.role.adv'}=$env{'user.adv'};
9804: $env{'browser.type'}=$clientbrowser;
9805:
9806: return $cookie;
9807:
9808: }
9809:
9810: sub _add_to_env {
9811: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 9812: if (ref($env_data) eq 'HASH') {
9813: while (my ($key,$value) = each(%$env_data)) {
9814: $idf->{$prefix.$key} = $value;
9815: $env{$prefix.$key} = $value;
9816: }
1.462 albertel 9817: }
9818: }
9819:
1.685 tempelho 9820: # --- Get the symbolic name of a problem and the url
9821: sub get_symb {
9822: my ($request,$silent) = @_;
1.692.4.2 raeburn 9823: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 9824: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
9825: if ($symb eq '') {
9826: if (!$silent) {
9827: $request->print("Unable to handle ambiguous references:$url:.");
9828: return ();
9829: }
9830: }
9831: &Apache::lonenc::check_decrypt(\$symb);
9832: return ($symb);
9833: }
9834:
9835: # --------------------------------------------------------------Get annotation
9836:
9837: sub get_annotation {
9838: my ($symb,$enc) = @_;
9839:
9840: my $key = $symb;
9841: if (!$enc) {
9842: $key =
9843: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
9844: }
9845: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
9846: return $annotation{$key};
9847: }
9848:
9849: sub clean_symb {
1.692.4.2 raeburn 9850: my ($symb,$delete_enc) = @_;
1.685 tempelho 9851:
9852: &Apache::lonenc::check_decrypt(\$symb);
9853: my $enc = $env{'request.enc'};
1.692.4.2 raeburn 9854: if ($delete_enc) {
9855: delete($env{'request.enc'});
9856: }
1.685 tempelho 9857:
9858: return ($symb,$enc);
9859: }
1.462 albertel 9860:
1.41 ng 9861: =pod
9862:
9863: =back
9864:
1.112 bowersj2 9865: =cut
1.41 ng 9866:
1.112 bowersj2 9867: 1;
9868: __END__;
1.41 ng 9869:
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