Annotation of loncom/interface/loncommon.pm, revision 1.692.4.24
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.24! raeburn 4: # $Id: loncommon.pm,v 1.692.4.23 2010/01/19 16:20:38 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.692.4.22 raeburn 484: my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
485: my $wintitle = 'Course_Browser';
486: if ($crstype eq 'Community') {
487: $wintitle = 'Community_Browser';
488: }
1.692.4.9 raeburn 489: my $id_functions = &javascript_index_functions();
490: my $output = '
1.692.4.2 raeburn 491: <script type="text/javascript" language="JavaScript">
1.692.4.4 raeburn 492: // <![CDATA[
1.468 raeburn 493: var stdeditbrowser;'."\n";
1.692.4.9 raeburn 494:
495: $output .= <<"ENDSTDBRW";
1.692.4.22 raeburn 496: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 497: var url = '/adm/pickcourse?';
1.692.4.18 raeburn 498: var formid = getFormIdByName(formname);
1.692.4.9 raeburn 499: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 500: if (domainfilter != null) {
501: if (domainfilter != '') {
502: url += 'domainfilter='+domainfilter+'&';
503: }
504: }
1.91 www 505: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 506: '&cdomelement='+udom+
507: '&cnameelement='+desc;
1.468 raeburn 508: if (extra_element !=null && extra_element != '') {
1.594 raeburn 509: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 510: url += '&roleelement='+extra_element;
511: if (domainfilter == null || domainfilter == '') {
512: url += '&domainfilter='+extra_element;
513: }
1.234 raeburn 514: }
1.468 raeburn 515: else {
516: if (formname == 'portform') {
517: url += '&setroles='+extra_element;
518: }
519: }
1.230 raeburn 520: }
1.692.4.22 raeburn 521: if (type != null && type != '') {
522: url += '&type='+type;
523: }
524: if (type_elem != null && type_elem != '') {
525: url += '&typeelement='+type_elem;
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.22 raeburn 535: var title = '$wintitle';
1.91 www 536: var options = 'scrollbars=1,resizable=1,menubar=0';
537: options += ',width=700,height=600';
538: stdeditbrowser = open(url,title,options,'1');
539: stdeditbrowser.focus();
540: }
1.692.4.9 raeburn 541: $id_functions
1.91 www 542: ENDSTDBRW
1.692.4.21 raeburn 543: if (($sec_element ne '') || ($role_element ne '')) {
544: $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.468 raeburn 545: }
546: $output .= '
1.692.4.4 raeburn 547: // ]]>
1.468 raeburn 548: </script>';
549: return $output;
550: }
551:
1.692.4.9 raeburn 552: sub javascript_index_functions {
553: return <<"ENDJS";
554:
555: function getFormIdByName(formname) {
556: for (var i=0;i<document.forms.length;i++) {
557: if (document.forms[i].name == formname) {
558: return i;
559: }
560: }
561: return -1;
562: }
563:
564: function getIndexByName(formid,item) {
565: for (var i=0;i<document.forms[formid].elements.length;i++) {
566: if (document.forms[formid].elements[i].name == item) {
567: return i;
568: }
569: }
570: return -1;
571: }
572:
573: function getDomainFromSelectbox(formname,udom) {
574: var userdom;
575: var formid = getFormIdByName(formname);
576: if (formid > -1) {
577: var domid = getIndexByName(formid,udom);
578: if (domid > -1) {
579: if (document.forms[formid].elements[domid].type == 'select-one') {
580: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
581: }
582: if (document.forms[formid].elements[domid].type == 'hidden') {
583: userdom=document.forms[formid].elements[domid].value;
584: }
585: }
586: }
587: return userdom;
588: }
589:
590: ENDJS
591:
592: }
593:
594: sub userbrowser_javascript {
595: my $id_functions = &javascript_index_functions();
596: return <<"ENDUSERBRW";
597:
1.692.4.17 raeburn 598: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.692.4.9 raeburn 599: var url = '/adm/pickuser?';
600: var userdom = getDomainFromSelectbox(formname,udom);
601: if (userdom != null) {
602: if (userdom != '') {
603: url += 'srchdom='+userdom+'&';
604: }
605: }
606: url += 'form=' + formname + '&unameelement='+uname+
607: '&udomelement='+udom+
608: '&ulastelement='+ulast+
609: '&ufirstelement='+ufirst+
610: '&uemailelement='+uemail+
611: '&hideudomelement='+hideudom+
612: '&coursedom='+crsdom;
1.692.4.17 raeburn 613: if ((caller != null) && (caller != undefined)) {
614: url += '&caller='+caller;
615: }
1.692.4.9 raeburn 616: var title = 'User_Browser';
617: var options = 'scrollbars=1,resizable=1,menubar=0';
618: options += ',width=700,height=600';
619: var stdeditbrowser = open(url,title,options,'1');
620: stdeditbrowser.focus();
621: }
622:
1.692.4.17 raeburn 623: function fix_domain (formname,udom,origdom,uname) {
1.692.4.9 raeburn 624: var formid = getFormIdByName(formname);
625: if (formid > -1) {
1.692.4.17 raeburn 626: var unameid = getIndexByName(formid,uname);
1.692.4.9 raeburn 627: var domid = getIndexByName(formid,udom);
628: var hidedomid = getIndexByName(formid,origdom);
629: if (hidedomid > -1) {
630: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.692.4.17 raeburn 631: var unameval = document.forms[formid].elements[unameid].value;
632: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
633: if (domid > -1) {
634: var slct = document.forms[formid].elements[domid];
635: if (slct.type == 'select-one') {
636: var i;
637: for (i=0;i<slct.length;i++) {
638: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
639: }
640: }
641: if (slct.type == 'hidden') {
642: slct.value = fixeddom;
1.692.4.9 raeburn 643: }
644: }
645: }
646: }
647: }
648: return;
649: }
650:
651: $id_functions
652: ENDUSERBRW
653: }
654:
655:
1.468 raeburn 656: sub setsec_javascript {
1.692.4.21 raeburn 657: my ($sec_element,$formname,$role_element) = @_;
658: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
659: $communityrolestr);
660: if ($role_element ne '') {
661: my @allroles = ('st','ta','ep','in','ad');
662: foreach my $crstype ('Course','Community') {
663: if ($crstype eq 'Community') {
664: foreach my $role (@allroles) {
665: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
666: }
667: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
668: } else {
669: foreach my $role (@allroles) {
670: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
671: }
672: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
673: }
674: }
675: $rolestr = '"'.join('","',@allroles).'"';
676: $courserolestr = '"'.join('","',@courserolenames).'"';
677: $communityrolestr = '"'.join('","',@communityrolenames).'"';
678: }
1.468 raeburn 679: my $setsections = qq|
680: function setSect(sectionlist) {
1.629 raeburn 681: var sectionsArray = new Array();
682: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
683: sectionsArray = sectionlist.split(",");
684: }
1.468 raeburn 685: var numSections = sectionsArray.length;
686: document.$formname.$sec_element.length = 0;
687: if (numSections == 0) {
688: document.$formname.$sec_element.multiple=false;
689: document.$formname.$sec_element.size=1;
690: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
691: } else {
692: if (numSections == 1) {
693: document.$formname.$sec_element.multiple=false;
694: document.$formname.$sec_element.size=1;
695: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
696: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
697: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
698: } else {
699: for (var i=0; i<numSections; i++) {
700: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
701: }
702: document.$formname.$sec_element.multiple=true
703: if (numSections < 3) {
704: document.$formname.$sec_element.size=numSections;
705: } else {
706: document.$formname.$sec_element.size=3;
707: }
708: document.$formname.$sec_element.options[0].selected = false
709: }
710: }
1.91 www 711: }
1.692.4.21 raeburn 712:
713: function setRole(crstype) {
714: |;
715: if ($role_element eq '') {
716: $setsections .= ' return;
717: }
718: ';
719: } else {
720: $setsections .= qq|
721: var elementLength = document.$formname.$role_element.length;
722: var allroles = Array($rolestr);
723: var courserolenames = Array($courserolestr);
724: var communityrolenames = Array($communityrolestr);
725: if (elementLength != undefined) {
726: if (document.$formname.$role_element.options[5].value == 'cc') {
727: if (crstype == 'Course') {
728: return;
729: } else {
730: allroles[5] = 'co';
731: for (var i=0; i<6; i++) {
732: document.$formname.$role_element.options[i].value = allroles[i];
733: document.$formname.$role_element.options[i].text = communityrolenames[i];
734: }
735: }
736: } else {
737: if (crstype == 'Community') {
738: return;
739: } else {
740: allroles[5] = 'cc';
741: for (var i=0; i<6; i++) {
742: document.$formname.$role_element.options[i].value = allroles[i];
743: document.$formname.$role_element.options[i].text = courserolenames[i];
744: }
745: }
746: }
747: }
748: return;
749: }
1.468 raeburn 750: |;
1.692.4.21 raeburn 751: }
1.468 raeburn 752: return $setsections;
753: }
754:
1.91 www 755: sub selectcourse_link {
1.692.4.22 raeburn 756: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
757: $typeelement) = @_;
758: my $type = $selecttype;
1.692.4.6 raeburn 759: my $linktext = &mt('Select Course');
760: if ($selecttype eq 'Community') {
761: $linktext = &mt('Select Community');
1.692.4.22 raeburn 762: } elsif ($selecttype eq 'Course/Community') {
763: $linktext = &mt('Select Course/Community');
764: $type = '';
1.692.4.6 raeburn 765: }
1.692.4.2 raeburn 766: return '<span class="LC_nobreak">'
767: ."<a href='"
768: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
769: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.692.4.22 raeburn 770: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.692.4.6 raeburn 771: ."'>".$linktext.'</a>'
1.692.4.2 raeburn 772: .'</span>';
1.74 www 773: }
1.42 matthew 774:
1.653 raeburn 775: sub selectauthor_link {
776: my ($form,$udom)=@_;
777: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
778: &mt('Select Author').'</a>';
779: }
780:
1.692.4.9 raeburn 781: sub selectuser_link {
782: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.692.4.17 raeburn 783: $coursedom,$linktext,$caller) = @_;
1.692.4.9 raeburn 784: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.692.4.17 raeburn 785: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.692.4.9 raeburn 786: ');">'.$linktext.'</a>';
787: }
788:
1.273 raeburn 789: sub check_uncheck_jscript {
790: my $jscript = <<"ENDSCRT";
791: function checkAll(field) {
792: if (field.length > 0) {
793: for (i = 0; i < field.length; i++) {
794: field[i].checked = true ;
795: }
796: } else {
797: field.checked = true
798: }
799: }
800:
801: function uncheckAll(field) {
802: if (field.length > 0) {
803: for (i = 0; i < field.length; i++) {
804: field[i].checked = false ;
1.543 albertel 805: }
806: } else {
1.273 raeburn 807: field.checked = false ;
808: }
809: }
810: ENDSCRT
811: return $jscript;
812: }
813:
1.656 www 814: sub select_timezone {
1.659 raeburn 815: my ($name,$selected,$onchange,$includeempty)=@_;
816: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
817: if ($includeempty) {
818: $output .= '<option value=""';
819: if (($selected eq '') || ($selected eq 'local')) {
820: $output .= ' selected="selected" ';
821: }
822: $output .= '> </option>';
823: }
1.657 raeburn 824: my @timezones = DateTime::TimeZone->all_names;
825: foreach my $tzone (@timezones) {
826: $output.= '<option value="'.$tzone.'"';
827: if ($tzone eq $selected) {
828: $output.=' selected="selected"';
829: }
830: $output.=">$tzone</option>\n";
1.656 www 831: }
832: $output.="</select>";
833: return $output;
834: }
1.273 raeburn 835:
1.687 raeburn 836: sub select_datelocale {
837: my ($name,$selected,$onchange,$includeempty)=@_;
838: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
839: if ($includeempty) {
840: $output .= '<option value=""';
841: if ($selected eq '') {
842: $output .= ' selected="selected" ';
843: }
844: $output .= '> </option>';
845: }
846: my (@possibles,%locale_names);
847: my @locales = DateTime::Locale::Catalog::Locales;
848: foreach my $locale (@locales) {
849: if (ref($locale) eq 'HASH') {
850: my $id = $locale->{'id'};
851: if ($id ne '') {
852: my $en_terr = $locale->{'en_territory'};
853: my $native_terr = $locale->{'native_territory'};
1.692.4.1 raeburn 854: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 855: if (grep(/^en$/,@languages) || !@languages) {
856: if ($en_terr ne '') {
857: $locale_names{$id} = '('.$en_terr.')';
858: } elsif ($native_terr ne '') {
859: $locale_names{$id} = $native_terr;
860: }
861: } else {
862: if ($native_terr ne '') {
863: $locale_names{$id} = $native_terr.' ';
864: } elsif ($en_terr ne '') {
865: $locale_names{$id} = '('.$en_terr.')';
866: }
867: }
868: push (@possibles,$id);
869: }
870: }
871: }
872: foreach my $item (sort(@possibles)) {
873: $output.= '<option value="'.$item.'"';
874: if ($item eq $selected) {
875: $output.=' selected="selected"';
876: }
877: $output.=">$item";
878: if ($locale_names{$item} ne '') {
879: $output.=" $locale_names{$item}</option>\n";
880: }
881: $output.="</option>\n";
882: }
883: $output.="</select>";
884: return $output;
885: }
886:
1.692.4.2 raeburn 887: sub select_language {
888: my ($name,$selected,$includeempty) = @_;
889: my %langchoices;
890: if ($includeempty) {
891: %langchoices = ('' => 'No language preference');
892: }
893: foreach my $id (&languageids()) {
894: my $code = &supportedlanguagecode($id);
895: if ($code) {
896: $langchoices{$code} = &plainlanguagedescription($id);
897: }
898: }
899: return &select_form($selected,$name,%langchoices);
900: }
901:
1.42 matthew 902: =pod
1.36 matthew 903:
1.648 raeburn 904: =item * &linked_select_forms(...)
1.36 matthew 905:
906: linked_select_forms returns a string containing a <script></script> block
907: and html for two <select> menus. The select menus will be linked in that
908: changing the value of the first menu will result in new values being placed
909: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 910: order unless a defined order is provided.
1.36 matthew 911:
912: linked_select_forms takes the following ordered inputs:
913:
914: =over 4
915:
1.112 bowersj2 916: =item * $formname, the name of the <form> tag
1.36 matthew 917:
1.112 bowersj2 918: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 919:
1.112 bowersj2 920: =item * $firstdefault, the default value for the first menu
1.36 matthew 921:
1.112 bowersj2 922: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 923:
1.112 bowersj2 924: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 925:
1.112 bowersj2 926: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 927:
1.609 raeburn 928: =item * $menuorder, the order of values in the first menu
929:
1.41 ng 930: =back
931:
1.36 matthew 932: Below is an example of such a hash. Only the 'text', 'default', and
933: 'select2' keys must appear as stated. keys(%menu) are the possible
934: values for the first select menu. The text that coincides with the
1.41 ng 935: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 936: and text for the second menu are given in the hash pointed to by
937: $menu{$choice1}->{'select2'}.
938:
1.112 bowersj2 939: my %menu = ( A1 => { text =>"Choice A1" ,
940: default => "B3",
941: select2 => {
942: B1 => "Choice B1",
943: B2 => "Choice B2",
944: B3 => "Choice B3",
945: B4 => "Choice B4"
1.609 raeburn 946: },
947: order => ['B4','B3','B1','B2'],
1.112 bowersj2 948: },
949: A2 => { text =>"Choice A2" ,
950: default => "C2",
951: select2 => {
952: C1 => "Choice C1",
953: C2 => "Choice C2",
954: C3 => "Choice C3"
1.609 raeburn 955: },
956: order => ['C2','C1','C3'],
1.112 bowersj2 957: },
958: A3 => { text =>"Choice A3" ,
959: default => "D6",
960: select2 => {
961: D1 => "Choice D1",
962: D2 => "Choice D2",
963: D3 => "Choice D3",
964: D4 => "Choice D4",
965: D5 => "Choice D5",
966: D6 => "Choice D6",
967: D7 => "Choice D7"
1.609 raeburn 968: },
969: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 970: }
971: );
1.36 matthew 972:
973: =cut
974:
975: sub linked_select_forms {
976: my ($formname,
977: $middletext,
978: $firstdefault,
979: $firstselectname,
980: $secondselectname,
1.609 raeburn 981: $hashref,
982: $menuorder,
1.36 matthew 983: ) = @_;
984: my $second = "document.$formname.$secondselectname";
985: my $first = "document.$formname.$firstselectname";
986: # output the javascript to do the changing
987: my $result = '';
1.692.4.2 raeburn 988: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.692.4.4 raeburn 989: $result.="// <![CDATA[\n";
1.36 matthew 990: $result.="var select2data = new Object();\n";
991: $" = '","';
992: my $debug = '';
993: foreach my $s1 (sort(keys(%$hashref))) {
994: $result.="select2data.d_$s1 = new Object();\n";
995: $result.="select2data.d_$s1.def = new String('".
996: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 997: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 998: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 999: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1000: @s2values = @{$hashref->{$s1}->{'order'}};
1001: }
1.36 matthew 1002: $result.="\"@s2values\");\n";
1003: $result.="select2data.d_$s1.texts = new Array(";
1004: my @s2texts;
1005: foreach my $value (@s2values) {
1006: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1007: }
1008: $result.="\"@s2texts\");\n";
1009: }
1010: $"=' ';
1011: $result.= <<"END";
1012:
1013: function select1_changed() {
1014: // Determine new choice
1015: var newvalue = "d_" + $first.value;
1016: // update select2
1017: var values = select2data[newvalue].values;
1018: var texts = select2data[newvalue].texts;
1019: var select2def = select2data[newvalue].def;
1020: var i;
1021: // out with the old
1022: for (i = 0; i < $second.options.length; i++) {
1023: $second.options[i] = null;
1024: }
1025: // in with the nuclear
1026: for (i=0;i<values.length; i++) {
1027: $second.options[i] = new Option(values[i]);
1.143 matthew 1028: $second.options[i].value = values[i];
1.36 matthew 1029: $second.options[i].text = texts[i];
1030: if (values[i] == select2def) {
1031: $second.options[i].selected = true;
1032: }
1033: }
1034: }
1.692.4.4 raeburn 1035: // ]]>
1.36 matthew 1036: </script>
1037: END
1038: # output the initial values for the selection lists
1039: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 1040: my @order = sort(keys(%{$hashref}));
1041: if (ref($menuorder) eq 'ARRAY') {
1042: @order = @{$menuorder};
1043: }
1044: foreach my $value (@order) {
1.36 matthew 1045: $result.=" <option value=\"$value\" ";
1.253 albertel 1046: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1047: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1048: }
1049: $result .= "</select>\n";
1050: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1051: $result .= $middletext;
1052: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
1053: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1054:
1055: my @secondorder = sort(keys(%select2));
1056: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1057: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1058: }
1059: foreach my $value (@secondorder) {
1.36 matthew 1060: $result.=" <option value=\"$value\" ";
1.253 albertel 1061: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1062: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1063: }
1064: $result .= "</select>\n";
1065: # return $debug;
1066: return $result;
1067: } # end of sub linked_select_forms {
1068:
1.45 matthew 1069: =pod
1.44 bowersj2 1070:
1.648 raeburn 1071: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44 bowersj2 1072:
1.112 bowersj2 1073: Returns a string corresponding to an HTML link to the given help
1074: $topic, where $topic corresponds to the name of a .tex file in
1075: /home/httpd/html/adm/help/tex, with underscores replaced by
1076: spaces.
1077:
1078: $text will optionally be linked to the same topic, allowing you to
1079: link text in addition to the graphic. If you do not want to link
1080: text, but wish to specify one of the later parameters, pass an
1081: empty string.
1082:
1083: $stayOnPage is a value that will be interpreted as a boolean. If true,
1084: the link will not open a new window. If false, the link will open
1085: a new window using Javascript. (Default is false.)
1086:
1087: $width and $height are optional numerical parameters that will
1088: override the width and height of the popped up window, which may
1089: be useful for certain help topics with big pictures included.
1.44 bowersj2 1090:
1091: =cut
1092:
1093: sub help_open_topic {
1.48 bowersj2 1094: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1095: $text = "" if (not defined $text);
1.44 bowersj2 1096: $stayOnPage = 0 if (not defined $stayOnPage);
1.552 banghart 1097: if ($env{'browser.interface'} eq 'textual') {
1.79 www 1098: $stayOnPage=1;
1099: }
1.44 bowersj2 1100: $width = 350 if (not defined $width);
1101: $height = 400 if (not defined $height);
1102: my $filename = $topic;
1103: $filename =~ s/ /_/g;
1104:
1.48 bowersj2 1105: my $template = "";
1106: my $link;
1.572 banghart 1107:
1.159 www 1108: $topic=~s/\W/\_/g;
1.44 bowersj2 1109:
1.572 banghart 1110: if (!$stayOnPage) {
1.72 bowersj2 1111: $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 1112: } else {
1.48 bowersj2 1113: $link = "/adm/help/${filename}.hlp";
1114: }
1115:
1116: # Add the text
1.572 banghart 1117: if ($text ne "") {
1.77 www 1118: $template .=
1.572 banghart 1119: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.691 bisitz 1120: "<td bgcolor='#5555FF'><span class=\"LC_nobreak\"><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 1121: }
1122:
1123: # Add the graphic
1.179 matthew 1124: my $title = &mt('Online Help');
1.667 raeburn 1125: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.692.4.2 raeburn 1126: $template .= '<a target="_top" href="'.$link.'" title="'.$title.'">'.
1127: '<img src="'.$helpicon.'" border="0" alt="'.&mt('Help: [_1]',$topic).
1128: '" title="'.$title.'" /></a>';
1129: if ($text ne '') {
1130: $template.='</span></td></tr></table>';
1131: }
1.44 bowersj2 1132: return $template;
1133:
1.106 bowersj2 1134: }
1135:
1136: # This is a quicky function for Latex cheatsheet editing, since it
1137: # appears in at least four places
1138: sub helpLatexCheatsheet {
1.692.4.2 raeburn 1139: my ($topic,$text,$not_author) = @_;
1140: my $out;
1.106 bowersj2 1141: my $addOther = '';
1.692.4.3 raeburn 1142: if ($topic) {
1.692.4.2 raeburn 1143: $addOther = &Apache::loncommon::help_open_topic($topic,$text,
1.106 bowersj2 1144: undef, undef, 600) .
1145: '</td><td>';
1146: }
1.692.4.2 raeburn 1147: $out = '<table><tr><td>'.
1148: $addOther .
1149: &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
1150: undef,undef,600).
1151: '</td><td>'.
1152: &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
1153: undef,undef,600).
1154: '</td>';
1155: unless ($not_author) {
1156: $out .= '<td>'.
1157: &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
1158: undef,undef,600).
1159: '</td>';
1160: }
1161: $out .= '</tr></table>';
1162: return $out;
1.172 www 1163: }
1164:
1.430 albertel 1165: sub general_help {
1166: my $helptopic='Student_Intro';
1167: if ($env{'request.role'}=~/^(ca|au)/) {
1168: $helptopic='Authoring_Intro';
1.692.4.22 raeburn 1169: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1170: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1171: } elsif ($env{'request.role'}=~/^dc/) {
1172: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1173: }
1174: return $helptopic;
1175: }
1176:
1177: sub update_help_link {
1178: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1179: my $origurl = $ENV{'REQUEST_URI'};
1180: $origurl=~s|^/~|/priv/|;
1181: my $timestamp = time;
1182: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1183: $$datum = &escape($$datum);
1184: }
1185:
1186: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1187: my $output .= <<"ENDOUTPUT";
1188: <script type="text/javascript">
1.692.4.4 raeburn 1189: // <![CDATA[
1.430 albertel 1190: banner_link = '$banner_link';
1.692.4.4 raeburn 1191: // ]]>
1.430 albertel 1192: </script>
1193: ENDOUTPUT
1194: return $output;
1195: }
1196:
1197: # now just updates the help link and generates a blue icon
1.193 raeburn 1198: sub help_open_menu {
1.430 albertel 1199: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1200: = @_;
1.430 albertel 1201: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 1202: # only use pop-up help (stayOnPage == 0)
1.552 banghart 1203: # if environment.remote is on (using remote control UI)
1.572 banghart 1204: if ($env{'browser.interface'} eq 'textual' ||
1205: $env{'environment.remote'} eq 'off' ) {
1.552 banghart 1206: $stayOnPage=1;
1.430 albertel 1207: }
1208: my $output;
1209: if ($component_help) {
1210: if (!$text) {
1211: $output=&help_open_topic($component_help,undef,$stayOnPage,
1212: $width,$height);
1213: } else {
1214: my $help_text;
1215: $help_text=&unescape($topic);
1216: $output='<table><tr><td>'.
1217: &help_open_topic($component_help,$help_text,$stayOnPage,
1218: $width,$height).'</td></tr></table>';
1219: }
1220: }
1221: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1222: return $output.$banner_link;
1223: }
1224:
1225: sub top_nav_help {
1226: my ($text) = @_;
1.436 albertel 1227: $text = &mt($text);
1.572 banghart 1228: my $stay_on_page =
1.436 albertel 1229: ($env{'browser.interface'} eq 'textual' ||
1230: $env{'environment.remote'} eq 'off' );
1.572 banghart 1231: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1232: : "javascript:helpMenu('open')";
1.572 banghart 1233: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1234:
1.201 raeburn 1235: my $title = &mt('Get help');
1.436 albertel 1236:
1237: return <<"END";
1238: $banner_link
1239: <a href="$link" title="$title">$text</a>
1240: END
1241: }
1242:
1243: sub help_menu_js {
1244: my ($text) = @_;
1245:
1246: my $stayOnPage =
1247: ($env{'browser.interface'} eq 'textual' ||
1248: $env{'environment.remote'} eq 'off' );
1249:
1250: my $width = 620;
1251: my $height = 600;
1.430 albertel 1252: my $helptopic=&general_help();
1253: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1254: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1255: my $start_page =
1256: &Apache::loncommon::start_page('Help Menu', undef,
1257: {'frameset' => 1,
1258: 'js_ready' => 1,
1259: 'add_entries' => {
1260: 'border' => '0',
1.579 raeburn 1261: 'rows' => "110,*",},});
1.331 albertel 1262: my $end_page =
1263: &Apache::loncommon::end_page({'frameset' => 1,
1264: 'js_ready' => 1,});
1265:
1.436 albertel 1266: my $template .= <<"ENDTEMPLATE";
1267: <script type="text/javascript">
1.253 albertel 1268: // <![CDATA[
1.692.4.10 raeburn 1269: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1270: var banner_link = '';
1.243 raeburn 1271: function helpMenu(target) {
1272: var caller = this;
1273: if (target == 'open') {
1274: var newWindow = null;
1275: try {
1.262 albertel 1276: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1277: }
1278: catch(error) {
1279: writeHelp(caller);
1280: return;
1281: }
1282: if (newWindow) {
1283: caller = newWindow;
1284: }
1.193 raeburn 1285: }
1.243 raeburn 1286: writeHelp(caller);
1287: return;
1288: }
1289: function writeHelp(caller) {
1.430 albertel 1290: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 1291: caller.document.close()
1292: caller.focus()
1.193 raeburn 1293: }
1.219 albertel 1294: // END LON-CAPA Internal -->
1.692.4.10 raeburn 1295: // ]]>
1.436 albertel 1296: </script>
1.193 raeburn 1297: ENDTEMPLATE
1298: return $template;
1299: }
1300:
1.172 www 1301: sub help_open_bug {
1302: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1303: unless ($env{'user.adv'}) { return ''; }
1.172 www 1304: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1305: $text = "" if (not defined $text);
1306: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1307: if ($env{'browser.interface'} eq 'textual' ||
1308: $env{'environment.remote'} eq 'off' ) {
1.172 www 1309: $stayOnPage=1;
1310: }
1.184 albertel 1311: $width = 600 if (not defined $width);
1312: $height = 600 if (not defined $height);
1.172 www 1313:
1314: $topic=~s/\W+/\+/g;
1315: my $link='';
1316: my $template='';
1.379 albertel 1317: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1318: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1319: if (!$stayOnPage)
1320: {
1321: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1322: }
1323: else
1324: {
1325: $link = $url;
1326: }
1327: # Add the text
1328: if ($text ne "")
1329: {
1330: $template .=
1331: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1332: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1333: }
1334:
1335: # Add the graphic
1.179 matthew 1336: my $title = &mt('Report a Bug');
1.215 albertel 1337: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1338: $template .= <<"ENDTEMPLATE";
1.436 albertel 1339: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1340: ENDTEMPLATE
1341: if ($text ne '') { $template.='</td></tr></table>' };
1342: return $template;
1343:
1344: }
1345:
1346: sub help_open_faq {
1347: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1348: unless ($env{'user.adv'}) { return ''; }
1.172 www 1349: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1350: $text = "" if (not defined $text);
1351: $stayOnPage = 0 if (not defined $stayOnPage);
1.258 albertel 1352: if ($env{'browser.interface'} eq 'textual' ||
1353: $env{'environment.remote'} eq 'off' ) {
1.172 www 1354: $stayOnPage=1;
1355: }
1356: $width = 350 if (not defined $width);
1357: $height = 400 if (not defined $height);
1358:
1359: $topic=~s/\W+/\+/g;
1360: my $link='';
1361: my $template='';
1362: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1363: if (!$stayOnPage)
1364: {
1365: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1366: }
1367: else
1368: {
1369: $link = $url;
1370: }
1371:
1372: # Add the text
1373: if ($text ne "")
1374: {
1375: $template .=
1.173 www 1376: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.436 albertel 1377: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.172 www 1378: }
1379:
1380: # Add the graphic
1.179 matthew 1381: my $title = &mt('View the FAQ');
1.215 albertel 1382: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1383: $template .= <<"ENDTEMPLATE";
1.436 albertel 1384: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1385: ENDTEMPLATE
1386: if ($text ne '') { $template.='</td></tr></table>' };
1387: return $template;
1388:
1.44 bowersj2 1389: }
1.37 matthew 1390:
1.180 matthew 1391: ###############################################################
1392: ###############################################################
1393:
1.45 matthew 1394: =pod
1395:
1.648 raeburn 1396: =item * &change_content_javascript():
1.256 matthew 1397:
1398: This and the next function allow you to create small sections of an
1399: otherwise static HTML page that you can update on the fly with
1400: Javascript, even in Netscape 4.
1401:
1402: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1403: must be written to the HTML page once. It will prove the Javascript
1404: function "change(name, content)". Calling the change function with the
1405: name of the section
1406: you want to update, matching the name passed to C<changable_area>, and
1407: the new content you want to put in there, will put the content into
1408: that area.
1409:
1410: B<Note>: Netscape 4 only reserves enough space for the changable area
1411: to contain room for the original contents. You need to "make space"
1412: for whatever changes you wish to make, and be B<sure> to check your
1413: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1414: it's adequate for updating a one-line status display, but little more.
1415: This script will set the space to 100% width, so you only need to
1416: worry about height in Netscape 4.
1417:
1418: Modern browsers are much less limiting, and if you can commit to the
1419: user not using Netscape 4, this feature may be used freely with
1420: pretty much any HTML.
1421:
1422: =cut
1423:
1424: sub change_content_javascript {
1425: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1426: if ($env{'browser.type'} eq 'netscape' &&
1427: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1428: return (<<NETSCAPE4);
1429: function change(name, content) {
1430: doc = document.layers[name+"___escape"].layers[0].document;
1431: doc.open();
1432: doc.write(content);
1433: doc.close();
1434: }
1435: NETSCAPE4
1436: } else {
1437: # Otherwise, we need to use semi-standards-compliant code
1438: # (technically, "innerHTML" isn't standard but the equivalent
1439: # is really scary, and every useful browser supports it
1440: return (<<DOMBASED);
1441: function change(name, content) {
1442: element = document.getElementById(name);
1443: element.innerHTML = content;
1444: }
1445: DOMBASED
1446: }
1447: }
1448:
1449: =pod
1450:
1.648 raeburn 1451: =item * &changable_area($name,$origContent):
1.256 matthew 1452:
1453: This provides a "changable area" that can be modified on the fly via
1454: the Javascript code provided in C<change_content_javascript>. $name is
1455: the name you will use to reference the area later; do not repeat the
1456: same name on a given HTML page more then once. $origContent is what
1457: the area will originally contain, which can be left blank.
1458:
1459: =cut
1460:
1461: sub changable_area {
1462: my ($name, $origContent) = @_;
1463:
1.258 albertel 1464: if ($env{'browser.type'} eq 'netscape' &&
1465: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1466: # If this is netscape 4, we need to use the Layer tag
1467: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1468: } else {
1469: return "<span id='$name'>$origContent</span>";
1470: }
1471: }
1472:
1473: =pod
1474:
1.648 raeburn 1475: =item * &viewport_geometry_js
1.590 raeburn 1476:
1477: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1478:
1479: =cut
1480:
1481:
1482: sub viewport_geometry_js {
1483: return <<"GEOMETRY";
1484: var Geometry = {};
1485: function init_geometry() {
1486: if (Geometry.init) { return };
1487: Geometry.init=1;
1488: if (window.innerHeight) {
1489: Geometry.getViewportHeight = function() { return window.innerHeight; };
1490: Geometry.getViewportWidth = function() { return window.innerWidth; };
1491: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1492: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1493: }
1494: else if (document.documentElement && document.documentElement.clientHeight) {
1495: Geometry.getViewportHeight =
1496: function() { return document.documentElement.clientHeight; };
1497: Geometry.getViewportWidth =
1498: function() { return document.documentElement.clientWidth; };
1499:
1500: Geometry.getHorizontalScroll =
1501: function() { return document.documentElement.scrollLeft; };
1502: Geometry.getVerticalScroll =
1503: function() { return document.documentElement.scrollTop; };
1504: }
1505: else if (document.body.clientHeight) {
1506: Geometry.getViewportHeight =
1507: function() { return document.body.clientHeight; };
1508: Geometry.getViewportWidth =
1509: function() { return document.body.clientWidth; };
1510: Geometry.getHorizontalScroll =
1511: function() { return document.body.scrollLeft; };
1512: Geometry.getVerticalScroll =
1513: function() { return document.body.scrollTop; };
1514: }
1515: }
1516:
1517: GEOMETRY
1518: }
1519:
1520: =pod
1521:
1.648 raeburn 1522: =item * &viewport_size_js()
1.590 raeburn 1523:
1524: 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.
1525:
1526: =cut
1527:
1528: sub viewport_size_js {
1529: my $geometry = &viewport_geometry_js();
1530: return <<"DIMS";
1531:
1532: $geometry
1533:
1534: function getViewportDims(width,height) {
1535: init_geometry();
1536: width.value = Geometry.getViewportWidth();
1537: height.value = Geometry.getViewportHeight();
1538: return;
1539: }
1540:
1541: DIMS
1542: }
1543:
1544: =pod
1545:
1.648 raeburn 1546: =item * &resize_textarea_js()
1.565 albertel 1547:
1548: emits the needed javascript to resize a textarea to be as big as possible
1549:
1550: creates a function resize_textrea that takes two IDs first should be
1551: the id of the element to resize, second should be the id of a div that
1552: surrounds everything that comes after the textarea, this routine needs
1553: to be attached to the <body> for the onload and onresize events.
1554:
1.648 raeburn 1555: =back
1.565 albertel 1556:
1557: =cut
1558:
1559: sub resize_textarea_js {
1.590 raeburn 1560: my $geometry = &viewport_geometry_js();
1.565 albertel 1561: return <<"RESIZE";
1562: <script type="text/javascript">
1.692.4.4 raeburn 1563: // <![CDATA[
1.590 raeburn 1564: $geometry
1.565 albertel 1565:
1.588 albertel 1566: function getX(element) {
1567: var x = 0;
1568: while (element) {
1569: x += element.offsetLeft;
1570: element = element.offsetParent;
1571: }
1572: return x;
1573: }
1574: function getY(element) {
1575: var y = 0;
1576: while (element) {
1577: y += element.offsetTop;
1578: element = element.offsetParent;
1579: }
1580: return y;
1581: }
1582:
1583:
1.565 albertel 1584: function resize_textarea(textarea_id,bottom_id) {
1585: init_geometry();
1586: var textarea = document.getElementById(textarea_id);
1587: //alert(textarea);
1588:
1.588 albertel 1589: var textarea_top = getY(textarea);
1.565 albertel 1590: var textarea_height = textarea.offsetHeight;
1591: var bottom = document.getElementById(bottom_id);
1.588 albertel 1592: var bottom_top = getY(bottom);
1.565 albertel 1593: var bottom_height = bottom.offsetHeight;
1594: var window_height = Geometry.getViewportHeight();
1.588 albertel 1595: var fudge = 23;
1.565 albertel 1596: var new_height = window_height-fudge-textarea_top-bottom_height;
1597: if (new_height < 300) {
1598: new_height = 300;
1599: }
1600: textarea.style.height=new_height+'px';
1601: }
1.692.4.4 raeburn 1602: // ]]>
1.565 albertel 1603: </script>
1604: RESIZE
1605:
1606: }
1607:
1608: =pod
1609:
1.256 matthew 1610: =head1 Excel and CSV file utility routines
1611:
1612: =over 4
1613:
1614: =cut
1615:
1616: ###############################################################
1617: ###############################################################
1618:
1619: =pod
1620:
1.648 raeburn 1621: =item * &csv_translate($text)
1.37 matthew 1622:
1.185 www 1623: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1624: format.
1625:
1626: =cut
1627:
1.180 matthew 1628: ###############################################################
1629: ###############################################################
1.37 matthew 1630: sub csv_translate {
1631: my $text = shift;
1632: $text =~ s/\"/\"\"/g;
1.209 albertel 1633: $text =~ s/\n/ /g;
1.37 matthew 1634: return $text;
1635: }
1.180 matthew 1636:
1637: ###############################################################
1638: ###############################################################
1639:
1640: =pod
1641:
1.648 raeburn 1642: =item * &define_excel_formats()
1.180 matthew 1643:
1644: Define some commonly used Excel cell formats.
1645:
1646: Currently supported formats:
1647:
1648: =over 4
1649:
1650: =item header
1651:
1652: =item bold
1653:
1654: =item h1
1655:
1656: =item h2
1657:
1658: =item h3
1659:
1.256 matthew 1660: =item h4
1661:
1662: =item i
1663:
1.180 matthew 1664: =item date
1665:
1666: =back
1667:
1668: Inputs: $workbook
1669:
1670: Returns: $format, a hash reference.
1671:
1672: =cut
1673:
1674: ###############################################################
1675: ###############################################################
1676: sub define_excel_formats {
1677: my ($workbook) = @_;
1678: my $format;
1679: $format->{'header'} = $workbook->add_format(bold => 1,
1680: bottom => 1,
1681: align => 'center');
1682: $format->{'bold'} = $workbook->add_format(bold=>1);
1683: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1684: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1685: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1686: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1687: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1688: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1689: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1690: return $format;
1691: }
1692:
1693: ###############################################################
1694: ###############################################################
1.113 bowersj2 1695:
1696: =pod
1697:
1.648 raeburn 1698: =item * &create_workbook()
1.255 matthew 1699:
1700: Create an Excel worksheet. If it fails, output message on the
1701: request object and return undefs.
1702:
1703: Inputs: Apache request object
1704:
1705: Returns (undef) on failure,
1706: Excel worksheet object, scalar with filename, and formats
1707: from &Apache::loncommon::define_excel_formats on success
1708:
1709: =cut
1710:
1711: ###############################################################
1712: ###############################################################
1713: sub create_workbook {
1714: my ($r) = @_;
1715: #
1716: # Create the excel spreadsheet
1717: my $filename = '/prtspool/'.
1.258 albertel 1718: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1719: time.'_'.rand(1000000000).'.xls';
1720: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1721: if (! defined($workbook)) {
1722: $r->log_error("Error creating excel spreadsheet $filename: $!");
1723: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1724: "This error has been logged. ".
1725: "Please alert your LON-CAPA administrator").
1726: '</p>');
1727: return (undef);
1728: }
1729: #
1730: $workbook->set_tempdir('/home/httpd/perl/tmp');
1731: #
1732: my $format = &Apache::loncommon::define_excel_formats($workbook);
1733: return ($workbook,$filename,$format);
1734: }
1735:
1736: ###############################################################
1737: ###############################################################
1738:
1739: =pod
1740:
1.648 raeburn 1741: =item * &create_text_file()
1.113 bowersj2 1742:
1.542 raeburn 1743: Create a file to write to and eventually make available to the user.
1.256 matthew 1744: If file creation fails, outputs an error message on the request object and
1745: return undefs.
1.113 bowersj2 1746:
1.256 matthew 1747: Inputs: Apache request object, and file suffix
1.113 bowersj2 1748:
1.256 matthew 1749: Returns (undef) on failure,
1750: Filehandle and filename on success.
1.113 bowersj2 1751:
1752: =cut
1753:
1.256 matthew 1754: ###############################################################
1755: ###############################################################
1756: sub create_text_file {
1757: my ($r,$suffix) = @_;
1758: if (! defined($suffix)) { $suffix = 'txt'; };
1759: my $fh;
1760: my $filename = '/prtspool/'.
1.258 albertel 1761: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1762: time.'_'.rand(1000000000).'.'.$suffix;
1763: $fh = Apache::File->new('>/home/httpd'.$filename);
1764: if (! defined($fh)) {
1765: $r->log_error("Couldn't open $filename for output $!");
1.683 bisitz 1766: $r->print(&mt('Problems occurred in creating the output file. '
1767: .'This error has been logged. '
1768: .'Please alert your LON-CAPA administrator.'));
1.113 bowersj2 1769: }
1.256 matthew 1770: return ($fh,$filename)
1.113 bowersj2 1771: }
1772:
1773:
1.256 matthew 1774: =pod
1.113 bowersj2 1775:
1776: =back
1777:
1778: =cut
1.37 matthew 1779:
1780: ###############################################################
1.33 matthew 1781: ## Home server <option> list generating code ##
1782: ###############################################################
1.35 matthew 1783:
1.169 www 1784: # ------------------------------------------
1785:
1786: sub domain_select {
1787: my ($name,$value,$multiple)=@_;
1788: my %domains=map {
1.514 albertel 1789: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1790: } &Apache::lonnet::all_domains();
1.169 www 1791: if ($multiple) {
1792: $domains{''}=&mt('Any domain');
1.550 albertel 1793: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1794: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1795: } else {
1.550 albertel 1796: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1797: return &select_form($name,$value,%domains);
1798: }
1799: }
1800:
1.282 albertel 1801: #-------------------------------------------
1802:
1803: =pod
1804:
1.519 raeburn 1805: =head1 Routines for form select boxes
1806:
1807: =over 4
1808:
1.648 raeburn 1809: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1810:
1811: Returns a string containing a <select> element int multiple mode
1812:
1813:
1814: Args:
1815: $name - name of the <select> element
1.506 raeburn 1816: $value - scalar or array ref of values that should already be selected
1.282 albertel 1817: $size - number of rows long the select element is
1.283 albertel 1818: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1819: (shown text should already have been &mt())
1.506 raeburn 1820: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1821:
1.282 albertel 1822: =cut
1823:
1824: #-------------------------------------------
1.169 www 1825: sub multiple_select_form {
1.284 albertel 1826: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1827: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1828: my $output='';
1.191 matthew 1829: if (! defined($size)) {
1830: $size = 4;
1.283 albertel 1831: if (scalar(keys(%$hash))<4) {
1832: $size = scalar(keys(%$hash));
1.191 matthew 1833: }
1834: }
1.692.4.2 raeburn 1835: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1836: my @order;
1.506 raeburn 1837: if (ref($order) eq 'ARRAY') {
1838: @order = @{$order};
1839: } else {
1840: @order = sort(keys(%$hash));
1.501 banghart 1841: }
1842: if (exists($$hash{'select_form_order'})) {
1843: @order = @{$$hash{'select_form_order'}};
1844: }
1845:
1.284 albertel 1846: foreach my $key (@order) {
1.356 albertel 1847: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1848: $output.='selected="selected" ' if ($selected{$key});
1849: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1850: }
1851: $output.="</select>\n";
1852: return $output;
1853: }
1854:
1.88 www 1855: #-------------------------------------------
1856:
1857: =pod
1858:
1.648 raeburn 1859: =item * &select_form($defdom,$name,%hash)
1.88 www 1860:
1861: Returns a string containing a <select name='$name' size='1'> form to
1862: allow a user to select options from a hash option_name => displayed text.
1863: See lonrights.pm for an example invocation and use.
1864:
1865: =cut
1866:
1867: #-------------------------------------------
1868: sub select_form {
1869: my ($def,$name,%hash) = @_;
1870: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1871: my @keys;
1872: if (exists($hash{'select_form_order'})) {
1873: @keys=@{$hash{'select_form_order'}};
1874: } else {
1875: @keys=sort(keys(%hash));
1876: }
1.356 albertel 1877: foreach my $key (@keys) {
1878: $selectform.=
1879: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1880: ($key eq $def ? 'selected="selected" ' : '').
1881: ">".&mt($hash{$key})."</option>\n";
1.88 www 1882: }
1883: $selectform.="</select>";
1884: return $selectform;
1885: }
1886:
1.475 www 1887: # For display filters
1888:
1889: sub display_filter {
1890: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1891: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.692.4.2 raeburn 1892: return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475 www 1893: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1894: (&mt('all'),10,20,50,100,1000,10000))).
1.692.4.2 raeburn 1895: '</label></span> <span class="LC_nobreak">'.
1.475 www 1896: &mt('Filter [_1]',
1.477 www 1897: &select_form($env{'form.displayfilter'},
1898: 'displayfilter',
1899: ('currentfolder' => 'Current folder/page',
1900: 'containing' => 'Containing phrase',
1901: 'none' => 'None'))).
1.692.4.2 raeburn 1902: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475 www 1903: }
1904:
1.167 www 1905: sub gradeleveldescription {
1906: my $gradelevel=shift;
1907: my %gradelevels=(0 => 'Not specified',
1908: 1 => 'Grade 1',
1909: 2 => 'Grade 2',
1910: 3 => 'Grade 3',
1911: 4 => 'Grade 4',
1912: 5 => 'Grade 5',
1913: 6 => 'Grade 6',
1914: 7 => 'Grade 7',
1915: 8 => 'Grade 8',
1916: 9 => 'Grade 9',
1917: 10 => 'Grade 10',
1918: 11 => 'Grade 11',
1919: 12 => 'Grade 12',
1920: 13 => 'Grade 13',
1921: 14 => '100 Level',
1922: 15 => '200 Level',
1923: 16 => '300 Level',
1924: 17 => '400 Level',
1925: 18 => 'Graduate Level');
1926: return &mt($gradelevels{$gradelevel});
1927: }
1928:
1.163 www 1929: sub select_level_form {
1930: my ($deflevel,$name)=@_;
1931: unless ($deflevel) { $deflevel=0; }
1.167 www 1932: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1933: for (my $i=0; $i<=18; $i++) {
1934: $selectform.="<option value=\"$i\" ".
1.253 albertel 1935: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1936: ">".&gradeleveldescription($i)."</option>\n";
1937: }
1938: $selectform.="</select>";
1939: return $selectform;
1.163 www 1940: }
1.167 www 1941:
1.35 matthew 1942: #-------------------------------------------
1943:
1.45 matthew 1944: =pod
1945:
1.692.4.23 raeburn 1946: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35 matthew 1947:
1948: Returns a string containing a <select name='$name' size='1'> form to
1949: allow a user to select the domain to preform an operation in.
1950: See loncreateuser.pm for an example invocation and use.
1951:
1.90 www 1952: If the $includeempty flag is set, it also includes an empty choice ("no domain
1953: selected");
1954:
1.692.4.2 raeburn 1955: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1956:
1.692.4.7 raeburn 1957: 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 1958:
1.692.4.23 raeburn 1959: The optional $incdoms is a reference to an array of domains which will be the only available options.
1960:
1.35 matthew 1961: =cut
1962:
1963: #-------------------------------------------
1.34 matthew 1964: sub select_dom_form {
1.692.4.23 raeburn 1965: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.692.4.7 raeburn 1966: if ($onchange) {
1967: $onchange = ' onchange="'.$onchange.'"';
1.692.4.2 raeburn 1968: }
1.692.4.23 raeburn 1969: my @domains;
1970: if (ref($incdoms) eq 'ARRAY') {
1971: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
1972: } else {
1973: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1974: }
1.90 www 1975: if ($includeempty) { @domains=('',@domains); }
1.692.4.2 raeburn 1976: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 1977: foreach my $dom (@domains) {
1978: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1979: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1980: if ($showdomdesc) {
1981: if ($dom ne '') {
1982: my $domdesc = &Apache::lonnet::domain($dom,'description');
1983: if ($domdesc ne '') {
1984: $selectdomain .= ' ('.$domdesc.')';
1985: }
1986: }
1987: }
1988: $selectdomain .= "</option>\n";
1.34 matthew 1989: }
1990: $selectdomain.="</select>";
1991: return $selectdomain;
1992: }
1993:
1.35 matthew 1994: #-------------------------------------------
1995:
1.45 matthew 1996: =pod
1997:
1.648 raeburn 1998: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1999:
1.586 raeburn 2000: input: 4 arguments (two required, two optional) -
2001: $domain - domain of new user
2002: $name - name of form element
2003: $default - Value of 'default' causes a default item to be first
2004: option, and selected by default.
2005: $hide - Value of 'hide' causes hiding of the name of the server,
2006: if 1 server found, or default, if 0 found.
1.594 raeburn 2007: output: returns 2 items:
1.586 raeburn 2008: (a) form element which contains either:
2009: (i) <select name="$name">
2010: <option value="$hostid1">$hostid $servers{$hostid}</option>
2011: <option value="$hostid2">$hostid $servers{$hostid}</option>
2012: </select>
2013: form item if there are multiple library servers in $domain, or
2014: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2015: if there is only one library server in $domain.
2016:
2017: (b) number of library servers found.
2018:
2019: See loncreateuser.pm for example of use.
1.35 matthew 2020:
2021: =cut
2022:
2023: #-------------------------------------------
1.586 raeburn 2024: sub home_server_form_item {
2025: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2026: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2027: my $result;
2028: my $numlib = keys(%servers);
2029: if ($numlib > 1) {
2030: $result .= '<select name="'.$name.'" />'."\n";
2031: if ($default) {
1.692.4.2 raeburn 2032: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2033: '</option>'."\n";
2034: }
2035: foreach my $hostid (sort(keys(%servers))) {
2036: $result.= '<option value="'.$hostid.'">'.
2037: $hostid.' '.$servers{$hostid}."</option>\n";
2038: }
2039: $result .= '</select>'."\n";
2040: } elsif ($numlib == 1) {
2041: my $hostid;
2042: foreach my $item (keys(%servers)) {
2043: $hostid = $item;
2044: }
2045: $result .= '<input type="hidden" name="'.$name.'" value="'.
2046: $hostid.'" />';
2047: if (!$hide) {
2048: $result .= $hostid.' '.$servers{$hostid};
2049: }
2050: $result .= "\n";
2051: } elsif ($default) {
2052: $result .= '<input type="hidden" name="'.$name.
2053: '" value="default" />';
2054: if (!$hide) {
2055: $result .= &mt('default');
2056: }
2057: $result .= "\n";
1.33 matthew 2058: }
1.586 raeburn 2059: return ($result,$numlib);
1.33 matthew 2060: }
1.112 bowersj2 2061:
2062: =pod
2063:
1.534 albertel 2064: =back
2065:
1.112 bowersj2 2066: =cut
1.87 matthew 2067:
2068: ###############################################################
1.112 bowersj2 2069: ## Decoding User Agent ##
1.87 matthew 2070: ###############################################################
2071:
2072: =pod
2073:
1.112 bowersj2 2074: =head1 Decoding the User Agent
2075:
2076: =over 4
2077:
2078: =item * &decode_user_agent()
1.87 matthew 2079:
2080: Inputs: $r
2081:
2082: Outputs:
2083:
2084: =over 4
2085:
1.112 bowersj2 2086: =item * $httpbrowser
1.87 matthew 2087:
1.112 bowersj2 2088: =item * $clientbrowser
1.87 matthew 2089:
1.112 bowersj2 2090: =item * $clientversion
1.87 matthew 2091:
1.112 bowersj2 2092: =item * $clientmathml
1.87 matthew 2093:
1.112 bowersj2 2094: =item * $clientunicode
1.87 matthew 2095:
1.112 bowersj2 2096: =item * $clientos
1.87 matthew 2097:
2098: =back
2099:
1.157 matthew 2100: =back
2101:
1.87 matthew 2102: =cut
2103:
2104: ###############################################################
2105: ###############################################################
2106: sub decode_user_agent {
1.247 albertel 2107: my ($r)=@_;
1.87 matthew 2108: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2109: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2110: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2111: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2112: my $clientbrowser='unknown';
2113: my $clientversion='0';
2114: my $clientmathml='';
2115: my $clientunicode='0';
2116: for (my $i=0;$i<=$#browsertype;$i++) {
2117: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2118: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2119: $clientbrowser=$bname;
2120: $httpbrowser=~/$vreg/i;
2121: $clientversion=$1;
2122: $clientmathml=($clientversion>=$minv);
2123: $clientunicode=($clientversion>=$univ);
2124: }
2125: }
2126: my $clientos='unknown';
2127: if (($httpbrowser=~/linux/i) ||
2128: ($httpbrowser=~/unix/i) ||
2129: ($httpbrowser=~/ux/i) ||
2130: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2131: if (($httpbrowser=~/vax/i) ||
2132: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2133: if ($httpbrowser=~/next/i) { $clientos='next'; }
2134: if (($httpbrowser=~/mac/i) ||
2135: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2136: if ($httpbrowser=~/win/i) { $clientos='win'; }
2137: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2138: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2139: $clientunicode,$clientos,);
2140: }
2141:
1.32 matthew 2142: ###############################################################
2143: ## Authentication changing form generation subroutines ##
2144: ###############################################################
2145: ##
2146: ## All of the authform_xxxxxxx subroutines take their inputs in a
2147: ## hash, and have reasonable default values.
2148: ##
2149: ## formname = the name given in the <form> tag.
1.35 matthew 2150: #-------------------------------------------
2151:
1.45 matthew 2152: =pod
2153:
1.112 bowersj2 2154: =head1 Authentication Routines
2155:
2156: =over 4
2157:
1.648 raeburn 2158: =item * &authform_xxxxxx()
1.35 matthew 2159:
2160: The authform_xxxxxx subroutines provide javascript and html forms which
2161: handle some of the conveniences required for authentication forms.
2162: This is not an optimal method, but it works.
2163:
2164: =over 4
2165:
1.112 bowersj2 2166: =item * authform_header
1.35 matthew 2167:
1.112 bowersj2 2168: =item * authform_authorwarning
1.35 matthew 2169:
1.112 bowersj2 2170: =item * authform_nochange
1.35 matthew 2171:
1.112 bowersj2 2172: =item * authform_kerberos
1.35 matthew 2173:
1.112 bowersj2 2174: =item * authform_internal
1.35 matthew 2175:
1.112 bowersj2 2176: =item * authform_filesystem
1.35 matthew 2177:
2178: =back
2179:
1.648 raeburn 2180: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2181:
1.35 matthew 2182: =cut
2183:
2184: #-------------------------------------------
1.32 matthew 2185: sub authform_header{
2186: my %in = (
2187: formname => 'cu',
1.80 albertel 2188: kerb_def_dom => '',
1.32 matthew 2189: @_,
2190: );
2191: $in{'formname'} = 'document.' . $in{'formname'};
2192: my $result='';
1.80 albertel 2193:
2194: #---------------------------------------------- Code for upper case translation
2195: my $Javascript_toUpperCase;
2196: unless ($in{kerb_def_dom}) {
2197: $Javascript_toUpperCase =<<"END";
2198: switch (choice) {
2199: case 'krb': currentform.elements[choicearg].value =
2200: currentform.elements[choicearg].value.toUpperCase();
2201: break;
2202: default:
2203: }
2204: END
2205: } else {
2206: $Javascript_toUpperCase = "";
2207: }
2208:
1.165 raeburn 2209: my $radioval = "'nochange'";
1.591 raeburn 2210: if (defined($in{'curr_authtype'})) {
2211: if ($in{'curr_authtype'} ne '') {
2212: $radioval = "'".$in{'curr_authtype'}."arg'";
2213: }
1.174 matthew 2214: }
1.165 raeburn 2215: my $argfield = 'null';
1.591 raeburn 2216: if (defined($in{'mode'})) {
1.165 raeburn 2217: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2218: if (defined($in{'curr_autharg'})) {
2219: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2220: $argfield = "'$in{'curr_autharg'}'";
2221: }
2222: }
2223: }
2224: }
2225:
1.32 matthew 2226: $result.=<<"END";
2227: var current = new Object();
1.165 raeburn 2228: current.radiovalue = $radioval;
2229: current.argfield = $argfield;
1.32 matthew 2230:
2231: function changed_radio(choice,currentform) {
2232: var choicearg = choice + 'arg';
2233: // If a radio button in changed, we need to change the argfield
2234: if (current.radiovalue != choice) {
2235: current.radiovalue = choice;
2236: if (current.argfield != null) {
2237: currentform.elements[current.argfield].value = '';
2238: }
2239: if (choice == 'nochange') {
2240: current.argfield = null;
2241: } else {
2242: current.argfield = choicearg;
2243: switch(choice) {
2244: case 'krb':
2245: currentform.elements[current.argfield].value =
2246: "$in{'kerb_def_dom'}";
2247: break;
2248: default:
2249: break;
2250: }
2251: }
2252: }
2253: return;
2254: }
1.22 www 2255:
1.32 matthew 2256: function changed_text(choice,currentform) {
2257: var choicearg = choice + 'arg';
2258: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2259: $Javascript_toUpperCase
1.32 matthew 2260: // clear old field
2261: if ((current.argfield != choicearg) && (current.argfield != null)) {
2262: currentform.elements[current.argfield].value = '';
2263: }
2264: current.argfield = choicearg;
2265: }
2266: set_auth_radio_buttons(choice,currentform);
2267: return;
1.20 www 2268: }
1.32 matthew 2269:
2270: function set_auth_radio_buttons(newvalue,currentform) {
2271: var i=0;
2272: while (i < currentform.login.length) {
2273: if (currentform.login[i].value == newvalue) { break; }
2274: i++;
2275: }
2276: if (i == currentform.login.length) {
2277: return;
2278: }
2279: current.radiovalue = newvalue;
2280: currentform.login[i].checked = true;
2281: return;
2282: }
2283: END
2284: return $result;
2285: }
2286:
2287: sub authform_authorwarning{
2288: my $result='';
1.144 matthew 2289: $result='<i>'.
2290: &mt('As a general rule, only authors or co-authors should be '.
2291: 'filesystem authenticated '.
2292: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2293: return $result;
2294: }
2295:
2296: sub authform_nochange{
2297: my %in = (
2298: formname => 'document.cu',
2299: kerb_def_dom => 'MSU.EDU',
2300: @_,
2301: );
1.586 raeburn 2302: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2303: my $result;
2304: if (keys(%can_assign) == 0) {
2305: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2306: } else {
2307: $result = '<label>'.&mt('[_1] Do not change login data',
2308: '<input type="radio" name="login" value="nochange" '.
2309: 'checked="checked" onclick="'.
1.281 albertel 2310: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2311: '</label>';
1.586 raeburn 2312: }
1.32 matthew 2313: return $result;
2314: }
2315:
1.591 raeburn 2316: sub authform_kerberos {
1.32 matthew 2317: my %in = (
2318: formname => 'document.cu',
2319: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2320: kerb_def_auth => 'krb4',
1.32 matthew 2321: @_,
2322: );
1.586 raeburn 2323: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2324: $autharg,$jscall);
2325: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2326: if ($in{'kerb_def_auth'} eq 'krb5') {
1.692.4.2 raeburn 2327: $check5 = ' checked="checked"';
1.80 albertel 2328: } else {
1.692.4.2 raeburn 2329: $check4 = ' checked="checked"';
1.80 albertel 2330: }
1.165 raeburn 2331: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2332: if (defined($in{'curr_authtype'})) {
2333: if ($in{'curr_authtype'} eq 'krb') {
1.692.4.2 raeburn 2334: $krbcheck = ' checked="checked"';
1.623 raeburn 2335: if (defined($in{'mode'})) {
2336: if ($in{'mode'} eq 'modifyuser') {
2337: $krbcheck = '';
2338: }
2339: }
1.591 raeburn 2340: if (defined($in{'curr_kerb_ver'})) {
2341: if ($in{'curr_krb_ver'} eq '5') {
1.692.4.2 raeburn 2342: $check5 = ' checked="checked"';
1.591 raeburn 2343: $check4 = '';
2344: } else {
1.692.4.2 raeburn 2345: $check4 = ' checked="checked"';
1.591 raeburn 2346: $check5 = '';
2347: }
1.586 raeburn 2348: }
1.591 raeburn 2349: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2350: $krbarg = $in{'curr_autharg'};
2351: }
1.586 raeburn 2352: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2353: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2354: $result =
2355: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2356: $in{'curr_autharg'},$krbver);
2357: } else {
2358: $result =
2359: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2360: }
2361: return $result;
2362: }
2363: }
2364: } else {
2365: if ($authnum == 1) {
1.692.4.2 raeburn 2366: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2367: }
2368: }
1.586 raeburn 2369: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2370: return;
1.587 raeburn 2371: } elsif ($authtype eq '') {
1.591 raeburn 2372: if (defined($in{'mode'})) {
1.587 raeburn 2373: if ($in{'mode'} eq 'modifycourse') {
2374: if ($authnum == 1) {
1.692.4.2 raeburn 2375: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2376: }
2377: }
2378: }
1.586 raeburn 2379: }
2380: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2381: if ($authtype eq '') {
2382: $authtype = '<input type="radio" name="login" value="krb" '.
2383: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2384: $krbcheck.' />';
2385: }
2386: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2387: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2388: $in{'curr_authtype'} eq 'krb5') ||
2389: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2390: $in{'curr_authtype'} eq 'krb4')) {
2391: $result .= &mt
1.144 matthew 2392: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2393: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2394: '<label>'.$authtype,
1.281 albertel 2395: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2396: 'value="'.$krbarg.'" '.
1.144 matthew 2397: 'onchange="'.$jscall.'" />',
1.281 albertel 2398: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2399: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2400: '</label>');
1.586 raeburn 2401: } elsif ($can_assign{'krb4'}) {
2402: $result .= &mt
2403: ('[_1] Kerberos authenticated with domain [_2] '.
2404: '[_3] Version 4 [_4]',
2405: '<label>'.$authtype,
2406: '</label><input type="text" size="10" name="krbarg" '.
2407: 'value="'.$krbarg.'" '.
2408: 'onchange="'.$jscall.'" />',
2409: '<label><input type="hidden" name="krbver" value="4" />',
2410: '</label>');
2411: } elsif ($can_assign{'krb5'}) {
2412: $result .= &mt
2413: ('[_1] Kerberos authenticated with domain [_2] '.
2414: '[_3] Version 5 [_4]',
2415: '<label>'.$authtype,
2416: '</label><input type="text" size="10" name="krbarg" '.
2417: 'value="'.$krbarg.'" '.
2418: 'onchange="'.$jscall.'" />',
2419: '<label><input type="hidden" name="krbver" value="5" />',
2420: '</label>');
2421: }
1.32 matthew 2422: return $result;
2423: }
2424:
2425: sub authform_internal{
1.586 raeburn 2426: my %in = (
1.32 matthew 2427: formname => 'document.cu',
2428: kerb_def_dom => 'MSU.EDU',
2429: @_,
2430: );
1.586 raeburn 2431: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2432: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2433: if (defined($in{'curr_authtype'})) {
2434: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2435: if ($can_assign{'int'}) {
1.692.4.2 raeburn 2436: $intcheck = 'checked="checked" ';
1.623 raeburn 2437: if (defined($in{'mode'})) {
2438: if ($in{'mode'} eq 'modifyuser') {
2439: $intcheck = '';
2440: }
2441: }
1.591 raeburn 2442: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2443: $intarg = $in{'curr_autharg'};
2444: }
2445: } else {
2446: $result = &mt('Currently internally authenticated.');
2447: return $result;
1.165 raeburn 2448: }
2449: }
1.586 raeburn 2450: } else {
2451: if ($authnum == 1) {
1.692.4.2 raeburn 2452: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2453: }
2454: }
2455: if (!$can_assign{'int'}) {
2456: return;
1.587 raeburn 2457: } elsif ($authtype eq '') {
1.591 raeburn 2458: if (defined($in{'mode'})) {
1.587 raeburn 2459: if ($in{'mode'} eq 'modifycourse') {
2460: if ($authnum == 1) {
1.692.4.2 raeburn 2461: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2462: }
2463: }
2464: }
1.165 raeburn 2465: }
1.586 raeburn 2466: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2467: if ($authtype eq '') {
2468: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2469: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2470: }
1.605 bisitz 2471: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2472: $intarg.'" onchange="'.$jscall.'" />';
2473: $result = &mt
1.144 matthew 2474: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2475: '<label>'.$authtype,'</label>'.$autharg);
1.692.4.4 raeburn 2476: $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 2477: return $result;
2478: }
2479:
2480: sub authform_local{
2481: my %in = (
2482: formname => 'document.cu',
2483: kerb_def_dom => 'MSU.EDU',
2484: @_,
2485: );
1.586 raeburn 2486: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2487: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2488: if (defined($in{'curr_authtype'})) {
2489: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2490: if ($can_assign{'loc'}) {
1.692.4.2 raeburn 2491: $loccheck = 'checked="checked" ';
1.623 raeburn 2492: if (defined($in{'mode'})) {
2493: if ($in{'mode'} eq 'modifyuser') {
2494: $loccheck = '';
2495: }
2496: }
1.591 raeburn 2497: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2498: $locarg = $in{'curr_autharg'};
2499: }
2500: } else {
2501: $result = &mt('Currently using local (institutional) authentication.');
2502: return $result;
1.165 raeburn 2503: }
2504: }
1.586 raeburn 2505: } else {
2506: if ($authnum == 1) {
1.692.4.2 raeburn 2507: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2508: }
2509: }
2510: if (!$can_assign{'loc'}) {
2511: return;
1.587 raeburn 2512: } elsif ($authtype eq '') {
1.591 raeburn 2513: if (defined($in{'mode'})) {
1.587 raeburn 2514: if ($in{'mode'} eq 'modifycourse') {
2515: if ($authnum == 1) {
1.692.4.2 raeburn 2516: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2517: }
2518: }
2519: }
1.165 raeburn 2520: }
1.586 raeburn 2521: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2522: if ($authtype eq '') {
2523: $authtype = '<input type="radio" name="login" value="loc" '.
2524: $loccheck.' onchange="'.$jscall.'" onclick="'.
2525: $jscall.'" />';
2526: }
2527: $autharg = '<input type="text" size="10" name="locarg" value="'.
2528: $locarg.'" onchange="'.$jscall.'" />';
2529: $result = &mt('[_1] Local Authentication with argument [_2]',
2530: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2531: return $result;
2532: }
2533:
2534: sub authform_filesystem{
2535: my %in = (
2536: formname => 'document.cu',
2537: kerb_def_dom => 'MSU.EDU',
2538: @_,
2539: );
1.586 raeburn 2540: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2541: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2542: if (defined($in{'curr_authtype'})) {
2543: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2544: if ($can_assign{'fsys'}) {
1.692.4.2 raeburn 2545: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2546: if (defined($in{'mode'})) {
2547: if ($in{'mode'} eq 'modifyuser') {
2548: $fsyscheck = '';
2549: }
2550: }
1.586 raeburn 2551: } else {
2552: $result = &mt('Currently Filesystem Authenticated.');
2553: return $result;
2554: }
2555: }
2556: } else {
2557: if ($authnum == 1) {
1.692.4.2 raeburn 2558: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2559: }
2560: }
2561: if (!$can_assign{'fsys'}) {
2562: return;
1.587 raeburn 2563: } elsif ($authtype eq '') {
1.591 raeburn 2564: if (defined($in{'mode'})) {
1.587 raeburn 2565: if ($in{'mode'} eq 'modifycourse') {
2566: if ($authnum == 1) {
1.692.4.2 raeburn 2567: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2568: }
2569: }
2570: }
1.586 raeburn 2571: }
2572: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2573: if ($authtype eq '') {
2574: $authtype = '<input type="radio" name="login" value="fsys" '.
2575: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2576: $jscall.'" />';
2577: }
2578: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2579: ' onchange="'.$jscall.'" />';
2580: $result = &mt
1.144 matthew 2581: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2582: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2583: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2584: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2585: 'onchange="'.$jscall.'" />');
1.32 matthew 2586: return $result;
2587: }
2588:
1.586 raeburn 2589: sub get_assignable_auth {
2590: my ($dom) = @_;
2591: if ($dom eq '') {
2592: $dom = $env{'request.role.domain'};
2593: }
2594: my %can_assign = (
2595: krb4 => 1,
2596: krb5 => 1,
2597: int => 1,
2598: loc => 1,
2599: );
2600: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2601: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2602: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2603: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2604: my $context;
2605: if ($env{'request.role'} =~ /^au/) {
2606: $context = 'author';
2607: } elsif ($env{'request.role'} =~ /^dc/) {
2608: $context = 'domain';
2609: } elsif ($env{'request.course.id'}) {
2610: $context = 'course';
2611: }
2612: if ($context) {
2613: if (ref($authhash->{$context}) eq 'HASH') {
2614: %can_assign = %{$authhash->{$context}};
2615: }
2616: }
2617: }
2618: }
2619: my $authnum = 0;
2620: foreach my $key (keys(%can_assign)) {
2621: if ($can_assign{$key}) {
2622: $authnum ++;
2623: }
2624: }
2625: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2626: $authnum --;
2627: }
2628: return ($authnum,%can_assign);
2629: }
2630:
1.80 albertel 2631: ###############################################################
2632: ## Get Kerberos Defaults for Domain ##
2633: ###############################################################
2634: ##
2635: ## Returns default kerberos version and an associated argument
2636: ## as listed in file domain.tab. If not listed, provides
2637: ## appropriate default domain and kerberos version.
2638: ##
2639: #-------------------------------------------
2640:
2641: =pod
2642:
1.648 raeburn 2643: =item * &get_kerberos_defaults()
1.80 albertel 2644:
2645: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2646: version and domain. If not found, it defaults to version 4 and the
2647: domain of the server.
1.80 albertel 2648:
1.648 raeburn 2649: =over 4
2650:
1.80 albertel 2651: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2652:
1.648 raeburn 2653: =back
2654:
2655: =back
2656:
1.80 albertel 2657: =cut
2658:
2659: #-------------------------------------------
2660: sub get_kerberos_defaults {
2661: my $domain=shift;
1.641 raeburn 2662: my ($krbdef,$krbdefdom);
2663: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2664: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2665: $krbdef = $domdefaults{'auth_def'};
2666: $krbdefdom = $domdefaults{'auth_arg_def'};
2667: } else {
1.80 albertel 2668: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2669: my $krbdefdom=$1;
2670: $krbdefdom=~tr/a-z/A-Z/;
2671: $krbdef = "krb4";
2672: }
2673: return ($krbdef,$krbdefdom);
2674: }
1.112 bowersj2 2675:
1.32 matthew 2676:
1.46 matthew 2677: ###############################################################
2678: ## Thesaurus Functions ##
2679: ###############################################################
1.20 www 2680:
1.46 matthew 2681: =pod
1.20 www 2682:
1.112 bowersj2 2683: =head1 Thesaurus Functions
2684:
2685: =over 4
2686:
1.648 raeburn 2687: =item * &initialize_keywords()
1.46 matthew 2688:
2689: Initializes the package variable %Keywords if it is empty. Uses the
2690: package variable $thesaurus_db_file.
2691:
2692: =cut
2693:
2694: ###################################################
2695:
2696: sub initialize_keywords {
2697: return 1 if (scalar keys(%Keywords));
2698: # If we are here, %Keywords is empty, so fill it up
2699: # Make sure the file we need exists...
2700: if (! -e $thesaurus_db_file) {
2701: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2702: " failed because it does not exist");
2703: return 0;
2704: }
2705: # Set up the hash as a database
2706: my %thesaurus_db;
2707: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2708: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2709: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2710: $thesaurus_db_file);
2711: return 0;
2712: }
2713: # Get the average number of appearances of a word.
2714: my $avecount = $thesaurus_db{'average.count'};
2715: # Put keywords (those that appear > average) into %Keywords
2716: while (my ($word,$data)=each (%thesaurus_db)) {
2717: my ($count,undef) = split /:/,$data;
2718: $Keywords{$word}++ if ($count > $avecount);
2719: }
2720: untie %thesaurus_db;
2721: # Remove special values from %Keywords.
1.356 albertel 2722: foreach my $value ('total.count','average.count') {
2723: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2724: }
1.46 matthew 2725: return 1;
2726: }
2727:
2728: ###################################################
2729:
2730: =pod
2731:
1.648 raeburn 2732: =item * &keyword($word)
1.46 matthew 2733:
2734: Returns true if $word is a keyword. A keyword is a word that appears more
2735: than the average number of times in the thesaurus database. Calls
2736: &initialize_keywords
2737:
2738: =cut
2739:
2740: ###################################################
1.20 www 2741:
2742: sub keyword {
1.46 matthew 2743: return if (!&initialize_keywords());
2744: my $word=lc(shift());
2745: $word=~s/\W//g;
2746: return exists($Keywords{$word});
1.20 www 2747: }
1.46 matthew 2748:
2749: ###############################################################
2750:
2751: =pod
1.20 www 2752:
1.648 raeburn 2753: =item * &get_related_words()
1.46 matthew 2754:
1.160 matthew 2755: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2756: an array of words. If the keyword is not in the thesaurus, an empty array
2757: will be returned. The order of the words returned is determined by the
2758: database which holds them.
2759:
2760: Uses global $thesaurus_db_file.
2761:
2762: =cut
2763:
2764: ###############################################################
2765: sub get_related_words {
2766: my $keyword = shift;
2767: my %thesaurus_db;
2768: if (! -e $thesaurus_db_file) {
2769: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2770: "failed because the file does not exist");
2771: return ();
2772: }
2773: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2774: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2775: return ();
2776: }
2777: my @Words=();
1.429 www 2778: my $count=0;
1.46 matthew 2779: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2780: # The first element is the number of times
2781: # the word appears. We do not need it now.
1.429 www 2782: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2783: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2784: my $threshold=$mostfrequentcount/10;
2785: foreach my $possibleword (@RelatedWords) {
2786: my ($word,$wordcount)=split(/\,/,$possibleword);
2787: if ($wordcount>$threshold) {
2788: push(@Words,$word);
2789: $count++;
2790: if ($count>10) { last; }
2791: }
1.20 www 2792: }
2793: }
1.46 matthew 2794: untie %thesaurus_db;
2795: return @Words;
1.14 harris41 2796: }
1.46 matthew 2797:
1.112 bowersj2 2798: =pod
2799:
2800: =back
2801:
2802: =cut
1.61 www 2803:
2804: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2805: =pod
2806:
1.112 bowersj2 2807: =head1 User Name Functions
2808:
2809: =over 4
2810:
1.648 raeburn 2811: =item * &plainname($uname,$udom,$first)
1.81 albertel 2812:
1.112 bowersj2 2813: Takes a users logon name and returns it as a string in
1.226 albertel 2814: "first middle last generation" form
2815: if $first is set to 'lastname' then it returns it as
2816: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2817:
2818: =cut
1.61 www 2819:
1.295 www 2820:
1.81 albertel 2821: ###############################################################
1.61 www 2822: sub plainname {
1.226 albertel 2823: my ($uname,$udom,$first)=@_;
1.537 albertel 2824: return if (!defined($uname) || !defined($udom));
1.295 www 2825: my %names=&getnames($uname,$udom);
1.226 albertel 2826: my $name=&Apache::lonnet::format_name($names{'firstname'},
2827: $names{'middlename'},
2828: $names{'lastname'},
2829: $names{'generation'},$first);
2830: $name=~s/^\s+//;
1.62 www 2831: $name=~s/\s+$//;
2832: $name=~s/\s+/ /g;
1.353 albertel 2833: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2834: return $name;
1.61 www 2835: }
1.66 www 2836:
2837: # -------------------------------------------------------------------- Nickname
1.81 albertel 2838: =pod
2839:
1.648 raeburn 2840: =item * &nickname($uname,$udom)
1.81 albertel 2841:
2842: Gets a users name and returns it as a string as
2843:
2844: ""nickname""
1.66 www 2845:
1.81 albertel 2846: if the user has a nickname or
2847:
2848: "first middle last generation"
2849:
2850: if the user does not
2851:
2852: =cut
1.66 www 2853:
2854: sub nickname {
2855: my ($uname,$udom)=@_;
1.537 albertel 2856: return if (!defined($uname) || !defined($udom));
1.295 www 2857: my %names=&getnames($uname,$udom);
1.68 albertel 2858: my $name=$names{'nickname'};
1.66 www 2859: if ($name) {
2860: $name='"'.$name.'"';
2861: } else {
2862: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2863: $names{'lastname'}.' '.$names{'generation'};
2864: $name=~s/\s+$//;
2865: $name=~s/\s+/ /g;
2866: }
2867: return $name;
2868: }
2869:
1.295 www 2870: sub getnames {
2871: my ($uname,$udom)=@_;
1.537 albertel 2872: return if (!defined($uname) || !defined($udom));
1.433 albertel 2873: if ($udom eq 'public' && $uname eq 'public') {
2874: return ('lastname' => &mt('Public'));
2875: }
1.295 www 2876: my $id=$uname.':'.$udom;
2877: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2878: if ($cached) {
2879: return %{$names};
2880: } else {
2881: my %loadnames=&Apache::lonnet::get('environment',
2882: ['firstname','middlename','lastname','generation','nickname'],
2883: $udom,$uname);
2884: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2885: return %loadnames;
2886: }
2887: }
1.61 www 2888:
1.542 raeburn 2889: # -------------------------------------------------------------------- getemails
1.648 raeburn 2890:
1.542 raeburn 2891: =pod
2892:
1.648 raeburn 2893: =item * &getemails($uname,$udom)
1.542 raeburn 2894:
2895: Gets a user's email information and returns it as a hash with keys:
2896: notification, critnotification, permanentemail
2897:
2898: For notification and critnotification, values are comma-separated lists
1.648 raeburn 2899: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 2900:
1.648 raeburn 2901:
1.542 raeburn 2902: =cut
2903:
1.648 raeburn 2904:
1.466 albertel 2905: sub getemails {
2906: my ($uname,$udom)=@_;
2907: if ($udom eq 'public' && $uname eq 'public') {
2908: return;
2909: }
1.467 www 2910: if (!$udom) { $udom=$env{'user.domain'}; }
2911: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2912: my $id=$uname.':'.$udom;
2913: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2914: if ($cached) {
2915: return %{$names};
2916: } else {
2917: my %loadnames=&Apache::lonnet::get('environment',
2918: ['notification','critnotification',
2919: 'permanentemail'],
2920: $udom,$uname);
2921: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2922: return %loadnames;
2923: }
2924: }
2925:
1.551 albertel 2926: sub flush_email_cache {
2927: my ($uname,$udom)=@_;
2928: if (!$udom) { $udom =$env{'user.domain'}; }
2929: if (!$uname) { $uname=$env{'user.name'}; }
2930: return if ($udom eq 'public' && $uname eq 'public');
2931: my $id=$uname.':'.$udom;
2932: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2933: }
2934:
1.692.4.2 raeburn 2935: # -------------------------------------------------------------------- getlangs
2936:
2937: =pod
2938:
2939: =item * &getlangs($uname,$udom)
2940:
2941: Gets a user's language preference and returns it as a hash with key:
2942: language.
2943:
2944: =cut
2945:
2946:
2947: sub getlangs {
2948: my ($uname,$udom) = @_;
2949: if (!$udom) { $udom =$env{'user.domain'}; }
2950: if (!$uname) { $uname=$env{'user.name'}; }
2951: my $id=$uname.':'.$udom;
2952: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
2953: if ($cached) {
2954: return %{$langs};
2955: } else {
2956: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
2957: $udom,$uname);
2958: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
2959: return %loadlangs;
2960: }
2961: }
2962:
2963: sub flush_langs_cache {
2964: my ($uname,$udom)=@_;
2965: if (!$udom) { $udom =$env{'user.domain'}; }
2966: if (!$uname) { $uname=$env{'user.name'}; }
2967: return if ($udom eq 'public' && $uname eq 'public');
2968: my $id=$uname.':'.$udom;
2969: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
2970: }
2971:
1.61 www 2972: # ------------------------------------------------------------------ Screenname
1.81 albertel 2973:
2974: =pod
2975:
1.648 raeburn 2976: =item * &screenname($uname,$udom)
1.81 albertel 2977:
2978: Gets a users screenname and returns it as a string
2979:
2980: =cut
1.61 www 2981:
2982: sub screenname {
2983: my ($uname,$udom)=@_;
1.258 albertel 2984: if ($uname eq $env{'user.name'} &&
2985: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2986: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2987: return $names{'screenname'};
1.62 www 2988: }
2989:
1.692.4.2 raeburn 2990: # ------------------------------------------------------------- Confirm Wrapper
2991: =pod
2992:
2993: =item confirmwrapper
2994:
2995: Wrap messages about completion of operation in box
2996:
2997: =cut
2998:
2999: sub confirmwrapper {
3000: my ($message)=@_;
3001: if ($message) {
3002: return "\n".'<div class="LC_confirm_box">'."\n"
3003: .$message."\n"
3004: .'</div>'."\n";
3005: } else {
3006: return $message;
3007: }
3008: }
1.212 albertel 3009:
1.62 www 3010: # ------------------------------------------------------------- Message Wrapper
3011:
3012: sub messagewrapper {
1.369 www 3013: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3014: return
1.441 albertel 3015: '<a href="/adm/email?compose=individual&'.
3016: 'recname='.$username.'&recdom='.$domain.
3017: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3018: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3019: }
3020: # --------------------------------------------------------------- Notes Wrapper
3021:
3022: sub noteswrapper {
3023: my ($link,$un,$do)=@_;
3024: return
3025: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3026: }
3027: # ------------------------------------------------------------- Aboutme Wrapper
3028:
3029: sub aboutmewrapper {
1.166 www 3030: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 3031: if (!defined($username) && !defined($domain)) {
3032: return;
3033: }
1.205 www 3034: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.692.4.2 raeburn 3035: ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3036: }
3037:
3038: # ------------------------------------------------------------ Syllabus Wrapper
3039:
3040:
3041: sub syllabuswrapper {
1.109 matthew 3042: my ($linktext,$coursedir,$domain,$fontcolor)=@_;
3043: if ($fontcolor) {
3044: $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
3045: }
1.208 matthew 3046: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3047: }
1.14 harris41 3048:
1.208 matthew 3049: sub track_student_link {
1.692.4.17 raeburn 3050: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3051: my $link ="/adm/trackstudent?";
1.208 matthew 3052: my $title = 'View recent activity';
3053: if (defined($sname) && $sname !~ /^\s*$/ &&
3054: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3055: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3056: $title .= ' of this student';
1.268 albertel 3057: }
1.208 matthew 3058: if (defined($target) && $target !~ /^\s*$/) {
3059: $target = qq{target="$target"};
3060: } else {
3061: $target = '';
3062: }
1.268 albertel 3063: if ($start) { $link.='&start='.$start; }
1.692.4.17 raeburn 3064: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3065: $title = &mt($title);
3066: $linktext = &mt($linktext);
1.448 albertel 3067: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3068: &help_open_topic('View_recent_activity');
1.208 matthew 3069: }
3070:
1.692.4.2 raeburn 3071: sub slot_reservations_link {
3072: my ($linktext,$sname,$sdom,$target) = @_;
3073: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3074: my $title = 'View slot reservation history';
3075: if (defined($sname) && $sname !~ /^\s*$/ &&
3076: defined($sdom) && $sdom !~ /^\s*$/) {
3077: $link .= "&uname=$sname&udom=$sdom";
3078: $title .= ' of this student';
3079: }
3080: if (defined($target) && $target !~ /^\s*$/) {
3081: $target = qq{target="$target"};
3082: } else {
3083: $target = '';
3084: }
3085: $title = &mt($title);
3086: $linktext = &mt($linktext);
3087: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3088: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3089:
3090: }
3091:
1.508 www 3092: # ===================================================== Display a student photo
3093:
3094:
1.509 albertel 3095: sub student_image_tag {
1.508 www 3096: my ($domain,$user)=@_;
3097: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3098: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3099: return '<img src="'.$imgsrc.'" align="right" />';
3100: } else {
3101: return '';
3102: }
3103: }
3104:
1.112 bowersj2 3105: =pod
3106:
3107: =back
3108:
3109: =head1 Access .tab File Data
3110:
3111: =over 4
3112:
1.648 raeburn 3113: =item * &languageids()
1.112 bowersj2 3114:
3115: returns list of all language ids
3116:
3117: =cut
3118:
1.14 harris41 3119: sub languageids {
1.16 harris41 3120: return sort(keys(%language));
1.14 harris41 3121: }
3122:
1.112 bowersj2 3123: =pod
3124:
1.648 raeburn 3125: =item * &languagedescription()
1.112 bowersj2 3126:
3127: returns description of a specified language id
3128:
3129: =cut
3130:
1.14 harris41 3131: sub languagedescription {
1.125 www 3132: my $code=shift;
3133: return ($supported_language{$code}?'* ':'').
3134: $language{$code}.
1.126 www 3135: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3136: }
3137:
3138: sub plainlanguagedescription {
3139: my $code=shift;
3140: return $language{$code};
3141: }
3142:
3143: sub supportedlanguagecode {
3144: my $code=shift;
3145: return $supported_language{$code};
1.97 www 3146: }
3147:
1.112 bowersj2 3148: =pod
3149:
1.648 raeburn 3150: =item * ©rightids()
1.112 bowersj2 3151:
3152: returns list of all copyrights
3153:
3154: =cut
3155:
3156: sub copyrightids {
3157: return sort(keys(%cprtag));
3158: }
3159:
3160: =pod
3161:
1.648 raeburn 3162: =item * ©rightdescription()
1.112 bowersj2 3163:
3164: returns description of a specified copyright id
3165:
3166: =cut
3167:
3168: sub copyrightdescription {
1.166 www 3169: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3170: }
1.197 matthew 3171:
3172: =pod
3173:
1.648 raeburn 3174: =item * &source_copyrightids()
1.192 taceyjo1 3175:
3176: returns list of all source copyrights
3177:
3178: =cut
3179:
3180: sub source_copyrightids {
3181: return sort(keys(%scprtag));
3182: }
3183:
3184: =pod
3185:
1.648 raeburn 3186: =item * &source_copyrightdescription()
1.192 taceyjo1 3187:
3188: returns description of a specified source copyright id
3189:
3190: =cut
3191:
3192: sub source_copyrightdescription {
3193: return &mt($scprtag{shift(@_)});
3194: }
1.112 bowersj2 3195:
3196: =pod
3197:
1.648 raeburn 3198: =item * &filecategories()
1.112 bowersj2 3199:
3200: returns list of all file categories
3201:
3202: =cut
3203:
3204: sub filecategories {
3205: return sort(keys(%category_extensions));
3206: }
3207:
3208: =pod
3209:
1.648 raeburn 3210: =item * &filecategorytypes()
1.112 bowersj2 3211:
3212: returns list of file types belonging to a given file
3213: category
3214:
3215: =cut
3216:
3217: sub filecategorytypes {
1.356 albertel 3218: my ($cat) = @_;
3219: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3220: }
3221:
3222: =pod
3223:
1.648 raeburn 3224: =item * &fileembstyle()
1.112 bowersj2 3225:
3226: returns embedding style for a specified file type
3227:
3228: =cut
3229:
3230: sub fileembstyle {
3231: return $fe{lc(shift(@_))};
1.169 www 3232: }
3233:
1.351 www 3234: sub filemimetype {
3235: return $fm{lc(shift(@_))};
3236: }
3237:
1.169 www 3238:
3239: sub filecategoryselect {
3240: my ($name,$value)=@_;
1.189 matthew 3241: return &select_form($value,$name,
1.169 www 3242: '' => &mt('Any category'),
3243: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 3244: }
3245:
3246: =pod
3247:
1.648 raeburn 3248: =item * &filedescription()
1.112 bowersj2 3249:
3250: returns description for a specified file type
3251:
3252: =cut
3253:
3254: sub filedescription {
1.188 matthew 3255: my $file_description = $fd{lc(shift())};
3256: $file_description =~ s:([\[\]]):~$1:g;
3257: return &mt($file_description);
1.112 bowersj2 3258: }
3259:
3260: =pod
3261:
1.648 raeburn 3262: =item * &filedescriptionex()
1.112 bowersj2 3263:
3264: returns description for a specified file type with
3265: extra formatting
3266:
3267: =cut
3268:
3269: sub filedescriptionex {
3270: my $ex=shift;
1.188 matthew 3271: my $file_description = $fd{lc($ex)};
3272: $file_description =~ s:([\[\]]):~$1:g;
3273: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3274: }
3275:
3276: # End of .tab access
3277: =pod
3278:
3279: =back
3280:
3281: =cut
3282:
3283: # ------------------------------------------------------------------ File Types
3284: sub fileextensions {
3285: return sort(keys(%fe));
3286: }
3287:
1.97 www 3288: # ----------------------------------------------------------- Display Languages
3289: # returns a hash with all desired display languages
3290: #
3291:
3292: sub display_languages {
3293: my %languages=();
1.692.4.1 raeburn 3294: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3295: $languages{$lang}=1;
1.97 www 3296: }
3297: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3298: if ($env{'form.displaylanguage'}) {
1.356 albertel 3299: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3300: $languages{$lang}=1;
1.97 www 3301: }
3302: }
3303: return %languages;
1.14 harris41 3304: }
3305:
1.582 albertel 3306: sub languages {
3307: my ($possible_langs) = @_;
1.692.4.1 raeburn 3308: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3309: if (!ref($possible_langs)) {
3310: if( wantarray ) {
3311: return @preferred_langs;
3312: } else {
3313: return $preferred_langs[0];
3314: }
3315: }
3316: my %possibilities = map { $_ => 1 } (@$possible_langs);
3317: my @preferred_possibilities;
3318: foreach my $preferred_lang (@preferred_langs) {
3319: if (exists($possibilities{$preferred_lang})) {
3320: push(@preferred_possibilities, $preferred_lang);
3321: }
3322: }
3323: if( wantarray ) {
3324: return @preferred_possibilities;
3325: }
3326: return $preferred_possibilities[0];
3327: }
3328:
1.692.4.2 raeburn 3329: sub user_lang {
3330: my ($touname,$toudom,$fromcid) = @_;
3331: my @userlangs;
3332: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3333: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3334: $env{'course.'.$fromcid.'.languages'}));
3335: } else {
3336: my %langhash = &getlangs($touname,$toudom);
3337: if ($langhash{'languages'} ne '') {
3338: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3339: } else {
3340: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3341: if ($domdefs{'lang_def'} ne '') {
3342: @userlangs = ($domdefs{'lang_def'});
3343: }
3344: }
3345: }
3346: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3347: my $user_lh = Apache::localize->get_handle(@languages);
3348: return $user_lh;
3349: }
3350:
1.112 bowersj2 3351: ###############################################################
3352: ## Student Answer Attempts ##
3353: ###############################################################
3354:
3355: =pod
3356:
3357: =head1 Alternate Problem Views
3358:
3359: =over 4
3360:
1.648 raeburn 3361: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3362: $getattempt, $regexp, $gradesub)
3363:
3364: Return string with previous attempt on problem. Arguments:
3365:
3366: =over 4
3367:
3368: =item * $symb: Problem, including path
3369:
3370: =item * $username: username of the desired student
3371:
3372: =item * $domain: domain of the desired student
1.14 harris41 3373:
1.112 bowersj2 3374: =item * $course: Course ID
1.14 harris41 3375:
1.112 bowersj2 3376: =item * $getattempt: Leave blank for all attempts, otherwise put
3377: something
1.14 harris41 3378:
1.112 bowersj2 3379: =item * $regexp: if string matches this regexp, the string will be
3380: sent to $gradesub
1.14 harris41 3381:
1.112 bowersj2 3382: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3383:
1.112 bowersj2 3384: =back
1.14 harris41 3385:
1.112 bowersj2 3386: The output string is a table containing all desired attempts, if any.
1.16 harris41 3387:
1.112 bowersj2 3388: =cut
1.1 albertel 3389:
3390: sub get_previous_attempt {
1.43 ng 3391: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3392: my $prevattempts='';
1.43 ng 3393: no strict 'refs';
1.1 albertel 3394: if ($symb) {
1.3 albertel 3395: my (%returnhash)=
3396: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3397: if ($returnhash{'version'}) {
3398: my %lasthash=();
3399: my $version;
3400: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3401: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3402: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3403: }
1.1 albertel 3404: }
1.596 albertel 3405: $prevattempts=&start_data_table().&start_data_table_header_row();
3406: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3407: foreach my $key (sort(keys(%lasthash))) {
3408: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3409: if ($#parts > 0) {
1.31 albertel 3410: my $data=$parts[-1];
3411: pop(@parts);
1.596 albertel 3412: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3413: } else {
1.41 ng 3414: if ($#parts == 0) {
3415: $prevattempts.='<th>'.$parts[0].'</th>';
3416: } else {
3417: $prevattempts.='<th>'.$ign.'</th>';
3418: }
1.31 albertel 3419: }
1.16 harris41 3420: }
1.596 albertel 3421: $prevattempts.=&end_data_table_header_row();
1.40 ng 3422: if ($getattempt eq '') {
3423: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3424: $prevattempts.=&start_data_table_row().
3425: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3426: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3427: my $value = &format_previous_attempt_value($key,
3428: $returnhash{$version.':'.$key});
3429: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3430: }
1.596 albertel 3431: $prevattempts.=&end_data_table_row();
1.40 ng 3432: }
1.1 albertel 3433: }
1.596 albertel 3434: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3435: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3436: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3437: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3438: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3439: }
1.596 albertel 3440: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3441: } else {
1.596 albertel 3442: $prevattempts=
3443: &start_data_table().&start_data_table_row().
3444: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3445: &end_data_table_row().&end_data_table();
1.1 albertel 3446: }
3447: } else {
1.596 albertel 3448: $prevattempts=
3449: &start_data_table().&start_data_table_row().
3450: '<td>'.&mt('No data.').'</td>'.
3451: &end_data_table_row().&end_data_table();
1.1 albertel 3452: }
1.10 albertel 3453: }
3454:
1.581 albertel 3455: sub format_previous_attempt_value {
3456: my ($key,$value) = @_;
3457: if ($key =~ /timestamp/) {
3458: $value = &Apache::lonlocal::locallocaltime($value);
3459: } elsif (ref($value) eq 'ARRAY') {
3460: $value = '('.join(', ', @{ $value }).')';
3461: } else {
3462: $value = &unescape($value);
3463: }
3464: return $value;
3465: }
3466:
3467:
1.107 albertel 3468: sub relative_to_absolute {
3469: my ($url,$output)=@_;
3470: my $parser=HTML::TokeParser->new(\$output);
3471: my $token;
3472: my $thisdir=$url;
3473: my @rlinks=();
3474: while ($token=$parser->get_token) {
3475: if ($token->[0] eq 'S') {
3476: if ($token->[1] eq 'a') {
3477: if ($token->[2]->{'href'}) {
3478: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3479: }
3480: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3481: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3482: } elsif ($token->[1] eq 'base') {
3483: $thisdir=$token->[2]->{'href'};
3484: }
3485: }
3486: }
3487: $thisdir=~s-/[^/]*$--;
1.356 albertel 3488: foreach my $link (@rlinks) {
1.692.4.2 raeburn 3489: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3490: ($link=~/^\//) ||
3491: ($link=~/^javascript:/i) ||
3492: ($link=~/^mailto:/i) ||
3493: ($link=~/^\#/)) {
3494: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3495: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3496: }
3497: }
3498: # -------------------------------------------------- Deal with Applet codebases
3499: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3500: return $output;
3501: }
3502:
1.112 bowersj2 3503: =pod
3504:
1.648 raeburn 3505: =item * &get_student_view()
1.112 bowersj2 3506:
3507: show a snapshot of what student was looking at
3508:
3509: =cut
3510:
1.10 albertel 3511: sub get_student_view {
1.186 albertel 3512: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3513: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3514: my (%form);
1.10 albertel 3515: my @elements=('symb','courseid','domain','username');
3516: foreach my $element (@elements) {
1.186 albertel 3517: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3518: }
1.186 albertel 3519: if (defined($moreenv)) {
3520: %form=(%form,%{$moreenv});
3521: }
1.236 albertel 3522: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3523: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3524: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3525: $userview=~s/\<body[^\>]*\>//gi;
3526: $userview=~s/\<\/body\>//gi;
3527: $userview=~s/\<html\>//gi;
3528: $userview=~s/\<\/html\>//gi;
3529: $userview=~s/\<head\>//gi;
3530: $userview=~s/\<\/head\>//gi;
3531: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3532: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3533: if (wantarray) {
3534: return ($userview,$response);
3535: } else {
3536: return $userview;
3537: }
3538: }
3539:
3540: sub get_student_view_with_retries {
3541: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3542:
3543: my $ok = 0; # True if we got a good response.
3544: my $content;
3545: my $response;
3546:
3547: # Try to get the student_view done. within the retries count:
3548:
3549: do {
3550: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3551: $ok = $response->is_success;
3552: if (!$ok) {
3553: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3554: }
3555: $retries--;
3556: } while (!$ok && ($retries > 0));
3557:
3558: if (!$ok) {
3559: $content = ''; # On error return an empty content.
3560: }
1.651 www 3561: if (wantarray) {
3562: return ($content, $response);
3563: } else {
3564: return $content;
3565: }
1.11 albertel 3566: }
3567:
1.112 bowersj2 3568: =pod
3569:
1.648 raeburn 3570: =item * &get_student_answers()
1.112 bowersj2 3571:
3572: show a snapshot of how student was answering problem
3573:
3574: =cut
3575:
1.11 albertel 3576: sub get_student_answers {
1.100 sakharuk 3577: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3578: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3579: my (%moreenv);
1.11 albertel 3580: my @elements=('symb','courseid','domain','username');
3581: foreach my $element (@elements) {
1.186 albertel 3582: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3583: }
1.186 albertel 3584: $moreenv{'grade_target'}='answer';
3585: %moreenv=(%form,%moreenv);
1.497 raeburn 3586: $feedurl = &Apache::lonnet::clutter($feedurl);
3587: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3588: return $userview;
1.1 albertel 3589: }
1.116 albertel 3590:
3591: =pod
3592:
3593: =item * &submlink()
3594:
1.242 albertel 3595: Inputs: $text $uname $udom $symb $target
1.116 albertel 3596:
3597: Returns: A link to grades.pm such as to see the SUBM view of a student
3598:
3599: =cut
3600:
3601: ###############################################
3602: sub submlink {
1.242 albertel 3603: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3604: if (!($uname && $udom)) {
3605: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3606: &Apache::lonnet::whichuser($symb);
1.116 albertel 3607: if (!$symb) { $symb=$cursymb; }
3608: }
1.254 matthew 3609: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3610: $symb=&escape($symb);
1.242 albertel 3611: if ($target) { $target="target=\"$target\""; }
3612: return '<a href="/adm/grades?&command=submission&'.
3613: 'symb='.$symb.'&student='.$uname.
3614: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3615: }
3616: ##############################################
3617:
3618: =pod
3619:
3620: =item * &pgrdlink()
3621:
3622: Inputs: $text $uname $udom $symb $target
3623:
3624: Returns: A link to grades.pm such as to see the PGRD view of a student
3625:
3626: =cut
3627:
3628: ###############################################
3629: sub pgrdlink {
3630: my $link=&submlink(@_);
3631: $link=~s/(&command=submission)/$1&showgrading=yes/;
3632: return $link;
3633: }
3634: ##############################################
3635:
3636: =pod
3637:
3638: =item * &pprmlink()
3639:
3640: Inputs: $text $uname $udom $symb $target
3641:
3642: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3643: student and a specific resource
1.242 albertel 3644:
3645: =cut
3646:
3647: ###############################################
3648: sub pprmlink {
3649: my ($text,$uname,$udom,$symb,$target)=@_;
3650: if (!($uname && $udom)) {
3651: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3652: &Apache::lonnet::whichuser($symb);
1.242 albertel 3653: if (!$symb) { $symb=$cursymb; }
3654: }
1.254 matthew 3655: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3656: $symb=&escape($symb);
1.242 albertel 3657: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3658: return '<a href="/adm/parmset?command=set&'.
3659: 'symb='.$symb.'&uname='.$uname.
3660: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3661: }
3662: ##############################################
1.37 matthew 3663:
1.112 bowersj2 3664: =pod
3665:
3666: =back
3667:
3668: =cut
3669:
1.37 matthew 3670: ###############################################
1.51 www 3671:
3672:
3673: sub timehash {
1.687 raeburn 3674: my ($thistime) = @_;
3675: my $timezone = &Apache::lonlocal::gettimezone();
3676: my $dt = DateTime->from_epoch(epoch => $thistime)
3677: ->set_time_zone($timezone);
3678: my $wday = $dt->day_of_week();
3679: if ($wday == 7) { $wday = 0; }
3680: return ( 'second' => $dt->second(),
3681: 'minute' => $dt->minute(),
3682: 'hour' => $dt->hour(),
3683: 'day' => $dt->day_of_month(),
3684: 'month' => $dt->month(),
3685: 'year' => $dt->year(),
3686: 'weekday' => $wday,
3687: 'dayyear' => $dt->day_of_year(),
3688: 'dlsav' => $dt->is_dst() );
1.51 www 3689: }
3690:
1.370 www 3691: sub utc_string {
3692: my ($date)=@_;
1.371 www 3693: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3694: }
3695:
1.51 www 3696: sub maketime {
3697: my %th=@_;
1.687 raeburn 3698: my ($epoch_time,$timezone,$dt);
3699: $timezone = &Apache::lonlocal::gettimezone();
3700: eval {
3701: $dt = DateTime->new( year => $th{'year'},
3702: month => $th{'month'},
3703: day => $th{'day'},
3704: hour => $th{'hour'},
3705: minute => $th{'minute'},
3706: second => $th{'second'},
3707: time_zone => $timezone,
3708: );
3709: };
3710: if (!$@) {
3711: $epoch_time = $dt->epoch;
3712: if ($epoch_time) {
3713: return $epoch_time;
3714: }
3715: }
1.51 www 3716: return POSIX::mktime(
3717: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3718: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3719: }
3720:
3721: #########################################
1.51 www 3722:
3723: sub findallcourses {
1.482 raeburn 3724: my ($roles,$uname,$udom) = @_;
1.355 albertel 3725: my %roles;
3726: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3727: my %courses;
1.51 www 3728: my $now=time;
1.482 raeburn 3729: if (!defined($uname)) {
3730: $uname = $env{'user.name'};
3731: }
3732: if (!defined($udom)) {
3733: $udom = $env{'user.domain'};
3734: }
3735: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3736: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3737: if (!%roles) {
3738: %roles = (
3739: cc => 1,
1.692.4.22 raeburn 3740: co => 1,
1.482 raeburn 3741: in => 1,
3742: ep => 1,
3743: ta => 1,
3744: cr => 1,
3745: st => 1,
3746: );
3747: }
3748: foreach my $entry (keys(%roleshash)) {
3749: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3750: if ($trole =~ /^cr/) {
3751: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3752: } else {
3753: next if (!exists($roles{$trole}));
3754: }
3755: if ($tend) {
3756: next if ($tend < $now);
3757: }
3758: if ($tstart) {
3759: next if ($tstart > $now);
3760: }
3761: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3762: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3763: if ($secpart eq '') {
3764: ($cnum,$role) = split(/_/,$cnumpart);
3765: $sec = 'none';
3766: $realsec = '';
3767: } else {
3768: $cnum = $cnumpart;
3769: ($sec,$role) = split(/_/,$secpart);
3770: $realsec = $sec;
1.490 raeburn 3771: }
1.482 raeburn 3772: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3773: }
3774: } else {
3775: foreach my $key (keys(%env)) {
1.483 albertel 3776: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3777: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3778: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3779: next if ($role eq 'ca' || $role eq 'aa');
3780: next if (%roles && !exists($roles{$role}));
3781: my ($starttime,$endtime)=split(/\./,$env{$key});
3782: my $active=1;
3783: if ($starttime) {
3784: if ($now<$starttime) { $active=0; }
3785: }
3786: if ($endtime) {
3787: if ($now>$endtime) { $active=0; }
3788: }
3789: if ($active) {
3790: if ($sec eq '') {
3791: $sec = 'none';
3792: }
3793: $courses{$cdom.'_'.$cnum}{$sec} =
3794: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3795: }
3796: }
1.51 www 3797: }
3798: }
1.474 raeburn 3799: return %courses;
1.51 www 3800: }
1.37 matthew 3801:
1.54 www 3802: ###############################################
1.474 raeburn 3803:
3804: sub blockcheck {
1.482 raeburn 3805: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3806:
3807: if (!defined($udom)) {
3808: $udom = $env{'user.domain'};
3809: }
3810: if (!defined($uname)) {
3811: $uname = $env{'user.name'};
3812: }
3813:
3814: # If uname and udom are for a course, check for blocks in the course.
3815:
3816: if (&Apache::lonnet::is_course($udom,$uname)) {
3817: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3818: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3819: return ($startblock,$endblock);
3820: }
1.474 raeburn 3821:
1.502 raeburn 3822: my $startblock = 0;
3823: my $endblock = 0;
1.482 raeburn 3824: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3825:
1.490 raeburn 3826: # If uname is for a user, and activity is course-specific, i.e.,
3827: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3828:
1.490 raeburn 3829: if (($activity eq 'boards' || $activity eq 'chat' ||
3830: $activity eq 'groups') && ($env{'request.course.id'})) {
3831: foreach my $key (keys(%live_courses)) {
3832: if ($key ne $env{'request.course.id'}) {
3833: delete($live_courses{$key});
3834: }
3835: }
3836: }
3837:
3838: my $otheruser = 0;
3839: my %own_courses;
3840: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3841: # Resource belongs to user other than current user.
3842: $otheruser = 1;
3843: # Gather courses for current user
3844: %own_courses =
3845: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3846: }
3847:
3848: # Gather active course roles - course coordinator, instructor,
3849: # exam proctor, ta, student, or custom role.
1.474 raeburn 3850:
3851: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3852: my ($cdom,$cnum);
3853: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3854: $cdom = $env{'course.'.$course.'.domain'};
3855: $cnum = $env{'course.'.$course.'.num'};
3856: } else {
1.490 raeburn 3857: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3858: }
3859: my $no_ownblock = 0;
3860: my $no_userblock = 0;
1.533 raeburn 3861: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3862: # Check if current user has 'evb' priv for this
3863: if (defined($own_courses{$course})) {
3864: foreach my $sec (keys(%{$own_courses{$course}})) {
3865: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3866: if ($sec ne 'none') {
3867: $checkrole .= '/'.$sec;
3868: }
3869: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3870: $no_ownblock = 1;
3871: last;
3872: }
3873: }
3874: }
3875: # if they have 'evb' priv and are currently not playing student
3876: next if (($no_ownblock) &&
3877: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3878: }
1.474 raeburn 3879: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3880: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3881: if ($sec ne 'none') {
1.482 raeburn 3882: $checkrole .= '/'.$sec;
1.474 raeburn 3883: }
1.490 raeburn 3884: if ($otheruser) {
3885: # Resource belongs to user other than current user.
3886: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3887: my ($trole,$tdom,$tnum,$tsec);
3888: my $entry = $live_courses{$course}{$sec};
3889: if ($entry =~ /^cr/) {
3890: ($trole,$tdom,$tnum,$tsec) =
3891: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3892: } else {
3893: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3894: }
3895: my ($spec,$area,$trest,%allroles,%userroles);
3896: $area = '/'.$tdom.'/'.$tnum;
3897: $trest = $tnum;
3898: if ($tsec ne '') {
3899: $area .= '/'.$tsec;
3900: $trest .= '/'.$tsec;
3901: }
3902: $spec = $trole.'.'.$area;
3903: if ($trole =~ /^cr/) {
3904: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3905: $tdom,$spec,$trest,$area);
3906: } else {
3907: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3908: $tdom,$spec,$trest,$area);
3909: }
3910: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3911: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3912: if ($1) {
3913: $no_userblock = 1;
3914: last;
3915: }
3916: }
1.490 raeburn 3917: } else {
3918: # Resource belongs to current user
3919: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3920: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3921: $no_ownblock = 1;
3922: last;
3923: }
1.474 raeburn 3924: }
3925: }
3926: # if they have the evb priv and are currently not playing student
1.482 raeburn 3927: next if (($no_ownblock) &&
1.491 albertel 3928: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3929: next if ($no_userblock);
1.474 raeburn 3930:
1.490 raeburn 3931: # Retrieve blocking times and identity of blocker for course
3932: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3933:
3934: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3935: if (($start != 0) &&
3936: (($startblock == 0) || ($startblock > $start))) {
3937: $startblock = $start;
3938: }
3939: if (($end != 0) &&
3940: (($endblock == 0) || ($endblock < $end))) {
3941: $endblock = $end;
3942: }
1.490 raeburn 3943: }
3944: return ($startblock,$endblock);
3945: }
3946:
3947: sub get_blocks {
3948: my ($setters,$activity,$cdom,$cnum) = @_;
3949: my $startblock = 0;
3950: my $endblock = 0;
3951: my $course = $cdom.'_'.$cnum;
3952: $setters->{$course} = {};
3953: $setters->{$course}{'staff'} = [];
3954: $setters->{$course}{'times'} = [];
3955: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3956: foreach my $record (keys(%records)) {
3957: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3958: if ($start <= time && $end >= time) {
3959: my ($staff_name,$staff_dom,$title,$blocks) =
3960: &parse_block_record($records{$record});
3961: if ($blocks->{$activity} eq 'on') {
3962: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3963: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3964: if ( ($startblock == 0) || ($startblock > $start) ) {
3965: $startblock = $start;
1.490 raeburn 3966: }
1.491 albertel 3967: if ( ($endblock == 0) || ($endblock < $end) ) {
3968: $endblock = $end;
1.474 raeburn 3969: }
3970: }
3971: }
3972: }
3973: return ($startblock,$endblock);
3974: }
3975:
3976: sub parse_block_record {
3977: my ($record) = @_;
3978: my ($setuname,$setudom,$title,$blocks);
3979: if (ref($record) eq 'HASH') {
3980: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3981: $title = &unescape($record->{'event'});
3982: $blocks = $record->{'blocks'};
3983: } else {
3984: my @data = split(/:/,$record,3);
3985: if (scalar(@data) eq 2) {
3986: $title = $data[1];
3987: ($setuname,$setudom) = split(/@/,$data[0]);
3988: } else {
3989: ($setuname,$setudom,$title) = @data;
3990: }
3991: $blocks = { 'com' => 'on' };
3992: }
3993: return ($setuname,$setudom,$title,$blocks);
3994: }
3995:
3996: sub build_block_table {
3997: my ($startblock,$endblock,$setters) = @_;
3998: my %lt = &Apache::lonlocal::texthash(
3999: 'cacb' => 'Currently active communication blocks',
4000: 'cour' => 'Course',
4001: 'dura' => 'Duration',
4002: 'blse' => 'Block set by'
4003: );
4004: my $output;
1.476 raeburn 4005: $output = '<br />'.$lt{'cacb'}.':<br />';
1.474 raeburn 4006: $output .= &start_data_table();
4007: $output .= '
4008: <tr>
4009: <th>'.$lt{'cour'}.'</th>
4010: <th>'.$lt{'dura'}.'</th>
4011: <th>'.$lt{'blse'}.'</th>
4012: </tr>
4013: ';
4014: foreach my $course (keys(%{$setters})) {
4015: my %courseinfo=&Apache::lonnet::coursedescription($course);
4016: for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
4017: my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
1.490 raeburn 4018: my $fullname = &plainname($uname,$udom);
4019: if (defined($env{'user.name'}) && defined($env{'user.domain'})
4020: && $env{'user.name'} ne 'public'
4021: && $env{'user.domain'} ne 'public') {
4022: $fullname = &aboutmewrapper($fullname,$uname,$udom);
4023: }
1.474 raeburn 4024: my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
4025: $openblock = &Apache::lonlocal::locallocaltime($openblock);
4026: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
4027: $output .= &Apache::loncommon::start_data_table_row().
4028: '<td>'.$courseinfo{'description'}.'</td>'.
4029: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1.490 raeburn 4030: '<td>'.$fullname.'</td>'.
1.474 raeburn 4031: &Apache::loncommon::end_data_table_row();
4032: }
4033: }
4034: $output .= &end_data_table();
4035: }
4036:
1.490 raeburn 4037: sub blocking_status {
4038: my ($activity,$uname,$udom) = @_;
4039: my %setters;
4040: my ($blocked,$output,$ownitem,$is_course);
4041: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
4042: if ($startblock && $endblock) {
4043: $blocked = 1;
4044: if (wantarray) {
4045: my $category;
4046: if ($activity eq 'boards') {
4047: $category = 'Discussion posts in this course';
4048: } elsif ($activity eq 'blogs') {
4049: $category = 'Blogs';
4050: } elsif ($activity eq 'port') {
4051: if (defined($uname) && defined($udom)) {
4052: if ($uname eq $env{'user.name'} &&
4053: $udom eq $env{'user.domain'}) {
4054: $ownitem = 1;
4055: }
4056: }
4057: $is_course = &Apache::lonnet::is_course($udom,$uname);
4058: if ($ownitem) {
4059: $category = 'Your portfolio files';
4060: } elsif ($is_course) {
4061: my $coursedesc;
4062: foreach my $course (keys(%setters)) {
4063: my %courseinfo =
4064: &Apache::lonnet::coursedescription($course);
4065: $coursedesc = $courseinfo{'description'};
4066: }
1.692.4.2 raeburn 4067: $category = "Group portfolio files in the course '$coursedesc'";
1.490 raeburn 4068: } else {
4069: $category = 'Portfolio files belonging to ';
4070: if ($env{'user.name'} eq 'public' &&
4071: $env{'user.domain'} eq 'public') {
4072: $category .= &plainname($uname,$udom);
4073: } else {
4074: $category .= &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
4075: }
4076: }
4077: } elsif ($activity eq 'groups') {
4078: $category = 'Groups in this course';
4079: }
4080: my $showstart = &Apache::lonlocal::locallocaltime($startblock);
4081: my $showend = &Apache::lonlocal::locallocaltime($endblock);
4082: $output = '<br />'.&mt('[_1] will be inaccessible between [_2] and [_3] because communication is being blocked.',$category,$showstart,$showend).'<br />';
4083: if (!($activity eq 'port' && !($ownitem) && !($is_course))) {
4084: $output .= &build_block_table($startblock,$endblock,\%setters);
4085: }
4086: }
4087: }
4088: if (wantarray) {
4089: return ($blocked,$output);
4090: } else {
4091: return $blocked;
4092: }
4093: }
4094:
1.60 matthew 4095: ###############################################
4096:
1.682 raeburn 4097: sub check_ip_acc {
4098: my ($acc)=@_;
4099: &Apache::lonxml::debug("acc is $acc");
4100: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4101: return 1;
4102: }
4103: my $allowed=0;
4104: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4105:
4106: my $name;
4107: foreach my $pattern (split(',',$acc)) {
4108: $pattern =~ s/^\s*//;
4109: $pattern =~ s/\s*$//;
4110: if ($pattern =~ /\*$/) {
4111: #35.8.*
4112: $pattern=~s/\*//;
4113: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4114: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4115: #35.8.3.[34-56]
4116: my $low=$2;
4117: my $high=$3;
4118: $pattern=$1;
4119: if ($ip =~ /^\Q$pattern\E/) {
4120: my $last=(split(/\./,$ip))[3];
4121: if ($last <=$high && $last >=$low) { $allowed=1; }
4122: }
4123: } elsif ($pattern =~ /^\*/) {
4124: #*.msu.edu
4125: $pattern=~s/\*//;
4126: if (!defined($name)) {
4127: use Socket;
4128: my $netaddr=inet_aton($ip);
4129: ($name)=gethostbyaddr($netaddr,AF_INET);
4130: }
4131: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4132: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4133: #127.0.0.1
4134: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4135: } else {
4136: #some.name.com
4137: if (!defined($name)) {
4138: use Socket;
4139: my $netaddr=inet_aton($ip);
4140: ($name)=gethostbyaddr($netaddr,AF_INET);
4141: }
4142: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4143: }
4144: if ($allowed) { last; }
4145: }
4146: return $allowed;
4147: }
4148:
4149: ###############################################
4150:
1.60 matthew 4151: =pod
4152:
1.112 bowersj2 4153: =head1 Domain Template Functions
4154:
4155: =over 4
4156:
4157: =item * &determinedomain()
1.60 matthew 4158:
4159: Inputs: $domain (usually will be undef)
4160:
1.63 www 4161: Returns: Determines which domain should be used for designs
1.60 matthew 4162:
4163: =cut
1.54 www 4164:
1.60 matthew 4165: ###############################################
1.63 www 4166: sub determinedomain {
4167: my $domain=shift;
1.531 albertel 4168: if (! $domain) {
1.60 matthew 4169: # Determine domain if we have not been given one
1.692.4.18 raeburn 4170: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4171: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4172: if ($env{'request.role.domain'}) {
4173: $domain=$env{'request.role.domain'};
1.60 matthew 4174: }
4175: }
1.63 www 4176: return $domain;
4177: }
4178: ###############################################
1.517 raeburn 4179:
1.518 albertel 4180: sub devalidate_domconfig_cache {
4181: my ($udom)=@_;
4182: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4183: }
4184:
4185: # ---------------------- Get domain configuration for a domain
4186: sub get_domainconf {
4187: my ($udom) = @_;
4188: my $cachetime=1800;
4189: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4190: if (defined($cached)) { return %{$result}; }
4191:
4192: my %domconfig = &Apache::lonnet::get_dom('configuration',
4193: ['login','rolecolors'],$udom);
1.632 raeburn 4194: my (%designhash,%legacy);
1.518 albertel 4195: if (keys(%domconfig) > 0) {
4196: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4197: if (keys(%{$domconfig{'login'}})) {
4198: foreach my $key (keys(%{$domconfig{'login'}})) {
1.692.4.2 raeburn 4199: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4200: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4201: $designhash{$udom.'.login.'.$key.'_'.$img} =
4202: $domconfig{'login'}{$key}{$img};
4203: }
4204: } else {
4205: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4206: }
1.632 raeburn 4207: }
4208: } else {
4209: $legacy{'login'} = 1;
1.518 albertel 4210: }
1.632 raeburn 4211: } else {
4212: $legacy{'login'} = 1;
1.518 albertel 4213: }
4214: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4215: if (keys(%{$domconfig{'rolecolors'}})) {
4216: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4217: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4218: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4219: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4220: }
1.518 albertel 4221: }
4222: }
1.632 raeburn 4223: } else {
4224: $legacy{'rolecolors'} = 1;
1.518 albertel 4225: }
1.632 raeburn 4226: } else {
4227: $legacy{'rolecolors'} = 1;
1.518 albertel 4228: }
1.632 raeburn 4229: if (keys(%legacy) > 0) {
4230: my %legacyhash = &get_legacy_domconf($udom);
4231: foreach my $item (keys(%legacyhash)) {
4232: if ($item =~ /^\Q$udom\E\.login/) {
4233: if ($legacy{'login'}) {
4234: $designhash{$item} = $legacyhash{$item};
4235: }
4236: } else {
4237: if ($legacy{'rolecolors'}) {
4238: $designhash{$item} = $legacyhash{$item};
4239: }
1.518 albertel 4240: }
4241: }
4242: }
1.632 raeburn 4243: } else {
4244: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4245: }
4246: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4247: $cachetime);
4248: return %designhash;
4249: }
4250:
1.632 raeburn 4251: sub get_legacy_domconf {
4252: my ($udom) = @_;
4253: my %legacyhash;
4254: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4255: my $designfile = $designdir.'/'.$udom.'.tab';
4256: if (-e $designfile) {
4257: if ( open (my $fh,"<$designfile") ) {
4258: while (my $line = <$fh>) {
4259: next if ($line =~ /^\#/);
4260: chomp($line);
4261: my ($key,$val)=(split(/\=/,$line));
4262: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4263: }
4264: close($fh);
4265: }
4266: }
4267: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
4268: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4269: }
4270: return %legacyhash;
4271: }
4272:
1.63 www 4273: =pod
4274:
1.112 bowersj2 4275: =item * &domainlogo()
1.63 www 4276:
4277: Inputs: $domain (usually will be undef)
4278:
4279: Returns: A link to a domain logo, if the domain logo exists.
4280: If the domain logo does not exist, a description of the domain.
4281:
4282: =cut
1.112 bowersj2 4283:
1.63 www 4284: ###############################################
4285: sub domainlogo {
1.517 raeburn 4286: my $domain = &determinedomain(shift);
1.518 albertel 4287: my %designhash = &get_domainconf($domain);
1.517 raeburn 4288: # See if there is a logo
4289: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4290: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4291: if ($imgsrc =~ m{^/(adm|res)/}) {
4292: if ($imgsrc =~ m{^/res/}) {
4293: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4294: &Apache::lonnet::repcopy($local_name);
4295: }
4296: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4297: }
4298: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4299: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4300: return &Apache::lonnet::domain($domain,'description');
1.59 www 4301: } else {
1.60 matthew 4302: return '';
1.59 www 4303: }
4304: }
1.63 www 4305: ##############################################
4306:
4307: =pod
4308:
1.112 bowersj2 4309: =item * &designparm()
1.63 www 4310:
4311: Inputs: $which parameter; $domain (usually will be undef)
4312:
4313: Returns: value of designparamter $which
4314:
4315: =cut
1.112 bowersj2 4316:
1.397 albertel 4317:
1.400 albertel 4318: ##############################################
1.397 albertel 4319: sub designparm {
4320: my ($which,$domain)=@_;
1.258 albertel 4321: if ($env{'browser.blackwhite'} eq 'on') {
1.635 raeburn 4322: if ($which=~/\.(font|alink|vlink|link|textcol)$/) {
1.110 www 4323: return '#000000';
4324: }
1.635 raeburn 4325: if ($which=~/\.(pgbg|sidebg|bgcol)$/) {
1.110 www 4326: return '#FFFFFF';
4327: }
4328: if ($which=~/\.tabbg$/) {
4329: return '#CCCCCC';
4330: }
4331: }
1.397 albertel 4332: if (exists($env{'environment.color.'.$which})) {
1.258 albertel 4333: return $env{'environment.color.'.$which};
1.96 www 4334: }
1.63 www 4335: $domain=&determinedomain($domain);
1.518 albertel 4336: my %domdesign = &get_domainconf($domain);
1.520 raeburn 4337: my $output;
1.517 raeburn 4338: if ($domdesign{$domain.'.'.$which} ne '') {
1.520 raeburn 4339: $output = $domdesign{$domain.'.'.$which};
1.63 www 4340: } else {
1.520 raeburn 4341: $output = $defaultdesign{$which};
4342: }
4343: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4344: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4345: if ($output =~ m{^/(adm|res)/}) {
4346: if ($output =~ m{^/res/}) {
4347: my $local_name = &Apache::lonnet::filelocation('',$output);
4348: &Apache::lonnet::repcopy($local_name);
4349: }
1.520 raeburn 4350: $output = &lonhttpdurl($output);
4351: }
1.63 www 4352: }
1.520 raeburn 4353: return $output;
1.63 www 4354: }
1.59 www 4355:
1.60 matthew 4356: ###############################################
4357: ###############################################
4358:
4359: =pod
4360:
1.112 bowersj2 4361: =back
4362:
1.549 albertel 4363: =head1 HTML Helpers
1.112 bowersj2 4364:
4365: =over 4
4366:
4367: =item * &bodytag()
1.60 matthew 4368:
4369: Returns a uniform header for LON-CAPA web pages.
4370:
4371: Inputs:
4372:
1.112 bowersj2 4373: =over 4
4374:
4375: =item * $title, A title to be displayed on the page.
4376:
4377: =item * $function, the current role (can be undef).
4378:
4379: =item * $addentries, extra parameters for the <body> tag.
4380:
4381: =item * $bodyonly, if defined, only return the <body> tag.
4382:
4383: =item * $domain, if defined, force a given domain.
4384:
4385: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4386: text interface only)
1.60 matthew 4387:
1.326 albertel 4388: =item * $customtitle, alternate text to use instead of $title
4389: in the title box that appears, this text
4390: is not auto translated like the $title is
1.309 albertel 4391:
4392: =item * $notopbar, if true, keep the 'what is this' info but remove the
4393: navigational links
1.317 albertel 4394:
1.338 albertel 4395: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4396:
4397: =item * $notitle, if true keep the nav controls, but remove the title bar
4398:
1.361 albertel 4399: =item * $no_inline_link, if true and in remote mode, don't show the
4400: 'Switch To Inline Menu' link
4401:
1.460 albertel 4402: =item * $args, optional argument valid values are
4403: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4404: inherit_jsmath -> when creating popup window in a page,
4405: should it have jsmath forced on by the
4406: current page
1.460 albertel 4407:
1.112 bowersj2 4408: =back
4409:
1.60 matthew 4410: Returns: A uniform header for LON-CAPA web pages.
4411: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
4412: If $bodyonly is undef or zero, an html string containing a <body> tag and
4413: other decorations will be returned.
4414:
4415: =cut
4416:
1.54 www 4417: sub bodytag {
1.309 albertel 4418: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
1.460 albertel 4419: $notopbar,$bgcolor,$notitle,$no_inline_link,$args)=@_;
1.339 albertel 4420:
1.460 albertel 4421: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 4422:
1.183 matthew 4423: $function = &get_users_function() if (!$function);
1.339 albertel 4424: my $img = &designparm($function.'.img',$domain);
4425: my $font = &designparm($function.'.font',$domain);
4426: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
4427:
1.692.4.2 raeburn 4428: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 4429: 'bgcolor' => $pgbg,
1.339 albertel 4430: 'text' => $font,
4431: 'alink' => &designparm($function.'.alink',$domain),
4432: 'vlink' => &designparm($function.'.vlink',$domain),
4433: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 4434: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 4435:
1.63 www 4436: # role and realm
1.378 raeburn 4437: my ($role,$realm) = split(/\./,$env{'request.role'},2);
4438: if ($role eq 'ca') {
1.479 albertel 4439: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 4440: $realm = &plainname($rname,$rdom);
1.378 raeburn 4441: }
1.55 www 4442: # realm
1.258 albertel 4443: if ($env{'request.course.id'}) {
1.378 raeburn 4444: if ($env{'request.role'} !~ /^cr/) {
4445: $role = &Apache::lonnet::plaintext($role,&course_type());
4446: }
1.359 albertel 4447: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 4448: } else {
4449: $role = &Apache::lonnet::plaintext($role);
1.54 www 4450: }
1.433 albertel 4451:
1.359 albertel 4452: if (!$realm) { $realm=' '; }
1.55 www 4453: # Set messages
1.60 matthew 4454: my $messages=&domainlogo($domain);
1.330 albertel 4455:
1.438 albertel 4456: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 4457:
1.101 www 4458: # construct main body tag
1.359 albertel 4459: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 4460: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 4461:
1.530 albertel 4462: if ($bodyonly) {
1.60 matthew 4463: return $bodytag;
1.258 albertel 4464: } elsif ($env{'browser.interface'} eq 'textual') {
1.95 www 4465: # Accessibility
1.224 raeburn 4466:
1.337 albertel 4467: $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
1.338 albertel 4468: if (!$notitle) {
1.337 albertel 4469: $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
4470: }
4471: return $bodytag;
1.359 albertel 4472: }
4473:
1.410 albertel 4474: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4475: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4476: undef($role);
1.434 albertel 4477: } else {
4478: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4479: }
1.359 albertel 4480:
4481: my $roleinfo=(<<ENDROLE);
4482: <td class="LC_title_bar_who">
4483: <div class="LC_title_bar_name">
1.410 albertel 4484: $name
1.361 albertel 4485:
1.359 albertel 4486: </div>
4487: <div class="LC_title_bar_role">
1.361 albertel 4488: $role
1.359 albertel 4489: </div>
4490: <div class="LC_title_bar_realm">
1.361 albertel 4491: $realm
1.359 albertel 4492: </div>
1.206 albertel 4493: </td>
4494: ENDROLE
1.235 raeburn 4495:
1.359 albertel 4496: my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
4497: if ($customtitle) {
4498: $titleinfo = $customtitle;
4499: }
4500: #
4501: # Extra info if you are the DC
4502: my $dc_info = '';
4503: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4504: $env{'course.'.$env{'request.course.id'}.
4505: '.domain'}.'/'})) {
4506: my $cid = $env{'request.course.id'};
4507: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4508: $dc_info =~ s/\s+$//;
1.359 albertel 4509: $dc_info = '('.$dc_info.')';
4510: }
4511:
1.644 www 4512: if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
1.359 albertel 4513: # No Remote
1.258 albertel 4514: if ($env{'request.state'} eq 'construct') {
1.359 albertel 4515: $forcereg=1;
4516: }
4517:
4518: if (!$customtitle && $env{'request.state'} eq 'construct') {
4519: # this is for resources; directories have customtitle, and crumbs
4520: # and select recent are created in lonpubdir.pm
1.229 albertel 4521: my ($uname,$thisdisfn)=
1.258 albertel 4522: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
1.229 albertel 4523: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4524: $formaction=~s/\/+/\//g;
4525:
1.359 albertel 4526: my $parentpath = '';
4527: my $lastitem = '';
4528: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4529: $parentpath = $1;
4530: $lastitem = $2;
4531: } else {
4532: $lastitem = $thisdisfn;
4533: }
4534: $titleinfo =
1.640 bisitz 4535: &Apache::loncommon::help_open_menu('','',3,'Authoring')
4536: .'<b>'.&mt('Construction Space').'</b>: '
4537: .'<form name="dirs" method="post" action="'.$formaction
1.359 albertel 4538: .'" target="_top"><tt><b>'
4539: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
4540: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4541: .'</form>'
4542: .&Apache::lonmenu::constspaceform();
1.235 raeburn 4543: }
1.359 albertel 4544:
1.337 albertel 4545: my $titletable;
1.338 albertel 4546: if (!$notitle) {
1.337 albertel 4547: $titletable =
1.359 albertel 4548: '<table id="LC_title_bar">'.
4549: "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
4550: '</tr></table>';
1.337 albertel 4551: }
1.359 albertel 4552: if ($notopbar) {
4553: $bodytag .= $titletable;
4554: } else {
4555: if ($env{'request.state'} eq 'construct') {
1.337 albertel 4556: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
4557: $titletable);
1.272 raeburn 4558: } else {
1.336 albertel 4559: $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
1.359 albertel 4560: $titletable;
1.272 raeburn 4561: }
1.235 raeburn 4562: }
4563: return $bodytag;
1.94 www 4564: }
1.95 www 4565:
1.93 www 4566: #
1.95 www 4567: # Top frame rendering, Remote is up
1.93 www 4568: #
1.359 albertel 4569:
1.517 raeburn 4570: my $imgsrc = $img;
4571: if ($img =~ /^\/adm/) {
1.575 albertel 4572: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4573: }
4574: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4575:
1.305 www 4576: # Explicit link to get inline menu
1.361 albertel 4577: my $menu= ($no_inline_link?''
4578: :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
1.245 matthew 4579: #
1.338 albertel 4580: if ($notitle) {
1.337 albertel 4581: return $bodytag;
4582: }
1.94 www 4583: return(<<ENDBODY);
1.60 matthew 4584: $bodytag
1.359 albertel 4585: <table id="LC_title_bar" class="LC_with_remote">
1.368 albertel 4586: <tr><td class="LC_title_bar_role_logo">$upperleft</td>
1.359 albertel 4587: <td class="LC_title_bar_domain_logo">$messages </td>
1.54 www 4588: </tr>
1.359 albertel 4589: <tr><td>$titleinfo $dc_info $menu</td>
4590: $roleinfo
1.368 albertel 4591: </tr>
1.356 albertel 4592: </table>
1.54 www 4593: ENDBODY
1.182 matthew 4594: }
4595:
1.330 albertel 4596: sub make_attr_string {
4597: my ($register,$attr_ref) = @_;
4598:
4599: if ($attr_ref && !ref($attr_ref)) {
4600: die("addentries Must be a hash ref ".
4601: join(':',caller(1))." ".
4602: join(':',caller(0))." ");
4603: }
4604:
4605: if ($register) {
1.339 albertel 4606: my ($on_load,$on_unload);
4607: foreach my $key (keys(%{$attr_ref})) {
4608: if (lc($key) eq 'onload') {
4609: $on_load.=$attr_ref->{$key}.';';
4610: delete($attr_ref->{$key});
4611:
4612: } elsif (lc($key) eq 'onunload') {
4613: $on_unload.=$attr_ref->{$key}.';';
4614: delete($attr_ref->{$key});
4615: }
4616: }
4617: $attr_ref->{'onload'} =
4618: &Apache::lonmenu::loadevents(). $on_load;
4619: $attr_ref->{'onunload'}=
4620: &Apache::lonmenu::unloadevents().$on_unload;
4621: }
4622:
4623: # Accessibility font enhance
4624: if ($env{'browser.fontenhance'} eq 'on') {
4625: my $style;
4626: foreach my $key (keys(%{$attr_ref})) {
4627: if (lc($key) eq 'style') {
4628: $style.=$attr_ref->{$key}.';';
4629: delete($attr_ref->{$key});
4630: }
4631: }
4632: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4633: }
1.339 albertel 4634:
4635: if ($env{'browser.blackwhite'} eq 'on') {
4636: delete($attr_ref->{'font'});
4637: delete($attr_ref->{'link'});
4638: delete($attr_ref->{'alink'});
4639: delete($attr_ref->{'vlink'});
4640: delete($attr_ref->{'bgcolor'});
4641: delete($attr_ref->{'background'});
4642: }
4643:
1.330 albertel 4644: my $attr_string;
4645: foreach my $attr (keys(%$attr_ref)) {
4646: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4647: }
4648: return $attr_string;
4649: }
4650:
4651:
1.182 matthew 4652: ###############################################
1.251 albertel 4653: ###############################################
4654:
4655: =pod
4656:
4657: =item * &endbodytag()
4658:
4659: Returns a uniform footer for LON-CAPA web pages.
4660:
1.635 raeburn 4661: Inputs: 1 - optional reference to an args hash
4662: If in the hash, key for noredirectlink has a value which evaluates to true,
4663: a 'Continue' link is not displayed if the page contains an
4664: internal redirect in the <head></head> section,
4665: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4666:
4667: =cut
4668:
4669: sub endbodytag {
1.635 raeburn 4670: my ($args) = @_;
1.251 albertel 4671: my $endbodytag='</body>';
1.269 albertel 4672: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4673: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4674: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4675: $endbodytag=
4676: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4677: &mt('Continue').'</a>'.
4678: $endbodytag;
4679: }
1.315 albertel 4680: }
1.251 albertel 4681: return $endbodytag;
4682: }
4683:
1.352 albertel 4684: =pod
4685:
4686: =item * &standard_css()
4687:
4688: Returns a style sheet
4689:
4690: Inputs: (all optional)
4691: domain -> force to color decorate a page for a specific
4692: domain
4693: function -> force usage of a specific rolish color scheme
4694: bgcolor -> override the default page bgcolor
4695:
4696: =cut
4697:
1.343 albertel 4698: sub standard_css {
1.345 albertel 4699: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4700: $function = &get_users_function() if (!$function);
4701: my $img = &designparm($function.'.img', $domain);
4702: my $tabbg = &designparm($function.'.tabbg', $domain);
4703: my $font = &designparm($function.'.font', $domain);
1.345 albertel 4704: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4705: my $pgbg_or_bgcolor =
4706: $bgcolor ||
1.352 albertel 4707: &designparm($function.'.pgbg', $domain);
1.382 albertel 4708: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4709: my $alink = &designparm($function.'.alink', $domain);
4710: my $vlink = &designparm($function.'.vlink', $domain);
4711: my $link = &designparm($function.'.link', $domain);
4712:
1.602 albertel 4713: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4714: my $mono = 'monospace';
1.692.4.13 raeburn 4715: my $data_table_head = $tabbg;
1.692.4.6 raeburn 4716: my $data_table_light = '#FAFAFA';
4717: my $data_table_dark = '#F0F0F0';
1.470 banghart 4718: my $data_table_darker = '#CCCCCC';
1.349 albertel 4719: my $data_table_highlight = '#FFFF00';
1.352 albertel 4720: my $mail_new = '#FFBB77';
4721: my $mail_new_hover = '#DD9955';
4722: my $mail_read = '#BBBB77';
4723: my $mail_read_hover = '#999944';
4724: my $mail_replied = '#AAAA88';
4725: my $mail_replied_hover = '#888855';
4726: my $mail_other = '#99BBBB';
4727: my $mail_other_hover = '#669999';
1.391 albertel 4728: my $table_header = '#DDDDDD';
1.489 raeburn 4729: my $feedback_link_bg = '#BBBBBB';
1.692.4.3 raeburn 4730: my $lg_border_color = '#C8C8C8';
1.392 albertel 4731:
1.608 albertel 4732: my $border = ($env{'browser.type'} eq 'explorer' ||
1.692.4.2 raeburn 4733: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
4734: : '0 3px 0 4px';
1.448 albertel 4735:
1.523 albertel 4736:
1.343 albertel 4737: return <<END;
1.345 albertel 4738: h1, h2, h3, th { font-family: $sans }
1.343 albertel 4739: a:focus { color: red; background: yellow }
1.692.4.6 raeburn 4740:
4741: hr {
4742: clear: both;
4743: color: $tabbg;
4744: background-color: $tabbg;
4745: height: 3px;
4746: border: none;
4747: }
4748:
1.510 albertel 4749: table.thinborder,
1.523 albertel 4750:
1.510 albertel 4751: table.thinborder tr th {
4752: border-style: solid;
4753: border-width: 1px;
4754: background: $tabbg;
4755: }
1.523 albertel 4756: table.thinborder tr td {
1.510 albertel 4757: border-style: solid;
4758: border-width: 1px
4759: }
1.426 albertel 4760:
1.343 albertel 4761: form, .inline { display: inline; }
4762: .center { text-align: center; }
1.593 albertel 4763: .LC_filename {font-family: $mono; white-space:pre;}
1.350 albertel 4764: .LC_error {
4765: color: red;
4766: font-size: larger;
4767: }
1.457 albertel 4768: .LC_warning,
4769: .LC_diff_removed {
1.394 albertel 4770: color: red;
4771: }
1.532 albertel 4772:
4773: .LC_info,
1.457 albertel 4774: .LC_success,
4775: .LC_diff_added {
1.350 albertel 4776: color: green;
4777: }
1.692.4.2 raeburn 4778:
4779: div.LC_confirm_box {
4780: background-color: #FAFAFA;
4781: border: 1px solid $lg_border_color;
4782: margin-right: 0;
4783: padding: 5px;
4784: }
4785:
4786: div.LC_confirm_box .LC_error img,
4787: div.LC_confirm_box .LC_success img {
4788: vertical-align: middle;
1.543 albertel 4789: }
4790:
1.440 albertel 4791: .LC_icon {
1.692.4.2 raeburn 4792: border: none;
1.440 albertel 4793: }
1.539 albertel 4794: .LC_indexer_icon {
1.692.4.2 raeburn 4795: border: 0;
1.539 albertel 4796: height: 22px;
4797: }
1.543 albertel 4798: .LC_docs_spacer {
4799: width: 25px;
4800: height: 1px;
1.692.4.2 raeburn 4801: border: none;
1.543 albertel 4802: }
1.346 albertel 4803:
1.532 albertel 4804: .LC_internal_info {
1.692.4.2 raeburn 4805: color: #999999;
1.532 albertel 4806: }
4807:
1.692.4.19 raeburn 4808: .LC_discussion {
4809: background: $tabbg;
4810: border: 1px solid black;
4811: margin: 2px;
4812: }
4813:
4814: .LC_disc_action_links_bar {
4815: background: $tabbg;
4816: border: none;
4817: margin: 4px;
4818: }
4819:
4820: .LC_disc_action_left {
4821: text-align: left;
4822: }
4823:
4824: .LC_disc_action_right {
4825: text-align: right;
4826: }
4827:
4828: .LC_disc_new_item {
4829: background: white;
4830: border: 2px solid red;
4831: margin: 2px;
4832: }
4833:
4834: .LC_disc_old_item {
4835: background: white;
4836: border: 1px solid black;
4837: margin: 2px;
4838: }
4839:
1.458 albertel 4840: table.LC_pastsubmission {
4841: border: 1px solid black;
4842: margin: 2px;
4843: }
4844:
1.606 albertel 4845: table#LC_top_nav, table#LC_menubuttons,table#LC_nav_location {
1.345 albertel 4846: width: 100%;
4847: background: $pgbg;
1.392 albertel 4848: border: 2px;
1.402 albertel 4849: border-collapse: separate;
1.692.4.2 raeburn 4850: padding: 0;
1.345 albertel 4851: }
1.392 albertel 4852:
1.606 albertel 4853: table#LC_title_bar, table.LC_breadcrumbs,
1.393 albertel 4854: table#LC_title_bar.LC_with_remote {
1.359 albertel 4855: width: 100%;
1.392 albertel 4856: border-color: $pgbg;
4857: border-style: solid;
4858: border-width: $border;
4859:
1.379 albertel 4860: background: $pgbg;
4861: font-family: $sans;
1.392 albertel 4862: border-collapse: collapse;
1.692.4.2 raeburn 4863: padding: 0;
1.359 albertel 4864: }
1.392 albertel 4865:
1.409 albertel 4866: table.LC_docs_path {
4867: width: 100%;
4868: border: 0;
4869: background: $pgbg;
4870: font-family: $sans;
4871: border-collapse: collapse;
1.692.4.2 raeburn 4872: padding: 0;
1.409 albertel 4873: }
4874:
1.359 albertel 4875: table#LC_title_bar td {
4876: background: $tabbg;
4877: }
4878: table#LC_title_bar td.LC_title_bar_who {
4879: background: $tabbg;
4880: color: $font;
1.427 albertel 4881: font: small $sans;
1.359 albertel 4882: text-align: right;
4883: }
1.469 banghart 4884: span.LC_metadata {
4885: font-family: $sans;
4886: }
1.359 albertel 4887: span.LC_title_bar_title {
1.416 albertel 4888: font: bold x-large $sans;
1.359 albertel 4889: }
4890: table#LC_title_bar td.LC_title_bar_domain_logo {
4891: background: $sidebg;
4892: text-align: right;
1.692.4.2 raeburn 4893: padding: 0;
1.368 albertel 4894: }
4895: table#LC_title_bar td.LC_title_bar_role_logo {
4896: background: $sidebg;
1.692.4.2 raeburn 4897: padding: 0;
1.359 albertel 4898: }
4899:
1.346 albertel 4900: table#LC_menubuttons_mainmenu {
1.526 www 4901: width: 100%;
1.692.4.2 raeburn 4902: border: 0;
1.346 albertel 4903: border-spacing: 1px;
1.692.4.2 raeburn 4904: padding: 0 1px;
4905: margin: 0;
1.346 albertel 4906: border-collapse: separate;
4907: }
4908: table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
1.692.4.2 raeburn 4909: border: none;
1.346 albertel 4910: }
1.345 albertel 4911: table#LC_top_nav td {
4912: background: $tabbg;
1.692.4.2 raeburn 4913: border: none;
1.407 albertel 4914: font-size: small;
1.345 albertel 4915: }
4916: table#LC_top_nav td a, div#LC_top_nav a {
4917: color: $font;
4918: font-family: $sans;
4919: }
1.364 albertel 4920: table#LC_top_nav td.LC_top_nav_logo {
4921: background: $tabbg;
1.432 albertel 4922: text-align: left;
1.408 albertel 4923: white-space: nowrap;
1.432 albertel 4924: width: 31px;
1.408 albertel 4925: }
4926: table#LC_top_nav td.LC_top_nav_logo img {
1.692.4.2 raeburn 4927: border: none;
1.408 albertel 4928: vertical-align: bottom;
1.364 albertel 4929: }
1.432 albertel 4930: table#LC_top_nav td.LC_top_nav_exit,
4931: table#LC_top_nav td.LC_top_nav_help {
4932: width: 2.0em;
4933: }
1.442 albertel 4934: table#LC_top_nav td.LC_top_nav_login {
4935: width: 4.0em;
4936: text-align: center;
4937: }
1.409 albertel 4938: table.LC_breadcrumbs td, table.LC_docs_path td {
1.357 albertel 4939: background: $tabbg;
4940: color: $font;
4941: font-family: $sans;
1.358 albertel 4942: font-size: smaller;
1.357 albertel 4943: }
1.411 albertel 4944: table.LC_breadcrumbs td.LC_breadcrumbs_component,
1.409 albertel 4945: table.LC_docs_path td.LC_docs_path_component {
1.357 albertel 4946: background: $tabbg;
4947: color: $font;
4948: font-family: $sans;
4949: font-size: larger;
4950: text-align: right;
4951: }
1.383 albertel 4952: td.LC_table_cell_checkbox {
4953: text-align: center;
4954: }
1.522 albertel 4955: table#LC_mainmenu td.LC_mainmenu_column {
4956: vertical-align: top;
4957: }
4958:
1.346 albertel 4959: .LC_menubuttons_inline_text {
4960: color: $font;
4961: font-family: $sans;
4962: font-size: smaller;
4963: }
4964:
1.526 www 4965: .LC_menubuttons_link {
4966: text-decoration: none;
4967: }
1.692.4.2 raeburn 4968: /*2008--9-5: new menu style sheet.Changed category*/
1.522 albertel 4969: .LC_menubuttons_category {
1.521 www 4970: color: $font;
1.526 www 4971: background: $pgbg;
1.521 www 4972: font-family: $sans;
4973: font-size: larger;
4974: font-weight: bold;
4975: }
4976:
1.346 albertel 4977: td.LC_menubuttons_text {
1.526 www 4978: width: 90%;
1.346 albertel 4979: color: $font;
4980: font-family: $sans;
4981: }
1.526 www 4982:
1.346 albertel 4983: td.LC_menubuttons_img {
4984: }
1.526 www 4985:
1.346 albertel 4986: .LC_current_location {
4987: font-family: $sans;
4988: background: $tabbg;
4989: }
4990: .LC_new_mail {
4991: font-family: $sans;
1.634 www 4992: background: $tabbg;
1.346 albertel 4993: font-weight: bold;
4994: }
1.347 albertel 4995:
1.527 www 4996: .LC_dropadd_labeltext {
4997: font-family: $sans;
4998: text-align: right;
4999: }
5000:
5001: .LC_preferences_labeltext {
5002: font-family: $sans;
5003: text-align: right;
5004: }
5005:
1.666 raeburn 5006: .LC_roleslog_note {
5007: font-size: smaller;
5008: }
5009:
1.692.4.2 raeburn 5010: .LC_mail_functions {
5011: font-weight: bold;
5012: }
5013:
1.440 albertel 5014: table.LC_aboutme_port {
1.692.4.2 raeburn 5015: border: none;
1.440 albertel 5016: border-collapse: collapse;
1.692.4.2 raeburn 5017: border-spacing: 0;
1.440 albertel 5018: }
1.349 albertel 5019: table.LC_data_table, table.LC_mail_list {
1.347 albertel 5020: border: 1px solid #000000;
1.402 albertel 5021: border-collapse: separate;
1.426 albertel 5022: border-spacing: 1px;
1.610 albertel 5023: background: $pgbg;
1.347 albertel 5024: }
1.422 albertel 5025: .LC_data_table_dense {
5026: font-size: small;
5027: }
1.507 raeburn 5028: table.LC_nested_outer {
5029: border: 1px solid #000000;
1.589 raeburn 5030: border-collapse: collapse;
1.692.4.2 raeburn 5031: border-spacing: 0;
1.507 raeburn 5032: width: 100%;
5033: }
1.692.4.11 raeburn 5034: table.LC_innerpickbox,
1.507 raeburn 5035: table.LC_nested {
1.692.4.2 raeburn 5036: border: none;
1.589 raeburn 5037: border-collapse: collapse;
1.692.4.2 raeburn 5038: border-spacing: 0;
1.507 raeburn 5039: width: 100%;
5040: }
1.523 albertel 5041: table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
1.692.4.11 raeburn 5042: table.LC_prior_tries tr th,
5043: table.LC_innerpickbox tr th {
1.349 albertel 5044: font-weight: bold;
5045: background-color: $data_table_head;
1.421 albertel 5046: font-size: smaller;
1.347 albertel 5047: }
1.692.4.11 raeburn 5048: table.LC_innerpickbox tr th,
5049: table.LC_innerpickbox tr td {
5050: vertical-align: top;
5051: }
1.692.4.2 raeburn 5052: table.LC_data_table tr.LC_info_row > td {
5053: background-color: #CCCCCC;
5054: font-weight: bold;
5055: text-align: left;
5056: }
1.610 albertel 5057: table.LC_data_table tr.LC_odd_row > td,
1.692.4.2 raeburn 5058: table.LC_pick_box tr > td.LC_odd_row,
1.440 albertel 5059: table.LC_aboutme_port tr td {
1.349 albertel 5060: background-color: $data_table_light;
1.425 albertel 5061: padding: 2px;
1.347 albertel 5062: }
1.610 albertel 5063: table.LC_data_table tr.LC_even_row > td,
1.692.4.2 raeburn 5064: table.LC_pick_box tr > td.LC_even_row,
1.440 albertel 5065: table.LC_aboutme_port tr.LC_even_row td {
1.349 albertel 5066: background-color: $data_table_dark;
1.692.4.2 raeburn 5067: padding: 2px;
1.347 albertel 5068: }
1.425 albertel 5069: table.LC_data_table tr.LC_data_table_highlight td {
5070: background-color: $data_table_darker;
5071: }
1.639 raeburn 5072: table.LC_data_table tr td.LC_leftcol_header {
5073: background-color: $data_table_head;
5074: font-weight: bold;
5075: }
1.451 albertel 5076: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5077: table.LC_nested tr.LC_empty_row td {
1.347 albertel 5078: background-color: #FFFFFF;
1.421 albertel 5079: font-weight: bold;
5080: font-style: italic;
5081: text-align: center;
5082: padding: 8px;
1.347 albertel 5083: }
1.507 raeburn 5084: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5085: padding: 4ex
5086: }
1.507 raeburn 5087: table.LC_nested_outer tr th {
5088: font-weight: bold;
5089: background-color: $data_table_head;
5090: font-size: smaller;
5091: border-bottom: 1px solid #000000;
5092: }
5093: table.LC_nested_outer tr td.LC_subheader {
5094: background-color: $data_table_head;
5095: font-weight: bold;
5096: font-size: small;
5097: border-bottom: 1px solid #000000;
5098: text-align: right;
1.451 albertel 5099: }
1.507 raeburn 5100: table.LC_nested tr.LC_info_row td {
1.692.4.2 raeburn 5101: background-color: #CCCCCC;
1.451 albertel 5102: font-weight: bold;
5103: font-size: small;
1.507 raeburn 5104: text-align: center;
5105: }
1.589 raeburn 5106: table.LC_nested tr.LC_info_row td.LC_left_item,
5107: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5108: text-align: left;
1.451 albertel 5109: }
1.507 raeburn 5110: table.LC_nested td {
1.692.4.2 raeburn 5111: background-color: #FFFFFF;
1.451 albertel 5112: font-size: small;
1.507 raeburn 5113: }
5114: table.LC_nested_outer tr th.LC_right_item,
5115: table.LC_nested tr.LC_info_row td.LC_right_item,
5116: table.LC_nested tr.LC_odd_row td.LC_right_item,
5117: table.LC_nested tr td.LC_right_item {
1.451 albertel 5118: text-align: right;
5119: }
5120:
1.507 raeburn 5121: table.LC_nested tr.LC_odd_row td {
1.692.4.2 raeburn 5122: background-color: #EEEEEE;
1.451 albertel 5123: }
5124:
1.473 raeburn 5125: table.LC_createuser {
5126: }
5127:
5128: table.LC_createuser tr.LC_section_row td {
5129: font-size: smaller;
5130: }
5131:
5132: table.LC_createuser tr.LC_info_row td {
1.692.4.2 raeburn 5133: background-color: #CCCCCC;
1.473 raeburn 5134: font-weight: bold;
5135: text-align: center;
5136: }
5137:
1.349 albertel 5138: table.LC_calendar {
5139: border: 1px solid #000000;
5140: border-collapse: collapse;
5141: }
5142: table.LC_calendar_pickdate {
5143: font-size: xx-small;
5144: }
5145: table.LC_calendar tr td {
5146: border: 1px solid #000000;
5147: vertical-align: top;
5148: }
5149: table.LC_calendar tr td.LC_calendar_day_empty {
5150: background-color: $data_table_dark;
5151: }
5152: table.LC_calendar tr td.LC_calendar_day_current {
5153: background-color: $data_table_highlight;
5154: }
5155:
5156: table.LC_mail_list tr.LC_mail_new {
5157: background-color: $mail_new;
5158: }
5159: table.LC_mail_list tr.LC_mail_new:hover {
5160: background-color: $mail_new_hover;
5161: }
5162: table.LC_mail_list tr.LC_mail_read {
5163: background-color: $mail_read;
5164: }
5165: table.LC_mail_list tr.LC_mail_read:hover {
5166: background-color: $mail_read_hover;
5167: }
5168: table.LC_mail_list tr.LC_mail_replied {
5169: background-color: $mail_replied;
5170: }
5171: table.LC_mail_list tr.LC_mail_replied:hover {
5172: background-color: $mail_replied_hover;
5173: }
5174: table.LC_mail_list tr.LC_mail_other {
5175: background-color: $mail_other;
5176: }
5177: table.LC_mail_list tr.LC_mail_other:hover {
5178: background-color: $mail_other_hover;
5179: }
1.494 raeburn 5180: table.LC_mail_list tr.LC_mail_even {
5181: }
5182: table.LC_mail_list tr.LC_mail_odd {
5183: }
5184:
1.385 albertel 5185:
1.386 albertel 5186: table#LC_portfolio_actions {
5187: width: auto;
5188: background: $pgbg;
1.692.4.2 raeburn 5189: border: none;
1.386 albertel 5190: border-spacing: 2px 2px;
1.692.4.2 raeburn 5191: padding: 0;
5192: margin: 0;
1.386 albertel 5193: border-collapse: separate;
5194: }
5195: table#LC_portfolio_actions td.LC_label {
5196: background: $tabbg;
5197: text-align: right;
5198: }
5199: table#LC_portfolio_actions td.LC_value {
5200: background: $tabbg;
5201: }
1.385 albertel 5202:
1.391 albertel 5203: table#LC_cstr_controls {
5204: width: 100%;
5205: border-collapse: collapse;
5206: }
5207: table#LC_cstr_controls tr td {
5208: border: 4px solid $pgbg;
5209: padding: 4px;
5210: text-align: center;
5211: background: $tabbg;
5212: }
5213: table#LC_cstr_controls tr th {
5214: border: 4px solid $pgbg;
5215: background: $table_header;
5216: text-align: center;
5217: font-family: $sans;
5218: font-size: smaller;
5219: }
5220:
1.389 albertel 5221: table#LC_browser {
5222:
5223: }
5224: table#LC_browser tr th {
1.391 albertel 5225: background: $table_header;
1.389 albertel 5226: }
1.390 albertel 5227: table#LC_browser tr td {
5228: padding: 2px;
5229: }
1.389 albertel 5230: table#LC_browser tr.LC_browser_file,
5231: table#LC_browser tr.LC_browser_file_published {
5232: background: #CCFF88;
5233: }
5234: table#LC_browser tr.LC_browser_file_locked,
5235: table#LC_browser tr.LC_browser_file_unpublished {
5236: background: #FFAA99;
1.387 albertel 5237: }
1.389 albertel 5238: table#LC_browser tr.LC_browser_file_obsolete {
5239: background: #AAAAAA;
1.387 albertel 5240: }
1.455 albertel 5241: table#LC_browser tr.LC_browser_file_modified,
5242: table#LC_browser tr.LC_browser_file_metamodified {
1.389 albertel 5243: background: #FFFF77;
1.387 albertel 5244: }
1.389 albertel 5245: table#LC_browser tr.LC_browser_folder {
5246: background: #CCCCFF;
1.387 albertel 5247: }
1.692.4.2 raeburn 5248:
5249: table.LC_data_table tr > td.LC_roles_is {
5250: /* background: #77FF77; */
5251: }
5252: table.LC_data_table tr > td.LC_roles_future {
5253: background: #FFFF77;
5254: }
5255: table.LC_data_table tr > td.LC_roles_will {
5256: background: #FFAA77;
5257: }
5258: table.LC_data_table tr > td.LC_roles_expired {
5259: background: #FF7777;
5260: }
5261: table.LC_data_table tr > td.LC_roles_will_not {
5262: background: #AAFF77;
5263: }
5264: table.LC_data_table tr > td.LC_roles_selected {
5265: background: #11CC55;
5266: }
5267:
1.388 albertel 5268: span.LC_current_location {
5269: font-size: x-large;
5270: background: $pgbg;
5271: }
1.387 albertel 5272:
1.395 albertel 5273: span.LC_parm_menu_item {
5274: font-size: larger;
5275: font-family: $sans;
5276: }
5277: span.LC_parm_scope_all {
5278: color: red;
5279: }
5280: span.LC_parm_scope_folder {
5281: color: green;
5282: }
5283: span.LC_parm_scope_resource {
5284: color: orange;
5285: }
5286: span.LC_parm_part {
5287: color: blue;
5288: }
5289: span.LC_parm_folder, span.LC_parm_symb {
5290: font-size: x-small;
5291: font-family: $mono;
5292: color: #AAAAAA;
5293: }
5294:
1.396 albertel 5295: td.LC_parm_overview_level_menu, td.LC_parm_overview_map_menu,
5296: td.LC_parm_overview_parm_selectors, td.LC_parm_overview_parm_restrictions {
5297: border: 1px solid black;
5298: border-collapse: collapse;
5299: }
5300: table.LC_parm_overview_restrictions td {
5301: border-width: 1px 4px 1px 4px;
5302: border-style: solid;
5303: border-color: $pgbg;
5304: text-align: center;
5305: }
5306: table.LC_parm_overview_restrictions th {
5307: background: $tabbg;
5308: border-width: 1px 4px 1px 4px;
5309: border-style: solid;
5310: border-color: $pgbg;
5311: }
1.398 albertel 5312: table#LC_helpmenu {
1.692.4.2 raeburn 5313: border: none;
1.398 albertel 5314: height: 55px;
1.692.4.2 raeburn 5315: border-spacing: 0;
1.398 albertel 5316: }
5317:
5318: table#LC_helpmenu fieldset legend {
5319: font-size: larger;
5320: font-weight: bold;
5321: }
1.397 albertel 5322: table#LC_helpmenu_links {
5323: width: 100%;
5324: border: 1px solid black;
5325: background: $pgbg;
1.692.4.2 raeburn 5326: padding: 0;
1.397 albertel 5327: border-spacing: 1px;
5328: }
5329: table#LC_helpmenu_links tr td {
5330: padding: 1px;
5331: background: $tabbg;
1.399 albertel 5332: text-align: center;
5333: font-weight: bold;
1.397 albertel 5334: }
1.396 albertel 5335:
1.397 albertel 5336: table#LC_helpmenu_links a:link, table#LC_helpmenu_links a:visited,
5337: table#LC_helpmenu_links a:active {
5338: text-decoration: none;
5339: color: $font;
5340: }
5341: table#LC_helpmenu_links a:hover {
5342: text-decoration: underline;
5343: color: $vlink;
5344: }
1.396 albertel 5345:
1.417 albertel 5346: .LC_chrt_popup_exists {
5347: border: 1px solid #339933;
5348: margin: -1px;
5349: }
5350: .LC_chrt_popup_up {
5351: border: 1px solid yellow;
5352: margin: -1px;
5353: }
5354: .LC_chrt_popup {
5355: border: 1px solid #8888FF;
5356: background: #CCCCFF;
5357: }
1.421 albertel 5358: table.LC_pick_box {
5359: border-collapse: separate;
5360: background: white;
5361: border: 1px solid black;
5362: border-spacing: 1px;
5363: }
5364: table.LC_pick_box td.LC_pick_box_title {
1.692.4.16 raeburn 5365: background: $tabbg;
1.421 albertel 5366: font-weight: bold;
5367: text-align: right;
1.692.4.2 raeburn 5368: vertical-align: top;
1.421 albertel 5369: width: 184px;
5370: padding: 8px;
5371: }
1.645 raeburn 5372: table.LC_pick_box td.LC_selfenroll_pick_box_title {
1.692.4.16 raeburn 5373: background: $tabbg;
1.645 raeburn 5374: font-weight: bold;
5375: text-align: right;
5376: width: 350px;
5377: padding: 8px;
5378: }
5379:
1.579 raeburn 5380: table.LC_pick_box td.LC_pick_box_value {
5381: text-align: left;
5382: padding: 8px;
5383: }
5384: table.LC_pick_box td.LC_pick_box_select {
5385: text-align: left;
5386: padding: 8px;
5387: }
1.424 albertel 5388: table.LC_pick_box td.LC_pick_box_separator {
1.692.4.2 raeburn 5389: padding: 0;
1.421 albertel 5390: height: 1px;
5391: background: black;
5392: }
5393: table.LC_pick_box td.LC_pick_box_submit {
5394: text-align: right;
5395: }
1.579 raeburn 5396: table.LC_pick_box td.LC_evenrow_value {
5397: text-align: left;
5398: padding: 8px;
5399: background-color: $data_table_light;
5400: }
5401: table.LC_pick_box td.LC_oddrow_value {
5402: text-align: left;
5403: padding: 8px;
5404: background-color: $data_table_light;
5405: }
5406: table.LC_helpform_receipt {
5407: width: 620px;
5408: border-collapse: separate;
5409: background: white;
5410: border: 1px solid black;
5411: border-spacing: 1px;
5412: }
5413: table.LC_helpform_receipt td.LC_pick_box_title {
5414: background: $tabbg;
5415: font-weight: bold;
5416: text-align: right;
5417: width: 184px;
5418: padding: 8px;
5419: }
5420: table.LC_helpform_receipt td.LC_evenrow_value {
5421: text-align: left;
5422: padding: 8px;
5423: background-color: $data_table_light;
5424: }
5425: table.LC_helpform_receipt td.LC_oddrow_value {
5426: text-align: left;
5427: padding: 8px;
5428: background-color: $data_table_light;
5429: }
5430: table.LC_helpform_receipt td.LC_pick_box_separator {
1.692.4.2 raeburn 5431: padding: 0;
1.579 raeburn 5432: height: 1px;
5433: background: black;
5434: }
5435: span.LC_helpform_receipt_cat {
5436: font-weight: bold;
5437: }
1.424 albertel 5438: table.LC_group_priv_box {
5439: background: white;
5440: border: 1px solid black;
5441: border-spacing: 1px;
5442: }
5443: table.LC_group_priv_box td.LC_pick_box_title {
5444: background: $tabbg;
5445: font-weight: bold;
5446: text-align: right;
5447: width: 184px;
5448: }
5449: table.LC_group_priv_box td.LC_groups_fixed {
5450: background: $data_table_light;
5451: text-align: center;
5452: }
5453: table.LC_group_priv_box td.LC_groups_optional {
5454: background: $data_table_dark;
5455: text-align: center;
5456: }
5457: table.LC_group_priv_box td.LC_groups_functionality {
5458: background: $data_table_darker;
5459: text-align: center;
5460: font-weight: bold;
5461: }
5462: table.LC_group_priv td {
5463: text-align: left;
1.692.4.2 raeburn 5464: padding: 0;
1.424 albertel 5465: }
5466:
1.421 albertel 5467: table.LC_notify_front_page {
5468: background: white;
5469: border: 1px solid black;
5470: padding: 8px;
5471: }
5472: table.LC_notify_front_page td {
5473: padding: 8px;
5474: }
1.424 albertel 5475: .LC_navbuttons {
5476: margin: 2ex 0ex 2ex 0ex;
5477: }
1.423 albertel 5478: .LC_topic_bar {
5479: font-family: $sans;
5480: font-weight: bold;
5481: width: 100%;
5482: background: $tabbg;
5483: vertical-align: middle;
5484: margin: 2ex 0ex 2ex 0ex;
1.692.4.2 raeburn 5485: padding: 3px;
1.423 albertel 5486: }
5487: .LC_topic_bar span {
5488: vertical-align: middle;
5489: }
5490: .LC_topic_bar img {
5491: vertical-align: bottom;
5492: }
5493: table.LC_course_group_status {
5494: margin: 20px;
5495: }
5496: table.LC_status_selector td {
5497: vertical-align: top;
5498: text-align: center;
1.424 albertel 5499: padding: 4px;
5500: }
5501: table.LC_descriptive_input td.LC_description {
5502: vertical-align: top;
5503: text-align: right;
5504: font-weight: bold;
1.423 albertel 5505: }
1.599 albertel 5506: div.LC_feedback_link {
1.616 albertel 5507: clear: both;
1.599 albertel 5508: background: white;
5509: width: 100%;
1.489 raeburn 5510: }
5511: span.LC_feedback_link {
1.599 albertel 5512: background: $feedback_link_bg;
5513: font-size: larger;
5514: }
5515: span.LC_message_link {
5516: background: $feedback_link_bg;
5517: font-size: larger;
5518: position: absolute;
5519: right: 1em;
1.489 raeburn 5520: }
1.421 albertel 5521:
1.515 albertel 5522: table.LC_prior_tries {
1.524 albertel 5523: border: 1px solid #000000;
5524: border-collapse: separate;
5525: border-spacing: 1px;
1.515 albertel 5526: }
1.523 albertel 5527:
1.515 albertel 5528: table.LC_prior_tries td {
1.524 albertel 5529: padding: 2px;
1.515 albertel 5530: }
1.523 albertel 5531:
5532: .LC_answer_correct {
5533: background: #AAFFAA;
5534: color: black;
5535: }
5536: .LC_answer_charged_try {
5537: background: #FFAAAA ! important;
5538: color: black;
5539: }
5540: .LC_answer_not_charged_try,
5541: .LC_answer_no_grade,
5542: .LC_answer_late {
5543: background: #FFFFAA;
5544: color: black;
5545: }
5546: .LC_answer_previous {
5547: background: #AAAAFF;
5548: color: black;
5549: }
5550: .LC_answer_no_message {
5551: background: #FFFFFF;
5552: color: black;
5553: }
5554: .LC_answer_unknown {
5555: background: orange;
5556: color: black;
5557: }
5558:
5559:
1.529 albertel 5560: span.LC_prior_numerical,
5561: span.LC_prior_string,
5562: span.LC_prior_custom,
5563: span.LC_prior_reaction,
5564: span.LC_prior_math {
1.523 albertel 5565: font-family: monospace;
5566: white-space: pre;
5567: }
5568:
1.525 albertel 5569: span.LC_prior_string {
5570: font-family: monospace;
5571: white-space: pre;
5572: }
5573:
1.523 albertel 5574: table.LC_prior_option {
5575: width: 100%;
5576: border-collapse: collapse;
5577: }
1.528 albertel 5578: table.LC_prior_rank, table.LC_prior_match {
5579: border-collapse: collapse;
5580: }
5581: table.LC_prior_option tr td,
5582: table.LC_prior_rank tr td,
5583: table.LC_prior_match tr td {
1.524 albertel 5584: border: 1px solid #000000;
1.515 albertel 5585: }
5586:
1.519 raeburn 5587: span.LC_nobreak {
1.544 albertel 5588: white-space: nowrap;
1.519 raeburn 5589: }
5590:
1.576 raeburn 5591: span.LC_cusr_emph {
5592: font-style: italic;
5593: }
5594:
1.633 raeburn 5595: span.LC_cusr_subheading {
5596: font-weight: normal;
5597: font-size: 85%;
5598: }
5599:
1.545 albertel 5600: table.LC_docs_documents {
5601: background: #BBBBBB;
1.692.4.2 raeburn 5602: border-width: 0;
1.545 albertel 5603: border-collapse: collapse;
5604: }
5605:
5606: table.LC_docs_documents td.LC_docs_document {
5607: border: 2px solid black;
5608: padding: 4px;
5609: }
5610:
5611: .LC_docs_course_commands div {
5612: float: left;
5613: border: 4px solid #AAAAAA;
5614: padding: 4px;
5615: background: #DDDDCC;
5616: }
5617:
5618: .LC_docs_entry_move {
1.692.4.2 raeburn 5619: border: none;
1.545 albertel 5620: border-collapse: collapse;
1.544 albertel 5621: }
5622:
1.545 albertel 5623: .LC_docs_entry_move td {
5624: border: 2px solid #BBBBBB;
5625: background: #DDDDDD;
5626: }
5627:
5628: .LC_docs_editor td.LC_docs_entry_commands {
5629: background: #DDDDDD;
5630: font-size: x-small;
5631: }
1.544 albertel 5632: .LC_docs_copy {
1.545 albertel 5633: color: #000099;
1.544 albertel 5634: }
5635: .LC_docs_cut {
1.545 albertel 5636: color: #550044;
1.544 albertel 5637: }
5638: .LC_docs_rename {
1.545 albertel 5639: color: #009900;
1.544 albertel 5640: }
5641: .LC_docs_remove {
1.545 albertel 5642: color: #990000;
5643: }
5644:
1.547 albertel 5645: .LC_docs_reinit_warn,
5646: .LC_docs_ext_edit {
5647: font-size: x-small;
5648: }
5649:
1.545 albertel 5650: .LC_docs_editor td.LC_docs_entry_title,
5651: .LC_docs_editor td.LC_docs_entry_icon {
5652: background: #FFFFBB;
5653: }
5654: .LC_docs_editor td.LC_docs_entry_parameter {
5655: background: #BBBBFF;
5656: font-size: x-small;
5657: white-space: nowrap;
5658: }
5659:
5660: table.LC_docs_adddocs td,
5661: table.LC_docs_adddocs th {
5662: border: 1px solid #BBBBBB;
5663: padding: 4px;
5664: background: #DDDDDD;
1.543 albertel 5665: }
5666:
1.584 albertel 5667: table.LC_sty_begin {
5668: background: #BBFFBB;
5669: }
5670: table.LC_sty_end {
5671: background: #FFBBBB;
5672: }
5673:
1.589 raeburn 5674: table.LC_double_column {
1.692.4.2 raeburn 5675: border-width: 0;
1.589 raeburn 5676: border-collapse: collapse;
5677: width: 100%;
5678: padding: 2px;
5679: }
5680:
5681: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5682: top: 2px;
1.589 raeburn 5683: left: 2px;
5684: width: 47%;
5685: vertical-align: top;
5686: }
5687:
5688: table.LC_double_column tr td.LC_right_col {
5689: top: 2px;
5690: right: 2px;
5691: width: 47%;
5692: vertical-align: top;
5693: }
5694:
1.594 raeburn 5695: span.LC_role_level {
5696: font-weight: bold;
5697: }
5698:
1.591 raeburn 5699: div.LC_left_float {
5700: float: left;
5701: padding-right: 5%;
1.597 albertel 5702: padding-bottom: 4px;
1.591 raeburn 5703: }
5704:
5705: div.LC_clear_float_header {
1.597 albertel 5706: padding-bottom: 2px;
1.591 raeburn 5707: }
5708:
5709: div.LC_clear_float_footer {
1.597 albertel 5710: padding-top: 10px;
1.591 raeburn 5711: clear: both;
5712: }
5713:
1.597 albertel 5714:
1.601 albertel 5715: div.LC_grade_select_mode {
1.604 albertel 5716: font-family: $sans;
1.601 albertel 5717: }
5718: div.LC_grade_select_mode div div {
5719: margin: 5px;
5720: }
5721: div.LC_grade_select_mode_selector {
5722: margin: 5px;
5723: float: left;
5724: }
5725: div.LC_grade_select_mode_selector_header {
5726: font: bold medium $sans;
5727: }
5728: div.LC_grade_select_mode_type {
5729: clear: left;
5730: }
5731:
1.597 albertel 5732: div.LC_grade_show_user {
5733: margin-top: 20px;
5734: border: 1px solid black;
5735: }
5736: div.LC_grade_user_name {
5737: background: #DDDDEE;
5738: border-bottom: 1px solid black;
5739: font: bold large $sans;
5740: }
5741: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5742: background: #DDEEDD;
5743: }
5744:
5745: div.LC_grade_show_problem,
5746: div.LC_grade_submissions,
5747: div.LC_grade_message_center,
5748: div.LC_grade_info_links,
5749: div.LC_grade_assign {
5750: margin: 5px;
5751: width: 99%;
5752: background: #FFFFFF;
5753: }
5754: div.LC_grade_show_problem_header,
5755: div.LC_grade_submissions_header,
5756: div.LC_grade_message_center_header,
5757: div.LC_grade_assign_header {
5758: font: bold large $sans;
5759: }
5760: div.LC_grade_show_problem_problem,
5761: div.LC_grade_submissions_body,
5762: div.LC_grade_message_center_body,
5763: div.LC_grade_assign_body {
5764: border: 1px solid black;
5765: width: 99%;
5766: background: #FFFFFF;
5767: }
1.598 albertel 5768: span.LC_grade_check_note {
5769: font: normal medium $sans;
5770: display: inline;
5771: position: absolute;
5772: right: 1em;
5773: }
1.597 albertel 5774:
1.613 albertel 5775: table.LC_scantron_action {
5776: width: 100%;
5777: }
5778: table.LC_scantron_action tr th {
5779: font: normal bold $sans;
5780: }
1.600 albertel 5781:
1.614 albertel 5782: div.LC_edit_problem_header,
5783: div.LC_edit_problem_footer {
1.600 albertel 5784: font: normal medium $sans;
1.602 albertel 5785: margin: 2px;
1.600 albertel 5786: }
5787: div.LC_edit_problem_header,
1.602 albertel 5788: div.LC_edit_problem_header div,
1.614 albertel 5789: div.LC_edit_problem_footer,
5790: div.LC_edit_problem_footer div,
1.602 albertel 5791: div.LC_edit_problem_editxml_header,
5792: div.LC_edit_problem_editxml_header div {
1.600 albertel 5793: margin-top: 5px;
5794: }
1.602 albertel 5795: div.LC_edit_problem_header_edit_row {
5796: background: $tabbg;
5797: padding: 3px;
5798: margin-bottom: 5px;
5799: }
1.600 albertel 5800: div.LC_edit_problem_header_title {
1.602 albertel 5801: font: larger bold $sans;
5802: background: $tabbg;
5803: padding: 3px;
5804: }
5805: table.LC_edit_problem_header_title {
5806: font: larger bold $sans;
5807: width: 100%;
5808: border-color: $pgbg;
5809: border-style: solid;
5810: border-width: $border;
5811:
1.600 albertel 5812: background: $tabbg;
1.602 albertel 5813: border-collapse: collapse;
1.692.4.2 raeburn 5814: padding: 0;
1.602 albertel 5815: }
5816:
5817: div.LC_edit_problem_discards {
5818: float: left;
5819: padding-bottom: 5px;
5820: }
5821: div.LC_edit_problem_saves {
5822: float: right;
5823: padding-bottom: 5px;
1.600 albertel 5824: }
5825: hr.LC_edit_problem_divide {
1.602 albertel 5826: clear: both;
1.600 albertel 5827: color: $tabbg;
5828: background-color: $tabbg;
5829: height: 3px;
1.692.4.2 raeburn 5830: border: none;
1.600 albertel 5831: }
1.679 riegler 5832: img.stift{
1.678 riegler 5833: border-width:0;
1.679 riegler 5834: vertical-align:middle;
1.677 riegler 5835: }
1.680 riegler 5836:
1.681 riegler 5837: table#LC_mainmenu{
5838: margin-top:10px;
5839: width:80%;
5840:
5841: }
5842:
1.680 riegler 5843: table#LC_mainmenu td.LC_mainmenu_col_fieldset{
5844: vertical-align: top;
5845: width: 45%;
5846: }
5847: .LC_mainmenu_fieldset_category {
5848: color: $font;
5849: background: $pgbg;
5850: font-family: $sans;
5851: font-size: small;
5852: font-weight: bold;
5853: }
5854: fieldset#LC_mainmenu_fieldset {
1.692.4.2 raeburn 5855: margin:0 10px 10px 0;
5856:
5857: }
1.680 riegler 5858:
1.692.4.2 raeburn 5859: div.LC_createcourse {
5860: margin: 10px 10px 10px 10px;
1.680 riegler 5861: }
1.692.4.2 raeburn 5862:
1.343 albertel 5863: END
5864: }
5865:
1.306 albertel 5866: =pod
5867:
5868: =item * &headtag()
5869:
5870: Returns a uniform footer for LON-CAPA web pages.
5871:
1.307 albertel 5872: Inputs: $title - optional title for the head
5873: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 5874: $args - optional arguments
1.319 albertel 5875: force_register - if is true call registerurl so the remote is
5876: informed
1.415 albertel 5877: redirect -> array ref of
5878: 1- seconds before redirect occurs
5879: 2- url to redirect to
5880: 3- whether the side effect should occur
1.315 albertel 5881: (side effect of setting
5882: $env{'internal.head.redirect'} to the url
5883: redirected too)
1.352 albertel 5884: domain -> force to color decorate a page for a specific
5885: domain
5886: function -> force usage of a specific rolish color scheme
5887: bgcolor -> override the default page bgcolor
1.460 albertel 5888: no_auto_mt_title
5889: -> prevent &mt()ing the title arg
1.464 albertel 5890:
1.306 albertel 5891: =cut
5892:
5893: sub headtag {
1.313 albertel 5894: my ($title,$head_extra,$args) = @_;
1.306 albertel 5895:
1.363 albertel 5896: my $function = $args->{'function'} || &get_users_function();
5897: my $domain = $args->{'domain'} || &determinedomain();
5898: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 5899: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 5900: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 5901: #time(),
1.418 albertel 5902: $env{'environment.color.timestamp'},
1.363 albertel 5903: $function,$domain,$bgcolor);
5904:
1.369 www 5905: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 5906:
1.308 albertel 5907: my $result =
5908: '<head>'.
1.461 albertel 5909: &font_settings();
1.319 albertel 5910:
1.461 albertel 5911: if (!$args->{'frameset'}) {
5912: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
5913: }
1.319 albertel 5914: if ($args->{'force_register'}) {
5915: $result .= &Apache::lonmenu::registerurl(1);
5916: }
1.436 albertel 5917: if (!$args->{'no_nav_bar'}
5918: && !$args->{'only_body'}
5919: && !$args->{'frameset'}) {
5920: $result .= &help_menu_js();
5921: }
1.319 albertel 5922:
1.314 albertel 5923: if (ref($args->{'redirect'})) {
1.414 albertel 5924: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 5925: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 5926: if (!$inhibit_continue) {
5927: $env{'internal.head.redirect'} = $url;
5928: }
1.313 albertel 5929: $result.=<<ADDMETA
5930: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 5931: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 5932: ADDMETA
5933: }
1.306 albertel 5934: if (!defined($title)) {
5935: $title = 'The LearningOnline Network with CAPA';
5936: }
1.460 albertel 5937: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
5938: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 5939: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
5940: .$head_extra;
1.306 albertel 5941: return $result;
5942: }
5943:
5944: =pod
5945:
1.340 albertel 5946: =item * &font_settings()
5947:
5948: Returns neccessary <meta> to set the proper encoding
5949:
5950: Inputs: none
5951:
5952: =cut
5953:
5954: sub font_settings {
5955: my $headerstring='';
1.647 www 5956: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 5957: $headerstring.=
5958: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
5959: }
5960: return $headerstring;
5961: }
5962:
1.341 albertel 5963: =pod
5964:
5965: =item * &xml_begin()
5966:
5967: Returns the needed doctype and <html>
5968:
5969: Inputs: none
5970:
5971: =cut
5972:
5973: sub xml_begin {
5974: my $output='';
5975:
1.592 albertel 5976: if ($env{'internal.start_page'}==1) {
5977: &Apache::lonhtmlcommon::init_htmlareafields();
5978: }
1.342 albertel 5979:
1.341 albertel 5980: if ($env{'browser.mathml'}) {
5981: $output='<?xml version="1.0"?>'
5982: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
5983: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
5984:
5985: # .'<!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">] >'
5986: .'<!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">'
5987: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
5988: .'xmlns="http://www.w3.org/1999/xhtml">';
5989: } else {
1.692.4.6 raeburn 5990: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'.
5991: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 5992: }
5993: return $output;
5994: }
1.340 albertel 5995:
5996: =pod
5997:
1.306 albertel 5998: =item * &endheadtag()
5999:
6000: Returns a uniform </head> for LON-CAPA web pages.
6001:
6002: Inputs: none
6003:
6004: =cut
6005:
6006: sub endheadtag {
6007: return '</head>';
6008: }
6009:
6010: =pod
6011:
6012: =item * &head()
6013:
6014: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
6015:
1.648 raeburn 6016: Inputs:
6017:
6018: =over 4
6019:
6020: $title - optional title for the page
6021:
6022: $head_extra - optional extra HTML to put inside the <head>
6023:
6024: =back
1.405 albertel 6025:
1.306 albertel 6026: =cut
6027:
6028: sub head {
1.325 albertel 6029: my ($title,$head_extra,$args) = @_;
6030: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 6031: }
6032:
6033: =pod
6034:
6035: =item * &start_page()
6036:
6037: Returns a complete <html> .. <body> section for LON-CAPA web pages.
6038:
1.648 raeburn 6039: Inputs:
6040:
6041: =over 4
6042:
6043: $title - optional title for the page
6044:
6045: $head_extra - optional extra HTML to incude inside the <head>
6046:
6047: $args - additional optional args supported are:
6048:
6049: =over 8
6050:
6051: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 6052: arg on
1.648 raeburn 6053: no_nav_bar -> is true will set &bodytag() notopbar arg on
6054: add_entries -> additional attributes to add to the <body>
6055: domain -> force to color decorate a page for a
1.317 albertel 6056: specific domain
1.648 raeburn 6057: function -> force usage of a specific rolish color
1.317 albertel 6058: scheme
1.648 raeburn 6059: redirect -> see &headtag()
6060: bgcolor -> override the default page bg color
6061: js_ready -> return a string ready for being used in
1.317 albertel 6062: a javascript writeln
1.648 raeburn 6063: html_encode -> return a string ready for being used in
1.320 albertel 6064: a html attribute
1.648 raeburn 6065: force_register -> if is true will turn on the &bodytag()
1.317 albertel 6066: $forcereg arg
1.648 raeburn 6067: body_title -> alternate text to use instead of $title
1.326 albertel 6068: in the title box that appears, this text
6069: is not auto translated like the $title is
1.648 raeburn 6070: frameset -> if true will start with a <frameset>
1.330 albertel 6071: rather than <body>
1.648 raeburn 6072: no_title -> if true the title bar won't be shown
6073: skip_phases -> hash ref of
1.338 albertel 6074: head -> skip the <html><head> generation
6075: body -> skip all <body> generation
1.648 raeburn 6076: no_inline_link -> if true and in remote mode, don't show the
1.361 albertel 6077: 'Switch To Inline Menu' link
1.648 raeburn 6078: no_auto_mt_title -> prevent &mt()ing the title arg
6079: inherit_jsmath -> when creating popup window in a page,
6080: should it have jsmath forced on by the
6081: current page
1.361 albertel 6082:
1.648 raeburn 6083: =back
1.460 albertel 6084:
1.648 raeburn 6085: =back
1.562 albertel 6086:
1.306 albertel 6087: =cut
6088:
6089: sub start_page {
1.309 albertel 6090: my ($title,$head_extra,$args) = @_;
1.318 albertel 6091: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 6092: my %head_args;
1.352 albertel 6093: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 6094: 'bgcolor','frameset','no_nav_bar','only_body',
6095: 'no_auto_mt_title') {
1.319 albertel 6096: if (defined($args->{$arg})) {
1.324 raeburn 6097: $head_args{$arg} = $args->{$arg};
1.319 albertel 6098: }
1.313 albertel 6099: }
1.319 albertel 6100:
1.315 albertel 6101: $env{'internal.start_page'}++;
1.338 albertel 6102: my $result;
6103: if (! exists($args->{'skip_phases'}{'head'}) ) {
6104: $result.=
1.341 albertel 6105: &xml_begin().
1.338 albertel 6106: &headtag($title,$head_extra,\%head_args).&endheadtag();
6107: }
6108:
6109: if (! exists($args->{'skip_phases'}{'body'}) ) {
6110: if ($args->{'frameset'}) {
6111: my $attr_string = &make_attr_string($args->{'force_register'},
6112: $args->{'add_entries'});
6113: $result .= "\n<frameset $attr_string>\n";
6114: } else {
6115: $result .=
6116: &bodytag($title,
6117: $args->{'function'}, $args->{'add_entries'},
6118: $args->{'only_body'}, $args->{'domain'},
6119: $args->{'force_register'}, $args->{'body_title'},
6120: $args->{'no_nav_bar'}, $args->{'bgcolor'},
1.460 albertel 6121: $args->{'no_title'}, $args->{'no_inline_link'},
6122: $args);
1.338 albertel 6123: }
1.330 albertel 6124: }
1.338 albertel 6125:
1.315 albertel 6126: if ($args->{'js_ready'}) {
1.317 albertel 6127: $result = &js_ready($result);
1.315 albertel 6128: }
1.320 albertel 6129: if ($args->{'html_encode'}) {
6130: $result = &html_encode($result);
6131: }
1.692.4.2 raeburn 6132: #Breadcrumbs
6133: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
6134: &Apache::lonhtmlcommon::clear_breadcrumbs();
6135: #if any br links exists, add them to the breadcrumbs
6136: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6137: foreach my $crumb (@{$args->{'bread_crumbs'}}){
6138: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
6139: }
6140: }
1.306 albertel 6141:
1.692.4.2 raeburn 6142: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
6143: if (exists($args->{'bread_crumbs_component'})){
6144: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
6145: } else {
6146: $result .= &Apache::lonhtmlcommon::breadcrumbs();
6147: }
6148: }
6149: return $result;
1.692.4.3 raeburn 6150: }
1.330 albertel 6151:
1.306 albertel 6152: =pod
6153:
6154: =item * &head()
6155:
6156: Returns a complete </body></html> section for LON-CAPA web pages.
6157:
1.315 albertel 6158: Inputs: $args - additional optional args supported are:
6159: js_ready -> return a string ready for being used in
6160: a javascript writeln
1.320 albertel 6161: html_encode -> return a string ready for being used in
6162: a html attribute
1.330 albertel 6163: frameset -> if true will start with a <frameset>
6164: rather than <body>
1.493 albertel 6165: dicsussion -> if true will get discussion from
6166: lonxml::xmlend
6167: (you can pass the target and parser arguments
6168: through optional 'target' and 'parser' args
6169: to this routine)
1.306 albertel 6170:
6171: =cut
6172:
6173: sub end_page {
1.315 albertel 6174: my ($args) = @_;
6175: $env{'internal.end_page'}++;
1.330 albertel 6176: my $result;
1.335 albertel 6177: if ($args->{'discussion'}) {
6178: my ($target,$parser);
6179: if (ref($args->{'discussion'})) {
6180: ($target,$parser) =($args->{'discussion'}{'target'},
6181: $args->{'discussion'}{'parser'});
6182: }
6183: $result .= &Apache::lonxml::xmlend($target,$parser);
6184: }
6185:
1.330 albertel 6186: if ($args->{'frameset'}) {
6187: $result .= '</frameset>';
6188: } else {
1.635 raeburn 6189: $result .= &endbodytag($args);
1.330 albertel 6190: }
6191: $result .= "\n</html>";
6192:
1.315 albertel 6193: if ($args->{'js_ready'}) {
1.317 albertel 6194: $result = &js_ready($result);
1.315 albertel 6195: }
1.335 albertel 6196:
1.320 albertel 6197: if ($args->{'html_encode'}) {
6198: $result = &html_encode($result);
6199: }
1.335 albertel 6200:
1.315 albertel 6201: return $result;
6202: }
6203:
1.320 albertel 6204: sub html_encode {
6205: my ($result) = @_;
6206:
1.322 albertel 6207: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 6208:
6209: return $result;
6210: }
1.317 albertel 6211: sub js_ready {
6212: my ($result) = @_;
6213:
1.323 albertel 6214: $result =~ s/[\n\r]/ /xmsg;
6215: $result =~ s/\\/\\\\/xmsg;
6216: $result =~ s/'/\\'/xmsg;
1.372 albertel 6217: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 6218:
6219: return $result;
6220: }
6221:
1.315 albertel 6222: sub validate_page {
6223: if ( exists($env{'internal.start_page'})
1.316 albertel 6224: && $env{'internal.start_page'} > 1) {
6225: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 6226: $env{'internal.start_page'}.' '.
1.316 albertel 6227: $ENV{'request.filename'});
1.315 albertel 6228: }
6229: if ( exists($env{'internal.end_page'})
1.316 albertel 6230: && $env{'internal.end_page'} > 1) {
6231: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 6232: $env{'internal.end_page'}.' '.
1.316 albertel 6233: $env{'request.filename'});
1.315 albertel 6234: }
6235: if ( exists($env{'internal.start_page'})
6236: && ! exists($env{'internal.end_page'})) {
1.316 albertel 6237: &Apache::lonnet::logthis('start_page called without end_page '.
6238: $env{'request.filename'});
1.315 albertel 6239: }
6240: if ( ! exists($env{'internal.start_page'})
6241: && exists($env{'internal.end_page'})) {
1.316 albertel 6242: &Apache::lonnet::logthis('end_page called without start_page'.
6243: $env{'request.filename'});
1.315 albertel 6244: }
1.306 albertel 6245: }
1.315 albertel 6246:
1.318 albertel 6247: sub simple_error_page {
6248: my ($r,$title,$msg) = @_;
6249: my $page =
6250: &Apache::loncommon::start_page($title).
6251: &mt($msg).
6252: &Apache::loncommon::end_page();
6253: if (ref($r)) {
6254: $r->print($page);
1.327 albertel 6255: return;
1.318 albertel 6256: }
6257: return $page;
6258: }
1.347 albertel 6259:
6260: {
1.610 albertel 6261: my @row_count;
1.347 albertel 6262: sub start_data_table {
1.422 albertel 6263: my ($add_class) = @_;
6264: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 6265: unshift(@row_count,0);
1.422 albertel 6266: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 6267: }
6268:
6269: sub end_data_table {
1.610 albertel 6270: shift(@row_count);
1.389 albertel 6271: return '</table>'."\n";;
1.347 albertel 6272: }
6273:
6274: sub start_data_table_row {
1.422 albertel 6275: my ($add_class) = @_;
1.610 albertel 6276: $row_count[0]++;
6277: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 6278: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 6279: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 6280: }
1.471 banghart 6281:
6282: sub continue_data_table_row {
6283: my ($add_class) = @_;
1.610 albertel 6284: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 6285: $css_class = (join(' ',$css_class,$add_class));
6286: return '<tr class="'.$css_class.'">'."\n";;
6287: }
1.347 albertel 6288:
6289: sub end_data_table_row {
1.389 albertel 6290: return '</tr>'."\n";;
1.347 albertel 6291: }
1.367 www 6292:
1.421 albertel 6293: sub start_data_table_empty_row {
1.610 albertel 6294: $row_count[0]++;
1.421 albertel 6295: return '<tr class="LC_empty_row" >'."\n";;
6296: }
6297:
6298: sub end_data_table_empty_row {
6299: return '</tr>'."\n";;
6300: }
6301:
1.367 www 6302: sub start_data_table_header_row {
1.389 albertel 6303: return '<tr class="LC_header_row">'."\n";;
1.367 www 6304: }
6305:
6306: sub end_data_table_header_row {
1.389 albertel 6307: return '</tr>'."\n";;
1.367 www 6308: }
1.347 albertel 6309: }
6310:
1.548 albertel 6311: =pod
6312:
6313: =item * &inhibit_menu_check($arg)
6314:
6315: Checks for a inhibitmenu state and generates output to preserve it
6316:
6317: Inputs: $arg - can be any of
6318: - undef - in which case the return value is a string
6319: to add into arguments list of a uri
6320: - 'input' - in which case the return value is a HTML
6321: <form> <input> field of type hidden to
6322: preserve the value
6323: - a url - in which case the return value is the url with
6324: the neccesary cgi args added to preserve the
6325: inhibitmenu state
6326: - a ref to a url - no return value, but the string is
6327: updated to include the neccessary cgi
6328: args to preserve the inhibitmenu state
6329:
6330: =cut
6331:
6332: sub inhibit_menu_check {
6333: my ($arg) = @_;
6334: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6335: if ($arg eq 'input') {
6336: if ($env{'form.inhibitmenu'}) {
6337: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
6338: } else {
6339: return
6340: }
6341: }
6342: if ($env{'form.inhibitmenu'}) {
6343: if (ref($arg)) {
6344: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6345: } elsif ($arg eq '') {
6346: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
6347: } else {
6348: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6349: }
6350: }
6351: if (!ref($arg)) {
6352: return $arg;
6353: }
6354: }
6355:
1.251 albertel 6356: ###############################################
1.182 matthew 6357:
6358: =pod
6359:
1.549 albertel 6360: =back
6361:
6362: =head1 User Information Routines
6363:
6364: =over 4
6365:
1.405 albertel 6366: =item * &get_users_function()
1.182 matthew 6367:
6368: Used by &bodytag to determine the current users primary role.
6369: Returns either 'student','coordinator','admin', or 'author'.
6370:
6371: =cut
6372:
6373: ###############################################
6374: sub get_users_function {
6375: my $function = 'student';
1.692.4.22 raeburn 6376: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/
1.182 matthew 6377: $function='coordinator';
6378: }
1.258 albertel 6379: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 6380: $function='admin';
6381: }
1.692.4.5 raeburn 6382: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182 matthew 6383: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
6384: $function='author';
6385: }
6386: return $function;
1.54 www 6387: }
1.99 www 6388:
6389: ###############################################
6390:
1.233 raeburn 6391: =pod
6392:
1.692.4.2 raeburn 6393: =item * &show_course()
6394:
6395: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
6396: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
6397: Inputs:
6398: None
6399:
6400: Outputs:
6401: Scalar: 1 if 'Course' to be used, 0 otherwise.
6402:
6403: =cut
6404:
6405: ###############################################
6406: sub show_course {
6407: my $course = !$env{'user.adv'};
6408: if (!$env{'user.adv'}) {
6409: foreach my $env (keys(%env)) {
6410: next if ($env !~ m/^user\.priv\./);
6411: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
6412: $course = 0;
6413: last;
6414: }
6415: }
6416: }
6417: return $course;
6418: }
6419:
6420: ###############################################
6421:
6422: =pod
6423:
1.542 raeburn 6424: =item * &check_user_status()
1.274 raeburn 6425:
6426: Determines current status of supplied role for a
6427: specific user. Roles can be active, previous or future.
6428:
6429: Inputs:
6430: user's domain, user's username, course's domain,
1.375 raeburn 6431: course's number, optional section ID.
1.274 raeburn 6432:
6433: Outputs:
6434: role status: active, previous or future.
6435:
6436: =cut
6437:
6438: sub check_user_status {
1.412 raeburn 6439: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 6440: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
6441: my @uroles = keys %userinfo;
6442: my $srchstr;
6443: my $active_chk = 'none';
1.412 raeburn 6444: my $now = time;
1.274 raeburn 6445: if (@uroles > 0) {
1.692.4.22 raeburn 6446: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 6447: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
6448: } else {
1.412 raeburn 6449: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
6450: }
6451: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 6452: my $role_end = 0;
6453: my $role_start = 0;
6454: $active_chk = 'active';
1.412 raeburn 6455: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
6456: $role_end = $1;
6457: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
6458: $role_start = $1;
1.274 raeburn 6459: }
6460: }
6461: if ($role_start > 0) {
1.412 raeburn 6462: if ($now < $role_start) {
1.274 raeburn 6463: $active_chk = 'future';
6464: }
6465: }
6466: if ($role_end > 0) {
1.412 raeburn 6467: if ($now > $role_end) {
1.274 raeburn 6468: $active_chk = 'previous';
6469: }
6470: }
6471: }
6472: }
6473: return $active_chk;
6474: }
6475:
6476: ###############################################
6477:
6478: =pod
6479:
1.405 albertel 6480: =item * &get_sections()
1.233 raeburn 6481:
6482: Determines all the sections for a course including
6483: sections with students and sections containing other roles.
1.419 raeburn 6484: Incoming parameters:
6485:
6486: 1. domain
6487: 2. course number
6488: 3. reference to array containing roles for which sections should
6489: be gathered (optional).
6490: 4. reference to array containing status types for which sections
6491: should be gathered (optional).
6492:
6493: If the third argument is undefined, sections are gathered for any role.
6494: If the fourth argument is undefined, sections are gathered for any status.
6495: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 6496:
1.374 raeburn 6497: Returns section hash (keys are section IDs, values are
6498: number of users in each section), subject to the
1.419 raeburn 6499: optional roles filter, optional status filter
1.233 raeburn 6500:
6501: =cut
6502:
6503: ###############################################
6504: sub get_sections {
1.419 raeburn 6505: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 6506: if (!defined($cdom) || !defined($cnum)) {
6507: my $cid = $env{'request.course.id'};
6508:
6509: return if (!defined($cid));
6510:
6511: $cdom = $env{'course.'.$cid.'.domain'};
6512: $cnum = $env{'course.'.$cid.'.num'};
6513: }
6514:
6515: my %sectioncount;
1.419 raeburn 6516: my $now = time;
1.240 albertel 6517:
1.366 albertel 6518: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 6519: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 6520: my $sec_index = &Apache::loncoursedata::CL_SECTION();
6521: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 6522: my $start_index = &Apache::loncoursedata::CL_START();
6523: my $end_index = &Apache::loncoursedata::CL_END();
6524: my $status;
1.366 albertel 6525: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 6526: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
6527: $data->[$status_index],
6528: $data->[$start_index],
6529: $data->[$end_index]);
6530: if ($stu_status eq 'Active') {
6531: $status = 'active';
6532: } elsif ($end < $now) {
6533: $status = 'previous';
6534: } elsif ($start > $now) {
6535: $status = 'future';
6536: }
6537: if ($section ne '-1' && $section !~ /^\s*$/) {
6538: if ((!defined($possible_status)) || (($status ne '') &&
6539: (grep/^\Q$status\E$/,@{$possible_status}))) {
6540: $sectioncount{$section}++;
6541: }
1.240 albertel 6542: }
6543: }
6544: }
6545: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6546: foreach my $user (sort(keys(%courseroles))) {
6547: if ($user !~ /^(\w{2})/) { next; }
6548: my ($role) = ($user =~ /^(\w{2})/);
6549: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 6550: my ($section,$status);
1.240 albertel 6551: if ($role eq 'cr' &&
6552: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
6553: $section=$1;
6554: }
6555: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
6556: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 6557: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
6558: if ($end == -1 && $start == -1) {
6559: next; #deleted role
6560: }
6561: if (!defined($possible_status)) {
6562: $sectioncount{$section}++;
6563: } else {
6564: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
6565: $status = 'active';
6566: } elsif ($end < $now) {
6567: $status = 'future';
6568: } elsif ($start > $now) {
6569: $status = 'previous';
6570: }
6571: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
6572: $sectioncount{$section}++;
6573: }
6574: }
1.233 raeburn 6575: }
1.366 albertel 6576: return %sectioncount;
1.233 raeburn 6577: }
6578:
1.274 raeburn 6579: ###############################################
1.294 raeburn 6580:
6581: =pod
1.405 albertel 6582:
6583: =item * &get_course_users()
6584:
1.275 raeburn 6585: Retrieves usernames:domains for users in the specified course
6586: with specific role(s), and access status.
6587:
6588: Incoming parameters:
1.277 albertel 6589: 1. course domain
6590: 2. course number
6591: 3. access status: users must have - either active,
1.275 raeburn 6592: previous, future, or all.
1.277 albertel 6593: 4. reference to array of permissible roles
1.288 raeburn 6594: 5. reference to array of section restrictions (optional)
6595: 6. reference to results object (hash of hashes).
6596: 7. reference to optional userdata hash
1.609 raeburn 6597: 8. reference to optional statushash
1.630 raeburn 6598: 9. flag if privileged users (except those set to unhide in
6599: course settings) should be excluded
1.609 raeburn 6600: Keys of top level results hash are roles.
1.275 raeburn 6601: Keys of inner hashes are username:domain, with
6602: values set to access type.
1.288 raeburn 6603: Optional userdata hash returns an array with arguments in the
6604: same order as loncoursedata::get_classlist() for student data.
6605:
1.609 raeburn 6606: Optional statushash returns
6607:
1.288 raeburn 6608: Entries for end, start, section and status are blank because
6609: of the possibility of multiple values for non-student roles.
6610:
1.275 raeburn 6611: =cut
1.405 albertel 6612:
1.275 raeburn 6613: ###############################################
1.405 albertel 6614:
1.275 raeburn 6615: sub get_course_users {
1.630 raeburn 6616: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 6617: my %idx = ();
1.419 raeburn 6618: my %seclists;
1.288 raeburn 6619:
6620: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
6621: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
6622: $idx{end} = &Apache::loncoursedata::CL_END();
6623: $idx{start} = &Apache::loncoursedata::CL_START();
6624: $idx{id} = &Apache::loncoursedata::CL_ID();
6625: $idx{section} = &Apache::loncoursedata::CL_SECTION();
6626: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
6627: $idx{status} = &Apache::loncoursedata::CL_STATUS();
6628:
1.290 albertel 6629: if (grep(/^st$/,@{$roles})) {
1.276 albertel 6630: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 6631: my $now = time;
1.277 albertel 6632: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 6633: my $match = 0;
1.412 raeburn 6634: my $secmatch = 0;
1.419 raeburn 6635: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 6636: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 6637: if ($section eq '') {
6638: $section = 'none';
6639: }
1.291 albertel 6640: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6641: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6642: $secmatch = 1;
6643: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 6644: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6645: $secmatch = 1;
6646: }
6647: } else {
1.419 raeburn 6648: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 6649: $secmatch = 1;
6650: }
1.290 albertel 6651: }
1.412 raeburn 6652: if (!$secmatch) {
6653: next;
6654: }
1.419 raeburn 6655: }
1.275 raeburn 6656: if (defined($$types{'active'})) {
1.288 raeburn 6657: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 6658: push(@{$$users{st}{$student}},'active');
1.288 raeburn 6659: $match = 1;
1.275 raeburn 6660: }
6661: }
6662: if (defined($$types{'previous'})) {
1.609 raeburn 6663: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 6664: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 6665: $match = 1;
1.275 raeburn 6666: }
6667: }
6668: if (defined($$types{'future'})) {
1.609 raeburn 6669: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 6670: push(@{$$users{st}{$student}},'future');
1.288 raeburn 6671: $match = 1;
1.275 raeburn 6672: }
6673: }
1.609 raeburn 6674: if ($match) {
6675: push(@{$seclists{$student}},$section);
6676: if (ref($userdata) eq 'HASH') {
6677: $$userdata{$student} = $$classlist{$student};
6678: }
6679: if (ref($statushash) eq 'HASH') {
6680: $statushash->{$student}{'st'}{$section} = $status;
6681: }
1.288 raeburn 6682: }
1.275 raeburn 6683: }
6684: }
1.412 raeburn 6685: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 6686: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
6687: my $now = time;
1.609 raeburn 6688: my %displaystatus = ( previous => 'Expired',
6689: active => 'Active',
6690: future => 'Future',
6691: );
1.630 raeburn 6692: my %nothide;
6693: if ($hidepriv) {
6694: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
6695: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
6696: if ($user !~ /:/) {
6697: $nothide{join(':',split(/[\@]/,$user))}=1;
6698: } else {
6699: $nothide{$user} = 1;
6700: }
6701: }
6702: }
1.439 raeburn 6703: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 6704: my $match = 0;
1.412 raeburn 6705: my $secmatch = 0;
1.439 raeburn 6706: my $status;
1.412 raeburn 6707: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 6708: $user =~ s/:$//;
1.439 raeburn 6709: my ($end,$start) = split(/:/,$coursepersonnel{$person});
6710: if ($end == -1 || $start == -1) {
6711: next;
6712: }
6713: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
6714: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 6715: my ($uname,$udom) = split(/:/,$user);
6716: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 6717: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 6718: $secmatch = 1;
6719: } elsif ($usec eq '') {
1.420 albertel 6720: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 6721: $secmatch = 1;
6722: }
6723: } else {
6724: if (grep(/^\Q$usec\E$/,@{$sections})) {
6725: $secmatch = 1;
6726: }
6727: }
6728: if (!$secmatch) {
6729: next;
6730: }
1.288 raeburn 6731: }
1.419 raeburn 6732: if ($usec eq '') {
6733: $usec = 'none';
6734: }
1.275 raeburn 6735: if ($uname ne '' && $udom ne '') {
1.630 raeburn 6736: if ($hidepriv) {
6737: if ((&Apache::lonnet::privileged($uname,$udom)) &&
6738: (!$nothide{$uname.':'.$udom})) {
6739: next;
6740: }
6741: }
1.503 raeburn 6742: if ($end > 0 && $end < $now) {
1.439 raeburn 6743: $status = 'previous';
6744: } elsif ($start > $now) {
6745: $status = 'future';
6746: } else {
6747: $status = 'active';
6748: }
1.277 albertel 6749: foreach my $type (keys(%{$types})) {
1.275 raeburn 6750: if ($status eq $type) {
1.420 albertel 6751: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 6752: push(@{$$users{$role}{$user}},$type);
6753: }
1.288 raeburn 6754: $match = 1;
6755: }
6756: }
1.419 raeburn 6757: if (($match) && (ref($userdata) eq 'HASH')) {
6758: if (!exists($$userdata{$uname.':'.$udom})) {
6759: &get_user_info($udom,$uname,\%idx,$userdata);
6760: }
1.420 albertel 6761: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 6762: push(@{$seclists{$uname.':'.$udom}},$usec);
6763: }
1.609 raeburn 6764: if (ref($statushash) eq 'HASH') {
6765: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
6766: }
1.275 raeburn 6767: }
6768: }
6769: }
6770: }
1.290 albertel 6771: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 6772: if ((defined($cdom)) && (defined($cnum))) {
6773: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
6774: if ( defined($csettings{'internal.courseowner'}) ) {
6775: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 6776: next if ($owner eq '');
6777: my ($ownername,$ownerdom);
6778: if ($owner =~ /^([^:]+):([^:]+)$/) {
6779: $ownername = $1;
6780: $ownerdom = $2;
6781: } else {
6782: $ownername = $owner;
6783: $ownerdom = $cdom;
6784: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 6785: }
6786: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 6787: if (defined($userdata) &&
1.609 raeburn 6788: !exists($$userdata{$owner})) {
6789: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
6790: if (!grep(/^none$/,@{$seclists{$owner}})) {
6791: push(@{$seclists{$owner}},'none');
6792: }
6793: if (ref($statushash) eq 'HASH') {
6794: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 6795: }
1.290 albertel 6796: }
1.279 raeburn 6797: }
6798: }
6799: }
1.419 raeburn 6800: foreach my $user (keys(%seclists)) {
6801: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
6802: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
6803: }
1.275 raeburn 6804: }
6805: return;
6806: }
6807:
1.288 raeburn 6808: sub get_user_info {
6809: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 6810: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
6811: &plainname($uname,$udom,'lastname');
1.291 albertel 6812: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 6813: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 6814: my %idhash = &Apache::lonnet::idrget($udom,($uname));
6815: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 6816: return;
6817: }
1.275 raeburn 6818:
1.472 raeburn 6819: ###############################################
6820:
6821: =pod
6822:
6823: =item * &get_user_quota()
6824:
6825: Retrieves quota assigned for storage of portfolio files for a user
6826:
6827: Incoming parameters:
6828: 1. user's username
6829: 2. user's domain
6830:
6831: Returns:
1.536 raeburn 6832: 1. Disk quota (in Mb) assigned to student.
6833: 2. (Optional) Type of setting: custom or default
6834: (individually assigned or default for user's
6835: institutional status).
6836: 3. (Optional) - User's institutional status (e.g., faculty, staff
6837: or student - types as defined in localenroll::inst_usertypes
6838: for user's domain, which determines default quota for user.
6839: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 6840:
6841: If a value has been stored in the user's environment,
1.536 raeburn 6842: it will return that, otherwise it returns the maximal default
6843: defined for the user's instituional status(es) in the domain.
1.472 raeburn 6844:
6845: =cut
6846:
6847: ###############################################
6848:
6849:
6850: sub get_user_quota {
6851: my ($uname,$udom) = @_;
1.536 raeburn 6852: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 6853: if (!defined($udom)) {
6854: $udom = $env{'user.domain'};
6855: }
6856: if (!defined($uname)) {
6857: $uname = $env{'user.name'};
6858: }
6859: if (($udom eq '' || $uname eq '') ||
6860: ($udom eq 'public') && ($uname eq 'public')) {
6861: $quota = 0;
1.536 raeburn 6862: $quotatype = 'default';
6863: $defquota = 0;
1.472 raeburn 6864: } else {
1.536 raeburn 6865: my $inststatus;
1.472 raeburn 6866: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
6867: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 6868: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 6869: } else {
1.536 raeburn 6870: my %userenv =
6871: &Apache::lonnet::get('environment',['portfolioquota',
6872: 'inststatus'],$udom,$uname);
1.472 raeburn 6873: my ($tmp) = keys(%userenv);
6874: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
6875: $quota = $userenv{'portfolioquota'};
1.536 raeburn 6876: $inststatus = $userenv{'inststatus'};
1.472 raeburn 6877: } else {
6878: undef(%userenv);
6879: }
6880: }
1.536 raeburn 6881: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 6882: if ($quota eq '') {
1.536 raeburn 6883: $quota = $defquota;
6884: $quotatype = 'default';
6885: } else {
6886: $quotatype = 'custom';
1.472 raeburn 6887: }
6888: }
1.536 raeburn 6889: if (wantarray) {
6890: return ($quota,$quotatype,$settingstatus,$defquota);
6891: } else {
6892: return $quota;
6893: }
1.472 raeburn 6894: }
6895:
6896: ###############################################
6897:
6898: =pod
6899:
6900: =item * &default_quota()
6901:
1.536 raeburn 6902: Retrieves default quota assigned for storage of user portfolio files,
6903: given an (optional) user's institutional status.
1.472 raeburn 6904:
6905: Incoming parameters:
6906: 1. domain
1.536 raeburn 6907: 2. (Optional) institutional status(es). This is a : separated list of
6908: status types (e.g., faculty, staff, student etc.)
6909: which apply to the user for whom the default is being retrieved.
6910: If the institutional status string in undefined, the domain
6911: default quota will be returned.
1.472 raeburn 6912:
6913: Returns:
6914: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 6915: 2. (Optional) institutional type which determined the value of the
6916: default quota.
1.472 raeburn 6917:
6918: If a value has been stored in the domain's configuration db,
6919: it will return that, otherwise it returns 20 (for backwards
6920: compatibility with domains which have not set up a configuration
6921: db file; the original statically defined portfolio quota was 20 Mb).
6922:
1.536 raeburn 6923: If the user's status includes multiple types (e.g., staff and student),
6924: the largest default quota which applies to the user determines the
6925: default quota returned.
6926:
1.692.4.15 raeburn 6927: =back
6928:
1.472 raeburn 6929: =cut
6930:
6931: ###############################################
6932:
6933:
6934: sub default_quota {
1.536 raeburn 6935: my ($udom,$inststatus) = @_;
6936: my ($defquota,$settingstatus);
6937: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 6938: ['quotas'],$udom);
6939: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 6940: if ($inststatus ne '') {
1.692.4.2 raeburn 6941: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 6942: foreach my $item (@statuses) {
1.692.4.2 raeburn 6943: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6944: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
6945: if ($defquota eq '') {
6946: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6947: $settingstatus = $item;
6948: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
6949: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
6950: $settingstatus = $item;
6951: }
6952: }
6953: } else {
6954: if ($quotahash{'quotas'}{$item} ne '') {
6955: if ($defquota eq '') {
6956: $defquota = $quotahash{'quotas'}{$item};
6957: $settingstatus = $item;
6958: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
6959: $defquota = $quotahash{'quotas'}{$item};
6960: $settingstatus = $item;
6961: }
1.536 raeburn 6962: }
6963: }
6964: }
6965: }
6966: if ($defquota eq '') {
1.692.4.2 raeburn 6967: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
6968: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
6969: } else {
6970: $defquota = $quotahash{'quotas'}{'default'};
6971: }
1.536 raeburn 6972: $settingstatus = 'default';
6973: }
6974: } else {
6975: $settingstatus = 'default';
6976: $defquota = 20;
6977: }
6978: if (wantarray) {
6979: return ($defquota,$settingstatus);
1.472 raeburn 6980: } else {
1.536 raeburn 6981: return $defquota;
1.472 raeburn 6982: }
6983: }
6984:
1.384 raeburn 6985: sub get_secgrprole_info {
6986: my ($cdom,$cnum,$needroles,$type) = @_;
6987: my %sections_count = &get_sections($cdom,$cnum);
6988: my @sections = (sort {$a <=> $b} keys(%sections_count));
6989: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
6990: my @groups = sort(keys(%curr_groups));
6991: my $allroles = [];
6992: my $rolehash;
6993: my $accesshash = {
6994: active => 'Currently has access',
6995: future => 'Will have future access',
6996: previous => 'Previously had access',
6997: };
6998: if ($needroles) {
6999: $rolehash = {'all' => 'all'};
1.385 albertel 7000: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7001: if (&Apache::lonnet::error(%user_roles)) {
7002: undef(%user_roles);
7003: }
7004: foreach my $item (keys(%user_roles)) {
1.384 raeburn 7005: my ($role)=split(/\:/,$item,2);
7006: if ($role eq 'cr') { next; }
7007: if ($role =~ /^cr/) {
7008: $$rolehash{$role} = (split('/',$role))[3];
7009: } else {
7010: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
7011: }
7012: }
7013: foreach my $key (sort(keys(%{$rolehash}))) {
7014: push(@{$allroles},$key);
7015: }
7016: push (@{$allroles},'st');
7017: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
7018: }
7019: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
7020: }
7021:
1.555 raeburn 7022: sub user_picker {
1.627 raeburn 7023: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 7024: my $currdom = $dom;
7025: my %curr_selected = (
7026: srchin => 'dom',
1.580 raeburn 7027: srchby => 'lastname',
1.555 raeburn 7028: );
7029: my $srchterm;
1.625 raeburn 7030: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 7031: if ($srch->{'srchby'} ne '') {
7032: $curr_selected{'srchby'} = $srch->{'srchby'};
7033: }
7034: if ($srch->{'srchin'} ne '') {
7035: $curr_selected{'srchin'} = $srch->{'srchin'};
7036: }
7037: if ($srch->{'srchtype'} ne '') {
7038: $curr_selected{'srchtype'} = $srch->{'srchtype'};
7039: }
7040: if ($srch->{'srchdomain'} ne '') {
7041: $currdom = $srch->{'srchdomain'};
7042: }
7043: $srchterm = $srch->{'srchterm'};
7044: }
7045: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 7046: 'usr' => 'Search criteria',
1.563 raeburn 7047: 'doma' => 'Domain/institution to search',
1.558 albertel 7048: 'uname' => 'username',
7049: 'lastname' => 'last name',
1.555 raeburn 7050: 'lastfirst' => 'last name, first name',
1.558 albertel 7051: 'crs' => 'in this course',
1.576 raeburn 7052: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 7053: 'alc' => 'all LON-CAPA',
1.573 raeburn 7054: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 7055: 'exact' => 'is',
7056: 'contains' => 'contains',
1.569 raeburn 7057: 'begins' => 'begins with',
1.571 raeburn 7058: 'youm' => "You must include some text to search for.",
7059: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
7060: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
7061: 'yomc' => "You must choose a domain when using an institutional directory search.",
7062: 'ymcd' => "You must choose a domain when using a domain search.",
7063: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
7064: 'whse' => "When searching by last,first you must include at least one character in the first name.",
7065: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 7066: );
1.563 raeburn 7067: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
7068: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 7069:
7070: my @srchins = ('crs','dom','alc','instd');
7071:
7072: foreach my $option (@srchins) {
7073: # FIXME 'alc' option unavailable until
7074: # loncreateuser::print_user_query_page()
7075: # has been completed.
7076: next if ($option eq 'alc');
1.692.4.11 raeburn 7077: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 7078: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 7079: if ($curr_selected{'srchin'} eq $option) {
7080: $srchinsel .= '
7081: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7082: } else {
7083: $srchinsel .= '
7084: <option value="'.$option.'">'.$lt{$option}.'</option>';
7085: }
1.555 raeburn 7086: }
1.563 raeburn 7087: $srchinsel .= "\n </select>\n";
1.555 raeburn 7088:
7089: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 7090: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 7091: if ($curr_selected{'srchby'} eq $option) {
7092: $srchbysel .= '
7093: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7094: } else {
7095: $srchbysel .= '
7096: <option value="'.$option.'">'.$lt{$option}.'</option>';
7097: }
7098: }
7099: $srchbysel .= "\n </select>\n";
7100:
7101: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 7102: foreach my $option ('begins','contains','exact') {
1.555 raeburn 7103: if ($curr_selected{'srchtype'} eq $option) {
7104: $srchtypesel .= '
7105: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7106: } else {
7107: $srchtypesel .= '
7108: <option value="'.$option.'">'.$lt{$option}.'</option>';
7109: }
7110: }
7111: $srchtypesel .= "\n </select>\n";
7112:
1.558 albertel 7113: my ($newuserscript,$new_user_create);
1.556 raeburn 7114:
7115: if ($forcenewuser) {
1.576 raeburn 7116: if (ref($srch) eq 'HASH') {
7117: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 7118: if ($cancreate) {
7119: $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>';
7120: } else {
1.692.4.2 raeburn 7121: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 7122: my %usertypetext = (
7123: official => 'institutional',
7124: unofficial => 'non-institutional',
7125: );
1.692.4.2 raeburn 7126: $new_user_create = '<p class="LC_warning">'.
7127: &mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.
7128: &mt('Please contact the [_1]helpdesk[_2] for assistance.','<a href="'.$helplink.'">','</a>').'</p><br />';
1.627 raeburn 7129: }
1.576 raeburn 7130: }
7131: }
7132:
1.556 raeburn 7133: $newuserscript = <<"ENDSCRIPT";
7134:
1.570 raeburn 7135: function setSearch(createnew,callingForm) {
1.556 raeburn 7136: if (createnew == 1) {
1.570 raeburn 7137: for (var i=0; i<callingForm.srchby.length; i++) {
7138: if (callingForm.srchby.options[i].value == 'uname') {
7139: callingForm.srchby.selectedIndex = i;
1.556 raeburn 7140: }
7141: }
1.570 raeburn 7142: for (var i=0; i<callingForm.srchin.length; i++) {
7143: if ( callingForm.srchin.options[i].value == 'dom') {
7144: callingForm.srchin.selectedIndex = i;
1.556 raeburn 7145: }
7146: }
1.570 raeburn 7147: for (var i=0; i<callingForm.srchtype.length; i++) {
7148: if (callingForm.srchtype.options[i].value == 'exact') {
7149: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 7150: }
7151: }
1.570 raeburn 7152: for (var i=0; i<callingForm.srchdomain.length; i++) {
7153: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
7154: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 7155: }
7156: }
7157: }
7158: }
7159: ENDSCRIPT
1.558 albertel 7160:
1.556 raeburn 7161: }
7162:
1.555 raeburn 7163: my $output = <<"END_BLOCK";
1.556 raeburn 7164: <script type="text/javascript">
1.692.4.4 raeburn 7165: // <![CDATA[
1.570 raeburn 7166: function validateEntry(callingForm) {
1.558 albertel 7167:
1.556 raeburn 7168: var checkok = 1;
1.558 albertel 7169: var srchin;
1.570 raeburn 7170: for (var i=0; i<callingForm.srchin.length; i++) {
7171: if ( callingForm.srchin[i].checked ) {
7172: srchin = callingForm.srchin[i].value;
1.558 albertel 7173: }
7174: }
7175:
1.570 raeburn 7176: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
7177: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
7178: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
7179: var srchterm = callingForm.srchterm.value;
7180: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 7181: var msg = "";
7182:
7183: if (srchterm == "") {
7184: checkok = 0;
1.571 raeburn 7185: msg += "$lt{'youm'}\\n";
1.556 raeburn 7186: }
7187:
1.569 raeburn 7188: if (srchtype== 'begins') {
7189: if (srchterm.length < 2) {
7190: checkok = 0;
1.571 raeburn 7191: msg += "$lt{'thte'}\\n";
1.569 raeburn 7192: }
7193: }
7194:
1.556 raeburn 7195: if (srchtype== 'contains') {
7196: if (srchterm.length < 3) {
7197: checkok = 0;
1.571 raeburn 7198: msg += "$lt{'thet'}\\n";
1.556 raeburn 7199: }
7200: }
7201: if (srchin == 'instd') {
7202: if (srchdomain == '') {
7203: checkok = 0;
1.571 raeburn 7204: msg += "$lt{'yomc'}\\n";
1.556 raeburn 7205: }
7206: }
7207: if (srchin == 'dom') {
7208: if (srchdomain == '') {
7209: checkok = 0;
1.571 raeburn 7210: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 7211: }
7212: }
7213: if (srchby == 'lastfirst') {
7214: if (srchterm.indexOf(",") == -1) {
7215: checkok = 0;
1.571 raeburn 7216: msg += "$lt{'whus'}\\n";
1.556 raeburn 7217: }
7218: if (srchterm.indexOf(",") == srchterm.length -1) {
7219: checkok = 0;
1.571 raeburn 7220: msg += "$lt{'whse'}\\n";
1.556 raeburn 7221: }
7222: }
7223: if (checkok == 0) {
1.571 raeburn 7224: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 7225: return;
7226: }
7227: if (checkok == 1) {
1.570 raeburn 7228: callingForm.submit();
1.556 raeburn 7229: }
7230: }
7231:
7232: $newuserscript
7233:
1.692.4.4 raeburn 7234: // ]]>
1.556 raeburn 7235: </script>
1.558 albertel 7236:
7237: $new_user_create
7238:
1.555 raeburn 7239: END_BLOCK
1.558 albertel 7240:
1.692.4.9 raeburn 7241: $output .= &Apache::lonhtmlcommon::start_pick_box().
7242: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
7243: $domform.
7244: &Apache::lonhtmlcommon::row_closure().
7245: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
7246: $srchbysel.
7247: $srchtypesel.
7248: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
7249: $srchinsel.
7250: &Apache::lonhtmlcommon::row_closure(1).
7251: &Apache::lonhtmlcommon::end_pick_box().
7252: '<br />';
1.555 raeburn 7253: return $output;
7254: }
7255:
1.612 raeburn 7256: sub user_rule_check {
1.615 raeburn 7257: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 7258: my $response;
7259: if (ref($usershash) eq 'HASH') {
7260: foreach my $user (keys(%{$usershash})) {
7261: my ($uname,$udom) = split(/:/,$user);
7262: next if ($udom eq '' || $uname eq '');
1.615 raeburn 7263: my ($id,$newuser);
1.612 raeburn 7264: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 7265: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 7266: $id = $usershash->{$user}->{'id'};
7267: }
7268: my $inst_response;
7269: if (ref($checks) eq 'HASH') {
7270: if (defined($checks->{'username'})) {
1.615 raeburn 7271: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7272: &Apache::lonnet::get_instuser($udom,$uname);
7273: } elsif (defined($checks->{'id'})) {
1.615 raeburn 7274: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7275: &Apache::lonnet::get_instuser($udom,undef,$id);
7276: }
1.615 raeburn 7277: } else {
7278: ($inst_response,%{$inst_results->{$user}}) =
7279: &Apache::lonnet::get_instuser($udom,$uname);
7280: return;
1.612 raeburn 7281: }
1.615 raeburn 7282: if (!$got_rules->{$udom}) {
1.612 raeburn 7283: my %domconfig = &Apache::lonnet::get_dom('configuration',
7284: ['usercreation'],$udom);
7285: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 7286: foreach my $item ('username','id') {
1.612 raeburn 7287: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
7288: $$curr_rules{$udom}{$item} =
7289: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 7290: }
7291: }
7292: }
1.615 raeburn 7293: $got_rules->{$udom} = 1;
1.585 raeburn 7294: }
1.612 raeburn 7295: foreach my $item (keys(%{$checks})) {
7296: if (ref($$curr_rules{$udom}) eq 'HASH') {
7297: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
7298: if (@{$$curr_rules{$udom}{$item}} > 0) {
7299: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
7300: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
7301: if ($rule_check{$rule}) {
7302: $$rulematch{$user}{$item} = $rule;
7303: if ($inst_response eq 'ok') {
1.615 raeburn 7304: if (ref($inst_results) eq 'HASH') {
7305: if (ref($inst_results->{$user}) eq 'HASH') {
7306: if (keys(%{$inst_results->{$user}}) == 0) {
7307: $$alerts{$item}{$udom}{$uname} = 1;
7308: }
1.612 raeburn 7309: }
7310: }
1.615 raeburn 7311: }
7312: last;
1.585 raeburn 7313: }
7314: }
7315: }
7316: }
7317: }
7318: }
7319: }
7320: }
1.612 raeburn 7321: return;
7322: }
7323:
7324: sub user_rule_formats {
7325: my ($domain,$domdesc,$curr_rules,$check) = @_;
7326: my %text = (
7327: 'username' => 'Usernames',
7328: 'id' => 'IDs',
7329: );
7330: my $output;
7331: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
7332: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
7333: if (@{$ruleorder} > 0) {
7334: $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>';
7335: foreach my $rule (@{$ruleorder}) {
7336: if (ref($curr_rules) eq 'ARRAY') {
7337: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
7338: if (ref($rules->{$rule}) eq 'HASH') {
7339: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
7340: $rules->{$rule}{'desc'}.'</li>';
7341: }
7342: }
7343: }
7344: }
7345: $output .= '</ul>';
7346: }
7347: }
7348: return $output;
7349: }
7350:
7351: sub instrule_disallow_msg {
1.615 raeburn 7352: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 7353: my $response;
7354: my %text = (
7355: item => 'username',
7356: items => 'usernames',
7357: match => 'matches',
7358: do => 'does',
7359: action => 'a username',
7360: one => 'one',
7361: );
7362: if ($count > 1) {
7363: $text{'item'} = 'usernames';
7364: $text{'match'} ='match';
7365: $text{'do'} = 'do';
7366: $text{'action'} = 'usernames',
7367: $text{'one'} = 'ones';
7368: }
7369: if ($checkitem eq 'id') {
7370: $text{'items'} = 'IDs';
7371: $text{'item'} = 'ID';
7372: $text{'action'} = 'an ID';
1.615 raeburn 7373: if ($count > 1) {
7374: $text{'item'} = 'IDs';
7375: $text{'action'} = 'IDs';
7376: }
1.612 raeburn 7377: }
1.674 bisitz 7378: $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 7379: if ($mode eq 'upload') {
7380: if ($checkitem eq 'username') {
7381: $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'}.");
7382: } elsif ($checkitem eq 'id') {
1.674 bisitz 7383: $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 7384: }
1.669 raeburn 7385: } elsif ($mode eq 'selfcreate') {
7386: if ($checkitem eq 'id') {
7387: $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.");
7388: }
1.615 raeburn 7389: } else {
7390: if ($checkitem eq 'username') {
7391: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
7392: } elsif ($checkitem eq 'id') {
7393: $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.");
7394: }
1.612 raeburn 7395: }
7396: return $response;
1.585 raeburn 7397: }
7398:
1.624 raeburn 7399: sub personal_data_fieldtitles {
7400: my %fieldtitles = &Apache::lonlocal::texthash (
7401: id => 'Student/Employee ID',
7402: permanentemail => 'E-mail address',
7403: lastname => 'Last Name',
7404: firstname => 'First Name',
7405: middlename => 'Middle Name',
7406: generation => 'Generation',
7407: gen => 'Generation',
1.692.4.2 raeburn 7408: inststatus => 'Affiliation',
1.624 raeburn 7409: );
7410: return %fieldtitles;
7411: }
7412:
1.642 raeburn 7413: sub sorted_inst_types {
7414: my ($dom) = @_;
7415: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
7416: my $othertitle = &mt('All users');
7417: if ($env{'request.course.id'}) {
1.668 raeburn 7418: $othertitle = &mt('Any users');
1.642 raeburn 7419: }
7420: my @types;
7421: if (ref($order) eq 'ARRAY') {
7422: @types = @{$order};
7423: }
7424: if (@types == 0) {
7425: if (ref($usertypes) eq 'HASH') {
7426: @types = sort(keys(%{$usertypes}));
7427: }
7428: }
7429: if (keys(%{$usertypes}) > 0) {
7430: $othertitle = &mt('Other users');
7431: }
7432: return ($othertitle,$usertypes,\@types);
7433: }
7434:
1.645 raeburn 7435: sub get_institutional_codes {
7436: my ($settings,$allcourses,$LC_code) = @_;
7437: # Get complete list of course sections to update
7438: my @currsections = ();
7439: my @currxlists = ();
7440: my $coursecode = $$settings{'internal.coursecode'};
7441:
7442: if ($$settings{'internal.sectionnums'} ne '') {
7443: @currsections = split(/,/,$$settings{'internal.sectionnums'});
7444: }
7445:
7446: if ($$settings{'internal.crosslistings'} ne '') {
7447: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
7448: }
7449:
7450: if (@currxlists > 0) {
7451: foreach (@currxlists) {
7452: if (m/^([^:]+):(\w*)$/) {
7453: unless (grep/^$1$/,@{$allcourses}) {
7454: push @{$allcourses},$1;
7455: $$LC_code{$1} = $2;
7456: }
7457: }
7458: }
7459: }
7460:
7461: if (@currsections > 0) {
7462: foreach (@currsections) {
7463: if (m/^(\w+):(\w*)$/) {
7464: my $sec = $coursecode.$1;
7465: my $lc_sec = $2;
7466: unless (grep/^$sec$/,@{$allcourses}) {
7467: push @{$allcourses},$sec;
7468: $$LC_code{$sec} = $lc_sec;
7469: }
7470: }
7471: }
7472: }
7473: return;
7474: }
7475:
1.112 bowersj2 7476: =pod
7477:
1.692.4.2 raeburn 7478: =head1 Slot Helpers
7479:
7480: =over 4
7481:
7482: =item * sorted_slots()
7483:
7484: Sorts an array of slot names in order of slot start time (earliest first).
7485:
7486: Inputs:
7487:
7488: =over 4
7489:
7490: slotsarr - Reference to array of unsorted slot names.
7491:
7492: slots - Reference to hash of hash, where outer hash keys are slot names.
7493:
7494: =back
7495:
7496: Returns:
7497:
7498: =over 4
7499:
7500: sorted - An array of slot names sorted by the start time of the slot.
7501:
7502: =back
7503:
7504: =back
7505:
7506: =cut
7507:
7508:
7509: sub sorted_slots {
7510: my ($slotsarr,$slots) = @_;
7511: my @sorted;
7512: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
7513: @sorted =
7514: sort {
7515: if (ref($slots->{$a}) && ref($slots->{$b})) {
7516: return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
7517: }
7518: if (ref($slots->{$a})) { return -1;}
7519: if (ref($slots->{$b})) { return 1;}
7520: return 0;
7521: } @{$slotsarr};
7522: }
7523: return @sorted;
7524: }
7525:
7526: =pod
7527:
1.549 albertel 7528: =head1 HTTP Helpers
7529:
7530: =over 4
7531:
1.648 raeburn 7532: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 7533:
1.258 albertel 7534: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 7535: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 7536: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 7537:
7538: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
7539: $possible_names is an ref to an array of form element names. As an example:
7540: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 7541: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 7542:
7543: =cut
1.1 albertel 7544:
1.6 albertel 7545: sub get_unprocessed_cgi {
1.25 albertel 7546: my ($query,$possible_names)= @_;
1.26 matthew 7547: # $Apache::lonxml::debug=1;
1.356 albertel 7548: foreach my $pair (split(/&/,$query)) {
7549: my ($name, $value) = split(/=/,$pair);
1.369 www 7550: $name = &unescape($name);
1.25 albertel 7551: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
7552: $value =~ tr/+/ /;
7553: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 7554: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 7555: }
1.16 harris41 7556: }
1.6 albertel 7557: }
7558:
1.112 bowersj2 7559: =pod
7560:
1.648 raeburn 7561: =item * &cacheheader()
1.112 bowersj2 7562:
7563: returns cache-controlling header code
7564:
7565: =cut
7566:
1.7 albertel 7567: sub cacheheader {
1.258 albertel 7568: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 7569: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
7570: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 7571: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
7572: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 7573: return $output;
1.7 albertel 7574: }
7575:
1.112 bowersj2 7576: =pod
7577:
1.648 raeburn 7578: =item * &no_cache($r)
1.112 bowersj2 7579:
7580: specifies header code to not have cache
7581:
7582: =cut
7583:
1.9 albertel 7584: sub no_cache {
1.216 albertel 7585: my ($r) = @_;
7586: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 7587: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 7588: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
7589: $r->no_cache(1);
7590: $r->header_out("Expires" => $date);
7591: $r->header_out("Pragma" => "no-cache");
1.123 www 7592: }
7593:
7594: sub content_type {
1.181 albertel 7595: my ($r,$type,$charset) = @_;
1.299 foxr 7596: if ($r) {
7597: # Note that printout.pl calls this with undef for $r.
7598: &no_cache($r);
7599: }
1.258 albertel 7600: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 7601: unless ($charset) {
7602: $charset=&Apache::lonlocal::current_encoding;
7603: }
7604: if ($charset) { $type.='; charset='.$charset; }
7605: if ($r) {
7606: $r->content_type($type);
7607: } else {
7608: print("Content-type: $type\n\n");
7609: }
1.9 albertel 7610: }
1.25 albertel 7611:
1.112 bowersj2 7612: =pod
7613:
1.648 raeburn 7614: =item * &add_to_env($name,$value)
1.112 bowersj2 7615:
1.258 albertel 7616: adds $name to the %env hash with value
1.112 bowersj2 7617: $value, if $name already exists, the entry is converted to an array
7618: reference and $value is added to the array.
7619:
7620: =cut
7621:
1.25 albertel 7622: sub add_to_env {
7623: my ($name,$value)=@_;
1.258 albertel 7624: if (defined($env{$name})) {
7625: if (ref($env{$name})) {
1.25 albertel 7626: #already have multiple values
1.258 albertel 7627: push(@{ $env{$name} },$value);
1.25 albertel 7628: } else {
7629: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 7630: my $first=$env{$name};
7631: undef($env{$name});
7632: push(@{ $env{$name} },$first,$value);
1.25 albertel 7633: }
7634: } else {
1.258 albertel 7635: $env{$name}=$value;
1.25 albertel 7636: }
1.31 albertel 7637: }
1.149 albertel 7638:
7639: =pod
7640:
1.648 raeburn 7641: =item * &get_env_multiple($name)
1.149 albertel 7642:
1.258 albertel 7643: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 7644: values may be defined and end up as an array ref.
7645:
7646: returns an array of values
7647:
7648: =cut
7649:
7650: sub get_env_multiple {
7651: my ($name) = @_;
7652: my @values;
1.258 albertel 7653: if (defined($env{$name})) {
1.149 albertel 7654: # exists is it an array
1.258 albertel 7655: if (ref($env{$name})) {
7656: @values=@{ $env{$name} };
1.149 albertel 7657: } else {
1.258 albertel 7658: $values[0]=$env{$name};
1.149 albertel 7659: }
7660: }
7661: return(@values);
7662: }
7663:
1.660 raeburn 7664: sub ask_for_embedded_content {
7665: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
7666: my $upload_output = '
7667: <form name="upload_embedded" action="'.$actionurl.'"
7668: method="post" enctype="multipart/form-data">';
7669: $upload_output .= $state;
1.661 raeburn 7670: $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660 raeburn 7671:
7672: my $num = 0;
7673: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
7674: $upload_output .= &start_data_table_row().
7675: '<td>'.$embed_file.'</td><td>';
7676: if ($args->{'ignore_remote_references'}
7677: && $embed_file =~ m{^\w+://}) {
7678: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
7679: } elsif ($args->{'error_on_invalid_names'}
7680: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
7681:
7682: $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
7683:
7684: } else {
7685: $upload_output .='
1.661 raeburn 7686: <input name="embedded_item_'.$num.'" type="file" value="" />
1.660 raeburn 7687: <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
7688: my $attrib = join(':',@{$$allfiles{$embed_file}});
7689: $upload_output .=
7690: "\n\t\t".
7691: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
7692: $attrib.'" />';
7693: if (exists($$codebase{$embed_file})) {
7694: $upload_output .=
7695: "\n\t\t".
7696: '<input name="codebase_'.$num.'" type="hidden" value="'.
7697: &escape($$codebase{$embed_file}).'" />';
7698: }
7699: }
7700: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
7701: $num++;
7702: }
7703: $upload_output .= &Apache::loncommon::end_data_table().'<br />
7704: <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
7705: <input type ="submit" value="'.&mt('Upload Listed Files').'" />
7706: '.&mt('(only files for which a location has been provided will be uploaded)').'
7707: </form>';
7708: return $upload_output;
7709: }
7710:
1.661 raeburn 7711: sub upload_embedded {
7712: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
7713: $current_disk_usage) = @_;
7714: my $output;
7715: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
7716: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
7717: my $orig_uploaded_filename =
7718: $env{'form.embedded_item_'.$i.'.filename'};
7719:
7720: $env{'form.embedded_orig_'.$i} =
7721: &unescape($env{'form.embedded_orig_'.$i});
7722: my ($path,$fname) =
7723: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
7724: # no path, whole string is fname
7725: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
7726:
7727: $path = $env{'form.currentpath'}.$path;
7728: $fname = &Apache::lonnet::clean_filename($fname);
7729: # See if there is anything left
7730: next if ($fname eq '');
7731:
7732: # Check if file already exists as a file or directory.
7733: my ($state,$msg);
7734: if ($context eq 'portfolio') {
7735: my $port_path = $dirpath;
7736: if ($group ne '') {
7737: $port_path = "groups/$group/$port_path";
7738: }
7739: ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
7740: $dir_root,$port_path,$disk_quota,
7741: $current_disk_usage,$uname,$udom);
7742: if ($state eq 'will_exceed_quota'
7743: || $state eq 'file_locked'
7744: || $state eq 'file_exists' ) {
7745: $output .= $msg;
7746: next;
7747: }
7748: } elsif (($context eq 'author') || ($context eq 'testbank')) {
7749: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
7750: if ($state eq 'exists') {
7751: $output .= $msg;
7752: next;
7753: }
7754: }
7755: # Check if extension is valid
7756: if (($fname =~ /\.(\w+)$/) &&
7757: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
7758: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
7759: next;
7760: } elsif (($fname =~ /\.(\w+)$/) &&
7761: (!defined(&Apache::loncommon::fileembstyle($1)))) {
7762: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
7763: next;
7764: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
7765: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
7766: next;
7767: }
7768:
7769: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
7770: if ($context eq 'portfolio') {
7771: my $result=
7772: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
7773: $dirpath.$path);
7774: if ($result !~ m|^/uploaded/|) {
7775: $output .= '<span class="LC_error">'
7776: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
7777: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
7778: .'</span><br />';
7779: next;
7780: } else {
7781: $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
7782: $path.$fname.'</span>').'</p>';
7783: }
7784: } else {
7785: # Save the file
7786: my $target = $env{'form.embedded_item_'.$i};
7787: my $fullpath = $dir_root.$dirpath.'/'.$path;
7788: my $dest = $fullpath.$fname;
7789: my $url = $url_root.$dirpath.'/'.$path.$fname;
7790: my @parts=split(/\//,$fullpath);
7791: my $count;
7792: my $filepath = $dir_root;
7793: for ($count=4;$count<=$#parts;$count++) {
7794: $filepath .= "/$parts[$count]";
7795: if ((-e $filepath)!=1) {
7796: mkdir($filepath,0770);
7797: }
7798: }
7799: my $fh;
7800: if (!open($fh,'>'.$dest)) {
7801: &Apache::lonnet::logthis('Failed to create '.$dest);
7802: $output .= '<span class="LC_error">'.
7803: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7804: '</span><br />';
7805: } else {
7806: if (!print $fh $env{'form.embedded_item_'.$i}) {
7807: &Apache::lonnet::logthis('Failed to write to '.$dest);
7808: $output .= '<span class="LC_error">'.
7809: &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
7810: '</span><br />';
7811: } else {
7812: if ($context eq 'testbank') {
7813: $output .= &mt('Embedded file uploaded successfully:').
7814: ' <a href="'.$url.'">'.
7815: $orig_uploaded_filename.'</a><br />';
7816: } else {
7817: $output .= '<font size="+2">'.
7818: &mt('View embedded file: [_1]','<a href="'.$url.'">'.
7819: $orig_uploaded_filename.'</a>').'</font><br />';
7820: }
7821: }
7822: close($fh);
7823: }
7824: }
7825: }
7826: return $output;
7827: }
7828:
7829: sub check_for_existing {
7830: my ($path,$fname,$element) = @_;
7831: my ($state,$msg);
7832: if (-d $path.'/'.$fname) {
7833: $state = 'exists';
7834: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7835: } elsif (-e $path.'/'.$fname) {
7836: $state = 'exists';
7837: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
7838: }
7839: if ($state eq 'exists') {
7840: $msg = '<span class="LC_error">'.$msg.'</span><br />';
7841: }
7842: return ($state,$msg);
7843: }
7844:
7845: sub check_for_upload {
7846: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
7847: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
7848: my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
7849: my $getpropath = 1;
7850: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
7851: $getpropath);
7852: my $found_file = 0;
7853: my $locked_file = 0;
7854: foreach my $line (@dir_list) {
7855: my ($file_name)=split(/\&/,$line,2);
7856: if ($file_name eq $fname){
7857: $file_name = $path.$file_name;
7858: if ($group ne '') {
7859: $file_name = $group.$file_name;
7860: }
7861: $found_file = 1;
7862: if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
7863: $locked_file = 1;
7864: }
7865: }
7866: }
7867: if (($current_disk_usage + $filesize) > $disk_quota){
7868: my $msg = '<span class="LC_error">'.
7869: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
7870: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
7871: return ('will_exceed_quota',$msg);
7872: } elsif ($found_file) {
7873: if ($locked_file) {
7874: my $msg = '<span class="LC_error">';
7875: $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>');
7876: $msg .= '</span><br />';
7877: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
7878: return ('file_locked',$msg);
7879: } else {
7880: my $msg = '<span class="LC_error">';
7881: $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'});
7882: $msg .= '</span>';
7883: $msg .= '<br />';
7884: $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
7885: return ('file_exists',$msg);
7886: }
7887: }
7888: }
7889:
1.31 albertel 7890:
1.41 ng 7891: =pod
1.45 matthew 7892:
1.464 albertel 7893: =back
1.41 ng 7894:
1.112 bowersj2 7895: =head1 CSV Upload/Handling functions
1.38 albertel 7896:
1.41 ng 7897: =over 4
7898:
1.648 raeburn 7899: =item * &upfile_store($r)
1.41 ng 7900:
7901: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 7902: needs $env{'form.upfile'}
1.41 ng 7903: returns $datatoken to be put into hidden field
7904:
7905: =cut
1.31 albertel 7906:
7907: sub upfile_store {
7908: my $r=shift;
1.258 albertel 7909: $env{'form.upfile'}=~s/\r/\n/gs;
7910: $env{'form.upfile'}=~s/\f/\n/gs;
7911: $env{'form.upfile'}=~s/\n+/\n/gs;
7912: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 7913:
1.258 albertel 7914: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
7915: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 7916: {
1.158 raeburn 7917: my $datafile = $r->dir_config('lonDaemons').
7918: '/tmp/'.$datatoken.'.tmp';
7919: if ( open(my $fh,">$datafile") ) {
1.258 albertel 7920: print $fh $env{'form.upfile'};
1.158 raeburn 7921: close($fh);
7922: }
1.31 albertel 7923: }
7924: return $datatoken;
7925: }
7926:
1.56 matthew 7927: =pod
7928:
1.648 raeburn 7929: =item * &load_tmp_file($r)
1.41 ng 7930:
7931: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 7932: needs $env{'form.datatoken'},
7933: sets $env{'form.upfile'} to the contents of the file
1.41 ng 7934:
7935: =cut
1.31 albertel 7936:
7937: sub load_tmp_file {
7938: my $r=shift;
7939: my @studentdata=();
7940: {
1.158 raeburn 7941: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 7942: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 7943: if ( open(my $fh,"<$studentfile") ) {
7944: @studentdata=<$fh>;
7945: close($fh);
7946: }
1.31 albertel 7947: }
1.258 albertel 7948: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 7949: }
7950:
1.56 matthew 7951: =pod
7952:
1.648 raeburn 7953: =item * &upfile_record_sep()
1.41 ng 7954:
7955: Separate uploaded file into records
7956: returns array of records,
1.258 albertel 7957: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 7958:
7959: =cut
1.31 albertel 7960:
7961: sub upfile_record_sep {
1.258 albertel 7962: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 7963: } else {
1.248 albertel 7964: my @records;
1.258 albertel 7965: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 7966: if ($line=~/^\s*$/) { next; }
7967: push(@records,$line);
7968: }
7969: return @records;
1.31 albertel 7970: }
7971: }
7972:
1.56 matthew 7973: =pod
7974:
1.648 raeburn 7975: =item * &record_sep($record)
1.41 ng 7976:
1.258 albertel 7977: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 7978:
7979: =cut
7980:
1.263 www 7981: sub takeleft {
7982: my $index=shift;
7983: return substr('0000'.$index,-4,4);
7984: }
7985:
1.31 albertel 7986: sub record_sep {
7987: my $record=shift;
7988: my %components=();
1.258 albertel 7989: if ($env{'form.upfiletype'} eq 'xml') {
7990: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 7991: my $i=0;
1.356 albertel 7992: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 7993: $field=~s/^(\"|\')//;
7994: $field=~s/(\"|\')$//;
1.263 www 7995: $components{&takeleft($i)}=$field;
1.31 albertel 7996: $i++;
7997: }
1.258 albertel 7998: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 7999: my $i=0;
1.356 albertel 8000: foreach my $field (split(/\t/,$record)) {
1.31 albertel 8001: $field=~s/^(\"|\')//;
8002: $field=~s/(\"|\')$//;
1.263 www 8003: $components{&takeleft($i)}=$field;
1.31 albertel 8004: $i++;
8005: }
8006: } else {
1.561 www 8007: my $separator=',';
1.480 banghart 8008: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 8009: $separator=';';
1.480 banghart 8010: }
1.31 albertel 8011: my $i=0;
1.561 www 8012: # the character we are looking for to indicate the end of a quote or a record
8013: my $looking_for=$separator;
8014: # do not add the characters to the fields
8015: my $ignore=0;
8016: # we just encountered a separator (or the beginning of the record)
8017: my $just_found_separator=1;
8018: # store the field we are working on here
8019: my $field='';
8020: # work our way through all characters in record
8021: foreach my $character ($record=~/(.)/g) {
8022: if ($character eq $looking_for) {
8023: if ($character ne $separator) {
8024: # Found the end of a quote, again looking for separator
8025: $looking_for=$separator;
8026: $ignore=1;
8027: } else {
8028: # Found a separator, store away what we got
8029: $components{&takeleft($i)}=$field;
8030: $i++;
8031: $just_found_separator=1;
8032: $ignore=0;
8033: $field='';
8034: }
8035: next;
8036: }
8037: # single or double quotation marks after a separator indicate beginning of a quote
8038: # we are now looking for the end of the quote and need to ignore separators
8039: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
8040: $looking_for=$character;
8041: next;
8042: }
8043: # ignore would be true after we reached the end of a quote
8044: if ($ignore) { next; }
8045: if (($just_found_separator) && ($character=~/\s/)) { next; }
8046: $field.=$character;
8047: $just_found_separator=0;
1.31 albertel 8048: }
1.561 www 8049: # catch the very last entry, since we never encountered the separator
8050: $components{&takeleft($i)}=$field;
1.31 albertel 8051: }
8052: return %components;
8053: }
8054:
1.144 matthew 8055: ######################################################
8056: ######################################################
8057:
1.56 matthew 8058: =pod
8059:
1.648 raeburn 8060: =item * &upfile_select_html()
1.41 ng 8061:
1.144 matthew 8062: Return HTML code to select a file from the users machine and specify
8063: the file type.
1.41 ng 8064:
8065: =cut
8066:
1.144 matthew 8067: ######################################################
8068: ######################################################
1.31 albertel 8069: sub upfile_select_html {
1.144 matthew 8070: my %Types = (
8071: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 8072: semisv => &mt('Semicolon separated values'),
1.144 matthew 8073: space => &mt('Space separated'),
8074: tab => &mt('Tabulator separated'),
8075: # xml => &mt('HTML/XML'),
8076: );
8077: my $Str = '<input type="file" name="upfile" size="50" />'.
1.692.4.2 raeburn 8078: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 8079: foreach my $type (sort(keys(%Types))) {
8080: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
8081: }
8082: $Str .= "</select>\n";
8083: return $Str;
1.31 albertel 8084: }
8085:
1.301 albertel 8086: sub get_samples {
8087: my ($records,$toget) = @_;
8088: my @samples=({});
8089: my $got=0;
8090: foreach my $rec (@$records) {
8091: my %temp = &record_sep($rec);
8092: if (! grep(/\S/, values(%temp))) { next; }
8093: if (%temp) {
8094: $samples[$got]=\%temp;
8095: $got++;
8096: if ($got == $toget) { last; }
8097: }
8098: }
8099: return \@samples;
8100: }
8101:
1.144 matthew 8102: ######################################################
8103: ######################################################
8104:
1.56 matthew 8105: =pod
8106:
1.648 raeburn 8107: =item * &csv_print_samples($r,$records)
1.41 ng 8108:
8109: Prints a table of sample values from each column uploaded $r is an
8110: Apache Request ref, $records is an arrayref from
8111: &Apache::loncommon::upfile_record_sep
8112:
8113: =cut
8114:
1.144 matthew 8115: ######################################################
8116: ######################################################
1.31 albertel 8117: sub csv_print_samples {
8118: my ($r,$records) = @_;
1.662 bisitz 8119: my $samples = &get_samples($records,5);
1.301 albertel 8120:
1.594 raeburn 8121: $r->print(&mt('Samples').'<br />'.&start_data_table().
8122: &start_data_table_header_row());
1.356 albertel 8123: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.692.4.6 raeburn 8124: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>');
8125: }
1.594 raeburn 8126: $r->print(&end_data_table_header_row());
1.301 albertel 8127: foreach my $hash (@$samples) {
1.594 raeburn 8128: $r->print(&start_data_table_row());
1.356 albertel 8129: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 8130: $r->print('<td>');
1.356 albertel 8131: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 8132: $r->print('</td>');
8133: }
1.594 raeburn 8134: $r->print(&end_data_table_row());
1.31 albertel 8135: }
1.594 raeburn 8136: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 8137: }
8138:
1.144 matthew 8139: ######################################################
8140: ######################################################
8141:
1.56 matthew 8142: =pod
8143:
1.648 raeburn 8144: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 8145:
8146: Prints a table to create associations between values and table columns.
1.144 matthew 8147:
1.41 ng 8148: $r is an Apache Request ref,
8149: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 8150: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 8151:
8152: =cut
8153:
1.144 matthew 8154: ######################################################
8155: ######################################################
1.31 albertel 8156: sub csv_print_select_table {
8157: my ($r,$records,$d) = @_;
1.301 albertel 8158: my $i=0;
8159: my $samples = &get_samples($records,1);
1.144 matthew 8160: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 8161: &start_data_table().&start_data_table_header_row().
1.144 matthew 8162: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 8163: '<th>'.&mt('Column').'</th>'.
8164: &end_data_table_header_row()."\n");
1.356 albertel 8165: foreach my $array_ref (@$d) {
8166: my ($value,$display,$defaultcol)=@{ $array_ref };
1.689 bisitz 8167: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 8168:
1.692.4.8 raeburn 8169: $r->print('<td><select name"f'.$i.'"'.
1.32 matthew 8170: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 8171: $r->print('<option value="none"></option>');
1.356 albertel 8172: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
8173: $r->print('<option value="'.$sample.'"'.
8174: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 8175: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 8176: }
1.594 raeburn 8177: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 8178: $i++;
8179: }
1.594 raeburn 8180: $r->print(&end_data_table());
1.31 albertel 8181: $i--;
8182: return $i;
8183: }
1.56 matthew 8184:
1.144 matthew 8185: ######################################################
8186: ######################################################
8187:
1.56 matthew 8188: =pod
1.31 albertel 8189:
1.648 raeburn 8190: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 8191:
8192: Prints a table of sample values from the upload and can make associate samples to internal names.
8193:
8194: $r is an Apache Request ref,
8195: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
8196: $d is an array of 2 element arrays (internal name, displayed name)
8197:
8198: =cut
8199:
1.144 matthew 8200: ######################################################
8201: ######################################################
1.31 albertel 8202: sub csv_samples_select_table {
8203: my ($r,$records,$d) = @_;
8204: my $i=0;
1.144 matthew 8205: #
1.662 bisitz 8206: my $max_samples = 5;
8207: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 8208: $r->print(&start_data_table().
8209: &start_data_table_header_row().'<th>'.
8210: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
8211: &end_data_table_header_row());
1.301 albertel 8212:
8213: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 8214: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 8215: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 8216: foreach my $option (@$d) {
8217: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 8218: $r->print('<option value="'.$value.'"'.
1.253 albertel 8219: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 8220: $display.'</option>');
1.31 albertel 8221: }
8222: $r->print('</select></td><td>');
1.662 bisitz 8223: foreach my $line (0..($max_samples-1)) {
1.301 albertel 8224: if (defined($samples->[$line]{$key})) {
8225: $r->print($samples->[$line]{$key}."<br />\n");
8226: }
8227: }
1.594 raeburn 8228: $r->print('</td>'.&end_data_table_row());
1.31 albertel 8229: $i++;
8230: }
1.594 raeburn 8231: $r->print(&end_data_table());
1.31 albertel 8232: $i--;
8233: return($i);
1.115 matthew 8234: }
8235:
1.144 matthew 8236: ######################################################
8237: ######################################################
8238:
1.115 matthew 8239: =pod
8240:
1.648 raeburn 8241: =item * &clean_excel_name($name)
1.115 matthew 8242:
8243: Returns a replacement for $name which does not contain any illegal characters.
8244:
8245: =cut
8246:
1.144 matthew 8247: ######################################################
8248: ######################################################
1.115 matthew 8249: sub clean_excel_name {
8250: my ($name) = @_;
8251: $name =~ s/[:\*\?\/\\]//g;
8252: if (length($name) > 31) {
8253: $name = substr($name,0,31);
8254: }
8255: return $name;
1.25 albertel 8256: }
1.84 albertel 8257:
1.85 albertel 8258: =pod
8259:
1.648 raeburn 8260: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 8261:
8262: Returns either 1 or undef
8263:
8264: 1 if the part is to be hidden, undef if it is to be shown
8265:
8266: Arguments are:
8267:
8268: $id the id of the part to be checked
8269: $symb, optional the symb of the resource to check
8270: $udom, optional the domain of the user to check for
8271: $uname, optional the username of the user to check for
8272:
8273: =cut
1.84 albertel 8274:
8275: sub check_if_partid_hidden {
8276: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 8277: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 8278: $symb,$udom,$uname);
1.141 albertel 8279: my $truth=1;
8280: #if the string starts with !, then the list is the list to show not hide
8281: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 8282: my @hiddenlist=split(/,/,$hiddenparts);
8283: foreach my $checkid (@hiddenlist) {
1.141 albertel 8284: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 8285: }
1.141 albertel 8286: return !$truth;
1.84 albertel 8287: }
1.127 matthew 8288:
1.138 matthew 8289:
8290: ############################################################
8291: ############################################################
8292:
8293: =pod
8294:
1.157 matthew 8295: =back
8296:
1.138 matthew 8297: =head1 cgi-bin script and graphing routines
8298:
1.157 matthew 8299: =over 4
8300:
1.648 raeburn 8301: =item * &get_cgi_id()
1.138 matthew 8302:
8303: Inputs: none
8304:
8305: Returns an id which can be used to pass environment variables
8306: to various cgi-bin scripts. These environment variables will
8307: be removed from the users environment after a given time by
8308: the routine &Apache::lonnet::transfer_profile_to_env.
8309:
8310: =cut
8311:
8312: ############################################################
8313: ############################################################
1.152 albertel 8314: my $uniq=0;
1.136 matthew 8315: sub get_cgi_id {
1.154 albertel 8316: $uniq=($uniq+1)%100000;
1.280 albertel 8317: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 8318: }
8319:
1.127 matthew 8320: ############################################################
8321: ############################################################
8322:
8323: =pod
8324:
1.648 raeburn 8325: =item * &DrawBarGraph()
1.127 matthew 8326:
1.138 matthew 8327: Facilitates the plotting of data in a (stacked) bar graph.
8328: Puts plot definition data into the users environment in order for
8329: graph.png to plot it. Returns an <img> tag for the plot.
8330: The bars on the plot are labeled '1','2',...,'n'.
8331:
8332: Inputs:
8333:
8334: =over 4
8335:
8336: =item $Title: string, the title of the plot
8337:
8338: =item $xlabel: string, text describing the X-axis of the plot
8339:
8340: =item $ylabel: string, text describing the Y-axis of the plot
8341:
8342: =item $Max: scalar, the maximum Y value to use in the plot
8343: If $Max is < any data point, the graph will not be rendered.
8344:
1.140 matthew 8345: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 8346: they are plotted. If undefined, default values will be used.
8347:
1.178 matthew 8348: =item $labels: array ref holding the labels to use on the x-axis for the bars.
8349:
1.138 matthew 8350: =item @Values: An array of array references. Each array reference holds data
8351: to be plotted in a stacked bar chart.
8352:
1.239 matthew 8353: =item If the final element of @Values is a hash reference the key/value
8354: pairs will be added to the graph definition.
8355:
1.138 matthew 8356: =back
8357:
8358: Returns:
8359:
8360: An <img> tag which references graph.png and the appropriate identifying
8361: information for the plot.
8362:
1.127 matthew 8363: =cut
8364:
8365: ############################################################
8366: ############################################################
1.134 matthew 8367: sub DrawBarGraph {
1.178 matthew 8368: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 8369: #
8370: if (! defined($colors)) {
8371: $colors = ['#33ff00',
8372: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
8373: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
8374: ];
8375: }
1.228 matthew 8376: my $extra_settings = {};
8377: if (ref($Values[-1]) eq 'HASH') {
8378: $extra_settings = pop(@Values);
8379: }
1.127 matthew 8380: #
1.136 matthew 8381: my $identifier = &get_cgi_id();
8382: my $id = 'cgi.'.$identifier;
1.129 matthew 8383: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 8384: return '';
8385: }
1.225 matthew 8386: #
8387: my @Labels;
8388: if (defined($labels)) {
8389: @Labels = @$labels;
8390: } else {
8391: for (my $i=0;$i<@{$Values[0]};$i++) {
8392: push (@Labels,$i+1);
8393: }
8394: }
8395: #
1.129 matthew 8396: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 8397: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 8398: my %ValuesHash;
8399: my $NumSets=1;
8400: foreach my $array (@Values) {
8401: next if (! ref($array));
1.136 matthew 8402: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 8403: join(',',@$array);
1.129 matthew 8404: }
1.127 matthew 8405: #
1.136 matthew 8406: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 8407: if ($NumBars < 3) {
8408: $width = 120+$NumBars*32;
1.220 matthew 8409: $xskip = 1;
1.225 matthew 8410: $bar_width = 30;
8411: } elsif ($NumBars < 5) {
8412: $width = 120+$NumBars*20;
8413: $xskip = 1;
8414: $bar_width = 20;
1.220 matthew 8415: } elsif ($NumBars < 10) {
1.136 matthew 8416: $width = 120+$NumBars*15;
8417: $xskip = 1;
8418: $bar_width = 15;
8419: } elsif ($NumBars <= 25) {
8420: $width = 120+$NumBars*11;
8421: $xskip = 5;
8422: $bar_width = 8;
8423: } elsif ($NumBars <= 50) {
8424: $width = 120+$NumBars*8;
8425: $xskip = 5;
8426: $bar_width = 4;
8427: } else {
8428: $width = 120+$NumBars*8;
8429: $xskip = 5;
8430: $bar_width = 4;
8431: }
8432: #
1.137 matthew 8433: $Max = 1 if ($Max < 1);
8434: if ( int($Max) < $Max ) {
8435: $Max++;
8436: $Max = int($Max);
8437: }
1.127 matthew 8438: $Title = '' if (! defined($Title));
8439: $xlabel = '' if (! defined($xlabel));
8440: $ylabel = '' if (! defined($ylabel));
1.369 www 8441: $ValuesHash{$id.'.title'} = &escape($Title);
8442: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
8443: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 8444: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 8445: $ValuesHash{$id.'.NumBars'} = $NumBars;
8446: $ValuesHash{$id.'.NumSets'} = $NumSets;
8447: $ValuesHash{$id.'.PlotType'} = 'bar';
8448: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8449: $ValuesHash{$id.'.height'} = $height;
8450: $ValuesHash{$id.'.width'} = $width;
8451: $ValuesHash{$id.'.xskip'} = $xskip;
8452: $ValuesHash{$id.'.bar_width'} = $bar_width;
8453: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 8454: #
1.228 matthew 8455: # Deal with other parameters
8456: while (my ($key,$value) = each(%$extra_settings)) {
8457: $ValuesHash{$id.'.'.$key} = $value;
8458: }
8459: #
1.646 raeburn 8460: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 8461: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8462: }
8463:
8464: ############################################################
8465: ############################################################
8466:
8467: =pod
8468:
1.648 raeburn 8469: =item * &DrawXYGraph()
1.137 matthew 8470:
1.138 matthew 8471: Facilitates the plotting of data in an XY graph.
8472: Puts plot definition data into the users environment in order for
8473: graph.png to plot it. Returns an <img> tag for the plot.
8474:
8475: Inputs:
8476:
8477: =over 4
8478:
8479: =item $Title: string, the title of the plot
8480:
8481: =item $xlabel: string, text describing the X-axis of the plot
8482:
8483: =item $ylabel: string, text describing the Y-axis of the plot
8484:
8485: =item $Max: scalar, the maximum Y value to use in the plot
8486: If $Max is < any data point, the graph will not be rendered.
8487:
8488: =item $colors: Array ref containing the hex color codes for the data to be
8489: plotted in. If undefined, default values will be used.
8490:
8491: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8492:
8493: =item $Ydata: Array ref containing Array refs.
1.185 www 8494: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 8495:
8496: =item %Values: hash indicating or overriding any default values which are
8497: passed to graph.png.
8498: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8499:
8500: =back
8501:
8502: Returns:
8503:
8504: An <img> tag which references graph.png and the appropriate identifying
8505: information for the plot.
8506:
1.137 matthew 8507: =cut
8508:
8509: ############################################################
8510: ############################################################
8511: sub DrawXYGraph {
8512: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
8513: #
8514: # Create the identifier for the graph
8515: my $identifier = &get_cgi_id();
8516: my $id = 'cgi.'.$identifier;
8517: #
8518: $Title = '' if (! defined($Title));
8519: $xlabel = '' if (! defined($xlabel));
8520: $ylabel = '' if (! defined($ylabel));
8521: my %ValuesHash =
8522: (
1.369 www 8523: $id.'.title' => &escape($Title),
8524: $id.'.xlabel' => &escape($xlabel),
8525: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 8526: $id.'.y_max_value'=> $Max,
8527: $id.'.labels' => join(',',@$Xlabels),
8528: $id.'.PlotType' => 'XY',
8529: );
8530: #
8531: if (defined($colors) && ref($colors) eq 'ARRAY') {
8532: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8533: }
8534: #
8535: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
8536: return '';
8537: }
8538: my $NumSets=1;
1.138 matthew 8539: foreach my $array (@{$Ydata}){
1.137 matthew 8540: next if (! ref($array));
8541: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
8542: }
1.138 matthew 8543: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 8544: #
8545: # Deal with other parameters
8546: while (my ($key,$value) = each(%Values)) {
8547: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 8548: }
8549: #
1.646 raeburn 8550: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 8551: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8552: }
8553:
8554: ############################################################
8555: ############################################################
8556:
8557: =pod
8558:
1.648 raeburn 8559: =item * &DrawXYYGraph()
1.138 matthew 8560:
8561: Facilitates the plotting of data in an XY graph with two Y axes.
8562: Puts plot definition data into the users environment in order for
8563: graph.png to plot it. Returns an <img> tag for the plot.
8564:
8565: Inputs:
8566:
8567: =over 4
8568:
8569: =item $Title: string, the title of the plot
8570:
8571: =item $xlabel: string, text describing the X-axis of the plot
8572:
8573: =item $ylabel: string, text describing the Y-axis of the plot
8574:
8575: =item $colors: Array ref containing the hex color codes for the data to be
8576: plotted in. If undefined, default values will be used.
8577:
8578: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8579:
8580: =item $Ydata1: The first data set
8581:
8582: =item $Min1: The minimum value of the left Y-axis
8583:
8584: =item $Max1: The maximum value of the left Y-axis
8585:
8586: =item $Ydata2: The second data set
8587:
8588: =item $Min2: The minimum value of the right Y-axis
8589:
8590: =item $Max2: The maximum value of the left Y-axis
8591:
8592: =item %Values: hash indicating or overriding any default values which are
8593: passed to graph.png.
8594: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8595:
8596: =back
8597:
8598: Returns:
8599:
8600: An <img> tag which references graph.png and the appropriate identifying
8601: information for the plot.
1.136 matthew 8602:
8603: =cut
8604:
8605: ############################################################
8606: ############################################################
1.137 matthew 8607: sub DrawXYYGraph {
8608: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
8609: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 8610: #
8611: # Create the identifier for the graph
8612: my $identifier = &get_cgi_id();
8613: my $id = 'cgi.'.$identifier;
8614: #
8615: $Title = '' if (! defined($Title));
8616: $xlabel = '' if (! defined($xlabel));
8617: $ylabel = '' if (! defined($ylabel));
8618: my %ValuesHash =
8619: (
1.369 www 8620: $id.'.title' => &escape($Title),
8621: $id.'.xlabel' => &escape($xlabel),
8622: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 8623: $id.'.labels' => join(',',@$Xlabels),
8624: $id.'.PlotType' => 'XY',
8625: $id.'.NumSets' => 2,
1.137 matthew 8626: $id.'.two_axes' => 1,
8627: $id.'.y1_max_value' => $Max1,
8628: $id.'.y1_min_value' => $Min1,
8629: $id.'.y2_max_value' => $Max2,
8630: $id.'.y2_min_value' => $Min2,
1.136 matthew 8631: );
8632: #
1.137 matthew 8633: if (defined($colors) && ref($colors) eq 'ARRAY') {
8634: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8635: }
8636: #
8637: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
8638: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 8639: return '';
8640: }
8641: my $NumSets=1;
1.137 matthew 8642: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 8643: next if (! ref($array));
8644: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 8645: }
8646: #
8647: # Deal with other parameters
8648: while (my ($key,$value) = each(%Values)) {
8649: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 8650: }
8651: #
1.646 raeburn 8652: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 8653: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 8654: }
8655:
8656: ############################################################
8657: ############################################################
8658:
8659: =pod
8660:
1.157 matthew 8661: =back
8662:
1.139 matthew 8663: =head1 Statistics helper routines?
8664:
8665: Bad place for them but what the hell.
8666:
1.157 matthew 8667: =over 4
8668:
1.648 raeburn 8669: =item * &chartlink()
1.139 matthew 8670:
8671: Returns a link to the chart for a specific student.
8672:
8673: Inputs:
8674:
8675: =over 4
8676:
8677: =item $linktext: The text of the link
8678:
8679: =item $sname: The students username
8680:
8681: =item $sdomain: The students domain
8682:
8683: =back
8684:
1.157 matthew 8685: =back
8686:
1.139 matthew 8687: =cut
8688:
8689: ############################################################
8690: ############################################################
8691: sub chartlink {
8692: my ($linktext, $sname, $sdomain) = @_;
8693: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 8694: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 8695: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 8696: '">'.$linktext.'</a>';
1.153 matthew 8697: }
8698:
8699: #######################################################
8700: #######################################################
8701:
8702: =pod
8703:
8704: =head1 Course Environment Routines
1.157 matthew 8705:
8706: =over 4
1.153 matthew 8707:
1.648 raeburn 8708: =item * &restore_course_settings()
1.153 matthew 8709:
1.648 raeburn 8710: =item * &store_course_settings()
1.153 matthew 8711:
8712: Restores/Store indicated form parameters from the course environment.
8713: Will not overwrite existing values of the form parameters.
8714:
8715: Inputs:
8716: a scalar describing the data (e.g. 'chart', 'problem_analysis')
8717:
8718: a hash ref describing the data to be stored. For example:
8719:
8720: %Save_Parameters = ('Status' => 'scalar',
8721: 'chartoutputmode' => 'scalar',
8722: 'chartoutputdata' => 'scalar',
8723: 'Section' => 'array',
1.373 raeburn 8724: 'Group' => 'array',
1.153 matthew 8725: 'StudentData' => 'array',
8726: 'Maps' => 'array');
8727:
8728: Returns: both routines return nothing
8729:
1.631 raeburn 8730: =back
8731:
1.153 matthew 8732: =cut
8733:
8734: #######################################################
8735: #######################################################
8736: sub store_course_settings {
1.496 albertel 8737: return &store_settings($env{'request.course.id'},@_);
8738: }
8739:
8740: sub store_settings {
1.153 matthew 8741: # save to the environment
8742: # appenv the same items, just to be safe
1.300 albertel 8743: my $udom = $env{'user.domain'};
8744: my $uname = $env{'user.name'};
1.496 albertel 8745: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8746: my %SaveHash;
8747: my %AppHash;
8748: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 8749: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 8750: my $envname = 'environment.'.$basename;
1.258 albertel 8751: if (exists($env{'form.'.$setting})) {
1.153 matthew 8752: # Save this value away
8753: if ($type eq 'scalar' &&
1.258 albertel 8754: (! exists($env{$envname}) ||
8755: $env{$envname} ne $env{'form.'.$setting})) {
8756: $SaveHash{$basename} = $env{'form.'.$setting};
8757: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 8758: } elsif ($type eq 'array') {
8759: my $stored_form;
1.258 albertel 8760: if (ref($env{'form.'.$setting})) {
1.153 matthew 8761: $stored_form = join(',',
8762: map {
1.369 www 8763: &escape($_);
1.258 albertel 8764: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 8765: } else {
8766: $stored_form =
1.369 www 8767: &escape($env{'form.'.$setting});
1.153 matthew 8768: }
8769: # Determine if the array contents are the same.
1.258 albertel 8770: if ($stored_form ne $env{$envname}) {
1.153 matthew 8771: $SaveHash{$basename} = $stored_form;
8772: $AppHash{$envname} = $stored_form;
8773: }
8774: }
8775: }
8776: }
8777: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 8778: $udom,$uname);
1.153 matthew 8779: if ($put_result !~ /^(ok|delayed)/) {
8780: &Apache::lonnet::logthis('unable to save form parameters, '.
8781: 'got error:'.$put_result);
8782: }
8783: # Make sure these settings stick around in this session, too
1.646 raeburn 8784: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 8785: return;
8786: }
8787:
8788: sub restore_course_settings {
1.499 albertel 8789: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 8790: }
8791:
8792: sub restore_settings {
8793: my ($context,$prefix,$Settings) = @_;
1.153 matthew 8794: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 8795: next if (exists($env{'form.'.$setting}));
1.496 albertel 8796: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 8797: '.'.$setting;
1.258 albertel 8798: if (exists($env{$envname})) {
1.153 matthew 8799: if ($type eq 'scalar') {
1.258 albertel 8800: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 8801: } elsif ($type eq 'array') {
1.258 albertel 8802: $env{'form.'.$setting} = [
1.153 matthew 8803: map {
1.369 www 8804: &unescape($_);
1.258 albertel 8805: } split(',',$env{$envname})
1.153 matthew 8806: ];
8807: }
8808: }
8809: }
1.127 matthew 8810: }
8811:
1.618 raeburn 8812: #######################################################
8813: #######################################################
8814:
8815: =pod
8816:
8817: =head1 Domain E-mail Routines
8818:
8819: =over 4
8820:
1.648 raeburn 8821: =item * &build_recipient_list()
1.618 raeburn 8822:
1.692.4.14 raeburn 8823: Build recipient lists for five types of e-mail:
1.692.4.2 raeburn 8824: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.692.4.14 raeburn 8825: (d) Help requests, (e) Course requests needing approval, generated by
8826: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
8827: loncoursequeueadmin.pm respectively.
1.618 raeburn 8828:
8829: Inputs:
1.619 raeburn 8830: defmail (scalar - email address of default recipient),
1.618 raeburn 8831: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 8832: defdom (domain for which to retrieve configuration settings),
8833: origmail (scalar - email address of recipient from loncapa.conf,
8834: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 8835:
1.655 raeburn 8836: Returns: comma separated list of addresses to which to send e-mail.
8837:
8838: =back
1.618 raeburn 8839:
8840: =cut
8841:
8842: ############################################################
8843: ############################################################
8844: sub build_recipient_list {
1.619 raeburn 8845: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 8846: my @recipients;
8847: my $otheremails;
8848: my %domconfig =
8849: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
8850: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.692.4.2 raeburn 8851: if (exists($domconfig{'contacts'}{$mailing})) {
8852: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
8853: my @contacts = ('adminemail','supportemail');
8854: foreach my $item (@contacts) {
8855: if ($domconfig{'contacts'}{$mailing}{$item}) {
8856: my $addr = $domconfig{'contacts'}{$item};
8857: if (!grep(/^\Q$addr\E$/,@recipients)) {
8858: push(@recipients,$addr);
8859: }
1.619 raeburn 8860: }
1.692.4.2 raeburn 8861: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 8862: }
8863: }
1.692.4.2 raeburn 8864: } elsif ($origmail ne '') {
8865: push(@recipients,$origmail);
1.618 raeburn 8866: }
1.619 raeburn 8867: } elsif ($origmail ne '') {
8868: push(@recipients,$origmail);
1.618 raeburn 8869: }
1.688 raeburn 8870: if (defined($defmail)) {
8871: if ($defmail ne '') {
8872: push(@recipients,$defmail);
8873: }
1.618 raeburn 8874: }
8875: if ($otheremails) {
1.619 raeburn 8876: my @others;
8877: if ($otheremails =~ /,/) {
8878: @others = split(/,/,$otheremails);
1.618 raeburn 8879: } else {
1.619 raeburn 8880: push(@others,$otheremails);
8881: }
8882: foreach my $addr (@others) {
8883: if (!grep(/^\Q$addr\E$/,@recipients)) {
8884: push(@recipients,$addr);
8885: }
1.618 raeburn 8886: }
8887: }
1.619 raeburn 8888: my $recipientlist = join(',',@recipients);
1.618 raeburn 8889: return $recipientlist;
8890: }
8891:
1.127 matthew 8892: ############################################################
8893: ############################################################
1.154 albertel 8894:
1.655 raeburn 8895: =pod
8896:
8897: =head1 Course Catalog Routines
8898:
8899: =over 4
8900:
8901: =item * &gather_categories()
8902:
8903: Converts category definitions - keys of categories hash stored in
8904: coursecategories in configuration.db on the primary library server in a
8905: domain - to an array. Also generates javascript and idx hash used to
8906: generate Domain Coordinator interface for editing Course Categories.
8907:
8908: Inputs:
1.663 raeburn 8909:
1.655 raeburn 8910: categories (reference to hash of category definitions).
1.663 raeburn 8911:
1.655 raeburn 8912: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8913: categories and subcategories).
1.663 raeburn 8914:
1.655 raeburn 8915: idx (reference to hash of counters used in Domain Coordinator interface for
8916: editing Course Categories).
1.663 raeburn 8917:
1.655 raeburn 8918: jsarray (reference to array of categories used to create Javascript arrays for
8919: Domain Coordinator interface for editing Course Categories).
8920:
8921: Returns: nothing
8922:
8923: Side effects: populates cats, idx and jsarray.
8924:
8925: =cut
8926:
8927: sub gather_categories {
8928: my ($categories,$cats,$idx,$jsarray) = @_;
8929: my %counters;
8930: my $num = 0;
8931: foreach my $item (keys(%{$categories})) {
8932: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
8933: if ($container eq '' && $depth == 0) {
8934: $cats->[$depth][$categories->{$item}] = $cat;
8935: } else {
8936: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
8937: }
8938: my ($escitem,$tail) = split(/:/,$item,2);
8939: if ($counters{$tail} eq '') {
8940: $counters{$tail} = $num;
8941: $num ++;
8942: }
8943: if (ref($idx) eq 'HASH') {
8944: $idx->{$item} = $counters{$tail};
8945: }
8946: if (ref($jsarray) eq 'ARRAY') {
8947: push(@{$jsarray->[$counters{$tail}]},$item);
8948: }
8949: }
8950: return;
8951: }
8952:
8953: =pod
8954:
8955: =item * &extract_categories()
8956:
8957: Used to generate breadcrumb trails for course categories.
8958:
8959: Inputs:
1.663 raeburn 8960:
1.655 raeburn 8961: categories (reference to hash of category definitions).
1.663 raeburn 8962:
1.655 raeburn 8963: cats (reference to array of arrays/hashes which encapsulates hierarchy of
8964: categories and subcategories).
1.663 raeburn 8965:
1.655 raeburn 8966: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 8967:
1.655 raeburn 8968: allitems (reference to hash - key is category key
8969: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 8970:
1.655 raeburn 8971: idx (reference to hash of counters used in Domain Coordinator interface for
8972: editing Course Categories).
1.663 raeburn 8973:
1.655 raeburn 8974: jsarray (reference to array of categories used to create Javascript arrays for
8975: Domain Coordinator interface for editing Course Categories).
8976:
1.665 raeburn 8977: subcats (reference to hash of arrays containing all subcategories within each
8978: category, -recursive)
8979:
1.655 raeburn 8980: Returns: nothing
8981:
8982: Side effects: populates trails and allitems hash references.
8983:
8984: =cut
8985:
8986: sub extract_categories {
1.665 raeburn 8987: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 8988: if (ref($categories) eq 'HASH') {
8989: &gather_categories($categories,$cats,$idx,$jsarray);
8990: if (ref($cats->[0]) eq 'ARRAY') {
8991: for (my $i=0; $i<@{$cats->[0]}; $i++) {
8992: my $name = $cats->[0][$i];
8993: my $item = &escape($name).'::0';
8994: my $trailstr;
8995: if ($name eq 'instcode') {
8996: $trailstr = &mt('Official courses (with institutional codes)');
1.692.4.24! raeburn 8997: } elsif ($name eq 'communities') {
! 8998: $trailstr = &mt('Communities');
1.655 raeburn 8999: } else {
9000: $trailstr = $name;
9001: }
9002: if ($allitems->{$item} eq '') {
9003: push(@{$trails},$trailstr);
9004: $allitems->{$item} = scalar(@{$trails})-1;
9005: }
9006: my @parents = ($name);
9007: if (ref($cats->[1]{$name}) eq 'ARRAY') {
9008: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
9009: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 9010: if (ref($subcats) eq 'HASH') {
9011: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
9012: }
9013: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
9014: }
9015: } else {
9016: if (ref($subcats) eq 'HASH') {
9017: $subcats->{$item} = [];
1.655 raeburn 9018: }
9019: }
9020: }
9021: }
9022: }
9023: return;
9024: }
9025:
9026: =pod
9027:
9028: =item *&recurse_categories()
9029:
9030: Recursively used to generate breadcrumb trails for course categories.
9031:
9032: Inputs:
1.663 raeburn 9033:
1.655 raeburn 9034: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9035: categories and subcategories).
1.663 raeburn 9036:
1.655 raeburn 9037: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 9038:
9039: category (current course category, for which breadcrumb trail is being generated).
9040:
9041: trails (reference to array of breadcrumb trails for each category).
9042:
1.655 raeburn 9043: allitems (reference to hash - key is category key
9044: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 9045:
1.655 raeburn 9046: parents (array containing containers directories for current category,
9047: back to top level).
9048:
9049: Returns: nothing
9050:
9051: Side effects: populates trails and allitems hash references
9052:
9053: =cut
9054:
9055: sub recurse_categories {
1.665 raeburn 9056: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 9057: my $shallower = $depth - 1;
9058: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
9059: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
9060: my $name = $cats->[$depth]{$category}[$k];
9061: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9062: my $trailstr = join(' -> ',(@{$parents},$category));
9063: if ($allitems->{$item} eq '') {
9064: push(@{$trails},$trailstr);
9065: $allitems->{$item} = scalar(@{$trails})-1;
9066: }
9067: my $deeper = $depth+1;
9068: push(@{$parents},$category);
1.665 raeburn 9069: if (ref($subcats) eq 'HASH') {
9070: my $subcat = &escape($name).':'.$category.':'.$depth;
9071: for (my $j=@{$parents}; $j>=0; $j--) {
9072: my $higher;
9073: if ($j > 0) {
9074: $higher = &escape($parents->[$j]).':'.
9075: &escape($parents->[$j-1]).':'.$j;
9076: } else {
9077: $higher = &escape($parents->[$j]).'::'.$j;
9078: }
9079: push(@{$subcats->{$higher}},$subcat);
9080: }
9081: }
9082: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
9083: $subcats);
1.655 raeburn 9084: pop(@{$parents});
9085: }
9086: } else {
9087: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9088: my $trailstr = join(' -> ',(@{$parents},$category));
9089: if ($allitems->{$item} eq '') {
9090: push(@{$trails},$trailstr);
9091: $allitems->{$item} = scalar(@{$trails})-1;
9092: }
9093: }
9094: return;
9095: }
9096:
1.663 raeburn 9097: =pod
9098:
9099: =item *&assign_categories_table()
9100:
9101: Create a datatable for display of hierarchical categories in a domain,
9102: with checkboxes to allow a course to be categorized.
9103:
9104: Inputs:
9105:
9106: cathash - reference to hash of categories defined for the domain (from
9107: configuration.db)
9108:
1.692.4.24! raeburn 9109: currcat - scalar with an & separated list of categories assigned to a course.
! 9110:
! 9111: type - scalar contains course type (Course or Community).
1.663 raeburn 9112:
9113: Returns: $output (markup to be displayed)
9114:
9115: =cut
9116:
9117: sub assign_categories_table {
1.692.4.24! raeburn 9118: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 9119: my $output;
9120: if (ref($cathash) eq 'HASH') {
9121: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
9122: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
9123: $maxdepth = scalar(@cats);
9124: if (@cats > 0) {
9125: my $itemcount = 0;
9126: if (ref($cats[0]) eq 'ARRAY') {
9127: my @currcategories;
9128: if ($currcat ne '') {
9129: @currcategories = split('&',$currcat);
9130: }
1.692.4.24! raeburn 9131: my $table;
1.663 raeburn 9132: for (my $i=0; $i<@{$cats[0]}; $i++) {
9133: my $parent = $cats[0][$i];
9134: next if ($parent eq 'instcode');
1.692.4.24! raeburn 9135: if ($type eq 'Community') {
! 9136: next unless ($parent eq 'communities');
! 9137: } else {
! 9138: next if ($parent eq 'communities');
! 9139: }
! 9140: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.663 raeburn 9141: my $item = &escape($parent).'::0';
9142: my $checked = '';
9143: if (@currcategories > 0) {
9144: if (grep(/^\Q$item\E$/,@currcategories)) {
9145: $checked = ' checked="checked" ';
9146: }
9147: }
1.692.4.24! raeburn 9148: my $parent_title = $parent;
! 9149: if ($parent eq 'communities') {
! 9150: $parent_title = &mt('Communities');
! 9151: }
! 9152: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
! 9153: '<input type="checkbox" name="usecategory" value="'.
! 9154: $item.'"'.$checked.' />'.$parent_title.'</span>'.
! 9155: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 9156: my $depth = 1;
9157: push(@path,$parent);
1.692.4.24! raeburn 9158: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 9159: pop(@path);
1.692.4.24! raeburn 9160: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 9161: $itemcount ++;
9162: }
1.692.4.24! raeburn 9163: if ($itemcount) {
! 9164: $output = &Apache::loncommon::start_data_table().
! 9165: $table.
! 9166: &Apache::loncommon::end_data_table();
! 9167: }
1.663 raeburn 9168: }
9169: }
9170: }
9171: return $output;
9172: }
9173:
9174: =pod
9175:
9176: =item *&assign_category_rows()
9177:
9178: Create a datatable row for display of nested categories in a domain,
9179: with checkboxes to allow a course to be categorized,called recursively.
9180:
9181: Inputs:
9182:
9183: itemcount - track row number for alternating colors
9184:
9185: cats - reference to array of arrays/hashes which encapsulates hierarchy of
9186: categories and subcategories.
9187:
9188: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
9189:
9190: parent - parent of current category item
9191:
9192: path - Array containing all categories back up through the hierarchy from the
9193: current category to the top level.
9194:
9195: currcategories - reference to array of current categories assigned to the course
9196:
9197: Returns: $output (markup to be displayed).
9198:
9199: =cut
9200:
9201: sub assign_category_rows {
9202: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
9203: my ($text,$name,$item,$chgstr);
9204: if (ref($cats) eq 'ARRAY') {
9205: my $maxdepth = scalar(@{$cats});
9206: if (ref($cats->[$depth]) eq 'HASH') {
9207: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
9208: my $numchildren = @{$cats->[$depth]{$parent}};
9209: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
9210: $text .= '<td><table class="LC_datatable">';
9211: for (my $j=0; $j<$numchildren; $j++) {
9212: $name = $cats->[$depth]{$parent}[$j];
9213: $item = &escape($name).':'.&escape($parent).':'.$depth;
9214: my $deeper = $depth+1;
9215: my $checked = '';
9216: if (ref($currcategories) eq 'ARRAY') {
9217: if (@{$currcategories} > 0) {
9218: if (grep(/^\Q$item\E$/,@{$currcategories})) {
9219: $checked = ' checked="checked" ';
9220: }
9221: }
9222: }
1.664 raeburn 9223: $text .= '<tr><td><span class="LC_nobreak"><label>'.
9224: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 9225: $item.'"'.$checked.' />'.$name.'</label></span>'.
9226: '<input type="hidden" name="catname" value="'.$name.'" />'.
9227: '</td><td>';
1.663 raeburn 9228: if (ref($path) eq 'ARRAY') {
9229: push(@{$path},$name);
9230: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
9231: pop(@{$path});
9232: }
9233: $text .= '</td></tr>';
9234: }
9235: $text .= '</table></td>';
9236: }
9237: }
9238: }
9239: return $text;
9240: }
9241:
1.655 raeburn 9242: ############################################################
9243: ############################################################
9244:
9245:
1.443 albertel 9246: sub commit_customrole {
1.664 raeburn 9247: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 9248: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 9249: ($start?', '.&mt('starting').' '.localtime($start):'').
9250: ($end?', ending '.localtime($end):'').': <b>'.
9251: &Apache::lonnet::assigncustomrole(
1.664 raeburn 9252: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 9253: '</b><br />';
9254: return $output;
9255: }
9256:
9257: sub commit_standardrole {
1.541 raeburn 9258: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
9259: my ($output,$logmsg,$linefeed);
9260: if ($context eq 'auto') {
9261: $linefeed = "\n";
9262: } else {
9263: $linefeed = "<br />\n";
9264: }
1.443 albertel 9265: if ($three eq 'st') {
1.541 raeburn 9266: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
9267: $one,$two,$sec,$context);
9268: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 9269: ($result eq 'unknown_course') || ($result eq 'refused')) {
9270: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 9271: } else {
1.541 raeburn 9272: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 9273: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9274: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
9275: if ($context eq 'auto') {
9276: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
9277: } else {
9278: $output .= '<b>'.$result.'</b>'.$linefeed.
9279: &mt('Add to classlist').': <b>ok</b>';
9280: }
9281: $output .= $linefeed;
1.443 albertel 9282: }
9283: } else {
9284: $output = &mt('Assigning').' '.$three.' in '.$url.
9285: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9286: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 9287: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 9288: if ($context eq 'auto') {
9289: $output .= $result.$linefeed;
9290: } else {
9291: $output .= '<b>'.$result.'</b>'.$linefeed;
9292: }
1.443 albertel 9293: }
9294: return $output;
9295: }
9296:
9297: sub commit_studentrole {
1.541 raeburn 9298: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 9299: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 9300: if ($context eq 'auto') {
9301: $linefeed = "\n";
9302: } else {
9303: $linefeed = '<br />'."\n";
9304: }
1.443 albertel 9305: if (defined($one) && defined($two)) {
9306: my $cid=$one.'_'.$two;
9307: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
9308: my $secchange = 0;
9309: my $expire_role_result;
9310: my $modify_section_result;
1.628 raeburn 9311: if ($oldsec ne '-1') {
9312: if ($oldsec ne $sec) {
1.443 albertel 9313: $secchange = 1;
1.628 raeburn 9314: my $now = time;
1.443 albertel 9315: my $uurl='/'.$cid;
9316: $uurl=~s/\_/\//g;
9317: if ($oldsec) {
9318: $uurl.='/'.$oldsec;
9319: }
1.626 raeburn 9320: $oldsecurl = $uurl;
1.628 raeburn 9321: $expire_role_result =
1.652 raeburn 9322: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 9323: if ($env{'request.course.sec'} ne '') {
9324: if ($expire_role_result eq 'refused') {
9325: my @roles = ('st');
9326: my @statuses = ('previous');
9327: my @roledoms = ($one);
9328: my $withsec = 1;
9329: my %roleshash =
9330: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
9331: \@statuses,\@roles,\@roledoms,$withsec);
9332: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
9333: my ($oldstart,$oldend) =
9334: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
9335: if ($oldend > 0 && $oldend <= $now) {
9336: $expire_role_result = 'ok';
9337: }
9338: }
9339: }
9340: }
1.443 albertel 9341: $result = $expire_role_result;
9342: }
9343: }
9344: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 9345: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 9346: if ($modify_section_result =~ /^ok/) {
9347: if ($secchange == 1) {
1.628 raeburn 9348: if ($sec eq '') {
9349: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
9350: } else {
9351: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
9352: }
1.443 albertel 9353: } elsif ($oldsec eq '-1') {
1.628 raeburn 9354: if ($sec eq '') {
9355: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
9356: } else {
9357: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9358: }
1.443 albertel 9359: } else {
1.628 raeburn 9360: if ($sec eq '') {
9361: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
9362: } else {
9363: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9364: }
1.443 albertel 9365: }
9366: } else {
1.628 raeburn 9367: if ($secchange) {
9368: $$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;
9369: } else {
9370: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
9371: }
1.443 albertel 9372: }
9373: $result = $modify_section_result;
9374: } elsif ($secchange == 1) {
1.628 raeburn 9375: if ($oldsec eq '') {
9376: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
9377: } else {
9378: $$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;
9379: }
1.626 raeburn 9380: if ($expire_role_result eq 'refused') {
9381: my $newsecurl = '/'.$cid;
9382: $newsecurl =~ s/\_/\//g;
9383: if ($sec ne '') {
9384: $newsecurl.='/'.$sec;
9385: }
9386: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
9387: if ($sec eq '') {
9388: $$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;
9389: } else {
9390: $$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;
9391: }
9392: }
9393: }
1.443 albertel 9394: }
9395: } else {
1.626 raeburn 9396: $$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 9397: $result = "error: incomplete course id\n";
9398: }
9399: return $result;
9400: }
9401:
9402: ############################################################
9403: ############################################################
9404:
1.566 albertel 9405: sub check_clone {
1.578 raeburn 9406: my ($args,$linefeed) = @_;
1.566 albertel 9407: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
9408: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
9409: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
9410: my $clonemsg;
9411: my $can_clone = 0;
1.692.4.22 raeburn 9412: my $lctype = lc($args->{'type'});
9413: if ($lctype ne 'community') {
9414: $lctype = 'course';
9415: }
1.566 albertel 9416: if ($clonehome eq 'no_host') {
1.692.4.22 raeburn 9417: if ($args->{'type'} eq 'Community') {
9418: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
9419: } else {
9420: $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'});
9421: }
1.566 albertel 9422: } else {
9423: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.692.4.22 raeburn 9424: if ($args->{'type'} eq 'Community') {
9425: if ($clonedesc{'type'} ne 'Community') {
9426: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
9427: return ($can_clone, $clonemsg, $cloneid, $clonehome);
9428: }
9429: }
9430: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.692.4.12 raeburn 9431: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.692.4.22 raeburn 9432: $can_clone = 1;
9433: } else {
9434: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
9435: $args->{'clonedomain'},$args->{'clonecourse'});
9436: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 9437: if (grep(/^\*$/,@cloners)) {
9438: $can_clone = 1;
9439: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
9440: $can_clone = 1;
9441: } else {
1.692.4.22 raeburn 9442: my $ccrole = 'cc';
9443: if ($args->{'type'} eq 'Community') {
9444: $ccrole = 'co';
9445: }
9446: my %roleshash =
9447: &Apache::lonnet::get_my_roles($args->{'ccuname'},
9448: $args->{'ccdomain'},
9449: 'userroles',['active'],[$ccrole],
9450: [$args->{'clonedomain'}]);
9451: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
9452: $can_clone = 1;
9453: } else {
9454: if ($args->{'type'} eq 'Community') {
9455: $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
9456: } else {
9457: $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'});
9458: }
9459: }
9460: }
1.578 raeburn 9461: }
1.566 albertel 9462: }
9463: return ($can_clone, $clonemsg, $cloneid, $clonehome);
9464: }
9465:
1.444 albertel 9466: sub construct_course {
1.692.4.14 raeburn 9467: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 9468: my $outcome;
1.541 raeburn 9469: my $linefeed = '<br />'."\n";
9470: if ($context eq 'auto') {
9471: $linefeed = "\n";
9472: }
1.566 albertel 9473:
9474: #
9475: # Are we cloning?
9476: #
9477: my ($can_clone, $clonemsg, $cloneid, $clonehome);
9478: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 9479: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 9480: if ($context ne 'auto') {
1.578 raeburn 9481: if ($clonemsg ne '') {
9482: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
9483: }
1.566 albertel 9484: }
9485: $outcome .= $clonemsg.$linefeed;
9486:
9487: if (!$can_clone) {
9488: return (0,$outcome);
9489: }
9490: }
9491:
1.444 albertel 9492: #
9493: # Open course
9494: #
9495: my $crstype = lc($args->{'crstype'});
9496: my %cenv=();
9497: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
9498: $args->{'cdescr'},
9499: $args->{'curl'},
9500: $args->{'course_home'},
9501: $args->{'nonstandard'},
9502: $args->{'crscode'},
9503: $args->{'ccuname'}.':'.
9504: $args->{'ccdomain'},
1.692.4.12 raeburn 9505: $args->{'crstype'},
1.692.4.14 raeburn 9506: $cnum,$context,$category);
1.692.4.12 raeburn 9507:
1.444 albertel 9508:
9509: # Note: The testing routines depend on this being output; see
9510: # Utils::Course. This needs to at least be output as a comment
9511: # if anyone ever decides to not show this, and Utils::Course::new
9512: # will need to be suitably modified.
1.541 raeburn 9513: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 9514: #
9515: # Check if created correctly
9516: #
1.479 albertel 9517: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 9518: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 9519: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 9520:
1.444 albertel 9521: #
1.566 albertel 9522: # Do the cloning
9523: #
9524: if ($can_clone && $cloneid) {
9525: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
9526: if ($context ne 'auto') {
9527: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
9528: }
9529: $outcome .= $clonemsg.$linefeed;
9530: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 9531: # Copy all files
1.637 www 9532: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 9533: # Restore URL
1.566 albertel 9534: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 9535: # Restore title
1.566 albertel 9536: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 9537: # Mark as cloned
1.566 albertel 9538: $cenv{'clonedfrom'}=$cloneid;
1.638 www 9539: # Need to clone grading mode
9540: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
9541: $cenv{'grading'}=$newenv{'grading'};
9542: # Do not clone these environment entries
9543: &Apache::lonnet::del('environment',
9544: ['default_enrollment_start_date',
9545: 'default_enrollment_end_date',
9546: 'question.email',
9547: 'policy.email',
9548: 'comment.email',
9549: 'pch.users.denied',
1.692.4.2 raeburn 9550: 'plc.users.denied',
9551: 'hidefromcat',
9552: 'categories'],
1.638 www 9553: $$crsudom,$$crsunum);
1.444 albertel 9554: }
1.566 albertel 9555:
1.444 albertel 9556: #
9557: # Set environment (will override cloned, if existing)
9558: #
9559: my @sections = ();
9560: my @xlists = ();
9561: if ($args->{'crstype'}) {
9562: $cenv{'type'}=$args->{'crstype'};
9563: }
9564: if ($args->{'crsid'}) {
9565: $cenv{'courseid'}=$args->{'crsid'};
9566: }
9567: if ($args->{'crscode'}) {
9568: $cenv{'internal.coursecode'}=$args->{'crscode'};
9569: }
9570: if ($args->{'crsquota'} ne '') {
9571: $cenv{'internal.coursequota'}=$args->{'crsquota'};
9572: } else {
9573: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
9574: }
9575: if ($args->{'ccuname'}) {
9576: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
9577: ':'.$args->{'ccdomain'};
9578: } else {
9579: $cenv{'internal.courseowner'} = $args->{'curruser'};
9580: }
9581: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
9582: if ($args->{'crssections'}) {
9583: $cenv{'internal.sectionnums'} = '';
9584: if ($args->{'crssections'} =~ m/,/) {
9585: @sections = split/,/,$args->{'crssections'};
9586: } else {
9587: $sections[0] = $args->{'crssections'};
9588: }
9589: if (@sections > 0) {
9590: foreach my $item (@sections) {
9591: my ($sec,$gp) = split/:/,$item;
9592: my $class = $args->{'crscode'}.$sec;
9593: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
9594: $cenv{'internal.sectionnums'} .= $item.',';
9595: unless ($addcheck eq 'ok') {
9596: push @badclasses, $class;
9597: }
9598: }
9599: $cenv{'internal.sectionnums'} =~ s/,$//;
9600: }
9601: }
9602: # do not hide course coordinator from staff listing,
9603: # even if privileged
9604: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9605: # add crosslistings
9606: if ($args->{'crsxlist'}) {
9607: $cenv{'internal.crosslistings'}='';
9608: if ($args->{'crsxlist'} =~ m/,/) {
9609: @xlists = split/,/,$args->{'crsxlist'};
9610: } else {
9611: $xlists[0] = $args->{'crsxlist'};
9612: }
9613: if (@xlists > 0) {
9614: foreach my $item (@xlists) {
9615: my ($xl,$gp) = split/:/,$item;
9616: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
9617: $cenv{'internal.crosslistings'} .= $item.',';
9618: unless ($addcheck eq 'ok') {
9619: push @badclasses, $xl;
9620: }
9621: }
9622: $cenv{'internal.crosslistings'} =~ s/,$//;
9623: }
9624: }
9625: if ($args->{'autoadds'}) {
9626: $cenv{'internal.autoadds'}=$args->{'autoadds'};
9627: }
9628: if ($args->{'autodrops'}) {
9629: $cenv{'internal.autodrops'}=$args->{'autodrops'};
9630: }
9631: # check for notification of enrollment changes
9632: my @notified = ();
9633: if ($args->{'notify_owner'}) {
9634: if ($args->{'ccuname'} ne '') {
9635: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
9636: }
9637: }
9638: if ($args->{'notify_dc'}) {
9639: if ($uname ne '') {
1.630 raeburn 9640: push(@notified,$uname.':'.$udom);
1.444 albertel 9641: }
9642: }
9643: if (@notified > 0) {
9644: my $notifylist;
9645: if (@notified > 1) {
9646: $notifylist = join(',',@notified);
9647: } else {
9648: $notifylist = $notified[0];
9649: }
9650: $cenv{'internal.notifylist'} = $notifylist;
9651: }
9652: if (@badclasses > 0) {
9653: my %lt=&Apache::lonlocal::texthash(
9654: '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',
9655: 'dnhr' => 'does not have rights to access enrollment in these classes',
9656: 'adby' => 'as determined by the policies of your institution on access to official classlists'
9657: );
1.541 raeburn 9658: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
9659: ' ('.$lt{'adby'}.')';
9660: if ($context eq 'auto') {
9661: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 9662: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 9663: foreach my $item (@badclasses) {
9664: if ($context eq 'auto') {
9665: $outcome .= " - $item\n";
9666: } else {
9667: $outcome .= "<li>$item</li>\n";
9668: }
9669: }
9670: if ($context eq 'auto') {
9671: $outcome .= $linefeed;
9672: } else {
1.566 albertel 9673: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 9674: }
9675: }
1.444 albertel 9676: }
9677: if ($args->{'no_end_date'}) {
9678: $args->{'endaccess'} = 0;
9679: }
9680: $cenv{'internal.autostart'}=$args->{'enrollstart'};
9681: $cenv{'internal.autoend'}=$args->{'enrollend'};
9682: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
9683: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
9684: if ($args->{'showphotos'}) {
9685: $cenv{'internal.showphotos'}=$args->{'showphotos'};
9686: }
9687: $cenv{'internal.authtype'} = $args->{'authtype'};
9688: $cenv{'internal.autharg'} = $args->{'autharg'};
9689: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
9690: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 9691: 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');
9692: if ($context eq 'auto') {
9693: $outcome .= $krb_msg;
9694: } else {
1.566 albertel 9695: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 9696: }
9697: $outcome .= $linefeed;
1.444 albertel 9698: }
9699: }
9700: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
9701: if ($args->{'setpolicy'}) {
9702: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9703: }
9704: if ($args->{'setcontent'}) {
9705: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
9706: }
9707: }
9708: if ($args->{'reshome'}) {
9709: $cenv{'reshome'}=$args->{'reshome'}.'/';
9710: $cenv{'reshome'}=~s/\/+$/\//;
9711: }
9712: #
9713: # course has keyed access
9714: #
9715: if ($args->{'setkeys'}) {
9716: $cenv{'keyaccess'}='yes';
9717: }
9718: # if specified, key authority is not course, but user
9719: # only active if keyaccess is yes
9720: if ($args->{'keyauth'}) {
1.487 albertel 9721: my ($user,$domain) = split(':',$args->{'keyauth'});
9722: $user = &LONCAPA::clean_username($user);
9723: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 9724: if ($user ne '' && $domain ne '') {
1.487 albertel 9725: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 9726: }
9727: }
9728:
9729: if ($args->{'disresdis'}) {
9730: $cenv{'pch.roles.denied'}='st';
9731: }
9732: if ($args->{'disablechat'}) {
9733: $cenv{'plc.roles.denied'}='st';
9734: }
9735:
9736: # Record we've not yet viewed the Course Initialization Helper for this
9737: # course
9738: $cenv{'course.helper.not.run'} = 1;
9739: #
9740: # Use new Randomseed
9741: #
9742: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
9743: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
9744: #
9745: # The encryption code and receipt prefix for this course
9746: #
9747: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
9748: $cenv{'internal.encpref'}=100+int(9*rand(99));
9749: #
9750: # By default, use standard grading
9751: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
9752:
1.541 raeburn 9753: $outcome .= $linefeed.&mt('Setting environment').': '.
9754: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9755: #
9756: # Open all assignments
9757: #
9758: if ($args->{'openall'}) {
9759: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
9760: my %storecontent = ($storeunder => time,
9761: $storeunder.'.type' => 'date_start');
9762:
9763: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 9764: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 9765: }
9766: #
9767: # Set first page
9768: #
9769: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
9770: || ($cloneid)) {
1.445 albertel 9771: use LONCAPA::map;
1.444 albertel 9772: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 9773:
9774: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
9775: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
9776:
1.444 albertel 9777: $outcome .= ($fatal?$errtext:'read ok').' - ';
9778: my $title; my $url;
9779: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 9780: $title=&mt('Syllabus');
1.444 albertel 9781: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
9782: } else {
1.690 bisitz 9783: $title=&mt('Navigate Contents');
1.444 albertel 9784: $url='/adm/navmaps';
9785: }
1.445 albertel 9786:
9787: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
9788: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
9789:
9790: if ($errtext) { $fatal=2; }
1.541 raeburn 9791: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 9792: }
1.566 albertel 9793:
9794: return (1,$outcome);
1.444 albertel 9795: }
9796:
9797: ############################################################
9798: ############################################################
9799:
1.378 raeburn 9800: sub course_type {
9801: my ($cid) = @_;
9802: if (!defined($cid)) {
9803: $cid = $env{'request.course.id'};
9804: }
1.404 albertel 9805: if (defined($env{'course.'.$cid.'.type'})) {
9806: return $env{'course.'.$cid.'.type'};
1.378 raeburn 9807: } else {
9808: return 'Course';
1.377 raeburn 9809: }
9810: }
1.156 albertel 9811:
1.406 raeburn 9812: sub group_term {
9813: my $crstype = &course_type();
9814: my %names = (
1.692.4.6 raeburn 9815: 'Course' => 'group',
9816: 'Community' => 'group',
1.406 raeburn 9817: );
9818: return $names{$crstype};
9819: }
9820:
1.692.4.20 raeburn 9821: sub course_types {
9822: my @types = ('official','unofficial','community');
9823: my %typename = (
9824: official => 'Official course',
9825: unofficial => 'Unofficial course',
9826: community => 'Community',
9827: );
9828: return (\@types,\%typename);
9829: }
9830:
1.156 albertel 9831: sub icon {
9832: my ($file)=@_;
1.505 albertel 9833: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 9834: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 9835: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 9836: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
9837: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
9838: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9839: $curfext.".gif") {
9840: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
9841: $curfext.".gif";
9842: }
9843: }
1.249 albertel 9844: return &lonhttpdurl($iconname);
1.154 albertel 9845: }
1.84 albertel 9846:
1.575 albertel 9847: sub lonhttpdurl {
1.692 www 9848: #
9849: # Had been used for "small fry" static images on separate port 8080.
9850: # Modify here if lightweight http functionality desired again.
9851: # Currently eliminated due to increasing firewall issues.
9852: #
1.575 albertel 9853: my ($url)=@_;
1.692 www 9854: return $url;
1.215 albertel 9855: }
9856:
1.213 albertel 9857: sub connection_aborted {
9858: my ($r)=@_;
9859: $r->print(" ");$r->rflush();
9860: my $c = $r->connection;
9861: return $c->aborted();
9862: }
9863:
1.221 foxr 9864: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 9865: # strings as 'strings'.
9866: sub escape_single {
1.221 foxr 9867: my ($input) = @_;
1.223 albertel 9868: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 9869: $input =~ s/\'/\\\'/g; # Esacpe the 's....
9870: return $input;
9871: }
1.223 albertel 9872:
1.222 foxr 9873: # Same as escape_single, but escape's "'s This
9874: # can be used for "strings"
9875: sub escape_double {
9876: my ($input) = @_;
9877: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
9878: $input =~ s/\"/\\\"/g; # Esacpe the "s....
9879: return $input;
9880: }
1.223 albertel 9881:
1.222 foxr 9882: # Escapes the last element of a full URL.
9883: sub escape_url {
9884: my ($url) = @_;
1.238 raeburn 9885: my @urlslices = split(/\//, $url,-1);
1.369 www 9886: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 9887: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 9888: }
1.462 albertel 9889:
1.692.4.2 raeburn 9890: sub compare_arrays {
9891: my ($arrayref1,$arrayref2) = @_;
9892: my (@difference,%count);
9893: @difference = ();
9894: %count = ();
9895: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
9896: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
9897: foreach my $element (keys(%count)) {
9898: if ($count{$element} == 1) {
9899: push(@difference,$element);
9900: }
9901: }
9902: }
9903: return @difference;
9904: }
9905:
1.462 albertel 9906: # -------------------------------------------------------- Initliaze user login
9907: sub init_user_environment {
1.463 albertel 9908: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 9909: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
9910:
9911: my $public=($username eq 'public' && $domain eq 'public');
9912:
9913: # See if old ID present, if so, remove
9914:
9915: my ($filename,$cookie,$userroles);
9916: my $now=time;
9917:
9918: if ($public) {
9919: my $max_public=100;
9920: my $oldest;
9921: my $oldest_time=0;
9922: for(my $next=1;$next<=$max_public;$next++) {
9923: if (-e $lonids."/publicuser_$next.id") {
9924: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
9925: if ($mtime<$oldest_time || !$oldest_time) {
9926: $oldest_time=$mtime;
9927: $oldest=$next;
9928: }
9929: } else {
9930: $cookie="publicuser_$next";
9931: last;
9932: }
9933: }
9934: if (!$cookie) { $cookie="publicuser_$oldest"; }
9935: } else {
1.463 albertel 9936: # if this isn't a robot, kill any existing non-robot sessions
9937: if (!$args->{'robot'}) {
9938: opendir(DIR,$lonids);
9939: while ($filename=readdir(DIR)) {
9940: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
9941: unlink($lonids.'/'.$filename);
9942: }
1.462 albertel 9943: }
1.463 albertel 9944: closedir(DIR);
1.462 albertel 9945: }
9946: # Give them a new cookie
1.463 albertel 9947: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 9948: : $now.$$.int(rand(10000)));
1.463 albertel 9949: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 9950:
9951: # Initialize roles
9952:
9953: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
9954: }
9955: # ------------------------------------ Check browser type and MathML capability
9956:
9957: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
9958: $clientunicode,$clientos) = &decode_user_agent($r);
9959:
9960: # -------------------------------------- Any accessibility options to remember?
9961: if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
9962: foreach my $option ('imagesuppress','appletsuppress',
9963: 'embedsuppress','fontenhance','blackwhite') {
9964: if ($form->{$option} eq 'true') {
9965: &Apache::lonnet::put('environment',{$option => 'on'},
9966: $domain,$username);
9967: } else {
9968: &Apache::lonnet::del('environment',[$option],
9969: $domain,$username);
9970: }
9971: }
9972: }
9973: # ------------------------------------------------------------- Get environment
9974:
9975: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
9976: my ($tmp) = keys(%userenv);
9977: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9978: # default remote control to off
9979: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
9980: } else {
9981: undef(%userenv);
9982: }
9983: if (($userenv{'interface'}) && (!$form->{'interface'})) {
9984: $form->{'interface'}=$userenv{'interface'};
9985: }
9986: $env{'environment.remote'}=$userenv{'remote'};
9987: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
9988:
9989: # --------------- Do not trust query string to be put directly into environment
9990: foreach my $option ('imagesuppress','appletsuppress',
9991: 'embedsuppress','fontenhance','blackwhite',
9992: 'interface','localpath','localres') {
9993: $form->{$option}=~s/[\n\r\=]//gs;
9994: }
9995: # --------------------------------------------------------- Write first profile
9996:
9997: {
9998: my %initial_env =
9999: ("user.name" => $username,
10000: "user.domain" => $domain,
10001: "user.home" => $authhost,
10002: "browser.type" => $clientbrowser,
10003: "browser.version" => $clientversion,
10004: "browser.mathml" => $clientmathml,
10005: "browser.unicode" => $clientunicode,
10006: "browser.os" => $clientos,
10007: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
10008: "request.course.fn" => '',
10009: "request.course.uri" => '',
10010: "request.course.sec" => '',
10011: "request.role" => 'cm',
10012: "request.role.adv" => $env{'user.adv'},
10013: "request.host" => $ENV{'REMOTE_ADDR'},);
10014:
10015: if ($form->{'localpath'}) {
10016: $initial_env{"browser.localpath"} = $form->{'localpath'};
10017: $initial_env{"browser.localres"} = $form->{'localres'};
10018: }
10019:
10020: if ($public) {
10021: $initial_env{"environment.remote"} = "off";
10022: }
10023: if ($form->{'interface'}) {
10024: $form->{'interface'}=~s/\W//gs;
10025: $initial_env{"browser.interface"} = $form->{'interface'};
10026: $env{'browser.interface'}=$form->{'interface'};
10027: foreach my $option ('imagesuppress','appletsuppress',
10028: 'embedsuppress','fontenhance','blackwhite') {
10029: if (($form->{$option} eq 'true') ||
10030: ($userenv{$option} eq 'on')) {
10031: $initial_env{"browser.$option"} = "on";
10032: }
10033: }
10034: }
10035:
1.692.4.2 raeburn 10036: foreach my $tool ('aboutme','blog','portfolio') {
10037: $userenv{'availabletools.'.$tool} =
10038: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
10039: }
10040:
1.692.4.6 raeburn 10041: foreach my $crstype ('official','unofficial','community') {
1.692.4.2 raeburn 10042: $userenv{'canrequest.'.$crstype} =
10043: &Apache::lonnet::usertools_access($username,$domain,$crstype,
10044: 'reload','requestcourses');
10045: }
10046:
1.462 albertel 10047: $env{'user.environment'} = "$lonids/$cookie.id";
10048:
10049: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
10050: &GDBM_WRCREAT(),0640)) {
10051: &_add_to_env(\%disk_env,\%initial_env);
10052: &_add_to_env(\%disk_env,\%userenv,'environment.');
10053: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 10054: if (ref($args->{'extra_env'})) {
10055: &_add_to_env(\%disk_env,$args->{'extra_env'});
10056: }
1.462 albertel 10057: untie(%disk_env);
10058: } else {
10059: &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
10060: 'Could not create environment storage in lonauth: '.$!.'</font>');
10061: return 'error: '.$!;
10062: }
10063: }
10064: $env{'request.role'}='cm';
10065: $env{'request.role.adv'}=$env{'user.adv'};
10066: $env{'browser.type'}=$clientbrowser;
10067:
10068: return $cookie;
10069:
10070: }
10071:
10072: sub _add_to_env {
10073: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 10074: if (ref($env_data) eq 'HASH') {
10075: while (my ($key,$value) = each(%$env_data)) {
10076: $idf->{$prefix.$key} = $value;
10077: $env{$prefix.$key} = $value;
10078: }
1.462 albertel 10079: }
10080: }
10081:
1.685 tempelho 10082: # --- Get the symbolic name of a problem and the url
10083: sub get_symb {
10084: my ($request,$silent) = @_;
1.692.4.2 raeburn 10085: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 10086: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
10087: if ($symb eq '') {
10088: if (!$silent) {
10089: $request->print("Unable to handle ambiguous references:$url:.");
10090: return ();
10091: }
10092: }
10093: &Apache::lonenc::check_decrypt(\$symb);
10094: return ($symb);
10095: }
10096:
10097: # --------------------------------------------------------------Get annotation
10098:
10099: sub get_annotation {
10100: my ($symb,$enc) = @_;
10101:
10102: my $key = $symb;
10103: if (!$enc) {
10104: $key =
10105: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
10106: }
10107: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
10108: return $annotation{$key};
10109: }
10110:
10111: sub clean_symb {
1.692.4.2 raeburn 10112: my ($symb,$delete_enc) = @_;
1.685 tempelho 10113:
10114: &Apache::lonenc::check_decrypt(\$symb);
10115: my $enc = $env{'request.enc'};
1.692.4.2 raeburn 10116: if ($delete_enc) {
10117: delete($env{'request.enc'});
10118: }
1.685 tempelho 10119:
10120: return ($symb,$enc);
10121: }
1.462 albertel 10122:
1.41 ng 10123: =pod
10124:
10125: =back
10126:
1.112 bowersj2 10127: =cut
1.41 ng 10128:
1.112 bowersj2 10129: 1;
10130: __END__;
1.41 ng 10131:
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