Annotation of loncom/interface/loncommon.pm, revision 1.692.4.8
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.8! raeburn 4: # $Id: loncommon.pm,v 1.692.4.7 2009/08/14 07:49:01 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.692.4.6 raeburn 485: my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Community - 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.692.4.7 raeburn 527: if (formname == 'ccrs') {
528: var ownername = document.forms[formid].ccuname.value;
529: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
530: url += '&cloner='+ownername+':'+ownerdom;
531: }
1.293 raeburn 532: if (multflag !=null && multflag != '') {
533: url += '&multiple='+multflag;
534: }
1.692.4.6 raeburn 535: if (crstype == 'Course/Community') {
1.377 raeburn 536: if (formname == 'cu') {
537: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
538: if (crstype == "") {
539: alert("$crs_or_grp_alert");
540: return;
541: }
542: }
543: }
544: if (crstype !=null && crstype != '') {
545: url += '&type='+crstype;
546: }
1.102 www 547: var title = 'Course_Browser';
1.91 www 548: var options = 'scrollbars=1,resizable=1,menubar=0';
549: options += ',width=700,height=600';
550: stdeditbrowser = open(url,title,options,'1');
551: stdeditbrowser.focus();
552: }
1.468 raeburn 553:
554: function getFormIdByName(formname) {
555: for (var i=0;i<document.forms.length;i++) {
556: if (document.forms[i].name == formname) {
557: return i;
558: }
559: }
560: return -1;
561: }
562:
563: function getIndexByName(formid,item) {
564: for (var i=0;i<document.forms[formid].elements.length;i++) {
565: if (document.forms[formid].elements[i].name == item) {
566: return i;
567: }
568: }
569: return -1;
570: }
1.91 www 571: ENDSTDBRW
1.468 raeburn 572: if ($sec_element ne '') {
573: $output .= &setsec_javascript($sec_element,$formname);
574: }
575: $output .= '
1.692.4.4 raeburn 576: // ]]>
1.468 raeburn 577: </script>';
578: return $output;
579: }
580:
581: sub setsec_javascript {
582: my ($sec_element,$formname) = @_;
583: my $setsections = qq|
584: function setSect(sectionlist) {
1.629 raeburn 585: var sectionsArray = new Array();
586: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
587: sectionsArray = sectionlist.split(",");
588: }
1.468 raeburn 589: var numSections = sectionsArray.length;
590: document.$formname.$sec_element.length = 0;
591: if (numSections == 0) {
592: document.$formname.$sec_element.multiple=false;
593: document.$formname.$sec_element.size=1;
594: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
595: } else {
596: if (numSections == 1) {
597: document.$formname.$sec_element.multiple=false;
598: document.$formname.$sec_element.size=1;
599: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
600: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
601: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
602: } else {
603: for (var i=0; i<numSections; i++) {
604: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
605: }
606: document.$formname.$sec_element.multiple=true
607: if (numSections < 3) {
608: document.$formname.$sec_element.size=numSections;
609: } else {
610: document.$formname.$sec_element.size=3;
611: }
612: document.$formname.$sec_element.options[0].selected = false
613: }
614: }
1.91 www 615: }
1.468 raeburn 616: |;
617: return $setsections;
618: }
619:
1.91 www 620:
621: sub selectcourse_link {
1.377 raeburn 622: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.692.4.6 raeburn 623: my $linktext = &mt('Select Course');
624: if ($selecttype eq 'Community') {
625: $linktext = &mt('Select Community');
626: }
1.692.4.2 raeburn 627: return '<span class="LC_nobreak">'
628: ."<a href='"
629: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
630: .'","'.$udomele.'","'.$desc.'","'.$extra_element
631: .'","'.$multflag.'","'.$selecttype.'");'
1.692.4.6 raeburn 632: ."'>".$linktext.'</a>'
1.692.4.2 raeburn 633: .'</span>';
1.74 www 634: }
1.42 matthew 635:
1.653 raeburn 636: sub selectauthor_link {
637: my ($form,$udom)=@_;
638: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
639: &mt('Select Author').'</a>';
640: }
641:
1.273 raeburn 642: sub check_uncheck_jscript {
643: my $jscript = <<"ENDSCRT";
644: function checkAll(field) {
645: if (field.length > 0) {
646: for (i = 0; i < field.length; i++) {
647: field[i].checked = true ;
648: }
649: } else {
650: field.checked = true
651: }
652: }
653:
654: function uncheckAll(field) {
655: if (field.length > 0) {
656: for (i = 0; i < field.length; i++) {
657: field[i].checked = false ;
1.543 albertel 658: }
659: } else {
1.273 raeburn 660: field.checked = false ;
661: }
662: }
663: ENDSCRT
664: return $jscript;
665: }
666:
1.656 www 667: sub select_timezone {
1.659 raeburn 668: my ($name,$selected,$onchange,$includeempty)=@_;
669: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
670: if ($includeempty) {
671: $output .= '<option value=""';
672: if (($selected eq '') || ($selected eq 'local')) {
673: $output .= ' selected="selected" ';
674: }
675: $output .= '> </option>';
676: }
1.657 raeburn 677: my @timezones = DateTime::TimeZone->all_names;
678: foreach my $tzone (@timezones) {
679: $output.= '<option value="'.$tzone.'"';
680: if ($tzone eq $selected) {
681: $output.=' selected="selected"';
682: }
683: $output.=">$tzone</option>\n";
1.656 www 684: }
685: $output.="</select>";
686: return $output;
687: }
1.273 raeburn 688:
1.687 raeburn 689: sub select_datelocale {
690: my ($name,$selected,$onchange,$includeempty)=@_;
691: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
692: if ($includeempty) {
693: $output .= '<option value=""';
694: if ($selected eq '') {
695: $output .= ' selected="selected" ';
696: }
697: $output .= '> </option>';
698: }
699: my (@possibles,%locale_names);
700: my @locales = DateTime::Locale::Catalog::Locales;
701: foreach my $locale (@locales) {
702: if (ref($locale) eq 'HASH') {
703: my $id = $locale->{'id'};
704: if ($id ne '') {
705: my $en_terr = $locale->{'en_territory'};
706: my $native_terr = $locale->{'native_territory'};
1.692.4.1 raeburn 707: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 708: if (grep(/^en$/,@languages) || !@languages) {
709: if ($en_terr ne '') {
710: $locale_names{$id} = '('.$en_terr.')';
711: } elsif ($native_terr ne '') {
712: $locale_names{$id} = $native_terr;
713: }
714: } else {
715: if ($native_terr ne '') {
716: $locale_names{$id} = $native_terr.' ';
717: } elsif ($en_terr ne '') {
718: $locale_names{$id} = '('.$en_terr.')';
719: }
720: }
721: push (@possibles,$id);
722: }
723: }
724: }
725: foreach my $item (sort(@possibles)) {
726: $output.= '<option value="'.$item.'"';
727: if ($item eq $selected) {
728: $output.=' selected="selected"';
729: }
730: $output.=">$item";
731: if ($locale_names{$item} ne '') {
732: $output.=" $locale_names{$item}</option>\n";
733: }
734: $output.="</option>\n";
735: }
736: $output.="</select>";
737: return $output;
738: }
739:
1.692.4.2 raeburn 740: sub select_language {
741: my ($name,$selected,$includeempty) = @_;
742: my %langchoices;
743: if ($includeempty) {
744: %langchoices = ('' => 'No language preference');
745: }
746: foreach my $id (&languageids()) {
747: my $code = &supportedlanguagecode($id);
748: if ($code) {
749: $langchoices{$code} = &plainlanguagedescription($id);
750: }
751: }
752: return &select_form($selected,$name,%langchoices);
753: }
754:
1.42 matthew 755: =pod
1.36 matthew 756:
1.648 raeburn 757: =item * &linked_select_forms(...)
1.36 matthew 758:
759: linked_select_forms returns a string containing a <script></script> block
760: and html for two <select> menus. The select menus will be linked in that
761: changing the value of the first menu will result in new values being placed
762: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 763: order unless a defined order is provided.
1.36 matthew 764:
765: linked_select_forms takes the following ordered inputs:
766:
767: =over 4
768:
1.112 bowersj2 769: =item * $formname, the name of the <form> tag
1.36 matthew 770:
1.112 bowersj2 771: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 772:
1.112 bowersj2 773: =item * $firstdefault, the default value for the first menu
1.36 matthew 774:
1.112 bowersj2 775: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 776:
1.112 bowersj2 777: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 778:
1.112 bowersj2 779: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 780:
1.609 raeburn 781: =item * $menuorder, the order of values in the first menu
782:
1.41 ng 783: =back
784:
1.36 matthew 785: Below is an example of such a hash. Only the 'text', 'default', and
786: 'select2' keys must appear as stated. keys(%menu) are the possible
787: values for the first select menu. The text that coincides with the
1.41 ng 788: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 789: and text for the second menu are given in the hash pointed to by
790: $menu{$choice1}->{'select2'}.
791:
1.112 bowersj2 792: my %menu = ( A1 => { text =>"Choice A1" ,
793: default => "B3",
794: select2 => {
795: B1 => "Choice B1",
796: B2 => "Choice B2",
797: B3 => "Choice B3",
798: B4 => "Choice B4"
1.609 raeburn 799: },
800: order => ['B4','B3','B1','B2'],
1.112 bowersj2 801: },
802: A2 => { text =>"Choice A2" ,
803: default => "C2",
804: select2 => {
805: C1 => "Choice C1",
806: C2 => "Choice C2",
807: C3 => "Choice C3"
1.609 raeburn 808: },
809: order => ['C2','C1','C3'],
1.112 bowersj2 810: },
811: A3 => { text =>"Choice A3" ,
812: default => "D6",
813: select2 => {
814: D1 => "Choice D1",
815: D2 => "Choice D2",
816: D3 => "Choice D3",
817: D4 => "Choice D4",
818: D5 => "Choice D5",
819: D6 => "Choice D6",
820: D7 => "Choice D7"
1.609 raeburn 821: },
822: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 823: }
824: );
1.36 matthew 825:
826: =cut
827:
828: sub linked_select_forms {
829: my ($formname,
830: $middletext,
831: $firstdefault,
832: $firstselectname,
833: $secondselectname,
1.609 raeburn 834: $hashref,
835: $menuorder,
1.36 matthew 836: ) = @_;
837: my $second = "document.$formname.$secondselectname";
838: my $first = "document.$formname.$firstselectname";
839: # output the javascript to do the changing
840: my $result = '';
1.692.4.2 raeburn 841: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.692.4.4 raeburn 842: $result.="// <![CDATA[\n";
1.36 matthew 843: $result.="var select2data = new Object();\n";
844: $" = '","';
845: my $debug = '';
846: foreach my $s1 (sort(keys(%$hashref))) {
847: $result.="select2data.d_$s1 = new Object();\n";
848: $result.="select2data.d_$s1.def = new String('".
849: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 850: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 851: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 852: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
853: @s2values = @{$hashref->{$s1}->{'order'}};
854: }
1.36 matthew 855: $result.="\"@s2values\");\n";
856: $result.="select2data.d_$s1.texts = new Array(";
857: my @s2texts;
858: foreach my $value (@s2values) {
859: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
860: }
861: $result.="\"@s2texts\");\n";
862: }
863: $"=' ';
864: $result.= <<"END";
865:
866: function select1_changed() {
867: // Determine new choice
868: var newvalue = "d_" + $first.value;
869: // update select2
870: var values = select2data[newvalue].values;
871: var texts = select2data[newvalue].texts;
872: var select2def = select2data[newvalue].def;
873: var i;
874: // out with the old
875: for (i = 0; i < $second.options.length; i++) {
876: $second.options[i] = null;
877: }
878: // in with the nuclear
879: for (i=0;i<values.length; i++) {
880: $second.options[i] = new Option(values[i]);
1.143 matthew 881: $second.options[i].value = values[i];
1.36 matthew 882: $second.options[i].text = texts[i];
883: if (values[i] == select2def) {
884: $second.options[i].selected = true;
885: }
886: }
887: }
1.692.4.4 raeburn 888: // ]]>
1.36 matthew 889: </script>
890: END
891: # output the initial values for the selection lists
892: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 893: my @order = sort(keys(%{$hashref}));
894: if (ref($menuorder) eq 'ARRAY') {
895: @order = @{$menuorder};
896: }
897: foreach my $value (@order) {
1.36 matthew 898: $result.=" <option value=\"$value\" ";
1.253 albertel 899: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 900: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 901: }
902: $result .= "</select>\n";
903: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
904: $result .= $middletext;
905: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
906: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 907:
908: my @secondorder = sort(keys(%select2));
909: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
910: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
911: }
912: foreach my $value (@secondorder) {
1.36 matthew 913: $result.=" <option value=\"$value\" ";
1.253 albertel 914: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 915: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 916: }
917: $result .= "</select>\n";
918: # return $debug;
919: return $result;
920: } # end of sub linked_select_forms {
921:
1.45 matthew 922: =pod
1.44 bowersj2 923:
1.648 raeburn 924: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44 bowersj2 925:
1.112 bowersj2 926: Returns a string corresponding to an HTML link to the given help
927: $topic, where $topic corresponds to the name of a .tex file in
928: /home/httpd/html/adm/help/tex, with underscores replaced by
929: spaces.
930:
931: $text will optionally be linked to the same topic, allowing you to
932: link text in addition to the graphic. If you do not want to link
933: text, but wish to specify one of the later parameters, pass an
934: empty string.
935:
936: $stayOnPage is a value that will be interpreted as a boolean. If true,
937: the link will not open a new window. If false, the link will open
938: a new window using Javascript. (Default is false.)
939:
940: $width and $height are optional numerical parameters that will
941: override the width and height of the popped up window, which may
942: be useful for certain help topics with big pictures included.
1.44 bowersj2 943:
944: =cut
945:
946: sub help_open_topic {
1.48 bowersj2 947: my ($topic, $text, $stayOnPage, $width, $height) = @_;
948: $text = "" if (not defined $text);
1.44 bowersj2 949: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 950: if ($env{'browser.interface'} eq 'textual') {
1.79 www 951: $stayOnPage=1;
952: }
1.44 bowersj2 953: $width = 350 if (not defined $width);
954: $height = 400 if (not defined $height);
955: my $filename = $topic;
956: $filename =~ s/ /_/g;
957:
1.48 bowersj2 958: my $template = "";
959: my $link;
1.572 banghart 960:
1.159 www 961: $topic=~s/\W/\_/g;
1.44 bowersj2 962:
1.572 banghart 963: if (!$stayOnPage) {
1.72 bowersj2 964: $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 965: } else {
1.48 bowersj2 966: $link = "/adm/help/${filename}.hlp";
967: }
968:
969: # Add the text
1.572 banghart 970: if ($text ne "") {
1.77 www 971: $template .=
1.572 banghart 972: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.691 bisitz 973: "<td bgcolor='#5555FF'><span class=\"LC_nobreak\"><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 974: }
975:
976: # Add the graphic
1.179 matthew 977: my $title = &mt('Online Help');
1.667 raeburn 978: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.692.4.2 raeburn 979: $template .= '<a target="_top" href="'.$link.'" title="'.$title.'">'.
980: '<img src="'.$helpicon.'" border="0" alt="'.&mt('Help: [_1]',$topic).
981: '" title="'.$title.'" /></a>';
982: if ($text ne '') {
983: $template.='</span></td></tr></table>';
984: }
1.44 bowersj2 985: return $template;
986:
1.106 bowersj2 987: }
988:
989: # This is a quicky function for Latex cheatsheet editing, since it
990: # appears in at least four places
991: sub helpLatexCheatsheet {
1.692.4.2 raeburn 992: my ($topic,$text,$not_author) = @_;
993: my $out;
1.106 bowersj2 994: my $addOther = '';
1.692.4.3 raeburn 995: if ($topic) {
1.692.4.2 raeburn 996: $addOther = &Apache::loncommon::help_open_topic($topic,$text,
1.106 bowersj2 997: undef, undef, 600) .
998: '</td><td>';
999: }
1.692.4.2 raeburn 1000: $out = '<table><tr><td>'.
1001: $addOther .
1002: &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
1003: undef,undef,600).
1004: '</td><td>'.
1005: &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
1006: undef,undef,600).
1007: '</td>';
1008: unless ($not_author) {
1009: $out .= '<td>'.
1010: &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
1011: undef,undef,600).
1012: '</td>';
1013: }
1014: $out .= '</tr></table>';
1015: return $out;
1.172 www 1016: }
1017:
1.430 albertel 1018: sub general_help {
1019: my $helptopic='Student_Intro';
1020: if ($env{'request.role'}=~/^(ca|au)/) {
1021: $helptopic='Authoring_Intro';
1022: } elsif ($env{'request.role'}=~/^cc/) {
1023: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1024: } elsif ($env{'request.role'}=~/^dc/) {
1025: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1026: }
1027: return $helptopic;
1028: }
1029:
1030: sub update_help_link {
1031: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1032: my $origurl = $ENV{'REQUEST_URI'};
1033: $origurl=~s|^/~|/priv/|;
1034: my $timestamp = time;
1035: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1036: $$datum = &escape($$datum);
1037: }
1038:
1039: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1040: my $output .= <<"ENDOUTPUT";
1041: <script type="text/javascript">
1.692.4.4 raeburn 1042: // <![CDATA[
1.430 albertel 1043: banner_link = '$banner_link';
1.692.4.4 raeburn 1044: // ]]>
1.430 albertel 1045: </script>
1046: ENDOUTPUT
1047: return $output;
1048: }
1049:
1050: # now just updates the help link and generates a blue icon
1.193 raeburn 1051: sub help_open_menu {
1.430 albertel 1052: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1053: = @_;
1.430 albertel 1054: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 1055: # only use pop-up help (stayOnPage == 0)
1.552 banghart 1056: # if environment.remote is on (using remote control UI)
1.572 banghart 1057: if ($env{'browser.interface'} eq 'textual' ||
1058: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 1059: $stayOnPage=1;
1.430 albertel 1060: }
1061: my $output;
1062: if ($component_help) {
1063: if (!$text) {
1064: $output=&help_open_topic($component_help,undef,$stayOnPage,
1065: $width,$height);
1066: } else {
1067: my $help_text;
1068: $help_text=&unescape($topic);
1069: $output='<table><tr><td>'.
1070: &help_open_topic($component_help,$help_text,$stayOnPage,
1071: $width,$height).'</td></tr></table>';
1072: }
1073: }
1074: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1075: return $output.$banner_link;
1076: }
1077:
1078: sub top_nav_help {
1079: my ($text) = @_;
1.436 albertel 1080: $text = &mt($text);
1.572 banghart 1081: my $stay_on_page =
1.436 albertel 1082: ($env{'browser.interface'} eq 'textual' ||
1083: $env{'environment.remote'} eq 'off' );
1.572 banghart 1084: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1085: : "javascript:helpMenu('open')";
1.572 banghart 1086: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1087:
1.201 raeburn 1088: my $title = &mt('Get help');
1.436 albertel 1089:
1090: return <<"END";
1091: $banner_link
1092: <a href="$link" title="$title">$text</a>
1093: END
1094: }
1095:
1096: sub help_menu_js {
1097: my ($text) = @_;
1098:
1099: my $stayOnPage =
1100: ($env{'browser.interface'} eq 'textual' ||
1101: $env{'environment.remote'} eq 'off' );
1102:
1103: my $width = 620;
1104: my $height = 600;
1.430 albertel 1105: my $helptopic=&general_help();
1106: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1107: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1108: my $start_page =
1109: &Apache::loncommon::start_page('Help Menu', undef,
1110: {'frameset' => 1,
1111: 'js_ready' => 1,
1112: 'add_entries' => {
1113: 'border' => '0',
1.579 raeburn 1114: 'rows' => "110,*",},});
1.331 albertel 1115: my $end_page =
1116: &Apache::loncommon::end_page({'frameset' => 1,
1117: 'js_ready' => 1,});
1118:
1.436 albertel 1119: my $template .= <<"ENDTEMPLATE";
1120: <script type="text/javascript">
1.253 albertel 1121: // <!-- BEGIN LON-CAPA Internal
1122: // <![CDATA[
1.430 albertel 1123: var banner_link = '';
1.243 raeburn 1124: function helpMenu(target) {
1125: var caller = this;
1126: if (target == 'open') {
1127: var newWindow = null;
1128: try {
1.262 albertel 1129: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1130: }
1131: catch(error) {
1132: writeHelp(caller);
1133: return;
1134: }
1135: if (newWindow) {
1136: caller = newWindow;
1137: }
1.193 raeburn 1138: }
1.243 raeburn 1139: writeHelp(caller);
1140: return;
1141: }
1142: function writeHelp(caller) {
1.430 albertel 1143: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 1144: caller.document.close()
1145: caller.focus()
1.193 raeburn 1146: }
1.253 albertel 1147: // ]]>
1.219 albertel 1148: // END LON-CAPA Internal -->
1.436 albertel 1149: </script>
1.193 raeburn 1150: ENDTEMPLATE
1151: return $template;
1152: }
1153:
1.172 www 1154: sub help_open_bug {
1155: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1156: unless ($env{'user.adv'}) { return ''; }
1.172 www 1157: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1158: $text = "" if (not defined $text);
1159: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1160: if ($env{'browser.interface'} eq 'textual' ||
1161: $env{'environment.remote'} eq 'off' ) {
1.172 www 1162: $stayOnPage=1;
1163: }
1.184 albertel 1164: $width = 600 if (not defined $width);
1165: $height = 600 if (not defined $height);
1.172 www 1166:
1167: $topic=~s/\W+/\+/g;
1168: my $link='';
1169: my $template='';
1.379 albertel 1170: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1171: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1172: if (!$stayOnPage)
1173: {
1174: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1175: }
1176: else
1177: {
1178: $link = $url;
1179: }
1180: # Add the text
1181: if ($text ne "")
1182: {
1183: $template .=
1184: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1185: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1186: }
1187:
1188: # Add the graphic
1.179 matthew 1189: my $title = &mt('Report a Bug');
1.215 albertel 1190: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1191: $template .= <<"ENDTEMPLATE";
1.436 albertel 1192: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1193: ENDTEMPLATE
1194: if ($text ne '') { $template.='</td></tr></table>' };
1195: return $template;
1196:
1197: }
1198:
1199: sub help_open_faq {
1200: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1201: unless ($env{'user.adv'}) { return ''; }
1.172 www 1202: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1203: $text = "" if (not defined $text);
1204: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1205: if ($env{'browser.interface'} eq 'textual' ||
1206: $env{'environment.remote'} eq 'off' ) {
1.172 www 1207: $stayOnPage=1;
1208: }
1209: $width = 350 if (not defined $width);
1210: $height = 400 if (not defined $height);
1211:
1212: $topic=~s/\W+/\+/g;
1213: my $link='';
1214: my $template='';
1215: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1216: if (!$stayOnPage)
1217: {
1218: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1219: }
1220: else
1221: {
1222: $link = $url;
1223: }
1224:
1225: # Add the text
1226: if ($text ne "")
1227: {
1228: $template .=
1.173 www 1229: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1230: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1231: }
1232:
1233: # Add the graphic
1.179 matthew 1234: my $title = &mt('View the FAQ');
1.215 albertel 1235: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1236: $template .= <<"ENDTEMPLATE";
1.436 albertel 1237: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1238: ENDTEMPLATE
1239: if ($text ne '') { $template.='</td></tr></table>' };
1240: return $template;
1241:
1.44 bowersj2 1242: }
1.37 matthew 1243:
1.180 matthew 1244: ###############################################################
1245: ###############################################################
1246:
1.45 matthew 1247: =pod
1248:
1.648 raeburn 1249: =item * &change_content_javascript():
1.256 matthew 1250:
1251: This and the next function allow you to create small sections of an
1252: otherwise static HTML page that you can update on the fly with
1253: Javascript, even in Netscape 4.
1254:
1255: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1256: must be written to the HTML page once. It will prove the Javascript
1257: function "change(name, content)". Calling the change function with the
1258: name of the section
1259: you want to update, matching the name passed to C<changable_area>, and
1260: the new content you want to put in there, will put the content into
1261: that area.
1262:
1263: B<Note>: Netscape 4 only reserves enough space for the changable area
1264: to contain room for the original contents. You need to "make space"
1265: for whatever changes you wish to make, and be B<sure> to check your
1266: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1267: it's adequate for updating a one-line status display, but little more.
1268: This script will set the space to 100% width, so you only need to
1269: worry about height in Netscape 4.
1270:
1271: Modern browsers are much less limiting, and if you can commit to the
1272: user not using Netscape 4, this feature may be used freely with
1273: pretty much any HTML.
1274:
1275: =cut
1276:
1277: sub change_content_javascript {
1278: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1279: if ($env{'browser.type'} eq 'netscape' &&
1280: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1281: return (<<NETSCAPE4);
1282: function change(name, content) {
1283: doc = document.layers[name+"___escape"].layers[0].document;
1284: doc.open();
1285: doc.write(content);
1286: doc.close();
1287: }
1288: NETSCAPE4
1289: } else {
1290: # Otherwise, we need to use semi-standards-compliant code
1291: # (technically, "innerHTML" isn't standard but the equivalent
1292: # is really scary, and every useful browser supports it
1293: return (<<DOMBASED);
1294: function change(name, content) {
1295: element = document.getElementById(name);
1296: element.innerHTML = content;
1297: }
1298: DOMBASED
1299: }
1300: }
1301:
1302: =pod
1303:
1.648 raeburn 1304: =item * &changable_area($name,$origContent):
1.256 matthew 1305:
1306: This provides a "changable area" that can be modified on the fly via
1307: the Javascript code provided in C<change_content_javascript>. $name is
1308: the name you will use to reference the area later; do not repeat the
1309: same name on a given HTML page more then once. $origContent is what
1310: the area will originally contain, which can be left blank.
1311:
1312: =cut
1313:
1314: sub changable_area {
1315: my ($name, $origContent) = @_;
1316:
1.258 albertel 1317: if ($env{'browser.type'} eq 'netscape' &&
1318: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1319: # If this is netscape 4, we need to use the Layer tag
1320: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1321: } else {
1322: return "<span id='$name'>$origContent</span>";
1323: }
1324: }
1325:
1326: =pod
1327:
1.648 raeburn 1328: =item * &viewport_geometry_js
1.590 raeburn 1329:
1330: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1331:
1332: =cut
1333:
1334:
1335: sub viewport_geometry_js {
1336: return <<"GEOMETRY";
1337: var Geometry = {};
1338: function init_geometry() {
1339: if (Geometry.init) { return };
1340: Geometry.init=1;
1341: if (window.innerHeight) {
1342: Geometry.getViewportHeight = function() { return window.innerHeight; };
1343: Geometry.getViewportWidth = function() { return window.innerWidth; };
1344: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1345: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1346: }
1347: else if (document.documentElement && document.documentElement.clientHeight) {
1348: Geometry.getViewportHeight =
1349: function() { return document.documentElement.clientHeight; };
1350: Geometry.getViewportWidth =
1351: function() { return document.documentElement.clientWidth; };
1352:
1353: Geometry.getHorizontalScroll =
1354: function() { return document.documentElement.scrollLeft; };
1355: Geometry.getVerticalScroll =
1356: function() { return document.documentElement.scrollTop; };
1357: }
1358: else if (document.body.clientHeight) {
1359: Geometry.getViewportHeight =
1360: function() { return document.body.clientHeight; };
1361: Geometry.getViewportWidth =
1362: function() { return document.body.clientWidth; };
1363: Geometry.getHorizontalScroll =
1364: function() { return document.body.scrollLeft; };
1365: Geometry.getVerticalScroll =
1366: function() { return document.body.scrollTop; };
1367: }
1368: }
1369:
1370: GEOMETRY
1371: }
1372:
1373: =pod
1374:
1.648 raeburn 1375: =item * &viewport_size_js()
1.590 raeburn 1376:
1377: 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.
1378:
1379: =cut
1380:
1381: sub viewport_size_js {
1382: my $geometry = &viewport_geometry_js();
1383: return <<"DIMS";
1384:
1385: $geometry
1386:
1387: function getViewportDims(width,height) {
1388: init_geometry();
1389: width.value = Geometry.getViewportWidth();
1390: height.value = Geometry.getViewportHeight();
1391: return;
1392: }
1393:
1394: DIMS
1395: }
1396:
1397: =pod
1398:
1.648 raeburn 1399: =item * &resize_textarea_js()
1.565 albertel 1400:
1401: emits the needed javascript to resize a textarea to be as big as possible
1402:
1403: creates a function resize_textrea that takes two IDs first should be
1404: the id of the element to resize, second should be the id of a div that
1405: surrounds everything that comes after the textarea, this routine needs
1406: to be attached to the <body> for the onload and onresize events.
1407:
1.648 raeburn 1408: =back
1.565 albertel 1409:
1410: =cut
1411:
1412: sub resize_textarea_js {
1.590 raeburn 1413: my $geometry = &viewport_geometry_js();
1.565 albertel 1414: return <<"RESIZE";
1415: <script type="text/javascript">
1.692.4.4 raeburn 1416: // <![CDATA[
1.590 raeburn 1417: $geometry
1.565 albertel 1418:
1.588 albertel 1419: function getX(element) {
1420: var x = 0;
1421: while (element) {
1422: x += element.offsetLeft;
1423: element = element.offsetParent;
1424: }
1425: return x;
1426: }
1427: function getY(element) {
1428: var y = 0;
1429: while (element) {
1430: y += element.offsetTop;
1431: element = element.offsetParent;
1432: }
1433: return y;
1434: }
1435:
1436:
1.565 albertel 1437: function resize_textarea(textarea_id,bottom_id) {
1438: init_geometry();
1439: var textarea = document.getElementById(textarea_id);
1440: //alert(textarea);
1441:
1.588 albertel 1442: var textarea_top = getY(textarea);
1.565 albertel 1443: var textarea_height = textarea.offsetHeight;
1444: var bottom = document.getElementById(bottom_id);
1.588 albertel 1445: var bottom_top = getY(bottom);
1.565 albertel 1446: var bottom_height = bottom.offsetHeight;
1447: var window_height = Geometry.getViewportHeight();
1.588 albertel 1448: var fudge = 23;
1.565 albertel 1449: var new_height = window_height-fudge-textarea_top-bottom_height;
1450: if (new_height < 300) {
1451: new_height = 300;
1452: }
1453: textarea.style.height=new_height+'px';
1454: }
1.692.4.4 raeburn 1455: // ]]>
1.565 albertel 1456: </script>
1457: RESIZE
1458:
1459: }
1460:
1461: =pod
1462:
1.256 matthew 1463: =head1 Excel and CSV file utility routines
1464:
1465: =over 4
1466:
1467: =cut
1468:
1469: ###############################################################
1470: ###############################################################
1471:
1472: =pod
1473:
1.648 raeburn 1474: =item * &csv_translate($text)
1.37 matthew 1475:
1.185 www 1476: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1477: format.
1478:
1479: =cut
1480:
1.180 matthew 1481: ###############################################################
1482: ###############################################################
1.37 matthew 1483: sub csv_translate {
1484: my $text = shift;
1485: $text =~ s/\"/\"\"/g;
1.209 albertel 1486: $text =~ s/\n/ /g;
1.37 matthew 1487: return $text;
1488: }
1.180 matthew 1489:
1490: ###############################################################
1491: ###############################################################
1492:
1493: =pod
1494:
1.648 raeburn 1495: =item * &define_excel_formats()
1.180 matthew 1496:
1497: Define some commonly used Excel cell formats.
1498:
1499: Currently supported formats:
1500:
1501: =over 4
1502:
1503: =item header
1504:
1505: =item bold
1506:
1507: =item h1
1508:
1509: =item h2
1510:
1511: =item h3
1512:
1.256 matthew 1513: =item h4
1514:
1515: =item i
1516:
1.180 matthew 1517: =item date
1518:
1519: =back
1520:
1521: Inputs: $workbook
1522:
1523: Returns: $format, a hash reference.
1524:
1525: =cut
1526:
1527: ###############################################################
1528: ###############################################################
1529: sub define_excel_formats {
1530: my ($workbook) = @_;
1531: my $format;
1532: $format->{'header'} = $workbook->add_format(bold => 1,
1533: bottom => 1,
1534: align => 'center');
1535: $format->{'bold'} = $workbook->add_format(bold=>1);
1536: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1537: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1538: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1539: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1540: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1541: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1542: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1543: return $format;
1544: }
1545:
1546: ###############################################################
1547: ###############################################################
1.113 bowersj2 1548:
1549: =pod
1550:
1.648 raeburn 1551: =item * &create_workbook()
1.255 matthew 1552:
1553: Create an Excel worksheet. If it fails, output message on the
1554: request object and return undefs.
1555:
1556: Inputs: Apache request object
1557:
1558: Returns (undef) on failure,
1559: Excel worksheet object, scalar with filename, and formats
1560: from &Apache::loncommon::define_excel_formats on success
1561:
1562: =cut
1563:
1564: ###############################################################
1565: ###############################################################
1566: sub create_workbook {
1567: my ($r) = @_;
1568: #
1569: # Create the excel spreadsheet
1570: my $filename = '/prtspool/'.
1.258 albertel 1571: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1572: time.'_'.rand(1000000000).'.xls';
1573: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1574: if (! defined($workbook)) {
1575: $r->log_error("Error creating excel spreadsheet $filename: $!");
1576: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1577: "This error has been logged. ".
1578: "Please alert your LON-CAPA administrator").
1579: '</p>');
1580: return (undef);
1581: }
1582: #
1583: $workbook->set_tempdir('/home/httpd/perl/tmp');
1584: #
1585: my $format = &Apache::loncommon::define_excel_formats($workbook);
1586: return ($workbook,$filename,$format);
1587: }
1588:
1589: ###############################################################
1590: ###############################################################
1591:
1592: =pod
1593:
1.648 raeburn 1594: =item * &create_text_file()
1.113 bowersj2 1595:
1.542 raeburn 1596: Create a file to write to and eventually make available to the user.
1.256 matthew 1597: If file creation fails, outputs an error message on the request object and
1598: return undefs.
1.113 bowersj2 1599:
1.256 matthew 1600: Inputs: Apache request object, and file suffix
1.113 bowersj2 1601:
1.256 matthew 1602: Returns (undef) on failure,
1603: Filehandle and filename on success.
1.113 bowersj2 1604:
1605: =cut
1606:
1.256 matthew 1607: ###############################################################
1608: ###############################################################
1609: sub create_text_file {
1610: my ($r,$suffix) = @_;
1611: if (! defined($suffix)) { $suffix = 'txt'; };
1612: my $fh;
1613: my $filename = '/prtspool/'.
1.258 albertel 1614: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1615: time.'_'.rand(1000000000).'.'.$suffix;
1616: $fh = Apache::File->new('>/home/httpd'.$filename);
1617: if (! defined($fh)) {
1618: $r->log_error("Couldn't open $filename for output $!");
1.683 bisitz 1619: $r->print(&mt('Problems occurred in creating the output file. '
1620: .'This error has been logged. '
1621: .'Please alert your LON-CAPA administrator.'));
1.113 bowersj2 1622: }
1.256 matthew 1623: return ($fh,$filename)
1.113 bowersj2 1624: }
1625:
1626:
1.256 matthew 1627: =pod
1.113 bowersj2 1628:
1629: =back
1630:
1631: =cut
1.37 matthew 1632:
1633: ###############################################################
1.33 matthew 1634: ## Home server <option> list generating code ##
1635: ###############################################################
1.35 matthew 1636:
1.169 www 1637: # ------------------------------------------
1638:
1639: sub domain_select {
1640: my ($name,$value,$multiple)=@_;
1641: my %domains=map {
1.514 albertel 1642: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1643: } &Apache::lonnet::all_domains();
1.169 www 1644: if ($multiple) {
1645: $domains{''}=&mt('Any domain');
1.550 albertel 1646: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1647: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1648: } else {
1.550 albertel 1649: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1650: return &select_form($name,$value,%domains);
1651: }
1652: }
1653:
1.282 albertel 1654: #-------------------------------------------
1655:
1656: =pod
1657:
1.519 raeburn 1658: =head1 Routines for form select boxes
1659:
1660: =over 4
1661:
1.648 raeburn 1662: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1663:
1664: Returns a string containing a <select> element int multiple mode
1665:
1666:
1667: Args:
1668: $name - name of the <select> element
1.506 raeburn 1669: $value - scalar or array ref of values that should already be selected
1.282 albertel 1670: $size - number of rows long the select element is
1.283 albertel 1671: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1672: (shown text should already have been &mt())
1.506 raeburn 1673: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1674:
1.282 albertel 1675: =cut
1676:
1677: #-------------------------------------------
1.169 www 1678: sub multiple_select_form {
1.284 albertel 1679: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1680: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1681: my $output='';
1.191 matthew 1682: if (! defined($size)) {
1683: $size = 4;
1.283 albertel 1684: if (scalar(keys(%$hash))<4) {
1685: $size = scalar(keys(%$hash));
1.191 matthew 1686: }
1687: }
1.692.4.2 raeburn 1688: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1689: my @order;
1.506 raeburn 1690: if (ref($order) eq 'ARRAY') {
1691: @order = @{$order};
1692: } else {
1693: @order = sort(keys(%$hash));
1.501 banghart 1694: }
1695: if (exists($$hash{'select_form_order'})) {
1696: @order = @{$$hash{'select_form_order'}};
1697: }
1698:
1.284 albertel 1699: foreach my $key (@order) {
1.356 albertel 1700: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1701: $output.='selected="selected" ' if ($selected{$key});
1702: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1703: }
1704: $output.="</select>\n";
1705: return $output;
1706: }
1707:
1.88 www 1708: #-------------------------------------------
1709:
1710: =pod
1711:
1.648 raeburn 1712: =item * &select_form($defdom,$name,%hash)
1.88 www 1713:
1714: Returns a string containing a <select name='$name' size='1'> form to
1715: allow a user to select options from a hash option_name => displayed text.
1716: See lonrights.pm for an example invocation and use.
1717:
1718: =cut
1719:
1720: #-------------------------------------------
1721: sub select_form {
1722: my ($def,$name,%hash) = @_;
1723: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1724: my @keys;
1725: if (exists($hash{'select_form_order'})) {
1726: @keys=@{$hash{'select_form_order'}};
1727: } else {
1728: @keys=sort(keys(%hash));
1729: }
1.356 albertel 1730: foreach my $key (@keys) {
1731: $selectform.=
1732: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1733: ($key eq $def ? 'selected="selected" ' : '').
1734: ">".&mt($hash{$key})."</option>\n";
1.88 www 1735: }
1736: $selectform.="</select>";
1737: return $selectform;
1738: }
1739:
1.475 www 1740: # For display filters
1741:
1742: sub display_filter {
1743: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1744: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.692.4.2 raeburn 1745: return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475 www 1746: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1747: (&mt('all'),10,20,50,100,1000,10000))).
1.692.4.2 raeburn 1748: '</label></span> <span class="LC_nobreak">'.
1.475 www 1749: &mt('Filter [_1]',
1.477 www 1750: &select_form($env{'form.displayfilter'},
1751: 'displayfilter',
1752: ('currentfolder' => 'Current folder/page',
1753: 'containing' => 'Containing phrase',
1754: 'none' => 'None'))).
1.692.4.2 raeburn 1755: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475 www 1756: }
1757:
1.167 www 1758: sub gradeleveldescription {
1759: my $gradelevel=shift;
1760: my %gradelevels=(0 => 'Not specified',
1761: 1 => 'Grade 1',
1762: 2 => 'Grade 2',
1763: 3 => 'Grade 3',
1764: 4 => 'Grade 4',
1765: 5 => 'Grade 5',
1766: 6 => 'Grade 6',
1767: 7 => 'Grade 7',
1768: 8 => 'Grade 8',
1769: 9 => 'Grade 9',
1770: 10 => 'Grade 10',
1771: 11 => 'Grade 11',
1772: 12 => 'Grade 12',
1773: 13 => 'Grade 13',
1774: 14 => '100 Level',
1775: 15 => '200 Level',
1776: 16 => '300 Level',
1777: 17 => '400 Level',
1778: 18 => 'Graduate Level');
1779: return &mt($gradelevels{$gradelevel});
1780: }
1781:
1.163 www 1782: sub select_level_form {
1783: my ($deflevel,$name)=@_;
1784: unless ($deflevel) { $deflevel=0; }
1.167 www 1785: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1786: for (my $i=0; $i<=18; $i++) {
1787: $selectform.="<option value=\"$i\" ".
1.253 albertel 1788: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1789: ">".&gradeleveldescription($i)."</option>\n";
1790: }
1791: $selectform.="</select>";
1792: return $selectform;
1.163 www 1793: }
1.167 www 1794:
1.35 matthew 1795: #-------------------------------------------
1796:
1.45 matthew 1797: =pod
1798:
1.692.4.7 raeburn 1799: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange)
1.35 matthew 1800:
1801: Returns a string containing a <select name='$name' size='1'> form to
1802: allow a user to select the domain to preform an operation in.
1803: See loncreateuser.pm for an example invocation and use.
1804:
1.90 www 1805: If the $includeempty flag is set, it also includes an empty choice ("no domain
1806: selected");
1807:
1.692.4.2 raeburn 1808: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1809:
1.692.4.7 raeburn 1810: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
1.563 raeburn 1811:
1.35 matthew 1812: =cut
1813:
1814: #-------------------------------------------
1.34 matthew 1815: sub select_dom_form {
1.692.4.7 raeburn 1816: my ($defdom,$name,$includeempty,$showdomdesc,$onchange) = @_;
1817: if ($onchange) {
1818: $onchange = ' onchange="'.$onchange.'"';
1.692.4.2 raeburn 1819: }
1.550 albertel 1820: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1821: if ($includeempty) { @domains=('',@domains); }
1.692.4.2 raeburn 1822: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 1823: foreach my $dom (@domains) {
1824: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1825: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1826: if ($showdomdesc) {
1827: if ($dom ne '') {
1828: my $domdesc = &Apache::lonnet::domain($dom,'description');
1829: if ($domdesc ne '') {
1830: $selectdomain .= ' ('.$domdesc.')';
1831: }
1832: }
1833: }
1834: $selectdomain .= "</option>\n";
1.34 matthew 1835: }
1836: $selectdomain.="</select>";
1837: return $selectdomain;
1838: }
1839:
1.35 matthew 1840: #-------------------------------------------
1841:
1.45 matthew 1842: =pod
1843:
1.648 raeburn 1844: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1845:
1.586 raeburn 1846: input: 4 arguments (two required, two optional) -
1847: $domain - domain of new user
1848: $name - name of form element
1849: $default - Value of 'default' causes a default item to be first
1850: option, and selected by default.
1851: $hide - Value of 'hide' causes hiding of the name of the server,
1852: if 1 server found, or default, if 0 found.
1.594 raeburn 1853: output: returns 2 items:
1.586 raeburn 1854: (a) form element which contains either:
1855: (i) <select name="$name">
1856: <option value="$hostid1">$hostid $servers{$hostid}</option>
1857: <option value="$hostid2">$hostid $servers{$hostid}</option>
1858: </select>
1859: form item if there are multiple library servers in $domain, or
1860: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1861: if there is only one library server in $domain.
1862:
1863: (b) number of library servers found.
1864:
1865: See loncreateuser.pm for example of use.
1.35 matthew 1866:
1867: =cut
1868:
1869: #-------------------------------------------
1.586 raeburn 1870: sub home_server_form_item {
1871: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1872: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1873: my $result;
1874: my $numlib = keys(%servers);
1875: if ($numlib > 1) {
1876: $result .= '<select name="'.$name.'" />'."\n";
1877: if ($default) {
1.692.4.2 raeburn 1878: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 1879: '</option>'."\n";
1880: }
1881: foreach my $hostid (sort(keys(%servers))) {
1882: $result.= '<option value="'.$hostid.'">'.
1883: $hostid.' '.$servers{$hostid}."</option>\n";
1884: }
1885: $result .= '</select>'."\n";
1886: } elsif ($numlib == 1) {
1887: my $hostid;
1888: foreach my $item (keys(%servers)) {
1889: $hostid = $item;
1890: }
1891: $result .= '<input type="hidden" name="'.$name.'" value="'.
1892: $hostid.'" />';
1893: if (!$hide) {
1894: $result .= $hostid.' '.$servers{$hostid};
1895: }
1896: $result .= "\n";
1897: } elsif ($default) {
1898: $result .= '<input type="hidden" name="'.$name.
1899: '" value="default" />';
1900: if (!$hide) {
1901: $result .= &mt('default');
1902: }
1903: $result .= "\n";
1.33 matthew 1904: }
1.586 raeburn 1905: return ($result,$numlib);
1.33 matthew 1906: }
1.112 bowersj2 1907:
1908: =pod
1909:
1.534 albertel 1910: =back
1911:
1.112 bowersj2 1912: =cut
1.87 matthew 1913:
1914: ###############################################################
1.112 bowersj2 1915: ## Decoding User Agent ##
1.87 matthew 1916: ###############################################################
1917:
1918: =pod
1919:
1.112 bowersj2 1920: =head1 Decoding the User Agent
1921:
1922: =over 4
1923:
1924: =item * &decode_user_agent()
1.87 matthew 1925:
1926: Inputs: $r
1927:
1928: Outputs:
1929:
1930: =over 4
1931:
1.112 bowersj2 1932: =item * $httpbrowser
1.87 matthew 1933:
1.112 bowersj2 1934: =item * $clientbrowser
1.87 matthew 1935:
1.112 bowersj2 1936: =item * $clientversion
1.87 matthew 1937:
1.112 bowersj2 1938: =item * $clientmathml
1.87 matthew 1939:
1.112 bowersj2 1940: =item * $clientunicode
1.87 matthew 1941:
1.112 bowersj2 1942: =item * $clientos
1.87 matthew 1943:
1944: =back
1945:
1.157 matthew 1946: =back
1947:
1.87 matthew 1948: =cut
1949:
1950: ###############################################################
1951: ###############################################################
1952: sub decode_user_agent {
1.247 albertel 1953: my ($r)=@_;
1.87 matthew 1954: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
1955: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
1956: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 1957: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 1958: my $clientbrowser='unknown';
1959: my $clientversion='0';
1960: my $clientmathml='';
1961: my $clientunicode='0';
1962: for (my $i=0;$i<=$#browsertype;$i++) {
1963: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
1964: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
1965: $clientbrowser=$bname;
1966: $httpbrowser=~/$vreg/i;
1967: $clientversion=$1;
1968: $clientmathml=($clientversion>=$minv);
1969: $clientunicode=($clientversion>=$univ);
1970: }
1971: }
1972: my $clientos='unknown';
1973: if (($httpbrowser=~/linux/i) ||
1974: ($httpbrowser=~/unix/i) ||
1975: ($httpbrowser=~/ux/i) ||
1976: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
1977: if (($httpbrowser=~/vax/i) ||
1978: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
1979: if ($httpbrowser=~/next/i) { $clientos='next'; }
1980: if (($httpbrowser=~/mac/i) ||
1981: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1982: if ($httpbrowser=~/win/i) { $clientos='win'; }
1983: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1984: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1985: $clientunicode,$clientos,);
1986: }
1987:
1.32 matthew 1988: ###############################################################
1989: ## Authentication changing form generation subroutines ##
1990: ###############################################################
1991: ##
1992: ## All of the authform_xxxxxxx subroutines take their inputs in a
1993: ## hash, and have reasonable default values.
1994: ##
1995: ## formname = the name given in the <form> tag.
1.35 matthew 1996: #-------------------------------------------
1997:
1.45 matthew 1998: =pod
1999:
1.112 bowersj2 2000: =head1 Authentication Routines
2001:
2002: =over 4
2003:
1.648 raeburn 2004: =item * &authform_xxxxxx()
1.35 matthew 2005:
2006: The authform_xxxxxx subroutines provide javascript and html forms which
2007: handle some of the conveniences required for authentication forms.
2008: This is not an optimal method, but it works.
2009:
2010: =over 4
2011:
1.112 bowersj2 2012: =item * authform_header
1.35 matthew 2013:
1.112 bowersj2 2014: =item * authform_authorwarning
1.35 matthew 2015:
1.112 bowersj2 2016: =item * authform_nochange
1.35 matthew 2017:
1.112 bowersj2 2018: =item * authform_kerberos
1.35 matthew 2019:
1.112 bowersj2 2020: =item * authform_internal
1.35 matthew 2021:
1.112 bowersj2 2022: =item * authform_filesystem
1.35 matthew 2023:
2024: =back
2025:
1.648 raeburn 2026: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2027:
1.35 matthew 2028: =cut
2029:
2030: #-------------------------------------------
1.32 matthew 2031: sub authform_header{
2032: my %in = (
2033: formname => 'cu',
1.80 albertel 2034: kerb_def_dom => '',
1.32 matthew 2035: @_,
2036: );
2037: $in{'formname'} = 'document.' . $in{'formname'};
2038: my $result='';
1.80 albertel 2039:
2040: #---------------------------------------------- Code for upper case translation
2041: my $Javascript_toUpperCase;
2042: unless ($in{kerb_def_dom}) {
2043: $Javascript_toUpperCase =<<"END";
2044: switch (choice) {
2045: case 'krb': currentform.elements[choicearg].value =
2046: currentform.elements[choicearg].value.toUpperCase();
2047: break;
2048: default:
2049: }
2050: END
2051: } else {
2052: $Javascript_toUpperCase = "";
2053: }
2054:
1.165 raeburn 2055: my $radioval = "'nochange'";
1.591 raeburn 2056: if (defined($in{'curr_authtype'})) {
2057: if ($in{'curr_authtype'} ne '') {
2058: $radioval = "'".$in{'curr_authtype'}."arg'";
2059: }
1.174 matthew 2060: }
1.165 raeburn 2061: my $argfield = 'null';
1.591 raeburn 2062: if (defined($in{'mode'})) {
1.165 raeburn 2063: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2064: if (defined($in{'curr_autharg'})) {
2065: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2066: $argfield = "'$in{'curr_autharg'}'";
2067: }
2068: }
2069: }
2070: }
2071:
1.32 matthew 2072: $result.=<<"END";
2073: var current = new Object();
1.165 raeburn 2074: current.radiovalue = $radioval;
2075: current.argfield = $argfield;
1.32 matthew 2076:
2077: function changed_radio(choice,currentform) {
2078: var choicearg = choice + 'arg';
2079: // If a radio button in changed, we need to change the argfield
2080: if (current.radiovalue != choice) {
2081: current.radiovalue = choice;
2082: if (current.argfield != null) {
2083: currentform.elements[current.argfield].value = '';
2084: }
2085: if (choice == 'nochange') {
2086: current.argfield = null;
2087: } else {
2088: current.argfield = choicearg;
2089: switch(choice) {
2090: case 'krb':
2091: currentform.elements[current.argfield].value =
2092: "$in{'kerb_def_dom'}";
2093: break;
2094: default:
2095: break;
2096: }
2097: }
2098: }
2099: return;
2100: }
1.22 www 2101:
1.32 matthew 2102: function changed_text(choice,currentform) {
2103: var choicearg = choice + 'arg';
2104: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2105: $Javascript_toUpperCase
1.32 matthew 2106: // clear old field
2107: if ((current.argfield != choicearg) && (current.argfield != null)) {
2108: currentform.elements[current.argfield].value = '';
2109: }
2110: current.argfield = choicearg;
2111: }
2112: set_auth_radio_buttons(choice,currentform);
2113: return;
1.20 www 2114: }
1.32 matthew 2115:
2116: function set_auth_radio_buttons(newvalue,currentform) {
2117: var i=0;
2118: while (i < currentform.login.length) {
2119: if (currentform.login[i].value == newvalue) { break; }
2120: i++;
2121: }
2122: if (i == currentform.login.length) {
2123: return;
2124: }
2125: current.radiovalue = newvalue;
2126: currentform.login[i].checked = true;
2127: return;
2128: }
2129: END
2130: return $result;
2131: }
2132:
2133: sub authform_authorwarning{
2134: my $result='';
1.144 matthew 2135: $result='<i>'.
2136: &mt('As a general rule, only authors or co-authors should be '.
2137: 'filesystem authenticated '.
2138: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2139: return $result;
2140: }
2141:
2142: sub authform_nochange{
2143: my %in = (
2144: formname => 'document.cu',
2145: kerb_def_dom => 'MSU.EDU',
2146: @_,
2147: );
1.586 raeburn 2148: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2149: my $result;
2150: if (keys(%can_assign) == 0) {
2151: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2152: } else {
2153: $result = '<label>'.&mt('[_1] Do not change login data',
2154: '<input type="radio" name="login" value="nochange" '.
2155: 'checked="checked" onclick="'.
1.281 albertel 2156: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2157: '</label>';
1.586 raeburn 2158: }
1.32 matthew 2159: return $result;
2160: }
2161:
1.591 raeburn 2162: sub authform_kerberos {
1.32 matthew 2163: my %in = (
2164: formname => 'document.cu',
2165: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2166: kerb_def_auth => 'krb4',
1.32 matthew 2167: @_,
2168: );
1.586 raeburn 2169: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2170: $autharg,$jscall);
2171: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2172: if ($in{'kerb_def_auth'} eq 'krb5') {
1.692.4.2 raeburn 2173: $check5 = ' checked="checked"';
1.80 albertel 2174: } else {
1.692.4.2 raeburn 2175: $check4 = ' checked="checked"';
1.80 albertel 2176: }
1.165 raeburn 2177: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2178: if (defined($in{'curr_authtype'})) {
2179: if ($in{'curr_authtype'} eq 'krb') {
1.692.4.2 raeburn 2180: $krbcheck = ' checked="checked"';
1.623 raeburn 2181: if (defined($in{'mode'})) {
2182: if ($in{'mode'} eq 'modifyuser') {
2183: $krbcheck = '';
2184: }
2185: }
1.591 raeburn 2186: if (defined($in{'curr_kerb_ver'})) {
2187: if ($in{'curr_krb_ver'} eq '5') {
1.692.4.2 raeburn 2188: $check5 = ' checked="checked"';
1.591 raeburn 2189: $check4 = '';
2190: } else {
1.692.4.2 raeburn 2191: $check4 = ' checked="checked"';
1.591 raeburn 2192: $check5 = '';
2193: }
1.586 raeburn 2194: }
1.591 raeburn 2195: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2196: $krbarg = $in{'curr_autharg'};
2197: }
1.586 raeburn 2198: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2199: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2200: $result =
2201: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2202: $in{'curr_autharg'},$krbver);
2203: } else {
2204: $result =
2205: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2206: }
2207: return $result;
2208: }
2209: }
2210: } else {
2211: if ($authnum == 1) {
1.692.4.2 raeburn 2212: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2213: }
2214: }
1.586 raeburn 2215: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2216: return;
1.587 raeburn 2217: } elsif ($authtype eq '') {
1.591 raeburn 2218: if (defined($in{'mode'})) {
1.587 raeburn 2219: if ($in{'mode'} eq 'modifycourse') {
2220: if ($authnum == 1) {
1.692.4.2 raeburn 2221: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2222: }
2223: }
2224: }
1.586 raeburn 2225: }
2226: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2227: if ($authtype eq '') {
2228: $authtype = '<input type="radio" name="login" value="krb" '.
2229: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2230: $krbcheck.' />';
2231: }
2232: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2233: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2234: $in{'curr_authtype'} eq 'krb5') ||
2235: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2236: $in{'curr_authtype'} eq 'krb4')) {
2237: $result .= &mt
1.144 matthew 2238: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2239: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2240: '<label>'.$authtype,
1.281 albertel 2241: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2242: 'value="'.$krbarg.'" '.
1.144 matthew 2243: 'onchange="'.$jscall.'" />',
1.281 albertel 2244: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2245: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2246: '</label>');
1.586 raeburn 2247: } elsif ($can_assign{'krb4'}) {
2248: $result .= &mt
2249: ('[_1] Kerberos authenticated with domain [_2] '.
2250: '[_3] Version 4 [_4]',
2251: '<label>'.$authtype,
2252: '</label><input type="text" size="10" name="krbarg" '.
2253: 'value="'.$krbarg.'" '.
2254: 'onchange="'.$jscall.'" />',
2255: '<label><input type="hidden" name="krbver" value="4" />',
2256: '</label>');
2257: } elsif ($can_assign{'krb5'}) {
2258: $result .= &mt
2259: ('[_1] Kerberos authenticated with domain [_2] '.
2260: '[_3] Version 5 [_4]',
2261: '<label>'.$authtype,
2262: '</label><input type="text" size="10" name="krbarg" '.
2263: 'value="'.$krbarg.'" '.
2264: 'onchange="'.$jscall.'" />',
2265: '<label><input type="hidden" name="krbver" value="5" />',
2266: '</label>');
2267: }
1.32 matthew 2268: return $result;
2269: }
2270:
2271: sub authform_internal{
1.586 raeburn 2272: my %in = (
1.32 matthew 2273: formname => 'document.cu',
2274: kerb_def_dom => 'MSU.EDU',
2275: @_,
2276: );
1.586 raeburn 2277: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2278: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2279: if (defined($in{'curr_authtype'})) {
2280: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2281: if ($can_assign{'int'}) {
1.692.4.2 raeburn 2282: $intcheck = 'checked="checked" ';
1.623 raeburn 2283: if (defined($in{'mode'})) {
2284: if ($in{'mode'} eq 'modifyuser') {
2285: $intcheck = '';
2286: }
2287: }
1.591 raeburn 2288: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2289: $intarg = $in{'curr_autharg'};
2290: }
2291: } else {
2292: $result = &mt('Currently internally authenticated.');
2293: return $result;
1.165 raeburn 2294: }
2295: }
1.586 raeburn 2296: } else {
2297: if ($authnum == 1) {
1.692.4.2 raeburn 2298: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2299: }
2300: }
2301: if (!$can_assign{'int'}) {
2302: return;
1.587 raeburn 2303: } elsif ($authtype eq '') {
1.591 raeburn 2304: if (defined($in{'mode'})) {
1.587 raeburn 2305: if ($in{'mode'} eq 'modifycourse') {
2306: if ($authnum == 1) {
1.692.4.2 raeburn 2307: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2308: }
2309: }
2310: }
1.165 raeburn 2311: }
1.586 raeburn 2312: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2313: if ($authtype eq '') {
2314: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2315: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2316: }
1.605 bisitz 2317: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2318: $intarg.'" onchange="'.$jscall.'" />';
2319: $result = &mt
1.144 matthew 2320: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2321: '<label>'.$authtype,'</label>'.$autharg);
1.692.4.4 raeburn 2322: $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 2323: return $result;
2324: }
2325:
2326: sub authform_local{
2327: my %in = (
2328: formname => 'document.cu',
2329: kerb_def_dom => 'MSU.EDU',
2330: @_,
2331: );
1.586 raeburn 2332: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2333: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2334: if (defined($in{'curr_authtype'})) {
2335: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2336: if ($can_assign{'loc'}) {
1.692.4.2 raeburn 2337: $loccheck = 'checked="checked" ';
1.623 raeburn 2338: if (defined($in{'mode'})) {
2339: if ($in{'mode'} eq 'modifyuser') {
2340: $loccheck = '';
2341: }
2342: }
1.591 raeburn 2343: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2344: $locarg = $in{'curr_autharg'};
2345: }
2346: } else {
2347: $result = &mt('Currently using local (institutional) authentication.');
2348: return $result;
1.165 raeburn 2349: }
2350: }
1.586 raeburn 2351: } else {
2352: if ($authnum == 1) {
1.692.4.2 raeburn 2353: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2354: }
2355: }
2356: if (!$can_assign{'loc'}) {
2357: return;
1.587 raeburn 2358: } elsif ($authtype eq '') {
1.591 raeburn 2359: if (defined($in{'mode'})) {
1.587 raeburn 2360: if ($in{'mode'} eq 'modifycourse') {
2361: if ($authnum == 1) {
1.692.4.2 raeburn 2362: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2363: }
2364: }
2365: }
1.165 raeburn 2366: }
1.586 raeburn 2367: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2368: if ($authtype eq '') {
2369: $authtype = '<input type="radio" name="login" value="loc" '.
2370: $loccheck.' onchange="'.$jscall.'" onclick="'.
2371: $jscall.'" />';
2372: }
2373: $autharg = '<input type="text" size="10" name="locarg" value="'.
2374: $locarg.'" onchange="'.$jscall.'" />';
2375: $result = &mt('[_1] Local Authentication with argument [_2]',
2376: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2377: return $result;
2378: }
2379:
2380: sub authform_filesystem{
2381: my %in = (
2382: formname => 'document.cu',
2383: kerb_def_dom => 'MSU.EDU',
2384: @_,
2385: );
1.586 raeburn 2386: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2387: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2388: if (defined($in{'curr_authtype'})) {
2389: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2390: if ($can_assign{'fsys'}) {
1.692.4.2 raeburn 2391: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2392: if (defined($in{'mode'})) {
2393: if ($in{'mode'} eq 'modifyuser') {
2394: $fsyscheck = '';
2395: }
2396: }
1.586 raeburn 2397: } else {
2398: $result = &mt('Currently Filesystem Authenticated.');
2399: return $result;
2400: }
2401: }
2402: } else {
2403: if ($authnum == 1) {
1.692.4.2 raeburn 2404: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2405: }
2406: }
2407: if (!$can_assign{'fsys'}) {
2408: return;
1.587 raeburn 2409: } elsif ($authtype eq '') {
1.591 raeburn 2410: if (defined($in{'mode'})) {
1.587 raeburn 2411: if ($in{'mode'} eq 'modifycourse') {
2412: if ($authnum == 1) {
1.692.4.2 raeburn 2413: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2414: }
2415: }
2416: }
1.586 raeburn 2417: }
2418: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2419: if ($authtype eq '') {
2420: $authtype = '<input type="radio" name="login" value="fsys" '.
2421: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2422: $jscall.'" />';
2423: }
2424: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2425: ' onchange="'.$jscall.'" />';
2426: $result = &mt
1.144 matthew 2427: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2428: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2429: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2430: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2431: 'onchange="'.$jscall.'" />');
1.32 matthew 2432: return $result;
2433: }
2434:
1.586 raeburn 2435: sub get_assignable_auth {
2436: my ($dom) = @_;
2437: if ($dom eq '') {
2438: $dom = $env{'request.role.domain'};
2439: }
2440: my %can_assign = (
2441: krb4 => 1,
2442: krb5 => 1,
2443: int => 1,
2444: loc => 1,
2445: );
2446: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2447: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2448: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2449: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2450: my $context;
2451: if ($env{'request.role'} =~ /^au/) {
2452: $context = 'author';
2453: } elsif ($env{'request.role'} =~ /^dc/) {
2454: $context = 'domain';
2455: } elsif ($env{'request.course.id'}) {
2456: $context = 'course';
2457: }
2458: if ($context) {
2459: if (ref($authhash->{$context}) eq 'HASH') {
2460: %can_assign = %{$authhash->{$context}};
2461: }
2462: }
2463: }
2464: }
2465: my $authnum = 0;
2466: foreach my $key (keys(%can_assign)) {
2467: if ($can_assign{$key}) {
2468: $authnum ++;
2469: }
2470: }
2471: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2472: $authnum --;
2473: }
2474: return ($authnum,%can_assign);
2475: }
2476:
1.80 albertel 2477: ###############################################################
2478: ## Get Kerberos Defaults for Domain ##
2479: ###############################################################
2480: ##
2481: ## Returns default kerberos version and an associated argument
2482: ## as listed in file domain.tab. If not listed, provides
2483: ## appropriate default domain and kerberos version.
2484: ##
2485: #-------------------------------------------
2486:
2487: =pod
2488:
1.648 raeburn 2489: =item * &get_kerberos_defaults()
1.80 albertel 2490:
2491: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2492: version and domain. If not found, it defaults to version 4 and the
2493: domain of the server.
1.80 albertel 2494:
1.648 raeburn 2495: =over 4
2496:
1.80 albertel 2497: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2498:
1.648 raeburn 2499: =back
2500:
2501: =back
2502:
1.80 albertel 2503: =cut
2504:
2505: #-------------------------------------------
2506: sub get_kerberos_defaults {
2507: my $domain=shift;
1.641 raeburn 2508: my ($krbdef,$krbdefdom);
2509: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2510: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2511: $krbdef = $domdefaults{'auth_def'};
2512: $krbdefdom = $domdefaults{'auth_arg_def'};
2513: } else {
1.80 albertel 2514: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2515: my $krbdefdom=$1;
2516: $krbdefdom=~tr/a-z/A-Z/;
2517: $krbdef = "krb4";
2518: }
2519: return ($krbdef,$krbdefdom);
2520: }
1.112 bowersj2 2521:
1.32 matthew 2522:
1.46 matthew 2523: ###############################################################
2524: ## Thesaurus Functions ##
2525: ###############################################################
1.20 www 2526:
1.46 matthew 2527: =pod
1.20 www 2528:
1.112 bowersj2 2529: =head1 Thesaurus Functions
2530:
2531: =over 4
2532:
1.648 raeburn 2533: =item * &initialize_keywords()
1.46 matthew 2534:
2535: Initializes the package variable %Keywords if it is empty. Uses the
2536: package variable $thesaurus_db_file.
2537:
2538: =cut
2539:
2540: ###################################################
2541:
2542: sub initialize_keywords {
2543: return 1 if (scalar keys(%Keywords));
2544: # If we are here, %Keywords is empty, so fill it up
2545: # Make sure the file we need exists...
2546: if (! -e $thesaurus_db_file) {
2547: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2548: " failed because it does not exist");
2549: return 0;
2550: }
2551: # Set up the hash as a database
2552: my %thesaurus_db;
2553: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2554: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2555: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2556: $thesaurus_db_file);
2557: return 0;
2558: }
2559: # Get the average number of appearances of a word.
2560: my $avecount = $thesaurus_db{'average.count'};
2561: # Put keywords (those that appear > average) into %Keywords
2562: while (my ($word,$data)=each (%thesaurus_db)) {
2563: my ($count,undef) = split /:/,$data;
2564: $Keywords{$word}++ if ($count > $avecount);
2565: }
2566: untie %thesaurus_db;
2567: # Remove special values from %Keywords.
1.356 albertel 2568: foreach my $value ('total.count','average.count') {
2569: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2570: }
1.46 matthew 2571: return 1;
2572: }
2573:
2574: ###################################################
2575:
2576: =pod
2577:
1.648 raeburn 2578: =item * &keyword($word)
1.46 matthew 2579:
2580: Returns true if $word is a keyword. A keyword is a word that appears more
2581: than the average number of times in the thesaurus database. Calls
2582: &initialize_keywords
2583:
2584: =cut
2585:
2586: ###################################################
1.20 www 2587:
2588: sub keyword {
1.46 matthew 2589: return if (!&initialize_keywords());
2590: my $word=lc(shift());
2591: $word=~s/\W//g;
2592: return exists($Keywords{$word});
1.20 www 2593: }
1.46 matthew 2594:
2595: ###############################################################
2596:
2597: =pod
1.20 www 2598:
1.648 raeburn 2599: =item * &get_related_words()
1.46 matthew 2600:
1.160 matthew 2601: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2602: an array of words. If the keyword is not in the thesaurus, an empty array
2603: will be returned. The order of the words returned is determined by the
2604: database which holds them.
2605:
2606: Uses global $thesaurus_db_file.
2607:
2608: =cut
2609:
2610: ###############################################################
2611: sub get_related_words {
2612: my $keyword = shift;
2613: my %thesaurus_db;
2614: if (! -e $thesaurus_db_file) {
2615: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2616: "failed because the file does not exist");
2617: return ();
2618: }
2619: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2620: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2621: return ();
2622: }
2623: my @Words=();
1.429 www 2624: my $count=0;
1.46 matthew 2625: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2626: # The first element is the number of times
2627: # the word appears. We do not need it now.
1.429 www 2628: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2629: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2630: my $threshold=$mostfrequentcount/10;
2631: foreach my $possibleword (@RelatedWords) {
2632: my ($word,$wordcount)=split(/\,/,$possibleword);
2633: if ($wordcount>$threshold) {
2634: push(@Words,$word);
2635: $count++;
2636: if ($count>10) { last; }
2637: }
1.20 www 2638: }
2639: }
1.46 matthew 2640: untie %thesaurus_db;
2641: return @Words;
1.14 harris41 2642: }
1.46 matthew 2643:
1.112 bowersj2 2644: =pod
2645:
2646: =back
2647:
2648: =cut
1.61 www 2649:
2650: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2651: =pod
2652:
1.112 bowersj2 2653: =head1 User Name Functions
2654:
2655: =over 4
2656:
1.648 raeburn 2657: =item * &plainname($uname,$udom,$first)
1.81 albertel 2658:
1.112 bowersj2 2659: Takes a users logon name and returns it as a string in
1.226 albertel 2660: "first middle last generation" form
2661: if $first is set to 'lastname' then it returns it as
2662: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2663:
2664: =cut
1.61 www 2665:
1.295 www 2666:
1.81 albertel 2667: ###############################################################
1.61 www 2668: sub plainname {
1.226 albertel 2669: my ($uname,$udom,$first)=@_;
1.537 albertel 2670: return if (!defined($uname) || !defined($udom));
1.295 www 2671: my %names=&getnames($uname,$udom);
1.226 albertel 2672: my $name=&Apache::lonnet::format_name($names{'firstname'},
2673: $names{'middlename'},
2674: $names{'lastname'},
2675: $names{'generation'},$first);
2676: $name=~s/^\s+//;
1.62 www 2677: $name=~s/\s+$//;
2678: $name=~s/\s+/ /g;
1.353 albertel 2679: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2680: return $name;
1.61 www 2681: }
1.66 www 2682:
2683: # -------------------------------------------------------------------- Nickname
1.81 albertel 2684: =pod
2685:
1.648 raeburn 2686: =item * &nickname($uname,$udom)
1.81 albertel 2687:
2688: Gets a users name and returns it as a string as
2689:
2690: ""nickname""
1.66 www 2691:
1.81 albertel 2692: if the user has a nickname or
2693:
2694: "first middle last generation"
2695:
2696: if the user does not
2697:
2698: =cut
1.66 www 2699:
2700: sub nickname {
2701: my ($uname,$udom)=@_;
1.537 albertel 2702: return if (!defined($uname) || !defined($udom));
1.295 www 2703: my %names=&getnames($uname,$udom);
1.68 albertel 2704: my $name=$names{'nickname'};
1.66 www 2705: if ($name) {
2706: $name='"'.$name.'"';
2707: } else {
2708: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2709: $names{'lastname'}.' '.$names{'generation'};
2710: $name=~s/\s+$//;
2711: $name=~s/\s+/ /g;
2712: }
2713: return $name;
2714: }
2715:
1.295 www 2716: sub getnames {
2717: my ($uname,$udom)=@_;
1.537 albertel 2718: return if (!defined($uname) || !defined($udom));
1.433 albertel 2719: if ($udom eq 'public' && $uname eq 'public') {
2720: return ('lastname' => &mt('Public'));
2721: }
1.295 www 2722: my $id=$uname.':'.$udom;
2723: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2724: if ($cached) {
2725: return %{$names};
2726: } else {
2727: my %loadnames=&Apache::lonnet::get('environment',
2728: ['firstname','middlename','lastname','generation','nickname'],
2729: $udom,$uname);
2730: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2731: return %loadnames;
2732: }
2733: }
1.61 www 2734:
1.542 raeburn 2735: # -------------------------------------------------------------------- getemails
1.648 raeburn 2736:
1.542 raeburn 2737: =pod
2738:
1.648 raeburn 2739: =item * &getemails($uname,$udom)
1.542 raeburn 2740:
2741: Gets a user's email information and returns it as a hash with keys:
2742: notification, critnotification, permanentemail
2743:
2744: For notification and critnotification, values are comma-separated lists
1.648 raeburn 2745: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 2746:
1.648 raeburn 2747:
1.542 raeburn 2748: =cut
2749:
1.648 raeburn 2750:
1.466 albertel 2751: sub getemails {
2752: my ($uname,$udom)=@_;
2753: if ($udom eq 'public' && $uname eq 'public') {
2754: return;
2755: }
1.467 www 2756: if (!$udom) { $udom=$env{'user.domain'}; }
2757: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2758: my $id=$uname.':'.$udom;
2759: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2760: if ($cached) {
2761: return %{$names};
2762: } else {
2763: my %loadnames=&Apache::lonnet::get('environment',
2764: ['notification','critnotification',
2765: 'permanentemail'],
2766: $udom,$uname);
2767: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2768: return %loadnames;
2769: }
2770: }
2771:
1.551 albertel 2772: sub flush_email_cache {
2773: my ($uname,$udom)=@_;
2774: if (!$udom) { $udom =$env{'user.domain'}; }
2775: if (!$uname) { $uname=$env{'user.name'}; }
2776: return if ($udom eq 'public' && $uname eq 'public');
2777: my $id=$uname.':'.$udom;
2778: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2779: }
2780:
1.692.4.2 raeburn 2781: # -------------------------------------------------------------------- getlangs
2782:
2783: =pod
2784:
2785: =item * &getlangs($uname,$udom)
2786:
2787: Gets a user's language preference and returns it as a hash with key:
2788: language.
2789:
2790: =cut
2791:
2792:
2793: sub getlangs {
2794: my ($uname,$udom) = @_;
2795: if (!$udom) { $udom =$env{'user.domain'}; }
2796: if (!$uname) { $uname=$env{'user.name'}; }
2797: my $id=$uname.':'.$udom;
2798: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
2799: if ($cached) {
2800: return %{$langs};
2801: } else {
2802: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
2803: $udom,$uname);
2804: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
2805: return %loadlangs;
2806: }
2807: }
2808:
2809: sub flush_langs_cache {
2810: my ($uname,$udom)=@_;
2811: if (!$udom) { $udom =$env{'user.domain'}; }
2812: if (!$uname) { $uname=$env{'user.name'}; }
2813: return if ($udom eq 'public' && $uname eq 'public');
2814: my $id=$uname.':'.$udom;
2815: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
2816: }
2817:
1.61 www 2818: # ------------------------------------------------------------------ Screenname
1.81 albertel 2819:
2820: =pod
2821:
1.648 raeburn 2822: =item * &screenname($uname,$udom)
1.81 albertel 2823:
2824: Gets a users screenname and returns it as a string
2825:
2826: =cut
1.61 www 2827:
2828: sub screenname {
2829: my ($uname,$udom)=@_;
1.258 albertel 2830: if ($uname eq $env{'user.name'} &&
2831: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2832: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2833: return $names{'screenname'};
1.62 www 2834: }
2835:
1.692.4.2 raeburn 2836: # ------------------------------------------------------------- Confirm Wrapper
2837: =pod
2838:
2839: =item confirmwrapper
2840:
2841: Wrap messages about completion of operation in box
2842:
2843: =cut
2844:
2845: sub confirmwrapper {
2846: my ($message)=@_;
2847: if ($message) {
2848: return "\n".'<div class="LC_confirm_box">'."\n"
2849: .$message."\n"
2850: .'</div>'."\n";
2851: } else {
2852: return $message;
2853: }
2854: }
1.212 albertel 2855:
1.62 www 2856: # ------------------------------------------------------------- Message Wrapper
2857:
2858: sub messagewrapper {
1.369 www 2859: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2860: return
1.441 albertel 2861: '<a href="/adm/email?compose=individual&'.
2862: 'recname='.$username.'&recdom='.$domain.
2863: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2864: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2865: }
2866: # --------------------------------------------------------------- Notes Wrapper
2867:
2868: sub noteswrapper {
2869: my ($link,$un,$do)=@_;
2870: return
2871: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2872: }
2873: # ------------------------------------------------------------- Aboutme Wrapper
2874:
2875: sub aboutmewrapper {
1.166 www 2876: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2877: if (!defined($username) && !defined($domain)) {
2878: return;
2879: }
1.205 www 2880: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.692.4.2 raeburn 2881: ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 2882: }
2883:
2884: # ------------------------------------------------------------ Syllabus Wrapper
2885:
2886:
2887: sub syllabuswrapper {
1.109 matthew 2888: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
2889: if ($fontcolor) {
2890: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
2891: }
1.208 matthew 2892: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2893: }
1.14 harris41 2894:
1.208 matthew 2895: sub track_student_link {
1.268 albertel 2896: my ($linktext,$sname,$sdom,$target,$start) = @_;
2897: my $link ="/adm/trackstudent?";
1.208 matthew 2898: my $title = 'View recent activity';
2899: if (defined($sname) && $sname !~ /^\s*$/ &&
2900: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2901: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2902: $title .= ' of this student';
1.268 albertel 2903: }
1.208 matthew 2904: if (defined($target) && $target !~ /^\s*$/) {
2905: $target = qq{target="$target"};
2906: } else {
2907: $target = '';
2908: }
1.268 albertel 2909: if ($start) { $link.='&start='.$start; }
1.554 albertel 2910: $title = &mt($title);
2911: $linktext = &mt($linktext);
1.448 albertel 2912: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2913: &help_open_topic('View_recent_activity');
1.208 matthew 2914: }
2915:
1.692.4.2 raeburn 2916: sub slot_reservations_link {
2917: my ($linktext,$sname,$sdom,$target) = @_;
2918: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
2919: my $title = 'View slot reservation history';
2920: if (defined($sname) && $sname !~ /^\s*$/ &&
2921: defined($sdom) && $sdom !~ /^\s*$/) {
2922: $link .= "&uname=$sname&udom=$sdom";
2923: $title .= ' of this student';
2924: }
2925: if (defined($target) && $target !~ /^\s*$/) {
2926: $target = qq{target="$target"};
2927: } else {
2928: $target = '';
2929: }
2930: $title = &mt($title);
2931: $linktext = &mt($linktext);
2932: return qq{<a href="$link" title="$title" $target>$linktext</a>};
2933: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
2934:
2935: }
2936:
1.508 www 2937: # ===================================================== Display a student photo
2938:
2939:
1.509 albertel 2940: sub student_image_tag {
1.508 www 2941: my ($domain,$user)=@_;
2942: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
2943: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
2944: return '<img src="'.$imgsrc.'" align="right" />';
2945: } else {
2946: return '';
2947: }
2948: }
2949:
1.112 bowersj2 2950: =pod
2951:
2952: =back
2953:
2954: =head1 Access .tab File Data
2955:
2956: =over 4
2957:
1.648 raeburn 2958: =item * &languageids()
1.112 bowersj2 2959:
2960: returns list of all language ids
2961:
2962: =cut
2963:
1.14 harris41 2964: sub languageids {
1.16 harris41 2965: return sort(keys(%language));
1.14 harris41 2966: }
2967:
1.112 bowersj2 2968: =pod
2969:
1.648 raeburn 2970: =item * &languagedescription()
1.112 bowersj2 2971:
2972: returns description of a specified language id
2973:
2974: =cut
2975:
1.14 harris41 2976: sub languagedescription {
1.125 www 2977: my $code=shift;
2978: return ($supported_language{$code}?'* ':'').
2979: $language{$code}.
1.126 www 2980: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 2981: }
2982:
2983: sub plainlanguagedescription {
2984: my $code=shift;
2985: return $language{$code};
2986: }
2987:
2988: sub supportedlanguagecode {
2989: my $code=shift;
2990: return $supported_language{$code};
1.97 www 2991: }
2992:
1.112 bowersj2 2993: =pod
2994:
1.648 raeburn 2995: =item * ©rightids()
1.112 bowersj2 2996:
2997: returns list of all copyrights
2998:
2999: =cut
3000:
3001: sub copyrightids {
3002: return sort(keys(%cprtag));
3003: }
3004:
3005: =pod
3006:
1.648 raeburn 3007: =item * ©rightdescription()
1.112 bowersj2 3008:
3009: returns description of a specified copyright id
3010:
3011: =cut
3012:
3013: sub copyrightdescription {
1.166 www 3014: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3015: }
1.197 matthew 3016:
3017: =pod
3018:
1.648 raeburn 3019: =item * &source_copyrightids()
1.192 taceyjo1 3020:
3021: returns list of all source copyrights
3022:
3023: =cut
3024:
3025: sub source_copyrightids {
3026: return sort(keys(%scprtag));
3027: }
3028:
3029: =pod
3030:
1.648 raeburn 3031: =item * &source_copyrightdescription()
1.192 taceyjo1 3032:
3033: returns description of a specified source copyright id
3034:
3035: =cut
3036:
3037: sub source_copyrightdescription {
3038: return &mt($scprtag{shift(@_)});
3039: }
1.112 bowersj2 3040:
3041: =pod
3042:
1.648 raeburn 3043: =item * &filecategories()
1.112 bowersj2 3044:
3045: returns list of all file categories
3046:
3047: =cut
3048:
3049: sub filecategories {
3050: return sort(keys(%category_extensions));
3051: }
3052:
3053: =pod
3054:
1.648 raeburn 3055: =item * &filecategorytypes()
1.112 bowersj2 3056:
3057: returns list of file types belonging to a given file
3058: category
3059:
3060: =cut
3061:
3062: sub filecategorytypes {
1.356 albertel 3063: my ($cat) = @_;
3064: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3065: }
3066:
3067: =pod
3068:
1.648 raeburn 3069: =item * &fileembstyle()
1.112 bowersj2 3070:
3071: returns embedding style for a specified file type
3072:
3073: =cut
3074:
3075: sub fileembstyle {
3076: return $fe{lc(shift(@_))};
1.169 www 3077: }
3078:
1.351 www 3079: sub filemimetype {
3080: return $fm{lc(shift(@_))};
3081: }
3082:
1.169 www 3083:
3084: sub filecategoryselect {
3085: my ($name,$value)=@_;
1.189 matthew 3086: return &select_form($value,$name,
1.169 www 3087: '' => &mt('Any category'),
3088: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 3089: }
3090:
3091: =pod
3092:
1.648 raeburn 3093: =item * &filedescription()
1.112 bowersj2 3094:
3095: returns description for a specified file type
3096:
3097: =cut
3098:
3099: sub filedescription {
1.188 matthew 3100: my $file_description = $fd{lc(shift())};
3101: $file_description =~ s:([\[\]]):~$1:g;
3102: return &mt($file_description);
1.112 bowersj2 3103: }
3104:
3105: =pod
3106:
1.648 raeburn 3107: =item * &filedescriptionex()
1.112 bowersj2 3108:
3109: returns description for a specified file type with
3110: extra formatting
3111:
3112: =cut
3113:
3114: sub filedescriptionex {
3115: my $ex=shift;
1.188 matthew 3116: my $file_description = $fd{lc($ex)};
3117: $file_description =~ s:([\[\]]):~$1:g;
3118: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3119: }
3120:
3121: # End of .tab access
3122: =pod
3123:
3124: =back
3125:
3126: =cut
3127:
3128: # ------------------------------------------------------------------ File Types
3129: sub fileextensions {
3130: return sort(keys(%fe));
3131: }
3132:
1.97 www 3133: # ----------------------------------------------------------- Display Languages
3134: # returns a hash with all desired display languages
3135: #
3136:
3137: sub display_languages {
3138: my %languages=();
1.692.4.1 raeburn 3139: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3140: $languages{$lang}=1;
1.97 www 3141: }
3142: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3143: if ($env{'form.displaylanguage'}) {
1.356 albertel 3144: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3145: $languages{$lang}=1;
1.97 www 3146: }
3147: }
3148: return %languages;
1.14 harris41 3149: }
3150:
1.582 albertel 3151: sub languages {
3152: my ($possible_langs) = @_;
1.692.4.1 raeburn 3153: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3154: if (!ref($possible_langs)) {
3155: if( wantarray ) {
3156: return @preferred_langs;
3157: } else {
3158: return $preferred_langs[0];
3159: }
3160: }
3161: my %possibilities = map { $_ => 1 } (@$possible_langs);
3162: my @preferred_possibilities;
3163: foreach my $preferred_lang (@preferred_langs) {
3164: if (exists($possibilities{$preferred_lang})) {
3165: push(@preferred_possibilities, $preferred_lang);
3166: }
3167: }
3168: if( wantarray ) {
3169: return @preferred_possibilities;
3170: }
3171: return $preferred_possibilities[0];
3172: }
3173:
1.692.4.2 raeburn 3174: sub user_lang {
3175: my ($touname,$toudom,$fromcid) = @_;
3176: my @userlangs;
3177: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3178: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3179: $env{'course.'.$fromcid.'.languages'}));
3180: } else {
3181: my %langhash = &getlangs($touname,$toudom);
3182: if ($langhash{'languages'} ne '') {
3183: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3184: } else {
3185: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3186: if ($domdefs{'lang_def'} ne '') {
3187: @userlangs = ($domdefs{'lang_def'});
3188: }
3189: }
3190: }
3191: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3192: my $user_lh = Apache::localize->get_handle(@languages);
3193: return $user_lh;
3194: }
3195:
1.112 bowersj2 3196: ###############################################################
3197: ## Student Answer Attempts ##
3198: ###############################################################
3199:
3200: =pod
3201:
3202: =head1 Alternate Problem Views
3203:
3204: =over 4
3205:
1.648 raeburn 3206: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3207: $getattempt, $regexp, $gradesub)
3208:
3209: Return string with previous attempt on problem. Arguments:
3210:
3211: =over 4
3212:
3213: =item * $symb: Problem, including path
3214:
3215: =item * $username: username of the desired student
3216:
3217: =item * $domain: domain of the desired student
1.14 harris41 3218:
1.112 bowersj2 3219: =item * $course: Course ID
1.14 harris41 3220:
1.112 bowersj2 3221: =item * $getattempt: Leave blank for all attempts, otherwise put
3222: something
1.14 harris41 3223:
1.112 bowersj2 3224: =item * $regexp: if string matches this regexp, the string will be
3225: sent to $gradesub
1.14 harris41 3226:
1.112 bowersj2 3227: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3228:
1.112 bowersj2 3229: =back
1.14 harris41 3230:
1.112 bowersj2 3231: The output string is a table containing all desired attempts, if any.
1.16 harris41 3232:
1.112 bowersj2 3233: =cut
1.1 albertel 3234:
3235: sub get_previous_attempt {
1.43 ng 3236: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3237: my $prevattempts='';
1.43 ng 3238: no strict 'refs';
1.1 albertel 3239: if ($symb) {
1.3 albertel 3240: my (%returnhash)=
3241: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3242: if ($returnhash{'version'}) {
3243: my %lasthash=();
3244: my $version;
3245: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3246: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3247: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3248: }
1.1 albertel 3249: }
1.596 albertel 3250: $prevattempts=&start_data_table().&start_data_table_header_row();
3251: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3252: foreach my $key (sort(keys(%lasthash))) {
3253: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3254: if ($#parts > 0) {
1.31 albertel 3255: my $data=$parts[-1];
3256: pop(@parts);
1.596 albertel 3257: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3258: } else {
1.41 ng 3259: if ($#parts == 0) {
3260: $prevattempts.='<th>'.$parts[0].'</th>';
3261: } else {
3262: $prevattempts.='<th>'.$ign.'</th>';
3263: }
1.31 albertel 3264: }
1.16 harris41 3265: }
1.596 albertel 3266: $prevattempts.=&end_data_table_header_row();
1.40 ng 3267: if ($getattempt eq '') {
3268: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3269: $prevattempts.=&start_data_table_row().
3270: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3271: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3272: my $value = &format_previous_attempt_value($key,
3273: $returnhash{$version.':'.$key});
3274: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3275: }
1.596 albertel 3276: $prevattempts.=&end_data_table_row();
1.40 ng 3277: }
1.1 albertel 3278: }
1.596 albertel 3279: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3280: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3281: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3282: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3283: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3284: }
1.596 albertel 3285: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3286: } else {
1.596 albertel 3287: $prevattempts=
3288: &start_data_table().&start_data_table_row().
3289: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3290: &end_data_table_row().&end_data_table();
1.1 albertel 3291: }
3292: } else {
1.596 albertel 3293: $prevattempts=
3294: &start_data_table().&start_data_table_row().
3295: '<td>'.&mt('No data.').'</td>'.
3296: &end_data_table_row().&end_data_table();
1.1 albertel 3297: }
1.10 albertel 3298: }
3299:
1.581 albertel 3300: sub format_previous_attempt_value {
3301: my ($key,$value) = @_;
3302: if ($key =~ /timestamp/) {
3303: $value = &Apache::lonlocal::locallocaltime($value);
3304: } elsif (ref($value) eq 'ARRAY') {
3305: $value = '('.join(', ', @{ $value }).')';
3306: } else {
3307: $value = &unescape($value);
3308: }
3309: return $value;
3310: }
3311:
3312:
1.107 albertel 3313: sub relative_to_absolute {
3314: my ($url,$output)=@_;
3315: my $parser=HTML::TokeParser->new(\$output);
3316: my $token;
3317: my $thisdir=$url;
3318: my @rlinks=();
3319: while ($token=$parser->get_token) {
3320: if ($token->[0] eq 'S') {
3321: if ($token->[1] eq 'a') {
3322: if ($token->[2]->{'href'}) {
3323: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3324: }
3325: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3326: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3327: } elsif ($token->[1] eq 'base') {
3328: $thisdir=$token->[2]->{'href'};
3329: }
3330: }
3331: }
3332: $thisdir=~s-/[^/]*$--;
1.356 albertel 3333: foreach my $link (@rlinks) {
1.692.4.2 raeburn 3334: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3335: ($link=~/^\//) ||
3336: ($link=~/^javascript:/i) ||
3337: ($link=~/^mailto:/i) ||
3338: ($link=~/^\#/)) {
3339: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3340: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3341: }
3342: }
3343: # -------------------------------------------------- Deal with Applet codebases
3344: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3345: return $output;
3346: }
3347:
1.112 bowersj2 3348: =pod
3349:
1.648 raeburn 3350: =item * &get_student_view()
1.112 bowersj2 3351:
3352: show a snapshot of what student was looking at
3353:
3354: =cut
3355:
1.10 albertel 3356: sub get_student_view {
1.186 albertel 3357: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3358: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3359: my (%form);
1.10 albertel 3360: my @elements=('symb','courseid','domain','username');
3361: foreach my $element (@elements) {
1.186 albertel 3362: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3363: }
1.186 albertel 3364: if (defined($moreenv)) {
3365: %form=(%form,%{$moreenv});
3366: }
1.236 albertel 3367: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3368: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3369: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3370: $userview=~s/\<body[^\>]*\>//gi;
3371: $userview=~s/\<\/body\>//gi;
3372: $userview=~s/\<html\>//gi;
3373: $userview=~s/\<\/html\>//gi;
3374: $userview=~s/\<head\>//gi;
3375: $userview=~s/\<\/head\>//gi;
3376: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3377: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3378: if (wantarray) {
3379: return ($userview,$response);
3380: } else {
3381: return $userview;
3382: }
3383: }
3384:
3385: sub get_student_view_with_retries {
3386: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3387:
3388: my $ok = 0; # True if we got a good response.
3389: my $content;
3390: my $response;
3391:
3392: # Try to get the student_view done. within the retries count:
3393:
3394: do {
3395: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3396: $ok = $response->is_success;
3397: if (!$ok) {
3398: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3399: }
3400: $retries--;
3401: } while (!$ok && ($retries > 0));
3402:
3403: if (!$ok) {
3404: $content = ''; # On error return an empty content.
3405: }
1.651 www 3406: if (wantarray) {
3407: return ($content, $response);
3408: } else {
3409: return $content;
3410: }
1.11 albertel 3411: }
3412:
1.112 bowersj2 3413: =pod
3414:
1.648 raeburn 3415: =item * &get_student_answers()
1.112 bowersj2 3416:
3417: show a snapshot of how student was answering problem
3418:
3419: =cut
3420:
1.11 albertel 3421: sub get_student_answers {
1.100 sakharuk 3422: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3423: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3424: my (%moreenv);
1.11 albertel 3425: my @elements=('symb','courseid','domain','username');
3426: foreach my $element (@elements) {
1.186 albertel 3427: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3428: }
1.186 albertel 3429: $moreenv{'grade_target'}='answer';
3430: %moreenv=(%form,%moreenv);
1.497 raeburn 3431: $feedurl = &Apache::lonnet::clutter($feedurl);
3432: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3433: return $userview;
1.1 albertel 3434: }
1.116 albertel 3435:
3436: =pod
3437:
3438: =item * &submlink()
3439:
1.242 albertel 3440: Inputs: $text $uname $udom $symb $target
1.116 albertel 3441:
3442: Returns: A link to grades.pm such as to see the SUBM view of a student
3443:
3444: =cut
3445:
3446: ###############################################
3447: sub submlink {
1.242 albertel 3448: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3449: if (!($uname && $udom)) {
3450: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3451: &Apache::lonnet::whichuser($symb);
1.116 albertel 3452: if (!$symb) { $symb=$cursymb; }
3453: }
1.254 matthew 3454: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3455: $symb=&escape($symb);
1.242 albertel 3456: if ($target) { $target="target=\"$target\""; }
3457: return '<a href="/adm/grades?&command=submission&'.
3458: 'symb='.$symb.'&student='.$uname.
3459: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3460: }
3461: ##############################################
3462:
3463: =pod
3464:
3465: =item * &pgrdlink()
3466:
3467: Inputs: $text $uname $udom $symb $target
3468:
3469: Returns: A link to grades.pm such as to see the PGRD view of a student
3470:
3471: =cut
3472:
3473: ###############################################
3474: sub pgrdlink {
3475: my $link=&submlink(@_);
3476: $link=~s/(&command=submission)/$1&showgrading=yes/;
3477: return $link;
3478: }
3479: ##############################################
3480:
3481: =pod
3482:
3483: =item * &pprmlink()
3484:
3485: Inputs: $text $uname $udom $symb $target
3486:
3487: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3488: student and a specific resource
1.242 albertel 3489:
3490: =cut
3491:
3492: ###############################################
3493: sub pprmlink {
3494: my ($text,$uname,$udom,$symb,$target)=@_;
3495: if (!($uname && $udom)) {
3496: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3497: &Apache::lonnet::whichuser($symb);
1.242 albertel 3498: if (!$symb) { $symb=$cursymb; }
3499: }
1.254 matthew 3500: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3501: $symb=&escape($symb);
1.242 albertel 3502: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3503: return '<a href="/adm/parmset?command=set&'.
3504: 'symb='.$symb.'&uname='.$uname.
3505: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3506: }
3507: ##############################################
1.37 matthew 3508:
1.112 bowersj2 3509: =pod
3510:
3511: =back
3512:
3513: =cut
3514:
1.37 matthew 3515: ###############################################
1.51 www 3516:
3517:
3518: sub timehash {
1.687 raeburn 3519: my ($thistime) = @_;
3520: my $timezone = &Apache::lonlocal::gettimezone();
3521: my $dt = DateTime->from_epoch(epoch => $thistime)
3522: ->set_time_zone($timezone);
3523: my $wday = $dt->day_of_week();
3524: if ($wday == 7) { $wday = 0; }
3525: return ( 'second' => $dt->second(),
3526: 'minute' => $dt->minute(),
3527: 'hour' => $dt->hour(),
3528: 'day' => $dt->day_of_month(),
3529: 'month' => $dt->month(),
3530: 'year' => $dt->year(),
3531: 'weekday' => $wday,
3532: 'dayyear' => $dt->day_of_year(),
3533: 'dlsav' => $dt->is_dst() );
1.51 www 3534: }
3535:
1.370 www 3536: sub utc_string {
3537: my ($date)=@_;
1.371 www 3538: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3539: }
3540:
1.51 www 3541: sub maketime {
3542: my %th=@_;
1.687 raeburn 3543: my ($epoch_time,$timezone,$dt);
3544: $timezone = &Apache::lonlocal::gettimezone();
3545: eval {
3546: $dt = DateTime->new( year => $th{'year'},
3547: month => $th{'month'},
3548: day => $th{'day'},
3549: hour => $th{'hour'},
3550: minute => $th{'minute'},
3551: second => $th{'second'},
3552: time_zone => $timezone,
3553: );
3554: };
3555: if (!$@) {
3556: $epoch_time = $dt->epoch;
3557: if ($epoch_time) {
3558: return $epoch_time;
3559: }
3560: }
1.51 www 3561: return POSIX::mktime(
3562: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3563: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3564: }
3565:
3566: #########################################
1.51 www 3567:
3568: sub findallcourses {
1.482 raeburn 3569: my ($roles,$uname,$udom) = @_;
1.355 albertel 3570: my %roles;
3571: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3572: my %courses;
1.51 www 3573: my $now=time;
1.482 raeburn 3574: if (!defined($uname)) {
3575: $uname = $env{'user.name'};
3576: }
3577: if (!defined($udom)) {
3578: $udom = $env{'user.domain'};
3579: }
3580: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3581: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3582: if (!%roles) {
3583: %roles = (
3584: cc => 1,
3585: in => 1,
3586: ep => 1,
3587: ta => 1,
3588: cr => 1,
3589: st => 1,
3590: );
3591: }
3592: foreach my $entry (keys(%roleshash)) {
3593: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3594: if ($trole =~ /^cr/) {
3595: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3596: } else {
3597: next if (!exists($roles{$trole}));
3598: }
3599: if ($tend) {
3600: next if ($tend < $now);
3601: }
3602: if ($tstart) {
3603: next if ($tstart > $now);
3604: }
3605: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3606: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3607: if ($secpart eq '') {
3608: ($cnum,$role) = split(/_/,$cnumpart);
3609: $sec = 'none';
3610: $realsec = '';
3611: } else {
3612: $cnum = $cnumpart;
3613: ($sec,$role) = split(/_/,$secpart);
3614: $realsec = $sec;
1.490 raeburn 3615: }
1.482 raeburn 3616: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3617: }
3618: } else {
3619: foreach my $key (keys(%env)) {
1.483 albertel 3620: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3621: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3622: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3623: next if ($role eq 'ca' || $role eq 'aa');
3624: next if (%roles && !exists($roles{$role}));
3625: my ($starttime,$endtime)=split(/\./,$env{$key});
3626: my $active=1;
3627: if ($starttime) {
3628: if ($now<$starttime) { $active=0; }
3629: }
3630: if ($endtime) {
3631: if ($now>$endtime) { $active=0; }
3632: }
3633: if ($active) {
3634: if ($sec eq '') {
3635: $sec = 'none';
3636: }
3637: $courses{$cdom.'_'.$cnum}{$sec} =
3638: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3639: }
3640: }
1.51 www 3641: }
3642: }
1.474 raeburn 3643: return %courses;
1.51 www 3644: }
1.37 matthew 3645:
1.54 www 3646: ###############################################
1.474 raeburn 3647:
3648: sub blockcheck {
1.482 raeburn 3649: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3650:
3651: if (!defined($udom)) {
3652: $udom = $env{'user.domain'};
3653: }
3654: if (!defined($uname)) {
3655: $uname = $env{'user.name'};
3656: }
3657:
3658: # If uname and udom are for a course, check for blocks in the course.
3659:
3660: if (&Apache::lonnet::is_course($udom,$uname)) {
3661: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3662: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3663: return ($startblock,$endblock);
3664: }
1.474 raeburn 3665:
1.502 raeburn 3666: my $startblock = 0;
3667: my $endblock = 0;
1.482 raeburn 3668: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3669:
1.490 raeburn 3670: # If uname is for a user, and activity is course-specific, i.e.,
3671: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3672:
1.490 raeburn 3673: if (($activity eq 'boards' || $activity eq 'chat' ||
3674: $activity eq 'groups') && ($env{'request.course.id'})) {
3675: foreach my $key (keys(%live_courses)) {
3676: if ($key ne $env{'request.course.id'}) {
3677: delete($live_courses{$key});
3678: }
3679: }
3680: }
3681:
3682: my $otheruser = 0;
3683: my %own_courses;
3684: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3685: # Resource belongs to user other than current user.
3686: $otheruser = 1;
3687: # Gather courses for current user
3688: %own_courses =
3689: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3690: }
3691:
3692: # Gather active course roles - course coordinator, instructor,
3693: # exam proctor, ta, student, or custom role.
1.474 raeburn 3694:
3695: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3696: my ($cdom,$cnum);
3697: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3698: $cdom = $env{'course.'.$course.'.domain'};
3699: $cnum = $env{'course.'.$course.'.num'};
3700: } else {
1.490 raeburn 3701: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3702: }
3703: my $no_ownblock = 0;
3704: my $no_userblock = 0;
1.533 raeburn 3705: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3706: # Check if current user has 'evb' priv for this
3707: if (defined($own_courses{$course})) {
3708: foreach my $sec (keys(%{$own_courses{$course}})) {
3709: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3710: if ($sec ne 'none') {
3711: $checkrole .= '/'.$sec;
3712: }
3713: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3714: $no_ownblock = 1;
3715: last;
3716: }
3717: }
3718: }
3719: # if they have 'evb' priv and are currently not playing student
3720: next if (($no_ownblock) &&
3721: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3722: }
1.474 raeburn 3723: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3724: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3725: if ($sec ne 'none') {
1.482 raeburn 3726: $checkrole .= '/'.$sec;
1.474 raeburn 3727: }
1.490 raeburn 3728: if ($otheruser) {
3729: # Resource belongs to user other than current user.
3730: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3731: my ($trole,$tdom,$tnum,$tsec);
3732: my $entry = $live_courses{$course}{$sec};
3733: if ($entry =~ /^cr/) {
3734: ($trole,$tdom,$tnum,$tsec) =
3735: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3736: } else {
3737: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3738: }
3739: my ($spec,$area,$trest,%allroles,%userroles);
3740: $area = '/'.$tdom.'/'.$tnum;
3741: $trest = $tnum;
3742: if ($tsec ne '') {
3743: $area .= '/'.$tsec;
3744: $trest .= '/'.$tsec;
3745: }
3746: $spec = $trole.'.'.$area;
3747: if ($trole =~ /^cr/) {
3748: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3749: $tdom,$spec,$trest,$area);
3750: } else {
3751: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3752: $tdom,$spec,$trest,$area);
3753: }
3754: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3755: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3756: if ($1) {
3757: $no_userblock = 1;
3758: last;
3759: }
3760: }
1.490 raeburn 3761: } else {
3762: # Resource belongs to current user
3763: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3764: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3765: $no_ownblock = 1;
3766: last;
3767: }
1.474 raeburn 3768: }
3769: }
3770: # if they have the evb priv and are currently not playing student
1.482 raeburn 3771: next if (($no_ownblock) &&
1.491 albertel 3772: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3773: next if ($no_userblock);
1.474 raeburn 3774:
1.490 raeburn 3775: # Retrieve blocking times and identity of blocker for course
3776: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3777:
3778: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3779: if (($start != 0) &&
3780: (($startblock == 0) || ($startblock > $start))) {
3781: $startblock = $start;
3782: }
3783: if (($end != 0) &&
3784: (($endblock == 0) || ($endblock < $end))) {
3785: $endblock = $end;
3786: }
1.490 raeburn 3787: }
3788: return ($startblock,$endblock);
3789: }
3790:
3791: sub get_blocks {
3792: my ($setters,$activity,$cdom,$cnum) = @_;
3793: my $startblock = 0;
3794: my $endblock = 0;
3795: my $course = $cdom.'_'.$cnum;
3796: $setters->{$course} = {};
3797: $setters->{$course}{'staff'} = [];
3798: $setters->{$course}{'times'} = [];
3799: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3800: foreach my $record (keys(%records)) {
3801: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3802: if ($start <= time && $end >= time) {
3803: my ($staff_name,$staff_dom,$title,$blocks) =
3804: &parse_block_record($records{$record});
3805: if ($blocks->{$activity} eq 'on') {
3806: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3807: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3808: if ( ($startblock == 0) || ($startblock > $start) ) {
3809: $startblock = $start;
1.490 raeburn 3810: }
1.491 albertel 3811: if ( ($endblock == 0) || ($endblock < $end) ) {
3812: $endblock = $end;
1.474 raeburn 3813: }
3814: }
3815: }
3816: }
3817: return ($startblock,$endblock);
3818: }
3819:
3820: sub parse_block_record {
3821: my ($record) = @_;
3822: my ($setuname,$setudom,$title,$blocks);
3823: if (ref($record) eq 'HASH') {
3824: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3825: $title = &unescape($record->{'event'});
3826: $blocks = $record->{'blocks'};
3827: } else {
3828: my @data = split(/:/,$record,3);
3829: if (scalar(@data) eq 2) {
3830: $title = $data[1];
3831: ($setuname,$setudom) = split(/@/,$data[0]);
3832: } else {
3833: ($setuname,$setudom,$title) = @data;
3834: }
3835: $blocks = { 'com' => 'on' };
3836: }
3837: return ($setuname,$setudom,$title,$blocks);
3838: }
3839:
3840: sub build_block_table {
3841: my ($startblock,$endblock,$setters) = @_;
3842: my %lt = &Apache::lonlocal::texthash(
3843: 'cacb' => 'Currently active communication blocks',
3844: 'cour' => 'Course',
3845: 'dura' => 'Duration',
3846: 'blse' => 'Block set by'
3847: );
3848: my $output;
1.476 raeburn 3849: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 3850: $output .= &start_data_table();
3851: $output .= '
3852: <tr>
3853: <th>'.$lt{'cour'}.'</th>
3854: <th>'.$lt{'dura'}.'</th>
3855: <th>'.$lt{'blse'}.'</th>
3856: </tr>
3857: ';
3858: foreach my $course (keys(%{$setters})) {
3859: my %courseinfo=&Apache::lonnet::coursedescription($course);
3860: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
3861: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 3862: my $fullname = &plainname($uname,$udom);
3863: if (defined($env{'user.name'}) && defined($env{'user.domain'})
3864: && $env{'user.name'} ne 'public'
3865: && $env{'user.domain'} ne 'public') {
3866: $fullname = &aboutmewrapper($fullname,$uname,$udom);
3867: }
1.474 raeburn 3868: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
3869: $openblock = &Apache::lonlocal::locallocaltime($openblock);
3870: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
3871: $output .= &Apache::loncommon::start_data_table_row().
3872: '<td>'.$courseinfo{'description'}.'</td>'.
3873: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 3874: '<td>'.$fullname.'</td>'.
1.474 raeburn 3875: &Apache::loncommon::end_data_table_row();
3876: }
3877: }
3878: $output .= &end_data_table();
3879: }
3880:
1.490 raeburn 3881: sub blocking_status {
3882: my ($activity,$uname,$udom) = @_;
3883: my %setters;
3884: my ($blocked,$output,$ownitem,$is_course);
3885: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
3886: if ($startblock && $endblock) {
3887: $blocked = 1;
3888: if (wantarray) {
3889: my $category;
3890: if ($activity eq 'boards') {
3891: $category = 'Discussion posts in this course';
3892: } elsif ($activity eq 'blogs') {
3893: $category = 'Blogs';
3894: } elsif ($activity eq 'port') {
3895: if (defined($uname) && defined($udom)) {
3896: if ($uname eq $env{'user.name'} &&
3897: $udom eq $env{'user.domain'}) {
3898: $ownitem = 1;
3899: }
3900: }
3901: $is_course = &Apache::lonnet::is_course($udom,$uname);
3902: if ($ownitem) {
3903: $category = 'Your portfolio files';
3904: } elsif ($is_course) {
3905: my $coursedesc;
3906: foreach my $course (keys(%setters)) {
3907: my %courseinfo =
3908: &Apache::lonnet::coursedescription($course);
3909: $coursedesc = $courseinfo{'description'};
3910: }
1.692.4.2 raeburn 3911: $category = "Group portfolio files in the course '$coursedesc'";
1.490 raeburn 3912: } else {
3913: $category = 'Portfolio files belonging to ';
3914: if ($env{'user.name'} eq 'public' &&
3915: $env{'user.domain'} eq 'public') {
3916: $category .= &plainname($uname,$udom);
3917: } else {
3918: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
3919: }
3920: }
3921: } elsif ($activity eq 'groups') {
3922: $category = 'Groups in this course';
3923: }
3924: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
3925: my $showend = &Apache::lonlocal::locallocaltime($endblock);
3926: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
3927: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
3928: $output .= &build_block_table($startblock,$endblock,\%setters);
3929: }
3930: }
3931: }
3932: if (wantarray) {
3933: return ($blocked,$output);
3934: } else {
3935: return $blocked;
3936: }
3937: }
3938:
1.60 matthew 3939: ###############################################
3940:
1.682 raeburn 3941: sub check_ip_acc {
3942: my ($acc)=@_;
3943: &Apache::lonxml::debug("acc is $acc");
3944: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
3945: return 1;
3946: }
3947: my $allowed=0;
3948: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
3949:
3950: my $name;
3951: foreach my $pattern (split(',',$acc)) {
3952: $pattern =~ s/^\s*//;
3953: $pattern =~ s/\s*$//;
3954: if ($pattern =~ /\*$/) {
3955: #35.8.*
3956: $pattern=~s/\*//;
3957: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
3958: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
3959: #35.8.3.[34-56]
3960: my $low=$2;
3961: my $high=$3;
3962: $pattern=$1;
3963: if ($ip =~ /^\Q$pattern\E/) {
3964: my $last=(split(/\./,$ip))[3];
3965: if ($last <=$high && $last >=$low) { $allowed=1; }
3966: }
3967: } elsif ($pattern =~ /^\*/) {
3968: #*.msu.edu
3969: $pattern=~s/\*//;
3970: if (!defined($name)) {
3971: use Socket;
3972: my $netaddr=inet_aton($ip);
3973: ($name)=gethostbyaddr($netaddr,AF_INET);
3974: }
3975: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
3976: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
3977: #127.0.0.1
3978: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
3979: } else {
3980: #some.name.com
3981: if (!defined($name)) {
3982: use Socket;
3983: my $netaddr=inet_aton($ip);
3984: ($name)=gethostbyaddr($netaddr,AF_INET);
3985: }
3986: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
3987: }
3988: if ($allowed) { last; }
3989: }
3990: return $allowed;
3991: }
3992:
3993: ###############################################
3994:
1.60 matthew 3995: =pod
3996:
1.112 bowersj2 3997: =head1 Domain Template Functions
3998:
3999: =over 4
4000:
4001: =item * &determinedomain()
1.60 matthew 4002:
4003: Inputs: $domain (usually will be undef)
4004:
1.63 www 4005: Returns: Determines which domain should be used for designs
1.60 matthew 4006:
4007: =cut
1.54 www 4008:
1.60 matthew 4009: ###############################################
1.63 www 4010: sub determinedomain {
4011: my $domain=shift;
1.531 albertel 4012: if (! $domain) {
1.60 matthew 4013: # Determine domain if we have not been given one
4014: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1.258 albertel 4015: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4016: if ($env{'request.role.domain'}) {
4017: $domain=$env{'request.role.domain'};
1.60 matthew 4018: }
4019: }
1.63 www 4020: return $domain;
4021: }
4022: ###############################################
1.517 raeburn 4023:
1.518 albertel 4024: sub devalidate_domconfig_cache {
4025: my ($udom)=@_;
4026: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4027: }
4028:
4029: # ---------------------- Get domain configuration for a domain
4030: sub get_domainconf {
4031: my ($udom) = @_;
4032: my $cachetime=1800;
4033: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4034: if (defined($cached)) { return %{$result}; }
4035:
4036: my %domconfig = &Apache::lonnet::get_dom('configuration',
4037: ['login','rolecolors'],$udom);
1.632 raeburn 4038: my (%designhash,%legacy);
1.518 albertel 4039: if (keys(%domconfig) > 0) {
4040: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4041: if (keys(%{$domconfig{'login'}})) {
4042: foreach my $key (keys(%{$domconfig{'login'}})) {
1.692.4.2 raeburn 4043: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4044: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4045: $designhash{$udom.'.login.'.$key.'_'.$img} =
4046: $domconfig{'login'}{$key}{$img};
4047: }
4048: } else {
4049: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4050: }
1.632 raeburn 4051: }
4052: } else {
4053: $legacy{'login'} = 1;
1.518 albertel 4054: }
1.632 raeburn 4055: } else {
4056: $legacy{'login'} = 1;
1.518 albertel 4057: }
4058: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4059: if (keys(%{$domconfig{'rolecolors'}})) {
4060: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4061: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4062: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4063: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4064: }
1.518 albertel 4065: }
4066: }
1.632 raeburn 4067: } else {
4068: $legacy{'rolecolors'} = 1;
1.518 albertel 4069: }
1.632 raeburn 4070: } else {
4071: $legacy{'rolecolors'} = 1;
1.518 albertel 4072: }
1.632 raeburn 4073: if (keys(%legacy) > 0) {
4074: my %legacyhash = &get_legacy_domconf($udom);
4075: foreach my $item (keys(%legacyhash)) {
4076: if ($item =~ /^\Q$udom\E\.login/) {
4077: if ($legacy{'login'}) {
4078: $designhash{$item} = $legacyhash{$item};
4079: }
4080: } else {
4081: if ($legacy{'rolecolors'}) {
4082: $designhash{$item} = $legacyhash{$item};
4083: }
1.518 albertel 4084: }
4085: }
4086: }
1.632 raeburn 4087: } else {
4088: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4089: }
4090: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4091: $cachetime);
4092: return %designhash;
4093: }
4094:
1.632 raeburn 4095: sub get_legacy_domconf {
4096: my ($udom) = @_;
4097: my %legacyhash;
4098: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4099: my $designfile = $designdir.'/'.$udom.'.tab';
4100: if (-e $designfile) {
4101: if ( open (my $fh,"<$designfile") ) {
4102: while (my $line = <$fh>) {
4103: next if ($line =~ /^\#/);
4104: chomp($line);
4105: my ($key,$val)=(split(/\=/,$line));
4106: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4107: }
4108: close($fh);
4109: }
4110: }
4111: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
4112: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4113: }
4114: return %legacyhash;
4115: }
4116:
1.63 www 4117: =pod
4118:
1.112 bowersj2 4119: =item * &domainlogo()
1.63 www 4120:
4121: Inputs: $domain (usually will be undef)
4122:
4123: Returns: A link to a domain logo, if the domain logo exists.
4124: If the domain logo does not exist, a description of the domain.
4125:
4126: =cut
1.112 bowersj2 4127:
1.63 www 4128: ###############################################
4129: sub domainlogo {
1.517 raeburn 4130: my $domain = &determinedomain(shift);
1.518 albertel 4131: my %designhash = &get_domainconf($domain);
1.517 raeburn 4132: # See if there is a logo
4133: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4134: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4135: if ($imgsrc =~ m{^/(adm|res)/}) {
4136: if ($imgsrc =~ m{^/res/}) {
4137: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4138: &Apache::lonnet::repcopy($local_name);
4139: }
4140: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4141: }
4142: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4143: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4144: return &Apache::lonnet::domain($domain,'description');
1.59 www 4145: } else {
1.60 matthew 4146: return '';
1.59 www 4147: }
4148: }
1.63 www 4149: ##############################################
4150:
4151: =pod
4152:
1.112 bowersj2 4153: =item * &designparm()
1.63 www 4154:
4155: Inputs: $which parameter; $domain (usually will be undef)
4156:
4157: Returns: value of designparamter $which
4158:
4159: =cut
1.112 bowersj2 4160:
1.397 albertel 4161:
1.400 albertel 4162: ##############################################
1.397 albertel 4163: sub designparm {
4164: my ($which,$domain)=@_;
1.258 albertel 4165: if ($env{'browser.blackwhite'} eq 'on') {
1.635 raeburn 4166: if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110 www 4167: return '#000000';
4168: }
1.635 raeburn 4169: if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110 www 4170: return '#FFFFFF';
4171: }
4172: if ($which=~/\.tabbg$/) {
4173: return '#CCCCCC';
4174: }
4175: }
1.397 albertel 4176: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 4177: return $env{'environment.color.'.$which};
1.96 www 4178: }
1.63 www 4179: $domain=&determinedomain($domain);
1.518 albertel 4180: my %domdesign = &get_domainconf($domain);
1.520 raeburn 4181: my $output;
1.517 raeburn 4182: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 4183: $output = $domdesign{$domain.'.'.$which};
1.63 www 4184: } else {
1.520 raeburn 4185: $output = $defaultdesign{$which};
4186: }
4187: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4188: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4189: if ($output =~ m{^/(adm|res)/}) {
4190: if ($output =~ m{^/res/}) {
4191: my $local_name = &Apache::lonnet::filelocation('',$output);
4192: &Apache::lonnet::repcopy($local_name);
4193: }
1.520 raeburn 4194: $output = &lonhttpdurl($output);
4195: }
1.63 www 4196: }
1.520 raeburn 4197: return $output;
1.63 www 4198: }
1.59 www 4199:
1.60 matthew 4200: ###############################################
4201: ###############################################
4202:
4203: =pod
4204:
1.112 bowersj2 4205: =back
4206:
1.549 albertel 4207: =head1 HTML Helpers
1.112 bowersj2 4208:
4209: =over 4
4210:
4211: =item * &bodytag()
1.60 matthew 4212:
4213: Returns a uniform header for LON-CAPA web pages.
4214:
4215: Inputs:
4216:
1.112 bowersj2 4217: =over 4
4218:
4219: =item * $title, A title to be displayed on the page.
4220:
4221: =item * $function, the current role (can be undef).
4222:
4223: =item * $addentries, extra parameters for the <body> tag.
4224:
4225: =item * $bodyonly, if defined, only return the <body> tag.
4226:
4227: =item * $domain, if defined, force a given domain.
4228:
4229: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4230: text interface only)
1.60 matthew 4231:
1.326 albertel 4232: =item * $customtitle, alternate text to use instead of $title
4233: in the title box that appears, this text
4234: is not auto translated like the $title is
1.309 albertel 4235:
4236: =item * $notopbar, if true, keep the 'what is this' info but remove the
4237: navigational links
1.317 albertel 4238:
1.338 albertel 4239: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4240:
4241: =item * $notitle, if true keep the nav controls, but remove the title bar
4242:
1.361 albertel 4243: =item * $no_inline_link, if true and in remote mode, don't show the
4244: 'Switch To Inline Menu' link
4245:
1.460 albertel 4246: =item * $args, optional argument valid values are
4247: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4248: inherit_jsmath -> when creating popup window in a page,
4249: should it have jsmath forced on by the
4250: current page
1.460 albertel 4251:
1.112 bowersj2 4252: =back
4253:
1.60 matthew 4254: Returns: A uniform header for LON-CAPA web pages.
4255: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
4256: If $bodyonly is undef or zero, an html string containing a <body> tag and
4257: other decorations will be returned.
4258:
4259: =cut
4260:
1.54 www 4261: sub bodytag {
1.309 albertel 4262: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 4263: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 4264:
1.460 albertel 4265: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 4266:
1.183 matthew 4267: $function = &get_users_function() if (!$function);
1.339 albertel 4268: my $img = &designparm($function.'.img',$domain);
4269: my $font = &designparm($function.'.font',$domain);
4270: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
4271:
1.692.4.2 raeburn 4272: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 4273: 'bgcolor' => $pgbg,
1.339 albertel 4274: 'text' => $font,
4275: 'alink' => &designparm($function.'.alink',$domain),
4276: 'vlink' => &designparm($function.'.vlink',$domain),
4277: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 4278: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 4279:
1.63 www 4280: # role and realm
1.378 raeburn 4281: my ($role,$realm) = split(/\./,$env{'request.role'},2);
4282: if ($role eq 'ca') {
1.479 albertel 4283: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 4284: $realm = &plainname($rname,$rdom);
1.378 raeburn 4285: }
1.55 www 4286: # realm
1.258 albertel 4287: if ($env{'request.course.id'}) {
1.378 raeburn 4288: if ($env{'request.role'} !~ /^cr/) {
4289: $role = &Apache::lonnet::plaintext($role,&course_type());
4290: }
1.359 albertel 4291: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 4292: } else {
4293: $role = &Apache::lonnet::plaintext($role);
1.54 www 4294: }
1.433 albertel 4295:
1.359 albertel 4296: if (!$realm) { $realm=' '; }
1.55 www 4297: # Set messages
1.60 matthew 4298: my $messages=&domainlogo($domain);
1.330 albertel 4299:
1.438 albertel 4300: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 4301:
1.101 www 4302: # construct main body tag
1.359 albertel 4303: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 4304: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 4305:
1.530 albertel 4306: if ($bodyonly) {
1.60 matthew 4307: return $bodytag;
1.258 albertel 4308: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 4309: # Accessibility
1.224 raeburn 4310:
1.337 albertel 4311: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 4312: if (!$notitle) {
1.337 albertel 4313: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
4314: }
4315: return $bodytag;
1.359 albertel 4316: }
4317:
1.410 albertel 4318: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4319: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4320: undef($role);
1.434 albertel 4321: } else {
4322: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4323: }
1.359 albertel 4324:
4325: my $roleinfo=(<<ENDROLE);
4326: <td class="LC_title_bar_who">
4327: <div class="LC_title_bar_name">
1.410 albertel 4328: $name
1.361 albertel 4329:
1.359 albertel 4330: </div>
4331: <div class="LC_title_bar_role">
1.361 albertel 4332: $role
1.359 albertel 4333: </div>
4334: <div class="LC_title_bar_realm">
1.361 albertel 4335: $realm
1.359 albertel 4336: </div>
1.206 albertel 4337: </td>
4338: ENDROLE
1.235 raeburn 4339:
1.359 albertel 4340: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
4341: if ($customtitle) {
4342: $titleinfo = $customtitle;
4343: }
4344: #
4345: # Extra info if you are the DC
4346: my $dc_info = '';
4347: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4348: $env{'course.'.$env{'request.course.id'}.
4349: '.domain'}.'/'})) {
4350: my $cid = $env{'request.course.id'};
4351: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4352: $dc_info =~ s/\s+$//;
1.359 albertel 4353: $dc_info = '('.$dc_info.')';
4354: }
4355:
1.644 www 4356: if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
1.359 albertel 4357: # No Remote
1.258 albertel 4358: if ($env{'request.state'} eq 'construct') {
1.359 albertel 4359: $forcereg=1;
4360: }
4361:
4362: if (!$customtitle && $env{'request.state'} eq 'construct') {
4363: # this is for resources; directories have customtitle, and crumbs
4364: # and select recent are created in lonpubdir.pm
1.229 albertel 4365: my ($uname,$thisdisfn)=
1.258 albertel 4366: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 4367: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4368: $formaction=~s/\/+/\//g;
4369:
1.359 albertel 4370: my $parentpath = '';
4371: my $lastitem = '';
4372: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4373: $parentpath = $1;
4374: $lastitem = $2;
4375: } else {
4376: $lastitem = $thisdisfn;
4377: }
4378: $titleinfo =
1.640 bisitz 4379: &Apache::loncommon::help_open_menu('','',3,'Authoring')
4380: .'<b>'.&mt('Construction Space').'</b>: '
4381: .'<form name="dirs" method="post" action="'.$formaction
1.359 albertel 4382: .'" target="_top"><tt><b>'
4383: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
4384: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4385: .'</form>'
4386: .&Apache::lonmenu::constspaceform();
1.235 raeburn 4387: }
1.359 albertel 4388:
1.337 albertel 4389: my $titletable;
1.338 albertel 4390: if (!$notitle) {
1.337 albertel 4391: $titletable =
1.359 albertel 4392: '<table id="LC_title_bar">'.
4393: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
4394: '</tr></table>';
1.337 albertel 4395: }
1.359 albertel 4396: if ($notopbar) {
4397: $bodytag .= $titletable;
4398: } else {
4399: if ($env{'request.state'} eq 'construct') {
1.337 albertel 4400: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
4401: $titletable);
1.272 raeburn 4402: } else {
1.336 albertel 4403: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 4404: $titletable;
1.272 raeburn 4405: }
1.235 raeburn 4406: }
4407: return $bodytag;
1.94 www 4408: }
1.95 www 4409:
1.93 www 4410: #
1.95 www 4411: # Top frame rendering, Remote is up
1.93 www 4412: #
1.359 albertel 4413:
1.517 raeburn 4414: my $imgsrc = $img;
4415: if ($img =~ /^\/adm/) {
1.575 albertel 4416: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4417: }
4418: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4419:
1.305 www 4420: # Explicit link to get inline menu
1.361 albertel 4421: my $menu= ($no_inline_link?''
4422: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 4423: #
1.338 albertel 4424: if ($notitle) {
1.337 albertel 4425: return $bodytag;
4426: }
1.94 www 4427: return(<<ENDBODY);
1.60 matthew 4428: $bodytag
1.359 albertel 4429: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4430: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4431: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4432: </tr>
1.359 albertel 4433: <tr><td>$titleinfo $dc_info $menu</td>
4434: $roleinfo
1.368 albertel 4435: </tr>
1.356 albertel 4436: </table>
1.54 www 4437: ENDBODY
1.182 matthew 4438: }
4439:
1.330 albertel 4440: sub make_attr_string {
4441: my ($register,$attr_ref) = @_;
4442:
4443: if ($attr_ref && !ref($attr_ref)) {
4444: die("addentries Must be a hash ref ".
4445: join(':',caller(1))." ".
4446: join(':',caller(0))." ");
4447: }
4448:
4449: if ($register) {
1.339 albertel 4450: my ($on_load,$on_unload);
4451: foreach my $key (keys(%{$attr_ref})) {
4452: if (lc($key) eq 'onload') {
4453: $on_load.=$attr_ref->{$key}.';';
4454: delete($attr_ref->{$key});
4455:
4456: } elsif (lc($key) eq 'onunload') {
4457: $on_unload.=$attr_ref->{$key}.';';
4458: delete($attr_ref->{$key});
4459: }
4460: }
4461: $attr_ref->{'onload'} =
4462: &Apache::lonmenu::loadevents(). $on_load;
4463: $attr_ref->{'onunload'}=
4464: &Apache::lonmenu::unloadevents().$on_unload;
4465: }
4466:
4467: # Accessibility font enhance
4468: if ($env{'browser.fontenhance'} eq 'on') {
4469: my $style;
4470: foreach my $key (keys(%{$attr_ref})) {
4471: if (lc($key) eq 'style') {
4472: $style.=$attr_ref->{$key}.';';
4473: delete($attr_ref->{$key});
4474: }
4475: }
4476: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4477: }
1.339 albertel 4478:
4479: if ($env{'browser.blackwhite'} eq 'on') {
4480: delete($attr_ref->{'font'});
4481: delete($attr_ref->{'link'});
4482: delete($attr_ref->{'alink'});
4483: delete($attr_ref->{'vlink'});
4484: delete($attr_ref->{'bgcolor'});
4485: delete($attr_ref->{'background'});
4486: }
4487:
1.330 albertel 4488: my $attr_string;
4489: foreach my $attr (keys(%$attr_ref)) {
4490: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4491: }
4492: return $attr_string;
4493: }
4494:
4495:
1.182 matthew 4496: ###############################################
1.251 albertel 4497: ###############################################
4498:
4499: =pod
4500:
4501: =item * &endbodytag()
4502:
4503: Returns a uniform footer for LON-CAPA web pages.
4504:
1.635 raeburn 4505: Inputs: 1 - optional reference to an args hash
4506: If in the hash, key for noredirectlink has a value which evaluates to true,
4507: a 'Continue' link is not displayed if the page contains an
4508: internal redirect in the <head></head> section,
4509: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4510:
4511: =cut
4512:
4513: sub endbodytag {
1.635 raeburn 4514: my ($args) = @_;
1.251 albertel 4515: my $endbodytag='</body>';
1.269 albertel 4516: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4517: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4518: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4519: $endbodytag=
4520: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4521: &mt('Continue').'</a>'.
4522: $endbodytag;
4523: }
1.315 albertel 4524: }
1.251 albertel 4525: return $endbodytag;
4526: }
4527:
1.352 albertel 4528: =pod
4529:
4530: =item * &standard_css()
4531:
4532: Returns a style sheet
4533:
4534: Inputs: (all optional)
4535: domain -> force to color decorate a page for a specific
4536: domain
4537: function -> force usage of a specific rolish color scheme
4538: bgcolor -> override the default page bgcolor
4539:
4540: =cut
4541:
1.343 albertel 4542: sub standard_css {
1.345 albertel 4543: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4544: $function = &get_users_function() if (!$function);
4545: my $img = &designparm($function.'.img', $domain);
4546: my $tabbg = &designparm($function.'.tabbg', $domain);
4547: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4548: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4549: my $pgbg_or_bgcolor =
4550: $bgcolor ||
1.352 albertel 4551: &designparm($function.'.pgbg', $domain);
1.382 albertel 4552: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4553: my $alink = &designparm($function.'.alink', $domain);
4554: my $vlink = &designparm($function.'.vlink', $domain);
4555: my $link = &designparm($function.'.link', $domain);
4556:
1.602 albertel 4557: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4558: my $mono = 'monospace';
1.692.4.6 raeburn 4559: my $data_table_head = $sidebg;
4560: my $data_table_light = '#FAFAFA';
4561: my $data_table_dark = '#F0F0F0';
1.470 banghart 4562: my $data_table_darker = '#CCCCCC';
1.349 albertel 4563: my $data_table_highlight = '#FFFF00';
1.352 albertel 4564: my $mail_new = '#FFBB77';
4565: my $mail_new_hover = '#DD9955';
4566: my $mail_read = '#BBBB77';
4567: my $mail_read_hover = '#999944';
4568: my $mail_replied = '#AAAA88';
4569: my $mail_replied_hover = '#888855';
4570: my $mail_other = '#99BBBB';
4571: my $mail_other_hover = '#669999';
1.391 albertel 4572: my $table_header = '#DDDDDD';
1.489 raeburn 4573: my $feedback_link_bg = '#BBBBBB';
1.692.4.3 raeburn 4574: my $lg_border_color = '#C8C8C8';
1.392 albertel 4575:
1.608 albertel 4576: my $border = ($env{'browser.type'} eq 'explorer' ||
1.692.4.2 raeburn 4577: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
4578: : '0 3px 0 4px';
1.448 albertel 4579:
1.523 albertel 4580:
1.343 albertel 4581: return <<END;
1.345 albertel 4582: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4583: a:focus { color: red; background: yellow }
1.692.4.6 raeburn 4584:
4585: hr {
4586: clear: both;
4587: color: $tabbg;
4588: background-color: $tabbg;
4589: height: 3px;
4590: border: none;
4591: }
4592:
1.510 albertel 4593: table.thinborder,
1.523 albertel 4594:
1.510 albertel 4595: table.thinborder tr th {
4596: border-style: solid;
4597: border-width: 1px;
4598: background: $tabbg;
4599: }
1.523 albertel 4600: table.thinborder tr td {
1.510 albertel 4601: border-style: solid;
4602: border-width: 1px
4603: }
1.426 albertel 4604:
1.343 albertel 4605: form, .inline { display: inline; }
4606: .center { text-align: center; }
1.593 albertel 4607: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4608: .LC_error {
4609: color: red;
4610: font-size: larger;
4611: }
1.457 albertel 4612: .LC_warning,
4613: .LC_diff_removed {
1.394 albertel 4614: color: red;
4615: }
1.532 albertel 4616:
4617: .LC_info,
1.457 albertel 4618: .LC_success,
4619: .LC_diff_added {
1.350 albertel 4620: color: green;
4621: }
1.692.4.2 raeburn 4622:
4623: div.LC_confirm_box {
4624: background-color: #FAFAFA;
4625: border: 1px solid $lg_border_color;
4626: margin-right: 0;
4627: padding: 5px;
4628: }
4629:
4630: div.LC_confirm_box .LC_error img,
4631: div.LC_confirm_box .LC_success img {
4632: vertical-align: middle;
1.543 albertel 4633: }
4634:
1.440 albertel 4635: .LC_icon {
1.692.4.2 raeburn 4636: border: none;
1.440 albertel 4637: }
1.539 albertel 4638: .LC_indexer_icon {
1.692.4.2 raeburn 4639: border: 0;
1.539 albertel 4640: height: 22px;
4641: }
1.543 albertel 4642: .LC_docs_spacer {
4643: width: 25px;
4644: height: 1px;
1.692.4.2 raeburn 4645: border: none;
1.543 albertel 4646: }
1.346 albertel 4647:
1.532 albertel 4648: .LC_internal_info {
1.692.4.2 raeburn 4649: color: #999999;
1.532 albertel 4650: }
4651:
1.458 albertel 4652: table.LC_pastsubmission {
4653: border: 1px solid black;
4654: margin: 2px;
4655: }
4656:
1.606 albertel 4657: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4658: width: 100%;
4659: background: $pgbg;
1.392 albertel 4660: border: 2px;
1.402 albertel 4661: border-collapse: separate;
1.692.4.2 raeburn 4662: padding: 0;
1.345 albertel 4663: }
1.392 albertel 4664:
1.606 albertel 4665: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4666: table#LC_title_bar.LC_with_remote {
1.359 albertel 4667: width: 100%;
1.392 albertel 4668: border-color: $pgbg;
4669: border-style: solid;
4670: border-width: $border;
4671:
1.379 albertel 4672: background: $pgbg;
4673: font-family: $sans;
1.392 albertel 4674: border-collapse: collapse;
1.692.4.2 raeburn 4675: padding: 0;
1.359 albertel 4676: }
1.392 albertel 4677:
1.409 albertel 4678: table.LC_docs_path {
4679: width: 100%;
4680: border: 0;
4681: background: $pgbg;
4682: font-family: $sans;
4683: border-collapse: collapse;
1.692.4.2 raeburn 4684: padding: 0;
1.409 albertel 4685: }
4686:
1.359 albertel 4687: table#LC_title_bar td {
4688: background: $tabbg;
4689: }
4690: table#LC_title_bar td.LC_title_bar_who {
4691: background: $tabbg;
4692: color: $font;
1.427 albertel 4693: font: small $sans;
1.359 albertel 4694: text-align: right;
4695: }
1.469 banghart 4696: span.LC_metadata {
4697: font-family: $sans;
4698: }
1.359 albertel 4699: span.LC_title_bar_title {
1.416 albertel 4700: font: bold x-large $sans;
1.359 albertel 4701: }
4702: table#LC_title_bar td.LC_title_bar_domain_logo {
4703: background: $sidebg;
4704: text-align: right;
1.692.4.2 raeburn 4705: padding: 0;
1.368 albertel 4706: }
4707: table#LC_title_bar td.LC_title_bar_role_logo {
4708: background: $sidebg;
1.692.4.2 raeburn 4709: padding: 0;
1.359 albertel 4710: }
4711:
1.346 albertel 4712: table#LC_menubuttons_mainmenu {
1.526 www 4713: width: 100%;
1.692.4.2 raeburn 4714: border: 0;
1.346 albertel 4715: border-spacing: 1px;
1.692.4.2 raeburn 4716: padding: 0 1px;
4717: margin: 0;
1.346 albertel 4718: border-collapse: separate;
4719: }
4720: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
1.692.4.2 raeburn 4721: border: none;
1.346 albertel 4722: }
1.345 albertel 4723: table#LC_top_nav td {
4724: background: $tabbg;
1.692.4.2 raeburn 4725: border: none;
1.407 albertel 4726: font-size: small;
1.345 albertel 4727: }
4728: table#LC_top_nav td a, div#LC_top_nav a {
4729: color: $font;
4730: font-family: $sans;
4731: }
1.364 albertel 4732: table#LC_top_nav td.LC_top_nav_logo {
4733: background: $tabbg;
1.432 albertel 4734: text-align: left;
1.408 albertel 4735: white-space: nowrap;
1.432 albertel 4736: width: 31px;
1.408 albertel 4737: }
4738: table#LC_top_nav td.LC_top_nav_logo img {
1.692.4.2 raeburn 4739: border: none;
1.408 albertel 4740: vertical-align: bottom;
1.364 albertel 4741: }
1.432 albertel 4742: table#LC_top_nav td.LC_top_nav_exit,
4743: table#LC_top_nav td.LC_top_nav_help {
4744: width: 2.0em;
4745: }
1.442 albertel 4746: table#LC_top_nav td.LC_top_nav_login {
4747: width: 4.0em;
4748: text-align: center;
4749: }
1.409 albertel 4750: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4751: background: $tabbg;
4752: color: $font;
4753: font-family: $sans;
1.358 albertel 4754: font-size: smaller;
1.357 albertel 4755: }
1.411 albertel 4756: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4757: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4758: background: $tabbg;
4759: color: $font;
4760: font-family: $sans;
4761: font-size: larger;
4762: text-align: right;
4763: }
1.383 albertel 4764: td.LC_table_cell_checkbox {
4765: text-align: center;
4766: }
1.522 albertel 4767: table#LC_mainmenu td.LC_mainmenu_column {
4768: vertical-align: top;
4769: }
4770:
1.346 albertel 4771: .LC_menubuttons_inline_text {
4772: color: $font;
4773: font-family: $sans;
4774: font-size: smaller;
4775: }
4776:
1.526 www 4777: .LC_menubuttons_link {
4778: text-decoration: none;
4779: }
1.692.4.2 raeburn 4780: /*2008--9-5: new menu style sheet.Changed category*/
1.522 albertel 4781: .LC_menubuttons_category {
1.521 www 4782: color: $font;
1.526 www 4783: background: $pgbg;
1.521 www 4784: font-family: $sans;
4785: font-size: larger;
4786: font-weight: bold;
4787: }
4788:
1.346 albertel 4789: td.LC_menubuttons_text {
1.526 www 4790: width: 90%;
1.346 albertel 4791: color: $font;
4792: font-family: $sans;
4793: }
1.526 www 4794:
1.346 albertel 4795: td.LC_menubuttons_img {
4796: }
1.526 www 4797:
1.346 albertel 4798: .LC_current_location {
4799: font-family: $sans;
4800: background: $tabbg;
4801: }
4802: .LC_new_mail {
4803: font-family: $sans;
1.634 www 4804: background: $tabbg;
1.346 albertel 4805: font-weight: bold;
4806: }
1.347 albertel 4807:
1.527 www 4808: .LC_dropadd_labeltext {
4809: font-family: $sans;
4810: text-align: right;
4811: }
4812:
4813: .LC_preferences_labeltext {
4814: font-family: $sans;
4815: text-align: right;
4816: }
4817:
1.666 raeburn 4818: .LC_roleslog_note {
4819: font-size: smaller;
4820: }
4821:
1.692.4.2 raeburn 4822: .LC_mail_functions {
4823: font-weight: bold;
4824: }
4825:
1.440 albertel 4826: table.LC_aboutme_port {
1.692.4.2 raeburn 4827: border: none;
1.440 albertel 4828: border-collapse: collapse;
1.692.4.2 raeburn 4829: border-spacing: 0;
1.440 albertel 4830: }
1.349 albertel 4831: table.LC_data_table, table.LC_mail_list {
1.347 albertel 4832: border: 1px solid #000000;
1.402 albertel 4833: border-collapse: separate;
1.426 albertel 4834: border-spacing: 1px;
1.610 albertel 4835: background: $pgbg;
1.347 albertel 4836: }
1.422 albertel 4837: .LC_data_table_dense {
4838: font-size: small;
4839: }
1.507 raeburn 4840: table.LC_nested_outer {
4841: border: 1px solid #000000;
1.589 raeburn 4842: border-collapse: collapse;
1.692.4.2 raeburn 4843: border-spacing: 0;
1.507 raeburn 4844: width: 100%;
4845: }
4846: table.LC_nested {
1.692.4.2 raeburn 4847: border: none;
1.589 raeburn 4848: border-collapse: collapse;
1.692.4.2 raeburn 4849: border-spacing: 0;
1.507 raeburn 4850: width: 100%;
4851: }
1.523 albertel 4852: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
4853: table.LC_prior_tries tr th {
1.349 albertel 4854: font-weight: bold;
4855: background-color: $data_table_head;
1.421 albertel 4856: font-size: smaller;
1.347 albertel 4857: }
1.692.4.2 raeburn 4858: table.LC_data_table tr.LC_info_row > td {
4859: background-color: #CCCCCC;
4860: font-weight: bold;
4861: text-align: left;
4862: }
1.610 albertel 4863: table.LC_data_table tr.LC_odd_row > td,
1.692.4.2 raeburn 4864: table.LC_pick_box tr > td.LC_odd_row,
1.440 albertel 4865: table.LC_aboutme_port tr td {
1.349 albertel 4866: background-color: $data_table_light;
1.425 albertel 4867: padding: 2px;
1.347 albertel 4868: }
1.610 albertel 4869: table.LC_data_table tr.LC_even_row > td,
1.692.4.2 raeburn 4870: table.LC_pick_box tr > td.LC_even_row,
1.440 albertel 4871: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 4872: background-color: $data_table_dark;
1.692.4.2 raeburn 4873: padding: 2px;
1.347 albertel 4874: }
1.425 albertel 4875: table.LC_data_table tr.LC_data_table_highlight td {
4876: background-color: $data_table_darker;
4877: }
1.639 raeburn 4878: table.LC_data_table tr td.LC_leftcol_header {
4879: background-color: $data_table_head;
4880: font-weight: bold;
4881: }
1.451 albertel 4882: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 4883: table.LC_nested tr.LC_empty_row td {
1.347 albertel 4884: background-color: #FFFFFF;
1.421 albertel 4885: font-weight: bold;
4886: font-style: italic;
4887: text-align: center;
4888: padding: 8px;
1.347 albertel 4889: }
1.507 raeburn 4890: table.LC_nested tr.LC_empty_row td {
1.465 albertel 4891: padding: 4ex
4892: }
1.507 raeburn 4893: table.LC_nested_outer tr th {
4894: font-weight: bold;
4895: background-color: $data_table_head;
4896: font-size: smaller;
4897: border-bottom: 1px solid #000000;
4898: }
4899: table.LC_nested_outer tr td.LC_subheader {
4900: background-color: $data_table_head;
4901: font-weight: bold;
4902: font-size: small;
4903: border-bottom: 1px solid #000000;
4904: text-align: right;
1.451 albertel 4905: }
1.507 raeburn 4906: table.LC_nested tr.LC_info_row td {
1.692.4.2 raeburn 4907: background-color: #CCCCCC;
1.451 albertel 4908: font-weight: bold;
4909: font-size: small;
1.507 raeburn 4910: text-align: center;
4911: }
1.589 raeburn 4912: table.LC_nested tr.LC_info_row td.LC_left_item,
4913: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 4914: text-align: left;
1.451 albertel 4915: }
1.507 raeburn 4916: table.LC_nested td {
1.692.4.2 raeburn 4917: background-color: #FFFFFF;
1.451 albertel 4918: font-size: small;
1.507 raeburn 4919: }
4920: table.LC_nested_outer tr th.LC_right_item,
4921: table.LC_nested tr.LC_info_row td.LC_right_item,
4922: table.LC_nested tr.LC_odd_row td.LC_right_item,
4923: table.LC_nested tr td.LC_right_item {
1.451 albertel 4924: text-align: right;
4925: }
4926:
1.507 raeburn 4927: table.LC_nested tr.LC_odd_row td {
1.692.4.2 raeburn 4928: background-color: #EEEEEE;
1.451 albertel 4929: }
4930:
1.473 raeburn 4931: table.LC_createuser {
4932: }
4933:
4934: table.LC_createuser tr.LC_section_row td {
4935: font-size: smaller;
4936: }
4937:
4938: table.LC_createuser tr.LC_info_row td {
1.692.4.2 raeburn 4939: background-color: #CCCCCC;
1.473 raeburn 4940: font-weight: bold;
4941: text-align: center;
4942: }
4943:
1.349 albertel 4944: table.LC_calendar {
4945: border: 1px solid #000000;
4946: border-collapse: collapse;
4947: }
4948: table.LC_calendar_pickdate {
4949: font-size: xx-small;
4950: }
4951: table.LC_calendar tr td {
4952: border: 1px solid #000000;
4953: vertical-align: top;
4954: }
4955: table.LC_calendar tr td.LC_calendar_day_empty {
4956: background-color: $data_table_dark;
4957: }
4958: table.LC_calendar tr td.LC_calendar_day_current {
4959: background-color: $data_table_highlight;
4960: }
4961:
4962: table.LC_mail_list tr.LC_mail_new {
4963: background-color: $mail_new;
4964: }
4965: table.LC_mail_list tr.LC_mail_new:hover {
4966: background-color: $mail_new_hover;
4967: }
4968: table.LC_mail_list tr.LC_mail_read {
4969: background-color: $mail_read;
4970: }
4971: table.LC_mail_list tr.LC_mail_read:hover {
4972: background-color: $mail_read_hover;
4973: }
4974: table.LC_mail_list tr.LC_mail_replied {
4975: background-color: $mail_replied;
4976: }
4977: table.LC_mail_list tr.LC_mail_replied:hover {
4978: background-color: $mail_replied_hover;
4979: }
4980: table.LC_mail_list tr.LC_mail_other {
4981: background-color: $mail_other;
4982: }
4983: table.LC_mail_list tr.LC_mail_other:hover {
4984: background-color: $mail_other_hover;
4985: }
1.494 raeburn 4986: table.LC_mail_list tr.LC_mail_even {
4987: }
4988: table.LC_mail_list tr.LC_mail_odd {
4989: }
4990:
1.385 albertel 4991:
1.386 albertel 4992: table#LC_portfolio_actions {
4993: width: auto;
4994: background: $pgbg;
1.692.4.2 raeburn 4995: border: none;
1.386 albertel 4996: border-spacing: 2px 2px;
1.692.4.2 raeburn 4997: padding: 0;
4998: margin: 0;
1.386 albertel 4999: border-collapse: separate;
5000: }
5001: table#LC_portfolio_actions td.LC_label {
5002: background: $tabbg;
5003: text-align: right;
5004: }
5005: table#LC_portfolio_actions td.LC_value {
5006: background: $tabbg;
5007: }
1.385 albertel 5008:
1.391 albertel 5009: table#LC_cstr_controls {
5010: width: 100%;
5011: border-collapse: collapse;
5012: }
5013: table#LC_cstr_controls tr td {
5014: border: 4px solid $pgbg;
5015: padding: 4px;
5016: text-align: center;
5017: background: $tabbg;
5018: }
5019: table#LC_cstr_controls tr th {
5020: border: 4px solid $pgbg;
5021: background: $table_header;
5022: text-align: center;
5023: font-family: $sans;
5024: font-size: smaller;
5025: }
5026:
1.389 albertel 5027: table#LC_browser {
5028:
5029: }
5030: table#LC_browser tr th {
1.391 albertel 5031: background: $table_header;
1.389 albertel 5032: }
1.390 albertel 5033: table#LC_browser tr td {
5034: padding: 2px;
5035: }
1.389 albertel 5036: table#LC_browser tr.LC_browser_file,
5037: table#LC_browser tr.LC_browser_file_published {
5038: background: #CCFF88;
5039: }
5040: table#LC_browser tr.LC_browser_file_locked,
5041: table#LC_browser tr.LC_browser_file_unpublished {
5042: background: #FFAA99;
1.387 albertel 5043: }
1.389 albertel 5044: table#LC_browser tr.LC_browser_file_obsolete {
5045: background: #AAAAAA;
1.387 albertel 5046: }
1.455 albertel 5047: table#LC_browser tr.LC_browser_file_modified,
5048: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 5049: background: #FFFF77;
1.387 albertel 5050: }
1.389 albertel 5051: table#LC_browser tr.LC_browser_folder {
5052: background: #CCCCFF;
1.387 albertel 5053: }
1.692.4.2 raeburn 5054:
5055: table.LC_data_table tr > td.LC_roles_is {
5056: /* background: #77FF77; */
5057: }
5058: table.LC_data_table tr > td.LC_roles_future {
5059: background: #FFFF77;
5060: }
5061: table.LC_data_table tr > td.LC_roles_will {
5062: background: #FFAA77;
5063: }
5064: table.LC_data_table tr > td.LC_roles_expired {
5065: background: #FF7777;
5066: }
5067: table.LC_data_table tr > td.LC_roles_will_not {
5068: background: #AAFF77;
5069: }
5070: table.LC_data_table tr > td.LC_roles_selected {
5071: background: #11CC55;
5072: }
5073:
1.388 albertel 5074: span.LC_current_location {
5075: font-size: x-large;
5076: background: $pgbg;
5077: }
1.387 albertel 5078:
1.395 albertel 5079: span.LC_parm_menu_item {
5080: font-size: larger;
5081: font-family: $sans;
5082: }
5083: span.LC_parm_scope_all {
5084: color: red;
5085: }
5086: span.LC_parm_scope_folder {
5087: color: green;
5088: }
5089: span.LC_parm_scope_resource {
5090: color: orange;
5091: }
5092: span.LC_parm_part {
5093: color: blue;
5094: }
5095: span.LC_parm_folder, span.LC_parm_symb {
5096: font-size: x-small;
5097: font-family: $mono;
5098: color: #AAAAAA;
5099: }
5100:
1.396 albertel 5101: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
5102: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
5103: border: 1px solid black;
5104: border-collapse: collapse;
5105: }
5106: table.LC_parm_overview_restrictions td {
5107: border-width: 1px 4px 1px 4px;
5108: border-style: solid;
5109: border-color: $pgbg;
5110: text-align: center;
5111: }
5112: table.LC_parm_overview_restrictions th {
5113: background: $tabbg;
5114: border-width: 1px 4px 1px 4px;
5115: border-style: solid;
5116: border-color: $pgbg;
5117: }
1.398 albertel 5118: table#LC_helpmenu {
1.692.4.2 raeburn 5119: border: none;
1.398 albertel 5120: height: 55px;
1.692.4.2 raeburn 5121: border-spacing: 0;
1.398 albertel 5122: }
5123:
5124: table#LC_helpmenu fieldset legend {
5125: font-size: larger;
5126: font-weight: bold;
5127: }
1.397 albertel 5128: table#LC_helpmenu_links {
5129: width: 100%;
5130: border: 1px solid black;
5131: background: $pgbg;
1.692.4.2 raeburn 5132: padding: 0;
1.397 albertel 5133: border-spacing: 1px;
5134: }
5135: table#LC_helpmenu_links tr td {
5136: padding: 1px;
5137: background: $tabbg;
1.399 albertel 5138: text-align: center;
5139: font-weight: bold;
1.397 albertel 5140: }
1.396 albertel 5141:
1.397 albertel 5142: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
5143: table#LC_helpmenu_links a:active {
5144: text-decoration: none;
5145: color: $font;
5146: }
5147: table#LC_helpmenu_links a:hover {
5148: text-decoration: underline;
5149: color: $vlink;
5150: }
1.396 albertel 5151:
1.417 albertel 5152: .LC_chrt_popup_exists {
5153: border: 1px solid #339933;
5154: margin: -1px;
5155: }
5156: .LC_chrt_popup_up {
5157: border: 1px solid yellow;
5158: margin: -1px;
5159: }
5160: .LC_chrt_popup {
5161: border: 1px solid #8888FF;
5162: background: #CCCCFF;
5163: }
1.421 albertel 5164: table.LC_pick_box {
5165: border-collapse: separate;
5166: background: white;
5167: border: 1px solid black;
5168: border-spacing: 1px;
5169: }
5170: table.LC_pick_box td.LC_pick_box_title {
1.692.4.6 raeburn 5171: background: $sidebg;
1.421 albertel 5172: font-weight: bold;
5173: text-align: right;
1.692.4.2 raeburn 5174: vertical-align: top;
1.421 albertel 5175: width: 184px;
5176: padding: 8px;
5177: }
1.645 raeburn 5178: table.LC_pick_box td.LC_selfenroll_pick_box_title {
1.692.4.6 raeburn 5179: background: $sidebg;
1.645 raeburn 5180: font-weight: bold;
5181: text-align: right;
5182: width: 350px;
5183: padding: 8px;
5184: }
5185:
1.579 raeburn 5186: table.LC_pick_box td.LC_pick_box_value {
5187: text-align: left;
5188: padding: 8px;
5189: }
5190: table.LC_pick_box td.LC_pick_box_select {
5191: text-align: left;
5192: padding: 8px;
5193: }
1.424 albertel 5194: table.LC_pick_box td.LC_pick_box_separator {
1.692.4.2 raeburn 5195: padding: 0;
1.421 albertel 5196: height: 1px;
5197: background: black;
5198: }
5199: table.LC_pick_box td.LC_pick_box_submit {
5200: text-align: right;
5201: }
1.579 raeburn 5202: table.LC_pick_box td.LC_evenrow_value {
5203: text-align: left;
5204: padding: 8px;
5205: background-color: $data_table_light;
5206: }
5207: table.LC_pick_box td.LC_oddrow_value {
5208: text-align: left;
5209: padding: 8px;
5210: background-color: $data_table_light;
5211: }
5212: table.LC_helpform_receipt {
5213: width: 620px;
5214: border-collapse: separate;
5215: background: white;
5216: border: 1px solid black;
5217: border-spacing: 1px;
5218: }
5219: table.LC_helpform_receipt td.LC_pick_box_title {
5220: background: $tabbg;
5221: font-weight: bold;
5222: text-align: right;
5223: width: 184px;
5224: padding: 8px;
5225: }
5226: table.LC_helpform_receipt td.LC_evenrow_value {
5227: text-align: left;
5228: padding: 8px;
5229: background-color: $data_table_light;
5230: }
5231: table.LC_helpform_receipt td.LC_oddrow_value {
5232: text-align: left;
5233: padding: 8px;
5234: background-color: $data_table_light;
5235: }
5236: table.LC_helpform_receipt td.LC_pick_box_separator {
1.692.4.2 raeburn 5237: padding: 0;
1.579 raeburn 5238: height: 1px;
5239: background: black;
5240: }
5241: span.LC_helpform_receipt_cat {
5242: font-weight: bold;
5243: }
1.424 albertel 5244: table.LC_group_priv_box {
5245: background: white;
5246: border: 1px solid black;
5247: border-spacing: 1px;
5248: }
5249: table.LC_group_priv_box td.LC_pick_box_title {
5250: background: $tabbg;
5251: font-weight: bold;
5252: text-align: right;
5253: width: 184px;
5254: }
5255: table.LC_group_priv_box td.LC_groups_fixed {
5256: background: $data_table_light;
5257: text-align: center;
5258: }
5259: table.LC_group_priv_box td.LC_groups_optional {
5260: background: $data_table_dark;
5261: text-align: center;
5262: }
5263: table.LC_group_priv_box td.LC_groups_functionality {
5264: background: $data_table_darker;
5265: text-align: center;
5266: font-weight: bold;
5267: }
5268: table.LC_group_priv td {
5269: text-align: left;
1.692.4.2 raeburn 5270: padding: 0;
1.424 albertel 5271: }
5272:
1.421 albertel 5273: table.LC_notify_front_page {
5274: background: white;
5275: border: 1px solid black;
5276: padding: 8px;
5277: }
5278: table.LC_notify_front_page td {
5279: padding: 8px;
5280: }
1.424 albertel 5281: .LC_navbuttons {
5282: margin: 2ex 0ex 2ex 0ex;
5283: }
1.423 albertel 5284: .LC_topic_bar {
5285: font-family: $sans;
5286: font-weight: bold;
5287: width: 100%;
5288: background: $tabbg;
5289: vertical-align: middle;
5290: margin: 2ex 0ex 2ex 0ex;
1.692.4.2 raeburn 5291: padding: 3px;
1.423 albertel 5292: }
5293: .LC_topic_bar span {
5294: vertical-align: middle;
5295: }
5296: .LC_topic_bar img {
5297: vertical-align: bottom;
5298: }
5299: table.LC_course_group_status {
5300: margin: 20px;
5301: }
5302: table.LC_status_selector td {
5303: vertical-align: top;
5304: text-align: center;
1.424 albertel 5305: padding: 4px;
5306: }
5307: table.LC_descriptive_input td.LC_description {
5308: vertical-align: top;
5309: text-align: right;
5310: font-weight: bold;
1.423 albertel 5311: }
1.599 albertel 5312: div.LC_feedback_link {
1.616 albertel 5313: clear: both;
1.599 albertel 5314: background: white;
5315: width: 100%;
1.489 raeburn 5316: }
5317: span.LC_feedback_link {
1.599 albertel 5318: background: $feedback_link_bg;
5319: font-size: larger;
5320: }
5321: span.LC_message_link {
5322: background: $feedback_link_bg;
5323: font-size: larger;
5324: position: absolute;
5325: right: 1em;
1.489 raeburn 5326: }
1.421 albertel 5327:
1.515 albertel 5328: table.LC_prior_tries {
1.524 albertel 5329: border: 1px solid #000000;
5330: border-collapse: separate;
5331: border-spacing: 1px;
1.515 albertel 5332: }
1.523 albertel 5333:
1.515 albertel 5334: table.LC_prior_tries td {
1.524 albertel 5335: padding: 2px;
1.515 albertel 5336: }
1.523 albertel 5337:
5338: .LC_answer_correct {
5339: background: #AAFFAA;
5340: color: black;
5341: }
5342: .LC_answer_charged_try {
5343: background: #FFAAAA ! important;
5344: color: black;
5345: }
5346: .LC_answer_not_charged_try,
5347: .LC_answer_no_grade,
5348: .LC_answer_late {
5349: background: #FFFFAA;
5350: color: black;
5351: }
5352: .LC_answer_previous {
5353: background: #AAAAFF;
5354: color: black;
5355: }
5356: .LC_answer_no_message {
5357: background: #FFFFFF;
5358: color: black;
5359: }
5360: .LC_answer_unknown {
5361: background: orange;
5362: color: black;
5363: }
5364:
5365:
1.529 albertel 5366: span.LC_prior_numerical,
5367: span.LC_prior_string,
5368: span.LC_prior_custom,
5369: span.LC_prior_reaction,
5370: span.LC_prior_math {
1.523 albertel 5371: font-family: monospace;
5372: white-space: pre;
5373: }
5374:
1.525 albertel 5375: span.LC_prior_string {
5376: font-family: monospace;
5377: white-space: pre;
5378: }
5379:
1.523 albertel 5380: table.LC_prior_option {
5381: width: 100%;
5382: border-collapse: collapse;
5383: }
1.528 albertel 5384: table.LC_prior_rank, table.LC_prior_match {
5385: border-collapse: collapse;
5386: }
5387: table.LC_prior_option tr td,
5388: table.LC_prior_rank tr td,
5389: table.LC_prior_match tr td {
1.524 albertel 5390: border: 1px solid #000000;
1.515 albertel 5391: }
5392:
1.519 raeburn 5393: span.LC_nobreak {
1.544 albertel 5394: white-space: nowrap;
1.519 raeburn 5395: }
5396:
1.576 raeburn 5397: span.LC_cusr_emph {
5398: font-style: italic;
5399: }
5400:
1.633 raeburn 5401: span.LC_cusr_subheading {
5402: font-weight: normal;
5403: font-size: 85%;
5404: }
5405:
1.545 albertel 5406: table.LC_docs_documents {
5407: background: #BBBBBB;
1.692.4.2 raeburn 5408: border-width: 0;
1.545 albertel 5409: border-collapse: collapse;
5410: }
5411:
5412: table.LC_docs_documents td.LC_docs_document {
5413: border: 2px solid black;
5414: padding: 4px;
5415: }
5416:
5417: .LC_docs_course_commands div {
5418: float: left;
5419: border: 4px solid #AAAAAA;
5420: padding: 4px;
5421: background: #DDDDCC;
5422: }
5423:
5424: .LC_docs_entry_move {
1.692.4.2 raeburn 5425: border: none;
1.545 albertel 5426: border-collapse: collapse;
1.544 albertel 5427: }
5428:
1.545 albertel 5429: .LC_docs_entry_move td {
5430: border: 2px solid #BBBBBB;
5431: background: #DDDDDD;
5432: }
5433:
5434: .LC_docs_editor td.LC_docs_entry_commands {
5435: background: #DDDDDD;
5436: font-size: x-small;
5437: }
1.544 albertel 5438: .LC_docs_copy {
1.545 albertel 5439: color: #000099;
1.544 albertel 5440: }
5441: .LC_docs_cut {
1.545 albertel 5442: color: #550044;
1.544 albertel 5443: }
5444: .LC_docs_rename {
1.545 albertel 5445: color: #009900;
1.544 albertel 5446: }
5447: .LC_docs_remove {
1.545 albertel 5448: color: #990000;
5449: }
5450:
1.547 albertel 5451: .LC_docs_reinit_warn,
5452: .LC_docs_ext_edit {
5453: font-size: x-small;
5454: }
5455:
1.545 albertel 5456: .LC_docs_editor td.LC_docs_entry_title,
5457: .LC_docs_editor td.LC_docs_entry_icon {
5458: background: #FFFFBB;
5459: }
5460: .LC_docs_editor td.LC_docs_entry_parameter {
5461: background: #BBBBFF;
5462: font-size: x-small;
5463: white-space: nowrap;
5464: }
5465:
5466: table.LC_docs_adddocs td,
5467: table.LC_docs_adddocs th {
5468: border: 1px solid #BBBBBB;
5469: padding: 4px;
5470: background: #DDDDDD;
1.543 albertel 5471: }
5472:
1.584 albertel 5473: table.LC_sty_begin {
5474: background: #BBFFBB;
5475: }
5476: table.LC_sty_end {
5477: background: #FFBBBB;
5478: }
5479:
1.589 raeburn 5480: table.LC_double_column {
1.692.4.2 raeburn 5481: border-width: 0;
1.589 raeburn 5482: border-collapse: collapse;
5483: width: 100%;
5484: padding: 2px;
5485: }
5486:
5487: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5488: top: 2px;
1.589 raeburn 5489: left: 2px;
5490: width: 47%;
5491: vertical-align: top;
5492: }
5493:
5494: table.LC_double_column tr td.LC_right_col {
5495: top: 2px;
5496: right: 2px;
5497: width: 47%;
5498: vertical-align: top;
5499: }
5500:
1.594 raeburn 5501: span.LC_role_level {
5502: font-weight: bold;
5503: }
5504:
1.591 raeburn 5505: div.LC_left_float {
5506: float: left;
5507: padding-right: 5%;
1.597 albertel 5508: padding-bottom: 4px;
1.591 raeburn 5509: }
5510:
5511: div.LC_clear_float_header {
1.597 albertel 5512: padding-bottom: 2px;
1.591 raeburn 5513: }
5514:
5515: div.LC_clear_float_footer {
1.597 albertel 5516: padding-top: 10px;
1.591 raeburn 5517: clear: both;
5518: }
5519:
1.597 albertel 5520:
1.601 albertel 5521: div.LC_grade_select_mode {
1.604 albertel 5522: font-family: $sans;
1.601 albertel 5523: }
5524: div.LC_grade_select_mode div div {
5525: margin: 5px;
5526: }
5527: div.LC_grade_select_mode_selector {
5528: margin: 5px;
5529: float: left;
5530: }
5531: div.LC_grade_select_mode_selector_header {
5532: font: bold medium $sans;
5533: }
5534: div.LC_grade_select_mode_type {
5535: clear: left;
5536: }
5537:
1.597 albertel 5538: div.LC_grade_show_user {
5539: margin-top: 20px;
5540: border: 1px solid black;
5541: }
5542: div.LC_grade_user_name {
5543: background: #DDDDEE;
5544: border-bottom: 1px solid black;
5545: font: bold large $sans;
5546: }
5547: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5548: background: #DDEEDD;
5549: }
5550:
5551: div.LC_grade_show_problem,
5552: div.LC_grade_submissions,
5553: div.LC_grade_message_center,
5554: div.LC_grade_info_links,
5555: div.LC_grade_assign {
5556: margin: 5px;
5557: width: 99%;
5558: background: #FFFFFF;
5559: }
5560: div.LC_grade_show_problem_header,
5561: div.LC_grade_submissions_header,
5562: div.LC_grade_message_center_header,
5563: div.LC_grade_assign_header {
5564: font: bold large $sans;
5565: }
5566: div.LC_grade_show_problem_problem,
5567: div.LC_grade_submissions_body,
5568: div.LC_grade_message_center_body,
5569: div.LC_grade_assign_body {
5570: border: 1px solid black;
5571: width: 99%;
5572: background: #FFFFFF;
5573: }
1.598 albertel 5574: span.LC_grade_check_note {
5575: font: normal medium $sans;
5576: display: inline;
5577: position: absolute;
5578: right: 1em;
5579: }
1.597 albertel 5580:
1.613 albertel 5581: table.LC_scantron_action {
5582: width: 100%;
5583: }
5584: table.LC_scantron_action tr th {
5585: font: normal bold $sans;
5586: }
1.600 albertel 5587:
1.614 albertel 5588: div.LC_edit_problem_header,
5589: div.LC_edit_problem_footer {
1.600 albertel 5590: font: normal medium $sans;
1.602 albertel 5591: margin: 2px;
1.600 albertel 5592: }
5593: div.LC_edit_problem_header,
1.602 albertel 5594: div.LC_edit_problem_header div,
1.614 albertel 5595: div.LC_edit_problem_footer,
5596: div.LC_edit_problem_footer div,
1.602 albertel 5597: div.LC_edit_problem_editxml_header,
5598: div.LC_edit_problem_editxml_header div {
1.600 albertel 5599: margin-top: 5px;
5600: }
1.602 albertel 5601: div.LC_edit_problem_header_edit_row {
5602: background: $tabbg;
5603: padding: 3px;
5604: margin-bottom: 5px;
5605: }
1.600 albertel 5606: div.LC_edit_problem_header_title {
1.602 albertel 5607: font: larger bold $sans;
5608: background: $tabbg;
5609: padding: 3px;
5610: }
5611: table.LC_edit_problem_header_title {
5612: font: larger bold $sans;
5613: width: 100%;
5614: border-color: $pgbg;
5615: border-style: solid;
5616: border-width: $border;
5617:
1.600 albertel 5618: background: $tabbg;
1.602 albertel 5619: border-collapse: collapse;
1.692.4.2 raeburn 5620: padding: 0;
1.602 albertel 5621: }
5622:
5623: div.LC_edit_problem_discards {
5624: float: left;
5625: padding-bottom: 5px;
5626: }
5627: div.LC_edit_problem_saves {
5628: float: right;
5629: padding-bottom: 5px;
1.600 albertel 5630: }
5631: hr.LC_edit_problem_divide {
1.602 albertel 5632: clear: both;
1.600 albertel 5633: color: $tabbg;
5634: background-color: $tabbg;
5635: height: 3px;
1.692.4.2 raeburn 5636: border: none;
1.600 albertel 5637: }
1.679 riegler 5638: img.stift{
1.678 riegler 5639: border-width:0;
1.679 riegler 5640: vertical-align:middle;
1.677 riegler 5641: }
1.680 riegler 5642:
1.681 riegler 5643: table#LC_mainmenu{
5644: margin-top:10px;
5645: width:80%;
5646:
5647: }
5648:
1.680 riegler 5649: table#LC_mainmenu td.LC_mainmenu_col_fieldset{
5650: vertical-align: top;
5651: width: 45%;
5652: }
5653: .LC_mainmenu_fieldset_category {
5654: color: $font;
5655: background: $pgbg;
5656: font-family: $sans;
5657: font-size: small;
5658: font-weight: bold;
5659: }
5660: fieldset#LC_mainmenu_fieldset {
1.692.4.2 raeburn 5661: margin:0 10px 10px 0;
5662:
5663: }
1.680 riegler 5664:
1.692.4.2 raeburn 5665: div.LC_createcourse {
5666: margin: 10px 10px 10px 10px;
1.680 riegler 5667: }
1.692.4.2 raeburn 5668:
1.343 albertel 5669: END
5670: }
5671:
1.306 albertel 5672: =pod
5673:
5674: =item * &headtag()
5675:
5676: Returns a uniform footer for LON-CAPA web pages.
5677:
1.307 albertel 5678: Inputs: $title - optional title for the head
5679: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5680: $args - optional arguments
1.319 albertel 5681: force_register - if is true call registerurl so the remote is
5682: informed
1.415 albertel 5683: redirect -> array ref of
5684: 1- seconds before redirect occurs
5685: 2- url to redirect to
5686: 3- whether the side effect should occur
1.315 albertel 5687: (side effect of setting
5688: $env{'internal.head.redirect'} to the url
5689: redirected too)
1.352 albertel 5690: domain -> force to color decorate a page for a specific
5691: domain
5692: function -> force usage of a specific rolish color scheme
5693: bgcolor -> override the default page bgcolor
1.460 albertel 5694: no_auto_mt_title
5695: -> prevent &mt()ing the title arg
1.464 albertel 5696:
1.306 albertel 5697: =cut
5698:
5699: sub headtag {
1.313 albertel 5700: my ($title,$head_extra,$args) = @_;
1.306 albertel 5701:
1.363 albertel 5702: my $function = $args->{'function'} || &get_users_function();
5703: my $domain = $args->{'domain'} || &determinedomain();
5704: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5705: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5706: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5707: #time(),
1.418 albertel 5708: $env{'environment.color.timestamp'},
1.363 albertel 5709: $function,$domain,$bgcolor);
5710:
1.369 www 5711: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5712:
1.308 albertel 5713: my $result =
5714: '<head>'.
1.461 albertel 5715: &font_settings();
1.319 albertel 5716:
1.461 albertel 5717: if (!$args->{'frameset'}) {
5718: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5719: }
1.319 albertel 5720: if ($args->{'force_register'}) {
5721: $result .= &Apache::lonmenu::registerurl(1);
5722: }
1.436 albertel 5723: if (!$args->{'no_nav_bar'}
5724: && !$args->{'only_body'}
5725: && !$args->{'frameset'}) {
5726: $result .= &help_menu_js();
5727: }
1.319 albertel 5728:
1.314 albertel 5729: if (ref($args->{'redirect'})) {
1.414 albertel 5730: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5731: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5732: if (!$inhibit_continue) {
5733: $env{'internal.head.redirect'} = $url;
5734: }
1.313 albertel 5735: $result.=<<ADDMETA
5736: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5737: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5738: ADDMETA
5739: }
1.306 albertel 5740: if (!defined($title)) {
5741: $title = 'The LearningOnline Network with CAPA';
5742: }
1.460 albertel 5743: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5744: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5745: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5746: .$head_extra;
1.306 albertel 5747: return $result;
5748: }
5749:
5750: =pod
5751:
1.340 albertel 5752: =item * &font_settings()
5753:
5754: Returns neccessary <meta> to set the proper encoding
5755:
5756: Inputs: none
5757:
5758: =cut
5759:
5760: sub font_settings {
5761: my $headerstring='';
1.647 www 5762: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 5763: $headerstring.=
5764: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5765: }
5766: return $headerstring;
5767: }
5768:
1.341 albertel 5769: =pod
5770:
5771: =item * &xml_begin()
5772:
5773: Returns the needed doctype and <html>
5774:
5775: Inputs: none
5776:
5777: =cut
5778:
5779: sub xml_begin {
5780: my $output='';
5781:
1.592 albertel 5782: if ($env{'internal.start_page'}==1) {
5783: &Apache::lonhtmlcommon::init_htmlareafields();
5784: }
1.342 albertel 5785:
1.341 albertel 5786: if ($env{'browser.mathml'}) {
5787: $output='<?xml version="1.0"?>'
5788: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5789: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5790:
5791: # .'<!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">] >'
5792: .'<!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">'
5793: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5794: .'xmlns="http://www.w3.org/1999/xhtml">';
5795: } else {
1.692.4.6 raeburn 5796: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'.
5797: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 5798: }
5799: return $output;
5800: }
1.340 albertel 5801:
5802: =pod
5803:
1.306 albertel 5804: =item * &endheadtag()
5805:
5806: Returns a uniform </head> for LON-CAPA web pages.
5807:
5808: Inputs: none
5809:
5810: =cut
5811:
5812: sub endheadtag {
5813: return '</head>';
5814: }
5815:
5816: =pod
5817:
5818: =item * &head()
5819:
5820: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
5821:
1.648 raeburn 5822: Inputs:
5823:
5824: =over 4
5825:
5826: $title - optional title for the page
5827:
5828: $head_extra - optional extra HTML to put inside the <head>
5829:
5830: =back
1.405 albertel 5831:
1.306 albertel 5832: =cut
5833:
5834: sub head {
1.325 albertel 5835: my ($title,$head_extra,$args) = @_;
5836: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 5837: }
5838:
5839: =pod
5840:
5841: =item * &start_page()
5842:
5843: Returns a complete <html> .. <body> section for LON-CAPA web pages.
5844:
1.648 raeburn 5845: Inputs:
5846:
5847: =over 4
5848:
5849: $title - optional title for the page
5850:
5851: $head_extra - optional extra HTML to incude inside the <head>
5852:
5853: $args - additional optional args supported are:
5854:
5855: =over 8
5856:
5857: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 5858: arg on
1.648 raeburn 5859: no_nav_bar -> is true will set &bodytag() notopbar arg on
5860: add_entries -> additional attributes to add to the <body>
5861: domain -> force to color decorate a page for a
1.317 albertel 5862: specific domain
1.648 raeburn 5863: function -> force usage of a specific rolish color
1.317 albertel 5864: scheme
1.648 raeburn 5865: redirect -> see &headtag()
5866: bgcolor -> override the default page bg color
5867: js_ready -> return a string ready for being used in
1.317 albertel 5868: a javascript writeln
1.648 raeburn 5869: html_encode -> return a string ready for being used in
1.320 albertel 5870: a html attribute
1.648 raeburn 5871: force_register -> if is true will turn on the &bodytag()
1.317 albertel 5872: $forcereg arg
1.648 raeburn 5873: body_title -> alternate text to use instead of $title
1.326 albertel 5874: in the title box that appears, this text
5875: is not auto translated like the $title is
1.648 raeburn 5876: frameset -> if true will start with a <frameset>
1.330 albertel 5877: rather than <body>
1.648 raeburn 5878: no_title -> if true the title bar won't be shown
5879: skip_phases -> hash ref of
1.338 albertel 5880: head -> skip the <html><head> generation
5881: body -> skip all <body> generation
1.648 raeburn 5882: no_inline_link -> if true and in remote mode, don't show the
1.361 albertel 5883: 'Switch To Inline Menu' link
1.648 raeburn 5884: no_auto_mt_title -> prevent &mt()ing the title arg
5885: inherit_jsmath -> when creating popup window in a page,
5886: should it have jsmath forced on by the
5887: current page
1.361 albertel 5888:
1.648 raeburn 5889: =back
1.460 albertel 5890:
1.648 raeburn 5891: =back
1.562 albertel 5892:
1.306 albertel 5893: =cut
5894:
5895: sub start_page {
1.309 albertel 5896: my ($title,$head_extra,$args) = @_;
1.318 albertel 5897: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 5898: my %head_args;
1.352 albertel 5899: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 5900: 'bgcolor','frameset','no_nav_bar','only_body',
5901: 'no_auto_mt_title') {
1.319 albertel 5902: if (defined($args->{$arg})) {
1.324 raeburn 5903: $head_args{$arg} = $args->{$arg};
1.319 albertel 5904: }
1.313 albertel 5905: }
1.319 albertel 5906:
1.315 albertel 5907: $env{'internal.start_page'}++;
1.338 albertel 5908: my $result;
5909: if (! exists($args->{'skip_phases'}{'head'}) ) {
5910: $result.=
1.341 albertel 5911: &xml_begin().
1.338 albertel 5912: &headtag($title,$head_extra,\%head_args).&endheadtag();
5913: }
5914:
5915: if (! exists($args->{'skip_phases'}{'body'}) ) {
5916: if ($args->{'frameset'}) {
5917: my $attr_string = &make_attr_string($args->{'force_register'},
5918: $args->{'add_entries'});
5919: $result .= "\n<frameset $attr_string>\n";
5920: } else {
5921: $result .=
5922: &bodytag($title,
5923: $args->{'function'}, $args->{'add_entries'},
5924: $args->{'only_body'}, $args->{'domain'},
5925: $args->{'force_register'}, $args->{'body_title'},
5926: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 5927: $args->{'no_title'}, $args->{'no_inline_link'},
5928: $args);
1.338 albertel 5929: }
1.330 albertel 5930: }
1.338 albertel 5931:
1.315 albertel 5932: if ($args->{'js_ready'}) {
1.317 albertel 5933: $result = &js_ready($result);
1.315 albertel 5934: }
1.320 albertel 5935: if ($args->{'html_encode'}) {
5936: $result = &html_encode($result);
5937: }
1.692.4.2 raeburn 5938: #Breadcrumbs
5939: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
5940: &Apache::lonhtmlcommon::clear_breadcrumbs();
5941: #if any br links exists, add them to the breadcrumbs
5942: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5943: foreach my $crumb (@{$args->{'bread_crumbs'}}){
5944: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
5945: }
5946: }
1.306 albertel 5947:
1.692.4.2 raeburn 5948: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
5949: if (exists($args->{'bread_crumbs_component'})){
5950: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
5951: } else {
5952: $result .= &Apache::lonhtmlcommon::breadcrumbs();
5953: }
5954: }
5955: return $result;
1.692.4.3 raeburn 5956: }
1.330 albertel 5957:
1.306 albertel 5958: =pod
5959:
5960: =item * &head()
5961:
5962: Returns a complete </body></html> section for LON-CAPA web pages.
5963:
1.315 albertel 5964: Inputs: $args - additional optional args supported are:
5965: js_ready -> return a string ready for being used in
5966: a javascript writeln
1.320 albertel 5967: html_encode -> return a string ready for being used in
5968: a html attribute
1.330 albertel 5969: frameset -> if true will start with a <frameset>
5970: rather than <body>
1.493 albertel 5971: dicsussion -> if true will get discussion from
5972: lonxml::xmlend
5973: (you can pass the target and parser arguments
5974: through optional 'target' and 'parser' args
5975: to this routine)
1.306 albertel 5976:
5977: =cut
5978:
5979: sub end_page {
1.315 albertel 5980: my ($args) = @_;
5981: $env{'internal.end_page'}++;
1.330 albertel 5982: my $result;
1.335 albertel 5983: if ($args->{'discussion'}) {
5984: my ($target,$parser);
5985: if (ref($args->{'discussion'})) {
5986: ($target,$parser) =($args->{'discussion'}{'target'},
5987: $args->{'discussion'}{'parser'});
5988: }
5989: $result .= &Apache::lonxml::xmlend($target,$parser);
5990: }
5991:
1.330 albertel 5992: if ($args->{'frameset'}) {
5993: $result .= '</frameset>';
5994: } else {
1.635 raeburn 5995: $result .= &endbodytag($args);
1.330 albertel 5996: }
5997: $result .= "\n</html>";
5998:
1.315 albertel 5999: if ($args->{'js_ready'}) {
1.317 albertel 6000: $result = &js_ready($result);
1.315 albertel 6001: }
1.335 albertel 6002:
1.320 albertel 6003: if ($args->{'html_encode'}) {
6004: $result = &html_encode($result);
6005: }
1.335 albertel 6006:
1.315 albertel 6007: return $result;
6008: }
6009:
1.320 albertel 6010: sub html_encode {
6011: my ($result) = @_;
6012:
1.322 albertel 6013: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 6014:
6015: return $result;
6016: }
1.317 albertel 6017: sub js_ready {
6018: my ($result) = @_;
6019:
1.323 albertel 6020: $result =~ s/[\n\r]/ /xmsg;
6021: $result =~ s/\\/\\\\/xmsg;
6022: $result =~ s/'/\\'/xmsg;
1.372 albertel 6023: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 6024:
6025: return $result;
6026: }
6027:
1.315 albertel 6028: sub validate_page {
6029: if ( exists($env{'internal.start_page'})
1.316 albertel 6030: && $env{'internal.start_page'} > 1) {
6031: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 6032: $env{'internal.start_page'}.' '.
1.316 albertel 6033: $ENV{'request.filename'});
1.315 albertel 6034: }
6035: if ( exists($env{'internal.end_page'})
1.316 albertel 6036: && $env{'internal.end_page'} > 1) {
6037: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 6038: $env{'internal.end_page'}.' '.
1.316 albertel 6039: $env{'request.filename'});
1.315 albertel 6040: }
6041: if ( exists($env{'internal.start_page'})
6042: && ! exists($env{'internal.end_page'})) {
1.316 albertel 6043: &Apache::lonnet::logthis('start_page called without end_page '.
6044: $env{'request.filename'});
1.315 albertel 6045: }
6046: if ( ! exists($env{'internal.start_page'})
6047: && exists($env{'internal.end_page'})) {
1.316 albertel 6048: &Apache::lonnet::logthis('end_page called without start_page'.
6049: $env{'request.filename'});
1.315 albertel 6050: }
1.306 albertel 6051: }
1.315 albertel 6052:
1.318 albertel 6053: sub simple_error_page {
6054: my ($r,$title,$msg) = @_;
6055: my $page =
6056: &Apache::loncommon::start_page($title).
6057: &mt($msg).
6058: &Apache::loncommon::end_page();
6059: if (ref($r)) {
6060: $r->print($page);
1.327 albertel 6061: return;
1.318 albertel 6062: }
6063: return $page;
6064: }
1.347 albertel 6065:
6066: {
1.610 albertel 6067: my @row_count;
1.347 albertel 6068: sub start_data_table {
1.422 albertel 6069: my ($add_class) = @_;
6070: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 6071: unshift(@row_count,0);
1.422 albertel 6072: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 6073: }
6074:
6075: sub end_data_table {
1.610 albertel 6076: shift(@row_count);
1.389 albertel 6077: return '</table>'."\n";;
1.347 albertel 6078: }
6079:
6080: sub start_data_table_row {
1.422 albertel 6081: my ($add_class) = @_;
1.610 albertel 6082: $row_count[0]++;
6083: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 6084: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 6085: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 6086: }
1.471 banghart 6087:
6088: sub continue_data_table_row {
6089: my ($add_class) = @_;
1.610 albertel 6090: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 6091: $css_class = (join(' ',$css_class,$add_class));
6092: return '<tr class="'.$css_class.'">'."\n";;
6093: }
1.347 albertel 6094:
6095: sub end_data_table_row {
1.389 albertel 6096: return '</tr>'."\n";;
1.347 albertel 6097: }
1.367 www 6098:
1.421 albertel 6099: sub start_data_table_empty_row {
1.610 albertel 6100: $row_count[0]++;
1.421 albertel 6101: return '<tr class="LC_empty_row" >'."\n";;
6102: }
6103:
6104: sub end_data_table_empty_row {
6105: return '</tr>'."\n";;
6106: }
6107:
1.367 www 6108: sub start_data_table_header_row {
1.389 albertel 6109: return '<tr class="LC_header_row">'."\n";;
1.367 www 6110: }
6111:
6112: sub end_data_table_header_row {
1.389 albertel 6113: return '</tr>'."\n";;
1.367 www 6114: }
1.347 albertel 6115: }
6116:
1.548 albertel 6117: =pod
6118:
6119: =item * &inhibit_menu_check($arg)
6120:
6121: Checks for a inhibitmenu state and generates output to preserve it
6122:
6123: Inputs: $arg - can be any of
6124: - undef - in which case the return value is a string
6125: to add into arguments list of a uri
6126: - 'input' - in which case the return value is a HTML
6127: <form> <input> field of type hidden to
6128: preserve the value
6129: - a url - in which case the return value is the url with
6130: the neccesary cgi args added to preserve the
6131: inhibitmenu state
6132: - a ref to a url - no return value, but the string is
6133: updated to include the neccessary cgi
6134: args to preserve the inhibitmenu state
6135:
6136: =cut
6137:
6138: sub inhibit_menu_check {
6139: my ($arg) = @_;
6140: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6141: if ($arg eq 'input') {
6142: if ($env{'form.inhibitmenu'}) {
6143: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
6144: } else {
6145: return
6146: }
6147: }
6148: if ($env{'form.inhibitmenu'}) {
6149: if (ref($arg)) {
6150: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6151: } elsif ($arg eq '') {
6152: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
6153: } else {
6154: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6155: }
6156: }
6157: if (!ref($arg)) {
6158: return $arg;
6159: }
6160: }
6161:
1.251 albertel 6162: ###############################################
1.182 matthew 6163:
6164: =pod
6165:
1.549 albertel 6166: =back
6167:
6168: =head1 User Information Routines
6169:
6170: =over 4
6171:
1.405 albertel 6172: =item * &get_users_function()
1.182 matthew 6173:
6174: Used by &bodytag to determine the current users primary role.
6175: Returns either 'student','coordinator','admin', or 'author'.
6176:
6177: =cut
6178:
6179: ###############################################
6180: sub get_users_function {
6181: my $function = 'student';
1.258 albertel 6182: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 6183: $function='coordinator';
6184: }
1.258 albertel 6185: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 6186: $function='admin';
6187: }
1.692.4.5 raeburn 6188: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182 matthew 6189: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
6190: $function='author';
6191: }
6192: return $function;
1.54 www 6193: }
1.99 www 6194:
6195: ###############################################
6196:
1.233 raeburn 6197: =pod
6198:
1.692.4.2 raeburn 6199: =item * &show_course()
6200:
6201: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
6202: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
6203: Inputs:
6204: None
6205:
6206: Outputs:
6207: Scalar: 1 if 'Course' to be used, 0 otherwise.
6208:
6209: =cut
6210:
6211: ###############################################
6212: sub show_course {
6213: my $course = !$env{'user.adv'};
6214: if (!$env{'user.adv'}) {
6215: foreach my $env (keys(%env)) {
6216: next if ($env !~ m/^user\.priv\./);
6217: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
6218: $course = 0;
6219: last;
6220: }
6221: }
6222: }
6223: return $course;
6224: }
6225:
6226: ###############################################
6227:
6228: =pod
6229:
1.542 raeburn 6230: =item * &check_user_status()
1.274 raeburn 6231:
6232: Determines current status of supplied role for a
6233: specific user. Roles can be active, previous or future.
6234:
6235: Inputs:
6236: user's domain, user's username, course's domain,
1.375 raeburn 6237: course's number, optional section ID.
1.274 raeburn 6238:
6239: Outputs:
6240: role status: active, previous or future.
6241:
6242: =cut
6243:
6244: sub check_user_status {
1.412 raeburn 6245: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 6246: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
6247: my @uroles = keys %userinfo;
6248: my $srchstr;
6249: my $active_chk = 'none';
1.412 raeburn 6250: my $now = time;
1.274 raeburn 6251: if (@uroles > 0) {
1.412 raeburn 6252: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 6253: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
6254: } else {
1.412 raeburn 6255: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
6256: }
6257: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 6258: my $role_end = 0;
6259: my $role_start = 0;
6260: $active_chk = 'active';
1.412 raeburn 6261: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
6262: $role_end = $1;
6263: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
6264: $role_start = $1;
1.274 raeburn 6265: }
6266: }
6267: if ($role_start > 0) {
1.412 raeburn 6268: if ($now < $role_start) {
1.274 raeburn 6269: $active_chk = 'future';
6270: }
6271: }
6272: if ($role_end > 0) {
1.412 raeburn 6273: if ($now > $role_end) {
1.274 raeburn 6274: $active_chk = 'previous';
6275: }
6276: }
6277: }
6278: }
6279: return $active_chk;
6280: }
6281:
6282: ###############################################
6283:
6284: =pod
6285:
1.405 albertel 6286: =item * &get_sections()
1.233 raeburn 6287:
6288: Determines all the sections for a course including
6289: sections with students and sections containing other roles.
1.419 raeburn 6290: Incoming parameters:
6291:
6292: 1. domain
6293: 2. course number
6294: 3. reference to array containing roles for which sections should
6295: be gathered (optional).
6296: 4. reference to array containing status types for which sections
6297: should be gathered (optional).
6298:
6299: If the third argument is undefined, sections are gathered for any role.
6300: If the fourth argument is undefined, sections are gathered for any status.
6301: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 6302:
1.374 raeburn 6303: Returns section hash (keys are section IDs, values are
6304: number of users in each section), subject to the
1.419 raeburn 6305: optional roles filter, optional status filter
1.233 raeburn 6306:
6307: =cut
6308:
6309: ###############################################
6310: sub get_sections {
1.419 raeburn 6311: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 6312: if (!defined($cdom) || !defined($cnum)) {
6313: my $cid = $env{'request.course.id'};
6314:
6315: return if (!defined($cid));
6316:
6317: $cdom = $env{'course.'.$cid.'.domain'};
6318: $cnum = $env{'course.'.$cid.'.num'};
6319: }
6320:
6321: my %sectioncount;
1.419 raeburn 6322: my $now = time;
1.240 albertel 6323:
1.366 albertel 6324: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 6325: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 6326: my $sec_index = &Apache::loncoursedata::CL_SECTION();
6327: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 6328: my $start_index = &Apache::loncoursedata::CL_START();
6329: my $end_index = &Apache::loncoursedata::CL_END();
6330: my $status;
1.366 albertel 6331: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 6332: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
6333: $data->[$status_index],
6334: $data->[$start_index],
6335: $data->[$end_index]);
6336: if ($stu_status eq 'Active') {
6337: $status = 'active';
6338: } elsif ($end < $now) {
6339: $status = 'previous';
6340: } elsif ($start > $now) {
6341: $status = 'future';
6342: }
6343: if ($section ne '-1' && $section !~ /^\s*$/) {
6344: if ((!defined($possible_status)) || (($status ne '') &&
6345: (grep/^\Q$status\E$/,@{$possible_status}))) {
6346: $sectioncount{$section}++;
6347: }
1.240 albertel 6348: }
6349: }
6350: }
6351: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6352: foreach my $user (sort(keys(%courseroles))) {
6353: if ($user !~ /^(\w{2})/) { next; }
6354: my ($role) = ($user =~ /^(\w{2})/);
6355: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 6356: my ($section,$status);
1.240 albertel 6357: if ($role eq 'cr' &&
6358: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
6359: $section=$1;
6360: }
6361: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
6362: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 6363: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
6364: if ($end == -1 && $start == -1) {
6365: next; #deleted role
6366: }
6367: if (!defined($possible_status)) {
6368: $sectioncount{$section}++;
6369: } else {
6370: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
6371: $status = 'active';
6372: } elsif ($end < $now) {
6373: $status = 'future';
6374: } elsif ($start > $now) {
6375: $status = 'previous';
6376: }
6377: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
6378: $sectioncount{$section}++;
6379: }
6380: }
1.233 raeburn 6381: }
1.366 albertel 6382: return %sectioncount;
1.233 raeburn 6383: }
6384:
1.274 raeburn 6385: ###############################################
1.294 raeburn 6386:
6387: =pod
1.405 albertel 6388:
6389: =item * &get_course_users()
6390:
1.275 raeburn 6391: Retrieves usernames:domains for users in the specified course
6392: with specific role(s), and access status.
6393:
6394: Incoming parameters:
1.277 albertel 6395: 1. course domain
6396: 2. course number
6397: 3. access status: users must have - either active,
1.275 raeburn 6398: previous, future, or all.
1.277 albertel 6399: 4. reference to array of permissible roles
1.288 raeburn 6400: 5. reference to array of section restrictions (optional)
6401: 6. reference to results object (hash of hashes).
6402: 7. reference to optional userdata hash
1.609 raeburn 6403: 8. reference to optional statushash
1.630 raeburn 6404: 9. flag if privileged users (except those set to unhide in
6405: course settings) should be excluded
1.609 raeburn 6406: Keys of top level results hash are roles.
1.275 raeburn 6407: Keys of inner hashes are username:domain, with
6408: values set to access type.
1.288 raeburn 6409: Optional userdata hash returns an array with arguments in the
6410: same order as loncoursedata::get_classlist() for student data.
6411:
1.609 raeburn 6412: Optional statushash returns
6413:
1.288 raeburn 6414: Entries for end, start, section and status are blank because
6415: of the possibility of multiple values for non-student roles.
6416:
1.275 raeburn 6417: =cut
1.405 albertel 6418:
1.275 raeburn 6419: ###############################################
1.405 albertel 6420:
1.275 raeburn 6421: sub get_course_users {
1.630 raeburn 6422: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 6423: my %idx = ();
1.419 raeburn 6424: my %seclists;
1.288 raeburn 6425:
6426: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
6427: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
6428: $idx{end} = &Apache::loncoursedata::CL_END();
6429: $idx{start} = &Apache::loncoursedata::CL_START();
6430: $idx{id} = &Apache::loncoursedata::CL_ID();
6431: $idx{section} = &Apache::loncoursedata::CL_SECTION();
6432: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
6433: $idx{status} = &Apache::loncoursedata::CL_STATUS();
6434:
1.290 albertel 6435: if (grep(/^st$/,@{$roles})) {
1.276 albertel 6436: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 6437: my $now = time;
1.277 albertel 6438: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 6439: my $match = 0;
1.412 raeburn 6440: my $secmatch = 0;
1.419 raeburn 6441: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 6442: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 6443: if ($section eq '') {
6444: $section = 'none';
6445: }
1.291 albertel 6446: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6447: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6448: $secmatch = 1;
6449: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 6450: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6451: $secmatch = 1;
6452: }
6453: } else {
1.419 raeburn 6454: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 6455: $secmatch = 1;
6456: }
1.290 albertel 6457: }
1.412 raeburn 6458: if (!$secmatch) {
6459: next;
6460: }
1.419 raeburn 6461: }
1.275 raeburn 6462: if (defined($$types{'active'})) {
1.288 raeburn 6463: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 6464: push(@{$$users{st}{$student}},'active');
1.288 raeburn 6465: $match = 1;
1.275 raeburn 6466: }
6467: }
6468: if (defined($$types{'previous'})) {
1.609 raeburn 6469: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 6470: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 6471: $match = 1;
1.275 raeburn 6472: }
6473: }
6474: if (defined($$types{'future'})) {
1.609 raeburn 6475: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 6476: push(@{$$users{st}{$student}},'future');
1.288 raeburn 6477: $match = 1;
1.275 raeburn 6478: }
6479: }
1.609 raeburn 6480: if ($match) {
6481: push(@{$seclists{$student}},$section);
6482: if (ref($userdata) eq 'HASH') {
6483: $$userdata{$student} = $$classlist{$student};
6484: }
6485: if (ref($statushash) eq 'HASH') {
6486: $statushash->{$student}{'st'}{$section} = $status;
6487: }
1.288 raeburn 6488: }
1.275 raeburn 6489: }
6490: }
1.412 raeburn 6491: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 6492: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6493: my $now = time;
1.609 raeburn 6494: my %displaystatus = ( previous => 'Expired',
6495: active => 'Active',
6496: future => 'Future',
6497: );
1.630 raeburn 6498: my %nothide;
6499: if ($hidepriv) {
6500: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
6501: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
6502: if ($user !~ /:/) {
6503: $nothide{join(':',split(/[\@]/,$user))}=1;
6504: } else {
6505: $nothide{$user} = 1;
6506: }
6507: }
6508: }
1.439 raeburn 6509: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 6510: my $match = 0;
1.412 raeburn 6511: my $secmatch = 0;
1.439 raeburn 6512: my $status;
1.412 raeburn 6513: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 6514: $user =~ s/:$//;
1.439 raeburn 6515: my ($end,$start) = split(/:/,$coursepersonnel{$person});
6516: if ($end == -1 || $start == -1) {
6517: next;
6518: }
6519: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
6520: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 6521: my ($uname,$udom) = split(/:/,$user);
6522: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6523: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6524: $secmatch = 1;
6525: } elsif ($usec eq '') {
1.420 albertel 6526: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6527: $secmatch = 1;
6528: }
6529: } else {
6530: if (grep(/^\Q$usec\E$/,@{$sections})) {
6531: $secmatch = 1;
6532: }
6533: }
6534: if (!$secmatch) {
6535: next;
6536: }
1.288 raeburn 6537: }
1.419 raeburn 6538: if ($usec eq '') {
6539: $usec = 'none';
6540: }
1.275 raeburn 6541: if ($uname ne '' && $udom ne '') {
1.630 raeburn 6542: if ($hidepriv) {
6543: if ((&Apache::lonnet::privileged($uname,$udom)) &&
6544: (!$nothide{$uname.':'.$udom})) {
6545: next;
6546: }
6547: }
1.503 raeburn 6548: if ($end > 0 && $end < $now) {
1.439 raeburn 6549: $status = 'previous';
6550: } elsif ($start > $now) {
6551: $status = 'future';
6552: } else {
6553: $status = 'active';
6554: }
1.277 albertel 6555: foreach my $type (keys(%{$types})) {
1.275 raeburn 6556: if ($status eq $type) {
1.420 albertel 6557: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 6558: push(@{$$users{$role}{$user}},$type);
6559: }
1.288 raeburn 6560: $match = 1;
6561: }
6562: }
1.419 raeburn 6563: if (($match) && (ref($userdata) eq 'HASH')) {
6564: if (!exists($$userdata{$uname.':'.$udom})) {
6565: &get_user_info($udom,$uname,\%idx,$userdata);
6566: }
1.420 albertel 6567: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 6568: push(@{$seclists{$uname.':'.$udom}},$usec);
6569: }
1.609 raeburn 6570: if (ref($statushash) eq 'HASH') {
6571: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
6572: }
1.275 raeburn 6573: }
6574: }
6575: }
6576: }
1.290 albertel 6577: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 6578: if ((defined($cdom)) && (defined($cnum))) {
6579: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
6580: if ( defined($csettings{'internal.courseowner'}) ) {
6581: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 6582: next if ($owner eq '');
6583: my ($ownername,$ownerdom);
6584: if ($owner =~ /^([^:]+):([^:]+)$/) {
6585: $ownername = $1;
6586: $ownerdom = $2;
6587: } else {
6588: $ownername = $owner;
6589: $ownerdom = $cdom;
6590: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 6591: }
6592: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 6593: if (defined($userdata) &&
1.609 raeburn 6594: !exists($$userdata{$owner})) {
6595: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
6596: if (!grep(/^none$/,@{$seclists{$owner}})) {
6597: push(@{$seclists{$owner}},'none');
6598: }
6599: if (ref($statushash) eq 'HASH') {
6600: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 6601: }
1.290 albertel 6602: }
1.279 raeburn 6603: }
6604: }
6605: }
1.419 raeburn 6606: foreach my $user (keys(%seclists)) {
6607: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6608: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6609: }
1.275 raeburn 6610: }
6611: return;
6612: }
6613:
1.288 raeburn 6614: sub get_user_info {
6615: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6616: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6617: &plainname($uname,$udom,'lastname');
1.291 albertel 6618: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6619: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6620: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6621: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6622: return;
6623: }
1.275 raeburn 6624:
1.472 raeburn 6625: ###############################################
6626:
6627: =pod
6628:
6629: =item * &get_user_quota()
6630:
6631: Retrieves quota assigned for storage of portfolio files for a user
6632:
6633: Incoming parameters:
6634: 1. user's username
6635: 2. user's domain
6636:
6637: Returns:
1.536 raeburn 6638: 1. Disk quota (in Mb) assigned to student.
6639: 2. (Optional) Type of setting: custom or default
6640: (individually assigned or default for user's
6641: institutional status).
6642: 3. (Optional) - User's institutional status (e.g., faculty, staff
6643: or student - types as defined in localenroll::inst_usertypes
6644: for user's domain, which determines default quota for user.
6645: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6646:
6647: If a value has been stored in the user's environment,
1.536 raeburn 6648: it will return that, otherwise it returns the maximal default
6649: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6650:
6651: =cut
6652:
6653: ###############################################
6654:
6655:
6656: sub get_user_quota {
6657: my ($uname,$udom) = @_;
1.536 raeburn 6658: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6659: if (!defined($udom)) {
6660: $udom = $env{'user.domain'};
6661: }
6662: if (!defined($uname)) {
6663: $uname = $env{'user.name'};
6664: }
6665: if (($udom eq '' || $uname eq '') ||
6666: ($udom eq 'public') && ($uname eq 'public')) {
6667: $quota = 0;
1.536 raeburn 6668: $quotatype = 'default';
6669: $defquota = 0;
1.472 raeburn 6670: } else {
1.536 raeburn 6671: my $inststatus;
1.472 raeburn 6672: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6673: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6674: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6675: } else {
1.536 raeburn 6676: my %userenv =
6677: &Apache::lonnet::get('environment',['portfolioquota',
6678: 'inststatus'],$udom,$uname);
1.472 raeburn 6679: my ($tmp) = keys(%userenv);
6680: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6681: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6682: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6683: } else {
6684: undef(%userenv);
6685: }
6686: }
1.536 raeburn 6687: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6688: if ($quota eq '') {
1.536 raeburn 6689: $quota = $defquota;
6690: $quotatype = 'default';
6691: } else {
6692: $quotatype = 'custom';
1.472 raeburn 6693: }
6694: }
1.536 raeburn 6695: if (wantarray) {
6696: return ($quota,$quotatype,$settingstatus,$defquota);
6697: } else {
6698: return $quota;
6699: }
1.472 raeburn 6700: }
6701:
6702: ###############################################
6703:
6704: =pod
6705:
6706: =item * &default_quota()
6707:
1.536 raeburn 6708: Retrieves default quota assigned for storage of user portfolio files,
6709: given an (optional) user's institutional status.
1.472 raeburn 6710:
6711: Incoming parameters:
6712: 1. domain
1.536 raeburn 6713: 2. (Optional) institutional status(es). This is a : separated list of
6714: status types (e.g., faculty, staff, student etc.)
6715: which apply to the user for whom the default is being retrieved.
6716: If the institutional status string in undefined, the domain
6717: default quota will be returned.
1.472 raeburn 6718:
6719: Returns:
6720: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6721: 2. (Optional) institutional type which determined the value of the
6722: default quota.
1.472 raeburn 6723:
6724: If a value has been stored in the domain's configuration db,
6725: it will return that, otherwise it returns 20 (for backwards
6726: compatibility with domains which have not set up a configuration
6727: db file; the original statically defined portfolio quota was 20 Mb).
6728:
1.536 raeburn 6729: If the user's status includes multiple types (e.g., staff and student),
6730: the largest default quota which applies to the user determines the
6731: default quota returned.
6732:
1.472 raeburn 6733: =cut
6734:
6735: ###############################################
6736:
6737:
6738: sub default_quota {
1.536 raeburn 6739: my ($udom,$inststatus) = @_;
6740: my ($defquota,$settingstatus);
6741: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 6742: ['quotas'],$udom);
6743: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 6744: if ($inststatus ne '') {
1.692.4.2 raeburn 6745: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 6746: foreach my $item (@statuses) {
1.692.4.2 raeburn 6747: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6748: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
6749: if ($defquota eq '') {
6750: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6751: $settingstatus = $item;
6752: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
6753: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6754: $settingstatus = $item;
6755: }
6756: }
6757: } else {
6758: if ($quotahash{'quotas'}{$item} ne '') {
6759: if ($defquota eq '') {
6760: $defquota = $quotahash{'quotas'}{$item};
6761: $settingstatus = $item;
6762: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
6763: $defquota = $quotahash{'quotas'}{$item};
6764: $settingstatus = $item;
6765: }
1.536 raeburn 6766: }
6767: }
6768: }
6769: }
6770: if ($defquota eq '') {
1.692.4.2 raeburn 6771: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6772: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
6773: } else {
6774: $defquota = $quotahash{'quotas'}{'default'};
6775: }
1.536 raeburn 6776: $settingstatus = 'default';
6777: }
6778: } else {
6779: $settingstatus = 'default';
6780: $defquota = 20;
6781: }
6782: if (wantarray) {
6783: return ($defquota,$settingstatus);
1.472 raeburn 6784: } else {
1.536 raeburn 6785: return $defquota;
1.472 raeburn 6786: }
6787: }
6788:
1.384 raeburn 6789: sub get_secgrprole_info {
6790: my ($cdom,$cnum,$needroles,$type) = @_;
6791: my %sections_count = &get_sections($cdom,$cnum);
6792: my @sections = (sort {$a <=> $b} keys(%sections_count));
6793: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6794: my @groups = sort(keys(%curr_groups));
6795: my $allroles = [];
6796: my $rolehash;
6797: my $accesshash = {
6798: active => 'Currently has access',
6799: future => 'Will have future access',
6800: previous => 'Previously had access',
6801: };
6802: if ($needroles) {
6803: $rolehash = {'all' => 'all'};
1.385 albertel 6804: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6805: if (&Apache::lonnet::error(%user_roles)) {
6806: undef(%user_roles);
6807: }
6808: foreach my $item (keys(%user_roles)) {
1.384 raeburn 6809: my ($role)=split(/\:/,$item,2);
6810: if ($role eq 'cr') { next; }
6811: if ($role =~ /^cr/) {
6812: $$rolehash{$role} = (split('/',$role))[3];
6813: } else {
6814: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
6815: }
6816: }
6817: foreach my $key (sort(keys(%{$rolehash}))) {
6818: push(@{$allroles},$key);
6819: }
6820: push (@{$allroles},'st');
6821: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
6822: }
6823: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
6824: }
6825:
1.555 raeburn 6826: sub user_picker {
1.627 raeburn 6827: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 6828: my $currdom = $dom;
6829: my %curr_selected = (
6830: srchin => 'dom',
1.580 raeburn 6831: srchby => 'lastname',
1.555 raeburn 6832: );
6833: my $srchterm;
1.625 raeburn 6834: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 6835: if ($srch->{'srchby'} ne '') {
6836: $curr_selected{'srchby'} = $srch->{'srchby'};
6837: }
6838: if ($srch->{'srchin'} ne '') {
6839: $curr_selected{'srchin'} = $srch->{'srchin'};
6840: }
6841: if ($srch->{'srchtype'} ne '') {
6842: $curr_selected{'srchtype'} = $srch->{'srchtype'};
6843: }
6844: if ($srch->{'srchdomain'} ne '') {
6845: $currdom = $srch->{'srchdomain'};
6846: }
6847: $srchterm = $srch->{'srchterm'};
6848: }
6849: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 6850: 'usr' => 'Search criteria',
1.563 raeburn 6851: 'doma' => 'Domain/institution to search',
1.558 albertel 6852: 'uname' => 'username',
6853: 'lastname' => 'last name',
1.555 raeburn 6854: 'lastfirst' => 'last name, first name',
1.558 albertel 6855: 'crs' => 'in this course',
1.576 raeburn 6856: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 6857: 'alc' => 'all LON-CAPA',
1.573 raeburn 6858: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 6859: 'exact' => 'is',
6860: 'contains' => 'contains',
1.569 raeburn 6861: 'begins' => 'begins with',
1.571 raeburn 6862: 'youm' => "You must include some text to search for.",
6863: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
6864: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
6865: 'yomc' => "You must choose a domain when using an institutional directory search.",
6866: 'ymcd' => "You must choose a domain when using a domain search.",
6867: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
6868: 'whse' => "When searching by last,first you must include at least one character in the first name.",
6869: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 6870: );
1.563 raeburn 6871: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
6872: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 6873:
6874: my @srchins = ('crs','dom','alc','instd');
6875:
6876: foreach my $option (@srchins) {
6877: # FIXME 'alc' option unavailable until
6878: # loncreateuser::print_user_query_page()
6879: # has been completed.
6880: next if ($option eq 'alc');
6881: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 6882: if ($curr_selected{'srchin'} eq $option) {
6883: $srchinsel .= '
6884: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6885: } else {
6886: $srchinsel .= '
6887: <option value="'.$option.'">'.$lt{$option}.'</option>';
6888: }
1.555 raeburn 6889: }
1.563 raeburn 6890: $srchinsel .= "\n </select>\n";
1.555 raeburn 6891:
6892: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 6893: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 6894: if ($curr_selected{'srchby'} eq $option) {
6895: $srchbysel .= '
6896: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6897: } else {
6898: $srchbysel .= '
6899: <option value="'.$option.'">'.$lt{$option}.'</option>';
6900: }
6901: }
6902: $srchbysel .= "\n </select>\n";
6903:
6904: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 6905: foreach my $option ('begins','contains','exact') {
1.555 raeburn 6906: if ($curr_selected{'srchtype'} eq $option) {
6907: $srchtypesel .= '
6908: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
6909: } else {
6910: $srchtypesel .= '
6911: <option value="'.$option.'">'.$lt{$option}.'</option>';
6912: }
6913: }
6914: $srchtypesel .= "\n </select>\n";
6915:
1.558 albertel 6916: my ($newuserscript,$new_user_create);
1.556 raeburn 6917:
6918: if ($forcenewuser) {
1.576 raeburn 6919: if (ref($srch) eq 'HASH') {
6920: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 6921: if ($cancreate) {
6922: $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>';
6923: } else {
1.692.4.2 raeburn 6924: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 6925: my %usertypetext = (
6926: official => 'institutional',
6927: unofficial => 'non-institutional',
6928: );
1.692.4.2 raeburn 6929: $new_user_create = '<p class="LC_warning">'.
6930: &mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.
6931: &mt('Please contact the [_1]helpdesk[_2] for assistance.','<a href="'.$helplink.'">','</a>').'</p><br />';
1.627 raeburn 6932: }
1.576 raeburn 6933: }
6934: }
6935:
1.556 raeburn 6936: $newuserscript = <<"ENDSCRIPT";
6937:
1.570 raeburn 6938: function setSearch(createnew,callingForm) {
1.556 raeburn 6939: if (createnew == 1) {
1.570 raeburn 6940: for (var i=0; i<callingForm.srchby.length; i++) {
6941: if (callingForm.srchby.options[i].value == 'uname') {
6942: callingForm.srchby.selectedIndex = i;
1.556 raeburn 6943: }
6944: }
1.570 raeburn 6945: for (var i=0; i<callingForm.srchin.length; i++) {
6946: if ( callingForm.srchin.options[i].value == 'dom') {
6947: callingForm.srchin.selectedIndex = i;
1.556 raeburn 6948: }
6949: }
1.570 raeburn 6950: for (var i=0; i<callingForm.srchtype.length; i++) {
6951: if (callingForm.srchtype.options[i].value == 'exact') {
6952: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 6953: }
6954: }
1.570 raeburn 6955: for (var i=0; i<callingForm.srchdomain.length; i++) {
6956: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
6957: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 6958: }
6959: }
6960: }
6961: }
6962: ENDSCRIPT
1.558 albertel 6963:
1.556 raeburn 6964: }
6965:
1.555 raeburn 6966: my $output = <<"END_BLOCK";
1.556 raeburn 6967: <script type="text/javascript">
1.692.4.4 raeburn 6968: // <![CDATA[
1.570 raeburn 6969: function validateEntry(callingForm) {
1.558 albertel 6970:
1.556 raeburn 6971: var checkok = 1;
1.558 albertel 6972: var srchin;
1.570 raeburn 6973: for (var i=0; i<callingForm.srchin.length; i++) {
6974: if ( callingForm.srchin[i].checked ) {
6975: srchin = callingForm.srchin[i].value;
1.558 albertel 6976: }
6977: }
6978:
1.570 raeburn 6979: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
6980: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
6981: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
6982: var srchterm = callingForm.srchterm.value;
6983: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 6984: var msg = "";
6985:
6986: if (srchterm == "") {
6987: checkok = 0;
1.571 raeburn 6988: msg += "$lt{'youm'}\\n";
1.556 raeburn 6989: }
6990:
1.569 raeburn 6991: if (srchtype== 'begins') {
6992: if (srchterm.length < 2) {
6993: checkok = 0;
1.571 raeburn 6994: msg += "$lt{'thte'}\\n";
1.569 raeburn 6995: }
6996: }
6997:
1.556 raeburn 6998: if (srchtype== 'contains') {
6999: if (srchterm.length < 3) {
7000: checkok = 0;
1.571 raeburn 7001: msg += "$lt{'thet'}\\n";
1.556 raeburn 7002: }
7003: }
7004: if (srchin == 'instd') {
7005: if (srchdomain == '') {
7006: checkok = 0;
1.571 raeburn 7007: msg += "$lt{'yomc'}\\n";
1.556 raeburn 7008: }
7009: }
7010: if (srchin == 'dom') {
7011: if (srchdomain == '') {
7012: checkok = 0;
1.571 raeburn 7013: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 7014: }
7015: }
7016: if (srchby == 'lastfirst') {
7017: if (srchterm.indexOf(",") == -1) {
7018: checkok = 0;
1.571 raeburn 7019: msg += "$lt{'whus'}\\n";
1.556 raeburn 7020: }
7021: if (srchterm.indexOf(",") == srchterm.length -1) {
7022: checkok = 0;
1.571 raeburn 7023: msg += "$lt{'whse'}\\n";
1.556 raeburn 7024: }
7025: }
7026: if (checkok == 0) {
1.571 raeburn 7027: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 7028: return;
7029: }
7030: if (checkok == 1) {
1.570 raeburn 7031: callingForm.submit();
1.556 raeburn 7032: }
7033: }
7034:
7035: $newuserscript
7036:
1.692.4.4 raeburn 7037: // ]]>
1.556 raeburn 7038: </script>
1.558 albertel 7039:
7040: $new_user_create
7041:
1.555 raeburn 7042: <table>
1.558 albertel 7043: <tr>
1.573 raeburn 7044: <td>$lt{'doma'}:</td>
7045: <td>$domform</td>
7046: </td>
7047: </tr>
7048: <tr>
7049: <td>$lt{'usr'}:</td>
1.563 raeburn 7050: <td>$srchbysel
7051: $srchtypesel
7052: <input type="text" size="15" name="srchterm" value="$srchterm" />
1.564 albertel 7053: $srchinsel
1.563 raeburn 7054: </td>
7055: </tr>
1.555 raeburn 7056: </table>
7057: <br />
7058: END_BLOCK
1.558 albertel 7059:
1.555 raeburn 7060: return $output;
7061: }
7062:
1.612 raeburn 7063: sub user_rule_check {
1.615 raeburn 7064: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 7065: my $response;
7066: if (ref($usershash) eq 'HASH') {
7067: foreach my $user (keys(%{$usershash})) {
7068: my ($uname,$udom) = split(/:/,$user);
7069: next if ($udom eq '' || $uname eq '');
1.615 raeburn 7070: my ($id,$newuser);
1.612 raeburn 7071: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 7072: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 7073: $id = $usershash->{$user}->{'id'};
7074: }
7075: my $inst_response;
7076: if (ref($checks) eq 'HASH') {
7077: if (defined($checks->{'username'})) {
1.615 raeburn 7078: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7079: &Apache::lonnet::get_instuser($udom,$uname);
7080: } elsif (defined($checks->{'id'})) {
1.615 raeburn 7081: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7082: &Apache::lonnet::get_instuser($udom,undef,$id);
7083: }
1.615 raeburn 7084: } else {
7085: ($inst_response,%{$inst_results->{$user}}) =
7086: &Apache::lonnet::get_instuser($udom,$uname);
7087: return;
1.612 raeburn 7088: }
1.615 raeburn 7089: if (!$got_rules->{$udom}) {
1.612 raeburn 7090: my %domconfig = &Apache::lonnet::get_dom('configuration',
7091: ['usercreation'],$udom);
7092: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 7093: foreach my $item ('username','id') {
1.612 raeburn 7094: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
7095: $$curr_rules{$udom}{$item} =
7096: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 7097: }
7098: }
7099: }
1.615 raeburn 7100: $got_rules->{$udom} = 1;
1.585 raeburn 7101: }
1.612 raeburn 7102: foreach my $item (keys(%{$checks})) {
7103: if (ref($$curr_rules{$udom}) eq 'HASH') {
7104: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
7105: if (@{$$curr_rules{$udom}{$item}} > 0) {
7106: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
7107: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
7108: if ($rule_check{$rule}) {
7109: $$rulematch{$user}{$item} = $rule;
7110: if ($inst_response eq 'ok') {
1.615 raeburn 7111: if (ref($inst_results) eq 'HASH') {
7112: if (ref($inst_results->{$user}) eq 'HASH') {
7113: if (keys(%{$inst_results->{$user}}) == 0) {
7114: $$alerts{$item}{$udom}{$uname} = 1;
7115: }
1.612 raeburn 7116: }
7117: }
1.615 raeburn 7118: }
7119: last;
1.585 raeburn 7120: }
7121: }
7122: }
7123: }
7124: }
7125: }
7126: }
7127: }
1.612 raeburn 7128: return;
7129: }
7130:
7131: sub user_rule_formats {
7132: my ($domain,$domdesc,$curr_rules,$check) = @_;
7133: my %text = (
7134: 'username' => 'Usernames',
7135: 'id' => 'IDs',
7136: );
7137: my $output;
7138: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
7139: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
7140: if (@{$ruleorder} > 0) {
7141: $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>';
7142: foreach my $rule (@{$ruleorder}) {
7143: if (ref($curr_rules) eq 'ARRAY') {
7144: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
7145: if (ref($rules->{$rule}) eq 'HASH') {
7146: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
7147: $rules->{$rule}{'desc'}.'</li>';
7148: }
7149: }
7150: }
7151: }
7152: $output .= '</ul>';
7153: }
7154: }
7155: return $output;
7156: }
7157:
7158: sub instrule_disallow_msg {
1.615 raeburn 7159: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 7160: my $response;
7161: my %text = (
7162: item => 'username',
7163: items => 'usernames',
7164: match => 'matches',
7165: do => 'does',
7166: action => 'a username',
7167: one => 'one',
7168: );
7169: if ($count > 1) {
7170: $text{'item'} = 'usernames';
7171: $text{'match'} ='match';
7172: $text{'do'} = 'do';
7173: $text{'action'} = 'usernames',
7174: $text{'one'} = 'ones';
7175: }
7176: if ($checkitem eq 'id') {
7177: $text{'items'} = 'IDs';
7178: $text{'item'} = 'ID';
7179: $text{'action'} = 'an ID';
1.615 raeburn 7180: if ($count > 1) {
7181: $text{'item'} = 'IDs';
7182: $text{'action'} = 'IDs';
7183: }
1.612 raeburn 7184: }
1.674 bisitz 7185: $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 7186: if ($mode eq 'upload') {
7187: if ($checkitem eq 'username') {
7188: $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'}.");
7189: } elsif ($checkitem eq 'id') {
1.674 bisitz 7190: $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 7191: }
1.669 raeburn 7192: } elsif ($mode eq 'selfcreate') {
7193: if ($checkitem eq 'id') {
7194: $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.");
7195: }
1.615 raeburn 7196: } else {
7197: if ($checkitem eq 'username') {
7198: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
7199: } elsif ($checkitem eq 'id') {
7200: $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.");
7201: }
1.612 raeburn 7202: }
7203: return $response;
1.585 raeburn 7204: }
7205:
1.624 raeburn 7206: sub personal_data_fieldtitles {
7207: my %fieldtitles = &Apache::lonlocal::texthash (
7208: id => 'Student/Employee ID',
7209: permanentemail => 'E-mail address',
7210: lastname => 'Last Name',
7211: firstname => 'First Name',
7212: middlename => 'Middle Name',
7213: generation => 'Generation',
7214: gen => 'Generation',
1.692.4.2 raeburn 7215: inststatus => 'Affiliation',
1.624 raeburn 7216: );
7217: return %fieldtitles;
7218: }
7219:
1.642 raeburn 7220: sub sorted_inst_types {
7221: my ($dom) = @_;
7222: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
7223: my $othertitle = &mt('All users');
7224: if ($env{'request.course.id'}) {
1.668 raeburn 7225: $othertitle = &mt('Any users');
1.642 raeburn 7226: }
7227: my @types;
7228: if (ref($order) eq 'ARRAY') {
7229: @types = @{$order};
7230: }
7231: if (@types == 0) {
7232: if (ref($usertypes) eq 'HASH') {
7233: @types = sort(keys(%{$usertypes}));
7234: }
7235: }
7236: if (keys(%{$usertypes}) > 0) {
7237: $othertitle = &mt('Other users');
7238: }
7239: return ($othertitle,$usertypes,\@types);
7240: }
7241:
1.645 raeburn 7242: sub get_institutional_codes {
7243: my ($settings,$allcourses,$LC_code) = @_;
7244: # Get complete list of course sections to update
7245: my @currsections = ();
7246: my @currxlists = ();
7247: my $coursecode = $$settings{'internal.coursecode'};
7248:
7249: if ($$settings{'internal.sectionnums'} ne '') {
7250: @currsections = split(/,/,$$settings{'internal.sectionnums'});
7251: }
7252:
7253: if ($$settings{'internal.crosslistings'} ne '') {
7254: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
7255: }
7256:
7257: if (@currxlists > 0) {
7258: foreach (@currxlists) {
7259: if (m/^([^:]+):(\w*)$/) {
7260: unless (grep/^$1$/,@{$allcourses}) {
7261: push @{$allcourses},$1;
7262: $$LC_code{$1} = $2;
7263: }
7264: }
7265: }
7266: }
7267:
7268: if (@currsections > 0) {
7269: foreach (@currsections) {
7270: if (m/^(\w+):(\w*)$/) {
7271: my $sec = $coursecode.$1;
7272: my $lc_sec = $2;
7273: unless (grep/^$sec$/,@{$allcourses}) {
7274: push @{$allcourses},$sec;
7275: $$LC_code{$sec} = $lc_sec;
7276: }
7277: }
7278: }
7279: }
7280: return;
7281: }
7282:
1.112 bowersj2 7283: =pod
7284:
1.692.4.2 raeburn 7285: =head1 Slot Helpers
7286:
7287: =over 4
7288:
7289: =item * sorted_slots()
7290:
7291: Sorts an array of slot names in order of slot start time (earliest first).
7292:
7293: Inputs:
7294:
7295: =over 4
7296:
7297: slotsarr - Reference to array of unsorted slot names.
7298:
7299: slots - Reference to hash of hash, where outer hash keys are slot names.
7300:
7301: =back
7302:
7303: Returns:
7304:
7305: =over 4
7306:
7307: sorted - An array of slot names sorted by the start time of the slot.
7308:
7309: =back
7310:
7311: =back
7312:
7313: =cut
7314:
7315:
7316: sub sorted_slots {
7317: my ($slotsarr,$slots) = @_;
7318: my @sorted;
7319: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
7320: @sorted =
7321: sort {
7322: if (ref($slots->{$a}) && ref($slots->{$b})) {
7323: return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
7324: }
7325: if (ref($slots->{$a})) { return -1;}
7326: if (ref($slots->{$b})) { return 1;}
7327: return 0;
7328: } @{$slotsarr};
7329: }
7330: return @sorted;
7331: }
7332:
7333: =pod
7334:
1.549 albertel 7335: =back
7336:
7337: =head1 HTTP Helpers
7338:
7339: =over 4
7340:
1.648 raeburn 7341: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 7342:
1.258 albertel 7343: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 7344: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 7345: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 7346:
7347: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
7348: $possible_names is an ref to an array of form element names. As an example:
7349: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 7350: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 7351:
7352: =cut
1.1 albertel 7353:
1.6 albertel 7354: sub get_unprocessed_cgi {
1.25 albertel 7355: my ($query,$possible_names)= @_;
1.26 matthew 7356: # $Apache::lonxml::debug=1;
1.356 albertel 7357: foreach my $pair (split(/&/,$query)) {
7358: my ($name, $value) = split(/=/,$pair);
1.369 www 7359: $name = &unescape($name);
1.25 albertel 7360: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
7361: $value =~ tr/+/ /;
7362: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 7363: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 7364: }
1.16 harris41 7365: }
1.6 albertel 7366: }
7367:
1.112 bowersj2 7368: =pod
7369:
1.648 raeburn 7370: =item * &cacheheader()
1.112 bowersj2 7371:
7372: returns cache-controlling header code
7373:
7374: =cut
7375:
1.7 albertel 7376: sub cacheheader {
1.258 albertel 7377: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 7378: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
7379: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 7380: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
7381: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 7382: return $output;
1.7 albertel 7383: }
7384:
1.112 bowersj2 7385: =pod
7386:
1.648 raeburn 7387: =item * &no_cache($r)
1.112 bowersj2 7388:
7389: specifies header code to not have cache
7390:
7391: =cut
7392:
1.9 albertel 7393: sub no_cache {
1.216 albertel 7394: my ($r) = @_;
7395: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 7396: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 7397: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
7398: $r->no_cache(1);
7399: $r->header_out("Expires" => $date);
7400: $r->header_out("Pragma" => "no-cache");
1.123 www 7401: }
7402:
7403: sub content_type {
1.181 albertel 7404: my ($r,$type,$charset) = @_;
1.299 foxr 7405: if ($r) {
7406: # Note that printout.pl calls this with undef for $r.
7407: &no_cache($r);
7408: }
1.258 albertel 7409: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 7410: unless ($charset) {
7411: $charset=&Apache::lonlocal::current_encoding;
7412: }
7413: if ($charset) { $type.='; charset='.$charset; }
7414: if ($r) {
7415: $r->content_type($type);
7416: } else {
7417: print("Content-type: $type\n\n");
7418: }
1.9 albertel 7419: }
1.25 albertel 7420:
1.112 bowersj2 7421: =pod
7422:
1.648 raeburn 7423: =item * &add_to_env($name,$value)
1.112 bowersj2 7424:
1.258 albertel 7425: adds $name to the %env hash with value
1.112 bowersj2 7426: $value, if $name already exists, the entry is converted to an array
7427: reference and $value is added to the array.
7428:
7429: =cut
7430:
1.25 albertel 7431: sub add_to_env {
7432: my ($name,$value)=@_;
1.258 albertel 7433: if (defined($env{$name})) {
7434: if (ref($env{$name})) {
1.25 albertel 7435: #already have multiple values
1.258 albertel 7436: push(@{ $env{$name} },$value);
1.25 albertel 7437: } else {
7438: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 7439: my $first=$env{$name};
7440: undef($env{$name});
7441: push(@{ $env{$name} },$first,$value);
1.25 albertel 7442: }
7443: } else {
1.258 albertel 7444: $env{$name}=$value;
1.25 albertel 7445: }
1.31 albertel 7446: }
1.149 albertel 7447:
7448: =pod
7449:
1.648 raeburn 7450: =item * &get_env_multiple($name)
1.149 albertel 7451:
1.258 albertel 7452: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 7453: values may be defined and end up as an array ref.
7454:
7455: returns an array of values
7456:
7457: =cut
7458:
7459: sub get_env_multiple {
7460: my ($name) = @_;
7461: my @values;
1.258 albertel 7462: if (defined($env{$name})) {
1.149 albertel 7463: # exists is it an array
1.258 albertel 7464: if (ref($env{$name})) {
7465: @values=@{ $env{$name} };
1.149 albertel 7466: } else {
1.258 albertel 7467: $values[0]=$env{$name};
1.149 albertel 7468: }
7469: }
7470: return(@values);
7471: }
7472:
1.660 raeburn 7473: sub ask_for_embedded_content {
7474: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
7475: my $upload_output = '
7476: <form name="upload_embedded" action="'.$actionurl.'"
7477: method="post" enctype="multipart/form-data">';
7478: $upload_output .= $state;
1.661 raeburn 7479: $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660 raeburn 7480:
7481: my $num = 0;
7482: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
7483: $upload_output .= &start_data_table_row().
7484: '<td>'.$embed_file.'</td><td>';
7485: if ($args->{'ignore_remote_references'}
7486: && $embed_file =~ m{^\w+://}) {
7487: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
7488: } elsif ($args->{'error_on_invalid_names'}
7489: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
7490:
7491: $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
7492:
7493: } else {
7494: $upload_output .='
1.661 raeburn 7495: <input name="embedded_item_'.$num.'" type="file" value="" />
1.660 raeburn 7496: <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
7497: my $attrib = join(':',@{$$allfiles{$embed_file}});
7498: $upload_output .=
7499: "\n\t\t".
7500: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
7501: $attrib.'" />';
7502: if (exists($$codebase{$embed_file})) {
7503: $upload_output .=
7504: "\n\t\t".
7505: '<input name="codebase_'.$num.'" type="hidden" value="'.
7506: &escape($$codebase{$embed_file}).'" />';
7507: }
7508: }
7509: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
7510: $num++;
7511: }
7512: $upload_output .= &Apache::loncommon::end_data_table().'<br />
7513: <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
7514: <input type ="submit" value="'.&mt('Upload Listed Files').'" />
7515: '.&mt('(only files for which a location has been provided will be uploaded)').'
7516: </form>';
7517: return $upload_output;
7518: }
7519:
1.661 raeburn 7520: sub upload_embedded {
7521: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
7522: $current_disk_usage) = @_;
7523: my $output;
7524: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
7525: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
7526: my $orig_uploaded_filename =
7527: $env{'form.embedded_item_'.$i.'.filename'};
7528:
7529: $env{'form.embedded_orig_'.$i} =
7530: &unescape($env{'form.embedded_orig_'.$i});
7531: my ($path,$fname) =
7532: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
7533: # no path, whole string is fname
7534: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
7535:
7536: $path = $env{'form.currentpath'}.$path;
7537: $fname = &Apache::lonnet::clean_filename($fname);
7538: # See if there is anything left
7539: next if ($fname eq '');
7540:
7541: # Check if file already exists as a file or directory.
7542: my ($state,$msg);
7543: if ($context eq 'portfolio') {
7544: my $port_path = $dirpath;
7545: if ($group ne '') {
7546: $port_path = "groups/$group/$port_path";
7547: }
7548: ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
7549: $dir_root,$port_path,$disk_quota,
7550: $current_disk_usage,$uname,$udom);
7551: if ($state eq 'will_exceed_quota'
7552: || $state eq 'file_locked'
7553: || $state eq 'file_exists' ) {
7554: $output .= $msg;
7555: next;
7556: }
7557: } elsif (($context eq 'author') || ($context eq 'testbank')) {
7558: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
7559: if ($state eq 'exists') {
7560: $output .= $msg;
7561: next;
7562: }
7563: }
7564: # Check if extension is valid
7565: if (($fname =~ /\.(\w+)$/) &&
7566: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
7567: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
7568: next;
7569: } elsif (($fname =~ /\.(\w+)$/) &&
7570: (!defined(&Apache::loncommon::fileembstyle($1)))) {
7571: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
7572: next;
7573: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
7574: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
7575: next;
7576: }
7577:
7578: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
7579: if ($context eq 'portfolio') {
7580: my $result=
7581: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
7582: $dirpath.$path);
7583: if ($result !~ m|^/uploaded/|) {
7584: $output .= '<span class="LC_error">'
7585: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
7586: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
7587: .'</span><br />';
7588: next;
7589: } else {
7590: $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
7591: $path.$fname.'</span>').'</p>';
7592: }
7593: } else {
7594: # Save the file
7595: my $target = $env{'form.embedded_item_'.$i};
7596: my $fullpath = $dir_root.$dirpath.'/'.$path;
7597: my $dest = $fullpath.$fname;
7598: my $url = $url_root.$dirpath.'/'.$path.$fname;
7599: my @parts=split(/\//,$fullpath);
7600: my $count;
7601: my $filepath = $dir_root;
7602: for ($count=4;$count<=$#parts;$count++) {
7603: $filepath .= "/$parts[$count]";
7604: if ((-e $filepath)!=1) {
7605: mkdir($filepath,0770);
7606: }
7607: }
7608: my $fh;
7609: if (!open($fh,'>'.$dest)) {
7610: &Apache::lonnet::logthis('Failed to create '.$dest);
7611: $output .= '<span class="LC_error">'.
7612: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7613: '</span><br />';
7614: } else {
7615: if (!print $fh $env{'form.embedded_item_'.$i}) {
7616: &Apache::lonnet::logthis('Failed to write to '.$dest);
7617: $output .= '<span class="LC_error">'.
7618: &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7619: '</span><br />';
7620: } else {
7621: if ($context eq 'testbank') {
7622: $output .= &mt('Embedded file uploaded successfully:').
7623: ' <a href="'.$url.'">'.
7624: $orig_uploaded_filename.'</a><br />';
7625: } else {
7626: $output .= '<font size="+2">'.
7627: &mt('View embedded file: [_1]','<a href="'.$url.'">'.
7628: $orig_uploaded_filename.'</a>').'</font><br />';
7629: }
7630: }
7631: close($fh);
7632: }
7633: }
7634: }
7635: return $output;
7636: }
7637:
7638: sub check_for_existing {
7639: my ($path,$fname,$element) = @_;
7640: my ($state,$msg);
7641: if (-d $path.'/'.$fname) {
7642: $state = 'exists';
7643: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7644: } elsif (-e $path.'/'.$fname) {
7645: $state = 'exists';
7646: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7647: }
7648: if ($state eq 'exists') {
7649: $msg = '<span class="LC_error">'.$msg.'</span><br />';
7650: }
7651: return ($state,$msg);
7652: }
7653:
7654: sub check_for_upload {
7655: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
7656: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
7657: my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
7658: my $getpropath = 1;
7659: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
7660: $getpropath);
7661: my $found_file = 0;
7662: my $locked_file = 0;
7663: foreach my $line (@dir_list) {
7664: my ($file_name)=split(/\&/,$line,2);
7665: if ($file_name eq $fname){
7666: $file_name = $path.$file_name;
7667: if ($group ne '') {
7668: $file_name = $group.$file_name;
7669: }
7670: $found_file = 1;
7671: if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
7672: $locked_file = 1;
7673: }
7674: }
7675: }
7676: if (($current_disk_usage + $filesize) > $disk_quota){
7677: my $msg = '<span class="LC_error">'.
7678: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
7679: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
7680: return ('will_exceed_quota',$msg);
7681: } elsif ($found_file) {
7682: if ($locked_file) {
7683: my $msg = '<span class="LC_error">';
7684: $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>');
7685: $msg .= '</span><br />';
7686: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
7687: return ('file_locked',$msg);
7688: } else {
7689: my $msg = '<span class="LC_error">';
7690: $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'});
7691: $msg .= '</span>';
7692: $msg .= '<br />';
7693: $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
7694: return ('file_exists',$msg);
7695: }
7696: }
7697: }
7698:
1.31 albertel 7699:
1.41 ng 7700: =pod
1.45 matthew 7701:
1.464 albertel 7702: =back
1.41 ng 7703:
1.112 bowersj2 7704: =head1 CSV Upload/Handling functions
1.38 albertel 7705:
1.41 ng 7706: =over 4
7707:
1.648 raeburn 7708: =item * &upfile_store($r)
1.41 ng 7709:
7710: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 7711: needs $env{'form.upfile'}
1.41 ng 7712: returns $datatoken to be put into hidden field
7713:
7714: =cut
1.31 albertel 7715:
7716: sub upfile_store {
7717: my $r=shift;
1.258 albertel 7718: $env{'form.upfile'}=~s/\r/\n/gs;
7719: $env{'form.upfile'}=~s/\f/\n/gs;
7720: $env{'form.upfile'}=~s/\n+/\n/gs;
7721: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 7722:
1.258 albertel 7723: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
7724: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 7725: {
1.158 raeburn 7726: my $datafile = $r->dir_config('lonDaemons').
7727: '/tmp/'.$datatoken.'.tmp';
7728: if ( open(my $fh,">$datafile") ) {
1.258 albertel 7729: print $fh $env{'form.upfile'};
1.158 raeburn 7730: close($fh);
7731: }
1.31 albertel 7732: }
7733: return $datatoken;
7734: }
7735:
1.56 matthew 7736: =pod
7737:
1.648 raeburn 7738: =item * &load_tmp_file($r)
1.41 ng 7739:
7740: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 7741: needs $env{'form.datatoken'},
7742: sets $env{'form.upfile'} to the contents of the file
1.41 ng 7743:
7744: =cut
1.31 albertel 7745:
7746: sub load_tmp_file {
7747: my $r=shift;
7748: my @studentdata=();
7749: {
1.158 raeburn 7750: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 7751: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 7752: if ( open(my $fh,"<$studentfile") ) {
7753: @studentdata=<$fh>;
7754: close($fh);
7755: }
1.31 albertel 7756: }
1.258 albertel 7757: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 7758: }
7759:
1.56 matthew 7760: =pod
7761:
1.648 raeburn 7762: =item * &upfile_record_sep()
1.41 ng 7763:
7764: Separate uploaded file into records
7765: returns array of records,
1.258 albertel 7766: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 7767:
7768: =cut
1.31 albertel 7769:
7770: sub upfile_record_sep {
1.258 albertel 7771: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 7772: } else {
1.248 albertel 7773: my @records;
1.258 albertel 7774: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 7775: if ($line=~/^\s*$/) { next; }
7776: push(@records,$line);
7777: }
7778: return @records;
1.31 albertel 7779: }
7780: }
7781:
1.56 matthew 7782: =pod
7783:
1.648 raeburn 7784: =item * &record_sep($record)
1.41 ng 7785:
1.258 albertel 7786: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 7787:
7788: =cut
7789:
1.263 www 7790: sub takeleft {
7791: my $index=shift;
7792: return substr('0000'.$index,-4,4);
7793: }
7794:
1.31 albertel 7795: sub record_sep {
7796: my $record=shift;
7797: my %components=();
1.258 albertel 7798: if ($env{'form.upfiletype'} eq 'xml') {
7799: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 7800: my $i=0;
1.356 albertel 7801: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 7802: $field=~s/^(\"|\')//;
7803: $field=~s/(\"|\')$//;
1.263 www 7804: $components{&takeleft($i)}=$field;
1.31 albertel 7805: $i++;
7806: }
1.258 albertel 7807: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 7808: my $i=0;
1.356 albertel 7809: foreach my $field (split(/\t/,$record)) {
1.31 albertel 7810: $field=~s/^(\"|\')//;
7811: $field=~s/(\"|\')$//;
1.263 www 7812: $components{&takeleft($i)}=$field;
1.31 albertel 7813: $i++;
7814: }
7815: } else {
1.561 www 7816: my $separator=',';
1.480 banghart 7817: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 7818: $separator=';';
1.480 banghart 7819: }
1.31 albertel 7820: my $i=0;
1.561 www 7821: # the character we are looking for to indicate the end of a quote or a record
7822: my $looking_for=$separator;
7823: # do not add the characters to the fields
7824: my $ignore=0;
7825: # we just encountered a separator (or the beginning of the record)
7826: my $just_found_separator=1;
7827: # store the field we are working on here
7828: my $field='';
7829: # work our way through all characters in record
7830: foreach my $character ($record=~/(.)/g) {
7831: if ($character eq $looking_for) {
7832: if ($character ne $separator) {
7833: # Found the end of a quote, again looking for separator
7834: $looking_for=$separator;
7835: $ignore=1;
7836: } else {
7837: # Found a separator, store away what we got
7838: $components{&takeleft($i)}=$field;
7839: $i++;
7840: $just_found_separator=1;
7841: $ignore=0;
7842: $field='';
7843: }
7844: next;
7845: }
7846: # single or double quotation marks after a separator indicate beginning of a quote
7847: # we are now looking for the end of the quote and need to ignore separators
7848: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
7849: $looking_for=$character;
7850: next;
7851: }
7852: # ignore would be true after we reached the end of a quote
7853: if ($ignore) { next; }
7854: if (($just_found_separator) && ($character=~/\s/)) { next; }
7855: $field.=$character;
7856: $just_found_separator=0;
1.31 albertel 7857: }
1.561 www 7858: # catch the very last entry, since we never encountered the separator
7859: $components{&takeleft($i)}=$field;
1.31 albertel 7860: }
7861: return %components;
7862: }
7863:
1.144 matthew 7864: ######################################################
7865: ######################################################
7866:
1.56 matthew 7867: =pod
7868:
1.648 raeburn 7869: =item * &upfile_select_html()
1.41 ng 7870:
1.144 matthew 7871: Return HTML code to select a file from the users machine and specify
7872: the file type.
1.41 ng 7873:
7874: =cut
7875:
1.144 matthew 7876: ######################################################
7877: ######################################################
1.31 albertel 7878: sub upfile_select_html {
1.144 matthew 7879: my %Types = (
7880: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 7881: semisv => &mt('Semicolon separated values'),
1.144 matthew 7882: space => &mt('Space separated'),
7883: tab => &mt('Tabulator separated'),
7884: # xml => &mt('HTML/XML'),
7885: );
7886: my $Str = '<input type="file" name="upfile" size="50" />'.
1.692.4.2 raeburn 7887: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 7888: foreach my $type (sort(keys(%Types))) {
7889: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
7890: }
7891: $Str .= "</select>\n";
7892: return $Str;
1.31 albertel 7893: }
7894:
1.301 albertel 7895: sub get_samples {
7896: my ($records,$toget) = @_;
7897: my @samples=({});
7898: my $got=0;
7899: foreach my $rec (@$records) {
7900: my %temp = &record_sep($rec);
7901: if (! grep(/\S/, values(%temp))) { next; }
7902: if (%temp) {
7903: $samples[$got]=\%temp;
7904: $got++;
7905: if ($got == $toget) { last; }
7906: }
7907: }
7908: return \@samples;
7909: }
7910:
1.144 matthew 7911: ######################################################
7912: ######################################################
7913:
1.56 matthew 7914: =pod
7915:
1.648 raeburn 7916: =item * &csv_print_samples($r,$records)
1.41 ng 7917:
7918: Prints a table of sample values from each column uploaded $r is an
7919: Apache Request ref, $records is an arrayref from
7920: &Apache::loncommon::upfile_record_sep
7921:
7922: =cut
7923:
1.144 matthew 7924: ######################################################
7925: ######################################################
1.31 albertel 7926: sub csv_print_samples {
7927: my ($r,$records) = @_;
1.662 bisitz 7928: my $samples = &get_samples($records,5);
1.301 albertel 7929:
1.594 raeburn 7930: $r->print(&mt('Samples').'<br />'.&start_data_table().
7931: &start_data_table_header_row());
1.356 albertel 7932: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.692.4.6 raeburn 7933: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>');
7934: }
1.594 raeburn 7935: $r->print(&end_data_table_header_row());
1.301 albertel 7936: foreach my $hash (@$samples) {
1.594 raeburn 7937: $r->print(&start_data_table_row());
1.356 albertel 7938: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 7939: $r->print('<td>');
1.356 albertel 7940: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 7941: $r->print('</td>');
7942: }
1.594 raeburn 7943: $r->print(&end_data_table_row());
1.31 albertel 7944: }
1.594 raeburn 7945: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 7946: }
7947:
1.144 matthew 7948: ######################################################
7949: ######################################################
7950:
1.56 matthew 7951: =pod
7952:
1.648 raeburn 7953: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 7954:
7955: Prints a table to create associations between values and table columns.
1.144 matthew 7956:
1.41 ng 7957: $r is an Apache Request ref,
7958: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 7959: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 7960:
7961: =cut
7962:
1.144 matthew 7963: ######################################################
7964: ######################################################
1.31 albertel 7965: sub csv_print_select_table {
7966: my ($r,$records,$d) = @_;
1.301 albertel 7967: my $i=0;
7968: my $samples = &get_samples($records,1);
1.144 matthew 7969: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 7970: &start_data_table().&start_data_table_header_row().
1.144 matthew 7971: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 7972: '<th>'.&mt('Column').'</th>'.
7973: &end_data_table_header_row()."\n");
1.356 albertel 7974: foreach my $array_ref (@$d) {
7975: my ($value,$display,$defaultcol)=@{ $array_ref };
1.689 bisitz 7976: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 7977:
1.692.4.8! raeburn 7978: $r->print('<td><select name"f'.$i.'"'.
1.32 matthew 7979: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 7980: $r->print('<option value="none"></option>');
1.356 albertel 7981: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
7982: $r->print('<option value="'.$sample.'"'.
7983: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 7984: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 7985: }
1.594 raeburn 7986: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 7987: $i++;
7988: }
1.594 raeburn 7989: $r->print(&end_data_table());
1.31 albertel 7990: $i--;
7991: return $i;
7992: }
1.56 matthew 7993:
1.144 matthew 7994: ######################################################
7995: ######################################################
7996:
1.56 matthew 7997: =pod
1.31 albertel 7998:
1.648 raeburn 7999: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 8000:
8001: Prints a table of sample values from the upload and can make associate samples to internal names.
8002:
8003: $r is an Apache Request ref,
8004: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
8005: $d is an array of 2 element arrays (internal name, displayed name)
8006:
8007: =cut
8008:
1.144 matthew 8009: ######################################################
8010: ######################################################
1.31 albertel 8011: sub csv_samples_select_table {
8012: my ($r,$records,$d) = @_;
8013: my $i=0;
1.144 matthew 8014: #
1.662 bisitz 8015: my $max_samples = 5;
8016: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 8017: $r->print(&start_data_table().
8018: &start_data_table_header_row().'<th>'.
8019: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
8020: &end_data_table_header_row());
1.301 albertel 8021:
8022: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 8023: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 8024: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 8025: foreach my $option (@$d) {
8026: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 8027: $r->print('<option value="'.$value.'"'.
1.253 albertel 8028: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 8029: $display.'</option>');
1.31 albertel 8030: }
8031: $r->print('</select></td><td>');
1.662 bisitz 8032: foreach my $line (0..($max_samples-1)) {
1.301 albertel 8033: if (defined($samples->[$line]{$key})) {
8034: $r->print($samples->[$line]{$key}."<br />\n");
8035: }
8036: }
1.594 raeburn 8037: $r->print('</td>'.&end_data_table_row());
1.31 albertel 8038: $i++;
8039: }
1.594 raeburn 8040: $r->print(&end_data_table());
1.31 albertel 8041: $i--;
8042: return($i);
1.115 matthew 8043: }
8044:
1.144 matthew 8045: ######################################################
8046: ######################################################
8047:
1.115 matthew 8048: =pod
8049:
1.648 raeburn 8050: =item * &clean_excel_name($name)
1.115 matthew 8051:
8052: Returns a replacement for $name which does not contain any illegal characters.
8053:
8054: =cut
8055:
1.144 matthew 8056: ######################################################
8057: ######################################################
1.115 matthew 8058: sub clean_excel_name {
8059: my ($name) = @_;
8060: $name =~ s/[:\*\?\/\\]//g;
8061: if (length($name) > 31) {
8062: $name = substr($name,0,31);
8063: }
8064: return $name;
1.25 albertel 8065: }
1.84 albertel 8066:
1.85 albertel 8067: =pod
8068:
1.648 raeburn 8069: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 8070:
8071: Returns either 1 or undef
8072:
8073: 1 if the part is to be hidden, undef if it is to be shown
8074:
8075: Arguments are:
8076:
8077: $id the id of the part to be checked
8078: $symb, optional the symb of the resource to check
8079: $udom, optional the domain of the user to check for
8080: $uname, optional the username of the user to check for
8081:
8082: =cut
1.84 albertel 8083:
8084: sub check_if_partid_hidden {
8085: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 8086: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 8087: $symb,$udom,$uname);
1.141 albertel 8088: my $truth=1;
8089: #if the string starts with !, then the list is the list to show not hide
8090: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 8091: my @hiddenlist=split(/,/,$hiddenparts);
8092: foreach my $checkid (@hiddenlist) {
1.141 albertel 8093: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 8094: }
1.141 albertel 8095: return !$truth;
1.84 albertel 8096: }
1.127 matthew 8097:
1.138 matthew 8098:
8099: ############################################################
8100: ############################################################
8101:
8102: =pod
8103:
1.157 matthew 8104: =back
8105:
1.138 matthew 8106: =head1 cgi-bin script and graphing routines
8107:
1.157 matthew 8108: =over 4
8109:
1.648 raeburn 8110: =item * &get_cgi_id()
1.138 matthew 8111:
8112: Inputs: none
8113:
8114: Returns an id which can be used to pass environment variables
8115: to various cgi-bin scripts. These environment variables will
8116: be removed from the users environment after a given time by
8117: the routine &Apache::lonnet::transfer_profile_to_env.
8118:
8119: =cut
8120:
8121: ############################################################
8122: ############################################################
1.152 albertel 8123: my $uniq=0;
1.136 matthew 8124: sub get_cgi_id {
1.154 albertel 8125: $uniq=($uniq+1)%100000;
1.280 albertel 8126: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 8127: }
8128:
1.127 matthew 8129: ############################################################
8130: ############################################################
8131:
8132: =pod
8133:
1.648 raeburn 8134: =item * &DrawBarGraph()
1.127 matthew 8135:
1.138 matthew 8136: Facilitates the plotting of data in a (stacked) bar graph.
8137: Puts plot definition data into the users environment in order for
8138: graph.png to plot it. Returns an <img> tag for the plot.
8139: The bars on the plot are labeled '1','2',...,'n'.
8140:
8141: Inputs:
8142:
8143: =over 4
8144:
8145: =item $Title: string, the title of the plot
8146:
8147: =item $xlabel: string, text describing the X-axis of the plot
8148:
8149: =item $ylabel: string, text describing the Y-axis of the plot
8150:
8151: =item $Max: scalar, the maximum Y value to use in the plot
8152: If $Max is < any data point, the graph will not be rendered.
8153:
1.140 matthew 8154: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 8155: they are plotted. If undefined, default values will be used.
8156:
1.178 matthew 8157: =item $labels: array ref holding the labels to use on the x-axis for the bars.
8158:
1.138 matthew 8159: =item @Values: An array of array references. Each array reference holds data
8160: to be plotted in a stacked bar chart.
8161:
1.239 matthew 8162: =item If the final element of @Values is a hash reference the key/value
8163: pairs will be added to the graph definition.
8164:
1.138 matthew 8165: =back
8166:
8167: Returns:
8168:
8169: An <img> tag which references graph.png and the appropriate identifying
8170: information for the plot.
8171:
1.127 matthew 8172: =cut
8173:
8174: ############################################################
8175: ############################################################
1.134 matthew 8176: sub DrawBarGraph {
1.178 matthew 8177: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 8178: #
8179: if (! defined($colors)) {
8180: $colors = ['#33ff00',
8181: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
8182: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
8183: ];
8184: }
1.228 matthew 8185: my $extra_settings = {};
8186: if (ref($Values[-1]) eq 'HASH') {
8187: $extra_settings = pop(@Values);
8188: }
1.127 matthew 8189: #
1.136 matthew 8190: my $identifier = &get_cgi_id();
8191: my $id = 'cgi.'.$identifier;
1.129 matthew 8192: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 8193: return '';
8194: }
1.225 matthew 8195: #
8196: my @Labels;
8197: if (defined($labels)) {
8198: @Labels = @$labels;
8199: } else {
8200: for (my $i=0;$i<@{$Values[0]};$i++) {
8201: push (@Labels,$i+1);
8202: }
8203: }
8204: #
1.129 matthew 8205: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 8206: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 8207: my %ValuesHash;
8208: my $NumSets=1;
8209: foreach my $array (@Values) {
8210: next if (! ref($array));
1.136 matthew 8211: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 8212: join(',',@$array);
1.129 matthew 8213: }
1.127 matthew 8214: #
1.136 matthew 8215: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 8216: if ($NumBars < 3) {
8217: $width = 120+$NumBars*32;
1.220 matthew 8218: $xskip = 1;
1.225 matthew 8219: $bar_width = 30;
8220: } elsif ($NumBars < 5) {
8221: $width = 120+$NumBars*20;
8222: $xskip = 1;
8223: $bar_width = 20;
1.220 matthew 8224: } elsif ($NumBars < 10) {
1.136 matthew 8225: $width = 120+$NumBars*15;
8226: $xskip = 1;
8227: $bar_width = 15;
8228: } elsif ($NumBars <= 25) {
8229: $width = 120+$NumBars*11;
8230: $xskip = 5;
8231: $bar_width = 8;
8232: } elsif ($NumBars <= 50) {
8233: $width = 120+$NumBars*8;
8234: $xskip = 5;
8235: $bar_width = 4;
8236: } else {
8237: $width = 120+$NumBars*8;
8238: $xskip = 5;
8239: $bar_width = 4;
8240: }
8241: #
1.137 matthew 8242: $Max = 1 if ($Max < 1);
8243: if ( int($Max) < $Max ) {
8244: $Max++;
8245: $Max = int($Max);
8246: }
1.127 matthew 8247: $Title = '' if (! defined($Title));
8248: $xlabel = '' if (! defined($xlabel));
8249: $ylabel = '' if (! defined($ylabel));
1.369 www 8250: $ValuesHash{$id.'.title'} = &escape($Title);
8251: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
8252: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 8253: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 8254: $ValuesHash{$id.'.NumBars'} = $NumBars;
8255: $ValuesHash{$id.'.NumSets'} = $NumSets;
8256: $ValuesHash{$id.'.PlotType'} = 'bar';
8257: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8258: $ValuesHash{$id.'.height'} = $height;
8259: $ValuesHash{$id.'.width'} = $width;
8260: $ValuesHash{$id.'.xskip'} = $xskip;
8261: $ValuesHash{$id.'.bar_width'} = $bar_width;
8262: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 8263: #
1.228 matthew 8264: # Deal with other parameters
8265: while (my ($key,$value) = each(%$extra_settings)) {
8266: $ValuesHash{$id.'.'.$key} = $value;
8267: }
8268: #
1.646 raeburn 8269: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 8270: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8271: }
8272:
8273: ############################################################
8274: ############################################################
8275:
8276: =pod
8277:
1.648 raeburn 8278: =item * &DrawXYGraph()
1.137 matthew 8279:
1.138 matthew 8280: Facilitates the plotting of data in an XY graph.
8281: Puts plot definition data into the users environment in order for
8282: graph.png to plot it. Returns an <img> tag for the plot.
8283:
8284: Inputs:
8285:
8286: =over 4
8287:
8288: =item $Title: string, the title of the plot
8289:
8290: =item $xlabel: string, text describing the X-axis of the plot
8291:
8292: =item $ylabel: string, text describing the Y-axis of the plot
8293:
8294: =item $Max: scalar, the maximum Y value to use in the plot
8295: If $Max is < any data point, the graph will not be rendered.
8296:
8297: =item $colors: Array ref containing the hex color codes for the data to be
8298: plotted in. If undefined, default values will be used.
8299:
8300: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8301:
8302: =item $Ydata: Array ref containing Array refs.
1.185 www 8303: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 8304:
8305: =item %Values: hash indicating or overriding any default values which are
8306: passed to graph.png.
8307: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8308:
8309: =back
8310:
8311: Returns:
8312:
8313: An <img> tag which references graph.png and the appropriate identifying
8314: information for the plot.
8315:
1.137 matthew 8316: =cut
8317:
8318: ############################################################
8319: ############################################################
8320: sub DrawXYGraph {
8321: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
8322: #
8323: # Create the identifier for the graph
8324: my $identifier = &get_cgi_id();
8325: my $id = 'cgi.'.$identifier;
8326: #
8327: $Title = '' if (! defined($Title));
8328: $xlabel = '' if (! defined($xlabel));
8329: $ylabel = '' if (! defined($ylabel));
8330: my %ValuesHash =
8331: (
1.369 www 8332: $id.'.title' => &escape($Title),
8333: $id.'.xlabel' => &escape($xlabel),
8334: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 8335: $id.'.y_max_value'=> $Max,
8336: $id.'.labels' => join(',',@$Xlabels),
8337: $id.'.PlotType' => 'XY',
8338: );
8339: #
8340: if (defined($colors) && ref($colors) eq 'ARRAY') {
8341: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8342: }
8343: #
8344: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
8345: return '';
8346: }
8347: my $NumSets=1;
1.138 matthew 8348: foreach my $array (@{$Ydata}){
1.137 matthew 8349: next if (! ref($array));
8350: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
8351: }
1.138 matthew 8352: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 8353: #
8354: # Deal with other parameters
8355: while (my ($key,$value) = each(%Values)) {
8356: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 8357: }
8358: #
1.646 raeburn 8359: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 8360: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8361: }
8362:
8363: ############################################################
8364: ############################################################
8365:
8366: =pod
8367:
1.648 raeburn 8368: =item * &DrawXYYGraph()
1.138 matthew 8369:
8370: Facilitates the plotting of data in an XY graph with two Y axes.
8371: Puts plot definition data into the users environment in order for
8372: graph.png to plot it. Returns an <img> tag for the plot.
8373:
8374: Inputs:
8375:
8376: =over 4
8377:
8378: =item $Title: string, the title of the plot
8379:
8380: =item $xlabel: string, text describing the X-axis of the plot
8381:
8382: =item $ylabel: string, text describing the Y-axis of the plot
8383:
8384: =item $colors: Array ref containing the hex color codes for the data to be
8385: plotted in. If undefined, default values will be used.
8386:
8387: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8388:
8389: =item $Ydata1: The first data set
8390:
8391: =item $Min1: The minimum value of the left Y-axis
8392:
8393: =item $Max1: The maximum value of the left Y-axis
8394:
8395: =item $Ydata2: The second data set
8396:
8397: =item $Min2: The minimum value of the right Y-axis
8398:
8399: =item $Max2: The maximum value of the left Y-axis
8400:
8401: =item %Values: hash indicating or overriding any default values which are
8402: passed to graph.png.
8403: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8404:
8405: =back
8406:
8407: Returns:
8408:
8409: An <img> tag which references graph.png and the appropriate identifying
8410: information for the plot.
1.136 matthew 8411:
8412: =cut
8413:
8414: ############################################################
8415: ############################################################
1.137 matthew 8416: sub DrawXYYGraph {
8417: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
8418: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 8419: #
8420: # Create the identifier for the graph
8421: my $identifier = &get_cgi_id();
8422: my $id = 'cgi.'.$identifier;
8423: #
8424: $Title = '' if (! defined($Title));
8425: $xlabel = '' if (! defined($xlabel));
8426: $ylabel = '' if (! defined($ylabel));
8427: my %ValuesHash =
8428: (
1.369 www 8429: $id.'.title' => &escape($Title),
8430: $id.'.xlabel' => &escape($xlabel),
8431: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 8432: $id.'.labels' => join(',',@$Xlabels),
8433: $id.'.PlotType' => 'XY',
8434: $id.'.NumSets' => 2,
1.137 matthew 8435: $id.'.two_axes' => 1,
8436: $id.'.y1_max_value' => $Max1,
8437: $id.'.y1_min_value' => $Min1,
8438: $id.'.y2_max_value' => $Max2,
8439: $id.'.y2_min_value' => $Min2,
1.136 matthew 8440: );
8441: #
1.137 matthew 8442: if (defined($colors) && ref($colors) eq 'ARRAY') {
8443: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8444: }
8445: #
8446: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
8447: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 8448: return '';
8449: }
8450: my $NumSets=1;
1.137 matthew 8451: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 8452: next if (! ref($array));
8453: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 8454: }
8455: #
8456: # Deal with other parameters
8457: while (my ($key,$value) = each(%Values)) {
8458: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 8459: }
8460: #
1.646 raeburn 8461: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 8462: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 8463: }
8464:
8465: ############################################################
8466: ############################################################
8467:
8468: =pod
8469:
1.157 matthew 8470: =back
8471:
1.139 matthew 8472: =head1 Statistics helper routines?
8473:
8474: Bad place for them but what the hell.
8475:
1.157 matthew 8476: =over 4
8477:
1.648 raeburn 8478: =item * &chartlink()
1.139 matthew 8479:
8480: Returns a link to the chart for a specific student.
8481:
8482: Inputs:
8483:
8484: =over 4
8485:
8486: =item $linktext: The text of the link
8487:
8488: =item $sname: The students username
8489:
8490: =item $sdomain: The students domain
8491:
8492: =back
8493:
1.157 matthew 8494: =back
8495:
1.139 matthew 8496: =cut
8497:
8498: ############################################################
8499: ############################################################
8500: sub chartlink {
8501: my ($linktext, $sname, $sdomain) = @_;
8502: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 8503: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 8504: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 8505: '">'.$linktext.'</a>';
1.153 matthew 8506: }
8507:
8508: #######################################################
8509: #######################################################
8510:
8511: =pod
8512:
8513: =head1 Course Environment Routines
1.157 matthew 8514:
8515: =over 4
1.153 matthew 8516:
1.648 raeburn 8517: =item * &restore_course_settings()
1.153 matthew 8518:
1.648 raeburn 8519: =item * &store_course_settings()
1.153 matthew 8520:
8521: Restores/Store indicated form parameters from the course environment.
8522: Will not overwrite existing values of the form parameters.
8523:
8524: Inputs:
8525: a scalar describing the data (e.g. 'chart', 'problem_analysis')
8526:
8527: a hash ref describing the data to be stored. For example:
8528:
8529: %Save_Parameters = ('Status' => 'scalar',
8530: 'chartoutputmode' => 'scalar',
8531: 'chartoutputdata' => 'scalar',
8532: 'Section' => 'array',
1.373 raeburn 8533: 'Group' => 'array',
1.153 matthew 8534: 'StudentData' => 'array',
8535: 'Maps' => 'array');
8536:
8537: Returns: both routines return nothing
8538:
1.631 raeburn 8539: =back
8540:
1.153 matthew 8541: =cut
8542:
8543: #######################################################
8544: #######################################################
8545: sub store_course_settings {
1.496 albertel 8546: return &store_settings($env{'request.course.id'},@_);
8547: }
8548:
8549: sub store_settings {
1.153 matthew 8550: # save to the environment
8551: # appenv the same items, just to be safe
1.300 albertel 8552: my $udom = $env{'user.domain'};
8553: my $uname = $env{'user.name'};
1.496 albertel 8554: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8555: my %SaveHash;
8556: my %AppHash;
8557: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 8558: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 8559: my $envname = 'environment.'.$basename;
1.258 albertel 8560: if (exists($env{'form.'.$setting})) {
1.153 matthew 8561: # Save this value away
8562: if ($type eq 'scalar' &&
1.258 albertel 8563: (! exists($env{$envname}) ||
8564: $env{$envname} ne $env{'form.'.$setting})) {
8565: $SaveHash{$basename} = $env{'form.'.$setting};
8566: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 8567: } elsif ($type eq 'array') {
8568: my $stored_form;
1.258 albertel 8569: if (ref($env{'form.'.$setting})) {
1.153 matthew 8570: $stored_form = join(',',
8571: map {
1.369 www 8572: &escape($_);
1.258 albertel 8573: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 8574: } else {
8575: $stored_form =
1.369 www 8576: &escape($env{'form.'.$setting});
1.153 matthew 8577: }
8578: # Determine if the array contents are the same.
1.258 albertel 8579: if ($stored_form ne $env{$envname}) {
1.153 matthew 8580: $SaveHash{$basename} = $stored_form;
8581: $AppHash{$envname} = $stored_form;
8582: }
8583: }
8584: }
8585: }
8586: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 8587: $udom,$uname);
1.153 matthew 8588: if ($put_result !~ /^(ok|delayed)/) {
8589: &Apache::lonnet::logthis('unable to save form parameters, '.
8590: 'got error:'.$put_result);
8591: }
8592: # Make sure these settings stick around in this session, too
1.646 raeburn 8593: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 8594: return;
8595: }
8596:
8597: sub restore_course_settings {
1.499 albertel 8598: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 8599: }
8600:
8601: sub restore_settings {
8602: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8603: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 8604: next if (exists($env{'form.'.$setting}));
1.496 albertel 8605: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 8606: '.'.$setting;
1.258 albertel 8607: if (exists($env{$envname})) {
1.153 matthew 8608: if ($type eq 'scalar') {
1.258 albertel 8609: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 8610: } elsif ($type eq 'array') {
1.258 albertel 8611: $env{'form.'.$setting} = [
1.153 matthew 8612: map {
1.369 www 8613: &unescape($_);
1.258 albertel 8614: } split(',',$env{$envname})
1.153 matthew 8615: ];
8616: }
8617: }
8618: }
1.127 matthew 8619: }
8620:
1.618 raeburn 8621: #######################################################
8622: #######################################################
8623:
8624: =pod
8625:
8626: =head1 Domain E-mail Routines
8627:
8628: =over 4
8629:
1.648 raeburn 8630: =item * &build_recipient_list()
1.618 raeburn 8631:
1.692.4.2 raeburn 8632: Build recipient lists for four types of e-mail:
8633: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
8634: (d) Help requests, generated by
8635: lonerrorhandler.pm, CHECKRPMS, loncron, and lonsupportreq.pm respectively.
1.618 raeburn 8636:
8637: Inputs:
1.619 raeburn 8638: defmail (scalar - email address of default recipient),
1.618 raeburn 8639: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 8640: defdom (domain for which to retrieve configuration settings),
8641: origmail (scalar - email address of recipient from loncapa.conf,
8642: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 8643:
1.655 raeburn 8644: Returns: comma separated list of addresses to which to send e-mail.
8645:
8646: =back
1.618 raeburn 8647:
8648: =cut
8649:
8650: ############################################################
8651: ############################################################
8652: sub build_recipient_list {
1.619 raeburn 8653: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 8654: my @recipients;
8655: my $otheremails;
8656: my %domconfig =
8657: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
8658: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.692.4.2 raeburn 8659: if (exists($domconfig{'contacts'}{$mailing})) {
8660: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
8661: my @contacts = ('adminemail','supportemail');
8662: foreach my $item (@contacts) {
8663: if ($domconfig{'contacts'}{$mailing}{$item}) {
8664: my $addr = $domconfig{'contacts'}{$item};
8665: if (!grep(/^\Q$addr\E$/,@recipients)) {
8666: push(@recipients,$addr);
8667: }
1.619 raeburn 8668: }
1.692.4.2 raeburn 8669: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 8670: }
8671: }
1.692.4.2 raeburn 8672: } elsif ($origmail ne '') {
8673: push(@recipients,$origmail);
1.618 raeburn 8674: }
1.619 raeburn 8675: } elsif ($origmail ne '') {
8676: push(@recipients,$origmail);
1.618 raeburn 8677: }
1.688 raeburn 8678: if (defined($defmail)) {
8679: if ($defmail ne '') {
8680: push(@recipients,$defmail);
8681: }
1.618 raeburn 8682: }
8683: if ($otheremails) {
1.619 raeburn 8684: my @others;
8685: if ($otheremails =~ /,/) {
8686: @others = split(/,/,$otheremails);
1.618 raeburn 8687: } else {
1.619 raeburn 8688: push(@others,$otheremails);
8689: }
8690: foreach my $addr (@others) {
8691: if (!grep(/^\Q$addr\E$/,@recipients)) {
8692: push(@recipients,$addr);
8693: }
1.618 raeburn 8694: }
8695: }
1.619 raeburn 8696: my $recipientlist = join(',',@recipients);
1.618 raeburn 8697: return $recipientlist;
8698: }
8699:
1.127 matthew 8700: ############################################################
8701: ############################################################
1.154 albertel 8702:
1.655 raeburn 8703: =pod
8704:
8705: =head1 Course Catalog Routines
8706:
8707: =over 4
8708:
8709: =item * &gather_categories()
8710:
8711: Converts category definitions - keys of categories hash stored in
8712: coursecategories in configuration.db on the primary library server in a
8713: domain - to an array. Also generates javascript and idx hash used to
8714: generate Domain Coordinator interface for editing Course Categories.
8715:
8716: Inputs:
1.663 raeburn 8717:
1.655 raeburn 8718: categories (reference to hash of category definitions).
1.663 raeburn 8719:
1.655 raeburn 8720: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8721: categories and subcategories).
1.663 raeburn 8722:
1.655 raeburn 8723: idx (reference to hash of counters used in Domain Coordinator interface for
8724: editing Course Categories).
1.663 raeburn 8725:
1.655 raeburn 8726: jsarray (reference to array of categories used to create Javascript arrays for
8727: Domain Coordinator interface for editing Course Categories).
8728:
8729: Returns: nothing
8730:
8731: Side effects: populates cats, idx and jsarray.
8732:
8733: =cut
8734:
8735: sub gather_categories {
8736: my ($categories,$cats,$idx,$jsarray) = @_;
8737: my %counters;
8738: my $num = 0;
8739: foreach my $item (keys(%{$categories})) {
8740: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
8741: if ($container eq '' && $depth == 0) {
8742: $cats->[$depth][$categories->{$item}] = $cat;
8743: } else {
8744: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
8745: }
8746: my ($escitem,$tail) = split(/:/,$item,2);
8747: if ($counters{$tail} eq '') {
8748: $counters{$tail} = $num;
8749: $num ++;
8750: }
8751: if (ref($idx) eq 'HASH') {
8752: $idx->{$item} = $counters{$tail};
8753: }
8754: if (ref($jsarray) eq 'ARRAY') {
8755: push(@{$jsarray->[$counters{$tail}]},$item);
8756: }
8757: }
8758: return;
8759: }
8760:
8761: =pod
8762:
8763: =item * &extract_categories()
8764:
8765: Used to generate breadcrumb trails for course categories.
8766:
8767: Inputs:
1.663 raeburn 8768:
1.655 raeburn 8769: categories (reference to hash of category definitions).
1.663 raeburn 8770:
1.655 raeburn 8771: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8772: categories and subcategories).
1.663 raeburn 8773:
1.655 raeburn 8774: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 8775:
1.655 raeburn 8776: allitems (reference to hash - key is category key
8777: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 8778:
1.655 raeburn 8779: idx (reference to hash of counters used in Domain Coordinator interface for
8780: editing Course Categories).
1.663 raeburn 8781:
1.655 raeburn 8782: jsarray (reference to array of categories used to create Javascript arrays for
8783: Domain Coordinator interface for editing Course Categories).
8784:
1.665 raeburn 8785: subcats (reference to hash of arrays containing all subcategories within each
8786: category, -recursive)
8787:
1.655 raeburn 8788: Returns: nothing
8789:
8790: Side effects: populates trails and allitems hash references.
8791:
8792: =cut
8793:
8794: sub extract_categories {
1.665 raeburn 8795: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 8796: if (ref($categories) eq 'HASH') {
8797: &gather_categories($categories,$cats,$idx,$jsarray);
8798: if (ref($cats->[0]) eq 'ARRAY') {
8799: for (my $i=0; $i<@{$cats->[0]}; $i++) {
8800: my $name = $cats->[0][$i];
8801: my $item = &escape($name).'::0';
8802: my $trailstr;
8803: if ($name eq 'instcode') {
8804: $trailstr = &mt('Official courses (with institutional codes)');
8805: } else {
8806: $trailstr = $name;
8807: }
8808: if ($allitems->{$item} eq '') {
8809: push(@{$trails},$trailstr);
8810: $allitems->{$item} = scalar(@{$trails})-1;
8811: }
8812: my @parents = ($name);
8813: if (ref($cats->[1]{$name}) eq 'ARRAY') {
8814: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
8815: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 8816: if (ref($subcats) eq 'HASH') {
8817: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
8818: }
8819: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
8820: }
8821: } else {
8822: if (ref($subcats) eq 'HASH') {
8823: $subcats->{$item} = [];
1.655 raeburn 8824: }
8825: }
8826: }
8827: }
8828: }
8829: return;
8830: }
8831:
8832: =pod
8833:
8834: =item *&recurse_categories()
8835:
8836: Recursively used to generate breadcrumb trails for course categories.
8837:
8838: Inputs:
1.663 raeburn 8839:
1.655 raeburn 8840: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8841: categories and subcategories).
1.663 raeburn 8842:
1.655 raeburn 8843: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 8844:
8845: category (current course category, for which breadcrumb trail is being generated).
8846:
8847: trails (reference to array of breadcrumb trails for each category).
8848:
1.655 raeburn 8849: allitems (reference to hash - key is category key
8850: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 8851:
1.655 raeburn 8852: parents (array containing containers directories for current category,
8853: back to top level).
8854:
8855: Returns: nothing
8856:
8857: Side effects: populates trails and allitems hash references
8858:
8859: =cut
8860:
8861: sub recurse_categories {
1.665 raeburn 8862: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 8863: my $shallower = $depth - 1;
8864: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
8865: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
8866: my $name = $cats->[$depth]{$category}[$k];
8867: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
8868: my $trailstr = join(' -> ',(@{$parents},$category));
8869: if ($allitems->{$item} eq '') {
8870: push(@{$trails},$trailstr);
8871: $allitems->{$item} = scalar(@{$trails})-1;
8872: }
8873: my $deeper = $depth+1;
8874: push(@{$parents},$category);
1.665 raeburn 8875: if (ref($subcats) eq 'HASH') {
8876: my $subcat = &escape($name).':'.$category.':'.$depth;
8877: for (my $j=@{$parents}; $j>=0; $j--) {
8878: my $higher;
8879: if ($j > 0) {
8880: $higher = &escape($parents->[$j]).':'.
8881: &escape($parents->[$j-1]).':'.$j;
8882: } else {
8883: $higher = &escape($parents->[$j]).'::'.$j;
8884: }
8885: push(@{$subcats->{$higher}},$subcat);
8886: }
8887: }
8888: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
8889: $subcats);
1.655 raeburn 8890: pop(@{$parents});
8891: }
8892: } else {
8893: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
8894: my $trailstr = join(' -> ',(@{$parents},$category));
8895: if ($allitems->{$item} eq '') {
8896: push(@{$trails},$trailstr);
8897: $allitems->{$item} = scalar(@{$trails})-1;
8898: }
8899: }
8900: return;
8901: }
8902:
1.663 raeburn 8903: =pod
8904:
8905: =item *&assign_categories_table()
8906:
8907: Create a datatable for display of hierarchical categories in a domain,
8908: with checkboxes to allow a course to be categorized.
8909:
8910: Inputs:
8911:
8912: cathash - reference to hash of categories defined for the domain (from
8913: configuration.db)
8914:
8915: currcat - scalar with an & separated list of categories assigned to a course.
8916:
8917: Returns: $output (markup to be displayed)
8918:
8919: =cut
8920:
8921: sub assign_categories_table {
8922: my ($cathash,$currcat) = @_;
8923: my $output;
8924: if (ref($cathash) eq 'HASH') {
8925: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
8926: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
8927: $maxdepth = scalar(@cats);
8928: if (@cats > 0) {
8929: my $itemcount = 0;
8930: if (ref($cats[0]) eq 'ARRAY') {
8931: $output = &Apache::loncommon::start_data_table();
8932: my @currcategories;
8933: if ($currcat ne '') {
8934: @currcategories = split('&',$currcat);
8935: }
8936: for (my $i=0; $i<@{$cats[0]}; $i++) {
8937: my $parent = $cats[0][$i];
8938: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
8939: next if ($parent eq 'instcode');
8940: my $item = &escape($parent).'::0';
8941: my $checked = '';
8942: if (@currcategories > 0) {
8943: if (grep(/^\Q$item\E$/,@currcategories)) {
8944: $checked = ' checked="checked" ';
8945: }
8946: }
1.675 raeburn 8947: $output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
8948: '<input type="checkbox" name="usecategory" value="'.
8949: $item.'"'.$checked.' />'.$parent.'</span>'.
8950: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 8951: my $depth = 1;
8952: push(@path,$parent);
8953: $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
8954: pop(@path);
8955: $output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
8956: $itemcount ++;
8957: }
8958: $output .= &Apache::loncommon::end_data_table();
8959: }
8960: }
8961: }
8962: return $output;
8963: }
8964:
8965: =pod
8966:
8967: =item *&assign_category_rows()
8968:
8969: Create a datatable row for display of nested categories in a domain,
8970: with checkboxes to allow a course to be categorized,called recursively.
8971:
8972: Inputs:
8973:
8974: itemcount - track row number for alternating colors
8975:
8976: cats - reference to array of arrays/hashes which encapsulates hierarchy of
8977: categories and subcategories.
8978:
8979: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
8980:
8981: parent - parent of current category item
8982:
8983: path - Array containing all categories back up through the hierarchy from the
8984: current category to the top level.
8985:
8986: currcategories - reference to array of current categories assigned to the course
8987:
8988: Returns: $output (markup to be displayed).
8989:
8990: =cut
8991:
8992: sub assign_category_rows {
8993: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
8994: my ($text,$name,$item,$chgstr);
8995: if (ref($cats) eq 'ARRAY') {
8996: my $maxdepth = scalar(@{$cats});
8997: if (ref($cats->[$depth]) eq 'HASH') {
8998: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
8999: my $numchildren = @{$cats->[$depth]{$parent}};
9000: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
9001: $text .= '<td><table class="LC_datatable">';
9002: for (my $j=0; $j<$numchildren; $j++) {
9003: $name = $cats->[$depth]{$parent}[$j];
9004: $item = &escape($name).':'.&escape($parent).':'.$depth;
9005: my $deeper = $depth+1;
9006: my $checked = '';
9007: if (ref($currcategories) eq 'ARRAY') {
9008: if (@{$currcategories} > 0) {
9009: if (grep(/^\Q$item\E$/,@{$currcategories})) {
9010: $checked = ' checked="checked" ';
9011: }
9012: }
9013: }
1.664 raeburn 9014: $text .= '<tr><td><span class="LC_nobreak"><label>'.
9015: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 9016: $item.'"'.$checked.' />'.$name.'</label></span>'.
9017: '<input type="hidden" name="catname" value="'.$name.'" />'.
9018: '</td><td>';
1.663 raeburn 9019: if (ref($path) eq 'ARRAY') {
9020: push(@{$path},$name);
9021: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
9022: pop(@{$path});
9023: }
9024: $text .= '</td></tr>';
9025: }
9026: $text .= '</table></td>';
9027: }
9028: }
9029: }
9030: return $text;
9031: }
9032:
1.655 raeburn 9033: ############################################################
9034: ############################################################
9035:
9036:
1.443 albertel 9037: sub commit_customrole {
1.664 raeburn 9038: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 9039: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 9040: ($start?', '.&mt('starting').' '.localtime($start):'').
9041: ($end?', ending '.localtime($end):'').': <b>'.
9042: &Apache::lonnet::assigncustomrole(
1.664 raeburn 9043: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 9044: '</b><br />';
9045: return $output;
9046: }
9047:
9048: sub commit_standardrole {
1.541 raeburn 9049: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
9050: my ($output,$logmsg,$linefeed);
9051: if ($context eq 'auto') {
9052: $linefeed = "\n";
9053: } else {
9054: $linefeed = "<br />\n";
9055: }
1.443 albertel 9056: if ($three eq 'st') {
1.541 raeburn 9057: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
9058: $one,$two,$sec,$context);
9059: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 9060: ($result eq 'unknown_course') || ($result eq 'refused')) {
9061: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 9062: } else {
1.541 raeburn 9063: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 9064: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9065: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
9066: if ($context eq 'auto') {
9067: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
9068: } else {
9069: $output .= '<b>'.$result.'</b>'.$linefeed.
9070: &mt('Add to classlist').': <b>ok</b>';
9071: }
9072: $output .= $linefeed;
1.443 albertel 9073: }
9074: } else {
9075: $output = &mt('Assigning').' '.$three.' in '.$url.
9076: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9077: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 9078: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 9079: if ($context eq 'auto') {
9080: $output .= $result.$linefeed;
9081: } else {
9082: $output .= '<b>'.$result.'</b>'.$linefeed;
9083: }
1.443 albertel 9084: }
9085: return $output;
9086: }
9087:
9088: sub commit_studentrole {
1.541 raeburn 9089: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 9090: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 9091: if ($context eq 'auto') {
9092: $linefeed = "\n";
9093: } else {
9094: $linefeed = '<br />'."\n";
9095: }
1.443 albertel 9096: if (defined($one) && defined($two)) {
9097: my $cid=$one.'_'.$two;
9098: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
9099: my $secchange = 0;
9100: my $expire_role_result;
9101: my $modify_section_result;
1.628 raeburn 9102: if ($oldsec ne '-1') {
9103: if ($oldsec ne $sec) {
1.443 albertel 9104: $secchange = 1;
1.628 raeburn 9105: my $now = time;
1.443 albertel 9106: my $uurl='/'.$cid;
9107: $uurl=~s/\_/\//g;
9108: if ($oldsec) {
9109: $uurl.='/'.$oldsec;
9110: }
1.626 raeburn 9111: $oldsecurl = $uurl;
1.628 raeburn 9112: $expire_role_result =
1.652 raeburn 9113: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 9114: if ($env{'request.course.sec'} ne '') {
9115: if ($expire_role_result eq 'refused') {
9116: my @roles = ('st');
9117: my @statuses = ('previous');
9118: my @roledoms = ($one);
9119: my $withsec = 1;
9120: my %roleshash =
9121: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
9122: \@statuses,\@roles,\@roledoms,$withsec);
9123: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
9124: my ($oldstart,$oldend) =
9125: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
9126: if ($oldend > 0 && $oldend <= $now) {
9127: $expire_role_result = 'ok';
9128: }
9129: }
9130: }
9131: }
1.443 albertel 9132: $result = $expire_role_result;
9133: }
9134: }
9135: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 9136: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 9137: if ($modify_section_result =~ /^ok/) {
9138: if ($secchange == 1) {
1.628 raeburn 9139: if ($sec eq '') {
9140: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
9141: } else {
9142: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
9143: }
1.443 albertel 9144: } elsif ($oldsec eq '-1') {
1.628 raeburn 9145: if ($sec eq '') {
9146: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
9147: } else {
9148: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9149: }
1.443 albertel 9150: } else {
1.628 raeburn 9151: if ($sec eq '') {
9152: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
9153: } else {
9154: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9155: }
1.443 albertel 9156: }
9157: } else {
1.628 raeburn 9158: if ($secchange) {
9159: $$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;
9160: } else {
9161: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
9162: }
1.443 albertel 9163: }
9164: $result = $modify_section_result;
9165: } elsif ($secchange == 1) {
1.628 raeburn 9166: if ($oldsec eq '') {
9167: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
9168: } else {
9169: $$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;
9170: }
1.626 raeburn 9171: if ($expire_role_result eq 'refused') {
9172: my $newsecurl = '/'.$cid;
9173: $newsecurl =~ s/\_/\//g;
9174: if ($sec ne '') {
9175: $newsecurl.='/'.$sec;
9176: }
9177: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
9178: if ($sec eq '') {
9179: $$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;
9180: } else {
9181: $$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;
9182: }
9183: }
9184: }
1.443 albertel 9185: }
9186: } else {
1.626 raeburn 9187: $$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 9188: $result = "error: incomplete course id\n";
9189: }
9190: return $result;
9191: }
9192:
9193: ############################################################
9194: ############################################################
9195:
1.566 albertel 9196: sub check_clone {
1.578 raeburn 9197: my ($args,$linefeed) = @_;
1.566 albertel 9198: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
9199: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
9200: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
9201: my $clonemsg;
9202: my $can_clone = 0;
9203:
9204: if ($clonehome eq 'no_host') {
1.578 raeburn 9205: $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 9206: } else {
9207: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.568 albertel 9208: if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
1.566 albertel 9209: $can_clone = 1;
9210: } else {
9211: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
9212: $args->{'clonedomain'},$args->{'clonecourse'});
9213: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 9214: if (grep(/^\*$/,@cloners)) {
9215: $can_clone = 1;
9216: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
9217: $can_clone = 1;
9218: } else {
9219: my %roleshash =
9220: &Apache::lonnet::get_my_roles($args->{'ccuname'},
9221: $args->{'ccdomain'},
9222: 'userroles',['active'],['cc'],
9223: [$args->{'clonedomain'}]);
9224: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
9225: $can_clone = 1;
9226: } else {
9227: $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'});
9228: }
1.566 albertel 9229: }
1.578 raeburn 9230: }
1.566 albertel 9231: }
9232: return ($can_clone, $clonemsg, $cloneid, $clonehome);
9233: }
9234:
1.444 albertel 9235: sub construct_course {
1.541 raeburn 9236: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
1.444 albertel 9237: my $outcome;
1.541 raeburn 9238: my $linefeed = '<br />'."\n";
9239: if ($context eq 'auto') {
9240: $linefeed = "\n";
9241: }
1.566 albertel 9242:
9243: #
9244: # Are we cloning?
9245: #
9246: my ($can_clone, $clonemsg, $cloneid, $clonehome);
9247: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 9248: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 9249: if ($context ne 'auto') {
1.578 raeburn 9250: if ($clonemsg ne '') {
9251: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
9252: }
1.566 albertel 9253: }
9254: $outcome .= $clonemsg.$linefeed;
9255:
9256: if (!$can_clone) {
9257: return (0,$outcome);
9258: }
9259: }
9260:
1.444 albertel 9261: #
9262: # Open course
9263: #
9264: my $crstype = lc($args->{'crstype'});
9265: my %cenv=();
9266: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
9267: $args->{'cdescr'},
9268: $args->{'curl'},
9269: $args->{'course_home'},
9270: $args->{'nonstandard'},
9271: $args->{'crscode'},
9272: $args->{'ccuname'}.':'.
9273: $args->{'ccdomain'},
9274: $args->{'crstype'});
9275:
9276: # Note: The testing routines depend on this being output; see
9277: # Utils::Course. This needs to at least be output as a comment
9278: # if anyone ever decides to not show this, and Utils::Course::new
9279: # will need to be suitably modified.
1.541 raeburn 9280: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 9281: #
9282: # Check if created correctly
9283: #
1.479 albertel 9284: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 9285: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 9286: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 9287:
1.444 albertel 9288: #
1.566 albertel 9289: # Do the cloning
9290: #
9291: if ($can_clone && $cloneid) {
9292: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
9293: if ($context ne 'auto') {
9294: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
9295: }
9296: $outcome .= $clonemsg.$linefeed;
9297: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 9298: # Copy all files
1.637 www 9299: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 9300: # Restore URL
1.566 albertel 9301: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 9302: # Restore title
1.566 albertel 9303: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 9304: # Mark as cloned
1.566 albertel 9305: $cenv{'clonedfrom'}=$cloneid;
1.638 www 9306: # Need to clone grading mode
9307: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
9308: $cenv{'grading'}=$newenv{'grading'};
9309: # Do not clone these environment entries
9310: &Apache::lonnet::del('environment',
9311: ['default_enrollment_start_date',
9312: 'default_enrollment_end_date',
9313: 'question.email',
9314: 'policy.email',
9315: 'comment.email',
9316: 'pch.users.denied',
1.692.4.2 raeburn 9317: 'plc.users.denied',
9318: 'hidefromcat',
9319: 'categories'],
1.638 www 9320: $$crsudom,$$crsunum);
1.444 albertel 9321: }
1.566 albertel 9322:
1.444 albertel 9323: #
9324: # Set environment (will override cloned, if existing)
9325: #
9326: my @sections = ();
9327: my @xlists = ();
9328: if ($args->{'crstype'}) {
9329: $cenv{'type'}=$args->{'crstype'};
9330: }
9331: if ($args->{'crsid'}) {
9332: $cenv{'courseid'}=$args->{'crsid'};
9333: }
9334: if ($args->{'crscode'}) {
9335: $cenv{'internal.coursecode'}=$args->{'crscode'};
9336: }
9337: if ($args->{'crsquota'} ne '') {
9338: $cenv{'internal.coursequota'}=$args->{'crsquota'};
9339: } else {
9340: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
9341: }
9342: if ($args->{'ccuname'}) {
9343: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
9344: ':'.$args->{'ccdomain'};
9345: } else {
9346: $cenv{'internal.courseowner'} = $args->{'curruser'};
9347: }
9348: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
9349: if ($args->{'crssections'}) {
9350: $cenv{'internal.sectionnums'} = '';
9351: if ($args->{'crssections'} =~ m/,/) {
9352: @sections = split/,/,$args->{'crssections'};
9353: } else {
9354: $sections[0] = $args->{'crssections'};
9355: }
9356: if (@sections > 0) {
9357: foreach my $item (@sections) {
9358: my ($sec,$gp) = split/:/,$item;
9359: my $class = $args->{'crscode'}.$sec;
9360: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
9361: $cenv{'internal.sectionnums'} .= $item.',';
9362: unless ($addcheck eq 'ok') {
9363: push @badclasses, $class;
9364: }
9365: }
9366: $cenv{'internal.sectionnums'} =~ s/,$//;
9367: }
9368: }
9369: # do not hide course coordinator from staff listing,
9370: # even if privileged
9371: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9372: # add crosslistings
9373: if ($args->{'crsxlist'}) {
9374: $cenv{'internal.crosslistings'}='';
9375: if ($args->{'crsxlist'} =~ m/,/) {
9376: @xlists = split/,/,$args->{'crsxlist'};
9377: } else {
9378: $xlists[0] = $args->{'crsxlist'};
9379: }
9380: if (@xlists > 0) {
9381: foreach my $item (@xlists) {
9382: my ($xl,$gp) = split/:/,$item;
9383: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
9384: $cenv{'internal.crosslistings'} .= $item.',';
9385: unless ($addcheck eq 'ok') {
9386: push @badclasses, $xl;
9387: }
9388: }
9389: $cenv{'internal.crosslistings'} =~ s/,$//;
9390: }
9391: }
9392: if ($args->{'autoadds'}) {
9393: $cenv{'internal.autoadds'}=$args->{'autoadds'};
9394: }
9395: if ($args->{'autodrops'}) {
9396: $cenv{'internal.autodrops'}=$args->{'autodrops'};
9397: }
9398: # check for notification of enrollment changes
9399: my @notified = ();
9400: if ($args->{'notify_owner'}) {
9401: if ($args->{'ccuname'} ne '') {
9402: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
9403: }
9404: }
9405: if ($args->{'notify_dc'}) {
9406: if ($uname ne '') {
1.630 raeburn 9407: push(@notified,$uname.':'.$udom);
1.444 albertel 9408: }
9409: }
9410: if (@notified > 0) {
9411: my $notifylist;
9412: if (@notified > 1) {
9413: $notifylist = join(',',@notified);
9414: } else {
9415: $notifylist = $notified[0];
9416: }
9417: $cenv{'internal.notifylist'} = $notifylist;
9418: }
9419: if (@badclasses > 0) {
9420: my %lt=&Apache::lonlocal::texthash(
9421: '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',
9422: 'dnhr' => 'does not have rights to access enrollment in these classes',
9423: 'adby' => 'as determined by the policies of your institution on access to official classlists'
9424: );
1.541 raeburn 9425: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
9426: ' ('.$lt{'adby'}.')';
9427: if ($context eq 'auto') {
9428: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 9429: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 9430: foreach my $item (@badclasses) {
9431: if ($context eq 'auto') {
9432: $outcome .= " - $item\n";
9433: } else {
9434: $outcome .= "<li>$item</li>\n";
9435: }
9436: }
9437: if ($context eq 'auto') {
9438: $outcome .= $linefeed;
9439: } else {
1.566 albertel 9440: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 9441: }
9442: }
1.444 albertel 9443: }
9444: if ($args->{'no_end_date'}) {
9445: $args->{'endaccess'} = 0;
9446: }
9447: $cenv{'internal.autostart'}=$args->{'enrollstart'};
9448: $cenv{'internal.autoend'}=$args->{'enrollend'};
9449: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
9450: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
9451: if ($args->{'showphotos'}) {
9452: $cenv{'internal.showphotos'}=$args->{'showphotos'};
9453: }
9454: $cenv{'internal.authtype'} = $args->{'authtype'};
9455: $cenv{'internal.autharg'} = $args->{'autharg'};
9456: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
9457: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 9458: 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');
9459: if ($context eq 'auto') {
9460: $outcome .= $krb_msg;
9461: } else {
1.566 albertel 9462: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 9463: }
9464: $outcome .= $linefeed;
1.444 albertel 9465: }
9466: }
9467: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
9468: if ($args->{'setpolicy'}) {
9469: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9470: }
9471: if ($args->{'setcontent'}) {
9472: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9473: }
9474: }
9475: if ($args->{'reshome'}) {
9476: $cenv{'reshome'}=$args->{'reshome'}.'/';
9477: $cenv{'reshome'}=~s/\/+$/\//;
9478: }
9479: #
9480: # course has keyed access
9481: #
9482: if ($args->{'setkeys'}) {
9483: $cenv{'keyaccess'}='yes';
9484: }
9485: # if specified, key authority is not course, but user
9486: # only active if keyaccess is yes
9487: if ($args->{'keyauth'}) {
1.487 albertel 9488: my ($user,$domain) = split(':',$args->{'keyauth'});
9489: $user = &LONCAPA::clean_username($user);
9490: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 9491: if ($user ne '' && $domain ne '') {
1.487 albertel 9492: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 9493: }
9494: }
9495:
9496: if ($args->{'disresdis'}) {
9497: $cenv{'pch.roles.denied'}='st';
9498: }
9499: if ($args->{'disablechat'}) {
9500: $cenv{'plc.roles.denied'}='st';
9501: }
9502:
9503: # Record we've not yet viewed the Course Initialization Helper for this
9504: # course
9505: $cenv{'course.helper.not.run'} = 1;
9506: #
9507: # Use new Randomseed
9508: #
9509: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
9510: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
9511: #
9512: # The encryption code and receipt prefix for this course
9513: #
9514: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
9515: $cenv{'internal.encpref'}=100+int(9*rand(99));
9516: #
9517: # By default, use standard grading
9518: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
9519:
1.541 raeburn 9520: $outcome .= $linefeed.&mt('Setting environment').': '.
9521: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9522: #
9523: # Open all assignments
9524: #
9525: if ($args->{'openall'}) {
9526: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
9527: my %storecontent = ($storeunder => time,
9528: $storeunder.'.type' => 'date_start');
9529:
9530: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 9531: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9532: }
9533: #
9534: # Set first page
9535: #
9536: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
9537: || ($cloneid)) {
1.445 albertel 9538: use LONCAPA::map;
1.444 albertel 9539: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 9540:
9541: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
9542: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
9543:
1.444 albertel 9544: $outcome .= ($fatal?$errtext:'read ok').' - ';
9545: my $title; my $url;
9546: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 9547: $title=&mt('Syllabus');
1.444 albertel 9548: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
9549: } else {
1.690 bisitz 9550: $title=&mt('Navigate Contents');
1.444 albertel 9551: $url='/adm/navmaps';
9552: }
1.445 albertel 9553:
9554: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
9555: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
9556:
9557: if ($errtext) { $fatal=2; }
1.541 raeburn 9558: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 9559: }
1.566 albertel 9560:
9561: return (1,$outcome);
1.444 albertel 9562: }
9563:
9564: ############################################################
9565: ############################################################
9566:
1.378 raeburn 9567: sub course_type {
9568: my ($cid) = @_;
9569: if (!defined($cid)) {
9570: $cid = $env{'request.course.id'};
9571: }
1.404 albertel 9572: if (defined($env{'course.'.$cid.'.type'})) {
9573: return $env{'course.'.$cid.'.type'};
1.378 raeburn 9574: } else {
9575: return 'Course';
1.377 raeburn 9576: }
9577: }
1.156 albertel 9578:
1.406 raeburn 9579: sub group_term {
9580: my $crstype = &course_type();
9581: my %names = (
1.692.4.6 raeburn 9582: 'Course' => 'group',
9583: 'Community' => 'group',
1.406 raeburn 9584: );
9585: return $names{$crstype};
9586: }
9587:
1.156 albertel 9588: sub icon {
9589: my ($file)=@_;
1.505 albertel 9590: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 9591: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 9592: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 9593: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
9594: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
9595: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9596: $curfext.".gif") {
9597: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9598: $curfext.".gif";
9599: }
9600: }
1.249 albertel 9601: return &lonhttpdurl($iconname);
1.154 albertel 9602: }
1.84 albertel 9603:
1.575 albertel 9604: sub lonhttpdurl {
1.692 www 9605: #
9606: # Had been used for "small fry" static images on separate port 8080.
9607: # Modify here if lightweight http functionality desired again.
9608: # Currently eliminated due to increasing firewall issues.
9609: #
1.575 albertel 9610: my ($url)=@_;
1.692 www 9611: return $url;
1.215 albertel 9612: }
9613:
1.213 albertel 9614: sub connection_aborted {
9615: my ($r)=@_;
9616: $r->print(" ");$r->rflush();
9617: my $c = $r->connection;
9618: return $c->aborted();
9619: }
9620:
1.221 foxr 9621: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 9622: # strings as 'strings'.
9623: sub escape_single {
1.221 foxr 9624: my ($input) = @_;
1.223 albertel 9625: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 9626: $input =~ s/\'/\\\'/g; # Esacpe the 's....
9627: return $input;
9628: }
1.223 albertel 9629:
1.222 foxr 9630: # Same as escape_single, but escape's "'s This
9631: # can be used for "strings"
9632: sub escape_double {
9633: my ($input) = @_;
9634: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
9635: $input =~ s/\"/\\\"/g; # Esacpe the "s....
9636: return $input;
9637: }
1.223 albertel 9638:
1.222 foxr 9639: # Escapes the last element of a full URL.
9640: sub escape_url {
9641: my ($url) = @_;
1.238 raeburn 9642: my @urlslices = split(/\//, $url,-1);
1.369 www 9643: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 9644: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 9645: }
1.462 albertel 9646:
1.692.4.2 raeburn 9647: sub compare_arrays {
9648: my ($arrayref1,$arrayref2) = @_;
9649: my (@difference,%count);
9650: @difference = ();
9651: %count = ();
9652: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
9653: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
9654: foreach my $element (keys(%count)) {
9655: if ($count{$element} == 1) {
9656: push(@difference,$element);
9657: }
9658: }
9659: }
9660: return @difference;
9661: }
9662:
1.462 albertel 9663: # -------------------------------------------------------- Initliaze user login
9664: sub init_user_environment {
1.463 albertel 9665: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 9666: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
9667:
9668: my $public=($username eq 'public' && $domain eq 'public');
9669:
9670: # See if old ID present, if so, remove
9671:
9672: my ($filename,$cookie,$userroles);
9673: my $now=time;
9674:
9675: if ($public) {
9676: my $max_public=100;
9677: my $oldest;
9678: my $oldest_time=0;
9679: for(my $next=1;$next<=$max_public;$next++) {
9680: if (-e $lonids."/publicuser_$next.id") {
9681: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
9682: if ($mtime<$oldest_time || !$oldest_time) {
9683: $oldest_time=$mtime;
9684: $oldest=$next;
9685: }
9686: } else {
9687: $cookie="publicuser_$next";
9688: last;
9689: }
9690: }
9691: if (!$cookie) { $cookie="publicuser_$oldest"; }
9692: } else {
1.463 albertel 9693: # if this isn't a robot, kill any existing non-robot sessions
9694: if (!$args->{'robot'}) {
9695: opendir(DIR,$lonids);
9696: while ($filename=readdir(DIR)) {
9697: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
9698: unlink($lonids.'/'.$filename);
9699: }
1.462 albertel 9700: }
1.463 albertel 9701: closedir(DIR);
1.462 albertel 9702: }
9703: # Give them a new cookie
1.463 albertel 9704: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 9705: : $now.$$.int(rand(10000)));
1.463 albertel 9706: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 9707:
9708: # Initialize roles
9709:
9710: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
9711: }
9712: # ------------------------------------ Check browser type and MathML capability
9713:
9714: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
9715: $clientunicode,$clientos) = &decode_user_agent($r);
9716:
9717: # -------------------------------------- Any accessibility options to remember?
9718: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
9719: foreach my $option ('imagesuppress','appletsuppress',
9720: 'embedsuppress','fontenhance','blackwhite') {
9721: if ($form->{$option} eq 'true') {
9722: &Apache::lonnet::put('environment',{$option => 'on'},
9723: $domain,$username);
9724: } else {
9725: &Apache::lonnet::del('environment',[$option],
9726: $domain,$username);
9727: }
9728: }
9729: }
9730: # ------------------------------------------------------------- Get environment
9731:
9732: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
9733: my ($tmp) = keys(%userenv);
9734: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9735: # default remote control to off
9736: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
9737: } else {
9738: undef(%userenv);
9739: }
9740: if (($userenv{'interface'}) && (!$form->{'interface'})) {
9741: $form->{'interface'}=$userenv{'interface'};
9742: }
9743: $env{'environment.remote'}=$userenv{'remote'};
9744: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
9745:
9746: # --------------- Do not trust query string to be put directly into environment
9747: foreach my $option ('imagesuppress','appletsuppress',
9748: 'embedsuppress','fontenhance','blackwhite',
9749: 'interface','localpath','localres') {
9750: $form->{$option}=~s/[\n\r\=]//gs;
9751: }
9752: # --------------------------------------------------------- Write first profile
9753:
9754: {
9755: my %initial_env =
9756: ("user.name" => $username,
9757: "user.domain" => $domain,
9758: "user.home" => $authhost,
9759: "browser.type" => $clientbrowser,
9760: "browser.version" => $clientversion,
9761: "browser.mathml" => $clientmathml,
9762: "browser.unicode" => $clientunicode,
9763: "browser.os" => $clientos,
9764: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
9765: "request.course.fn" => '',
9766: "request.course.uri" => '',
9767: "request.course.sec" => '',
9768: "request.role" => 'cm',
9769: "request.role.adv" => $env{'user.adv'},
9770: "request.host" => $ENV{'REMOTE_ADDR'},);
9771:
9772: if ($form->{'localpath'}) {
9773: $initial_env{"browser.localpath"} = $form->{'localpath'};
9774: $initial_env{"browser.localres"} = $form->{'localres'};
9775: }
9776:
9777: if ($public) {
9778: $initial_env{"environment.remote"} = "off";
9779: }
9780: if ($form->{'interface'}) {
9781: $form->{'interface'}=~s/\W//gs;
9782: $initial_env{"browser.interface"} = $form->{'interface'};
9783: $env{'browser.interface'}=$form->{'interface'};
9784: foreach my $option ('imagesuppress','appletsuppress',
9785: 'embedsuppress','fontenhance','blackwhite') {
9786: if (($form->{$option} eq 'true') ||
9787: ($userenv{$option} eq 'on')) {
9788: $initial_env{"browser.$option"} = "on";
9789: }
9790: }
9791: }
9792:
1.692.4.2 raeburn 9793: foreach my $tool ('aboutme','blog','portfolio') {
9794: $userenv{'availabletools.'.$tool} =
9795: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
9796: }
9797:
1.692.4.6 raeburn 9798: foreach my $crstype ('official','unofficial','community') {
1.692.4.2 raeburn 9799: $userenv{'canrequest.'.$crstype} =
9800: &Apache::lonnet::usertools_access($username,$domain,$crstype,
9801: 'reload','requestcourses');
9802: }
9803:
1.462 albertel 9804: $env{'user.environment'} = "$lonids/$cookie.id";
9805:
9806: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
9807: &GDBM_WRCREAT(),0640)) {
9808: &_add_to_env(\%disk_env,\%initial_env);
9809: &_add_to_env(\%disk_env,\%userenv,'environment.');
9810: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 9811: if (ref($args->{'extra_env'})) {
9812: &_add_to_env(\%disk_env,$args->{'extra_env'});
9813: }
1.462 albertel 9814: untie(%disk_env);
9815: } else {
9816: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
9817: 'Could not create environment storage in lonauth: '.$!.'</font>');
9818: return 'error: '.$!;
9819: }
9820: }
9821: $env{'request.role'}='cm';
9822: $env{'request.role.adv'}=$env{'user.adv'};
9823: $env{'browser.type'}=$clientbrowser;
9824:
9825: return $cookie;
9826:
9827: }
9828:
9829: sub _add_to_env {
9830: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 9831: if (ref($env_data) eq 'HASH') {
9832: while (my ($key,$value) = each(%$env_data)) {
9833: $idf->{$prefix.$key} = $value;
9834: $env{$prefix.$key} = $value;
9835: }
1.462 albertel 9836: }
9837: }
9838:
1.685 tempelho 9839: # --- Get the symbolic name of a problem and the url
9840: sub get_symb {
9841: my ($request,$silent) = @_;
1.692.4.2 raeburn 9842: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 9843: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
9844: if ($symb eq '') {
9845: if (!$silent) {
9846: $request->print("Unable to handle ambiguous references:$url:.");
9847: return ();
9848: }
9849: }
9850: &Apache::lonenc::check_decrypt(\$symb);
9851: return ($symb);
9852: }
9853:
9854: # --------------------------------------------------------------Get annotation
9855:
9856: sub get_annotation {
9857: my ($symb,$enc) = @_;
9858:
9859: my $key = $symb;
9860: if (!$enc) {
9861: $key =
9862: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
9863: }
9864: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
9865: return $annotation{$key};
9866: }
9867:
9868: sub clean_symb {
1.692.4.2 raeburn 9869: my ($symb,$delete_enc) = @_;
1.685 tempelho 9870:
9871: &Apache::lonenc::check_decrypt(\$symb);
9872: my $enc = $env{'request.enc'};
1.692.4.2 raeburn 9873: if ($delete_enc) {
9874: delete($env{'request.enc'});
9875: }
1.685 tempelho 9876:
9877: return ($symb,$enc);
9878: }
1.462 albertel 9879:
1.41 ng 9880: =pod
9881:
9882: =back
9883:
1.112 bowersj2 9884: =cut
1.41 ng 9885:
1.112 bowersj2 9886: 1;
9887: __END__;
1.41 ng 9888:
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