Annotation of loncom/interface/loncommon.pm, revision 1.894
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.894 ! droeschl 4: # $Id: loncommon.pm,v 1.893 2009/10/01 17:25:17 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.705 tempelho 274: "<span style='color:yellow;'>INFO: Read file types</span>");
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.776 bisitz 409: <script type="text/javascript" language="Javascript">
1.824 bisitz 410: // <![CDATA[
1.74 www 411: var stdeditbrowser;
1.793 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.793 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.824 bisitz 433: // ]]>
1.74 www 434: </script>
435: ENDSTDBRW
436: }
1.42 matthew 437:
1.74 www 438: sub selectstudent_link {
1.793 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.793 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.793 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";
1.776 bisitz 465: <script type="text/javascript" language="JavaScript">
1.824 bisitz 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: }
478:
1.824 bisitz 479: // ]]>
1.653 raeburn 480: </script>
481: ENDAUTHORBRW
482: }
483:
1.91 www 484: sub coursebrowser_javascript {
1.468 raeburn 485: my ($domainfilter,$sec_element,$formname)=@_;
1.886 raeburn 486: my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Community - for which you wish to add/modify a user role.');
1.876 raeburn 487: my $id_functions = &javascript_index_functions();
488: my $output = '
1.776 bisitz 489: <script type="text/javascript" language="JavaScript">
1.824 bisitz 490: // <![CDATA[
1.468 raeburn 491: var stdeditbrowser;'."\n";
1.876 raeburn 492:
493: $output .= <<"ENDSTDBRW";
1.377 raeburn 494: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
1.91 www 495: var url = '/adm/pickcourse?';
1.876 raeburn 496: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 497: if (domainfilter != null) {
498: if (domainfilter != '') {
499: url += 'domainfilter='+domainfilter+'&';
500: }
501: }
1.91 www 502: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 503: '&cdomelement='+udom+
504: '&cnameelement='+desc;
1.468 raeburn 505: if (extra_element !=null && extra_element != '') {
1.594 raeburn 506: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 507: url += '&roleelement='+extra_element;
508: if (domainfilter == null || domainfilter == '') {
509: url += '&domainfilter='+extra_element;
510: }
1.234 raeburn 511: }
1.468 raeburn 512: else {
513: if (formname == 'portform') {
514: url += '&setroles='+extra_element;
1.800 raeburn 515: } else {
516: if (formname == 'rules') {
517: url += '&fixeddom='+extra_element;
518: }
1.468 raeburn 519: }
520: }
1.230 raeburn 521: }
1.872 raeburn 522: if (formname == 'ccrs') {
523: var ownername = document.forms[formid].ccuname.value;
524: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
525: url += '&cloner='+ownername+':'+ownerdom;
526: }
1.293 raeburn 527: if (multflag !=null && multflag != '') {
528: url += '&multiple='+multflag;
529: }
1.865 raeburn 530: if (crstype == 'Course/Community') {
1.377 raeburn 531: if (formname == 'cu') {
532: crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
533: if (crstype == "") {
534: alert("$crs_or_grp_alert");
535: return;
536: }
537: }
538: }
539: if (crstype !=null && crstype != '') {
540: url += '&type='+crstype;
541: }
1.102 www 542: var title = 'Course_Browser';
1.91 www 543: var options = 'scrollbars=1,resizable=1,menubar=0';
544: options += ',width=700,height=600';
545: stdeditbrowser = open(url,title,options,'1');
546: stdeditbrowser.focus();
547: }
1.876 raeburn 548: $id_functions
549: ENDSTDBRW
550: if ($sec_element ne '') {
551: $output .= &setsec_javascript($sec_element,$formname);
552: }
553: $output .= '
554: // ]]>
555: </script>';
556: return $output;
557: }
558:
559: sub javascript_index_functions {
560: return <<"ENDJS";
561:
562: function getFormIdByName(formname) {
563: for (var i=0;i<document.forms.length;i++) {
564: if (document.forms[i].name == formname) {
565: return i;
566: }
567: }
568: return -1;
569: }
570:
571: function getIndexByName(formid,item) {
572: for (var i=0;i<document.forms[formid].elements.length;i++) {
573: if (document.forms[formid].elements[i].name == item) {
574: return i;
575: }
576: }
577: return -1;
578: }
1.468 raeburn 579:
1.876 raeburn 580: function getDomainFromSelectbox(formname,udom) {
581: var userdom;
582: var formid = getFormIdByName(formname);
583: if (formid > -1) {
584: var domid = getIndexByName(formid,udom);
585: if (domid > -1) {
586: if (document.forms[formid].elements[domid].type == 'select-one') {
587: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
588: }
589: if (document.forms[formid].elements[domid].type == 'hidden') {
590: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 591: }
592: }
593: }
1.876 raeburn 594: return userdom;
595: }
596:
597: ENDJS
1.468 raeburn 598:
1.876 raeburn 599: }
600:
601: sub userbrowser_javascript {
602: my $id_functions = &javascript_index_functions();
603: return <<"ENDUSERBRW";
604:
1.888 raeburn 605: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 606: var url = '/adm/pickuser?';
607: var userdom = getDomainFromSelectbox(formname,udom);
608: if (userdom != null) {
609: if (userdom != '') {
610: url += 'srchdom='+userdom+'&';
611: }
612: }
613: url += 'form=' + formname + '&unameelement='+uname+
614: '&udomelement='+udom+
615: '&ulastelement='+ulast+
616: '&ufirstelement='+ufirst+
617: '&uemailelement='+uemail+
1.881 raeburn 618: '&hideudomelement='+hideudom+
619: '&coursedom='+crsdom;
1.888 raeburn 620: if ((caller != null) && (caller != undefined)) {
621: url += '&caller='+caller;
622: }
1.876 raeburn 623: var title = 'User_Browser';
624: var options = 'scrollbars=1,resizable=1,menubar=0';
625: options += ',width=700,height=600';
626: var stdeditbrowser = open(url,title,options,'1');
627: stdeditbrowser.focus();
628: }
629:
1.888 raeburn 630: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 631: var formid = getFormIdByName(formname);
632: if (formid > -1) {
1.888 raeburn 633: var unameid = getIndexByName(formid,uname);
1.876 raeburn 634: var domid = getIndexByName(formid,udom);
635: var hidedomid = getIndexByName(formid,origdom);
636: if (hidedomid > -1) {
637: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 638: var unameval = document.forms[formid].elements[unameid].value;
639: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
640: if (domid > -1) {
641: var slct = document.forms[formid].elements[domid];
642: if (slct.type == 'select-one') {
643: var i;
644: for (i=0;i<slct.length;i++) {
645: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
646: }
647: }
648: if (slct.type == 'hidden') {
649: slct.value = fixeddom;
1.876 raeburn 650: }
651: }
1.468 raeburn 652: }
653: }
654: }
1.876 raeburn 655: return;
656: }
657:
658: $id_functions
659: ENDUSERBRW
1.468 raeburn 660: }
661:
662: sub setsec_javascript {
663: my ($sec_element,$formname) = @_;
664: my $setsections = qq|
665: function setSect(sectionlist) {
1.629 raeburn 666: var sectionsArray = new Array();
667: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
668: sectionsArray = sectionlist.split(",");
669: }
1.468 raeburn 670: var numSections = sectionsArray.length;
671: document.$formname.$sec_element.length = 0;
672: if (numSections == 0) {
673: document.$formname.$sec_element.multiple=false;
674: document.$formname.$sec_element.size=1;
675: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
676: } else {
677: if (numSections == 1) {
678: document.$formname.$sec_element.multiple=false;
679: document.$formname.$sec_element.size=1;
680: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
681: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
682: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
683: } else {
684: for (var i=0; i<numSections; i++) {
685: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
686: }
687: document.$formname.$sec_element.multiple=true
688: if (numSections < 3) {
689: document.$formname.$sec_element.size=numSections;
690: } else {
691: document.$formname.$sec_element.size=3;
692: }
693: document.$formname.$sec_element.options[0].selected = false
694: }
695: }
1.91 www 696: }
1.468 raeburn 697: |;
698: return $setsections;
699: }
700:
1.91 www 701:
702: sub selectcourse_link {
1.377 raeburn 703: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
1.871 raeburn 704: my $linktext = &mt('Select Course');
705: if ($selecttype eq 'Community') {
706: $linktext = &mt('Select Community');
707: }
1.787 bisitz 708: return '<span class="LC_nobreak">'
709: ."<a href='"
710: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
711: .'","'.$udomele.'","'.$desc.'","'.$extra_element
712: .'","'.$multflag.'","'.$selecttype.'");'
1.871 raeburn 713: ."'>".$linktext.'</a>'
1.787 bisitz 714: .'</span>';
1.74 www 715: }
1.42 matthew 716:
1.653 raeburn 717: sub selectauthor_link {
718: my ($form,$udom)=@_;
719: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
720: &mt('Select Author').'</a>';
721: }
722:
1.876 raeburn 723: sub selectuser_link {
1.881 raeburn 724: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 725: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 726: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 727: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 728: ');">'.$linktext.'</a>';
1.876 raeburn 729: }
730:
1.273 raeburn 731: sub check_uncheck_jscript {
732: my $jscript = <<"ENDSCRT";
733: function checkAll(field) {
734: if (field.length > 0) {
735: for (i = 0; i < field.length; i++) {
736: field[i].checked = true ;
737: }
738: } else {
739: field.checked = true
740: }
741: }
742:
743: function uncheckAll(field) {
744: if (field.length > 0) {
745: for (i = 0; i < field.length; i++) {
746: field[i].checked = false ;
1.543 albertel 747: }
748: } else {
1.273 raeburn 749: field.checked = false ;
750: }
751: }
752: ENDSCRT
753: return $jscript;
754: }
755:
1.656 www 756: sub select_timezone {
1.659 raeburn 757: my ($name,$selected,$onchange,$includeempty)=@_;
758: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
759: if ($includeempty) {
760: $output .= '<option value=""';
761: if (($selected eq '') || ($selected eq 'local')) {
762: $output .= ' selected="selected" ';
763: }
764: $output .= '> </option>';
765: }
1.657 raeburn 766: my @timezones = DateTime::TimeZone->all_names;
767: foreach my $tzone (@timezones) {
768: $output.= '<option value="'.$tzone.'"';
769: if ($tzone eq $selected) {
770: $output.=' selected="selected"';
771: }
772: $output.=">$tzone</option>\n";
1.656 www 773: }
774: $output.="</select>";
775: return $output;
776: }
1.273 raeburn 777:
1.687 raeburn 778: sub select_datelocale {
779: my ($name,$selected,$onchange,$includeempty)=@_;
780: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
781: if ($includeempty) {
782: $output .= '<option value=""';
783: if ($selected eq '') {
784: $output .= ' selected="selected" ';
785: }
786: $output .= '> </option>';
787: }
788: my (@possibles,%locale_names);
789: my @locales = DateTime::Locale::Catalog::Locales;
790: foreach my $locale (@locales) {
791: if (ref($locale) eq 'HASH') {
792: my $id = $locale->{'id'};
793: if ($id ne '') {
794: my $en_terr = $locale->{'en_territory'};
795: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 796: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 797: if (grep(/^en$/,@languages) || !@languages) {
798: if ($en_terr ne '') {
799: $locale_names{$id} = '('.$en_terr.')';
800: } elsif ($native_terr ne '') {
801: $locale_names{$id} = $native_terr;
802: }
803: } else {
804: if ($native_terr ne '') {
805: $locale_names{$id} = $native_terr.' ';
806: } elsif ($en_terr ne '') {
807: $locale_names{$id} = '('.$en_terr.')';
808: }
809: }
810: push (@possibles,$id);
811: }
812: }
813: }
814: foreach my $item (sort(@possibles)) {
815: $output.= '<option value="'.$item.'"';
816: if ($item eq $selected) {
817: $output.=' selected="selected"';
818: }
819: $output.=">$item";
820: if ($locale_names{$item} ne '') {
821: $output.=" $locale_names{$item}</option>\n";
822: }
823: $output.="</option>\n";
824: }
825: $output.="</select>";
826: return $output;
827: }
828:
1.792 raeburn 829: sub select_language {
830: my ($name,$selected,$includeempty) = @_;
831: my %langchoices;
832: if ($includeempty) {
833: %langchoices = ('' => 'No language preference');
834: }
835: foreach my $id (&languageids()) {
836: my $code = &supportedlanguagecode($id);
837: if ($code) {
838: $langchoices{$code} = &plainlanguagedescription($id);
839: }
840: }
841: return &select_form($selected,$name,%langchoices);
842: }
843:
1.42 matthew 844: =pod
1.36 matthew 845:
1.648 raeburn 846: =item * &linked_select_forms(...)
1.36 matthew 847:
848: linked_select_forms returns a string containing a <script></script> block
849: and html for two <select> menus. The select menus will be linked in that
850: changing the value of the first menu will result in new values being placed
851: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 852: order unless a defined order is provided.
1.36 matthew 853:
854: linked_select_forms takes the following ordered inputs:
855:
856: =over 4
857:
1.112 bowersj2 858: =item * $formname, the name of the <form> tag
1.36 matthew 859:
1.112 bowersj2 860: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 861:
1.112 bowersj2 862: =item * $firstdefault, the default value for the first menu
1.36 matthew 863:
1.112 bowersj2 864: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 865:
1.112 bowersj2 866: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 867:
1.112 bowersj2 868: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 869:
1.609 raeburn 870: =item * $menuorder, the order of values in the first menu
871:
1.41 ng 872: =back
873:
1.36 matthew 874: Below is an example of such a hash. Only the 'text', 'default', and
875: 'select2' keys must appear as stated. keys(%menu) are the possible
876: values for the first select menu. The text that coincides with the
1.41 ng 877: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 878: and text for the second menu are given in the hash pointed to by
879: $menu{$choice1}->{'select2'}.
880:
1.112 bowersj2 881: my %menu = ( A1 => { text =>"Choice A1" ,
882: default => "B3",
883: select2 => {
884: B1 => "Choice B1",
885: B2 => "Choice B2",
886: B3 => "Choice B3",
887: B4 => "Choice B4"
1.609 raeburn 888: },
889: order => ['B4','B3','B1','B2'],
1.112 bowersj2 890: },
891: A2 => { text =>"Choice A2" ,
892: default => "C2",
893: select2 => {
894: C1 => "Choice C1",
895: C2 => "Choice C2",
896: C3 => "Choice C3"
1.609 raeburn 897: },
898: order => ['C2','C1','C3'],
1.112 bowersj2 899: },
900: A3 => { text =>"Choice A3" ,
901: default => "D6",
902: select2 => {
903: D1 => "Choice D1",
904: D2 => "Choice D2",
905: D3 => "Choice D3",
906: D4 => "Choice D4",
907: D5 => "Choice D5",
908: D6 => "Choice D6",
909: D7 => "Choice D7"
1.609 raeburn 910: },
911: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 912: }
913: );
1.36 matthew 914:
915: =cut
916:
917: sub linked_select_forms {
918: my ($formname,
919: $middletext,
920: $firstdefault,
921: $firstselectname,
922: $secondselectname,
1.609 raeburn 923: $hashref,
924: $menuorder,
1.36 matthew 925: ) = @_;
926: my $second = "document.$formname.$secondselectname";
927: my $first = "document.$formname.$firstselectname";
928: # output the javascript to do the changing
929: my $result = '';
1.776 bisitz 930: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 931: $result.="// <![CDATA[\n";
1.36 matthew 932: $result.="var select2data = new Object();\n";
933: $" = '","';
934: my $debug = '';
935: foreach my $s1 (sort(keys(%$hashref))) {
936: $result.="select2data.d_$s1 = new Object();\n";
937: $result.="select2data.d_$s1.def = new String('".
938: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 939: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 940: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 941: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
942: @s2values = @{$hashref->{$s1}->{'order'}};
943: }
1.36 matthew 944: $result.="\"@s2values\");\n";
945: $result.="select2data.d_$s1.texts = new Array(";
946: my @s2texts;
947: foreach my $value (@s2values) {
948: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
949: }
950: $result.="\"@s2texts\");\n";
951: }
952: $"=' ';
953: $result.= <<"END";
954:
955: function select1_changed() {
956: // Determine new choice
957: var newvalue = "d_" + $first.value;
958: // update select2
959: var values = select2data[newvalue].values;
960: var texts = select2data[newvalue].texts;
961: var select2def = select2data[newvalue].def;
962: var i;
963: // out with the old
964: for (i = 0; i < $second.options.length; i++) {
965: $second.options[i] = null;
966: }
967: // in with the nuclear
968: for (i=0;i<values.length; i++) {
969: $second.options[i] = new Option(values[i]);
1.143 matthew 970: $second.options[i].value = values[i];
1.36 matthew 971: $second.options[i].text = texts[i];
972: if (values[i] == select2def) {
973: $second.options[i].selected = true;
974: }
975: }
976: }
1.824 bisitz 977: // ]]>
1.36 matthew 978: </script>
979: END
980: # output the initial values for the selection lists
981: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 982: my @order = sort(keys(%{$hashref}));
983: if (ref($menuorder) eq 'ARRAY') {
984: @order = @{$menuorder};
985: }
986: foreach my $value (@order) {
1.36 matthew 987: $result.=" <option value=\"$value\" ";
1.253 albertel 988: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 989: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 990: }
991: $result .= "</select>\n";
992: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
993: $result .= $middletext;
994: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
995: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 996:
997: my @secondorder = sort(keys(%select2));
998: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
999: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1000: }
1001: foreach my $value (@secondorder) {
1.36 matthew 1002: $result.=" <option value=\"$value\" ";
1.253 albertel 1003: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1004: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1005: }
1006: $result .= "</select>\n";
1007: # return $debug;
1008: return $result;
1009: } # end of sub linked_select_forms {
1010:
1.45 matthew 1011: =pod
1.44 bowersj2 1012:
1.648 raeburn 1013: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44 bowersj2 1014:
1.112 bowersj2 1015: Returns a string corresponding to an HTML link to the given help
1016: $topic, where $topic corresponds to the name of a .tex file in
1017: /home/httpd/html/adm/help/tex, with underscores replaced by
1018: spaces.
1019:
1020: $text will optionally be linked to the same topic, allowing you to
1021: link text in addition to the graphic. If you do not want to link
1022: text, but wish to specify one of the later parameters, pass an
1023: empty string.
1024:
1025: $stayOnPage is a value that will be interpreted as a boolean. If true,
1026: the link will not open a new window. If false, the link will open
1027: a new window using Javascript. (Default is false.)
1028:
1029: $width and $height are optional numerical parameters that will
1030: override the width and height of the popped up window, which may
1031: be useful for certain help topics with big pictures included.
1.44 bowersj2 1032:
1033: =cut
1034:
1035: sub help_open_topic {
1.48 bowersj2 1036: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1037: $text = "" if (not defined $text);
1.44 bowersj2 1038: $stayOnPage = 0 if (not defined $stayOnPage);
1039: $width = 350 if (not defined $width);
1040: $height = 400 if (not defined $height);
1041: my $filename = $topic;
1042: $filename =~ s/ /_/g;
1043:
1.48 bowersj2 1044: my $template = "";
1045: my $link;
1.572 banghart 1046:
1.159 www 1047: $topic=~s/\W/\_/g;
1.44 bowersj2 1048:
1.572 banghart 1049: if (!$stayOnPage) {
1.72 bowersj2 1050: $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 1051: } else {
1.48 bowersj2 1052: $link = "/adm/help/${filename}.hlp";
1053: }
1054:
1055: # Add the text
1.755 neumanie 1056: if ($text ne "") {
1.763 bisitz 1057: $template.='<span class="LC_help_open_topic">'
1058: .'<a target="_top" href="'.$link.'">'
1059: .$text.'</a>';
1.48 bowersj2 1060: }
1061:
1.763 bisitz 1062: # (Always) Add the graphic
1.179 matthew 1063: my $title = &mt('Online Help');
1.667 raeburn 1064: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.763 bisitz 1065: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1066: .'<img src="'.$helpicon.'" border="0"'
1067: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.783 amueller 1068: .' title="'.$title.'"'
1.763 bisitz 1069: .' /></a>';
1070: if ($text ne "") {
1071: $template.='</span>';
1072: }
1.44 bowersj2 1073: return $template;
1074:
1.106 bowersj2 1075: }
1076:
1077: # This is a quicky function for Latex cheatsheet editing, since it
1078: # appears in at least four places
1079: sub helpLatexCheatsheet {
1.732 raeburn 1080: my ($topic,$text,$not_author) = @_;
1081: my $out;
1.106 bowersj2 1082: my $addOther = '';
1.732 raeburn 1083: if ($topic) {
1.763 bisitz 1084: $addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
1085: undef, undef, 600).
1086: '</span> ';
1087: }
1088: $out = '<span>' # Start cheatsheet
1089: .$addOther
1090: .'<span>'
1091: .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
1092: undef,undef,600)
1093: .'</span> <span>'
1094: .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
1095: undef,undef,600)
1096: .'</span>';
1.732 raeburn 1097: unless ($not_author) {
1.763 bisitz 1098: $out .= ' <span>'
1099: .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
1100: undef,undef,600)
1101: .'</span>';
1.732 raeburn 1102: }
1.763 bisitz 1103: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1104: return $out;
1.172 www 1105: }
1106:
1.430 albertel 1107: sub general_help {
1108: my $helptopic='Student_Intro';
1109: if ($env{'request.role'}=~/^(ca|au)/) {
1110: $helptopic='Authoring_Intro';
1111: } elsif ($env{'request.role'}=~/^cc/) {
1112: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1113: } elsif ($env{'request.role'}=~/^dc/) {
1114: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1115: }
1116: return $helptopic;
1117: }
1118:
1119: sub update_help_link {
1120: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1121: my $origurl = $ENV{'REQUEST_URI'};
1122: $origurl=~s|^/~|/priv/|;
1123: my $timestamp = time;
1124: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1125: $$datum = &escape($$datum);
1126: }
1127:
1128: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1129: my $output .= <<"ENDOUTPUT";
1130: <script type="text/javascript">
1.824 bisitz 1131: // <![CDATA[
1.430 albertel 1132: banner_link = '$banner_link';
1.824 bisitz 1133: // ]]>
1.430 albertel 1134: </script>
1135: ENDOUTPUT
1136: return $output;
1137: }
1138:
1139: # now just updates the help link and generates a blue icon
1.193 raeburn 1140: sub help_open_menu {
1.430 albertel 1141: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1142: = @_;
1.430 albertel 1143: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 1144: # only use pop-up help (stayOnPage == 0)
1.552 banghart 1145: # if environment.remote is on (using remote control UI)
1.798 tempelho 1146: if ($env{'environment.remote'} eq 'off' ) {
1.552 banghart 1147: $stayOnPage=1;
1.430 albertel 1148: }
1149: my $output;
1150: if ($component_help) {
1151: if (!$text) {
1152: $output=&help_open_topic($component_help,undef,$stayOnPage,
1153: $width,$height);
1154: } else {
1155: my $help_text;
1156: $help_text=&unescape($topic);
1157: $output='<table><tr><td>'.
1158: &help_open_topic($component_help,$help_text,$stayOnPage,
1159: $width,$height).'</td></tr></table>';
1160: }
1161: }
1162: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1163: return $output.$banner_link;
1164: }
1165:
1166: sub top_nav_help {
1167: my ($text) = @_;
1.436 albertel 1168: $text = &mt($text);
1.572 banghart 1169: my $stay_on_page =
1.798 tempelho 1170: ($env{'environment.remote'} eq 'off' );
1.572 banghart 1171: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1172: : "javascript:helpMenu('open')";
1.572 banghart 1173: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1174:
1.201 raeburn 1175: my $title = &mt('Get help');
1.436 albertel 1176:
1177: return <<"END";
1178: $banner_link
1179: <a href="$link" title="$title">$text</a>
1180: END
1181: }
1182:
1183: sub help_menu_js {
1184: my ($text) = @_;
1185:
1186: my $stayOnPage =
1.798 tempelho 1187: ($env{'environment.remote'} eq 'off' );
1.436 albertel 1188:
1189: my $width = 620;
1190: my $height = 600;
1.430 albertel 1191: my $helptopic=&general_help();
1192: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1193: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1194: my $start_page =
1195: &Apache::loncommon::start_page('Help Menu', undef,
1196: {'frameset' => 1,
1197: 'js_ready' => 1,
1198: 'add_entries' => {
1199: 'border' => '0',
1.579 raeburn 1200: 'rows' => "110,*",},});
1.331 albertel 1201: my $end_page =
1202: &Apache::loncommon::end_page({'frameset' => 1,
1203: 'js_ready' => 1,});
1204:
1.436 albertel 1205: my $template .= <<"ENDTEMPLATE";
1206: <script type="text/javascript">
1.877 bisitz 1207: // <![CDATA[
1.253 albertel 1208: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1209: var banner_link = '';
1.243 raeburn 1210: function helpMenu(target) {
1211: var caller = this;
1212: if (target == 'open') {
1213: var newWindow = null;
1214: try {
1.262 albertel 1215: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1216: }
1217: catch(error) {
1218: writeHelp(caller);
1219: return;
1220: }
1221: if (newWindow) {
1222: caller = newWindow;
1223: }
1.193 raeburn 1224: }
1.243 raeburn 1225: writeHelp(caller);
1226: return;
1227: }
1228: function writeHelp(caller) {
1.430 albertel 1229: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 1230: caller.document.close()
1231: caller.focus()
1.193 raeburn 1232: }
1.877 bisitz 1233: // END LON-CAPA Internal -->
1.253 albertel 1234: // ]]>
1.436 albertel 1235: </script>
1.193 raeburn 1236: ENDTEMPLATE
1237: return $template;
1238: }
1239:
1.172 www 1240: sub help_open_bug {
1241: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1242: unless ($env{'user.adv'}) { return ''; }
1.172 www 1243: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1244: $text = "" if (not defined $text);
1245: $stayOnPage = 0 if (not defined $stayOnPage);
1.798 tempelho 1246: if ($env{'environment.remote'} eq 'off' ) {
1.172 www 1247: $stayOnPage=1;
1248: }
1.184 albertel 1249: $width = 600 if (not defined $width);
1250: $height = 600 if (not defined $height);
1.172 www 1251:
1252: $topic=~s/\W+/\+/g;
1253: my $link='';
1254: my $template='';
1.379 albertel 1255: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1256: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1257: if (!$stayOnPage)
1258: {
1259: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1260: }
1261: else
1262: {
1263: $link = $url;
1264: }
1265: # Add the text
1266: if ($text ne "")
1267: {
1268: $template .=
1269: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1270: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1271: }
1272:
1273: # Add the graphic
1.179 matthew 1274: my $title = &mt('Report a Bug');
1.215 albertel 1275: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1276: $template .= <<"ENDTEMPLATE";
1.436 albertel 1277: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1278: ENDTEMPLATE
1279: if ($text ne '') { $template.='</td></tr></table>' };
1280: return $template;
1281:
1282: }
1283:
1284: sub help_open_faq {
1285: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1286: unless ($env{'user.adv'}) { return ''; }
1.172 www 1287: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1288: $text = "" if (not defined $text);
1289: $stayOnPage = 0 if (not defined $stayOnPage);
1.798 tempelho 1290: if ($env{'environment.remote'} eq 'off' ) {
1.172 www 1291: $stayOnPage=1;
1292: }
1293: $width = 350 if (not defined $width);
1294: $height = 400 if (not defined $height);
1295:
1296: $topic=~s/\W+/\+/g;
1297: my $link='';
1298: my $template='';
1299: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1300: if (!$stayOnPage)
1301: {
1302: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1303: }
1304: else
1305: {
1306: $link = $url;
1307: }
1308:
1309: # Add the text
1310: if ($text ne "")
1311: {
1312: $template .=
1.173 www 1313: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1314: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1315: }
1316:
1317: # Add the graphic
1.179 matthew 1318: my $title = &mt('View the FAQ');
1.215 albertel 1319: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1320: $template .= <<"ENDTEMPLATE";
1.436 albertel 1321: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1322: ENDTEMPLATE
1323: if ($text ne '') { $template.='</td></tr></table>' };
1324: return $template;
1325:
1.44 bowersj2 1326: }
1.37 matthew 1327:
1.180 matthew 1328: ###############################################################
1329: ###############################################################
1330:
1.45 matthew 1331: =pod
1332:
1.648 raeburn 1333: =item * &change_content_javascript():
1.256 matthew 1334:
1335: This and the next function allow you to create small sections of an
1336: otherwise static HTML page that you can update on the fly with
1337: Javascript, even in Netscape 4.
1338:
1339: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1340: must be written to the HTML page once. It will prove the Javascript
1341: function "change(name, content)". Calling the change function with the
1342: name of the section
1343: you want to update, matching the name passed to C<changable_area>, and
1344: the new content you want to put in there, will put the content into
1345: that area.
1346:
1347: B<Note>: Netscape 4 only reserves enough space for the changable area
1348: to contain room for the original contents. You need to "make space"
1349: for whatever changes you wish to make, and be B<sure> to check your
1350: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1351: it's adequate for updating a one-line status display, but little more.
1352: This script will set the space to 100% width, so you only need to
1353: worry about height in Netscape 4.
1354:
1355: Modern browsers are much less limiting, and if you can commit to the
1356: user not using Netscape 4, this feature may be used freely with
1357: pretty much any HTML.
1358:
1359: =cut
1360:
1361: sub change_content_javascript {
1362: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1363: if ($env{'browser.type'} eq 'netscape' &&
1364: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1365: return (<<NETSCAPE4);
1366: function change(name, content) {
1367: doc = document.layers[name+"___escape"].layers[0].document;
1368: doc.open();
1369: doc.write(content);
1370: doc.close();
1371: }
1372: NETSCAPE4
1373: } else {
1374: # Otherwise, we need to use semi-standards-compliant code
1375: # (technically, "innerHTML" isn't standard but the equivalent
1376: # is really scary, and every useful browser supports it
1377: return (<<DOMBASED);
1378: function change(name, content) {
1379: element = document.getElementById(name);
1380: element.innerHTML = content;
1381: }
1382: DOMBASED
1383: }
1384: }
1385:
1386: =pod
1387:
1.648 raeburn 1388: =item * &changable_area($name,$origContent):
1.256 matthew 1389:
1390: This provides a "changable area" that can be modified on the fly via
1391: the Javascript code provided in C<change_content_javascript>. $name is
1392: the name you will use to reference the area later; do not repeat the
1393: same name on a given HTML page more then once. $origContent is what
1394: the area will originally contain, which can be left blank.
1395:
1396: =cut
1397:
1398: sub changable_area {
1399: my ($name, $origContent) = @_;
1400:
1.258 albertel 1401: if ($env{'browser.type'} eq 'netscape' &&
1402: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1403: # If this is netscape 4, we need to use the Layer tag
1404: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1405: } else {
1406: return "<span id='$name'>$origContent</span>";
1407: }
1408: }
1409:
1410: =pod
1411:
1.648 raeburn 1412: =item * &viewport_geometry_js
1.590 raeburn 1413:
1414: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1415:
1416: =cut
1417:
1418:
1419: sub viewport_geometry_js {
1420: return <<"GEOMETRY";
1421: var Geometry = {};
1422: function init_geometry() {
1423: if (Geometry.init) { return };
1424: Geometry.init=1;
1425: if (window.innerHeight) {
1426: Geometry.getViewportHeight = function() { return window.innerHeight; };
1427: Geometry.getViewportWidth = function() { return window.innerWidth; };
1428: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1429: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1430: }
1431: else if (document.documentElement && document.documentElement.clientHeight) {
1432: Geometry.getViewportHeight =
1433: function() { return document.documentElement.clientHeight; };
1434: Geometry.getViewportWidth =
1435: function() { return document.documentElement.clientWidth; };
1436:
1437: Geometry.getHorizontalScroll =
1438: function() { return document.documentElement.scrollLeft; };
1439: Geometry.getVerticalScroll =
1440: function() { return document.documentElement.scrollTop; };
1441: }
1442: else if (document.body.clientHeight) {
1443: Geometry.getViewportHeight =
1444: function() { return document.body.clientHeight; };
1445: Geometry.getViewportWidth =
1446: function() { return document.body.clientWidth; };
1447: Geometry.getHorizontalScroll =
1448: function() { return document.body.scrollLeft; };
1449: Geometry.getVerticalScroll =
1450: function() { return document.body.scrollTop; };
1451: }
1452: }
1453:
1454: GEOMETRY
1455: }
1456:
1457: =pod
1458:
1.648 raeburn 1459: =item * &viewport_size_js()
1.590 raeburn 1460:
1461: 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.
1462:
1463: =cut
1464:
1465: sub viewport_size_js {
1466: my $geometry = &viewport_geometry_js();
1467: return <<"DIMS";
1468:
1469: $geometry
1470:
1471: function getViewportDims(width,height) {
1472: init_geometry();
1473: width.value = Geometry.getViewportWidth();
1474: height.value = Geometry.getViewportHeight();
1475: return;
1476: }
1477:
1478: DIMS
1479: }
1480:
1481: =pod
1482:
1.648 raeburn 1483: =item * &resize_textarea_js()
1.565 albertel 1484:
1485: emits the needed javascript to resize a textarea to be as big as possible
1486:
1487: creates a function resize_textrea that takes two IDs first should be
1488: the id of the element to resize, second should be the id of a div that
1489: surrounds everything that comes after the textarea, this routine needs
1490: to be attached to the <body> for the onload and onresize events.
1491:
1.648 raeburn 1492: =back
1.565 albertel 1493:
1494: =cut
1495:
1496: sub resize_textarea_js {
1.590 raeburn 1497: my $geometry = &viewport_geometry_js();
1.565 albertel 1498: return <<"RESIZE";
1499: <script type="text/javascript">
1.824 bisitz 1500: // <![CDATA[
1.590 raeburn 1501: $geometry
1.565 albertel 1502:
1.588 albertel 1503: function getX(element) {
1504: var x = 0;
1505: while (element) {
1506: x += element.offsetLeft;
1507: element = element.offsetParent;
1508: }
1509: return x;
1510: }
1511: function getY(element) {
1512: var y = 0;
1513: while (element) {
1514: y += element.offsetTop;
1515: element = element.offsetParent;
1516: }
1517: return y;
1518: }
1519:
1520:
1.565 albertel 1521: function resize_textarea(textarea_id,bottom_id) {
1522: init_geometry();
1523: var textarea = document.getElementById(textarea_id);
1524: //alert(textarea);
1525:
1.588 albertel 1526: var textarea_top = getY(textarea);
1.565 albertel 1527: var textarea_height = textarea.offsetHeight;
1528: var bottom = document.getElementById(bottom_id);
1.588 albertel 1529: var bottom_top = getY(bottom);
1.565 albertel 1530: var bottom_height = bottom.offsetHeight;
1531: var window_height = Geometry.getViewportHeight();
1.588 albertel 1532: var fudge = 23;
1.565 albertel 1533: var new_height = window_height-fudge-textarea_top-bottom_height;
1534: if (new_height < 300) {
1535: new_height = 300;
1536: }
1537: textarea.style.height=new_height+'px';
1538: }
1.824 bisitz 1539: // ]]>
1.565 albertel 1540: </script>
1541: RESIZE
1542:
1543: }
1544:
1545: =pod
1546:
1.256 matthew 1547: =head1 Excel and CSV file utility routines
1548:
1549: =over 4
1550:
1551: =cut
1552:
1553: ###############################################################
1554: ###############################################################
1555:
1556: =pod
1557:
1.648 raeburn 1558: =item * &csv_translate($text)
1.37 matthew 1559:
1.185 www 1560: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1561: format.
1562:
1563: =cut
1564:
1.180 matthew 1565: ###############################################################
1566: ###############################################################
1.37 matthew 1567: sub csv_translate {
1568: my $text = shift;
1569: $text =~ s/\"/\"\"/g;
1.209 albertel 1570: $text =~ s/\n/ /g;
1.37 matthew 1571: return $text;
1572: }
1.180 matthew 1573:
1574: ###############################################################
1575: ###############################################################
1576:
1577: =pod
1578:
1.648 raeburn 1579: =item * &define_excel_formats()
1.180 matthew 1580:
1581: Define some commonly used Excel cell formats.
1582:
1583: Currently supported formats:
1584:
1585: =over 4
1586:
1587: =item header
1588:
1589: =item bold
1590:
1591: =item h1
1592:
1593: =item h2
1594:
1595: =item h3
1596:
1.256 matthew 1597: =item h4
1598:
1599: =item i
1600:
1.180 matthew 1601: =item date
1602:
1603: =back
1604:
1605: Inputs: $workbook
1606:
1607: Returns: $format, a hash reference.
1608:
1609: =cut
1610:
1611: ###############################################################
1612: ###############################################################
1613: sub define_excel_formats {
1614: my ($workbook) = @_;
1615: my $format;
1616: $format->{'header'} = $workbook->add_format(bold => 1,
1617: bottom => 1,
1618: align => 'center');
1619: $format->{'bold'} = $workbook->add_format(bold=>1);
1620: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1621: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1622: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1623: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1624: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1625: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1626: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1627: return $format;
1628: }
1629:
1630: ###############################################################
1631: ###############################################################
1.113 bowersj2 1632:
1633: =pod
1634:
1.648 raeburn 1635: =item * &create_workbook()
1.255 matthew 1636:
1637: Create an Excel worksheet. If it fails, output message on the
1638: request object and return undefs.
1639:
1640: Inputs: Apache request object
1641:
1642: Returns (undef) on failure,
1643: Excel worksheet object, scalar with filename, and formats
1644: from &Apache::loncommon::define_excel_formats on success
1645:
1646: =cut
1647:
1648: ###############################################################
1649: ###############################################################
1650: sub create_workbook {
1651: my ($r) = @_;
1652: #
1653: # Create the excel spreadsheet
1654: my $filename = '/prtspool/'.
1.258 albertel 1655: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1656: time.'_'.rand(1000000000).'.xls';
1657: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1658: if (! defined($workbook)) {
1659: $r->log_error("Error creating excel spreadsheet $filename: $!");
1660: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1661: "This error has been logged. ".
1662: "Please alert your LON-CAPA administrator").
1663: '</p>');
1664: return (undef);
1665: }
1666: #
1667: $workbook->set_tempdir('/home/httpd/perl/tmp');
1668: #
1669: my $format = &Apache::loncommon::define_excel_formats($workbook);
1670: return ($workbook,$filename,$format);
1671: }
1672:
1673: ###############################################################
1674: ###############################################################
1675:
1676: =pod
1677:
1.648 raeburn 1678: =item * &create_text_file()
1.113 bowersj2 1679:
1.542 raeburn 1680: Create a file to write to and eventually make available to the user.
1.256 matthew 1681: If file creation fails, outputs an error message on the request object and
1682: return undefs.
1.113 bowersj2 1683:
1.256 matthew 1684: Inputs: Apache request object, and file suffix
1.113 bowersj2 1685:
1.256 matthew 1686: Returns (undef) on failure,
1687: Filehandle and filename on success.
1.113 bowersj2 1688:
1689: =cut
1690:
1.256 matthew 1691: ###############################################################
1692: ###############################################################
1693: sub create_text_file {
1694: my ($r,$suffix) = @_;
1695: if (! defined($suffix)) { $suffix = 'txt'; };
1696: my $fh;
1697: my $filename = '/prtspool/'.
1.258 albertel 1698: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1699: time.'_'.rand(1000000000).'.'.$suffix;
1700: $fh = Apache::File->new('>/home/httpd'.$filename);
1701: if (! defined($fh)) {
1702: $r->log_error("Couldn't open $filename for output $!");
1.683 bisitz 1703: $r->print(&mt('Problems occurred in creating the output file. '
1704: .'This error has been logged. '
1705: .'Please alert your LON-CAPA administrator.'));
1.113 bowersj2 1706: }
1.256 matthew 1707: return ($fh,$filename)
1.113 bowersj2 1708: }
1709:
1710:
1.256 matthew 1711: =pod
1.113 bowersj2 1712:
1713: =back
1714:
1715: =cut
1.37 matthew 1716:
1717: ###############################################################
1.33 matthew 1718: ## Home server <option> list generating code ##
1719: ###############################################################
1.35 matthew 1720:
1.169 www 1721: # ------------------------------------------
1722:
1723: sub domain_select {
1724: my ($name,$value,$multiple)=@_;
1725: my %domains=map {
1.514 albertel 1726: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1727: } &Apache::lonnet::all_domains();
1.169 www 1728: if ($multiple) {
1729: $domains{''}=&mt('Any domain');
1.550 albertel 1730: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1731: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1732: } else {
1.550 albertel 1733: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1734: return &select_form($name,$value,%domains);
1735: }
1736: }
1737:
1.282 albertel 1738: #-------------------------------------------
1739:
1740: =pod
1741:
1.519 raeburn 1742: =head1 Routines for form select boxes
1743:
1744: =over 4
1745:
1.648 raeburn 1746: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1747:
1748: Returns a string containing a <select> element int multiple mode
1749:
1750:
1751: Args:
1752: $name - name of the <select> element
1.506 raeburn 1753: $value - scalar or array ref of values that should already be selected
1.282 albertel 1754: $size - number of rows long the select element is
1.283 albertel 1755: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1756: (shown text should already have been &mt())
1.506 raeburn 1757: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1758:
1.282 albertel 1759: =cut
1760:
1761: #-------------------------------------------
1.169 www 1762: sub multiple_select_form {
1.284 albertel 1763: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1764: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1765: my $output='';
1.191 matthew 1766: if (! defined($size)) {
1767: $size = 4;
1.283 albertel 1768: if (scalar(keys(%$hash))<4) {
1769: $size = scalar(keys(%$hash));
1.191 matthew 1770: }
1771: }
1.734 bisitz 1772: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1773: my @order;
1.506 raeburn 1774: if (ref($order) eq 'ARRAY') {
1775: @order = @{$order};
1776: } else {
1777: @order = sort(keys(%$hash));
1.501 banghart 1778: }
1779: if (exists($$hash{'select_form_order'})) {
1780: @order = @{$$hash{'select_form_order'}};
1781: }
1782:
1.284 albertel 1783: foreach my $key (@order) {
1.356 albertel 1784: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1785: $output.='selected="selected" ' if ($selected{$key});
1786: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1787: }
1788: $output.="</select>\n";
1789: return $output;
1790: }
1791:
1.88 www 1792: #-------------------------------------------
1793:
1794: =pod
1795:
1.648 raeburn 1796: =item * &select_form($defdom,$name,%hash)
1.88 www 1797:
1798: Returns a string containing a <select name='$name' size='1'> form to
1799: allow a user to select options from a hash option_name => displayed text.
1800: See lonrights.pm for an example invocation and use.
1801:
1802: =cut
1803:
1804: #-------------------------------------------
1805: sub select_form {
1806: my ($def,$name,%hash) = @_;
1807: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1808: my @keys;
1809: if (exists($hash{'select_form_order'})) {
1810: @keys=@{$hash{'select_form_order'}};
1811: } else {
1812: @keys=sort(keys(%hash));
1813: }
1.356 albertel 1814: foreach my $key (@keys) {
1815: $selectform.=
1816: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1817: ($key eq $def ? 'selected="selected" ' : '').
1818: ">".&mt($hash{$key})."</option>\n";
1.88 www 1819: }
1820: $selectform.="</select>";
1821: return $selectform;
1822: }
1823:
1.475 www 1824: # For display filters
1825:
1826: sub display_filter {
1827: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1828: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714 bisitz 1829: return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475 www 1830: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1831: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 1832: '</label></span> <span class="LC_nobreak">'.
1.475 www 1833: &mt('Filter [_1]',
1.477 www 1834: &select_form($env{'form.displayfilter'},
1835: 'displayfilter',
1836: ('currentfolder' => 'Current folder/page',
1837: 'containing' => 'Containing phrase',
1838: 'none' => 'None'))).
1.714 bisitz 1839: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475 www 1840: }
1841:
1.167 www 1842: sub gradeleveldescription {
1843: my $gradelevel=shift;
1844: my %gradelevels=(0 => 'Not specified',
1845: 1 => 'Grade 1',
1846: 2 => 'Grade 2',
1847: 3 => 'Grade 3',
1848: 4 => 'Grade 4',
1849: 5 => 'Grade 5',
1850: 6 => 'Grade 6',
1851: 7 => 'Grade 7',
1852: 8 => 'Grade 8',
1853: 9 => 'Grade 9',
1854: 10 => 'Grade 10',
1855: 11 => 'Grade 11',
1856: 12 => 'Grade 12',
1857: 13 => 'Grade 13',
1858: 14 => '100 Level',
1859: 15 => '200 Level',
1860: 16 => '300 Level',
1861: 17 => '400 Level',
1862: 18 => 'Graduate Level');
1863: return &mt($gradelevels{$gradelevel});
1864: }
1865:
1.163 www 1866: sub select_level_form {
1867: my ($deflevel,$name)=@_;
1868: unless ($deflevel) { $deflevel=0; }
1.167 www 1869: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1870: for (my $i=0; $i<=18; $i++) {
1871: $selectform.="<option value=\"$i\" ".
1.253 albertel 1872: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1873: ">".&gradeleveldescription($i)."</option>\n";
1874: }
1875: $selectform.="</select>";
1876: return $selectform;
1.163 www 1877: }
1.167 www 1878:
1.35 matthew 1879: #-------------------------------------------
1880:
1.45 matthew 1881: =pod
1882:
1.873 raeburn 1883: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange)
1.35 matthew 1884:
1885: Returns a string containing a <select name='$name' size='1'> form to
1886: allow a user to select the domain to preform an operation in.
1887: See loncreateuser.pm for an example invocation and use.
1888:
1.90 www 1889: If the $includeempty flag is set, it also includes an empty choice ("no domain
1890: selected");
1891:
1.743 raeburn 1892: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1893:
1.872 raeburn 1894: The optional $onchange argumnet 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 1895:
1.35 matthew 1896: =cut
1897:
1898: #-------------------------------------------
1.34 matthew 1899: sub select_dom_form {
1.872 raeburn 1900: my ($defdom,$name,$includeempty,$showdomdesc,$onchange) = @_;
1901: if ($onchange) {
1.874 raeburn 1902: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 1903: }
1.550 albertel 1904: my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1.90 www 1905: if ($includeempty) { @domains=('',@domains); }
1.743 raeburn 1906: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 1907: foreach my $dom (@domains) {
1908: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1909: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1910: if ($showdomdesc) {
1911: if ($dom ne '') {
1912: my $domdesc = &Apache::lonnet::domain($dom,'description');
1913: if ($domdesc ne '') {
1914: $selectdomain .= ' ('.$domdesc.')';
1915: }
1916: }
1917: }
1918: $selectdomain .= "</option>\n";
1.34 matthew 1919: }
1920: $selectdomain.="</select>";
1921: return $selectdomain;
1922: }
1923:
1.35 matthew 1924: #-------------------------------------------
1925:
1.45 matthew 1926: =pod
1927:
1.648 raeburn 1928: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 1929:
1.586 raeburn 1930: input: 4 arguments (two required, two optional) -
1931: $domain - domain of new user
1932: $name - name of form element
1933: $default - Value of 'default' causes a default item to be first
1934: option, and selected by default.
1935: $hide - Value of 'hide' causes hiding of the name of the server,
1936: if 1 server found, or default, if 0 found.
1.594 raeburn 1937: output: returns 2 items:
1.586 raeburn 1938: (a) form element which contains either:
1939: (i) <select name="$name">
1940: <option value="$hostid1">$hostid $servers{$hostid}</option>
1941: <option value="$hostid2">$hostid $servers{$hostid}</option>
1942: </select>
1943: form item if there are multiple library servers in $domain, or
1944: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
1945: if there is only one library server in $domain.
1946:
1947: (b) number of library servers found.
1948:
1949: See loncreateuser.pm for example of use.
1.35 matthew 1950:
1951: =cut
1952:
1953: #-------------------------------------------
1.586 raeburn 1954: sub home_server_form_item {
1955: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 1956: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 1957: my $result;
1958: my $numlib = keys(%servers);
1959: if ($numlib > 1) {
1960: $result .= '<select name="'.$name.'" />'."\n";
1961: if ($default) {
1.804 bisitz 1962: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 1963: '</option>'."\n";
1964: }
1965: foreach my $hostid (sort(keys(%servers))) {
1966: $result.= '<option value="'.$hostid.'">'.
1967: $hostid.' '.$servers{$hostid}."</option>\n";
1968: }
1969: $result .= '</select>'."\n";
1970: } elsif ($numlib == 1) {
1971: my $hostid;
1972: foreach my $item (keys(%servers)) {
1973: $hostid = $item;
1974: }
1975: $result .= '<input type="hidden" name="'.$name.'" value="'.
1976: $hostid.'" />';
1977: if (!$hide) {
1978: $result .= $hostid.' '.$servers{$hostid};
1979: }
1980: $result .= "\n";
1981: } elsif ($default) {
1982: $result .= '<input type="hidden" name="'.$name.
1983: '" value="default" />';
1984: if (!$hide) {
1985: $result .= &mt('default');
1986: }
1987: $result .= "\n";
1.33 matthew 1988: }
1.586 raeburn 1989: return ($result,$numlib);
1.33 matthew 1990: }
1.112 bowersj2 1991:
1992: =pod
1993:
1.534 albertel 1994: =back
1995:
1.112 bowersj2 1996: =cut
1.87 matthew 1997:
1998: ###############################################################
1.112 bowersj2 1999: ## Decoding User Agent ##
1.87 matthew 2000: ###############################################################
2001:
2002: =pod
2003:
1.112 bowersj2 2004: =head1 Decoding the User Agent
2005:
2006: =over 4
2007:
2008: =item * &decode_user_agent()
1.87 matthew 2009:
2010: Inputs: $r
2011:
2012: Outputs:
2013:
2014: =over 4
2015:
1.112 bowersj2 2016: =item * $httpbrowser
1.87 matthew 2017:
1.112 bowersj2 2018: =item * $clientbrowser
1.87 matthew 2019:
1.112 bowersj2 2020: =item * $clientversion
1.87 matthew 2021:
1.112 bowersj2 2022: =item * $clientmathml
1.87 matthew 2023:
1.112 bowersj2 2024: =item * $clientunicode
1.87 matthew 2025:
1.112 bowersj2 2026: =item * $clientos
1.87 matthew 2027:
2028: =back
2029:
1.157 matthew 2030: =back
2031:
1.87 matthew 2032: =cut
2033:
2034: ###############################################################
2035: ###############################################################
2036: sub decode_user_agent {
1.247 albertel 2037: my ($r)=@_;
1.87 matthew 2038: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2039: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2040: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2041: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2042: my $clientbrowser='unknown';
2043: my $clientversion='0';
2044: my $clientmathml='';
2045: my $clientunicode='0';
2046: for (my $i=0;$i<=$#browsertype;$i++) {
2047: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2048: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2049: $clientbrowser=$bname;
2050: $httpbrowser=~/$vreg/i;
2051: $clientversion=$1;
2052: $clientmathml=($clientversion>=$minv);
2053: $clientunicode=($clientversion>=$univ);
2054: }
2055: }
2056: my $clientos='unknown';
2057: if (($httpbrowser=~/linux/i) ||
2058: ($httpbrowser=~/unix/i) ||
2059: ($httpbrowser=~/ux/i) ||
2060: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2061: if (($httpbrowser=~/vax/i) ||
2062: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2063: if ($httpbrowser=~/next/i) { $clientos='next'; }
2064: if (($httpbrowser=~/mac/i) ||
2065: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2066: if ($httpbrowser=~/win/i) { $clientos='win'; }
2067: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2068: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2069: $clientunicode,$clientos,);
2070: }
2071:
1.32 matthew 2072: ###############################################################
2073: ## Authentication changing form generation subroutines ##
2074: ###############################################################
2075: ##
2076: ## All of the authform_xxxxxxx subroutines take their inputs in a
2077: ## hash, and have reasonable default values.
2078: ##
2079: ## formname = the name given in the <form> tag.
1.35 matthew 2080: #-------------------------------------------
2081:
1.45 matthew 2082: =pod
2083:
1.112 bowersj2 2084: =head1 Authentication Routines
2085:
2086: =over 4
2087:
1.648 raeburn 2088: =item * &authform_xxxxxx()
1.35 matthew 2089:
2090: The authform_xxxxxx subroutines provide javascript and html forms which
2091: handle some of the conveniences required for authentication forms.
2092: This is not an optimal method, but it works.
2093:
2094: =over 4
2095:
1.112 bowersj2 2096: =item * authform_header
1.35 matthew 2097:
1.112 bowersj2 2098: =item * authform_authorwarning
1.35 matthew 2099:
1.112 bowersj2 2100: =item * authform_nochange
1.35 matthew 2101:
1.112 bowersj2 2102: =item * authform_kerberos
1.35 matthew 2103:
1.112 bowersj2 2104: =item * authform_internal
1.35 matthew 2105:
1.112 bowersj2 2106: =item * authform_filesystem
1.35 matthew 2107:
2108: =back
2109:
1.648 raeburn 2110: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2111:
1.35 matthew 2112: =cut
2113:
2114: #-------------------------------------------
1.32 matthew 2115: sub authform_header{
2116: my %in = (
2117: formname => 'cu',
1.80 albertel 2118: kerb_def_dom => '',
1.32 matthew 2119: @_,
2120: );
2121: $in{'formname'} = 'document.' . $in{'formname'};
2122: my $result='';
1.80 albertel 2123:
2124: #---------------------------------------------- Code for upper case translation
2125: my $Javascript_toUpperCase;
2126: unless ($in{kerb_def_dom}) {
2127: $Javascript_toUpperCase =<<"END";
2128: switch (choice) {
2129: case 'krb': currentform.elements[choicearg].value =
2130: currentform.elements[choicearg].value.toUpperCase();
2131: break;
2132: default:
2133: }
2134: END
2135: } else {
2136: $Javascript_toUpperCase = "";
2137: }
2138:
1.165 raeburn 2139: my $radioval = "'nochange'";
1.591 raeburn 2140: if (defined($in{'curr_authtype'})) {
2141: if ($in{'curr_authtype'} ne '') {
2142: $radioval = "'".$in{'curr_authtype'}."arg'";
2143: }
1.174 matthew 2144: }
1.165 raeburn 2145: my $argfield = 'null';
1.591 raeburn 2146: if (defined($in{'mode'})) {
1.165 raeburn 2147: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2148: if (defined($in{'curr_autharg'})) {
2149: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2150: $argfield = "'$in{'curr_autharg'}'";
2151: }
2152: }
2153: }
2154: }
2155:
1.32 matthew 2156: $result.=<<"END";
2157: var current = new Object();
1.165 raeburn 2158: current.radiovalue = $radioval;
2159: current.argfield = $argfield;
1.32 matthew 2160:
2161: function changed_radio(choice,currentform) {
2162: var choicearg = choice + 'arg';
2163: // If a radio button in changed, we need to change the argfield
2164: if (current.radiovalue != choice) {
2165: current.radiovalue = choice;
2166: if (current.argfield != null) {
2167: currentform.elements[current.argfield].value = '';
2168: }
2169: if (choice == 'nochange') {
2170: current.argfield = null;
2171: } else {
2172: current.argfield = choicearg;
2173: switch(choice) {
2174: case 'krb':
2175: currentform.elements[current.argfield].value =
2176: "$in{'kerb_def_dom'}";
2177: break;
2178: default:
2179: break;
2180: }
2181: }
2182: }
2183: return;
2184: }
1.22 www 2185:
1.32 matthew 2186: function changed_text(choice,currentform) {
2187: var choicearg = choice + 'arg';
2188: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2189: $Javascript_toUpperCase
1.32 matthew 2190: // clear old field
2191: if ((current.argfield != choicearg) && (current.argfield != null)) {
2192: currentform.elements[current.argfield].value = '';
2193: }
2194: current.argfield = choicearg;
2195: }
2196: set_auth_radio_buttons(choice,currentform);
2197: return;
1.20 www 2198: }
1.32 matthew 2199:
2200: function set_auth_radio_buttons(newvalue,currentform) {
2201: var i=0;
2202: while (i < currentform.login.length) {
2203: if (currentform.login[i].value == newvalue) { break; }
2204: i++;
2205: }
2206: if (i == currentform.login.length) {
2207: return;
2208: }
2209: current.radiovalue = newvalue;
2210: currentform.login[i].checked = true;
2211: return;
2212: }
2213: END
2214: return $result;
2215: }
2216:
2217: sub authform_authorwarning{
2218: my $result='';
1.144 matthew 2219: $result='<i>'.
2220: &mt('As a general rule, only authors or co-authors should be '.
2221: 'filesystem authenticated '.
2222: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2223: return $result;
2224: }
2225:
2226: sub authform_nochange{
2227: my %in = (
2228: formname => 'document.cu',
2229: kerb_def_dom => 'MSU.EDU',
2230: @_,
2231: );
1.586 raeburn 2232: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2233: my $result;
2234: if (keys(%can_assign) == 0) {
2235: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2236: } else {
2237: $result = '<label>'.&mt('[_1] Do not change login data',
2238: '<input type="radio" name="login" value="nochange" '.
2239: 'checked="checked" onclick="'.
1.281 albertel 2240: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2241: '</label>';
1.586 raeburn 2242: }
1.32 matthew 2243: return $result;
2244: }
2245:
1.591 raeburn 2246: sub authform_kerberos {
1.32 matthew 2247: my %in = (
2248: formname => 'document.cu',
2249: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2250: kerb_def_auth => 'krb4',
1.32 matthew 2251: @_,
2252: );
1.586 raeburn 2253: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2254: $autharg,$jscall);
2255: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2256: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2257: $check5 = ' checked="checked"';
1.80 albertel 2258: } else {
1.772 bisitz 2259: $check4 = ' checked="checked"';
1.80 albertel 2260: }
1.165 raeburn 2261: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2262: if (defined($in{'curr_authtype'})) {
2263: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2264: $krbcheck = ' checked="checked"';
1.623 raeburn 2265: if (defined($in{'mode'})) {
2266: if ($in{'mode'} eq 'modifyuser') {
2267: $krbcheck = '';
2268: }
2269: }
1.591 raeburn 2270: if (defined($in{'curr_kerb_ver'})) {
2271: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2272: $check5 = ' checked="checked"';
1.591 raeburn 2273: $check4 = '';
2274: } else {
1.772 bisitz 2275: $check4 = ' checked="checked"';
1.591 raeburn 2276: $check5 = '';
2277: }
1.586 raeburn 2278: }
1.591 raeburn 2279: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2280: $krbarg = $in{'curr_autharg'};
2281: }
1.586 raeburn 2282: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2283: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2284: $result =
2285: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2286: $in{'curr_autharg'},$krbver);
2287: } else {
2288: $result =
2289: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2290: }
2291: return $result;
2292: }
2293: }
2294: } else {
2295: if ($authnum == 1) {
1.784 bisitz 2296: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2297: }
2298: }
1.586 raeburn 2299: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2300: return;
1.587 raeburn 2301: } elsif ($authtype eq '') {
1.591 raeburn 2302: if (defined($in{'mode'})) {
1.587 raeburn 2303: if ($in{'mode'} eq 'modifycourse') {
2304: if ($authnum == 1) {
1.784 bisitz 2305: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2306: }
2307: }
2308: }
1.586 raeburn 2309: }
2310: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2311: if ($authtype eq '') {
2312: $authtype = '<input type="radio" name="login" value="krb" '.
2313: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2314: $krbcheck.' />';
2315: }
2316: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2317: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2318: $in{'curr_authtype'} eq 'krb5') ||
2319: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2320: $in{'curr_authtype'} eq 'krb4')) {
2321: $result .= &mt
1.144 matthew 2322: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2323: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2324: '<label>'.$authtype,
1.281 albertel 2325: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2326: 'value="'.$krbarg.'" '.
1.144 matthew 2327: 'onchange="'.$jscall.'" />',
1.281 albertel 2328: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2329: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2330: '</label>');
1.586 raeburn 2331: } elsif ($can_assign{'krb4'}) {
2332: $result .= &mt
2333: ('[_1] Kerberos authenticated with domain [_2] '.
2334: '[_3] Version 4 [_4]',
2335: '<label>'.$authtype,
2336: '</label><input type="text" size="10" name="krbarg" '.
2337: 'value="'.$krbarg.'" '.
2338: 'onchange="'.$jscall.'" />',
2339: '<label><input type="hidden" name="krbver" value="4" />',
2340: '</label>');
2341: } elsif ($can_assign{'krb5'}) {
2342: $result .= &mt
2343: ('[_1] Kerberos authenticated with domain [_2] '.
2344: '[_3] Version 5 [_4]',
2345: '<label>'.$authtype,
2346: '</label><input type="text" size="10" name="krbarg" '.
2347: 'value="'.$krbarg.'" '.
2348: 'onchange="'.$jscall.'" />',
2349: '<label><input type="hidden" name="krbver" value="5" />',
2350: '</label>');
2351: }
1.32 matthew 2352: return $result;
2353: }
2354:
2355: sub authform_internal{
1.586 raeburn 2356: my %in = (
1.32 matthew 2357: formname => 'document.cu',
2358: kerb_def_dom => 'MSU.EDU',
2359: @_,
2360: );
1.586 raeburn 2361: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2362: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2363: if (defined($in{'curr_authtype'})) {
2364: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2365: if ($can_assign{'int'}) {
1.772 bisitz 2366: $intcheck = 'checked="checked" ';
1.623 raeburn 2367: if (defined($in{'mode'})) {
2368: if ($in{'mode'} eq 'modifyuser') {
2369: $intcheck = '';
2370: }
2371: }
1.591 raeburn 2372: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2373: $intarg = $in{'curr_autharg'};
2374: }
2375: } else {
2376: $result = &mt('Currently internally authenticated.');
2377: return $result;
1.165 raeburn 2378: }
2379: }
1.586 raeburn 2380: } else {
2381: if ($authnum == 1) {
1.784 bisitz 2382: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2383: }
2384: }
2385: if (!$can_assign{'int'}) {
2386: return;
1.587 raeburn 2387: } elsif ($authtype eq '') {
1.591 raeburn 2388: if (defined($in{'mode'})) {
1.587 raeburn 2389: if ($in{'mode'} eq 'modifycourse') {
2390: if ($authnum == 1) {
1.784 bisitz 2391: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2392: }
2393: }
2394: }
1.165 raeburn 2395: }
1.586 raeburn 2396: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2397: if ($authtype eq '') {
2398: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2399: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2400: }
1.605 bisitz 2401: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2402: $intarg.'" onchange="'.$jscall.'" />';
2403: $result = &mt
1.144 matthew 2404: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2405: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2406: $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 2407: return $result;
2408: }
2409:
2410: sub authform_local{
2411: my %in = (
2412: formname => 'document.cu',
2413: kerb_def_dom => 'MSU.EDU',
2414: @_,
2415: );
1.586 raeburn 2416: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2417: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2418: if (defined($in{'curr_authtype'})) {
2419: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2420: if ($can_assign{'loc'}) {
1.772 bisitz 2421: $loccheck = 'checked="checked" ';
1.623 raeburn 2422: if (defined($in{'mode'})) {
2423: if ($in{'mode'} eq 'modifyuser') {
2424: $loccheck = '';
2425: }
2426: }
1.591 raeburn 2427: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2428: $locarg = $in{'curr_autharg'};
2429: }
2430: } else {
2431: $result = &mt('Currently using local (institutional) authentication.');
2432: return $result;
1.165 raeburn 2433: }
2434: }
1.586 raeburn 2435: } else {
2436: if ($authnum == 1) {
1.784 bisitz 2437: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2438: }
2439: }
2440: if (!$can_assign{'loc'}) {
2441: return;
1.587 raeburn 2442: } elsif ($authtype eq '') {
1.591 raeburn 2443: if (defined($in{'mode'})) {
1.587 raeburn 2444: if ($in{'mode'} eq 'modifycourse') {
2445: if ($authnum == 1) {
1.784 bisitz 2446: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2447: }
2448: }
2449: }
1.165 raeburn 2450: }
1.586 raeburn 2451: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2452: if ($authtype eq '') {
2453: $authtype = '<input type="radio" name="login" value="loc" '.
2454: $loccheck.' onchange="'.$jscall.'" onclick="'.
2455: $jscall.'" />';
2456: }
2457: $autharg = '<input type="text" size="10" name="locarg" value="'.
2458: $locarg.'" onchange="'.$jscall.'" />';
2459: $result = &mt('[_1] Local Authentication with argument [_2]',
2460: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2461: return $result;
2462: }
2463:
2464: sub authform_filesystem{
2465: my %in = (
2466: formname => 'document.cu',
2467: kerb_def_dom => 'MSU.EDU',
2468: @_,
2469: );
1.586 raeburn 2470: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2471: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2472: if (defined($in{'curr_authtype'})) {
2473: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2474: if ($can_assign{'fsys'}) {
1.772 bisitz 2475: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2476: if (defined($in{'mode'})) {
2477: if ($in{'mode'} eq 'modifyuser') {
2478: $fsyscheck = '';
2479: }
2480: }
1.586 raeburn 2481: } else {
2482: $result = &mt('Currently Filesystem Authenticated.');
2483: return $result;
2484: }
2485: }
2486: } else {
2487: if ($authnum == 1) {
1.784 bisitz 2488: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2489: }
2490: }
2491: if (!$can_assign{'fsys'}) {
2492: return;
1.587 raeburn 2493: } elsif ($authtype eq '') {
1.591 raeburn 2494: if (defined($in{'mode'})) {
1.587 raeburn 2495: if ($in{'mode'} eq 'modifycourse') {
2496: if ($authnum == 1) {
1.784 bisitz 2497: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2498: }
2499: }
2500: }
1.586 raeburn 2501: }
2502: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2503: if ($authtype eq '') {
2504: $authtype = '<input type="radio" name="login" value="fsys" '.
2505: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2506: $jscall.'" />';
2507: }
2508: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2509: ' onchange="'.$jscall.'" />';
2510: $result = &mt
1.144 matthew 2511: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2512: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2513: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2514: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2515: 'onchange="'.$jscall.'" />');
1.32 matthew 2516: return $result;
2517: }
2518:
1.586 raeburn 2519: sub get_assignable_auth {
2520: my ($dom) = @_;
2521: if ($dom eq '') {
2522: $dom = $env{'request.role.domain'};
2523: }
2524: my %can_assign = (
2525: krb4 => 1,
2526: krb5 => 1,
2527: int => 1,
2528: loc => 1,
2529: );
2530: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2531: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2532: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2533: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2534: my $context;
2535: if ($env{'request.role'} =~ /^au/) {
2536: $context = 'author';
2537: } elsif ($env{'request.role'} =~ /^dc/) {
2538: $context = 'domain';
2539: } elsif ($env{'request.course.id'}) {
2540: $context = 'course';
2541: }
2542: if ($context) {
2543: if (ref($authhash->{$context}) eq 'HASH') {
2544: %can_assign = %{$authhash->{$context}};
2545: }
2546: }
2547: }
2548: }
2549: my $authnum = 0;
2550: foreach my $key (keys(%can_assign)) {
2551: if ($can_assign{$key}) {
2552: $authnum ++;
2553: }
2554: }
2555: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2556: $authnum --;
2557: }
2558: return ($authnum,%can_assign);
2559: }
2560:
1.80 albertel 2561: ###############################################################
2562: ## Get Kerberos Defaults for Domain ##
2563: ###############################################################
2564: ##
2565: ## Returns default kerberos version and an associated argument
2566: ## as listed in file domain.tab. If not listed, provides
2567: ## appropriate default domain and kerberos version.
2568: ##
2569: #-------------------------------------------
2570:
2571: =pod
2572:
1.648 raeburn 2573: =item * &get_kerberos_defaults()
1.80 albertel 2574:
2575: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2576: version and domain. If not found, it defaults to version 4 and the
2577: domain of the server.
1.80 albertel 2578:
1.648 raeburn 2579: =over 4
2580:
1.80 albertel 2581: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2582:
1.648 raeburn 2583: =back
2584:
2585: =back
2586:
1.80 albertel 2587: =cut
2588:
2589: #-------------------------------------------
2590: sub get_kerberos_defaults {
2591: my $domain=shift;
1.641 raeburn 2592: my ($krbdef,$krbdefdom);
2593: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2594: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2595: $krbdef = $domdefaults{'auth_def'};
2596: $krbdefdom = $domdefaults{'auth_arg_def'};
2597: } else {
1.80 albertel 2598: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2599: my $krbdefdom=$1;
2600: $krbdefdom=~tr/a-z/A-Z/;
2601: $krbdef = "krb4";
2602: }
2603: return ($krbdef,$krbdefdom);
2604: }
1.112 bowersj2 2605:
1.32 matthew 2606:
1.46 matthew 2607: ###############################################################
2608: ## Thesaurus Functions ##
2609: ###############################################################
1.20 www 2610:
1.46 matthew 2611: =pod
1.20 www 2612:
1.112 bowersj2 2613: =head1 Thesaurus Functions
2614:
2615: =over 4
2616:
1.648 raeburn 2617: =item * &initialize_keywords()
1.46 matthew 2618:
2619: Initializes the package variable %Keywords if it is empty. Uses the
2620: package variable $thesaurus_db_file.
2621:
2622: =cut
2623:
2624: ###################################################
2625:
2626: sub initialize_keywords {
2627: return 1 if (scalar keys(%Keywords));
2628: # If we are here, %Keywords is empty, so fill it up
2629: # Make sure the file we need exists...
2630: if (! -e $thesaurus_db_file) {
2631: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2632: " failed because it does not exist");
2633: return 0;
2634: }
2635: # Set up the hash as a database
2636: my %thesaurus_db;
2637: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2638: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2639: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2640: $thesaurus_db_file);
2641: return 0;
2642: }
2643: # Get the average number of appearances of a word.
2644: my $avecount = $thesaurus_db{'average.count'};
2645: # Put keywords (those that appear > average) into %Keywords
2646: while (my ($word,$data)=each (%thesaurus_db)) {
2647: my ($count,undef) = split /:/,$data;
2648: $Keywords{$word}++ if ($count > $avecount);
2649: }
2650: untie %thesaurus_db;
2651: # Remove special values from %Keywords.
1.356 albertel 2652: foreach my $value ('total.count','average.count') {
2653: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2654: }
1.46 matthew 2655: return 1;
2656: }
2657:
2658: ###################################################
2659:
2660: =pod
2661:
1.648 raeburn 2662: =item * &keyword($word)
1.46 matthew 2663:
2664: Returns true if $word is a keyword. A keyword is a word that appears more
2665: than the average number of times in the thesaurus database. Calls
2666: &initialize_keywords
2667:
2668: =cut
2669:
2670: ###################################################
1.20 www 2671:
2672: sub keyword {
1.46 matthew 2673: return if (!&initialize_keywords());
2674: my $word=lc(shift());
2675: $word=~s/\W//g;
2676: return exists($Keywords{$word});
1.20 www 2677: }
1.46 matthew 2678:
2679: ###############################################################
2680:
2681: =pod
1.20 www 2682:
1.648 raeburn 2683: =item * &get_related_words()
1.46 matthew 2684:
1.160 matthew 2685: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2686: an array of words. If the keyword is not in the thesaurus, an empty array
2687: will be returned. The order of the words returned is determined by the
2688: database which holds them.
2689:
2690: Uses global $thesaurus_db_file.
2691:
2692: =cut
2693:
2694: ###############################################################
2695: sub get_related_words {
2696: my $keyword = shift;
2697: my %thesaurus_db;
2698: if (! -e $thesaurus_db_file) {
2699: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2700: "failed because the file does not exist");
2701: return ();
2702: }
2703: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2704: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2705: return ();
2706: }
2707: my @Words=();
1.429 www 2708: my $count=0;
1.46 matthew 2709: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2710: # The first element is the number of times
2711: # the word appears. We do not need it now.
1.429 www 2712: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2713: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2714: my $threshold=$mostfrequentcount/10;
2715: foreach my $possibleword (@RelatedWords) {
2716: my ($word,$wordcount)=split(/\,/,$possibleword);
2717: if ($wordcount>$threshold) {
2718: push(@Words,$word);
2719: $count++;
2720: if ($count>10) { last; }
2721: }
1.20 www 2722: }
2723: }
1.46 matthew 2724: untie %thesaurus_db;
2725: return @Words;
1.14 harris41 2726: }
1.46 matthew 2727:
1.112 bowersj2 2728: =pod
2729:
2730: =back
2731:
2732: =cut
1.61 www 2733:
2734: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2735: =pod
2736:
1.112 bowersj2 2737: =head1 User Name Functions
2738:
2739: =over 4
2740:
1.648 raeburn 2741: =item * &plainname($uname,$udom,$first)
1.81 albertel 2742:
1.112 bowersj2 2743: Takes a users logon name and returns it as a string in
1.226 albertel 2744: "first middle last generation" form
2745: if $first is set to 'lastname' then it returns it as
2746: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2747:
2748: =cut
1.61 www 2749:
1.295 www 2750:
1.81 albertel 2751: ###############################################################
1.61 www 2752: sub plainname {
1.226 albertel 2753: my ($uname,$udom,$first)=@_;
1.537 albertel 2754: return if (!defined($uname) || !defined($udom));
1.295 www 2755: my %names=&getnames($uname,$udom);
1.226 albertel 2756: my $name=&Apache::lonnet::format_name($names{'firstname'},
2757: $names{'middlename'},
2758: $names{'lastname'},
2759: $names{'generation'},$first);
2760: $name=~s/^\s+//;
1.62 www 2761: $name=~s/\s+$//;
2762: $name=~s/\s+/ /g;
1.353 albertel 2763: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2764: return $name;
1.61 www 2765: }
1.66 www 2766:
2767: # -------------------------------------------------------------------- Nickname
1.81 albertel 2768: =pod
2769:
1.648 raeburn 2770: =item * &nickname($uname,$udom)
1.81 albertel 2771:
2772: Gets a users name and returns it as a string as
2773:
2774: ""nickname""
1.66 www 2775:
1.81 albertel 2776: if the user has a nickname or
2777:
2778: "first middle last generation"
2779:
2780: if the user does not
2781:
2782: =cut
1.66 www 2783:
2784: sub nickname {
2785: my ($uname,$udom)=@_;
1.537 albertel 2786: return if (!defined($uname) || !defined($udom));
1.295 www 2787: my %names=&getnames($uname,$udom);
1.68 albertel 2788: my $name=$names{'nickname'};
1.66 www 2789: if ($name) {
2790: $name='"'.$name.'"';
2791: } else {
2792: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2793: $names{'lastname'}.' '.$names{'generation'};
2794: $name=~s/\s+$//;
2795: $name=~s/\s+/ /g;
2796: }
2797: return $name;
2798: }
2799:
1.295 www 2800: sub getnames {
2801: my ($uname,$udom)=@_;
1.537 albertel 2802: return if (!defined($uname) || !defined($udom));
1.433 albertel 2803: if ($udom eq 'public' && $uname eq 'public') {
2804: return ('lastname' => &mt('Public'));
2805: }
1.295 www 2806: my $id=$uname.':'.$udom;
2807: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2808: if ($cached) {
2809: return %{$names};
2810: } else {
2811: my %loadnames=&Apache::lonnet::get('environment',
2812: ['firstname','middlename','lastname','generation','nickname'],
2813: $udom,$uname);
2814: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2815: return %loadnames;
2816: }
2817: }
1.61 www 2818:
1.542 raeburn 2819: # -------------------------------------------------------------------- getemails
1.648 raeburn 2820:
1.542 raeburn 2821: =pod
2822:
1.648 raeburn 2823: =item * &getemails($uname,$udom)
1.542 raeburn 2824:
2825: Gets a user's email information and returns it as a hash with keys:
2826: notification, critnotification, permanentemail
2827:
2828: For notification and critnotification, values are comma-separated lists
1.648 raeburn 2829: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 2830:
1.648 raeburn 2831:
1.542 raeburn 2832: =cut
2833:
1.648 raeburn 2834:
1.466 albertel 2835: sub getemails {
2836: my ($uname,$udom)=@_;
2837: if ($udom eq 'public' && $uname eq 'public') {
2838: return;
2839: }
1.467 www 2840: if (!$udom) { $udom=$env{'user.domain'}; }
2841: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2842: my $id=$uname.':'.$udom;
2843: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2844: if ($cached) {
2845: return %{$names};
2846: } else {
2847: my %loadnames=&Apache::lonnet::get('environment',
2848: ['notification','critnotification',
2849: 'permanentemail'],
2850: $udom,$uname);
2851: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2852: return %loadnames;
2853: }
2854: }
2855:
1.551 albertel 2856: sub flush_email_cache {
2857: my ($uname,$udom)=@_;
2858: if (!$udom) { $udom =$env{'user.domain'}; }
2859: if (!$uname) { $uname=$env{'user.name'}; }
2860: return if ($udom eq 'public' && $uname eq 'public');
2861: my $id=$uname.':'.$udom;
2862: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2863: }
2864:
1.728 raeburn 2865: # -------------------------------------------------------------------- getlangs
2866:
2867: =pod
2868:
2869: =item * &getlangs($uname,$udom)
2870:
2871: Gets a user's language preference and returns it as a hash with key:
2872: language.
2873:
2874: =cut
2875:
2876:
2877: sub getlangs {
2878: my ($uname,$udom) = @_;
2879: if (!$udom) { $udom =$env{'user.domain'}; }
2880: if (!$uname) { $uname=$env{'user.name'}; }
2881: my $id=$uname.':'.$udom;
2882: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
2883: if ($cached) {
2884: return %{$langs};
2885: } else {
2886: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
2887: $udom,$uname);
2888: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
2889: return %loadlangs;
2890: }
2891: }
2892:
2893: sub flush_langs_cache {
2894: my ($uname,$udom)=@_;
2895: if (!$udom) { $udom =$env{'user.domain'}; }
2896: if (!$uname) { $uname=$env{'user.name'}; }
2897: return if ($udom eq 'public' && $uname eq 'public');
2898: my $id=$uname.':'.$udom;
2899: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
2900: }
2901:
1.61 www 2902: # ------------------------------------------------------------------ Screenname
1.81 albertel 2903:
2904: =pod
2905:
1.648 raeburn 2906: =item * &screenname($uname,$udom)
1.81 albertel 2907:
2908: Gets a users screenname and returns it as a string
2909:
2910: =cut
1.61 www 2911:
2912: sub screenname {
2913: my ($uname,$udom)=@_;
1.258 albertel 2914: if ($uname eq $env{'user.name'} &&
2915: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2916: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2917: return $names{'screenname'};
1.62 www 2918: }
2919:
1.212 albertel 2920:
1.802 bisitz 2921: # ------------------------------------------------------------- Confirm Wrapper
2922: =pod
2923:
2924: =item confirmwrapper
2925:
2926: Wrap messages about completion of operation in box
2927:
2928: =cut
2929:
2930: sub confirmwrapper {
2931: my ($message)=@_;
2932: if ($message) {
2933: return "\n".'<div class="LC_confirm_box">'."\n"
2934: .$message."\n"
2935: .'</div>'."\n";
2936: } else {
2937: return $message;
2938: }
2939: }
2940:
1.62 www 2941: # ------------------------------------------------------------- Message Wrapper
2942:
2943: sub messagewrapper {
1.369 www 2944: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 2945: return
1.441 albertel 2946: '<a href="/adm/email?compose=individual&'.
2947: 'recname='.$username.'&recdom='.$domain.
2948: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 2949: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 2950: }
1.802 bisitz 2951:
1.74 www 2952: # --------------------------------------------------------------- Notes Wrapper
2953:
2954: sub noteswrapper {
2955: my ($link,$un,$do)=@_;
2956: return
2957: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 2958: }
1.802 bisitz 2959:
1.62 www 2960: # ------------------------------------------------------------- Aboutme Wrapper
2961:
2962: sub aboutmewrapper {
1.166 www 2963: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 2964: if (!defined($username) && !defined($domain)) {
2965: return;
2966: }
1.892 amueller 2967: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756 weissno 2968: ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 2969: }
2970:
2971: # ------------------------------------------------------------ Syllabus Wrapper
2972:
2973: sub syllabuswrapper {
1.707 bisitz 2974: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 2975: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 2976: }
1.14 harris41 2977:
1.802 bisitz 2978: # -----------------------------------------------------------------------------
2979:
1.208 matthew 2980: sub track_student_link {
1.887 raeburn 2981: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 2982: my $link ="/adm/trackstudent?";
1.208 matthew 2983: my $title = 'View recent activity';
2984: if (defined($sname) && $sname !~ /^\s*$/ &&
2985: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 2986: $link .= "selected_student=$sname:$sdom";
1.208 matthew 2987: $title .= ' of this student';
1.268 albertel 2988: }
1.208 matthew 2989: if (defined($target) && $target !~ /^\s*$/) {
2990: $target = qq{target="$target"};
2991: } else {
2992: $target = '';
2993: }
1.268 albertel 2994: if ($start) { $link.='&start='.$start; }
1.887 raeburn 2995: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 2996: $title = &mt($title);
2997: $linktext = &mt($linktext);
1.448 albertel 2998: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
2999: &help_open_topic('View_recent_activity');
1.208 matthew 3000: }
3001:
1.781 raeburn 3002: sub slot_reservations_link {
3003: my ($linktext,$sname,$sdom,$target) = @_;
3004: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3005: my $title = 'View slot reservation history';
3006: if (defined($sname) && $sname !~ /^\s*$/ &&
3007: defined($sdom) && $sdom !~ /^\s*$/) {
3008: $link .= "&uname=$sname&udom=$sdom";
3009: $title .= ' of this student';
3010: }
3011: if (defined($target) && $target !~ /^\s*$/) {
3012: $target = qq{target="$target"};
3013: } else {
3014: $target = '';
3015: }
3016: $title = &mt($title);
3017: $linktext = &mt($linktext);
3018: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3019: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3020:
3021: }
3022:
1.508 www 3023: # ===================================================== Display a student photo
3024:
3025:
1.509 albertel 3026: sub student_image_tag {
1.508 www 3027: my ($domain,$user)=@_;
3028: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3029: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3030: return '<img src="'.$imgsrc.'" align="right" />';
3031: } else {
3032: return '';
3033: }
3034: }
3035:
1.112 bowersj2 3036: =pod
3037:
3038: =back
3039:
3040: =head1 Access .tab File Data
3041:
3042: =over 4
3043:
1.648 raeburn 3044: =item * &languageids()
1.112 bowersj2 3045:
3046: returns list of all language ids
3047:
3048: =cut
3049:
1.14 harris41 3050: sub languageids {
1.16 harris41 3051: return sort(keys(%language));
1.14 harris41 3052: }
3053:
1.112 bowersj2 3054: =pod
3055:
1.648 raeburn 3056: =item * &languagedescription()
1.112 bowersj2 3057:
3058: returns description of a specified language id
3059:
3060: =cut
3061:
1.14 harris41 3062: sub languagedescription {
1.125 www 3063: my $code=shift;
3064: return ($supported_language{$code}?'* ':'').
3065: $language{$code}.
1.126 www 3066: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3067: }
3068:
3069: sub plainlanguagedescription {
3070: my $code=shift;
3071: return $language{$code};
3072: }
3073:
3074: sub supportedlanguagecode {
3075: my $code=shift;
3076: return $supported_language{$code};
1.97 www 3077: }
3078:
1.112 bowersj2 3079: =pod
3080:
1.648 raeburn 3081: =item * ©rightids()
1.112 bowersj2 3082:
3083: returns list of all copyrights
3084:
3085: =cut
3086:
3087: sub copyrightids {
3088: return sort(keys(%cprtag));
3089: }
3090:
3091: =pod
3092:
1.648 raeburn 3093: =item * ©rightdescription()
1.112 bowersj2 3094:
3095: returns description of a specified copyright id
3096:
3097: =cut
3098:
3099: sub copyrightdescription {
1.166 www 3100: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3101: }
1.197 matthew 3102:
3103: =pod
3104:
1.648 raeburn 3105: =item * &source_copyrightids()
1.192 taceyjo1 3106:
3107: returns list of all source copyrights
3108:
3109: =cut
3110:
3111: sub source_copyrightids {
3112: return sort(keys(%scprtag));
3113: }
3114:
3115: =pod
3116:
1.648 raeburn 3117: =item * &source_copyrightdescription()
1.192 taceyjo1 3118:
3119: returns description of a specified source copyright id
3120:
3121: =cut
3122:
3123: sub source_copyrightdescription {
3124: return &mt($scprtag{shift(@_)});
3125: }
1.112 bowersj2 3126:
3127: =pod
3128:
1.648 raeburn 3129: =item * &filecategories()
1.112 bowersj2 3130:
3131: returns list of all file categories
3132:
3133: =cut
3134:
3135: sub filecategories {
3136: return sort(keys(%category_extensions));
3137: }
3138:
3139: =pod
3140:
1.648 raeburn 3141: =item * &filecategorytypes()
1.112 bowersj2 3142:
3143: returns list of file types belonging to a given file
3144: category
3145:
3146: =cut
3147:
3148: sub filecategorytypes {
1.356 albertel 3149: my ($cat) = @_;
3150: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3151: }
3152:
3153: =pod
3154:
1.648 raeburn 3155: =item * &fileembstyle()
1.112 bowersj2 3156:
3157: returns embedding style for a specified file type
3158:
3159: =cut
3160:
3161: sub fileembstyle {
3162: return $fe{lc(shift(@_))};
1.169 www 3163: }
3164:
1.351 www 3165: sub filemimetype {
3166: return $fm{lc(shift(@_))};
3167: }
3168:
1.169 www 3169:
3170: sub filecategoryselect {
3171: my ($name,$value)=@_;
1.189 matthew 3172: return &select_form($value,$name,
1.169 www 3173: '' => &mt('Any category'),
3174: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 3175: }
3176:
3177: =pod
3178:
1.648 raeburn 3179: =item * &filedescription()
1.112 bowersj2 3180:
3181: returns description for a specified file type
3182:
3183: =cut
3184:
3185: sub filedescription {
1.188 matthew 3186: my $file_description = $fd{lc(shift())};
3187: $file_description =~ s:([\[\]]):~$1:g;
3188: return &mt($file_description);
1.112 bowersj2 3189: }
3190:
3191: =pod
3192:
1.648 raeburn 3193: =item * &filedescriptionex()
1.112 bowersj2 3194:
3195: returns description for a specified file type with
3196: extra formatting
3197:
3198: =cut
3199:
3200: sub filedescriptionex {
3201: my $ex=shift;
1.188 matthew 3202: my $file_description = $fd{lc($ex)};
3203: $file_description =~ s:([\[\]]):~$1:g;
3204: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3205: }
3206:
3207: # End of .tab access
3208: =pod
3209:
3210: =back
3211:
3212: =cut
3213:
3214: # ------------------------------------------------------------------ File Types
3215: sub fileextensions {
3216: return sort(keys(%fe));
3217: }
3218:
1.97 www 3219: # ----------------------------------------------------------- Display Languages
3220: # returns a hash with all desired display languages
3221: #
3222:
3223: sub display_languages {
3224: my %languages=();
1.695 raeburn 3225: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3226: $languages{$lang}=1;
1.97 www 3227: }
3228: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3229: if ($env{'form.displaylanguage'}) {
1.356 albertel 3230: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3231: $languages{$lang}=1;
1.97 www 3232: }
3233: }
3234: return %languages;
1.14 harris41 3235: }
3236:
1.582 albertel 3237: sub languages {
3238: my ($possible_langs) = @_;
1.695 raeburn 3239: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3240: if (!ref($possible_langs)) {
3241: if( wantarray ) {
3242: return @preferred_langs;
3243: } else {
3244: return $preferred_langs[0];
3245: }
3246: }
3247: my %possibilities = map { $_ => 1 } (@$possible_langs);
3248: my @preferred_possibilities;
3249: foreach my $preferred_lang (@preferred_langs) {
3250: if (exists($possibilities{$preferred_lang})) {
3251: push(@preferred_possibilities, $preferred_lang);
3252: }
3253: }
3254: if( wantarray ) {
3255: return @preferred_possibilities;
3256: }
3257: return $preferred_possibilities[0];
3258: }
3259:
1.742 raeburn 3260: sub user_lang {
3261: my ($touname,$toudom,$fromcid) = @_;
3262: my @userlangs;
3263: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3264: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3265: $env{'course.'.$fromcid.'.languages'}));
3266: } else {
3267: my %langhash = &getlangs($touname,$toudom);
3268: if ($langhash{'languages'} ne '') {
3269: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3270: } else {
3271: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3272: if ($domdefs{'lang_def'} ne '') {
3273: @userlangs = ($domdefs{'lang_def'});
3274: }
3275: }
3276: }
3277: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3278: my $user_lh = Apache::localize->get_handle(@languages);
3279: return $user_lh;
3280: }
3281:
3282:
1.112 bowersj2 3283: ###############################################################
3284: ## Student Answer Attempts ##
3285: ###############################################################
3286:
3287: =pod
3288:
3289: =head1 Alternate Problem Views
3290:
3291: =over 4
3292:
1.648 raeburn 3293: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3294: $getattempt, $regexp, $gradesub)
3295:
3296: Return string with previous attempt on problem. Arguments:
3297:
3298: =over 4
3299:
3300: =item * $symb: Problem, including path
3301:
3302: =item * $username: username of the desired student
3303:
3304: =item * $domain: domain of the desired student
1.14 harris41 3305:
1.112 bowersj2 3306: =item * $course: Course ID
1.14 harris41 3307:
1.112 bowersj2 3308: =item * $getattempt: Leave blank for all attempts, otherwise put
3309: something
1.14 harris41 3310:
1.112 bowersj2 3311: =item * $regexp: if string matches this regexp, the string will be
3312: sent to $gradesub
1.14 harris41 3313:
1.112 bowersj2 3314: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3315:
1.112 bowersj2 3316: =back
1.14 harris41 3317:
1.112 bowersj2 3318: The output string is a table containing all desired attempts, if any.
1.16 harris41 3319:
1.112 bowersj2 3320: =cut
1.1 albertel 3321:
3322: sub get_previous_attempt {
1.43 ng 3323: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3324: my $prevattempts='';
1.43 ng 3325: no strict 'refs';
1.1 albertel 3326: if ($symb) {
1.3 albertel 3327: my (%returnhash)=
3328: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3329: if ($returnhash{'version'}) {
3330: my %lasthash=();
3331: my $version;
3332: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3333: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3334: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3335: }
1.1 albertel 3336: }
1.596 albertel 3337: $prevattempts=&start_data_table().&start_data_table_header_row();
3338: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3339: foreach my $key (sort(keys(%lasthash))) {
3340: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3341: if ($#parts > 0) {
1.31 albertel 3342: my $data=$parts[-1];
3343: pop(@parts);
1.596 albertel 3344: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3345: } else {
1.41 ng 3346: if ($#parts == 0) {
3347: $prevattempts.='<th>'.$parts[0].'</th>';
3348: } else {
3349: $prevattempts.='<th>'.$ign.'</th>';
3350: }
1.31 albertel 3351: }
1.16 harris41 3352: }
1.596 albertel 3353: $prevattempts.=&end_data_table_header_row();
1.40 ng 3354: if ($getattempt eq '') {
3355: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3356: $prevattempts.=&start_data_table_row().
3357: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3358: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3359: my $value = &format_previous_attempt_value($key,
3360: $returnhash{$version.':'.$key});
3361: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3362: }
1.596 albertel 3363: $prevattempts.=&end_data_table_row();
1.40 ng 3364: }
1.1 albertel 3365: }
1.596 albertel 3366: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3367: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3368: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3369: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3370: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3371: }
1.596 albertel 3372: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3373: } else {
1.596 albertel 3374: $prevattempts=
3375: &start_data_table().&start_data_table_row().
3376: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3377: &end_data_table_row().&end_data_table();
1.1 albertel 3378: }
3379: } else {
1.596 albertel 3380: $prevattempts=
3381: &start_data_table().&start_data_table_row().
3382: '<td>'.&mt('No data.').'</td>'.
3383: &end_data_table_row().&end_data_table();
1.1 albertel 3384: }
1.10 albertel 3385: }
3386:
1.581 albertel 3387: sub format_previous_attempt_value {
3388: my ($key,$value) = @_;
3389: if ($key =~ /timestamp/) {
3390: $value = &Apache::lonlocal::locallocaltime($value);
3391: } elsif (ref($value) eq 'ARRAY') {
3392: $value = '('.join(', ', @{ $value }).')';
3393: } else {
3394: $value = &unescape($value);
3395: }
3396: return $value;
3397: }
3398:
3399:
1.107 albertel 3400: sub relative_to_absolute {
3401: my ($url,$output)=@_;
3402: my $parser=HTML::TokeParser->new(\$output);
3403: my $token;
3404: my $thisdir=$url;
3405: my @rlinks=();
3406: while ($token=$parser->get_token) {
3407: if ($token->[0] eq 'S') {
3408: if ($token->[1] eq 'a') {
3409: if ($token->[2]->{'href'}) {
3410: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3411: }
3412: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3413: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3414: } elsif ($token->[1] eq 'base') {
3415: $thisdir=$token->[2]->{'href'};
3416: }
3417: }
3418: }
3419: $thisdir=~s-/[^/]*$--;
1.356 albertel 3420: foreach my $link (@rlinks) {
1.726 raeburn 3421: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3422: ($link=~/^\//) ||
3423: ($link=~/^javascript:/i) ||
3424: ($link=~/^mailto:/i) ||
3425: ($link=~/^\#/)) {
3426: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3427: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3428: }
3429: }
3430: # -------------------------------------------------- Deal with Applet codebases
3431: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3432: return $output;
3433: }
3434:
1.112 bowersj2 3435: =pod
3436:
1.648 raeburn 3437: =item * &get_student_view()
1.112 bowersj2 3438:
3439: show a snapshot of what student was looking at
3440:
3441: =cut
3442:
1.10 albertel 3443: sub get_student_view {
1.186 albertel 3444: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3445: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3446: my (%form);
1.10 albertel 3447: my @elements=('symb','courseid','domain','username');
3448: foreach my $element (@elements) {
1.186 albertel 3449: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3450: }
1.186 albertel 3451: if (defined($moreenv)) {
3452: %form=(%form,%{$moreenv});
3453: }
1.236 albertel 3454: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3455: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3456: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3457: $userview=~s/\<body[^\>]*\>//gi;
3458: $userview=~s/\<\/body\>//gi;
3459: $userview=~s/\<html\>//gi;
3460: $userview=~s/\<\/html\>//gi;
3461: $userview=~s/\<head\>//gi;
3462: $userview=~s/\<\/head\>//gi;
3463: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3464: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3465: if (wantarray) {
3466: return ($userview,$response);
3467: } else {
3468: return $userview;
3469: }
3470: }
3471:
3472: sub get_student_view_with_retries {
3473: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3474:
3475: my $ok = 0; # True if we got a good response.
3476: my $content;
3477: my $response;
3478:
3479: # Try to get the student_view done. within the retries count:
3480:
3481: do {
3482: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3483: $ok = $response->is_success;
3484: if (!$ok) {
3485: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3486: }
3487: $retries--;
3488: } while (!$ok && ($retries > 0));
3489:
3490: if (!$ok) {
3491: $content = ''; # On error return an empty content.
3492: }
1.651 www 3493: if (wantarray) {
3494: return ($content, $response);
3495: } else {
3496: return $content;
3497: }
1.11 albertel 3498: }
3499:
1.112 bowersj2 3500: =pod
3501:
1.648 raeburn 3502: =item * &get_student_answers()
1.112 bowersj2 3503:
3504: show a snapshot of how student was answering problem
3505:
3506: =cut
3507:
1.11 albertel 3508: sub get_student_answers {
1.100 sakharuk 3509: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3510: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3511: my (%moreenv);
1.11 albertel 3512: my @elements=('symb','courseid','domain','username');
3513: foreach my $element (@elements) {
1.186 albertel 3514: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3515: }
1.186 albertel 3516: $moreenv{'grade_target'}='answer';
3517: %moreenv=(%form,%moreenv);
1.497 raeburn 3518: $feedurl = &Apache::lonnet::clutter($feedurl);
3519: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3520: return $userview;
1.1 albertel 3521: }
1.116 albertel 3522:
3523: =pod
3524:
3525: =item * &submlink()
3526:
1.242 albertel 3527: Inputs: $text $uname $udom $symb $target
1.116 albertel 3528:
3529: Returns: A link to grades.pm such as to see the SUBM view of a student
3530:
3531: =cut
3532:
3533: ###############################################
3534: sub submlink {
1.242 albertel 3535: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3536: if (!($uname && $udom)) {
3537: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3538: &Apache::lonnet::whichuser($symb);
1.116 albertel 3539: if (!$symb) { $symb=$cursymb; }
3540: }
1.254 matthew 3541: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3542: $symb=&escape($symb);
1.242 albertel 3543: if ($target) { $target="target=\"$target\""; }
3544: return '<a href="/adm/grades?&command=submission&'.
3545: 'symb='.$symb.'&student='.$uname.
3546: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3547: }
3548: ##############################################
3549:
3550: =pod
3551:
3552: =item * &pgrdlink()
3553:
3554: Inputs: $text $uname $udom $symb $target
3555:
3556: Returns: A link to grades.pm such as to see the PGRD view of a student
3557:
3558: =cut
3559:
3560: ###############################################
3561: sub pgrdlink {
3562: my $link=&submlink(@_);
3563: $link=~s/(&command=submission)/$1&showgrading=yes/;
3564: return $link;
3565: }
3566: ##############################################
3567:
3568: =pod
3569:
3570: =item * &pprmlink()
3571:
3572: Inputs: $text $uname $udom $symb $target
3573:
3574: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3575: student and a specific resource
1.242 albertel 3576:
3577: =cut
3578:
3579: ###############################################
3580: sub pprmlink {
3581: my ($text,$uname,$udom,$symb,$target)=@_;
3582: if (!($uname && $udom)) {
3583: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3584: &Apache::lonnet::whichuser($symb);
1.242 albertel 3585: if (!$symb) { $symb=$cursymb; }
3586: }
1.254 matthew 3587: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3588: $symb=&escape($symb);
1.242 albertel 3589: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3590: return '<a href="/adm/parmset?command=set&'.
3591: 'symb='.$symb.'&uname='.$uname.
3592: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3593: }
3594: ##############################################
1.37 matthew 3595:
1.112 bowersj2 3596: =pod
3597:
3598: =back
3599:
3600: =cut
3601:
1.37 matthew 3602: ###############################################
1.51 www 3603:
3604:
3605: sub timehash {
1.687 raeburn 3606: my ($thistime) = @_;
3607: my $timezone = &Apache::lonlocal::gettimezone();
3608: my $dt = DateTime->from_epoch(epoch => $thistime)
3609: ->set_time_zone($timezone);
3610: my $wday = $dt->day_of_week();
3611: if ($wday == 7) { $wday = 0; }
3612: return ( 'second' => $dt->second(),
3613: 'minute' => $dt->minute(),
3614: 'hour' => $dt->hour(),
3615: 'day' => $dt->day_of_month(),
3616: 'month' => $dt->month(),
3617: 'year' => $dt->year(),
3618: 'weekday' => $wday,
3619: 'dayyear' => $dt->day_of_year(),
3620: 'dlsav' => $dt->is_dst() );
1.51 www 3621: }
3622:
1.370 www 3623: sub utc_string {
3624: my ($date)=@_;
1.371 www 3625: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3626: }
3627:
1.51 www 3628: sub maketime {
3629: my %th=@_;
1.687 raeburn 3630: my ($epoch_time,$timezone,$dt);
3631: $timezone = &Apache::lonlocal::gettimezone();
3632: eval {
3633: $dt = DateTime->new( year => $th{'year'},
3634: month => $th{'month'},
3635: day => $th{'day'},
3636: hour => $th{'hour'},
3637: minute => $th{'minute'},
3638: second => $th{'second'},
3639: time_zone => $timezone,
3640: );
3641: };
3642: if (!$@) {
3643: $epoch_time = $dt->epoch;
3644: if ($epoch_time) {
3645: return $epoch_time;
3646: }
3647: }
1.51 www 3648: return POSIX::mktime(
3649: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3650: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3651: }
3652:
3653: #########################################
1.51 www 3654:
3655: sub findallcourses {
1.482 raeburn 3656: my ($roles,$uname,$udom) = @_;
1.355 albertel 3657: my %roles;
3658: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3659: my %courses;
1.51 www 3660: my $now=time;
1.482 raeburn 3661: if (!defined($uname)) {
3662: $uname = $env{'user.name'};
3663: }
3664: if (!defined($udom)) {
3665: $udom = $env{'user.domain'};
3666: }
3667: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3668: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3669: if (!%roles) {
3670: %roles = (
3671: cc => 1,
3672: in => 1,
3673: ep => 1,
3674: ta => 1,
3675: cr => 1,
3676: st => 1,
3677: );
3678: }
3679: foreach my $entry (keys(%roleshash)) {
3680: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3681: if ($trole =~ /^cr/) {
3682: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3683: } else {
3684: next if (!exists($roles{$trole}));
3685: }
3686: if ($tend) {
3687: next if ($tend < $now);
3688: }
3689: if ($tstart) {
3690: next if ($tstart > $now);
3691: }
3692: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3693: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3694: if ($secpart eq '') {
3695: ($cnum,$role) = split(/_/,$cnumpart);
3696: $sec = 'none';
3697: $realsec = '';
3698: } else {
3699: $cnum = $cnumpart;
3700: ($sec,$role) = split(/_/,$secpart);
3701: $realsec = $sec;
1.490 raeburn 3702: }
1.482 raeburn 3703: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3704: }
3705: } else {
3706: foreach my $key (keys(%env)) {
1.483 albertel 3707: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3708: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3709: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3710: next if ($role eq 'ca' || $role eq 'aa');
3711: next if (%roles && !exists($roles{$role}));
3712: my ($starttime,$endtime)=split(/\./,$env{$key});
3713: my $active=1;
3714: if ($starttime) {
3715: if ($now<$starttime) { $active=0; }
3716: }
3717: if ($endtime) {
3718: if ($now>$endtime) { $active=0; }
3719: }
3720: if ($active) {
3721: if ($sec eq '') {
3722: $sec = 'none';
3723: }
3724: $courses{$cdom.'_'.$cnum}{$sec} =
3725: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3726: }
3727: }
1.51 www 3728: }
3729: }
1.474 raeburn 3730: return %courses;
1.51 www 3731: }
1.37 matthew 3732:
1.54 www 3733: ###############################################
1.474 raeburn 3734:
3735: sub blockcheck {
1.482 raeburn 3736: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3737:
3738: if (!defined($udom)) {
3739: $udom = $env{'user.domain'};
3740: }
3741: if (!defined($uname)) {
3742: $uname = $env{'user.name'};
3743: }
3744:
3745: # If uname and udom are for a course, check for blocks in the course.
3746:
3747: if (&Apache::lonnet::is_course($udom,$uname)) {
3748: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3749: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3750: return ($startblock,$endblock);
3751: }
1.474 raeburn 3752:
1.502 raeburn 3753: my $startblock = 0;
3754: my $endblock = 0;
1.482 raeburn 3755: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3756:
1.490 raeburn 3757: # If uname is for a user, and activity is course-specific, i.e.,
3758: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3759:
1.490 raeburn 3760: if (($activity eq 'boards' || $activity eq 'chat' ||
3761: $activity eq 'groups') && ($env{'request.course.id'})) {
3762: foreach my $key (keys(%live_courses)) {
3763: if ($key ne $env{'request.course.id'}) {
3764: delete($live_courses{$key});
3765: }
3766: }
3767: }
3768:
3769: my $otheruser = 0;
3770: my %own_courses;
3771: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3772: # Resource belongs to user other than current user.
3773: $otheruser = 1;
3774: # Gather courses for current user
3775: %own_courses =
3776: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3777: }
3778:
3779: # Gather active course roles - course coordinator, instructor,
3780: # exam proctor, ta, student, or custom role.
1.474 raeburn 3781:
3782: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3783: my ($cdom,$cnum);
3784: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3785: $cdom = $env{'course.'.$course.'.domain'};
3786: $cnum = $env{'course.'.$course.'.num'};
3787: } else {
1.490 raeburn 3788: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3789: }
3790: my $no_ownblock = 0;
3791: my $no_userblock = 0;
1.533 raeburn 3792: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3793: # Check if current user has 'evb' priv for this
3794: if (defined($own_courses{$course})) {
3795: foreach my $sec (keys(%{$own_courses{$course}})) {
3796: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3797: if ($sec ne 'none') {
3798: $checkrole .= '/'.$sec;
3799: }
3800: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3801: $no_ownblock = 1;
3802: last;
3803: }
3804: }
3805: }
3806: # if they have 'evb' priv and are currently not playing student
3807: next if (($no_ownblock) &&
3808: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3809: }
1.474 raeburn 3810: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3811: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3812: if ($sec ne 'none') {
1.482 raeburn 3813: $checkrole .= '/'.$sec;
1.474 raeburn 3814: }
1.490 raeburn 3815: if ($otheruser) {
3816: # Resource belongs to user other than current user.
3817: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3818: my ($trole,$tdom,$tnum,$tsec);
3819: my $entry = $live_courses{$course}{$sec};
3820: if ($entry =~ /^cr/) {
3821: ($trole,$tdom,$tnum,$tsec) =
3822: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3823: } else {
3824: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3825: }
3826: my ($spec,$area,$trest,%allroles,%userroles);
3827: $area = '/'.$tdom.'/'.$tnum;
3828: $trest = $tnum;
3829: if ($tsec ne '') {
3830: $area .= '/'.$tsec;
3831: $trest .= '/'.$tsec;
3832: }
3833: $spec = $trole.'.'.$area;
3834: if ($trole =~ /^cr/) {
3835: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3836: $tdom,$spec,$trest,$area);
3837: } else {
3838: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3839: $tdom,$spec,$trest,$area);
3840: }
3841: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3842: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3843: if ($1) {
3844: $no_userblock = 1;
3845: last;
3846: }
3847: }
1.490 raeburn 3848: } else {
3849: # Resource belongs to current user
3850: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3851: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3852: $no_ownblock = 1;
3853: last;
3854: }
1.474 raeburn 3855: }
3856: }
3857: # if they have the evb priv and are currently not playing student
1.482 raeburn 3858: next if (($no_ownblock) &&
1.491 albertel 3859: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3860: next if ($no_userblock);
1.474 raeburn 3861:
1.866 kalberla 3862: # Retrieve blocking times and identity of locker for course
1.490 raeburn 3863: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3864:
3865: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3866: if (($start != 0) &&
3867: (($startblock == 0) || ($startblock > $start))) {
3868: $startblock = $start;
3869: }
3870: if (($end != 0) &&
3871: (($endblock == 0) || ($endblock < $end))) {
3872: $endblock = $end;
3873: }
1.490 raeburn 3874: }
3875: return ($startblock,$endblock);
3876: }
3877:
3878: sub get_blocks {
3879: my ($setters,$activity,$cdom,$cnum) = @_;
3880: my $startblock = 0;
3881: my $endblock = 0;
3882: my $course = $cdom.'_'.$cnum;
3883: $setters->{$course} = {};
3884: $setters->{$course}{'staff'} = [];
3885: $setters->{$course}{'times'} = [];
3886: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3887: foreach my $record (keys(%records)) {
3888: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3889: if ($start <= time && $end >= time) {
3890: my ($staff_name,$staff_dom,$title,$blocks) =
3891: &parse_block_record($records{$record});
3892: if ($blocks->{$activity} eq 'on') {
3893: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3894: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3895: if ( ($startblock == 0) || ($startblock > $start) ) {
3896: $startblock = $start;
1.490 raeburn 3897: }
1.491 albertel 3898: if ( ($endblock == 0) || ($endblock < $end) ) {
3899: $endblock = $end;
1.474 raeburn 3900: }
3901: }
3902: }
3903: }
3904: return ($startblock,$endblock);
3905: }
3906:
3907: sub parse_block_record {
3908: my ($record) = @_;
3909: my ($setuname,$setudom,$title,$blocks);
3910: if (ref($record) eq 'HASH') {
3911: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3912: $title = &unescape($record->{'event'});
3913: $blocks = $record->{'blocks'};
3914: } else {
3915: my @data = split(/:/,$record,3);
3916: if (scalar(@data) eq 2) {
3917: $title = $data[1];
3918: ($setuname,$setudom) = split(/@/,$data[0]);
3919: } else {
3920: ($setuname,$setudom,$title) = @data;
3921: }
3922: $blocks = { 'com' => 'on' };
3923: }
3924: return ($setuname,$setudom,$title,$blocks);
3925: }
3926:
1.854 kalberla 3927: sub blocking_status {
3928: my ($activity,$uname,$udom) = @_;
1.867 kalberla 3929: my %setters;
1.890 droeschl 3930:
3931: # check for active blocking
1.867 kalberla 3932: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854 kalberla 3933:
1.890 droeschl 3934: my $blocked = $startblock && $endblock ? 1 : 0;
3935:
3936: # caller just wants to know whether a block is active
3937: if (!wantarray) { return $blocked; }
3938:
3939: # build a link to a popup window containing the details
3940: my $querystring = "?activity=$activity";
3941: # $uname and $udom decide whose portfolio the user is trying to look at
3942: $querystring .= "&udom=$udom" if $udom;
3943: $querystring .= "&uname=$uname" if $uname;
3944:
3945: my $output .= <<'END_MYBLOCK';
1.854 kalberla 3946: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
3947: var options = "width=" + w + ",height=" + h + ",";
3948: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
3949: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
3950: var newWin = window.open(url, wdwName, options);
3951: newWin.focus();
3952: }
1.890 droeschl 3953: END_MYBLOCK
1.854 kalberla 3954:
1.890 droeschl 3955: $output = Apache::lonhtmlcommon::scripttag($output);
3956:
1.854 kalberla 3957: my $popupUrl = "/adm/blockingstatus/$querystring";
1.890 droeschl 3958: my $text = mt('Communication Blocked');
3959:
1.867 kalberla 3960: $output .= <<"END_BLOCK";
3961: <div class='LC_comblock'>
1.869 kalberla 3962: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 3963: title='$text'>
3964: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 3965: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 3966: title='$text'>$text</a>
1.867 kalberla 3967: </div>
3968:
3969: END_BLOCK
1.474 raeburn 3970:
1.854 kalberla 3971: return ($blocked, $output);
3972: }
1.490 raeburn 3973:
1.60 matthew 3974: ###############################################
3975:
1.682 raeburn 3976: sub check_ip_acc {
3977: my ($acc)=@_;
3978: &Apache::lonxml::debug("acc is $acc");
3979: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
3980: return 1;
3981: }
3982: my $allowed=0;
3983: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
3984:
3985: my $name;
3986: foreach my $pattern (split(',',$acc)) {
3987: $pattern =~ s/^\s*//;
3988: $pattern =~ s/\s*$//;
3989: if ($pattern =~ /\*$/) {
3990: #35.8.*
3991: $pattern=~s/\*//;
3992: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
3993: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
3994: #35.8.3.[34-56]
3995: my $low=$2;
3996: my $high=$3;
3997: $pattern=$1;
3998: if ($ip =~ /^\Q$pattern\E/) {
3999: my $last=(split(/\./,$ip))[3];
4000: if ($last <=$high && $last >=$low) { $allowed=1; }
4001: }
4002: } elsif ($pattern =~ /^\*/) {
4003: #*.msu.edu
4004: $pattern=~s/\*//;
4005: if (!defined($name)) {
4006: use Socket;
4007: my $netaddr=inet_aton($ip);
4008: ($name)=gethostbyaddr($netaddr,AF_INET);
4009: }
4010: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4011: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4012: #127.0.0.1
4013: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4014: } else {
4015: #some.name.com
4016: if (!defined($name)) {
4017: use Socket;
4018: my $netaddr=inet_aton($ip);
4019: ($name)=gethostbyaddr($netaddr,AF_INET);
4020: }
4021: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4022: }
4023: if ($allowed) { last; }
4024: }
4025: return $allowed;
4026: }
4027:
4028: ###############################################
4029:
1.60 matthew 4030: =pod
4031:
1.112 bowersj2 4032: =head1 Domain Template Functions
4033:
4034: =over 4
4035:
4036: =item * &determinedomain()
1.60 matthew 4037:
4038: Inputs: $domain (usually will be undef)
4039:
1.63 www 4040: Returns: Determines which domain should be used for designs
1.60 matthew 4041:
4042: =cut
1.54 www 4043:
1.60 matthew 4044: ###############################################
1.63 www 4045: sub determinedomain {
4046: my $domain=shift;
1.531 albertel 4047: if (! $domain) {
1.60 matthew 4048: # Determine domain if we have not been given one
1.893 raeburn 4049: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4050: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4051: if ($env{'request.role.domain'}) {
4052: $domain=$env{'request.role.domain'};
1.60 matthew 4053: }
4054: }
1.63 www 4055: return $domain;
4056: }
4057: ###############################################
1.517 raeburn 4058:
1.518 albertel 4059: sub devalidate_domconfig_cache {
4060: my ($udom)=@_;
4061: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4062: }
4063:
4064: # ---------------------- Get domain configuration for a domain
4065: sub get_domainconf {
4066: my ($udom) = @_;
4067: my $cachetime=1800;
4068: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4069: if (defined($cached)) { return %{$result}; }
4070:
4071: my %domconfig = &Apache::lonnet::get_dom('configuration',
4072: ['login','rolecolors'],$udom);
1.632 raeburn 4073: my (%designhash,%legacy);
1.518 albertel 4074: if (keys(%domconfig) > 0) {
4075: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4076: if (keys(%{$domconfig{'login'}})) {
4077: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4078: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4079: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4080: $designhash{$udom.'.login.'.$key.'_'.$img} =
4081: $domconfig{'login'}{$key}{$img};
4082: }
4083: } else {
4084: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4085: }
1.632 raeburn 4086: }
4087: } else {
4088: $legacy{'login'} = 1;
1.518 albertel 4089: }
1.632 raeburn 4090: } else {
4091: $legacy{'login'} = 1;
1.518 albertel 4092: }
4093: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4094: if (keys(%{$domconfig{'rolecolors'}})) {
4095: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4096: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4097: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4098: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4099: }
1.518 albertel 4100: }
4101: }
1.632 raeburn 4102: } else {
4103: $legacy{'rolecolors'} = 1;
1.518 albertel 4104: }
1.632 raeburn 4105: } else {
4106: $legacy{'rolecolors'} = 1;
1.518 albertel 4107: }
1.632 raeburn 4108: if (keys(%legacy) > 0) {
4109: my %legacyhash = &get_legacy_domconf($udom);
4110: foreach my $item (keys(%legacyhash)) {
4111: if ($item =~ /^\Q$udom\E\.login/) {
4112: if ($legacy{'login'}) {
4113: $designhash{$item} = $legacyhash{$item};
4114: }
4115: } else {
4116: if ($legacy{'rolecolors'}) {
4117: $designhash{$item} = $legacyhash{$item};
4118: }
1.518 albertel 4119: }
4120: }
4121: }
1.632 raeburn 4122: } else {
4123: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4124: }
4125: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4126: $cachetime);
4127: return %designhash;
4128: }
4129:
1.632 raeburn 4130: sub get_legacy_domconf {
4131: my ($udom) = @_;
4132: my %legacyhash;
4133: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4134: my $designfile = $designdir.'/'.$udom.'.tab';
4135: if (-e $designfile) {
4136: if ( open (my $fh,"<$designfile") ) {
4137: while (my $line = <$fh>) {
4138: next if ($line =~ /^\#/);
4139: chomp($line);
4140: my ($key,$val)=(split(/\=/,$line));
4141: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4142: }
4143: close($fh);
4144: }
4145: }
4146: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
4147: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4148: }
4149: return %legacyhash;
4150: }
4151:
1.63 www 4152: =pod
4153:
1.112 bowersj2 4154: =item * &domainlogo()
1.63 www 4155:
4156: Inputs: $domain (usually will be undef)
4157:
4158: Returns: A link to a domain logo, if the domain logo exists.
4159: If the domain logo does not exist, a description of the domain.
4160:
4161: =cut
1.112 bowersj2 4162:
1.63 www 4163: ###############################################
4164: sub domainlogo {
1.517 raeburn 4165: my $domain = &determinedomain(shift);
1.518 albertel 4166: my %designhash = &get_domainconf($domain);
1.517 raeburn 4167: # See if there is a logo
4168: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4169: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4170: if ($imgsrc =~ m{^/(adm|res)/}) {
4171: if ($imgsrc =~ m{^/res/}) {
4172: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4173: &Apache::lonnet::repcopy($local_name);
4174: }
4175: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4176: }
4177: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4178: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4179: return &Apache::lonnet::domain($domain,'description');
1.59 www 4180: } else {
1.60 matthew 4181: return '';
1.59 www 4182: }
4183: }
1.63 www 4184: ##############################################
4185:
4186: =pod
4187:
1.112 bowersj2 4188: =item * &designparm()
1.63 www 4189:
4190: Inputs: $which parameter; $domain (usually will be undef)
4191:
4192: Returns: value of designparamter $which
4193:
4194: =cut
1.112 bowersj2 4195:
1.397 albertel 4196:
1.400 albertel 4197: ##############################################
1.397 albertel 4198: sub designparm {
4199: my ($which,$domain)=@_;
4200: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4201: return $env{'environment.color.'.$which};
1.96 www 4202: }
1.63 www 4203: $domain=&determinedomain($domain);
1.518 albertel 4204: my %domdesign = &get_domainconf($domain);
1.520 raeburn 4205: my $output;
1.517 raeburn 4206: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4207: $output = $domdesign{$domain.'.'.$which};
1.63 www 4208: } else {
1.520 raeburn 4209: $output = $defaultdesign{$which};
4210: }
4211: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4212: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4213: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4214: if ($output =~ m{^/res/}) {
4215: my $local_name = &Apache::lonnet::filelocation('',$output);
4216: &Apache::lonnet::repcopy($local_name);
4217: }
1.520 raeburn 4218: $output = &lonhttpdurl($output);
4219: }
1.63 www 4220: }
1.520 raeburn 4221: return $output;
1.63 www 4222: }
1.59 www 4223:
1.822 bisitz 4224: ##############################################
4225: =pod
4226:
1.832 bisitz 4227: =item * &authorspace()
4228:
4229: Inputs: ./.
4230:
4231: Returns: Path to the Construction Space of the current user's
4232: accessed author space
4233: The author space will be that of the current user
4234: when accessing the own author space
4235: and that of the co-author/assistent co-author
4236: when accessing the co-author's/assistent co-author's
4237: space
4238:
4239: =cut
4240:
4241: sub authorspace {
4242: my $caname = '';
4243: if ($env{'request.role'} =~ /^ca|^aa/) {
4244: (undef,$caname) =
4245: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
4246: } else {
4247: $caname = $env{'user.name'};
4248: }
4249: return '/priv/'.$caname.'/';
4250: }
4251:
4252: ##############################################
4253: =pod
4254:
1.822 bisitz 4255: =item * &head_subbox()
4256:
4257: Inputs: $content (contains HTML code with page functions, etc.)
4258:
4259: Returns: HTML div with $content
4260: To be included in page header
4261:
4262: =cut
4263:
4264: sub head_subbox {
4265: my ($content)=@_;
4266: my $output =
1.844 bisitz 4267: '<div id="LC_head_subbox">'
1.822 bisitz 4268: .$content
4269: .'</div>'
4270: }
4271:
4272: ##############################################
4273: =pod
4274:
4275: =item * &CSTR_pageheader()
4276:
4277: Inputs: ./.
4278:
4279: Returns: HTML div with CSTR path and recent box
4280: To be included on Construction Space pages
4281:
4282: =cut
4283:
4284: sub CSTR_pageheader {
4285: # this is for resources; directories have customtitle, and crumbs
4286: # and select recent are created in lonpubdir.pm
4287: my ($uname,$thisdisfn)=
4288: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
4289: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4290: $formaction=~s/\/+/\//g;
4291:
4292: my $parentpath = '';
4293: my $lastitem = '';
4294: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4295: $parentpath = $1;
4296: $lastitem = $2;
4297: } else {
4298: $lastitem = $thisdisfn;
4299: }
4300: return
4301: '<div>'
4302: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
4303: .'<b>'.&mt('Construction Space:').'</b> '
4304: .'<form name="dirs" method="post" action="'.$formaction
4305: .'" target="_top"><tt><b>' #FIXME lonpubdir: target="_parent"
4306: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem</b></tt><br />"
4307: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
4308: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4309: .'</form>'
4310: .&Apache::lonmenu::constspaceform()
4311: .'</div>';
4312: }
4313:
1.60 matthew 4314: ###############################################
4315: ###############################################
4316:
4317: =pod
4318:
1.112 bowersj2 4319: =back
4320:
1.549 albertel 4321: =head1 HTML Helpers
1.112 bowersj2 4322:
4323: =over 4
4324:
4325: =item * &bodytag()
1.60 matthew 4326:
4327: Returns a uniform header for LON-CAPA web pages.
4328:
4329: Inputs:
4330:
1.112 bowersj2 4331: =over 4
4332:
4333: =item * $title, A title to be displayed on the page.
4334:
4335: =item * $function, the current role (can be undef).
4336:
4337: =item * $addentries, extra parameters for the <body> tag.
4338:
4339: =item * $bodyonly, if defined, only return the <body> tag.
4340:
4341: =item * $domain, if defined, force a given domain.
4342:
4343: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4344: text interface only)
1.60 matthew 4345:
1.814 bisitz 4346: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
4347: navigational links
1.317 albertel 4348:
1.338 albertel 4349: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4350:
1.361 albertel 4351: =item * $no_inline_link, if true and in remote mode, don't show the
4352: 'Switch To Inline Menu' link
4353:
1.460 albertel 4354: =item * $args, optional argument valid values are
4355: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4356: inherit_jsmath -> when creating popup window in a page,
4357: should it have jsmath forced on by the
4358: current page
1.460 albertel 4359:
1.112 bowersj2 4360: =back
4361:
1.60 matthew 4362: Returns: A uniform header for LON-CAPA web pages.
4363: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
4364: If $bodyonly is undef or zero, an html string containing a <body> tag and
4365: other decorations will be returned.
4366:
4367: =cut
4368:
1.54 www 4369: sub bodytag {
1.831 bisitz 4370: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.816 bisitz 4371: $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_;
1.339 albertel 4372:
1.460 albertel 4373: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 4374:
1.183 matthew 4375: $function = &get_users_function() if (!$function);
1.339 albertel 4376: my $img = &designparm($function.'.img',$domain);
4377: my $font = &designparm($function.'.font',$domain);
4378: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
4379:
1.803 bisitz 4380: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 4381: 'bgcolor' => $pgbg,
1.339 albertel 4382: 'text' => $font,
4383: 'alink' => &designparm($function.'.alink',$domain),
4384: 'vlink' => &designparm($function.'.vlink',$domain),
4385: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 4386: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 4387:
1.63 www 4388: # role and realm
1.378 raeburn 4389: my ($role,$realm) = split(/\./,$env{'request.role'},2);
4390: if ($role eq 'ca') {
1.479 albertel 4391: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 4392: $realm = &plainname($rname,$rdom);
1.378 raeburn 4393: }
1.55 www 4394: # realm
1.258 albertel 4395: if ($env{'request.course.id'}) {
1.378 raeburn 4396: if ($env{'request.role'} !~ /^cr/) {
4397: $role = &Apache::lonnet::plaintext($role,&course_type());
4398: }
1.359 albertel 4399: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 4400: } else {
4401: $role = &Apache::lonnet::plaintext($role);
1.54 www 4402: }
1.433 albertel 4403:
1.359 albertel 4404: if (!$realm) { $realm=' '; }
1.55 www 4405: # Set messages
1.60 matthew 4406: my $messages=&domainlogo($domain);
1.330 albertel 4407:
1.438 albertel 4408: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 4409:
1.101 www 4410: # construct main body tag
1.359 albertel 4411: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 4412: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 4413:
1.530 albertel 4414: if ($bodyonly) {
1.60 matthew 4415: return $bodytag;
1.798 tempelho 4416: }
1.359 albertel 4417:
1.410 albertel 4418: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4419: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4420: undef($role);
1.434 albertel 4421: } else {
4422: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4423: }
1.359 albertel 4424:
1.762 bisitz 4425: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 4426: #
4427: # Extra info if you are the DC
4428: my $dc_info = '';
4429: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4430: $env{'course.'.$env{'request.course.id'}.
4431: '.domain'}.'/'})) {
4432: my $cid = $env{'request.course.id'};
4433: $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4434: $dc_info =~ s/\s+$//;
1.359 albertel 4435: $dc_info = '('.$dc_info.')';
4436: }
4437:
1.853 droeschl 4438: $role = "($role)" if $role;
4439: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
4440:
1.837 bisitz 4441: if ($env{'environment.remote'} eq 'off') {
1.359 albertel 4442: # No Remote
1.894 ! droeschl 4443: if ($env{'request.state'} eq 'construct') {
! 4444: $forcereg=1;
! 4445: }
1.359 albertel 4446:
1.894 ! droeschl 4447: # if ($env{'request.state'} eq 'construct') {
! 4448: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
! 4449: # }
1.359 albertel 4450:
1.816 bisitz 4451: my $titletable = '<table id="LC_title_bar">'
1.894 ! droeschl 4452: ."<tr><td> $titleinfo $dc_info</td>"
! 4453: .'</tr></table>';
! 4454:
! 4455: if ($no_nav_bar) {
! 4456: $bodytag .= $titletable;
! 4457: } else {
! 4458: $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
! 4459: <em>$realm</em> $dc_info</div>| unless $env{'form.inhibitmenu'};
1.816 bisitz 4460:
1.894 ! droeschl 4461: #SD $titletable is obsolete
! 4462: #SD if ($env{'request.state'} eq 'construct') {
! 4463: #SD $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$titletable);
! 4464: #SD } else {
! 4465: #SD $bodytag .= &Apache::lonmenu::menubuttons($forcereg).$titletable;
! 4466: #SD }
! 4467: if ( $env{'form.inhibitmenu'} eq 'yes'
! 4468: || $ENV{'REQUEST_URI'} eq '/adm/logout'
! 4469: || $env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
! 4470:
! 4471: return $bodytag;
! 4472: }
1.852 droeschl 4473:
1.894 ! droeschl 4474: $bodytag .= Apache::lonhtmlcommon::scripttag(
! 4475: Apache::lonmenu::utilityfunctions(),
! 4476: 'start');
! 4477: $bodytag .= Apache::lonmenu::primary_menu();
! 4478: $bodytag .= Apache::lonmenu::secondary_menu();
! 4479: #SD remove next line
! 4480: #$bodytag .= Apache::lonmenu::menubuttons($forcereg);
! 4481: $bodytag .= Apache::lonmenu::serverform();
! 4482: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
! 4483: $bodytag .= Apache::lonmenu::innerregister($forcereg) if $forcereg;
1.235 raeburn 4484: }
4485: return $bodytag;
1.94 www 4486: }
1.95 www 4487:
1.93 www 4488: #
1.95 www 4489: # Top frame rendering, Remote is up
1.93 www 4490: #
1.359 albertel 4491:
1.517 raeburn 4492: my $imgsrc = $img;
4493: if ($img =~ /^\/adm/) {
1.575 albertel 4494: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4495: }
4496: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4497:
1.305 www 4498: # Explicit link to get inline menu
1.361 albertel 4499: my $menu= ($no_inline_link?''
1.883 droeschl 4500: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
1.853 droeschl 4501: $bodytag .= qq|<div id="LC_nav_bar">$name $role
4502: <em>$realm</em> $dc_info </div>
4503: <ol class="LC_smallMenu LC_right">
4504: <li>$menu</li>
4505: </ol>| unless $env{'form.inhibitmenu'};
1.245 matthew 4506: #
1.94 www 4507: return(<<ENDBODY);
1.60 matthew 4508: $bodytag
1.359 albertel 4509: <table id="LC_title_bar" class="LC_with_remote">
1.791 tempelho 4510: <tr><td>$upperleft</td>
4511: <td>$messages </td>
1.54 www 4512: </tr>
1.359 albertel 4513: <tr><td>$titleinfo $dc_info $menu</td>
1.368 albertel 4514: </tr>
1.356 albertel 4515: </table>
1.54 www 4516: ENDBODY
1.182 matthew 4517: }
4518:
1.330 albertel 4519: sub make_attr_string {
4520: my ($register,$attr_ref) = @_;
4521:
4522: if ($attr_ref && !ref($attr_ref)) {
4523: die("addentries Must be a hash ref ".
4524: join(':',caller(1))." ".
4525: join(':',caller(0))." ");
4526: }
4527:
4528: if ($register) {
1.339 albertel 4529: my ($on_load,$on_unload);
4530: foreach my $key (keys(%{$attr_ref})) {
4531: if (lc($key) eq 'onload') {
4532: $on_load.=$attr_ref->{$key}.';';
4533: delete($attr_ref->{$key});
4534:
4535: } elsif (lc($key) eq 'onunload') {
4536: $on_unload.=$attr_ref->{$key}.';';
4537: delete($attr_ref->{$key});
4538: }
4539: }
4540: $attr_ref->{'onload'} =
4541: &Apache::lonmenu::loadevents(). $on_load;
4542: $attr_ref->{'onunload'}=
4543: &Apache::lonmenu::unloadevents().$on_unload;
4544: }
4545:
4546: # Accessibility font enhance
4547: if ($env{'browser.fontenhance'} eq 'on') {
4548: my $style;
4549: foreach my $key (keys(%{$attr_ref})) {
4550: if (lc($key) eq 'style') {
4551: $style.=$attr_ref->{$key}.';';
4552: delete($attr_ref->{$key});
4553: }
4554: }
4555: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4556: }
1.339 albertel 4557:
1.330 albertel 4558: my $attr_string;
4559: foreach my $attr (keys(%$attr_ref)) {
4560: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4561: }
4562: return $attr_string;
4563: }
4564:
4565:
1.182 matthew 4566: ###############################################
1.251 albertel 4567: ###############################################
4568:
4569: =pod
4570:
4571: =item * &endbodytag()
4572:
4573: Returns a uniform footer for LON-CAPA web pages.
4574:
1.635 raeburn 4575: Inputs: 1 - optional reference to an args hash
4576: If in the hash, key for noredirectlink has a value which evaluates to true,
4577: a 'Continue' link is not displayed if the page contains an
4578: internal redirect in the <head></head> section,
4579: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4580:
4581: =cut
4582:
4583: sub endbodytag {
1.635 raeburn 4584: my ($args) = @_;
1.251 albertel 4585: my $endbodytag='</body>';
1.269 albertel 4586: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4587: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4588: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4589: $endbodytag=
4590: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4591: &mt('Continue').'</a>'.
4592: $endbodytag;
4593: }
1.315 albertel 4594: }
1.251 albertel 4595: return $endbodytag;
4596: }
4597:
1.352 albertel 4598: =pod
4599:
4600: =item * &standard_css()
4601:
4602: Returns a style sheet
4603:
4604: Inputs: (all optional)
4605: domain -> force to color decorate a page for a specific
4606: domain
4607: function -> force usage of a specific rolish color scheme
4608: bgcolor -> override the default page bgcolor
4609:
4610: =cut
4611:
1.343 albertel 4612: sub standard_css {
1.345 albertel 4613: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4614: $function = &get_users_function() if (!$function);
4615: my $img = &designparm($function.'.img', $domain);
4616: my $tabbg = &designparm($function.'.tabbg', $domain);
4617: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 4618: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 4619: #second colour for later usage
1.345 albertel 4620: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4621: my $pgbg_or_bgcolor =
4622: $bgcolor ||
1.352 albertel 4623: &designparm($function.'.pgbg', $domain);
1.382 albertel 4624: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4625: my $alink = &designparm($function.'.alink', $domain);
4626: my $vlink = &designparm($function.'.vlink', $domain);
4627: my $link = &designparm($function.'.link', $domain);
4628:
1.704 muellerd 4629: my $loginbg = &designparm('login.sidebg',$domain);
1.712 muellerd 4630: my $bgcol = &designparm('login.bgcol',$domain);
4631: my $textcol = &designparm('login.textcol',$domain);
1.704 muellerd 4632:
1.602 albertel 4633: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4634: my $mono = 'monospace';
1.850 bisitz 4635: my $data_table_head = $sidebg;
4636: my $data_table_light = '#FAFAFA';
4637: my $data_table_dark = '#F0F0F0';
1.470 banghart 4638: my $data_table_darker = '#CCCCCC';
1.349 albertel 4639: my $data_table_highlight = '#FFFF00';
1.352 albertel 4640: my $mail_new = '#FFBB77';
4641: my $mail_new_hover = '#DD9955';
4642: my $mail_read = '#BBBB77';
4643: my $mail_read_hover = '#999944';
4644: my $mail_replied = '#AAAA88';
4645: my $mail_replied_hover = '#888855';
4646: my $mail_other = '#99BBBB';
4647: my $mail_other_hover = '#669999';
1.391 albertel 4648: my $table_header = '#DDDDDD';
1.489 raeburn 4649: my $feedback_link_bg = '#BBBBBB';
1.701 harmsja 4650: my $lg_border_color = '#C8C8C8';
1.392 albertel 4651:
1.608 albertel 4652: my $border = ($env{'browser.type'} eq 'explorer' ||
1.803 bisitz 4653: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
4654: : '0 3px 0 4px';
1.448 albertel 4655:
1.523 albertel 4656:
1.343 albertel 4657: return <<END;
1.795 www 4658: body {
4659: font-family: $sans;
4660: line-height:130%;
4661: font-size:0.83em;
4662: color:$font;
4663: }
4664:
4665: a:link, a:visited {
4666: font-size:100%;
4667: }
4668:
4669: a:focus {
4670: color: red;
4671: background: yellow
4672: }
1.698 harmsja 4673:
1.795 www 4674: form, .inline {
4675: display: inline;
4676: }
1.721 harmsja 4677:
1.795 www 4678: .LC_right {
4679: text-align:right;
4680: }
4681:
4682: .LC_middle {
4683: vertical-align:middle;
4684: }
1.721 harmsja 4685:
4686: /* just for tests */
1.754 droeschl 4687: .LC_400Box {width:400px; }
1.721 harmsja 4688: /* end */
4689:
1.778 bisitz 4690: .LC_filename {
4691: font-family: $mono;
4692: white-space:pre;
4693: }
4694:
4695: .LC_fileicon {
4696: border: none;
4697: height: 1.3em;
4698: vertical-align: text-bottom;
4699: margin-right: 0.3em;
4700: text-decoration:none;
4701: }
4702:
1.350 albertel 4703: .LC_error {
4704: color: red;
4705: font-size: larger;
4706: }
1.795 www 4707:
1.457 albertel 4708: .LC_warning,
4709: .LC_diff_removed {
1.733 bisitz 4710: color: red;
1.394 albertel 4711: }
1.532 albertel 4712:
4713: .LC_info,
1.457 albertel 4714: .LC_success,
4715: .LC_diff_added {
1.350 albertel 4716: color: green;
4717: }
1.795 www 4718:
1.802 bisitz 4719: div.LC_confirm_box {
4720: background-color: #FAFAFA;
4721: border: 1px solid $lg_border_color;
4722: margin-right: 0;
4723: padding: 5px;
4724: }
4725:
4726: div.LC_confirm_box .LC_error img,
4727: div.LC_confirm_box .LC_success img {
4728: vertical-align: middle;
4729: }
4730:
1.440 albertel 4731: .LC_icon {
1.771 droeschl 4732: border: none;
1.790 droeschl 4733: vertical-align: middle;
1.771 droeschl 4734: }
4735:
1.543 albertel 4736: .LC_docs_spacer {
4737: width: 25px;
4738: height: 1px;
1.771 droeschl 4739: border: none;
1.543 albertel 4740: }
1.346 albertel 4741:
1.532 albertel 4742: .LC_internal_info {
1.735 bisitz 4743: color: #999999;
1.532 albertel 4744: }
4745:
1.794 www 4746: .LC_discussion {
4747: background: $tabbg;
4748: border: 1px solid black;
4749: margin: 2px;
4750: }
4751:
4752: .LC_disc_action_links_bar {
4753: background: $tabbg;
1.803 bisitz 4754: border: none;
1.795 www 4755: margin: 4px;
1.794 www 4756: }
4757:
4758: .LC_disc_action_left {
4759: text-align: left;
4760: }
4761:
4762: .LC_disc_action_right {
4763: text-align: right;
4764: }
4765:
4766: .LC_disc_new_item {
4767: background: white;
4768: border: 2px solid red;
4769: margin: 2px;
4770: }
4771:
4772: .LC_disc_old_item {
4773: background: white;
4774: border: 1px solid black;
4775: margin: 2px;
4776: }
4777:
1.458 albertel 4778: table.LC_pastsubmission {
4779: border: 1px solid black;
4780: margin: 2px;
4781: }
4782:
1.795 www 4783: table#LC_top_nav,
4784: table#LC_menubuttons,
4785: table#LC_nav_location {
1.345 albertel 4786: width: 100%;
4787: background: $pgbg;
1.392 albertel 4788: border: 2px;
1.402 albertel 4789: border-collapse: separate;
1.803 bisitz 4790: padding: 0;
1.345 albertel 4791: }
1.392 albertel 4792:
1.801 tempelho 4793: table#LC_title_bar a {
4794: color: $fontmenu;
4795: }
1.836 bisitz 4796:
1.807 droeschl 4797: table#LC_title_bar {
1.819 tempelho 4798: clear: both;
1.836 bisitz 4799: display: none;
1.807 droeschl 4800: }
4801:
1.795 www 4802: table#LC_title_bar,
4803: table.LC_breadcrumbs,
1.393 albertel 4804: table#LC_title_bar.LC_with_remote {
1.359 albertel 4805: width: 100%;
1.392 albertel 4806: border-color: $pgbg;
4807: border-style: solid;
4808: border-width: $border;
1.379 albertel 4809: background: $pgbg;
1.801 tempelho 4810: color: $fontmenu;
1.392 albertel 4811: border-collapse: collapse;
1.803 bisitz 4812: padding: 0;
1.819 tempelho 4813: margin: 0;
1.359 albertel 4814: }
1.795 www 4815:
1.359 albertel 4816: table#LC_title_bar td {
4817: background: $tabbg;
4818: }
1.795 www 4819:
1.706 harmsja 4820: table#LC_menubuttons img{
1.803 bisitz 4821: border: none;
1.346 albertel 4822: }
1.795 www 4823:
1.345 albertel 4824: table#LC_top_nav td {
4825: background: $tabbg;
1.803 bisitz 4826: border: none;
1.407 albertel 4827: font-size: small;
1.706 harmsja 4828: vertical-align:top;
4829: padding:2px 5px 2px 5px;
1.345 albertel 4830: }
1.795 www 4831:
4832: table#LC_top_nav td a,
4833: div#LC_top_nav a {
1.345 albertel 4834: color: $font;
4835: }
1.795 www 4836:
1.364 albertel 4837: table#LC_top_nav td.LC_top_nav_logo {
4838: background: $tabbg;
1.432 albertel 4839: text-align: left;
1.408 albertel 4840: white-space: nowrap;
1.432 albertel 4841: width: 31px;
1.408 albertel 4842: }
1.795 www 4843:
1.408 albertel 4844: table#LC_top_nav td.LC_top_nav_logo img {
1.803 bisitz 4845: border: none;
1.408 albertel 4846: vertical-align: bottom;
1.364 albertel 4847: }
1.795 www 4848:
1.777 tempelho 4849: table#LC_top_nav td.LC_top_nav_exit,
1.779 bisitz 4850: table#LC_top_nav td.LC_top_nav_help {
1.777 tempelho 4851: width: 2.0em;
4852: }
1.795 www 4853:
1.442 albertel 4854: table#LC_top_nav td.LC_top_nav_login {
4855: width: 4.0em;
4856: text-align: center;
4857: }
1.795 www 4858:
1.842 droeschl 4859: .LC_breadcrumbs_component {
4860: float: right;
4861: margin: 0 1em;
1.357 albertel 4862: }
1.842 droeschl 4863: .LC_breadcrumbs_component img {
4864: vertical-align: middle;
1.777 tempelho 4865: }
1.795 www 4866:
1.383 albertel 4867: td.LC_table_cell_checkbox {
4868: text-align: center;
4869: }
1.795 www 4870:
1.779 bisitz 4871: table#LC_mainmenu td.LC_mainmenu_column {
4872: vertical-align: top;
1.777 tempelho 4873: }
1.522 albertel 4874:
1.795 www 4875: .LC_fontsize_small {
1.705 tempelho 4876: font-size: 70%;
4877: }
4878:
1.844 bisitz 4879: #LC_breadcrumbs {
1.819 tempelho 4880: clear:both;
4881: background: $sidebg;
1.822 bisitz 4882: border-bottom: 1px solid $lg_border_color;
1.819 tempelho 4883: line-height: 32px;
1.822 bisitz 4884: margin: 0;
1.819 tempelho 4885: padding: 0;
4886: }
1.862 bisitz 4887:
1.839 droeschl 4888: /* Preliminary fix to hide breadcrumbs inside remote control window */
1.844 bisitz 4889: #LC_remote #LC_breadcrumbs {
1.839 droeschl 4890: display:none;
4891: }
1.819 tempelho 4892:
1.844 bisitz 4893: #LC_head_subbox {
1.822 bisitz 4894: clear:both;
4895: background: #F8F8F8; /* $sidebg; */
4896: border-bottom: 1px solid $lg_border_color;
4897: margin: 0 0 10px 0;
4898: padding: 5px;
4899: }
4900:
1.795 www 4901: .LC_fontsize_medium {
1.705 tempelho 4902: font-size: 85%;
4903: }
4904:
1.795 www 4905: .LC_fontsize_large {
1.705 tempelho 4906: font-size: 120%;
4907: }
4908:
1.346 albertel 4909: .LC_menubuttons_inline_text {
4910: color: $font;
1.698 harmsja 4911: font-size: 90%;
1.701 harmsja 4912: padding-left:3px;
1.346 albertel 4913: }
4914:
1.526 www 4915: .LC_menubuttons_link {
4916: text-decoration: none;
4917: }
1.795 www 4918:
1.522 albertel 4919: .LC_menubuttons_category {
1.521 www 4920: color: $font;
1.526 www 4921: background: $pgbg;
1.521 www 4922: font-size: larger;
4923: font-weight: bold;
4924: }
4925:
1.346 albertel 4926: td.LC_menubuttons_text {
1.779 bisitz 4927: color: $font;
1.346 albertel 4928: }
1.706 harmsja 4929:
1.346 albertel 4930: .LC_current_location {
4931: background: $tabbg;
4932: }
1.795 www 4933:
1.346 albertel 4934: .LC_new_mail {
1.634 www 4935: background: $tabbg;
1.346 albertel 4936: font-weight: bold;
4937: }
1.347 albertel 4938:
1.795 www 4939: table.LC_data_table,
4940: table.LC_mail_list {
1.347 albertel 4941: border: 1px solid #000000;
1.402 albertel 4942: border-collapse: separate;
1.426 albertel 4943: border-spacing: 1px;
1.610 albertel 4944: background: $pgbg;
1.347 albertel 4945: }
1.795 www 4946:
1.422 albertel 4947: .LC_data_table_dense {
4948: font-size: small;
4949: }
1.795 www 4950:
1.507 raeburn 4951: table.LC_nested_outer {
4952: border: 1px solid #000000;
1.589 raeburn 4953: border-collapse: collapse;
1.803 bisitz 4954: border-spacing: 0;
1.507 raeburn 4955: width: 100%;
4956: }
1.795 www 4957:
1.879 raeburn 4958: table.LC_innerpickbox,
1.507 raeburn 4959: table.LC_nested {
1.803 bisitz 4960: border: none;
1.589 raeburn 4961: border-collapse: collapse;
1.803 bisitz 4962: border-spacing: 0;
1.507 raeburn 4963: width: 100%;
4964: }
1.795 www 4965:
4966: table.LC_data_table tr th,
4967: table.LC_calendar tr th,
4968: table.LC_mail_list tr th,
1.879 raeburn 4969: table.LC_prior_tries tr th,
4970: table.LC_innerpickbox tr th {
1.349 albertel 4971: font-weight: bold;
4972: background-color: $data_table_head;
1.801 tempelho 4973: color:$fontmenu;
1.701 harmsja 4974: font-size:90%;
1.347 albertel 4975: }
1.795 www 4976:
1.879 raeburn 4977: table.LC_innerpickbox tr th,
4978: table.LC_innerpickbox tr td {
4979: vertical-align: top;
4980: }
4981:
1.711 raeburn 4982: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 4983: background-color: #CCCCCC;
1.711 raeburn 4984: font-weight: bold;
4985: text-align: left;
4986: }
1.795 www 4987:
1.779 bisitz 4988: table.LC_data_table tr.LC_odd_row > td,
1.809 bisitz 4989: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 4990: background-color: $data_table_light;
1.425 albertel 4991: padding: 2px;
1.347 albertel 4992: }
1.795 www 4993:
1.610 albertel 4994: table.LC_data_table tr.LC_even_row > td,
1.809 bisitz 4995: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 4996: background-color: $data_table_dark;
1.709 bisitz 4997: padding: 2px;
1.347 albertel 4998: }
1.795 www 4999:
1.425 albertel 5000: table.LC_data_table tr.LC_data_table_highlight td {
5001: background-color: $data_table_darker;
5002: }
1.795 www 5003:
1.639 raeburn 5004: table.LC_data_table tr td.LC_leftcol_header {
5005: background-color: $data_table_head;
5006: font-weight: bold;
5007: }
1.795 www 5008:
1.451 albertel 5009: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5010: table.LC_nested tr.LC_empty_row td {
1.347 albertel 5011: background-color: #FFFFFF;
1.421 albertel 5012: font-weight: bold;
5013: font-style: italic;
5014: text-align: center;
5015: padding: 8px;
1.347 albertel 5016: }
1.795 www 5017:
1.890 droeschl 5018: table.LC_caption {
5019: }
5020:
1.507 raeburn 5021: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5022: padding: 4ex
5023: }
1.795 www 5024:
1.507 raeburn 5025: table.LC_nested_outer tr th {
5026: font-weight: bold;
1.801 tempelho 5027: color:$fontmenu;
1.507 raeburn 5028: background-color: $data_table_head;
1.701 harmsja 5029: font-size: small;
1.507 raeburn 5030: border-bottom: 1px solid #000000;
5031: }
1.795 www 5032:
1.507 raeburn 5033: table.LC_nested_outer tr td.LC_subheader {
5034: background-color: $data_table_head;
5035: font-weight: bold;
5036: font-size: small;
5037: border-bottom: 1px solid #000000;
5038: text-align: right;
1.451 albertel 5039: }
1.795 www 5040:
1.507 raeburn 5041: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5042: background-color: #CCCCCC;
1.451 albertel 5043: font-weight: bold;
5044: font-size: small;
1.507 raeburn 5045: text-align: center;
5046: }
1.795 www 5047:
1.589 raeburn 5048: table.LC_nested tr.LC_info_row td.LC_left_item,
5049: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5050: text-align: left;
1.451 albertel 5051: }
1.795 www 5052:
1.507 raeburn 5053: table.LC_nested td {
1.735 bisitz 5054: background-color: #FFFFFF;
1.451 albertel 5055: font-size: small;
1.507 raeburn 5056: }
1.795 www 5057:
1.507 raeburn 5058: table.LC_nested_outer tr th.LC_right_item,
5059: table.LC_nested tr.LC_info_row td.LC_right_item,
5060: table.LC_nested tr.LC_odd_row td.LC_right_item,
5061: table.LC_nested tr td.LC_right_item {
1.451 albertel 5062: text-align: right;
5063: }
5064:
1.507 raeburn 5065: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5066: background-color: #EEEEEE;
1.451 albertel 5067: }
5068:
1.473 raeburn 5069: table.LC_createuser {
5070: }
5071:
5072: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5073: font-size: small;
1.473 raeburn 5074: }
5075:
5076: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5077: background-color: #CCCCCC;
1.473 raeburn 5078: font-weight: bold;
5079: text-align: center;
5080: }
5081:
1.349 albertel 5082: table.LC_calendar {
5083: border: 1px solid #000000;
5084: border-collapse: collapse;
5085: }
1.795 www 5086:
1.349 albertel 5087: table.LC_calendar_pickdate {
5088: font-size: xx-small;
5089: }
1.795 www 5090:
1.349 albertel 5091: table.LC_calendar tr td {
5092: border: 1px solid #000000;
5093: vertical-align: top;
5094: }
1.795 www 5095:
1.349 albertel 5096: table.LC_calendar tr td.LC_calendar_day_empty {
5097: background-color: $data_table_dark;
5098: }
1.795 www 5099:
1.779 bisitz 5100: table.LC_calendar tr td.LC_calendar_day_current {
5101: background-color: $data_table_highlight;
1.777 tempelho 5102: }
1.795 www 5103:
1.349 albertel 5104: table.LC_mail_list tr.LC_mail_new {
5105: background-color: $mail_new;
5106: }
1.795 www 5107:
1.349 albertel 5108: table.LC_mail_list tr.LC_mail_new:hover {
5109: background-color: $mail_new_hover;
5110: }
1.795 www 5111:
5112: table.LC_mail_list tr.LC_mail_even {
1.777 tempelho 5113: }
1.795 www 5114:
5115: table.LC_mail_list tr.LC_mail_odd {
1.777 tempelho 5116: }
1.795 www 5117:
1.349 albertel 5118: table.LC_mail_list tr.LC_mail_read {
5119: background-color: $mail_read;
5120: }
1.795 www 5121:
1.349 albertel 5122: table.LC_mail_list tr.LC_mail_read:hover {
5123: background-color: $mail_read_hover;
5124: }
1.795 www 5125:
1.349 albertel 5126: table.LC_mail_list tr.LC_mail_replied {
5127: background-color: $mail_replied;
5128: }
1.795 www 5129:
1.349 albertel 5130: table.LC_mail_list tr.LC_mail_replied:hover {
5131: background-color: $mail_replied_hover;
5132: }
1.795 www 5133:
1.349 albertel 5134: table.LC_mail_list tr.LC_mail_other {
5135: background-color: $mail_other;
5136: }
1.795 www 5137:
1.349 albertel 5138: table.LC_mail_list tr.LC_mail_other:hover {
5139: background-color: $mail_other_hover;
5140: }
1.494 raeburn 5141:
1.777 tempelho 5142: table.LC_data_table tr > td.LC_browser_file,
5143: table.LC_data_table tr > td.LC_browser_file_published {
1.389 albertel 5144: background: #CCFF88;
5145: }
1.795 www 5146:
1.777 tempelho 5147: table.LC_data_table tr > td.LC_browser_file_locked,
5148: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5149: background: #FFAA99;
1.387 albertel 5150: }
1.795 www 5151:
1.777 tempelho 5152: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.779 bisitz 5153: background: #AAAAAA;
5154: }
1.795 www 5155:
1.777 tempelho 5156: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5157: table.LC_data_table tr > td.LC_browser_file_metamodified {
5158: background: #FFFF77;
1.777 tempelho 5159: }
1.795 www 5160:
1.696 bisitz 5161: table.LC_data_table tr.LC_browser_folder > td {
1.389 albertel 5162: background: #CCCCFF;
1.387 albertel 5163: }
1.696 bisitz 5164:
1.707 bisitz 5165: table.LC_data_table tr > td.LC_roles_is {
5166: /* background: #77FF77; */
5167: }
1.795 www 5168:
1.707 bisitz 5169: table.LC_data_table tr > td.LC_roles_future {
5170: background: #FFFF77;
5171: }
1.795 www 5172:
1.707 bisitz 5173: table.LC_data_table tr > td.LC_roles_will {
5174: background: #FFAA77;
5175: }
1.795 www 5176:
1.707 bisitz 5177: table.LC_data_table tr > td.LC_roles_expired {
5178: background: #FF7777;
5179: }
1.795 www 5180:
1.707 bisitz 5181: table.LC_data_table tr > td.LC_roles_will_not {
5182: background: #AAFF77;
5183: }
1.795 www 5184:
1.707 bisitz 5185: table.LC_data_table tr > td.LC_roles_selected {
5186: background: #11CC55;
5187: }
5188:
1.388 albertel 5189: span.LC_current_location {
1.701 harmsja 5190: font-size:larger;
1.388 albertel 5191: background: $pgbg;
5192: }
1.387 albertel 5193:
1.395 albertel 5194: span.LC_parm_menu_item {
5195: font-size: larger;
5196: }
1.795 www 5197:
1.395 albertel 5198: span.LC_parm_scope_all {
5199: color: red;
5200: }
1.795 www 5201:
1.395 albertel 5202: span.LC_parm_scope_folder {
5203: color: green;
5204: }
1.795 www 5205:
1.395 albertel 5206: span.LC_parm_scope_resource {
5207: color: orange;
5208: }
1.795 www 5209:
1.395 albertel 5210: span.LC_parm_part {
5211: color: blue;
5212: }
1.795 www 5213:
1.395 albertel 5214: span.LC_parm_folder, span.LC_parm_symb {
5215: font-size: x-small;
5216: font-family: $mono;
5217: color: #AAAAAA;
5218: }
5219:
1.795 www 5220: td.LC_parm_overview_level_menu,
5221: td.LC_parm_overview_map_menu,
5222: td.LC_parm_overview_parm_selectors,
5223: td.LC_parm_overview_restrictions {
1.396 albertel 5224: border: 1px solid black;
5225: border-collapse: collapse;
5226: }
1.795 www 5227:
1.396 albertel 5228: table.LC_parm_overview_restrictions td {
5229: border-width: 1px 4px 1px 4px;
5230: border-style: solid;
5231: border-color: $pgbg;
5232: text-align: center;
5233: }
1.795 www 5234:
1.396 albertel 5235: table.LC_parm_overview_restrictions th {
5236: background: $tabbg;
5237: border-width: 1px 4px 1px 4px;
5238: border-style: solid;
5239: border-color: $pgbg;
5240: }
1.795 www 5241:
1.398 albertel 5242: table#LC_helpmenu {
1.803 bisitz 5243: border: none;
1.398 albertel 5244: height: 55px;
1.803 bisitz 5245: border-spacing: 0;
1.398 albertel 5246: }
5247:
5248: table#LC_helpmenu fieldset legend {
5249: font-size: larger;
5250: }
1.795 www 5251:
1.397 albertel 5252: table#LC_helpmenu_links {
5253: width: 100%;
5254: border: 1px solid black;
5255: background: $pgbg;
1.803 bisitz 5256: padding: 0;
1.397 albertel 5257: border-spacing: 1px;
5258: }
1.795 www 5259:
1.397 albertel 5260: table#LC_helpmenu_links tr td {
5261: padding: 1px;
5262: background: $tabbg;
1.399 albertel 5263: text-align: center;
5264: font-weight: bold;
1.397 albertel 5265: }
1.396 albertel 5266:
1.795 www 5267: table#LC_helpmenu_links a:link,
5268: table#LC_helpmenu_links a:visited,
1.397 albertel 5269: table#LC_helpmenu_links a:active {
5270: text-decoration: none;
5271: color: $font;
5272: }
1.795 www 5273:
1.397 albertel 5274: table#LC_helpmenu_links a:hover {
5275: text-decoration: underline;
5276: color: $vlink;
5277: }
1.396 albertel 5278:
1.417 albertel 5279: .LC_chrt_popup_exists {
5280: border: 1px solid #339933;
5281: margin: -1px;
5282: }
1.795 www 5283:
1.417 albertel 5284: .LC_chrt_popup_up {
5285: border: 1px solid yellow;
5286: margin: -1px;
5287: }
1.795 www 5288:
1.417 albertel 5289: .LC_chrt_popup {
5290: border: 1px solid #8888FF;
5291: background: #CCCCFF;
5292: }
1.795 www 5293:
1.421 albertel 5294: table.LC_pick_box {
5295: border-collapse: separate;
5296: background: white;
5297: border: 1px solid black;
5298: border-spacing: 1px;
5299: }
1.795 www 5300:
1.421 albertel 5301: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 5302: background: $sidebg;
1.421 albertel 5303: font-weight: bold;
5304: text-align: right;
1.740 bisitz 5305: vertical-align: top;
1.421 albertel 5306: width: 184px;
5307: padding: 8px;
5308: }
1.795 www 5309:
1.579 raeburn 5310: table.LC_pick_box td.LC_pick_box_value {
5311: text-align: left;
5312: padding: 8px;
5313: }
1.795 www 5314:
1.579 raeburn 5315: table.LC_pick_box td.LC_pick_box_select {
5316: text-align: left;
5317: padding: 8px;
5318: }
1.795 www 5319:
1.424 albertel 5320: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 5321: padding: 0;
1.421 albertel 5322: height: 1px;
5323: background: black;
5324: }
1.795 www 5325:
1.421 albertel 5326: table.LC_pick_box td.LC_pick_box_submit {
5327: text-align: right;
5328: }
1.795 www 5329:
1.579 raeburn 5330: table.LC_pick_box td.LC_evenrow_value {
5331: text-align: left;
5332: padding: 8px;
5333: background-color: $data_table_light;
5334: }
1.795 www 5335:
1.579 raeburn 5336: table.LC_pick_box td.LC_oddrow_value {
5337: text-align: left;
5338: padding: 8px;
5339: background-color: $data_table_light;
5340: }
1.795 www 5341:
1.579 raeburn 5342: table.LC_helpform_receipt {
5343: width: 620px;
5344: border-collapse: separate;
5345: background: white;
5346: border: 1px solid black;
5347: border-spacing: 1px;
5348: }
1.795 www 5349:
1.579 raeburn 5350: table.LC_helpform_receipt td.LC_pick_box_title {
5351: background: $tabbg;
5352: font-weight: bold;
5353: text-align: right;
5354: width: 184px;
5355: padding: 8px;
5356: }
1.795 www 5357:
1.579 raeburn 5358: table.LC_helpform_receipt td.LC_evenrow_value {
5359: text-align: left;
5360: padding: 8px;
5361: background-color: $data_table_light;
5362: }
1.795 www 5363:
1.579 raeburn 5364: table.LC_helpform_receipt td.LC_oddrow_value {
5365: text-align: left;
5366: padding: 8px;
5367: background-color: $data_table_light;
5368: }
1.795 www 5369:
1.579 raeburn 5370: table.LC_helpform_receipt td.LC_pick_box_separator {
1.803 bisitz 5371: padding: 0;
1.579 raeburn 5372: height: 1px;
5373: background: black;
5374: }
1.795 www 5375:
1.579 raeburn 5376: span.LC_helpform_receipt_cat {
5377: font-weight: bold;
5378: }
1.795 www 5379:
1.424 albertel 5380: table.LC_group_priv_box {
5381: background: white;
5382: border: 1px solid black;
5383: border-spacing: 1px;
5384: }
1.795 www 5385:
1.424 albertel 5386: table.LC_group_priv_box td.LC_pick_box_title {
5387: background: $tabbg;
5388: font-weight: bold;
5389: text-align: right;
5390: width: 184px;
5391: }
1.795 www 5392:
1.424 albertel 5393: table.LC_group_priv_box td.LC_groups_fixed {
5394: background: $data_table_light;
5395: text-align: center;
5396: }
1.795 www 5397:
1.424 albertel 5398: table.LC_group_priv_box td.LC_groups_optional {
5399: background: $data_table_dark;
5400: text-align: center;
5401: }
1.795 www 5402:
1.424 albertel 5403: table.LC_group_priv_box td.LC_groups_functionality {
5404: background: $data_table_darker;
5405: text-align: center;
5406: font-weight: bold;
5407: }
1.795 www 5408:
1.424 albertel 5409: table.LC_group_priv td {
5410: text-align: left;
1.803 bisitz 5411: padding: 0;
1.424 albertel 5412: }
5413:
1.421 albertel 5414: table.LC_notify_front_page {
5415: background: white;
5416: border: 1px solid black;
5417: padding: 8px;
5418: }
1.795 www 5419:
1.421 albertel 5420: table.LC_notify_front_page td {
5421: padding: 8px;
5422: }
1.795 www 5423:
1.424 albertel 5424: .LC_navbuttons {
5425: margin: 2ex 0ex 2ex 0ex;
5426: }
1.795 www 5427:
1.423 albertel 5428: .LC_topic_bar {
5429: font-weight: bold;
5430: width: 100%;
5431: background: $tabbg;
5432: vertical-align: middle;
5433: margin: 2ex 0ex 2ex 0ex;
1.805 bisitz 5434: padding: 3px;
1.423 albertel 5435: }
1.795 www 5436:
1.423 albertel 5437: .LC_topic_bar span {
5438: vertical-align: middle;
5439: }
1.795 www 5440:
1.423 albertel 5441: .LC_topic_bar img {
5442: vertical-align: bottom;
5443: }
1.795 www 5444:
1.423 albertel 5445: table.LC_course_group_status {
5446: margin: 20px;
5447: }
1.795 www 5448:
1.423 albertel 5449: table.LC_status_selector td {
5450: vertical-align: top;
5451: text-align: center;
1.424 albertel 5452: padding: 4px;
5453: }
1.795 www 5454:
1.599 albertel 5455: div.LC_feedback_link {
1.616 albertel 5456: clear: both;
1.829 kalberla 5457: background: $sidebg;
1.779 bisitz 5458: width: 100%;
1.829 kalberla 5459: padding-bottom: 10px;
5460: border: 1px $tabbg solid;
1.833 kalberla 5461: height: 22px;
5462: line-height: 22px;
5463: padding-top: 5px;
5464: }
5465:
5466: div.LC_feedback_link img {
5467: height: 22px;
1.867 kalberla 5468: vertical-align:middle;
1.829 kalberla 5469: }
5470:
5471: div.LC_feedback_link a{
5472: text-decoration: none;
1.489 raeburn 5473: }
1.795 www 5474:
1.867 kalberla 5475: div.LC_comblock {
5476: display:inline;
5477: color:$font;
5478: font-size:90%;
5479: }
5480:
5481: div.LC_feedback_link div.LC_comblock {
5482: padding-left:5px;
5483: }
5484:
5485: div.LC_feedback_link div.LC_comblock a {
5486: color:$font;
5487: }
5488:
1.489 raeburn 5489: span.LC_feedback_link {
1.858 bisitz 5490: /* background: $feedback_link_bg; */
1.599 albertel 5491: font-size: larger;
5492: }
1.795 www 5493:
1.599 albertel 5494: span.LC_message_link {
1.858 bisitz 5495: /* background: $feedback_link_bg; */
1.599 albertel 5496: font-size: larger;
5497: position: absolute;
5498: right: 1em;
1.489 raeburn 5499: }
1.421 albertel 5500:
1.515 albertel 5501: table.LC_prior_tries {
1.524 albertel 5502: border: 1px solid #000000;
5503: border-collapse: separate;
5504: border-spacing: 1px;
1.515 albertel 5505: }
1.523 albertel 5506:
1.515 albertel 5507: table.LC_prior_tries td {
1.524 albertel 5508: padding: 2px;
1.515 albertel 5509: }
1.523 albertel 5510:
5511: .LC_answer_correct {
1.795 www 5512: background: lightgreen;
5513: color: darkgreen;
5514: padding: 6px;
1.523 albertel 5515: }
1.795 www 5516:
1.523 albertel 5517: .LC_answer_charged_try {
1.797 www 5518: background: #FFAAAA;
1.795 www 5519: color: darkred;
5520: padding: 6px;
1.523 albertel 5521: }
1.795 www 5522:
1.779 bisitz 5523: .LC_answer_not_charged_try,
1.523 albertel 5524: .LC_answer_no_grade,
5525: .LC_answer_late {
1.795 www 5526: background: lightyellow;
1.523 albertel 5527: color: black;
1.795 www 5528: padding: 6px;
1.523 albertel 5529: }
1.795 www 5530:
1.523 albertel 5531: .LC_answer_previous {
1.795 www 5532: background: lightblue;
5533: color: darkblue;
5534: padding: 6px;
1.523 albertel 5535: }
1.795 www 5536:
1.779 bisitz 5537: .LC_answer_no_message {
1.777 tempelho 5538: background: #FFFFFF;
5539: color: black;
1.795 www 5540: padding: 6px;
1.779 bisitz 5541: }
1.795 www 5542:
1.779 bisitz 5543: .LC_answer_unknown {
5544: background: orange;
5545: color: black;
1.795 www 5546: padding: 6px;
1.777 tempelho 5547: }
1.795 www 5548:
1.529 albertel 5549: span.LC_prior_numerical,
5550: span.LC_prior_string,
5551: span.LC_prior_custom,
5552: span.LC_prior_reaction,
5553: span.LC_prior_math {
1.523 albertel 5554: font-family: monospace;
5555: white-space: pre;
5556: }
5557:
1.525 albertel 5558: span.LC_prior_string {
5559: font-family: monospace;
5560: white-space: pre;
5561: }
5562:
1.523 albertel 5563: table.LC_prior_option {
5564: width: 100%;
5565: border-collapse: collapse;
5566: }
1.795 www 5567:
5568: table.LC_prior_rank,
5569: table.LC_prior_match {
1.528 albertel 5570: border-collapse: collapse;
5571: }
1.795 www 5572:
1.528 albertel 5573: table.LC_prior_option tr td,
5574: table.LC_prior_rank tr td,
5575: table.LC_prior_match tr td {
1.524 albertel 5576: border: 1px solid #000000;
1.515 albertel 5577: }
5578:
1.855 bisitz 5579: .LC_nobreak {
1.544 albertel 5580: white-space: nowrap;
1.519 raeburn 5581: }
5582:
1.576 raeburn 5583: span.LC_cusr_emph {
5584: font-style: italic;
5585: }
5586:
1.633 raeburn 5587: span.LC_cusr_subheading {
5588: font-weight: normal;
5589: font-size: 85%;
5590: }
5591:
1.545 albertel 5592: table.LC_docs_documents {
5593: background: #BBBBBB;
1.803 bisitz 5594: border-width: 0;
1.545 albertel 5595: border-collapse: collapse;
5596: }
1.795 www 5597:
1.777 tempelho 5598: table.LC_docs_documents td.LC_docs_document {
1.779 bisitz 5599: border: 2px solid black;
5600: padding: 4px;
1.777 tempelho 5601: }
1.795 www 5602:
1.861 bisitz 5603: div.LC_docs_entry_move {
1.859 bisitz 5604: border: 1px solid #BBBBBB;
1.545 albertel 5605: background: #DDDDDD;
1.861 bisitz 5606: width: 22px;
1.859 bisitz 5607: padding: 1px;
5608: margin: 0;
1.545 albertel 5609: }
5610:
1.861 bisitz 5611: table.LC_data_table tr > td.LC_docs_entry_commands,
5612: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 5613: background: #DDDDDD;
5614: font-size: x-small;
5615: }
1.795 www 5616:
1.861 bisitz 5617: .LC_docs_entry_parameter {
5618: white-space: nowrap;
5619: }
5620:
1.544 albertel 5621: .LC_docs_copy {
1.545 albertel 5622: color: #000099;
1.544 albertel 5623: }
1.795 www 5624:
1.544 albertel 5625: .LC_docs_cut {
1.545 albertel 5626: color: #550044;
1.544 albertel 5627: }
1.795 www 5628:
1.544 albertel 5629: .LC_docs_rename {
1.545 albertel 5630: color: #009900;
1.544 albertel 5631: }
1.795 www 5632:
1.544 albertel 5633: .LC_docs_remove {
1.545 albertel 5634: color: #990000;
5635: }
5636:
1.547 albertel 5637: .LC_docs_reinit_warn,
5638: .LC_docs_ext_edit {
5639: font-size: x-small;
5640: }
5641:
1.545 albertel 5642: table.LC_docs_adddocs td,
5643: table.LC_docs_adddocs th {
5644: border: 1px solid #BBBBBB;
5645: padding: 4px;
5646: background: #DDDDDD;
1.543 albertel 5647: }
5648:
1.584 albertel 5649: table.LC_sty_begin {
5650: background: #BBFFBB;
5651: }
1.795 www 5652:
1.584 albertel 5653: table.LC_sty_end {
5654: background: #FFBBBB;
5655: }
5656:
1.589 raeburn 5657: table.LC_double_column {
1.803 bisitz 5658: border-width: 0;
1.589 raeburn 5659: border-collapse: collapse;
5660: width: 100%;
5661: padding: 2px;
5662: }
5663:
5664: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5665: top: 2px;
1.589 raeburn 5666: left: 2px;
5667: width: 47%;
5668: vertical-align: top;
5669: }
5670:
5671: table.LC_double_column tr td.LC_right_col {
5672: top: 2px;
1.779 bisitz 5673: right: 2px;
1.589 raeburn 5674: width: 47%;
5675: vertical-align: top;
5676: }
5677:
1.591 raeburn 5678: div.LC_left_float {
5679: float: left;
5680: padding-right: 5%;
1.597 albertel 5681: padding-bottom: 4px;
1.591 raeburn 5682: }
5683:
5684: div.LC_clear_float_header {
1.597 albertel 5685: padding-bottom: 2px;
1.591 raeburn 5686: }
5687:
5688: div.LC_clear_float_footer {
1.597 albertel 5689: padding-top: 10px;
1.591 raeburn 5690: clear: both;
5691: }
5692:
1.597 albertel 5693: div.LC_grade_show_user {
5694: margin-top: 20px;
5695: border: 1px solid black;
5696: }
1.795 www 5697:
1.597 albertel 5698: div.LC_grade_user_name {
5699: background: #DDDDEE;
5700: border-bottom: 1px solid black;
1.705 tempelho 5701: font-weight: bold;
5702: font-size: large;
1.597 albertel 5703: }
1.795 www 5704:
1.597 albertel 5705: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5706: background: #DDEEDD;
5707: }
5708:
5709: div.LC_grade_show_problem,
5710: div.LC_grade_submissions,
5711: div.LC_grade_message_center,
5712: div.LC_grade_info_links,
5713: div.LC_grade_assign {
5714: margin: 5px;
5715: width: 99%;
5716: background: #FFFFFF;
5717: }
1.795 www 5718:
1.597 albertel 5719: div.LC_grade_show_problem_header,
5720: div.LC_grade_submissions_header,
5721: div.LC_grade_message_center_header,
5722: div.LC_grade_assign_header {
1.705 tempelho 5723: font-weight: bold;
5724: font-size: large;
1.597 albertel 5725: }
1.795 www 5726:
1.597 albertel 5727: div.LC_grade_show_problem_problem,
5728: div.LC_grade_submissions_body,
5729: div.LC_grade_message_center_body,
5730: div.LC_grade_assign_body {
5731: border: 1px solid black;
5732: width: 99%;
5733: background: #FFFFFF;
5734: }
1.795 www 5735:
1.598 albertel 5736: span.LC_grade_check_note {
1.705 tempelho 5737: font-weight: normal;
5738: font-size: medium;
1.598 albertel 5739: display: inline;
5740: position: absolute;
5741: right: 1em;
5742: }
1.597 albertel 5743:
1.613 albertel 5744: table.LC_scantron_action {
5745: width: 100%;
5746: }
1.795 www 5747:
1.613 albertel 5748: table.LC_scantron_action tr th {
1.698 harmsja 5749: font-weight:bold;
5750: font-style:normal;
1.613 albertel 5751: }
1.795 www 5752:
1.779 bisitz 5753: .LC_edit_problem_header,
1.614 albertel 5754: div.LC_edit_problem_footer {
1.705 tempelho 5755: font-weight: normal;
5756: font-size: medium;
1.602 albertel 5757: margin: 2px;
1.600 albertel 5758: }
1.795 www 5759:
1.600 albertel 5760: div.LC_edit_problem_header,
1.602 albertel 5761: div.LC_edit_problem_header div,
1.614 albertel 5762: div.LC_edit_problem_footer,
5763: div.LC_edit_problem_footer div,
1.602 albertel 5764: div.LC_edit_problem_editxml_header,
5765: div.LC_edit_problem_editxml_header div {
1.600 albertel 5766: margin-top: 5px;
5767: }
1.795 www 5768:
1.600 albertel 5769: div.LC_edit_problem_header_title {
1.705 tempelho 5770: font-weight: bold;
5771: font-size: larger;
1.602 albertel 5772: background: $tabbg;
5773: padding: 3px;
5774: }
1.795 www 5775:
1.602 albertel 5776: table.LC_edit_problem_header_title {
1.705 tempelho 5777: font-size: larger;
5778: font-weight: bold;
1.602 albertel 5779: width: 100%;
5780: border-color: $pgbg;
5781: border-style: solid;
5782: border-width: $border;
1.600 albertel 5783: background: $tabbg;
1.602 albertel 5784: border-collapse: collapse;
1.803 bisitz 5785: padding: 0;
1.602 albertel 5786: }
5787:
5788: div.LC_edit_problem_discards {
5789: float: left;
5790: padding-bottom: 5px;
5791: }
1.795 www 5792:
1.602 albertel 5793: div.LC_edit_problem_saves {
5794: float: right;
5795: padding-bottom: 5px;
1.600 albertel 5796: }
1.795 www 5797:
1.679 riegler 5798: img.stift{
1.803 bisitz 5799: border-width: 0;
5800: vertical-align: middle;
1.677 riegler 5801: }
1.680 riegler 5802:
1.681 riegler 5803: table#LC_mainmenu{
5804: margin-top:10px;
5805: width:80%;
5806: }
5807:
1.680 riegler 5808: table#LC_mainmenu td.LC_mainmenu_col_fieldset{
5809: vertical-align: top;
5810: width: 45%;
5811: }
1.795 www 5812:
1.779 bisitz 5813: .LC_mainmenu_fieldset_category {
5814: color: $font;
5815: background: $pgbg;
5816: font-size: small;
5817: font-weight: bold;
1.777 tempelho 5818: }
1.795 www 5819:
1.716 raeburn 5820: div.LC_createcourse {
5821: margin: 10px 10px 10px 10px;
5822: }
5823:
1.693 droeschl 5824: /* ---- Remove when done ----
5825: # The following styles is part of the redesign of LON-CAPA and are
5826: # subject to change during this project.
5827: # Don't rely on their current functionality as they might be
5828: # changed or removed.
5829: # --------------------------*/
5830:
1.698 harmsja 5831: a:hover,
1.721 harmsja 5832: ol.LC_smallMenu a:hover,
5833: ol#LC_MenuBreadcrumbs a:hover,
5834: ol#LC_PathBreadcrumbs a:hover,
5835: ul#LC_TabMainMenuContent a:hover,
5836: .LC_FormSectionClearButton input:hover
1.795 www 5837: ul.LC_TabContent li:hover a {
1.698 harmsja 5838: color:#BF2317;
5839: text-decoration:none;
1.693 droeschl 5840: }
5841:
1.779 bisitz 5842: h1 {
1.813 bisitz 5843: padding: 0;
1.693 droeschl 5844: line-height:130%;
5845: }
1.698 harmsja 5846:
1.795 www 5847: h2,h3,h4,h5,h6 {
1.803 bisitz 5848: margin: 5px 0 5px 0;
5849: padding: 0;
1.721 harmsja 5850: line-height:130%;
1.693 droeschl 5851: }
1.795 www 5852:
5853: .LC_hcell {
1.698 harmsja 5854: padding:3px 15px 3px 15px;
1.803 bisitz 5855: margin: 0;
1.703 harmsja 5856: background-color:$tabbg;
1.801 tempelho 5857: color:$fontmenu;
1.779 bisitz 5858: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 5859: }
1.795 www 5860:
1.840 bisitz 5861: .LC_Box > .LC_hcell {
1.847 tempelho 5862: margin: 0 -10px 10px -10px;
1.835 bisitz 5863: }
5864:
1.721 harmsja 5865: .LC_noBorder {
1.803 bisitz 5866: border: 0;
1.698 harmsja 5867: }
1.693 droeschl 5868:
1.761 tempelho 5869: .LC_Right {
5870: float: right;
1.803 bisitz 5871: margin: 0;
5872: padding: 0;
1.761 tempelho 5873: }
5874:
1.721 harmsja 5875: .LC_FormSectionClearButton input {
1.779 bisitz 5876: background-color:transparent;
1.803 bisitz 5877: border: none;
1.698 harmsja 5878: cursor:pointer;
5879: text-decoration:underline;
1.693 droeschl 5880: }
1.763 bisitz 5881:
5882: .LC_help_open_topic {
5883: color: #FFFFFF;
5884: background-color: #EEEEFF;
5885: margin: 1px;
5886: padding: 4px;
5887: border: 1px solid #000033;
5888: white-space: nowrap;
1.783 amueller 5889: /* vertical-align: middle; */
1.759 neumanie 5890: }
1.693 droeschl 5891:
1.698 harmsja 5892: dl,ul,div,fieldset {
1.803 bisitz 5893: margin: 10px 10px 10px 0;
1.806 bisitz 5894: /* overflow: hidden; */
1.693 droeschl 5895: }
1.795 www 5896:
1.838 bisitz 5897: fieldset > legend {
5898: font-weight: bold;
5899: padding: 0 5px 0 5px;
5900: }
5901:
1.813 bisitz 5902: #LC_nav_bar {
1.807 droeschl 5903: float: left;
1.852 droeschl 5904: margin: 0.2em 0 0 0;
1.807 droeschl 5905: }
5906:
1.813 bisitz 5907: #LC_nav_bar em{
1.807 droeschl 5908: font-weight: bold;
5909: font-style: normal;
5910: }
5911:
5912: ol.LC_smallMenu {
5913: float: right;
1.852 droeschl 5914: margin: 0.2em 0 0 0;
1.807 droeschl 5915: }
5916:
1.852 droeschl 5917: ol#LC_PathBreadcrumbs {
1.803 bisitz 5918: margin: 0;
1.693 droeschl 5919: }
5920:
1.721 harmsja 5921: ol.LC_smallMenu li {
1.693 droeschl 5922: display: inline;
1.803 bisitz 5923: padding: 5px 5px 0 10px;
1.693 droeschl 5924: vertical-align: top;
5925: }
5926:
1.721 harmsja 5927: ol.LC_smallMenu li img {
1.693 droeschl 5928: vertical-align: bottom;
5929: }
5930:
1.721 harmsja 5931: ol.LC_smallMenu a {
1.693 droeschl 5932: font-size: 90%;
5933: color: RGB(80, 80, 80);
5934: text-decoration: none;
5935: }
1.795 www 5936:
1.808 droeschl 5937: ul#LC_TabMainMenuContent {
1.807 droeschl 5938: clear: both;
1.808 droeschl 5939: color: $fontmenu;
5940: background: $tabbg;
5941: list-style: none;
5942: padding: 0;
5943: margin: 0;
5944: width: 100%;
5945: }
5946:
5947: ul#LC_TabMainMenuContent li {
5948: font-weight: bold;
5949: line-height: 1.8em;
5950: padding: 0 0.8em;
5951: border-right: 1px solid black;
5952: display: inline;
5953: vertical-align: middle;
1.807 droeschl 5954: }
5955:
1.847 tempelho 5956: ul.LC_TabContent {
1.721 harmsja 5957: display:block;
1.847 tempelho 5958: background: $sidebg;
1.858 bisitz 5959: border-bottom: solid 1px $lg_border_color;
1.721 harmsja 5960: list-style:none;
1.870 tempelho 5961: margin: 0 -10px;
1.803 bisitz 5962: padding: 0;
1.693 droeschl 5963: }
5964:
1.795 www 5965: ul.LC_TabContent li,
5966: ul.LC_TabContentBigger li {
1.741 harmsja 5967: float:left;
5968: }
1.795 www 5969:
1.808 droeschl 5970: ul#LC_TabMainMenuContent li a {
5971: color: $fontmenu;
1.693 droeschl 5972: text-decoration: none;
5973: }
1.795 www 5974:
1.721 harmsja 5975: ul.LC_TabContent {
1.847 tempelho 5976: min-height:1.5em;
1.721 harmsja 5977: }
1.795 www 5978:
5979: ul.LC_TabContent li {
1.741 harmsja 5980: vertical-align:middle;
1.803 bisitz 5981: padding: 0 10px 0 10px;
1.745 ehlerst 5982: background-color:$tabbg;
5983: border-bottom:solid 1px $lg_border_color;
1.721 harmsja 5984: }
1.795 www 5985:
1.847 tempelho 5986: ul.LC_TabContent .right {
5987: float:right;
5988: }
5989:
1.795 www 5990: ul.LC_TabContent li a, ul.LC_TabContent li {
1.721 harmsja 5991: color:rgb(47,47,47);
5992: text-decoration:none;
5993: font-size:95%;
5994: font-weight:bold;
1.761 tempelho 5995: padding-right: 16px;
1.721 harmsja 5996: }
1.795 www 5997:
5998: ul.LC_TabContent li:hover, ul.LC_TabContent li.active {
1.761 tempelho 5999: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.841 tempelho 6000: border-bottom:solid 2px #FFFFFF;
1.761 tempelho 6001: padding-right: 16px;
1.744 ehlerst 6002: }
1.795 www 6003:
1.870 tempelho 6004: #maincoursedoc {
6005: clear:both;
6006: }
6007:
6008: ul.LC_TabContentBigger {
6009: display:block;
6010: list-style:none;
6011: padding: 0;
6012: }
6013:
1.795 www 6014: ul.LC_TabContentBigger li {
1.870 tempelho 6015: vertical-align:bottom;
6016: height: 30px;
6017: font-size:110%;
6018: font-weight:bold;
6019: color: #737373;
1.841 tempelho 6020: }
6021:
1.870 tempelho 6022:
6023: ul.LC_TabContentBigger li a {
6024: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6025: height: 30px;
6026: line-height: 30px;
6027: text-align: center;
6028: display: block;
6029: text-decoration: none;
1.741 harmsja 6030: }
1.795 www 6031:
1.870 tempelho 6032: ul.LC_TabContentBigger li:hover a,
6033: ul.LC_TabContentBigger li.active a {
6034: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
1.857 tempelho 6035: color:$font;
1.870 tempelho 6036: text-decoration: underline;
1.744 ehlerst 6037: }
1.795 www 6038:
1.870 tempelho 6039:
6040: ul.LC_TabContentBigger li b {
6041: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6042: display: block;
6043: float: left;
6044: padding: 0 30px;
6045: }
6046:
6047: ul.LC_TabContentBigger li:hover b,
6048: ul.LC_TabContentBigger li.active b {
6049: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6050: color:$font;
6051: border-bottom: 1px solid #FFFFFF;
1.741 harmsja 6052: }
1.693 droeschl 6053:
1.870 tempelho 6054:
1.862 bisitz 6055: ul.LC_CourseBreadcrumbs {
6056: background: $sidebg;
6057: line-height: 32px;
6058: padding-left: 10px;
6059: margin: 0 0 10px 0;
6060: list-style-position: inside;
6061:
6062: }
6063:
1.795 www 6064: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6065: ol#LC_PathBreadcrumbs {
1.693 droeschl 6066: padding-left: 10px;
1.819 tempelho 6067: margin: 0;
1.693 droeschl 6068: list-style-position: inside;
6069: }
6070:
1.795 www 6071: ol#LC_MenuBreadcrumbs li,
6072: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6073: ul.LC_CourseBreadcrumbs li {
1.842 droeschl 6074: display: inline;
6075: white-space: nowrap;
1.693 droeschl 6076: }
6077:
1.823 bisitz 6078: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6079: ul.LC_CourseBreadcrumbs li a {
1.693 droeschl 6080: text-decoration: none;
6081: font-size:90%;
6082: }
1.795 www 6083:
6084: ol#LC_PathBreadcrumbs li a {
1.698 harmsja 6085: text-decoration:none;
6086: font-size:100%;
6087: font-weight:bold;
1.693 droeschl 6088: }
1.795 www 6089:
1.840 bisitz 6090: .LC_Box {
1.835 bisitz 6091: border: solid 1px $lg_border_color;
6092: padding: 0 10px 10px 10px;
1.746 neumanie 6093: }
1.795 www 6094:
6095: .LC_AboutMe_Image {
1.747 neumanie 6096: float:left;
6097: margin-right:10px;
6098: }
1.795 www 6099:
6100: .LC_Clear_AboutMe_Image {
1.747 neumanie 6101: clear:left;
6102: }
1.795 www 6103:
1.721 harmsja 6104: dl.LC_ListStyleClean dt {
1.693 droeschl 6105: padding-right: 5px;
6106: display: table-header-group;
6107: }
6108:
1.721 harmsja 6109: dl.LC_ListStyleClean dd {
1.693 droeschl 6110: display: table-row;
6111: }
6112:
1.721 harmsja 6113: .LC_ListStyleClean,
6114: .LC_ListStyleSimple,
6115: .LC_ListStyleNormal,
1.777 tempelho 6116: .LC_ListStyle_Border,
1.795 www 6117: .LC_ListStyleSpecial {
1.693 droeschl 6118: /*display:block; */
6119: list-style-position: inside;
6120: list-style-type: none;
6121: overflow: hidden;
1.803 bisitz 6122: padding: 0;
1.693 droeschl 6123: }
6124:
1.721 harmsja 6125: .LC_ListStyleSimple li,
6126: .LC_ListStyleSimple dd,
6127: .LC_ListStyleNormal li,
6128: .LC_ListStyleNormal dd,
6129: .LC_ListStyleSpecial li,
1.795 www 6130: .LC_ListStyleSpecial dd {
1.803 bisitz 6131: margin: 0;
1.693 droeschl 6132: padding: 5px 5px 5px 10px;
6133: clear: both;
6134: }
6135:
1.721 harmsja 6136: .LC_ListStyleClean li,
6137: .LC_ListStyleClean dd {
1.803 bisitz 6138: padding-top: 0;
6139: padding-bottom: 0;
1.693 droeschl 6140: }
6141:
1.721 harmsja 6142: .LC_ListStyleSimple dd,
1.795 www 6143: .LC_ListStyleSimple li {
1.698 harmsja 6144: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 6145: }
6146:
1.721 harmsja 6147: .LC_ListStyleSpecial li,
6148: .LC_ListStyleSpecial dd {
1.693 droeschl 6149: list-style-type: none;
6150: background-color: RGB(220, 220, 220);
6151: margin-bottom: 4px;
6152: }
6153:
1.721 harmsja 6154: table.LC_SimpleTable {
1.698 harmsja 6155: margin:5px;
6156: border:solid 1px $lg_border_color;
1.795 www 6157: }
1.693 droeschl 6158:
1.721 harmsja 6159: table.LC_SimpleTable tr {
1.803 bisitz 6160: padding: 0;
1.698 harmsja 6161: border:solid 1px $lg_border_color;
1.693 droeschl 6162: }
1.795 www 6163:
6164: table.LC_SimpleTable thead {
1.698 harmsja 6165: background:rgb(220,220,220);
1.693 droeschl 6166: }
6167:
1.721 harmsja 6168: div.LC_columnSection {
1.693 droeschl 6169: display: block;
6170: clear: both;
6171: overflow: hidden;
1.803 bisitz 6172: margin: 0;
1.693 droeschl 6173: }
6174:
1.721 harmsja 6175: div.LC_columnSection>* {
1.693 droeschl 6176: float: left;
1.803 bisitz 6177: margin: 10px 20px 10px 0;
1.747 neumanie 6178: overflow:hidden;
1.693 droeschl 6179: }
1.721 harmsja 6180:
1.694 tempelho 6181: .LC_loginpage_container {
6182: text-align:left;
6183: margin : 0 auto;
1.785 tempelho 6184: width:90%;
1.694 tempelho 6185: padding: 10px;
6186: height: auto;
1.712 muellerd 6187: background-color:#FFFFFF;
1.694 tempelho 6188: border:1px solid #CCCCCC;
6189: }
6190:
6191:
6192: .LC_loginpage_loginContainer {
6193: float:left;
1.712 muellerd 6194: width: 182px;
1.785 tempelho 6195: padding: 2px;
1.712 muellerd 6196: border:1px solid #CCCCCC;
6197: background-color:$loginbg;
1.694 tempelho 6198: }
6199:
1.795 www 6200: .LC_loginpage_loginContainer h2 {
1.803 bisitz 6201: margin-top: 0;
1.712 muellerd 6202: display:block;
6203: background:$bgcol;
6204: color:$textcol;
6205: padding-left:5px;
6206: }
1.785 tempelho 6207:
1.694 tempelho 6208: .LC_loginpage_loginInfo {
6209: float:left;
1.785 tempelho 6210: width:182px;
1.694 tempelho 6211: border:1px solid #CCCCCC;
1.785 tempelho 6212: padding:2px;
1.712 muellerd 6213: }
6214:
1.694 tempelho 6215: .LC_loginpage_space {
1.754 droeschl 6216: clear: both;
6217: margin-bottom: 20px;
1.694 tempelho 6218: border-bottom: 1px solid #CCCCCC;
6219: }
6220:
1.785 tempelho 6221: .LC_loginpage_floatLeft {
6222: float: left;
6223: width: 200px;
6224: margin: 0;
6225: }
6226:
1.795 www 6227: table em {
1.754 droeschl 6228: font-weight: bold;
6229: font-style: normal;
1.748 schulted 6230: }
1.795 www 6231:
1.779 bisitz 6232: table.LC_tableBrowseRes,
1.795 www 6233: table.LC_tableOfContent {
1.769 schulted 6234: border:none;
1.858 bisitz 6235: border-spacing: 1px;
1.754 droeschl 6236: padding: 3px;
6237: background-color: #FFFFFF;
6238: font-size: 90%;
1.753 droeschl 6239: }
1.789 droeschl 6240:
6241: table.LC_tableOfContent{
6242: border-collapse: collapse;
6243: }
6244:
1.771 droeschl 6245: table.LC_tableBrowseRes a,
1.768 schulted 6246: table.LC_tableOfContent a {
1.771 droeschl 6247: background-color: transparent;
1.753 droeschl 6248: text-decoration: none;
6249: }
6250:
1.771 droeschl 6251: table.LC_tableBrowseRes tr.LC_trOdd,
1.768 schulted 6252: table.LC_tableOfContent tr.LC_trOdd{
1.754 droeschl 6253: background-color: #EEEEEE;
1.753 droeschl 6254: }
6255:
1.795 www 6256: table.LC_tableOfContent img {
1.753 droeschl 6257: border: none;
6258: height: 1.3em;
6259: vertical-align: text-bottom;
6260: margin-right: 0.3em;
6261: }
1.757 schulted 6262:
1.795 www 6263: a#LC_content_toolbar_firsthomework {
1.774 ehlerst 6264: background-image:url(/res/adm/pages/open-first-problem.gif);
6265: }
6266:
1.795 www 6267: a#LC_content_toolbar_launchnav {
1.774 ehlerst 6268: background-image:url(/res/adm/pages/start-navigation.gif);
6269: }
6270:
1.795 www 6271: a#LC_content_toolbar_closenav {
1.774 ehlerst 6272: background-image:url(/res/adm/pages/close-navigation.gif);
6273: }
6274:
1.795 www 6275: a#LC_content_toolbar_everything {
1.774 ehlerst 6276: background-image:url(/res/adm/pages/show-all.gif);
6277: }
6278:
1.795 www 6279: a#LC_content_toolbar_uncompleted {
1.774 ehlerst 6280: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
6281: }
6282:
1.795 www 6283: #LC_content_toolbar_clearbubbles {
1.774 ehlerst 6284: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
6285: }
6286:
1.795 www 6287: a#LC_content_toolbar_changefolder {
1.757 schulted 6288: background : url(/res/adm/pages/close-all-folders.gif) top center ;
6289: }
6290:
1.795 www 6291: a#LC_content_toolbar_changefolder_toggled {
1.757 schulted 6292: background-image:url(/res/adm/pages/open-all-folders.gif);
6293: }
6294:
1.795 www 6295: ul#LC_toolbar li a:hover {
1.757 schulted 6296: background-position: bottom center;
6297: }
6298:
1.795 www 6299: ul#LC_toolbar {
1.803 bisitz 6300: padding: 0;
1.757 schulted 6301: margin: 2px;
6302: list-style:none;
6303: position:relative;
6304: background-color:white;
6305: }
6306:
1.795 www 6307: ul#LC_toolbar li {
1.757 schulted 6308: border:1px solid white;
1.803 bisitz 6309: padding: 0;
1.757 schulted 6310: margin: 0;
1.795 www 6311: float: left;
1.767 droeschl 6312: display:inline;
1.757 schulted 6313: vertical-align:middle;
1.795 www 6314: }
1.757 schulted 6315:
1.783 amueller 6316:
1.795 www 6317: a.LC_toolbarItem {
1.767 droeschl 6318: display:block;
1.803 bisitz 6319: padding: 0;
6320: margin: 0;
1.757 schulted 6321: height: 32px;
6322: width: 32px;
1.779 bisitz 6323: color:white;
1.803 bisitz 6324: border: none;
1.757 schulted 6325: background-repeat:no-repeat;
6326: background-color:transparent;
6327: }
6328:
1.843 bisitz 6329: ul.LC_funclist li {
1.782 bisitz 6330: float: left;
6331: white-space: nowrap;
6332: height: 35px; /* at least as high as heighest list item */
1.803 bisitz 6333: margin: 0 15px 15px 10px;
1.782 bisitz 6334: }
6335:
1.757 schulted 6336:
1.343 albertel 6337: END
6338: }
6339:
1.306 albertel 6340: =pod
6341:
6342: =item * &headtag()
6343:
6344: Returns a uniform footer for LON-CAPA web pages.
6345:
1.307 albertel 6346: Inputs: $title - optional title for the head
6347: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 6348: $args - optional arguments
1.319 albertel 6349: force_register - if is true call registerurl so the remote is
6350: informed
1.415 albertel 6351: redirect -> array ref of
6352: 1- seconds before redirect occurs
6353: 2- url to redirect to
6354: 3- whether the side effect should occur
1.315 albertel 6355: (side effect of setting
6356: $env{'internal.head.redirect'} to the url
6357: redirected too)
1.352 albertel 6358: domain -> force to color decorate a page for a specific
6359: domain
6360: function -> force usage of a specific rolish color scheme
6361: bgcolor -> override the default page bgcolor
1.460 albertel 6362: no_auto_mt_title
6363: -> prevent &mt()ing the title arg
1.464 albertel 6364:
1.306 albertel 6365: =cut
6366:
6367: sub headtag {
1.313 albertel 6368: my ($title,$head_extra,$args) = @_;
1.306 albertel 6369:
1.363 albertel 6370: my $function = $args->{'function'} || &get_users_function();
6371: my $domain = $args->{'domain'} || &determinedomain();
6372: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 6373: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 6374: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 6375: #time(),
1.418 albertel 6376: $env{'environment.color.timestamp'},
1.363 albertel 6377: $function,$domain,$bgcolor);
6378:
1.369 www 6379: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 6380:
1.308 albertel 6381: my $result =
6382: '<head>'.
1.461 albertel 6383: &font_settings();
1.319 albertel 6384:
1.461 albertel 6385: if (!$args->{'frameset'}) {
6386: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
6387: }
1.319 albertel 6388: if ($args->{'force_register'}) {
6389: $result .= &Apache::lonmenu::registerurl(1);
6390: }
1.436 albertel 6391: if (!$args->{'no_nav_bar'}
6392: && !$args->{'only_body'}
6393: && !$args->{'frameset'}) {
6394: $result .= &help_menu_js();
6395: }
1.319 albertel 6396:
1.314 albertel 6397: if (ref($args->{'redirect'})) {
1.414 albertel 6398: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 6399: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 6400: if (!$inhibit_continue) {
6401: $env{'internal.head.redirect'} = $url;
6402: }
1.313 albertel 6403: $result.=<<ADDMETA
6404: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 6405: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 6406: ADDMETA
6407: }
1.306 albertel 6408: if (!defined($title)) {
6409: $title = 'The LearningOnline Network with CAPA';
6410: }
1.460 albertel 6411: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
6412: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 6413: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
6414: .$head_extra;
1.306 albertel 6415: return $result;
6416: }
6417:
6418: =pod
6419:
1.340 albertel 6420: =item * &font_settings()
6421:
6422: Returns neccessary <meta> to set the proper encoding
6423:
6424: Inputs: none
6425:
6426: =cut
6427:
6428: sub font_settings {
6429: my $headerstring='';
1.647 www 6430: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 6431: $headerstring.=
6432: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
6433: }
6434: return $headerstring;
6435: }
6436:
1.341 albertel 6437: =pod
6438:
6439: =item * &xml_begin()
6440:
6441: Returns the needed doctype and <html>
6442:
6443: Inputs: none
6444:
6445: =cut
6446:
6447: sub xml_begin {
6448: my $output='';
6449:
1.592 albertel 6450: if ($env{'internal.start_page'}==1) {
6451: &Apache::lonhtmlcommon::init_htmlareafields();
6452: }
1.342 albertel 6453:
1.341 albertel 6454: if ($env{'browser.mathml'}) {
6455: $output='<?xml version="1.0"?>'
6456: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
6457: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
6458:
6459: # .'<!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">] >'
6460: .'<!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">'
6461: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
6462: .'xmlns="http://www.w3.org/1999/xhtml">';
6463: } else {
1.849 bisitz 6464: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
6465: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 6466: }
6467: return $output;
6468: }
1.340 albertel 6469:
6470: =pod
6471:
1.306 albertel 6472: =item * &endheadtag()
6473:
6474: Returns a uniform </head> for LON-CAPA web pages.
6475:
6476: Inputs: none
6477:
6478: =cut
6479:
6480: sub endheadtag {
6481: return '</head>';
6482: }
6483:
6484: =pod
6485:
6486: =item * &head()
6487:
6488: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
6489:
1.648 raeburn 6490: Inputs:
6491:
6492: =over 4
6493:
6494: $title - optional title for the page
6495:
6496: $head_extra - optional extra HTML to put inside the <head>
6497:
6498: =back
1.405 albertel 6499:
1.306 albertel 6500: =cut
6501:
6502: sub head {
1.325 albertel 6503: my ($title,$head_extra,$args) = @_;
6504: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 6505: }
6506:
6507: =pod
6508:
6509: =item * &start_page()
6510:
6511: Returns a complete <html> .. <body> section for LON-CAPA web pages.
6512:
1.648 raeburn 6513: Inputs:
6514:
6515: =over 4
6516:
6517: $title - optional title for the page
6518:
6519: $head_extra - optional extra HTML to incude inside the <head>
6520:
6521: $args - additional optional args supported are:
6522:
6523: =over 8
6524:
6525: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 6526: arg on
1.814 bisitz 6527: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 6528: add_entries -> additional attributes to add to the <body>
6529: domain -> force to color decorate a page for a
1.317 albertel 6530: specific domain
1.648 raeburn 6531: function -> force usage of a specific rolish color
1.317 albertel 6532: scheme
1.648 raeburn 6533: redirect -> see &headtag()
6534: bgcolor -> override the default page bg color
6535: js_ready -> return a string ready for being used in
1.317 albertel 6536: a javascript writeln
1.648 raeburn 6537: html_encode -> return a string ready for being used in
1.320 albertel 6538: a html attribute
1.648 raeburn 6539: force_register -> if is true will turn on the &bodytag()
1.317 albertel 6540: $forcereg arg
1.648 raeburn 6541: frameset -> if true will start with a <frameset>
1.330 albertel 6542: rather than <body>
1.648 raeburn 6543: skip_phases -> hash ref of
1.338 albertel 6544: head -> skip the <html><head> generation
6545: body -> skip all <body> generation
1.648 raeburn 6546: no_inline_link -> if true and in remote mode, don't show the
1.361 albertel 6547: 'Switch To Inline Menu' link
1.648 raeburn 6548: no_auto_mt_title -> prevent &mt()ing the title arg
6549: inherit_jsmath -> when creating popup window in a page,
6550: should it have jsmath forced on by the
6551: current page
1.867 kalberla 6552: bread_crumbs -> Array containing breadcrumbs
6553: bread_crumbs_components -> if exists show it as headline else show only the breadcrumbs
1.361 albertel 6554:
1.648 raeburn 6555: =back
1.460 albertel 6556:
1.648 raeburn 6557: =back
1.562 albertel 6558:
1.306 albertel 6559: =cut
6560:
6561: sub start_page {
1.309 albertel 6562: my ($title,$head_extra,$args) = @_;
1.318 albertel 6563: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 6564: my %head_args;
1.352 albertel 6565: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 6566: 'bgcolor','frameset','no_nav_bar','only_body',
6567: 'no_auto_mt_title') {
1.319 albertel 6568: if (defined($args->{$arg})) {
1.324 raeburn 6569: $head_args{$arg} = $args->{$arg};
1.319 albertel 6570: }
1.313 albertel 6571: }
1.319 albertel 6572:
1.315 albertel 6573: $env{'internal.start_page'}++;
1.338 albertel 6574: my $result;
6575: if (! exists($args->{'skip_phases'}{'head'}) ) {
6576: $result.=
1.341 albertel 6577: &xml_begin().
1.338 albertel 6578: &headtag($title,$head_extra,\%head_args).&endheadtag();
6579: }
6580:
6581: if (! exists($args->{'skip_phases'}{'body'}) ) {
6582: if ($args->{'frameset'}) {
6583: my $attr_string = &make_attr_string($args->{'force_register'},
6584: $args->{'add_entries'});
6585: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 6586: } else {
6587: $result .=
6588: &bodytag($title,
6589: $args->{'function'}, $args->{'add_entries'},
6590: $args->{'only_body'}, $args->{'domain'},
6591: $args->{'force_register'}, $args->{'no_nav_bar'},
6592: $args->{'bgcolor'}, $args->{'no_inline_link'},
6593: $args);
6594: }
1.330 albertel 6595: }
1.338 albertel 6596:
1.315 albertel 6597: if ($args->{'js_ready'}) {
1.713 kaisler 6598: $result = &js_ready($result);
1.315 albertel 6599: }
1.320 albertel 6600: if ($args->{'html_encode'}) {
1.713 kaisler 6601: $result = &html_encode($result);
6602: }
6603:
1.813 bisitz 6604: # Preparation for new and consistent functionlist at top of screen
6605: # if ($args->{'functionlist'}) {
6606: # $result .= &build_functionlist();
6607: #}
6608:
6609: # Don't add anything more if only_body wanted
6610: return $result if $args->{'only_body'};
6611:
6612: #Breadcrumbs
1.758 kaisler 6613: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
6614: &Apache::lonhtmlcommon::clear_breadcrumbs();
6615: #if any br links exists, add them to the breadcrumbs
6616: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6617: foreach my $crumb (@{$args->{'bread_crumbs'}}){
6618: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
6619: }
6620: }
6621:
6622: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
6623: if(exists($args->{'bread_crumbs_component'})){
6624: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
6625: }else{
6626: $result .= &Apache::lonhtmlcommon::breadcrumbs();
6627: }
1.320 albertel 6628: }
1.315 albertel 6629: return $result;
1.306 albertel 6630: }
6631:
1.330 albertel 6632:
1.306 albertel 6633: =pod
6634:
6635: =item * &head()
6636:
6637: Returns a complete </body></html> section for LON-CAPA web pages.
6638:
1.315 albertel 6639: Inputs: $args - additional optional args supported are:
6640: js_ready -> return a string ready for being used in
6641: a javascript writeln
1.320 albertel 6642: html_encode -> return a string ready for being used in
6643: a html attribute
1.330 albertel 6644: frameset -> if true will start with a <frameset>
6645: rather than <body>
1.493 albertel 6646: dicsussion -> if true will get discussion from
6647: lonxml::xmlend
6648: (you can pass the target and parser arguments
6649: through optional 'target' and 'parser' args
6650: to this routine)
1.306 albertel 6651:
6652: =cut
6653:
6654: sub end_page {
1.315 albertel 6655: my ($args) = @_;
6656: $env{'internal.end_page'}++;
1.330 albertel 6657: my $result;
1.335 albertel 6658: if ($args->{'discussion'}) {
6659: my ($target,$parser);
6660: if (ref($args->{'discussion'})) {
6661: ($target,$parser) =($args->{'discussion'}{'target'},
6662: $args->{'discussion'}{'parser'});
6663: }
6664: $result .= &Apache::lonxml::xmlend($target,$parser);
6665: }
6666:
1.330 albertel 6667: if ($args->{'frameset'}) {
6668: $result .= '</frameset>';
6669: } else {
1.635 raeburn 6670: $result .= &endbodytag($args);
1.330 albertel 6671: }
6672: $result .= "\n</html>";
6673:
1.315 albertel 6674: if ($args->{'js_ready'}) {
1.317 albertel 6675: $result = &js_ready($result);
1.315 albertel 6676: }
1.335 albertel 6677:
1.320 albertel 6678: if ($args->{'html_encode'}) {
6679: $result = &html_encode($result);
6680: }
1.335 albertel 6681:
1.315 albertel 6682: return $result;
6683: }
6684:
1.320 albertel 6685: sub html_encode {
6686: my ($result) = @_;
6687:
1.322 albertel 6688: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 6689:
6690: return $result;
6691: }
1.317 albertel 6692: sub js_ready {
6693: my ($result) = @_;
6694:
1.323 albertel 6695: $result =~ s/[\n\r]/ /xmsg;
6696: $result =~ s/\\/\\\\/xmsg;
6697: $result =~ s/'/\\'/xmsg;
1.372 albertel 6698: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 6699:
6700: return $result;
6701: }
6702:
1.315 albertel 6703: sub validate_page {
6704: if ( exists($env{'internal.start_page'})
1.316 albertel 6705: && $env{'internal.start_page'} > 1) {
6706: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 6707: $env{'internal.start_page'}.' '.
1.316 albertel 6708: $ENV{'request.filename'});
1.315 albertel 6709: }
6710: if ( exists($env{'internal.end_page'})
1.316 albertel 6711: && $env{'internal.end_page'} > 1) {
6712: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 6713: $env{'internal.end_page'}.' '.
1.316 albertel 6714: $env{'request.filename'});
1.315 albertel 6715: }
6716: if ( exists($env{'internal.start_page'})
6717: && ! exists($env{'internal.end_page'})) {
1.316 albertel 6718: &Apache::lonnet::logthis('start_page called without end_page '.
6719: $env{'request.filename'});
1.315 albertel 6720: }
6721: if ( ! exists($env{'internal.start_page'})
6722: && exists($env{'internal.end_page'})) {
1.316 albertel 6723: &Apache::lonnet::logthis('end_page called without start_page'.
6724: $env{'request.filename'});
1.315 albertel 6725: }
1.306 albertel 6726: }
1.315 albertel 6727:
1.318 albertel 6728: sub simple_error_page {
6729: my ($r,$title,$msg) = @_;
6730: my $page =
6731: &Apache::loncommon::start_page($title).
6732: &mt($msg).
6733: &Apache::loncommon::end_page();
6734: if (ref($r)) {
6735: $r->print($page);
1.327 albertel 6736: return;
1.318 albertel 6737: }
6738: return $page;
6739: }
1.347 albertel 6740:
6741: {
1.610 albertel 6742: my @row_count;
1.347 albertel 6743: sub start_data_table {
1.422 albertel 6744: my ($add_class) = @_;
6745: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 6746: unshift(@row_count,0);
1.422 albertel 6747: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 6748: }
6749:
6750: sub end_data_table {
1.610 albertel 6751: shift(@row_count);
1.389 albertel 6752: return '</table>'."\n";;
1.347 albertel 6753: }
6754:
6755: sub start_data_table_row {
1.422 albertel 6756: my ($add_class) = @_;
1.610 albertel 6757: $row_count[0]++;
6758: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.428 albertel 6759: $css_class = (join(' ',$css_class,$add_class));
1.422 albertel 6760: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 6761: }
1.471 banghart 6762:
6763: sub continue_data_table_row {
6764: my ($add_class) = @_;
1.610 albertel 6765: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.471 banghart 6766: $css_class = (join(' ',$css_class,$add_class));
6767: return '<tr class="'.$css_class.'">'."\n";;
6768: }
1.347 albertel 6769:
6770: sub end_data_table_row {
1.389 albertel 6771: return '</tr>'."\n";;
1.347 albertel 6772: }
1.367 www 6773:
1.421 albertel 6774: sub start_data_table_empty_row {
1.707 bisitz 6775: # $row_count[0]++;
1.421 albertel 6776: return '<tr class="LC_empty_row" >'."\n";;
6777: }
6778:
6779: sub end_data_table_empty_row {
6780: return '</tr>'."\n";;
6781: }
6782:
1.367 www 6783: sub start_data_table_header_row {
1.389 albertel 6784: return '<tr class="LC_header_row">'."\n";;
1.367 www 6785: }
6786:
6787: sub end_data_table_header_row {
1.389 albertel 6788: return '</tr>'."\n";;
1.367 www 6789: }
1.890 droeschl 6790:
6791: sub data_table_caption {
6792: my $caption = shift;
6793: return "<caption class=\"LC_caption\">$caption</caption>";
6794: }
1.347 albertel 6795: }
6796:
1.548 albertel 6797: =pod
6798:
6799: =item * &inhibit_menu_check($arg)
6800:
6801: Checks for a inhibitmenu state and generates output to preserve it
6802:
6803: Inputs: $arg - can be any of
6804: - undef - in which case the return value is a string
6805: to add into arguments list of a uri
6806: - 'input' - in which case the return value is a HTML
6807: <form> <input> field of type hidden to
6808: preserve the value
6809: - a url - in which case the return value is the url with
6810: the neccesary cgi args added to preserve the
6811: inhibitmenu state
6812: - a ref to a url - no return value, but the string is
6813: updated to include the neccessary cgi
6814: args to preserve the inhibitmenu state
6815:
6816: =cut
6817:
6818: sub inhibit_menu_check {
6819: my ($arg) = @_;
6820: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6821: if ($arg eq 'input') {
6822: if ($env{'form.inhibitmenu'}) {
6823: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
6824: } else {
6825: return
6826: }
6827: }
6828: if ($env{'form.inhibitmenu'}) {
6829: if (ref($arg)) {
6830: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6831: } elsif ($arg eq '') {
6832: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
6833: } else {
6834: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
6835: }
6836: }
6837: if (!ref($arg)) {
6838: return $arg;
6839: }
6840: }
6841:
1.251 albertel 6842: ###############################################
1.182 matthew 6843:
6844: =pod
6845:
1.549 albertel 6846: =back
6847:
6848: =head1 User Information Routines
6849:
6850: =over 4
6851:
1.405 albertel 6852: =item * &get_users_function()
1.182 matthew 6853:
6854: Used by &bodytag to determine the current users primary role.
6855: Returns either 'student','coordinator','admin', or 'author'.
6856:
6857: =cut
6858:
6859: ###############################################
6860: sub get_users_function {
1.815 tempelho 6861: my $function = 'norole';
1.818 tempelho 6862: if ($env{'request.role'}=~/^(st)/) {
6863: $function='student';
6864: }
1.258 albertel 6865: if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.182 matthew 6866: $function='coordinator';
6867: }
1.258 albertel 6868: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 6869: $function='admin';
6870: }
1.826 bisitz 6871: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182 matthew 6872: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
6873: $function='author';
6874: }
6875: return $function;
1.54 www 6876: }
1.99 www 6877:
6878: ###############################################
6879:
1.233 raeburn 6880: =pod
6881:
1.821 raeburn 6882: =item * &show_course()
6883:
6884: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
6885: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
6886:
6887: Inputs:
6888: None
6889:
6890: Outputs:
6891: Scalar: 1 if 'Course' to be used, 0 otherwise.
6892:
6893: =cut
6894:
6895: ###############################################
6896: sub show_course {
6897: my $course = !$env{'user.adv'};
6898: if (!$env{'user.adv'}) {
6899: foreach my $env (keys(%env)) {
6900: next if ($env !~ m/^user\.priv\./);
6901: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
6902: $course = 0;
6903: last;
6904: }
6905: }
6906: }
6907: return $course;
6908: }
6909:
6910: ###############################################
6911:
6912: =pod
6913:
1.542 raeburn 6914: =item * &check_user_status()
1.274 raeburn 6915:
6916: Determines current status of supplied role for a
6917: specific user. Roles can be active, previous or future.
6918:
6919: Inputs:
6920: user's domain, user's username, course's domain,
1.375 raeburn 6921: course's number, optional section ID.
1.274 raeburn 6922:
6923: Outputs:
6924: role status: active, previous or future.
6925:
6926: =cut
6927:
6928: sub check_user_status {
1.412 raeburn 6929: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 6930: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
6931: my @uroles = keys %userinfo;
6932: my $srchstr;
6933: my $active_chk = 'none';
1.412 raeburn 6934: my $now = time;
1.274 raeburn 6935: if (@uroles > 0) {
1.412 raeburn 6936: if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 6937: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
6938: } else {
1.412 raeburn 6939: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
6940: }
6941: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 6942: my $role_end = 0;
6943: my $role_start = 0;
6944: $active_chk = 'active';
1.412 raeburn 6945: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
6946: $role_end = $1;
6947: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
6948: $role_start = $1;
1.274 raeburn 6949: }
6950: }
6951: if ($role_start > 0) {
1.412 raeburn 6952: if ($now < $role_start) {
1.274 raeburn 6953: $active_chk = 'future';
6954: }
6955: }
6956: if ($role_end > 0) {
1.412 raeburn 6957: if ($now > $role_end) {
1.274 raeburn 6958: $active_chk = 'previous';
6959: }
6960: }
6961: }
6962: }
6963: return $active_chk;
6964: }
6965:
6966: ###############################################
6967:
6968: =pod
6969:
1.405 albertel 6970: =item * &get_sections()
1.233 raeburn 6971:
6972: Determines all the sections for a course including
6973: sections with students and sections containing other roles.
1.419 raeburn 6974: Incoming parameters:
6975:
6976: 1. domain
6977: 2. course number
6978: 3. reference to array containing roles for which sections should
6979: be gathered (optional).
6980: 4. reference to array containing status types for which sections
6981: should be gathered (optional).
6982:
6983: If the third argument is undefined, sections are gathered for any role.
6984: If the fourth argument is undefined, sections are gathered for any status.
6985: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 6986:
1.374 raeburn 6987: Returns section hash (keys are section IDs, values are
6988: number of users in each section), subject to the
1.419 raeburn 6989: optional roles filter, optional status filter
1.233 raeburn 6990:
6991: =cut
6992:
6993: ###############################################
6994: sub get_sections {
1.419 raeburn 6995: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 6996: if (!defined($cdom) || !defined($cnum)) {
6997: my $cid = $env{'request.course.id'};
6998:
6999: return if (!defined($cid));
7000:
7001: $cdom = $env{'course.'.$cid.'.domain'};
7002: $cnum = $env{'course.'.$cid.'.num'};
7003: }
7004:
7005: my %sectioncount;
1.419 raeburn 7006: my $now = time;
1.240 albertel 7007:
1.366 albertel 7008: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 7009: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 7010: my $sec_index = &Apache::loncoursedata::CL_SECTION();
7011: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 7012: my $start_index = &Apache::loncoursedata::CL_START();
7013: my $end_index = &Apache::loncoursedata::CL_END();
7014: my $status;
1.366 albertel 7015: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 7016: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
7017: $data->[$status_index],
7018: $data->[$start_index],
7019: $data->[$end_index]);
7020: if ($stu_status eq 'Active') {
7021: $status = 'active';
7022: } elsif ($end < $now) {
7023: $status = 'previous';
7024: } elsif ($start > $now) {
7025: $status = 'future';
7026: }
7027: if ($section ne '-1' && $section !~ /^\s*$/) {
7028: if ((!defined($possible_status)) || (($status ne '') &&
7029: (grep/^\Q$status\E$/,@{$possible_status}))) {
7030: $sectioncount{$section}++;
7031: }
1.240 albertel 7032: }
7033: }
7034: }
7035: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7036: foreach my $user (sort(keys(%courseroles))) {
7037: if ($user !~ /^(\w{2})/) { next; }
7038: my ($role) = ($user =~ /^(\w{2})/);
7039: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 7040: my ($section,$status);
1.240 albertel 7041: if ($role eq 'cr' &&
7042: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
7043: $section=$1;
7044: }
7045: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
7046: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 7047: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
7048: if ($end == -1 && $start == -1) {
7049: next; #deleted role
7050: }
7051: if (!defined($possible_status)) {
7052: $sectioncount{$section}++;
7053: } else {
7054: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
7055: $status = 'active';
7056: } elsif ($end < $now) {
7057: $status = 'future';
7058: } elsif ($start > $now) {
7059: $status = 'previous';
7060: }
7061: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
7062: $sectioncount{$section}++;
7063: }
7064: }
1.233 raeburn 7065: }
1.366 albertel 7066: return %sectioncount;
1.233 raeburn 7067: }
7068:
1.274 raeburn 7069: ###############################################
1.294 raeburn 7070:
7071: =pod
1.405 albertel 7072:
7073: =item * &get_course_users()
7074:
1.275 raeburn 7075: Retrieves usernames:domains for users in the specified course
7076: with specific role(s), and access status.
7077:
7078: Incoming parameters:
1.277 albertel 7079: 1. course domain
7080: 2. course number
7081: 3. access status: users must have - either active,
1.275 raeburn 7082: previous, future, or all.
1.277 albertel 7083: 4. reference to array of permissible roles
1.288 raeburn 7084: 5. reference to array of section restrictions (optional)
7085: 6. reference to results object (hash of hashes).
7086: 7. reference to optional userdata hash
1.609 raeburn 7087: 8. reference to optional statushash
1.630 raeburn 7088: 9. flag if privileged users (except those set to unhide in
7089: course settings) should be excluded
1.609 raeburn 7090: Keys of top level results hash are roles.
1.275 raeburn 7091: Keys of inner hashes are username:domain, with
7092: values set to access type.
1.288 raeburn 7093: Optional userdata hash returns an array with arguments in the
7094: same order as loncoursedata::get_classlist() for student data.
7095:
1.609 raeburn 7096: Optional statushash returns
7097:
1.288 raeburn 7098: Entries for end, start, section and status are blank because
7099: of the possibility of multiple values for non-student roles.
7100:
1.275 raeburn 7101: =cut
1.405 albertel 7102:
1.275 raeburn 7103: ###############################################
1.405 albertel 7104:
1.275 raeburn 7105: sub get_course_users {
1.630 raeburn 7106: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 7107: my %idx = ();
1.419 raeburn 7108: my %seclists;
1.288 raeburn 7109:
7110: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
7111: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
7112: $idx{end} = &Apache::loncoursedata::CL_END();
7113: $idx{start} = &Apache::loncoursedata::CL_START();
7114: $idx{id} = &Apache::loncoursedata::CL_ID();
7115: $idx{section} = &Apache::loncoursedata::CL_SECTION();
7116: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
7117: $idx{status} = &Apache::loncoursedata::CL_STATUS();
7118:
1.290 albertel 7119: if (grep(/^st$/,@{$roles})) {
1.276 albertel 7120: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 7121: my $now = time;
1.277 albertel 7122: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 7123: my $match = 0;
1.412 raeburn 7124: my $secmatch = 0;
1.419 raeburn 7125: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 7126: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 7127: if ($section eq '') {
7128: $section = 'none';
7129: }
1.291 albertel 7130: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 7131: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 7132: $secmatch = 1;
7133: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 7134: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 7135: $secmatch = 1;
7136: }
7137: } else {
1.419 raeburn 7138: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 7139: $secmatch = 1;
7140: }
1.290 albertel 7141: }
1.412 raeburn 7142: if (!$secmatch) {
7143: next;
7144: }
1.419 raeburn 7145: }
1.275 raeburn 7146: if (defined($$types{'active'})) {
1.288 raeburn 7147: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 7148: push(@{$$users{st}{$student}},'active');
1.288 raeburn 7149: $match = 1;
1.275 raeburn 7150: }
7151: }
7152: if (defined($$types{'previous'})) {
1.609 raeburn 7153: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 7154: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 7155: $match = 1;
1.275 raeburn 7156: }
7157: }
7158: if (defined($$types{'future'})) {
1.609 raeburn 7159: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 7160: push(@{$$users{st}{$student}},'future');
1.288 raeburn 7161: $match = 1;
1.275 raeburn 7162: }
7163: }
1.609 raeburn 7164: if ($match) {
7165: push(@{$seclists{$student}},$section);
7166: if (ref($userdata) eq 'HASH') {
7167: $$userdata{$student} = $$classlist{$student};
7168: }
7169: if (ref($statushash) eq 'HASH') {
7170: $statushash->{$student}{'st'}{$section} = $status;
7171: }
1.288 raeburn 7172: }
1.275 raeburn 7173: }
7174: }
1.412 raeburn 7175: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 7176: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7177: my $now = time;
1.609 raeburn 7178: my %displaystatus = ( previous => 'Expired',
7179: active => 'Active',
7180: future => 'Future',
7181: );
1.630 raeburn 7182: my %nothide;
7183: if ($hidepriv) {
7184: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
7185: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
7186: if ($user !~ /:/) {
7187: $nothide{join(':',split(/[\@]/,$user))}=1;
7188: } else {
7189: $nothide{$user} = 1;
7190: }
7191: }
7192: }
1.439 raeburn 7193: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 7194: my $match = 0;
1.412 raeburn 7195: my $secmatch = 0;
1.439 raeburn 7196: my $status;
1.412 raeburn 7197: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 7198: $user =~ s/:$//;
1.439 raeburn 7199: my ($end,$start) = split(/:/,$coursepersonnel{$person});
7200: if ($end == -1 || $start == -1) {
7201: next;
7202: }
7203: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
7204: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 7205: my ($uname,$udom) = split(/:/,$user);
7206: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 7207: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 7208: $secmatch = 1;
7209: } elsif ($usec eq '') {
1.420 albertel 7210: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 7211: $secmatch = 1;
7212: }
7213: } else {
7214: if (grep(/^\Q$usec\E$/,@{$sections})) {
7215: $secmatch = 1;
7216: }
7217: }
7218: if (!$secmatch) {
7219: next;
7220: }
1.288 raeburn 7221: }
1.419 raeburn 7222: if ($usec eq '') {
7223: $usec = 'none';
7224: }
1.275 raeburn 7225: if ($uname ne '' && $udom ne '') {
1.630 raeburn 7226: if ($hidepriv) {
7227: if ((&Apache::lonnet::privileged($uname,$udom)) &&
7228: (!$nothide{$uname.':'.$udom})) {
7229: next;
7230: }
7231: }
1.503 raeburn 7232: if ($end > 0 && $end < $now) {
1.439 raeburn 7233: $status = 'previous';
7234: } elsif ($start > $now) {
7235: $status = 'future';
7236: } else {
7237: $status = 'active';
7238: }
1.277 albertel 7239: foreach my $type (keys(%{$types})) {
1.275 raeburn 7240: if ($status eq $type) {
1.420 albertel 7241: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 7242: push(@{$$users{$role}{$user}},$type);
7243: }
1.288 raeburn 7244: $match = 1;
7245: }
7246: }
1.419 raeburn 7247: if (($match) && (ref($userdata) eq 'HASH')) {
7248: if (!exists($$userdata{$uname.':'.$udom})) {
7249: &get_user_info($udom,$uname,\%idx,$userdata);
7250: }
1.420 albertel 7251: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 7252: push(@{$seclists{$uname.':'.$udom}},$usec);
7253: }
1.609 raeburn 7254: if (ref($statushash) eq 'HASH') {
7255: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
7256: }
1.275 raeburn 7257: }
7258: }
7259: }
7260: }
1.290 albertel 7261: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 7262: if ((defined($cdom)) && (defined($cnum))) {
7263: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
7264: if ( defined($csettings{'internal.courseowner'}) ) {
7265: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 7266: next if ($owner eq '');
7267: my ($ownername,$ownerdom);
7268: if ($owner =~ /^([^:]+):([^:]+)$/) {
7269: $ownername = $1;
7270: $ownerdom = $2;
7271: } else {
7272: $ownername = $owner;
7273: $ownerdom = $cdom;
7274: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 7275: }
7276: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 7277: if (defined($userdata) &&
1.609 raeburn 7278: !exists($$userdata{$owner})) {
7279: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
7280: if (!grep(/^none$/,@{$seclists{$owner}})) {
7281: push(@{$seclists{$owner}},'none');
7282: }
7283: if (ref($statushash) eq 'HASH') {
7284: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 7285: }
1.290 albertel 7286: }
1.279 raeburn 7287: }
7288: }
7289: }
1.419 raeburn 7290: foreach my $user (keys(%seclists)) {
7291: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
7292: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
7293: }
1.275 raeburn 7294: }
7295: return;
7296: }
7297:
1.288 raeburn 7298: sub get_user_info {
7299: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 7300: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
7301: &plainname($uname,$udom,'lastname');
1.291 albertel 7302: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 7303: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 7304: my %idhash = &Apache::lonnet::idrget($udom,($uname));
7305: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 7306: return;
7307: }
1.275 raeburn 7308:
1.472 raeburn 7309: ###############################################
7310:
7311: =pod
7312:
7313: =item * &get_user_quota()
7314:
7315: Retrieves quota assigned for storage of portfolio files for a user
7316:
7317: Incoming parameters:
7318: 1. user's username
7319: 2. user's domain
7320:
7321: Returns:
1.536 raeburn 7322: 1. Disk quota (in Mb) assigned to student.
7323: 2. (Optional) Type of setting: custom or default
7324: (individually assigned or default for user's
7325: institutional status).
7326: 3. (Optional) - User's institutional status (e.g., faculty, staff
7327: or student - types as defined in localenroll::inst_usertypes
7328: for user's domain, which determines default quota for user.
7329: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 7330:
7331: If a value has been stored in the user's environment,
1.536 raeburn 7332: it will return that, otherwise it returns the maximal default
7333: defined for the user's instituional status(es) in the domain.
1.472 raeburn 7334:
7335: =cut
7336:
7337: ###############################################
7338:
7339:
7340: sub get_user_quota {
7341: my ($uname,$udom) = @_;
1.536 raeburn 7342: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 7343: if (!defined($udom)) {
7344: $udom = $env{'user.domain'};
7345: }
7346: if (!defined($uname)) {
7347: $uname = $env{'user.name'};
7348: }
7349: if (($udom eq '' || $uname eq '') ||
7350: ($udom eq 'public') && ($uname eq 'public')) {
7351: $quota = 0;
1.536 raeburn 7352: $quotatype = 'default';
7353: $defquota = 0;
1.472 raeburn 7354: } else {
1.536 raeburn 7355: my $inststatus;
1.472 raeburn 7356: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
7357: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 7358: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 7359: } else {
1.536 raeburn 7360: my %userenv =
7361: &Apache::lonnet::get('environment',['portfolioquota',
7362: 'inststatus'],$udom,$uname);
1.472 raeburn 7363: my ($tmp) = keys(%userenv);
7364: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
7365: $quota = $userenv{'portfolioquota'};
1.536 raeburn 7366: $inststatus = $userenv{'inststatus'};
1.472 raeburn 7367: } else {
7368: undef(%userenv);
7369: }
7370: }
1.536 raeburn 7371: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 7372: if ($quota eq '') {
1.536 raeburn 7373: $quota = $defquota;
7374: $quotatype = 'default';
7375: } else {
7376: $quotatype = 'custom';
1.472 raeburn 7377: }
7378: }
1.536 raeburn 7379: if (wantarray) {
7380: return ($quota,$quotatype,$settingstatus,$defquota);
7381: } else {
7382: return $quota;
7383: }
1.472 raeburn 7384: }
7385:
7386: ###############################################
7387:
7388: =pod
7389:
7390: =item * &default_quota()
7391:
1.536 raeburn 7392: Retrieves default quota assigned for storage of user portfolio files,
7393: given an (optional) user's institutional status.
1.472 raeburn 7394:
7395: Incoming parameters:
7396: 1. domain
1.536 raeburn 7397: 2. (Optional) institutional status(es). This is a : separated list of
7398: status types (e.g., faculty, staff, student etc.)
7399: which apply to the user for whom the default is being retrieved.
7400: If the institutional status string in undefined, the domain
7401: default quota will be returned.
1.472 raeburn 7402:
7403: Returns:
7404: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 7405: 2. (Optional) institutional type which determined the value of the
7406: default quota.
1.472 raeburn 7407:
7408: If a value has been stored in the domain's configuration db,
7409: it will return that, otherwise it returns 20 (for backwards
7410: compatibility with domains which have not set up a configuration
7411: db file; the original statically defined portfolio quota was 20 Mb).
7412:
1.536 raeburn 7413: If the user's status includes multiple types (e.g., staff and student),
7414: the largest default quota which applies to the user determines the
7415: default quota returned.
7416:
1.780 raeburn 7417: =back
7418:
1.472 raeburn 7419: =cut
7420:
7421: ###############################################
7422:
7423:
7424: sub default_quota {
1.536 raeburn 7425: my ($udom,$inststatus) = @_;
7426: my ($defquota,$settingstatus);
7427: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 7428: ['quotas'],$udom);
7429: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 7430: if ($inststatus ne '') {
1.765 raeburn 7431: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 7432: foreach my $item (@statuses) {
1.711 raeburn 7433: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
7434: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
7435: if ($defquota eq '') {
7436: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
7437: $settingstatus = $item;
7438: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
7439: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
7440: $settingstatus = $item;
7441: }
7442: }
7443: } else {
7444: if ($quotahash{'quotas'}{$item} ne '') {
7445: if ($defquota eq '') {
7446: $defquota = $quotahash{'quotas'}{$item};
7447: $settingstatus = $item;
7448: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
7449: $defquota = $quotahash{'quotas'}{$item};
7450: $settingstatus = $item;
7451: }
1.536 raeburn 7452: }
7453: }
7454: }
7455: }
7456: if ($defquota eq '') {
1.711 raeburn 7457: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
7458: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
7459: } else {
7460: $defquota = $quotahash{'quotas'}{'default'};
7461: }
1.536 raeburn 7462: $settingstatus = 'default';
7463: }
7464: } else {
7465: $settingstatus = 'default';
7466: $defquota = 20;
7467: }
7468: if (wantarray) {
7469: return ($defquota,$settingstatus);
1.472 raeburn 7470: } else {
1.536 raeburn 7471: return $defquota;
1.472 raeburn 7472: }
7473: }
7474:
1.384 raeburn 7475: sub get_secgrprole_info {
7476: my ($cdom,$cnum,$needroles,$type) = @_;
7477: my %sections_count = &get_sections($cdom,$cnum);
7478: my @sections = (sort {$a <=> $b} keys(%sections_count));
7479: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
7480: my @groups = sort(keys(%curr_groups));
7481: my $allroles = [];
7482: my $rolehash;
7483: my $accesshash = {
7484: active => 'Currently has access',
7485: future => 'Will have future access',
7486: previous => 'Previously had access',
7487: };
7488: if ($needroles) {
7489: $rolehash = {'all' => 'all'};
1.385 albertel 7490: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7491: if (&Apache::lonnet::error(%user_roles)) {
7492: undef(%user_roles);
7493: }
7494: foreach my $item (keys(%user_roles)) {
1.384 raeburn 7495: my ($role)=split(/\:/,$item,2);
7496: if ($role eq 'cr') { next; }
7497: if ($role =~ /^cr/) {
7498: $$rolehash{$role} = (split('/',$role))[3];
7499: } else {
7500: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
7501: }
7502: }
7503: foreach my $key (sort(keys(%{$rolehash}))) {
7504: push(@{$allroles},$key);
7505: }
7506: push (@{$allroles},'st');
7507: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
7508: }
7509: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
7510: }
7511:
1.555 raeburn 7512: sub user_picker {
1.627 raeburn 7513: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 7514: my $currdom = $dom;
7515: my %curr_selected = (
7516: srchin => 'dom',
1.580 raeburn 7517: srchby => 'lastname',
1.555 raeburn 7518: );
7519: my $srchterm;
1.625 raeburn 7520: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 7521: if ($srch->{'srchby'} ne '') {
7522: $curr_selected{'srchby'} = $srch->{'srchby'};
7523: }
7524: if ($srch->{'srchin'} ne '') {
7525: $curr_selected{'srchin'} = $srch->{'srchin'};
7526: }
7527: if ($srch->{'srchtype'} ne '') {
7528: $curr_selected{'srchtype'} = $srch->{'srchtype'};
7529: }
7530: if ($srch->{'srchdomain'} ne '') {
7531: $currdom = $srch->{'srchdomain'};
7532: }
7533: $srchterm = $srch->{'srchterm'};
7534: }
7535: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 7536: 'usr' => 'Search criteria',
1.563 raeburn 7537: 'doma' => 'Domain/institution to search',
1.558 albertel 7538: 'uname' => 'username',
7539: 'lastname' => 'last name',
1.555 raeburn 7540: 'lastfirst' => 'last name, first name',
1.558 albertel 7541: 'crs' => 'in this course',
1.576 raeburn 7542: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 7543: 'alc' => 'all LON-CAPA',
1.573 raeburn 7544: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 7545: 'exact' => 'is',
7546: 'contains' => 'contains',
1.569 raeburn 7547: 'begins' => 'begins with',
1.571 raeburn 7548: 'youm' => "You must include some text to search for.",
7549: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
7550: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
7551: 'yomc' => "You must choose a domain when using an institutional directory search.",
7552: 'ymcd' => "You must choose a domain when using a domain search.",
7553: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
7554: 'whse' => "When searching by last,first you must include at least one character in the first name.",
7555: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 7556: );
1.563 raeburn 7557: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
7558: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 7559:
7560: my @srchins = ('crs','dom','alc','instd');
7561:
7562: foreach my $option (@srchins) {
7563: # FIXME 'alc' option unavailable until
7564: # loncreateuser::print_user_query_page()
7565: # has been completed.
7566: next if ($option eq 'alc');
1.880 raeburn 7567: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 7568: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 7569: if ($curr_selected{'srchin'} eq $option) {
7570: $srchinsel .= '
7571: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7572: } else {
7573: $srchinsel .= '
7574: <option value="'.$option.'">'.$lt{$option}.'</option>';
7575: }
1.555 raeburn 7576: }
1.563 raeburn 7577: $srchinsel .= "\n </select>\n";
1.555 raeburn 7578:
7579: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 7580: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 7581: if ($curr_selected{'srchby'} eq $option) {
7582: $srchbysel .= '
7583: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7584: } else {
7585: $srchbysel .= '
7586: <option value="'.$option.'">'.$lt{$option}.'</option>';
7587: }
7588: }
7589: $srchbysel .= "\n </select>\n";
7590:
7591: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 7592: foreach my $option ('begins','contains','exact') {
1.555 raeburn 7593: if ($curr_selected{'srchtype'} eq $option) {
7594: $srchtypesel .= '
7595: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7596: } else {
7597: $srchtypesel .= '
7598: <option value="'.$option.'">'.$lt{$option}.'</option>';
7599: }
7600: }
7601: $srchtypesel .= "\n </select>\n";
7602:
1.558 albertel 7603: my ($newuserscript,$new_user_create);
1.556 raeburn 7604:
7605: if ($forcenewuser) {
1.576 raeburn 7606: if (ref($srch) eq 'HASH') {
7607: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 7608: if ($cancreate) {
7609: $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>';
7610: } else {
1.799 bisitz 7611: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 7612: my %usertypetext = (
7613: official => 'institutional',
7614: unofficial => 'non-institutional',
7615: );
1.799 bisitz 7616: $new_user_create = '<p class="LC_warning">'
7617: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
7618: .' '
7619: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
7620: ,'<a href="'.$helplink.'">','</a>')
7621: .'</p><br />';
1.627 raeburn 7622: }
1.576 raeburn 7623: }
7624: }
7625:
1.556 raeburn 7626: $newuserscript = <<"ENDSCRIPT";
7627:
1.570 raeburn 7628: function setSearch(createnew,callingForm) {
1.556 raeburn 7629: if (createnew == 1) {
1.570 raeburn 7630: for (var i=0; i<callingForm.srchby.length; i++) {
7631: if (callingForm.srchby.options[i].value == 'uname') {
7632: callingForm.srchby.selectedIndex = i;
1.556 raeburn 7633: }
7634: }
1.570 raeburn 7635: for (var i=0; i<callingForm.srchin.length; i++) {
7636: if ( callingForm.srchin.options[i].value == 'dom') {
7637: callingForm.srchin.selectedIndex = i;
1.556 raeburn 7638: }
7639: }
1.570 raeburn 7640: for (var i=0; i<callingForm.srchtype.length; i++) {
7641: if (callingForm.srchtype.options[i].value == 'exact') {
7642: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 7643: }
7644: }
1.570 raeburn 7645: for (var i=0; i<callingForm.srchdomain.length; i++) {
7646: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
7647: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 7648: }
7649: }
7650: }
7651: }
7652: ENDSCRIPT
1.558 albertel 7653:
1.556 raeburn 7654: }
7655:
1.555 raeburn 7656: my $output = <<"END_BLOCK";
1.556 raeburn 7657: <script type="text/javascript">
1.824 bisitz 7658: // <![CDATA[
1.570 raeburn 7659: function validateEntry(callingForm) {
1.558 albertel 7660:
1.556 raeburn 7661: var checkok = 1;
1.558 albertel 7662: var srchin;
1.570 raeburn 7663: for (var i=0; i<callingForm.srchin.length; i++) {
7664: if ( callingForm.srchin[i].checked ) {
7665: srchin = callingForm.srchin[i].value;
1.558 albertel 7666: }
7667: }
7668:
1.570 raeburn 7669: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
7670: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
7671: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
7672: var srchterm = callingForm.srchterm.value;
7673: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 7674: var msg = "";
7675:
7676: if (srchterm == "") {
7677: checkok = 0;
1.571 raeburn 7678: msg += "$lt{'youm'}\\n";
1.556 raeburn 7679: }
7680:
1.569 raeburn 7681: if (srchtype== 'begins') {
7682: if (srchterm.length < 2) {
7683: checkok = 0;
1.571 raeburn 7684: msg += "$lt{'thte'}\\n";
1.569 raeburn 7685: }
7686: }
7687:
1.556 raeburn 7688: if (srchtype== 'contains') {
7689: if (srchterm.length < 3) {
7690: checkok = 0;
1.571 raeburn 7691: msg += "$lt{'thet'}\\n";
1.556 raeburn 7692: }
7693: }
7694: if (srchin == 'instd') {
7695: if (srchdomain == '') {
7696: checkok = 0;
1.571 raeburn 7697: msg += "$lt{'yomc'}\\n";
1.556 raeburn 7698: }
7699: }
7700: if (srchin == 'dom') {
7701: if (srchdomain == '') {
7702: checkok = 0;
1.571 raeburn 7703: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 7704: }
7705: }
7706: if (srchby == 'lastfirst') {
7707: if (srchterm.indexOf(",") == -1) {
7708: checkok = 0;
1.571 raeburn 7709: msg += "$lt{'whus'}\\n";
1.556 raeburn 7710: }
7711: if (srchterm.indexOf(",") == srchterm.length -1) {
7712: checkok = 0;
1.571 raeburn 7713: msg += "$lt{'whse'}\\n";
1.556 raeburn 7714: }
7715: }
7716: if (checkok == 0) {
1.571 raeburn 7717: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 7718: return;
7719: }
7720: if (checkok == 1) {
1.570 raeburn 7721: callingForm.submit();
1.556 raeburn 7722: }
7723: }
7724:
7725: $newuserscript
7726:
1.824 bisitz 7727: // ]]>
1.556 raeburn 7728: </script>
1.558 albertel 7729:
7730: $new_user_create
7731:
1.555 raeburn 7732: END_BLOCK
1.558 albertel 7733:
1.876 raeburn 7734: $output .= &Apache::lonhtmlcommon::start_pick_box().
7735: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
7736: $domform.
7737: &Apache::lonhtmlcommon::row_closure().
7738: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
7739: $srchbysel.
7740: $srchtypesel.
7741: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
7742: $srchinsel.
7743: &Apache::lonhtmlcommon::row_closure(1).
7744: &Apache::lonhtmlcommon::end_pick_box().
7745: '<br />';
1.555 raeburn 7746: return $output;
7747: }
7748:
1.612 raeburn 7749: sub user_rule_check {
1.615 raeburn 7750: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 7751: my $response;
7752: if (ref($usershash) eq 'HASH') {
7753: foreach my $user (keys(%{$usershash})) {
7754: my ($uname,$udom) = split(/:/,$user);
7755: next if ($udom eq '' || $uname eq '');
1.615 raeburn 7756: my ($id,$newuser);
1.612 raeburn 7757: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 7758: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 7759: $id = $usershash->{$user}->{'id'};
7760: }
7761: my $inst_response;
7762: if (ref($checks) eq 'HASH') {
7763: if (defined($checks->{'username'})) {
1.615 raeburn 7764: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7765: &Apache::lonnet::get_instuser($udom,$uname);
7766: } elsif (defined($checks->{'id'})) {
1.615 raeburn 7767: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 7768: &Apache::lonnet::get_instuser($udom,undef,$id);
7769: }
1.615 raeburn 7770: } else {
7771: ($inst_response,%{$inst_results->{$user}}) =
7772: &Apache::lonnet::get_instuser($udom,$uname);
7773: return;
1.612 raeburn 7774: }
1.615 raeburn 7775: if (!$got_rules->{$udom}) {
1.612 raeburn 7776: my %domconfig = &Apache::lonnet::get_dom('configuration',
7777: ['usercreation'],$udom);
7778: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 7779: foreach my $item ('username','id') {
1.612 raeburn 7780: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
7781: $$curr_rules{$udom}{$item} =
7782: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 7783: }
7784: }
7785: }
1.615 raeburn 7786: $got_rules->{$udom} = 1;
1.585 raeburn 7787: }
1.612 raeburn 7788: foreach my $item (keys(%{$checks})) {
7789: if (ref($$curr_rules{$udom}) eq 'HASH') {
7790: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
7791: if (@{$$curr_rules{$udom}{$item}} > 0) {
7792: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
7793: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
7794: if ($rule_check{$rule}) {
7795: $$rulematch{$user}{$item} = $rule;
7796: if ($inst_response eq 'ok') {
1.615 raeburn 7797: if (ref($inst_results) eq 'HASH') {
7798: if (ref($inst_results->{$user}) eq 'HASH') {
7799: if (keys(%{$inst_results->{$user}}) == 0) {
7800: $$alerts{$item}{$udom}{$uname} = 1;
7801: }
1.612 raeburn 7802: }
7803: }
1.615 raeburn 7804: }
7805: last;
1.585 raeburn 7806: }
7807: }
7808: }
7809: }
7810: }
7811: }
7812: }
7813: }
1.612 raeburn 7814: return;
7815: }
7816:
7817: sub user_rule_formats {
7818: my ($domain,$domdesc,$curr_rules,$check) = @_;
7819: my %text = (
7820: 'username' => 'Usernames',
7821: 'id' => 'IDs',
7822: );
7823: my $output;
7824: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
7825: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
7826: if (@{$ruleorder} > 0) {
7827: $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>';
7828: foreach my $rule (@{$ruleorder}) {
7829: if (ref($curr_rules) eq 'ARRAY') {
7830: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
7831: if (ref($rules->{$rule}) eq 'HASH') {
7832: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
7833: $rules->{$rule}{'desc'}.'</li>';
7834: }
7835: }
7836: }
7837: }
7838: $output .= '</ul>';
7839: }
7840: }
7841: return $output;
7842: }
7843:
7844: sub instrule_disallow_msg {
1.615 raeburn 7845: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 7846: my $response;
7847: my %text = (
7848: item => 'username',
7849: items => 'usernames',
7850: match => 'matches',
7851: do => 'does',
7852: action => 'a username',
7853: one => 'one',
7854: );
7855: if ($count > 1) {
7856: $text{'item'} = 'usernames';
7857: $text{'match'} ='match';
7858: $text{'do'} = 'do';
7859: $text{'action'} = 'usernames',
7860: $text{'one'} = 'ones';
7861: }
7862: if ($checkitem eq 'id') {
7863: $text{'items'} = 'IDs';
7864: $text{'item'} = 'ID';
7865: $text{'action'} = 'an ID';
1.615 raeburn 7866: if ($count > 1) {
7867: $text{'item'} = 'IDs';
7868: $text{'action'} = 'IDs';
7869: }
1.612 raeburn 7870: }
1.674 bisitz 7871: $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 7872: if ($mode eq 'upload') {
7873: if ($checkitem eq 'username') {
7874: $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'}.");
7875: } elsif ($checkitem eq 'id') {
1.674 bisitz 7876: $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 7877: }
1.669 raeburn 7878: } elsif ($mode eq 'selfcreate') {
7879: if ($checkitem eq 'id') {
7880: $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.");
7881: }
1.615 raeburn 7882: } else {
7883: if ($checkitem eq 'username') {
7884: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
7885: } elsif ($checkitem eq 'id') {
7886: $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.");
7887: }
1.612 raeburn 7888: }
7889: return $response;
1.585 raeburn 7890: }
7891:
1.624 raeburn 7892: sub personal_data_fieldtitles {
7893: my %fieldtitles = &Apache::lonlocal::texthash (
7894: id => 'Student/Employee ID',
7895: permanentemail => 'E-mail address',
7896: lastname => 'Last Name',
7897: firstname => 'First Name',
7898: middlename => 'Middle Name',
7899: generation => 'Generation',
7900: gen => 'Generation',
1.765 raeburn 7901: inststatus => 'Affiliation',
1.624 raeburn 7902: );
7903: return %fieldtitles;
7904: }
7905:
1.642 raeburn 7906: sub sorted_inst_types {
7907: my ($dom) = @_;
7908: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
7909: my $othertitle = &mt('All users');
7910: if ($env{'request.course.id'}) {
1.668 raeburn 7911: $othertitle = &mt('Any users');
1.642 raeburn 7912: }
7913: my @types;
7914: if (ref($order) eq 'ARRAY') {
7915: @types = @{$order};
7916: }
7917: if (@types == 0) {
7918: if (ref($usertypes) eq 'HASH') {
7919: @types = sort(keys(%{$usertypes}));
7920: }
7921: }
7922: if (keys(%{$usertypes}) > 0) {
7923: $othertitle = &mt('Other users');
7924: }
7925: return ($othertitle,$usertypes,\@types);
7926: }
7927:
1.645 raeburn 7928: sub get_institutional_codes {
7929: my ($settings,$allcourses,$LC_code) = @_;
7930: # Get complete list of course sections to update
7931: my @currsections = ();
7932: my @currxlists = ();
7933: my $coursecode = $$settings{'internal.coursecode'};
7934:
7935: if ($$settings{'internal.sectionnums'} ne '') {
7936: @currsections = split(/,/,$$settings{'internal.sectionnums'});
7937: }
7938:
7939: if ($$settings{'internal.crosslistings'} ne '') {
7940: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
7941: }
7942:
7943: if (@currxlists > 0) {
7944: foreach (@currxlists) {
7945: if (m/^([^:]+):(\w*)$/) {
7946: unless (grep/^$1$/,@{$allcourses}) {
7947: push @{$allcourses},$1;
7948: $$LC_code{$1} = $2;
7949: }
7950: }
7951: }
7952: }
7953:
7954: if (@currsections > 0) {
7955: foreach (@currsections) {
7956: if (m/^(\w+):(\w*)$/) {
7957: my $sec = $coursecode.$1;
7958: my $lc_sec = $2;
7959: unless (grep/^$sec$/,@{$allcourses}) {
7960: push @{$allcourses},$sec;
7961: $$LC_code{$sec} = $lc_sec;
7962: }
7963: }
7964: }
7965: }
7966: return;
7967: }
7968:
1.112 bowersj2 7969: =pod
7970:
1.780 raeburn 7971: =head1 Slot Helpers
7972:
7973: =over 4
7974:
7975: =item * sorted_slots()
7976:
7977: Sorts an array of slot names in order of slot start time (earliest first).
7978:
7979: Inputs:
7980:
7981: =over 4
7982:
7983: slotsarr - Reference to array of unsorted slot names.
7984:
7985: slots - Reference to hash of hash, where outer hash keys are slot names.
7986:
1.549 albertel 7987: =back
7988:
1.780 raeburn 7989: Returns:
7990:
7991: =over 4
7992:
7993: sorted - An array of slot names sorted by the start time of the slot.
7994:
7995: =back
7996:
7997: =back
7998:
7999: =cut
8000:
8001:
8002: sub sorted_slots {
8003: my ($slotsarr,$slots) = @_;
8004: my @sorted;
8005: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
8006: @sorted =
8007: sort {
8008: if (ref($slots->{$a}) && ref($slots->{$b})) {
8009: return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
8010: }
8011: if (ref($slots->{$a})) { return -1;}
8012: if (ref($slots->{$b})) { return 1;}
8013: return 0;
8014: } @{$slotsarr};
8015: }
8016: return @sorted;
8017: }
8018:
8019:
8020: =pod
8021:
1.549 albertel 8022: =head1 HTTP Helpers
8023:
8024: =over 4
8025:
1.648 raeburn 8026: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 8027:
1.258 albertel 8028: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 8029: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 8030: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 8031:
8032: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
8033: $possible_names is an ref to an array of form element names. As an example:
8034: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 8035: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 8036:
8037: =cut
1.1 albertel 8038:
1.6 albertel 8039: sub get_unprocessed_cgi {
1.25 albertel 8040: my ($query,$possible_names)= @_;
1.26 matthew 8041: # $Apache::lonxml::debug=1;
1.356 albertel 8042: foreach my $pair (split(/&/,$query)) {
8043: my ($name, $value) = split(/=/,$pair);
1.369 www 8044: $name = &unescape($name);
1.25 albertel 8045: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
8046: $value =~ tr/+/ /;
8047: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 8048: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 8049: }
1.16 harris41 8050: }
1.6 albertel 8051: }
8052:
1.112 bowersj2 8053: =pod
8054:
1.648 raeburn 8055: =item * &cacheheader()
1.112 bowersj2 8056:
8057: returns cache-controlling header code
8058:
8059: =cut
8060:
1.7 albertel 8061: sub cacheheader {
1.258 albertel 8062: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 8063: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
8064: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 8065: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
8066: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 8067: return $output;
1.7 albertel 8068: }
8069:
1.112 bowersj2 8070: =pod
8071:
1.648 raeburn 8072: =item * &no_cache($r)
1.112 bowersj2 8073:
8074: specifies header code to not have cache
8075:
8076: =cut
8077:
1.9 albertel 8078: sub no_cache {
1.216 albertel 8079: my ($r) = @_;
8080: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 8081: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 8082: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
8083: $r->no_cache(1);
8084: $r->header_out("Expires" => $date);
8085: $r->header_out("Pragma" => "no-cache");
1.123 www 8086: }
8087:
8088: sub content_type {
1.181 albertel 8089: my ($r,$type,$charset) = @_;
1.299 foxr 8090: if ($r) {
8091: # Note that printout.pl calls this with undef for $r.
8092: &no_cache($r);
8093: }
1.258 albertel 8094: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 8095: unless ($charset) {
8096: $charset=&Apache::lonlocal::current_encoding;
8097: }
8098: if ($charset) { $type.='; charset='.$charset; }
8099: if ($r) {
8100: $r->content_type($type);
8101: } else {
8102: print("Content-type: $type\n\n");
8103: }
1.9 albertel 8104: }
1.25 albertel 8105:
1.112 bowersj2 8106: =pod
8107:
1.648 raeburn 8108: =item * &add_to_env($name,$value)
1.112 bowersj2 8109:
1.258 albertel 8110: adds $name to the %env hash with value
1.112 bowersj2 8111: $value, if $name already exists, the entry is converted to an array
8112: reference and $value is added to the array.
8113:
8114: =cut
8115:
1.25 albertel 8116: sub add_to_env {
8117: my ($name,$value)=@_;
1.258 albertel 8118: if (defined($env{$name})) {
8119: if (ref($env{$name})) {
1.25 albertel 8120: #already have multiple values
1.258 albertel 8121: push(@{ $env{$name} },$value);
1.25 albertel 8122: } else {
8123: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 8124: my $first=$env{$name};
8125: undef($env{$name});
8126: push(@{ $env{$name} },$first,$value);
1.25 albertel 8127: }
8128: } else {
1.258 albertel 8129: $env{$name}=$value;
1.25 albertel 8130: }
1.31 albertel 8131: }
1.149 albertel 8132:
8133: =pod
8134:
1.648 raeburn 8135: =item * &get_env_multiple($name)
1.149 albertel 8136:
1.258 albertel 8137: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 8138: values may be defined and end up as an array ref.
8139:
8140: returns an array of values
8141:
8142: =cut
8143:
8144: sub get_env_multiple {
8145: my ($name) = @_;
8146: my @values;
1.258 albertel 8147: if (defined($env{$name})) {
1.149 albertel 8148: # exists is it an array
1.258 albertel 8149: if (ref($env{$name})) {
8150: @values=@{ $env{$name} };
1.149 albertel 8151: } else {
1.258 albertel 8152: $values[0]=$env{$name};
1.149 albertel 8153: }
8154: }
8155: return(@values);
8156: }
8157:
1.660 raeburn 8158: sub ask_for_embedded_content {
8159: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
8160: my $upload_output = '
8161: <form name="upload_embedded" action="'.$actionurl.'"
8162: method="post" enctype="multipart/form-data">';
8163: $upload_output .= $state;
1.661 raeburn 8164: $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660 raeburn 8165:
8166: my $num = 0;
8167: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
8168: $upload_output .= &start_data_table_row().
8169: '<td>'.$embed_file.'</td><td>';
8170: if ($args->{'ignore_remote_references'}
8171: && $embed_file =~ m{^\w+://}) {
8172: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
8173: } elsif ($args->{'error_on_invalid_names'}
8174: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
8175:
8176: $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
8177:
8178: } else {
8179: $upload_output .='
1.661 raeburn 8180: <input name="embedded_item_'.$num.'" type="file" value="" />
1.660 raeburn 8181: <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
8182: my $attrib = join(':',@{$$allfiles{$embed_file}});
8183: $upload_output .=
8184: "\n\t\t".
8185: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
8186: $attrib.'" />';
8187: if (exists($$codebase{$embed_file})) {
8188: $upload_output .=
8189: "\n\t\t".
8190: '<input name="codebase_'.$num.'" type="hidden" value="'.
8191: &escape($$codebase{$embed_file}).'" />';
8192: }
8193: }
8194: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
8195: $num++;
8196: }
8197: $upload_output .= &Apache::loncommon::end_data_table().'<br />
8198: <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
8199: <input type ="submit" value="'.&mt('Upload Listed Files').'" />
8200: '.&mt('(only files for which a location has been provided will be uploaded)').'
8201: </form>';
8202: return $upload_output;
8203: }
8204:
1.661 raeburn 8205: sub upload_embedded {
8206: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
8207: $current_disk_usage) = @_;
8208: my $output;
8209: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
8210: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
8211: my $orig_uploaded_filename =
8212: $env{'form.embedded_item_'.$i.'.filename'};
8213:
8214: $env{'form.embedded_orig_'.$i} =
8215: &unescape($env{'form.embedded_orig_'.$i});
8216: my ($path,$fname) =
8217: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
8218: # no path, whole string is fname
8219: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
8220:
8221: $path = $env{'form.currentpath'}.$path;
8222: $fname = &Apache::lonnet::clean_filename($fname);
8223: # See if there is anything left
8224: next if ($fname eq '');
8225:
8226: # Check if file already exists as a file or directory.
8227: my ($state,$msg);
8228: if ($context eq 'portfolio') {
8229: my $port_path = $dirpath;
8230: if ($group ne '') {
8231: $port_path = "groups/$group/$port_path";
8232: }
8233: ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
8234: $dir_root,$port_path,$disk_quota,
8235: $current_disk_usage,$uname,$udom);
8236: if ($state eq 'will_exceed_quota'
8237: || $state eq 'file_locked'
8238: || $state eq 'file_exists' ) {
8239: $output .= $msg;
8240: next;
8241: }
8242: } elsif (($context eq 'author') || ($context eq 'testbank')) {
8243: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
8244: if ($state eq 'exists') {
8245: $output .= $msg;
8246: next;
8247: }
8248: }
8249: # Check if extension is valid
8250: if (($fname =~ /\.(\w+)$/) &&
8251: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
8252: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
8253: next;
8254: } elsif (($fname =~ /\.(\w+)$/) &&
8255: (!defined(&Apache::loncommon::fileembstyle($1)))) {
8256: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
8257: next;
8258: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
8259: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
8260: next;
8261: }
8262:
8263: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
8264: if ($context eq 'portfolio') {
8265: my $result=
8266: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
8267: $dirpath.$path);
8268: if ($result !~ m|^/uploaded/|) {
8269: $output .= '<span class="LC_error">'
8270: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
8271: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
8272: .'</span><br />';
8273: next;
8274: } else {
8275: $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
8276: $path.$fname.'</span>').'</p>';
8277: }
8278: } else {
8279: # Save the file
8280: my $target = $env{'form.embedded_item_'.$i};
8281: my $fullpath = $dir_root.$dirpath.'/'.$path;
8282: my $dest = $fullpath.$fname;
8283: my $url = $url_root.$dirpath.'/'.$path.$fname;
8284: my @parts=split(/\//,$fullpath);
8285: my $count;
8286: my $filepath = $dir_root;
8287: for ($count=4;$count<=$#parts;$count++) {
8288: $filepath .= "/$parts[$count]";
8289: if ((-e $filepath)!=1) {
8290: mkdir($filepath,0770);
8291: }
8292: }
8293: my $fh;
8294: if (!open($fh,'>'.$dest)) {
8295: &Apache::lonnet::logthis('Failed to create '.$dest);
8296: $output .= '<span class="LC_error">'.
8297: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
8298: '</span><br />';
8299: } else {
8300: if (!print $fh $env{'form.embedded_item_'.$i}) {
8301: &Apache::lonnet::logthis('Failed to write to '.$dest);
8302: $output .= '<span class="LC_error">'.
8303: &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
8304: '</span><br />';
8305: } else {
8306: if ($context eq 'testbank') {
8307: $output .= &mt('Embedded file uploaded successfully:').
8308: ' <a href="'.$url.'">'.
8309: $orig_uploaded_filename.'</a><br />';
8310: } else {
1.705 tempelho 8311: $output .= '<span class=\"LC_fontsize_large\">'.
1.661 raeburn 8312: &mt('View embedded file: [_1]','<a href="'.$url.'">'.
1.705 tempelho 8313: $orig_uploaded_filename.'</a>').'</span><br />';
1.661 raeburn 8314: }
8315: }
8316: close($fh);
8317: }
8318: }
8319: }
8320: return $output;
8321: }
8322:
8323: sub check_for_existing {
8324: my ($path,$fname,$element) = @_;
8325: my ($state,$msg);
8326: if (-d $path.'/'.$fname) {
8327: $state = 'exists';
8328: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
8329: } elsif (-e $path.'/'.$fname) {
8330: $state = 'exists';
8331: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
8332: }
8333: if ($state eq 'exists') {
8334: $msg = '<span class="LC_error">'.$msg.'</span><br />';
8335: }
8336: return ($state,$msg);
8337: }
8338:
8339: sub check_for_upload {
8340: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
8341: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
8342: my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
8343: my $getpropath = 1;
8344: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
8345: $getpropath);
8346: my $found_file = 0;
8347: my $locked_file = 0;
8348: foreach my $line (@dir_list) {
8349: my ($file_name)=split(/\&/,$line,2);
8350: if ($file_name eq $fname){
8351: $file_name = $path.$file_name;
8352: if ($group ne '') {
8353: $file_name = $group.$file_name;
8354: }
8355: $found_file = 1;
8356: if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
8357: $locked_file = 1;
8358: }
8359: }
8360: }
8361: if (($current_disk_usage + $filesize) > $disk_quota){
8362: my $msg = '<span class="LC_error">'.
8363: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
8364: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
8365: return ('will_exceed_quota',$msg);
8366: } elsif ($found_file) {
8367: if ($locked_file) {
8368: my $msg = '<span class="LC_error">';
8369: $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>');
8370: $msg .= '</span><br />';
8371: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
8372: return ('file_locked',$msg);
8373: } else {
8374: my $msg = '<span class="LC_error">';
8375: $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'});
8376: $msg .= '</span>';
8377: $msg .= '<br />';
8378: $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
8379: return ('file_exists',$msg);
8380: }
8381: }
8382: }
8383:
1.31 albertel 8384:
1.41 ng 8385: =pod
1.45 matthew 8386:
1.464 albertel 8387: =back
1.41 ng 8388:
1.112 bowersj2 8389: =head1 CSV Upload/Handling functions
1.38 albertel 8390:
1.41 ng 8391: =over 4
8392:
1.648 raeburn 8393: =item * &upfile_store($r)
1.41 ng 8394:
8395: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 8396: needs $env{'form.upfile'}
1.41 ng 8397: returns $datatoken to be put into hidden field
8398:
8399: =cut
1.31 albertel 8400:
8401: sub upfile_store {
8402: my $r=shift;
1.258 albertel 8403: $env{'form.upfile'}=~s/\r/\n/gs;
8404: $env{'form.upfile'}=~s/\f/\n/gs;
8405: $env{'form.upfile'}=~s/\n+/\n/gs;
8406: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 8407:
1.258 albertel 8408: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
8409: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 8410: {
1.158 raeburn 8411: my $datafile = $r->dir_config('lonDaemons').
8412: '/tmp/'.$datatoken.'.tmp';
8413: if ( open(my $fh,">$datafile") ) {
1.258 albertel 8414: print $fh $env{'form.upfile'};
1.158 raeburn 8415: close($fh);
8416: }
1.31 albertel 8417: }
8418: return $datatoken;
8419: }
8420:
1.56 matthew 8421: =pod
8422:
1.648 raeburn 8423: =item * &load_tmp_file($r)
1.41 ng 8424:
8425: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 8426: needs $env{'form.datatoken'},
8427: sets $env{'form.upfile'} to the contents of the file
1.41 ng 8428:
8429: =cut
1.31 albertel 8430:
8431: sub load_tmp_file {
8432: my $r=shift;
8433: my @studentdata=();
8434: {
1.158 raeburn 8435: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 8436: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 8437: if ( open(my $fh,"<$studentfile") ) {
8438: @studentdata=<$fh>;
8439: close($fh);
8440: }
1.31 albertel 8441: }
1.258 albertel 8442: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 8443: }
8444:
1.56 matthew 8445: =pod
8446:
1.648 raeburn 8447: =item * &upfile_record_sep()
1.41 ng 8448:
8449: Separate uploaded file into records
8450: returns array of records,
1.258 albertel 8451: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 8452:
8453: =cut
1.31 albertel 8454:
8455: sub upfile_record_sep {
1.258 albertel 8456: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 8457: } else {
1.248 albertel 8458: my @records;
1.258 albertel 8459: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 8460: if ($line=~/^\s*$/) { next; }
8461: push(@records,$line);
8462: }
8463: return @records;
1.31 albertel 8464: }
8465: }
8466:
1.56 matthew 8467: =pod
8468:
1.648 raeburn 8469: =item * &record_sep($record)
1.41 ng 8470:
1.258 albertel 8471: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 8472:
8473: =cut
8474:
1.263 www 8475: sub takeleft {
8476: my $index=shift;
8477: return substr('0000'.$index,-4,4);
8478: }
8479:
1.31 albertel 8480: sub record_sep {
8481: my $record=shift;
8482: my %components=();
1.258 albertel 8483: if ($env{'form.upfiletype'} eq 'xml') {
8484: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 8485: my $i=0;
1.356 albertel 8486: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 8487: $field=~s/^(\"|\')//;
8488: $field=~s/(\"|\')$//;
1.263 www 8489: $components{&takeleft($i)}=$field;
1.31 albertel 8490: $i++;
8491: }
1.258 albertel 8492: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 8493: my $i=0;
1.356 albertel 8494: foreach my $field (split(/\t/,$record)) {
1.31 albertel 8495: $field=~s/^(\"|\')//;
8496: $field=~s/(\"|\')$//;
1.263 www 8497: $components{&takeleft($i)}=$field;
1.31 albertel 8498: $i++;
8499: }
8500: } else {
1.561 www 8501: my $separator=',';
1.480 banghart 8502: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 8503: $separator=';';
1.480 banghart 8504: }
1.31 albertel 8505: my $i=0;
1.561 www 8506: # the character we are looking for to indicate the end of a quote or a record
8507: my $looking_for=$separator;
8508: # do not add the characters to the fields
8509: my $ignore=0;
8510: # we just encountered a separator (or the beginning of the record)
8511: my $just_found_separator=1;
8512: # store the field we are working on here
8513: my $field='';
8514: # work our way through all characters in record
8515: foreach my $character ($record=~/(.)/g) {
8516: if ($character eq $looking_for) {
8517: if ($character ne $separator) {
8518: # Found the end of a quote, again looking for separator
8519: $looking_for=$separator;
8520: $ignore=1;
8521: } else {
8522: # Found a separator, store away what we got
8523: $components{&takeleft($i)}=$field;
8524: $i++;
8525: $just_found_separator=1;
8526: $ignore=0;
8527: $field='';
8528: }
8529: next;
8530: }
8531: # single or double quotation marks after a separator indicate beginning of a quote
8532: # we are now looking for the end of the quote and need to ignore separators
8533: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
8534: $looking_for=$character;
8535: next;
8536: }
8537: # ignore would be true after we reached the end of a quote
8538: if ($ignore) { next; }
8539: if (($just_found_separator) && ($character=~/\s/)) { next; }
8540: $field.=$character;
8541: $just_found_separator=0;
1.31 albertel 8542: }
1.561 www 8543: # catch the very last entry, since we never encountered the separator
8544: $components{&takeleft($i)}=$field;
1.31 albertel 8545: }
8546: return %components;
8547: }
8548:
1.144 matthew 8549: ######################################################
8550: ######################################################
8551:
1.56 matthew 8552: =pod
8553:
1.648 raeburn 8554: =item * &upfile_select_html()
1.41 ng 8555:
1.144 matthew 8556: Return HTML code to select a file from the users machine and specify
8557: the file type.
1.41 ng 8558:
8559: =cut
8560:
1.144 matthew 8561: ######################################################
8562: ######################################################
1.31 albertel 8563: sub upfile_select_html {
1.144 matthew 8564: my %Types = (
8565: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 8566: semisv => &mt('Semicolon separated values'),
1.144 matthew 8567: space => &mt('Space separated'),
8568: tab => &mt('Tabulator separated'),
8569: # xml => &mt('HTML/XML'),
8570: );
8571: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 8572: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 8573: foreach my $type (sort(keys(%Types))) {
8574: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
8575: }
8576: $Str .= "</select>\n";
8577: return $Str;
1.31 albertel 8578: }
8579:
1.301 albertel 8580: sub get_samples {
8581: my ($records,$toget) = @_;
8582: my @samples=({});
8583: my $got=0;
8584: foreach my $rec (@$records) {
8585: my %temp = &record_sep($rec);
8586: if (! grep(/\S/, values(%temp))) { next; }
8587: if (%temp) {
8588: $samples[$got]=\%temp;
8589: $got++;
8590: if ($got == $toget) { last; }
8591: }
8592: }
8593: return \@samples;
8594: }
8595:
1.144 matthew 8596: ######################################################
8597: ######################################################
8598:
1.56 matthew 8599: =pod
8600:
1.648 raeburn 8601: =item * &csv_print_samples($r,$records)
1.41 ng 8602:
8603: Prints a table of sample values from each column uploaded $r is an
8604: Apache Request ref, $records is an arrayref from
8605: &Apache::loncommon::upfile_record_sep
8606:
8607: =cut
8608:
1.144 matthew 8609: ######################################################
8610: ######################################################
1.31 albertel 8611: sub csv_print_samples {
8612: my ($r,$records) = @_;
1.662 bisitz 8613: my $samples = &get_samples($records,5);
1.301 albertel 8614:
1.594 raeburn 8615: $r->print(&mt('Samples').'<br />'.&start_data_table().
8616: &start_data_table_header_row());
1.356 albertel 8617: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 8618: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 8619: $r->print(&end_data_table_header_row());
1.301 albertel 8620: foreach my $hash (@$samples) {
1.594 raeburn 8621: $r->print(&start_data_table_row());
1.356 albertel 8622: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 8623: $r->print('<td>');
1.356 albertel 8624: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 8625: $r->print('</td>');
8626: }
1.594 raeburn 8627: $r->print(&end_data_table_row());
1.31 albertel 8628: }
1.594 raeburn 8629: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 8630: }
8631:
1.144 matthew 8632: ######################################################
8633: ######################################################
8634:
1.56 matthew 8635: =pod
8636:
1.648 raeburn 8637: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 8638:
8639: Prints a table to create associations between values and table columns.
1.144 matthew 8640:
1.41 ng 8641: $r is an Apache Request ref,
8642: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 8643: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 8644:
8645: =cut
8646:
1.144 matthew 8647: ######################################################
8648: ######################################################
1.31 albertel 8649: sub csv_print_select_table {
8650: my ($r,$records,$d) = @_;
1.301 albertel 8651: my $i=0;
8652: my $samples = &get_samples($records,1);
1.144 matthew 8653: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 8654: &start_data_table().&start_data_table_header_row().
1.144 matthew 8655: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 8656: '<th>'.&mt('Column').'</th>'.
8657: &end_data_table_header_row()."\n");
1.356 albertel 8658: foreach my $array_ref (@$d) {
8659: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 8660: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 8661:
1.875 bisitz 8662: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 8663: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 8664: $r->print('<option value="none"></option>');
1.356 albertel 8665: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
8666: $r->print('<option value="'.$sample.'"'.
8667: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 8668: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 8669: }
1.594 raeburn 8670: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 8671: $i++;
8672: }
1.594 raeburn 8673: $r->print(&end_data_table());
1.31 albertel 8674: $i--;
8675: return $i;
8676: }
1.56 matthew 8677:
1.144 matthew 8678: ######################################################
8679: ######################################################
8680:
1.56 matthew 8681: =pod
1.31 albertel 8682:
1.648 raeburn 8683: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 8684:
8685: Prints a table of sample values from the upload and can make associate samples to internal names.
8686:
8687: $r is an Apache Request ref,
8688: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
8689: $d is an array of 2 element arrays (internal name, displayed name)
8690:
8691: =cut
8692:
1.144 matthew 8693: ######################################################
8694: ######################################################
1.31 albertel 8695: sub csv_samples_select_table {
8696: my ($r,$records,$d) = @_;
8697: my $i=0;
1.144 matthew 8698: #
1.662 bisitz 8699: my $max_samples = 5;
8700: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 8701: $r->print(&start_data_table().
8702: &start_data_table_header_row().'<th>'.
8703: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
8704: &end_data_table_header_row());
1.301 albertel 8705:
8706: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 8707: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 8708: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 8709: foreach my $option (@$d) {
8710: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 8711: $r->print('<option value="'.$value.'"'.
1.253 albertel 8712: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 8713: $display.'</option>');
1.31 albertel 8714: }
8715: $r->print('</select></td><td>');
1.662 bisitz 8716: foreach my $line (0..($max_samples-1)) {
1.301 albertel 8717: if (defined($samples->[$line]{$key})) {
8718: $r->print($samples->[$line]{$key}."<br />\n");
8719: }
8720: }
1.594 raeburn 8721: $r->print('</td>'.&end_data_table_row());
1.31 albertel 8722: $i++;
8723: }
1.594 raeburn 8724: $r->print(&end_data_table());
1.31 albertel 8725: $i--;
8726: return($i);
1.115 matthew 8727: }
8728:
1.144 matthew 8729: ######################################################
8730: ######################################################
8731:
1.115 matthew 8732: =pod
8733:
1.648 raeburn 8734: =item * &clean_excel_name($name)
1.115 matthew 8735:
8736: Returns a replacement for $name which does not contain any illegal characters.
8737:
8738: =cut
8739:
1.144 matthew 8740: ######################################################
8741: ######################################################
1.115 matthew 8742: sub clean_excel_name {
8743: my ($name) = @_;
8744: $name =~ s/[:\*\?\/\\]//g;
8745: if (length($name) > 31) {
8746: $name = substr($name,0,31);
8747: }
8748: return $name;
1.25 albertel 8749: }
1.84 albertel 8750:
1.85 albertel 8751: =pod
8752:
1.648 raeburn 8753: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 8754:
8755: Returns either 1 or undef
8756:
8757: 1 if the part is to be hidden, undef if it is to be shown
8758:
8759: Arguments are:
8760:
8761: $id the id of the part to be checked
8762: $symb, optional the symb of the resource to check
8763: $udom, optional the domain of the user to check for
8764: $uname, optional the username of the user to check for
8765:
8766: =cut
1.84 albertel 8767:
8768: sub check_if_partid_hidden {
8769: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 8770: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 8771: $symb,$udom,$uname);
1.141 albertel 8772: my $truth=1;
8773: #if the string starts with !, then the list is the list to show not hide
8774: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 8775: my @hiddenlist=split(/,/,$hiddenparts);
8776: foreach my $checkid (@hiddenlist) {
1.141 albertel 8777: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 8778: }
1.141 albertel 8779: return !$truth;
1.84 albertel 8780: }
1.127 matthew 8781:
1.138 matthew 8782:
8783: ############################################################
8784: ############################################################
8785:
8786: =pod
8787:
1.157 matthew 8788: =back
8789:
1.138 matthew 8790: =head1 cgi-bin script and graphing routines
8791:
1.157 matthew 8792: =over 4
8793:
1.648 raeburn 8794: =item * &get_cgi_id()
1.138 matthew 8795:
8796: Inputs: none
8797:
8798: Returns an id which can be used to pass environment variables
8799: to various cgi-bin scripts. These environment variables will
8800: be removed from the users environment after a given time by
8801: the routine &Apache::lonnet::transfer_profile_to_env.
8802:
8803: =cut
8804:
8805: ############################################################
8806: ############################################################
1.152 albertel 8807: my $uniq=0;
1.136 matthew 8808: sub get_cgi_id {
1.154 albertel 8809: $uniq=($uniq+1)%100000;
1.280 albertel 8810: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 8811: }
8812:
1.127 matthew 8813: ############################################################
8814: ############################################################
8815:
8816: =pod
8817:
1.648 raeburn 8818: =item * &DrawBarGraph()
1.127 matthew 8819:
1.138 matthew 8820: Facilitates the plotting of data in a (stacked) bar graph.
8821: Puts plot definition data into the users environment in order for
8822: graph.png to plot it. Returns an <img> tag for the plot.
8823: The bars on the plot are labeled '1','2',...,'n'.
8824:
8825: Inputs:
8826:
8827: =over 4
8828:
8829: =item $Title: string, the title of the plot
8830:
8831: =item $xlabel: string, text describing the X-axis of the plot
8832:
8833: =item $ylabel: string, text describing the Y-axis of the plot
8834:
8835: =item $Max: scalar, the maximum Y value to use in the plot
8836: If $Max is < any data point, the graph will not be rendered.
8837:
1.140 matthew 8838: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 8839: they are plotted. If undefined, default values will be used.
8840:
1.178 matthew 8841: =item $labels: array ref holding the labels to use on the x-axis for the bars.
8842:
1.138 matthew 8843: =item @Values: An array of array references. Each array reference holds data
8844: to be plotted in a stacked bar chart.
8845:
1.239 matthew 8846: =item If the final element of @Values is a hash reference the key/value
8847: pairs will be added to the graph definition.
8848:
1.138 matthew 8849: =back
8850:
8851: Returns:
8852:
8853: An <img> tag which references graph.png and the appropriate identifying
8854: information for the plot.
8855:
1.127 matthew 8856: =cut
8857:
8858: ############################################################
8859: ############################################################
1.134 matthew 8860: sub DrawBarGraph {
1.178 matthew 8861: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 8862: #
8863: if (! defined($colors)) {
8864: $colors = ['#33ff00',
8865: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
8866: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
8867: ];
8868: }
1.228 matthew 8869: my $extra_settings = {};
8870: if (ref($Values[-1]) eq 'HASH') {
8871: $extra_settings = pop(@Values);
8872: }
1.127 matthew 8873: #
1.136 matthew 8874: my $identifier = &get_cgi_id();
8875: my $id = 'cgi.'.$identifier;
1.129 matthew 8876: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 8877: return '';
8878: }
1.225 matthew 8879: #
8880: my @Labels;
8881: if (defined($labels)) {
8882: @Labels = @$labels;
8883: } else {
8884: for (my $i=0;$i<@{$Values[0]};$i++) {
8885: push (@Labels,$i+1);
8886: }
8887: }
8888: #
1.129 matthew 8889: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 8890: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 8891: my %ValuesHash;
8892: my $NumSets=1;
8893: foreach my $array (@Values) {
8894: next if (! ref($array));
1.136 matthew 8895: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 8896: join(',',@$array);
1.129 matthew 8897: }
1.127 matthew 8898: #
1.136 matthew 8899: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 8900: if ($NumBars < 3) {
8901: $width = 120+$NumBars*32;
1.220 matthew 8902: $xskip = 1;
1.225 matthew 8903: $bar_width = 30;
8904: } elsif ($NumBars < 5) {
8905: $width = 120+$NumBars*20;
8906: $xskip = 1;
8907: $bar_width = 20;
1.220 matthew 8908: } elsif ($NumBars < 10) {
1.136 matthew 8909: $width = 120+$NumBars*15;
8910: $xskip = 1;
8911: $bar_width = 15;
8912: } elsif ($NumBars <= 25) {
8913: $width = 120+$NumBars*11;
8914: $xskip = 5;
8915: $bar_width = 8;
8916: } elsif ($NumBars <= 50) {
8917: $width = 120+$NumBars*8;
8918: $xskip = 5;
8919: $bar_width = 4;
8920: } else {
8921: $width = 120+$NumBars*8;
8922: $xskip = 5;
8923: $bar_width = 4;
8924: }
8925: #
1.137 matthew 8926: $Max = 1 if ($Max < 1);
8927: if ( int($Max) < $Max ) {
8928: $Max++;
8929: $Max = int($Max);
8930: }
1.127 matthew 8931: $Title = '' if (! defined($Title));
8932: $xlabel = '' if (! defined($xlabel));
8933: $ylabel = '' if (! defined($ylabel));
1.369 www 8934: $ValuesHash{$id.'.title'} = &escape($Title);
8935: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
8936: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 8937: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 8938: $ValuesHash{$id.'.NumBars'} = $NumBars;
8939: $ValuesHash{$id.'.NumSets'} = $NumSets;
8940: $ValuesHash{$id.'.PlotType'} = 'bar';
8941: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
8942: $ValuesHash{$id.'.height'} = $height;
8943: $ValuesHash{$id.'.width'} = $width;
8944: $ValuesHash{$id.'.xskip'} = $xskip;
8945: $ValuesHash{$id.'.bar_width'} = $bar_width;
8946: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 8947: #
1.228 matthew 8948: # Deal with other parameters
8949: while (my ($key,$value) = each(%$extra_settings)) {
8950: $ValuesHash{$id.'.'.$key} = $value;
8951: }
8952: #
1.646 raeburn 8953: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 8954: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
8955: }
8956:
8957: ############################################################
8958: ############################################################
8959:
8960: =pod
8961:
1.648 raeburn 8962: =item * &DrawXYGraph()
1.137 matthew 8963:
1.138 matthew 8964: Facilitates the plotting of data in an XY graph.
8965: Puts plot definition data into the users environment in order for
8966: graph.png to plot it. Returns an <img> tag for the plot.
8967:
8968: Inputs:
8969:
8970: =over 4
8971:
8972: =item $Title: string, the title of the plot
8973:
8974: =item $xlabel: string, text describing the X-axis of the plot
8975:
8976: =item $ylabel: string, text describing the Y-axis of the plot
8977:
8978: =item $Max: scalar, the maximum Y value to use in the plot
8979: If $Max is < any data point, the graph will not be rendered.
8980:
8981: =item $colors: Array ref containing the hex color codes for the data to be
8982: plotted in. If undefined, default values will be used.
8983:
8984: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
8985:
8986: =item $Ydata: Array ref containing Array refs.
1.185 www 8987: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 8988:
8989: =item %Values: hash indicating or overriding any default values which are
8990: passed to graph.png.
8991: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
8992:
8993: =back
8994:
8995: Returns:
8996:
8997: An <img> tag which references graph.png and the appropriate identifying
8998: information for the plot.
8999:
1.137 matthew 9000: =cut
9001:
9002: ############################################################
9003: ############################################################
9004: sub DrawXYGraph {
9005: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
9006: #
9007: # Create the identifier for the graph
9008: my $identifier = &get_cgi_id();
9009: my $id = 'cgi.'.$identifier;
9010: #
9011: $Title = '' if (! defined($Title));
9012: $xlabel = '' if (! defined($xlabel));
9013: $ylabel = '' if (! defined($ylabel));
9014: my %ValuesHash =
9015: (
1.369 www 9016: $id.'.title' => &escape($Title),
9017: $id.'.xlabel' => &escape($xlabel),
9018: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 9019: $id.'.y_max_value'=> $Max,
9020: $id.'.labels' => join(',',@$Xlabels),
9021: $id.'.PlotType' => 'XY',
9022: );
9023: #
9024: if (defined($colors) && ref($colors) eq 'ARRAY') {
9025: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
9026: }
9027: #
9028: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
9029: return '';
9030: }
9031: my $NumSets=1;
1.138 matthew 9032: foreach my $array (@{$Ydata}){
1.137 matthew 9033: next if (! ref($array));
9034: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
9035: }
1.138 matthew 9036: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 9037: #
9038: # Deal with other parameters
9039: while (my ($key,$value) = each(%Values)) {
9040: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 9041: }
9042: #
1.646 raeburn 9043: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 9044: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
9045: }
9046:
9047: ############################################################
9048: ############################################################
9049:
9050: =pod
9051:
1.648 raeburn 9052: =item * &DrawXYYGraph()
1.138 matthew 9053:
9054: Facilitates the plotting of data in an XY graph with two Y axes.
9055: Puts plot definition data into the users environment in order for
9056: graph.png to plot it. Returns an <img> tag for the plot.
9057:
9058: Inputs:
9059:
9060: =over 4
9061:
9062: =item $Title: string, the title of the plot
9063:
9064: =item $xlabel: string, text describing the X-axis of the plot
9065:
9066: =item $ylabel: string, text describing the Y-axis of the plot
9067:
9068: =item $colors: Array ref containing the hex color codes for the data to be
9069: plotted in. If undefined, default values will be used.
9070:
9071: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
9072:
9073: =item $Ydata1: The first data set
9074:
9075: =item $Min1: The minimum value of the left Y-axis
9076:
9077: =item $Max1: The maximum value of the left Y-axis
9078:
9079: =item $Ydata2: The second data set
9080:
9081: =item $Min2: The minimum value of the right Y-axis
9082:
9083: =item $Max2: The maximum value of the left Y-axis
9084:
9085: =item %Values: hash indicating or overriding any default values which are
9086: passed to graph.png.
9087: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
9088:
9089: =back
9090:
9091: Returns:
9092:
9093: An <img> tag which references graph.png and the appropriate identifying
9094: information for the plot.
1.136 matthew 9095:
9096: =cut
9097:
9098: ############################################################
9099: ############################################################
1.137 matthew 9100: sub DrawXYYGraph {
9101: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
9102: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 9103: #
9104: # Create the identifier for the graph
9105: my $identifier = &get_cgi_id();
9106: my $id = 'cgi.'.$identifier;
9107: #
9108: $Title = '' if (! defined($Title));
9109: $xlabel = '' if (! defined($xlabel));
9110: $ylabel = '' if (! defined($ylabel));
9111: my %ValuesHash =
9112: (
1.369 www 9113: $id.'.title' => &escape($Title),
9114: $id.'.xlabel' => &escape($xlabel),
9115: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 9116: $id.'.labels' => join(',',@$Xlabels),
9117: $id.'.PlotType' => 'XY',
9118: $id.'.NumSets' => 2,
1.137 matthew 9119: $id.'.two_axes' => 1,
9120: $id.'.y1_max_value' => $Max1,
9121: $id.'.y1_min_value' => $Min1,
9122: $id.'.y2_max_value' => $Max2,
9123: $id.'.y2_min_value' => $Min2,
1.136 matthew 9124: );
9125: #
1.137 matthew 9126: if (defined($colors) && ref($colors) eq 'ARRAY') {
9127: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
9128: }
9129: #
9130: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
9131: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 9132: return '';
9133: }
9134: my $NumSets=1;
1.137 matthew 9135: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 9136: next if (! ref($array));
9137: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 9138: }
9139: #
9140: # Deal with other parameters
9141: while (my ($key,$value) = each(%Values)) {
9142: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 9143: }
9144: #
1.646 raeburn 9145: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 9146: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 9147: }
9148:
9149: ############################################################
9150: ############################################################
9151:
9152: =pod
9153:
1.157 matthew 9154: =back
9155:
1.139 matthew 9156: =head1 Statistics helper routines?
9157:
9158: Bad place for them but what the hell.
9159:
1.157 matthew 9160: =over 4
9161:
1.648 raeburn 9162: =item * &chartlink()
1.139 matthew 9163:
9164: Returns a link to the chart for a specific student.
9165:
9166: Inputs:
9167:
9168: =over 4
9169:
9170: =item $linktext: The text of the link
9171:
9172: =item $sname: The students username
9173:
9174: =item $sdomain: The students domain
9175:
9176: =back
9177:
1.157 matthew 9178: =back
9179:
1.139 matthew 9180: =cut
9181:
9182: ############################################################
9183: ############################################################
9184: sub chartlink {
9185: my ($linktext, $sname, $sdomain) = @_;
9186: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 9187: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 9188: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 9189: '">'.$linktext.'</a>';
1.153 matthew 9190: }
9191:
9192: #######################################################
9193: #######################################################
9194:
9195: =pod
9196:
9197: =head1 Course Environment Routines
1.157 matthew 9198:
9199: =over 4
1.153 matthew 9200:
1.648 raeburn 9201: =item * &restore_course_settings()
1.153 matthew 9202:
1.648 raeburn 9203: =item * &store_course_settings()
1.153 matthew 9204:
9205: Restores/Store indicated form parameters from the course environment.
9206: Will not overwrite existing values of the form parameters.
9207:
9208: Inputs:
9209: a scalar describing the data (e.g. 'chart', 'problem_analysis')
9210:
9211: a hash ref describing the data to be stored. For example:
9212:
9213: %Save_Parameters = ('Status' => 'scalar',
9214: 'chartoutputmode' => 'scalar',
9215: 'chartoutputdata' => 'scalar',
9216: 'Section' => 'array',
1.373 raeburn 9217: 'Group' => 'array',
1.153 matthew 9218: 'StudentData' => 'array',
9219: 'Maps' => 'array');
9220:
9221: Returns: both routines return nothing
9222:
1.631 raeburn 9223: =back
9224:
1.153 matthew 9225: =cut
9226:
9227: #######################################################
9228: #######################################################
9229: sub store_course_settings {
1.496 albertel 9230: return &store_settings($env{'request.course.id'},@_);
9231: }
9232:
9233: sub store_settings {
1.153 matthew 9234: # save to the environment
9235: # appenv the same items, just to be safe
1.300 albertel 9236: my $udom = $env{'user.domain'};
9237: my $uname = $env{'user.name'};
1.496 albertel 9238: my ($context,$prefix,$Settings) = @_;
1.153 matthew 9239: my %SaveHash;
9240: my %AppHash;
9241: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 9242: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 9243: my $envname = 'environment.'.$basename;
1.258 albertel 9244: if (exists($env{'form.'.$setting})) {
1.153 matthew 9245: # Save this value away
9246: if ($type eq 'scalar' &&
1.258 albertel 9247: (! exists($env{$envname}) ||
9248: $env{$envname} ne $env{'form.'.$setting})) {
9249: $SaveHash{$basename} = $env{'form.'.$setting};
9250: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 9251: } elsif ($type eq 'array') {
9252: my $stored_form;
1.258 albertel 9253: if (ref($env{'form.'.$setting})) {
1.153 matthew 9254: $stored_form = join(',',
9255: map {
1.369 www 9256: &escape($_);
1.258 albertel 9257: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 9258: } else {
9259: $stored_form =
1.369 www 9260: &escape($env{'form.'.$setting});
1.153 matthew 9261: }
9262: # Determine if the array contents are the same.
1.258 albertel 9263: if ($stored_form ne $env{$envname}) {
1.153 matthew 9264: $SaveHash{$basename} = $stored_form;
9265: $AppHash{$envname} = $stored_form;
9266: }
9267: }
9268: }
9269: }
9270: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 9271: $udom,$uname);
1.153 matthew 9272: if ($put_result !~ /^(ok|delayed)/) {
9273: &Apache::lonnet::logthis('unable to save form parameters, '.
9274: 'got error:'.$put_result);
9275: }
9276: # Make sure these settings stick around in this session, too
1.646 raeburn 9277: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 9278: return;
9279: }
9280:
9281: sub restore_course_settings {
1.499 albertel 9282: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 9283: }
9284:
9285: sub restore_settings {
9286: my ($context,$prefix,$Settings) = @_;
1.153 matthew 9287: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 9288: next if (exists($env{'form.'.$setting}));
1.496 albertel 9289: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 9290: '.'.$setting;
1.258 albertel 9291: if (exists($env{$envname})) {
1.153 matthew 9292: if ($type eq 'scalar') {
1.258 albertel 9293: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 9294: } elsif ($type eq 'array') {
1.258 albertel 9295: $env{'form.'.$setting} = [
1.153 matthew 9296: map {
1.369 www 9297: &unescape($_);
1.258 albertel 9298: } split(',',$env{$envname})
1.153 matthew 9299: ];
9300: }
9301: }
9302: }
1.127 matthew 9303: }
9304:
1.618 raeburn 9305: #######################################################
9306: #######################################################
9307:
9308: =pod
9309:
9310: =head1 Domain E-mail Routines
9311:
9312: =over 4
9313:
1.648 raeburn 9314: =item * &build_recipient_list()
1.618 raeburn 9315:
1.884 raeburn 9316: Build recipient lists for five types of e-mail:
1.766 raeburn 9317: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884 raeburn 9318: (d) Help requests, (e) Course requests needing approval, generated by
9319: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
9320: loncoursequeueadmin.pm respectively.
1.618 raeburn 9321:
9322: Inputs:
1.619 raeburn 9323: defmail (scalar - email address of default recipient),
1.618 raeburn 9324: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 9325: defdom (domain for which to retrieve configuration settings),
9326: origmail (scalar - email address of recipient from loncapa.conf,
9327: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 9328:
1.655 raeburn 9329: Returns: comma separated list of addresses to which to send e-mail.
9330:
9331: =back
1.618 raeburn 9332:
9333: =cut
9334:
9335: ############################################################
9336: ############################################################
9337: sub build_recipient_list {
1.619 raeburn 9338: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 9339: my @recipients;
9340: my $otheremails;
9341: my %domconfig =
9342: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
9343: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 9344: if (exists($domconfig{'contacts'}{$mailing})) {
9345: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
9346: my @contacts = ('adminemail','supportemail');
9347: foreach my $item (@contacts) {
9348: if ($domconfig{'contacts'}{$mailing}{$item}) {
9349: my $addr = $domconfig{'contacts'}{$item};
9350: if (!grep(/^\Q$addr\E$/,@recipients)) {
9351: push(@recipients,$addr);
9352: }
1.619 raeburn 9353: }
1.766 raeburn 9354: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 9355: }
9356: }
1.766 raeburn 9357: } elsif ($origmail ne '') {
9358: push(@recipients,$origmail);
1.618 raeburn 9359: }
1.619 raeburn 9360: } elsif ($origmail ne '') {
9361: push(@recipients,$origmail);
1.618 raeburn 9362: }
1.688 raeburn 9363: if (defined($defmail)) {
9364: if ($defmail ne '') {
9365: push(@recipients,$defmail);
9366: }
1.618 raeburn 9367: }
9368: if ($otheremails) {
1.619 raeburn 9369: my @others;
9370: if ($otheremails =~ /,/) {
9371: @others = split(/,/,$otheremails);
1.618 raeburn 9372: } else {
1.619 raeburn 9373: push(@others,$otheremails);
9374: }
9375: foreach my $addr (@others) {
9376: if (!grep(/^\Q$addr\E$/,@recipients)) {
9377: push(@recipients,$addr);
9378: }
1.618 raeburn 9379: }
9380: }
1.619 raeburn 9381: my $recipientlist = join(',',@recipients);
1.618 raeburn 9382: return $recipientlist;
9383: }
9384:
1.127 matthew 9385: ############################################################
9386: ############################################################
1.154 albertel 9387:
1.655 raeburn 9388: =pod
9389:
9390: =head1 Course Catalog Routines
9391:
9392: =over 4
9393:
9394: =item * &gather_categories()
9395:
9396: Converts category definitions - keys of categories hash stored in
9397: coursecategories in configuration.db on the primary library server in a
9398: domain - to an array. Also generates javascript and idx hash used to
9399: generate Domain Coordinator interface for editing Course Categories.
9400:
9401: Inputs:
1.663 raeburn 9402:
1.655 raeburn 9403: categories (reference to hash of category definitions).
1.663 raeburn 9404:
1.655 raeburn 9405: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9406: categories and subcategories).
1.663 raeburn 9407:
1.655 raeburn 9408: idx (reference to hash of counters used in Domain Coordinator interface for
9409: editing Course Categories).
1.663 raeburn 9410:
1.655 raeburn 9411: jsarray (reference to array of categories used to create Javascript arrays for
9412: Domain Coordinator interface for editing Course Categories).
9413:
9414: Returns: nothing
9415:
9416: Side effects: populates cats, idx and jsarray.
9417:
9418: =cut
9419:
9420: sub gather_categories {
9421: my ($categories,$cats,$idx,$jsarray) = @_;
9422: my %counters;
9423: my $num = 0;
9424: foreach my $item (keys(%{$categories})) {
9425: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
9426: if ($container eq '' && $depth == 0) {
9427: $cats->[$depth][$categories->{$item}] = $cat;
9428: } else {
9429: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
9430: }
9431: my ($escitem,$tail) = split(/:/,$item,2);
9432: if ($counters{$tail} eq '') {
9433: $counters{$tail} = $num;
9434: $num ++;
9435: }
9436: if (ref($idx) eq 'HASH') {
9437: $idx->{$item} = $counters{$tail};
9438: }
9439: if (ref($jsarray) eq 'ARRAY') {
9440: push(@{$jsarray->[$counters{$tail}]},$item);
9441: }
9442: }
9443: return;
9444: }
9445:
9446: =pod
9447:
9448: =item * &extract_categories()
9449:
9450: Used to generate breadcrumb trails for course categories.
9451:
9452: Inputs:
1.663 raeburn 9453:
1.655 raeburn 9454: categories (reference to hash of category definitions).
1.663 raeburn 9455:
1.655 raeburn 9456: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9457: categories and subcategories).
1.663 raeburn 9458:
1.655 raeburn 9459: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 9460:
1.655 raeburn 9461: allitems (reference to hash - key is category key
9462: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 9463:
1.655 raeburn 9464: idx (reference to hash of counters used in Domain Coordinator interface for
9465: editing Course Categories).
1.663 raeburn 9466:
1.655 raeburn 9467: jsarray (reference to array of categories used to create Javascript arrays for
9468: Domain Coordinator interface for editing Course Categories).
9469:
1.665 raeburn 9470: subcats (reference to hash of arrays containing all subcategories within each
9471: category, -recursive)
9472:
1.655 raeburn 9473: Returns: nothing
9474:
9475: Side effects: populates trails and allitems hash references.
9476:
9477: =cut
9478:
9479: sub extract_categories {
1.665 raeburn 9480: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 9481: if (ref($categories) eq 'HASH') {
9482: &gather_categories($categories,$cats,$idx,$jsarray);
9483: if (ref($cats->[0]) eq 'ARRAY') {
9484: for (my $i=0; $i<@{$cats->[0]}; $i++) {
9485: my $name = $cats->[0][$i];
9486: my $item = &escape($name).'::0';
9487: my $trailstr;
9488: if ($name eq 'instcode') {
9489: $trailstr = &mt('Official courses (with institutional codes)');
9490: } else {
9491: $trailstr = $name;
9492: }
9493: if ($allitems->{$item} eq '') {
9494: push(@{$trails},$trailstr);
9495: $allitems->{$item} = scalar(@{$trails})-1;
9496: }
9497: my @parents = ($name);
9498: if (ref($cats->[1]{$name}) eq 'ARRAY') {
9499: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
9500: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 9501: if (ref($subcats) eq 'HASH') {
9502: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
9503: }
9504: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
9505: }
9506: } else {
9507: if (ref($subcats) eq 'HASH') {
9508: $subcats->{$item} = [];
1.655 raeburn 9509: }
9510: }
9511: }
9512: }
9513: }
9514: return;
9515: }
9516:
9517: =pod
9518:
9519: =item *&recurse_categories()
9520:
9521: Recursively used to generate breadcrumb trails for course categories.
9522:
9523: Inputs:
1.663 raeburn 9524:
1.655 raeburn 9525: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9526: categories and subcategories).
1.663 raeburn 9527:
1.655 raeburn 9528: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 9529:
9530: category (current course category, for which breadcrumb trail is being generated).
9531:
9532: trails (reference to array of breadcrumb trails for each category).
9533:
1.655 raeburn 9534: allitems (reference to hash - key is category key
9535: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 9536:
1.655 raeburn 9537: parents (array containing containers directories for current category,
9538: back to top level).
9539:
9540: Returns: nothing
9541:
9542: Side effects: populates trails and allitems hash references
9543:
9544: =cut
9545:
9546: sub recurse_categories {
1.665 raeburn 9547: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 9548: my $shallower = $depth - 1;
9549: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
9550: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
9551: my $name = $cats->[$depth]{$category}[$k];
9552: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9553: my $trailstr = join(' -> ',(@{$parents},$category));
9554: if ($allitems->{$item} eq '') {
9555: push(@{$trails},$trailstr);
9556: $allitems->{$item} = scalar(@{$trails})-1;
9557: }
9558: my $deeper = $depth+1;
9559: push(@{$parents},$category);
1.665 raeburn 9560: if (ref($subcats) eq 'HASH') {
9561: my $subcat = &escape($name).':'.$category.':'.$depth;
9562: for (my $j=@{$parents}; $j>=0; $j--) {
9563: my $higher;
9564: if ($j > 0) {
9565: $higher = &escape($parents->[$j]).':'.
9566: &escape($parents->[$j-1]).':'.$j;
9567: } else {
9568: $higher = &escape($parents->[$j]).'::'.$j;
9569: }
9570: push(@{$subcats->{$higher}},$subcat);
9571: }
9572: }
9573: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
9574: $subcats);
1.655 raeburn 9575: pop(@{$parents});
9576: }
9577: } else {
9578: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9579: my $trailstr = join(' -> ',(@{$parents},$category));
9580: if ($allitems->{$item} eq '') {
9581: push(@{$trails},$trailstr);
9582: $allitems->{$item} = scalar(@{$trails})-1;
9583: }
9584: }
9585: return;
9586: }
9587:
1.663 raeburn 9588: =pod
9589:
9590: =item *&assign_categories_table()
9591:
9592: Create a datatable for display of hierarchical categories in a domain,
9593: with checkboxes to allow a course to be categorized.
9594:
9595: Inputs:
9596:
9597: cathash - reference to hash of categories defined for the domain (from
9598: configuration.db)
9599:
9600: currcat - scalar with an & separated list of categories assigned to a course.
9601:
9602: Returns: $output (markup to be displayed)
9603:
9604: =cut
9605:
9606: sub assign_categories_table {
9607: my ($cathash,$currcat) = @_;
9608: my $output;
9609: if (ref($cathash) eq 'HASH') {
9610: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
9611: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
9612: $maxdepth = scalar(@cats);
9613: if (@cats > 0) {
9614: my $itemcount = 0;
9615: if (ref($cats[0]) eq 'ARRAY') {
9616: $output = &Apache::loncommon::start_data_table();
9617: my @currcategories;
9618: if ($currcat ne '') {
9619: @currcategories = split('&',$currcat);
9620: }
9621: for (my $i=0; $i<@{$cats[0]}; $i++) {
9622: my $parent = $cats[0][$i];
9623: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
9624: next if ($parent eq 'instcode');
9625: my $item = &escape($parent).'::0';
9626: my $checked = '';
9627: if (@currcategories > 0) {
9628: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 9629: $checked = ' checked="checked"';
1.663 raeburn 9630: }
9631: }
1.675 raeburn 9632: $output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
9633: '<input type="checkbox" name="usecategory" value="'.
9634: $item.'"'.$checked.' />'.$parent.'</span>'.
9635: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 9636: my $depth = 1;
9637: push(@path,$parent);
9638: $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
9639: pop(@path);
9640: $output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
9641: $itemcount ++;
9642: }
9643: $output .= &Apache::loncommon::end_data_table();
9644: }
9645: }
9646: }
9647: return $output;
9648: }
9649:
9650: =pod
9651:
9652: =item *&assign_category_rows()
9653:
9654: Create a datatable row for display of nested categories in a domain,
9655: with checkboxes to allow a course to be categorized,called recursively.
9656:
9657: Inputs:
9658:
9659: itemcount - track row number for alternating colors
9660:
9661: cats - reference to array of arrays/hashes which encapsulates hierarchy of
9662: categories and subcategories.
9663:
9664: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
9665:
9666: parent - parent of current category item
9667:
9668: path - Array containing all categories back up through the hierarchy from the
9669: current category to the top level.
9670:
9671: currcategories - reference to array of current categories assigned to the course
9672:
9673: Returns: $output (markup to be displayed).
9674:
9675: =cut
9676:
9677: sub assign_category_rows {
9678: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
9679: my ($text,$name,$item,$chgstr);
9680: if (ref($cats) eq 'ARRAY') {
9681: my $maxdepth = scalar(@{$cats});
9682: if (ref($cats->[$depth]) eq 'HASH') {
9683: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
9684: my $numchildren = @{$cats->[$depth]{$parent}};
9685: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
9686: $text .= '<td><table class="LC_datatable">';
9687: for (my $j=0; $j<$numchildren; $j++) {
9688: $name = $cats->[$depth]{$parent}[$j];
9689: $item = &escape($name).':'.&escape($parent).':'.$depth;
9690: my $deeper = $depth+1;
9691: my $checked = '';
9692: if (ref($currcategories) eq 'ARRAY') {
9693: if (@{$currcategories} > 0) {
9694: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 9695: $checked = ' checked="checked"';
1.663 raeburn 9696: }
9697: }
9698: }
1.664 raeburn 9699: $text .= '<tr><td><span class="LC_nobreak"><label>'.
9700: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 9701: $item.'"'.$checked.' />'.$name.'</label></span>'.
9702: '<input type="hidden" name="catname" value="'.$name.'" />'.
9703: '</td><td>';
1.663 raeburn 9704: if (ref($path) eq 'ARRAY') {
9705: push(@{$path},$name);
9706: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
9707: pop(@{$path});
9708: }
9709: $text .= '</td></tr>';
9710: }
9711: $text .= '</table></td>';
9712: }
9713: }
9714: }
9715: return $text;
9716: }
9717:
1.655 raeburn 9718: ############################################################
9719: ############################################################
9720:
9721:
1.443 albertel 9722: sub commit_customrole {
1.664 raeburn 9723: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 9724: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 9725: ($start?', '.&mt('starting').' '.localtime($start):'').
9726: ($end?', ending '.localtime($end):'').': <b>'.
9727: &Apache::lonnet::assigncustomrole(
1.664 raeburn 9728: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 9729: '</b><br />';
9730: return $output;
9731: }
9732:
9733: sub commit_standardrole {
1.541 raeburn 9734: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
9735: my ($output,$logmsg,$linefeed);
9736: if ($context eq 'auto') {
9737: $linefeed = "\n";
9738: } else {
9739: $linefeed = "<br />\n";
9740: }
1.443 albertel 9741: if ($three eq 'st') {
1.541 raeburn 9742: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
9743: $one,$two,$sec,$context);
9744: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 9745: ($result eq 'unknown_course') || ($result eq 'refused')) {
9746: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 9747: } else {
1.541 raeburn 9748: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 9749: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9750: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
9751: if ($context eq 'auto') {
9752: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
9753: } else {
9754: $output .= '<b>'.$result.'</b>'.$linefeed.
9755: &mt('Add to classlist').': <b>ok</b>';
9756: }
9757: $output .= $linefeed;
1.443 albertel 9758: }
9759: } else {
9760: $output = &mt('Assigning').' '.$three.' in '.$url.
9761: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 9762: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 9763: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 9764: if ($context eq 'auto') {
9765: $output .= $result.$linefeed;
9766: } else {
9767: $output .= '<b>'.$result.'</b>'.$linefeed;
9768: }
1.443 albertel 9769: }
9770: return $output;
9771: }
9772:
9773: sub commit_studentrole {
1.541 raeburn 9774: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 9775: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 9776: if ($context eq 'auto') {
9777: $linefeed = "\n";
9778: } else {
9779: $linefeed = '<br />'."\n";
9780: }
1.443 albertel 9781: if (defined($one) && defined($two)) {
9782: my $cid=$one.'_'.$two;
9783: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
9784: my $secchange = 0;
9785: my $expire_role_result;
9786: my $modify_section_result;
1.628 raeburn 9787: if ($oldsec ne '-1') {
9788: if ($oldsec ne $sec) {
1.443 albertel 9789: $secchange = 1;
1.628 raeburn 9790: my $now = time;
1.443 albertel 9791: my $uurl='/'.$cid;
9792: $uurl=~s/\_/\//g;
9793: if ($oldsec) {
9794: $uurl.='/'.$oldsec;
9795: }
1.626 raeburn 9796: $oldsecurl = $uurl;
1.628 raeburn 9797: $expire_role_result =
1.652 raeburn 9798: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 9799: if ($env{'request.course.sec'} ne '') {
9800: if ($expire_role_result eq 'refused') {
9801: my @roles = ('st');
9802: my @statuses = ('previous');
9803: my @roledoms = ($one);
9804: my $withsec = 1;
9805: my %roleshash =
9806: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
9807: \@statuses,\@roles,\@roledoms,$withsec);
9808: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
9809: my ($oldstart,$oldend) =
9810: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
9811: if ($oldend > 0 && $oldend <= $now) {
9812: $expire_role_result = 'ok';
9813: }
9814: }
9815: }
9816: }
1.443 albertel 9817: $result = $expire_role_result;
9818: }
9819: }
9820: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 9821: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 9822: if ($modify_section_result =~ /^ok/) {
9823: if ($secchange == 1) {
1.628 raeburn 9824: if ($sec eq '') {
9825: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
9826: } else {
9827: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
9828: }
1.443 albertel 9829: } elsif ($oldsec eq '-1') {
1.628 raeburn 9830: if ($sec eq '') {
9831: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
9832: } else {
9833: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9834: }
1.443 albertel 9835: } else {
1.628 raeburn 9836: if ($sec eq '') {
9837: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
9838: } else {
9839: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
9840: }
1.443 albertel 9841: }
9842: } else {
1.628 raeburn 9843: if ($secchange) {
9844: $$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;
9845: } else {
9846: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
9847: }
1.443 albertel 9848: }
9849: $result = $modify_section_result;
9850: } elsif ($secchange == 1) {
1.628 raeburn 9851: if ($oldsec eq '') {
9852: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
9853: } else {
9854: $$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;
9855: }
1.626 raeburn 9856: if ($expire_role_result eq 'refused') {
9857: my $newsecurl = '/'.$cid;
9858: $newsecurl =~ s/\_/\//g;
9859: if ($sec ne '') {
9860: $newsecurl.='/'.$sec;
9861: }
9862: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
9863: if ($sec eq '') {
9864: $$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;
9865: } else {
9866: $$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;
9867: }
9868: }
9869: }
1.443 albertel 9870: }
9871: } else {
1.626 raeburn 9872: $$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 9873: $result = "error: incomplete course id\n";
9874: }
9875: return $result;
9876: }
9877:
9878: ############################################################
9879: ############################################################
9880:
1.566 albertel 9881: sub check_clone {
1.578 raeburn 9882: my ($args,$linefeed) = @_;
1.566 albertel 9883: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
9884: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
9885: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
9886: my $clonemsg;
9887: my $can_clone = 0;
9888:
9889: if ($clonehome eq 'no_host') {
1.578 raeburn 9890: $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
1.566 albertel 9891: } else {
9892: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.882 raeburn 9893: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
9894: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 9895: $can_clone = 1;
9896: } else {
9897: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
9898: $args->{'clonedomain'},$args->{'clonecourse'});
9899: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 9900: if (grep(/^\*$/,@cloners)) {
9901: $can_clone = 1;
9902: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
9903: $can_clone = 1;
9904: } else {
9905: my %roleshash =
9906: &Apache::lonnet::get_my_roles($args->{'ccuname'},
9907: $args->{'ccdomain'},
9908: 'userroles',['active'],['cc'],
9909: [$args->{'clonedomain'}]);
9910: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
9911: $can_clone = 1;
9912: } else {
9913: $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'});
9914: }
1.566 albertel 9915: }
1.578 raeburn 9916: }
1.566 albertel 9917: }
9918: return ($can_clone, $clonemsg, $cloneid, $clonehome);
9919: }
9920:
1.444 albertel 9921: sub construct_course {
1.885 raeburn 9922: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 9923: my $outcome;
1.541 raeburn 9924: my $linefeed = '<br />'."\n";
9925: if ($context eq 'auto') {
9926: $linefeed = "\n";
9927: }
1.566 albertel 9928:
9929: #
9930: # Are we cloning?
9931: #
9932: my ($can_clone, $clonemsg, $cloneid, $clonehome);
9933: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 9934: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 9935: if ($context ne 'auto') {
1.578 raeburn 9936: if ($clonemsg ne '') {
9937: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
9938: }
1.566 albertel 9939: }
9940: $outcome .= $clonemsg.$linefeed;
9941:
9942: if (!$can_clone) {
9943: return (0,$outcome);
9944: }
9945: }
9946:
1.444 albertel 9947: #
9948: # Open course
9949: #
9950: my $crstype = lc($args->{'crstype'});
9951: my %cenv=();
9952: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
9953: $args->{'cdescr'},
9954: $args->{'curl'},
9955: $args->{'course_home'},
9956: $args->{'nonstandard'},
9957: $args->{'crscode'},
9958: $args->{'ccuname'}.':'.
9959: $args->{'ccdomain'},
1.882 raeburn 9960: $args->{'crstype'},
1.885 raeburn 9961: $cnum,$context,$category);
1.444 albertel 9962:
9963: # Note: The testing routines depend on this being output; see
9964: # Utils::Course. This needs to at least be output as a comment
9965: # if anyone ever decides to not show this, and Utils::Course::new
9966: # will need to be suitably modified.
1.541 raeburn 9967: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 9968: #
9969: # Check if created correctly
9970: #
1.479 albertel 9971: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 9972: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 9973: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 9974:
1.444 albertel 9975: #
1.566 albertel 9976: # Do the cloning
9977: #
9978: if ($can_clone && $cloneid) {
9979: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
9980: if ($context ne 'auto') {
9981: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
9982: }
9983: $outcome .= $clonemsg.$linefeed;
9984: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 9985: # Copy all files
1.637 www 9986: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 9987: # Restore URL
1.566 albertel 9988: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 9989: # Restore title
1.566 albertel 9990: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 9991: # Mark as cloned
1.566 albertel 9992: $cenv{'clonedfrom'}=$cloneid;
1.638 www 9993: # Need to clone grading mode
9994: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
9995: $cenv{'grading'}=$newenv{'grading'};
9996: # Do not clone these environment entries
9997: &Apache::lonnet::del('environment',
9998: ['default_enrollment_start_date',
9999: 'default_enrollment_end_date',
10000: 'question.email',
10001: 'policy.email',
10002: 'comment.email',
10003: 'pch.users.denied',
1.725 raeburn 10004: 'plc.users.denied',
10005: 'hidefromcat',
10006: 'categories'],
1.638 www 10007: $$crsudom,$$crsunum);
1.444 albertel 10008: }
1.566 albertel 10009:
1.444 albertel 10010: #
10011: # Set environment (will override cloned, if existing)
10012: #
10013: my @sections = ();
10014: my @xlists = ();
10015: if ($args->{'crstype'}) {
10016: $cenv{'type'}=$args->{'crstype'};
10017: }
10018: if ($args->{'crsid'}) {
10019: $cenv{'courseid'}=$args->{'crsid'};
10020: }
10021: if ($args->{'crscode'}) {
10022: $cenv{'internal.coursecode'}=$args->{'crscode'};
10023: }
10024: if ($args->{'crsquota'} ne '') {
10025: $cenv{'internal.coursequota'}=$args->{'crsquota'};
10026: } else {
10027: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
10028: }
10029: if ($args->{'ccuname'}) {
10030: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
10031: ':'.$args->{'ccdomain'};
10032: } else {
10033: $cenv{'internal.courseowner'} = $args->{'curruser'};
10034: }
10035: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
10036: if ($args->{'crssections'}) {
10037: $cenv{'internal.sectionnums'} = '';
10038: if ($args->{'crssections'} =~ m/,/) {
10039: @sections = split/,/,$args->{'crssections'};
10040: } else {
10041: $sections[0] = $args->{'crssections'};
10042: }
10043: if (@sections > 0) {
10044: foreach my $item (@sections) {
10045: my ($sec,$gp) = split/:/,$item;
10046: my $class = $args->{'crscode'}.$sec;
10047: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
10048: $cenv{'internal.sectionnums'} .= $item.',';
10049: unless ($addcheck eq 'ok') {
10050: push @badclasses, $class;
10051: }
10052: }
10053: $cenv{'internal.sectionnums'} =~ s/,$//;
10054: }
10055: }
10056: # do not hide course coordinator from staff listing,
10057: # even if privileged
10058: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10059: # add crosslistings
10060: if ($args->{'crsxlist'}) {
10061: $cenv{'internal.crosslistings'}='';
10062: if ($args->{'crsxlist'} =~ m/,/) {
10063: @xlists = split/,/,$args->{'crsxlist'};
10064: } else {
10065: $xlists[0] = $args->{'crsxlist'};
10066: }
10067: if (@xlists > 0) {
10068: foreach my $item (@xlists) {
10069: my ($xl,$gp) = split/:/,$item;
10070: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
10071: $cenv{'internal.crosslistings'} .= $item.',';
10072: unless ($addcheck eq 'ok') {
10073: push @badclasses, $xl;
10074: }
10075: }
10076: $cenv{'internal.crosslistings'} =~ s/,$//;
10077: }
10078: }
10079: if ($args->{'autoadds'}) {
10080: $cenv{'internal.autoadds'}=$args->{'autoadds'};
10081: }
10082: if ($args->{'autodrops'}) {
10083: $cenv{'internal.autodrops'}=$args->{'autodrops'};
10084: }
10085: # check for notification of enrollment changes
10086: my @notified = ();
10087: if ($args->{'notify_owner'}) {
10088: if ($args->{'ccuname'} ne '') {
10089: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
10090: }
10091: }
10092: if ($args->{'notify_dc'}) {
10093: if ($uname ne '') {
1.630 raeburn 10094: push(@notified,$uname.':'.$udom);
1.444 albertel 10095: }
10096: }
10097: if (@notified > 0) {
10098: my $notifylist;
10099: if (@notified > 1) {
10100: $notifylist = join(',',@notified);
10101: } else {
10102: $notifylist = $notified[0];
10103: }
10104: $cenv{'internal.notifylist'} = $notifylist;
10105: }
10106: if (@badclasses > 0) {
10107: my %lt=&Apache::lonlocal::texthash(
10108: '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',
10109: 'dnhr' => 'does not have rights to access enrollment in these classes',
10110: 'adby' => 'as determined by the policies of your institution on access to official classlists'
10111: );
1.541 raeburn 10112: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
10113: ' ('.$lt{'adby'}.')';
10114: if ($context eq 'auto') {
10115: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 10116: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 10117: foreach my $item (@badclasses) {
10118: if ($context eq 'auto') {
10119: $outcome .= " - $item\n";
10120: } else {
10121: $outcome .= "<li>$item</li>\n";
10122: }
10123: }
10124: if ($context eq 'auto') {
10125: $outcome .= $linefeed;
10126: } else {
1.566 albertel 10127: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 10128: }
10129: }
1.444 albertel 10130: }
10131: if ($args->{'no_end_date'}) {
10132: $args->{'endaccess'} = 0;
10133: }
10134: $cenv{'internal.autostart'}=$args->{'enrollstart'};
10135: $cenv{'internal.autoend'}=$args->{'enrollend'};
10136: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
10137: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
10138: if ($args->{'showphotos'}) {
10139: $cenv{'internal.showphotos'}=$args->{'showphotos'};
10140: }
10141: $cenv{'internal.authtype'} = $args->{'authtype'};
10142: $cenv{'internal.autharg'} = $args->{'autharg'};
10143: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
10144: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 10145: 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');
10146: if ($context eq 'auto') {
10147: $outcome .= $krb_msg;
10148: } else {
1.566 albertel 10149: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 10150: }
10151: $outcome .= $linefeed;
1.444 albertel 10152: }
10153: }
10154: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
10155: if ($args->{'setpolicy'}) {
10156: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10157: }
10158: if ($args->{'setcontent'}) {
10159: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10160: }
10161: }
10162: if ($args->{'reshome'}) {
10163: $cenv{'reshome'}=$args->{'reshome'}.'/';
10164: $cenv{'reshome'}=~s/\/+$/\//;
10165: }
10166: #
10167: # course has keyed access
10168: #
10169: if ($args->{'setkeys'}) {
10170: $cenv{'keyaccess'}='yes';
10171: }
10172: # if specified, key authority is not course, but user
10173: # only active if keyaccess is yes
10174: if ($args->{'keyauth'}) {
1.487 albertel 10175: my ($user,$domain) = split(':',$args->{'keyauth'});
10176: $user = &LONCAPA::clean_username($user);
10177: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 10178: if ($user ne '' && $domain ne '') {
1.487 albertel 10179: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 10180: }
10181: }
10182:
10183: if ($args->{'disresdis'}) {
10184: $cenv{'pch.roles.denied'}='st';
10185: }
10186: if ($args->{'disablechat'}) {
10187: $cenv{'plc.roles.denied'}='st';
10188: }
10189:
10190: # Record we've not yet viewed the Course Initialization Helper for this
10191: # course
10192: $cenv{'course.helper.not.run'} = 1;
10193: #
10194: # Use new Randomseed
10195: #
10196: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
10197: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
10198: #
10199: # The encryption code and receipt prefix for this course
10200: #
10201: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
10202: $cenv{'internal.encpref'}=100+int(9*rand(99));
10203: #
10204: # By default, use standard grading
10205: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
10206:
1.541 raeburn 10207: $outcome .= $linefeed.&mt('Setting environment').': '.
10208: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 10209: #
10210: # Open all assignments
10211: #
10212: if ($args->{'openall'}) {
10213: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
10214: my %storecontent = ($storeunder => time,
10215: $storeunder.'.type' => 'date_start');
10216:
10217: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 10218: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 10219: }
10220: #
10221: # Set first page
10222: #
10223: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
10224: || ($cloneid)) {
1.445 albertel 10225: use LONCAPA::map;
1.444 albertel 10226: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 10227:
10228: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
10229: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
10230:
1.444 albertel 10231: $outcome .= ($fatal?$errtext:'read ok').' - ';
10232: my $title; my $url;
10233: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 10234: $title=&mt('Syllabus');
1.444 albertel 10235: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
10236: } else {
1.690 bisitz 10237: $title=&mt('Navigate Contents');
1.444 albertel 10238: $url='/adm/navmaps';
10239: }
1.445 albertel 10240:
10241: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
10242: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
10243:
10244: if ($errtext) { $fatal=2; }
1.541 raeburn 10245: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 10246: }
1.566 albertel 10247:
10248: return (1,$outcome);
1.444 albertel 10249: }
10250:
10251: ############################################################
10252: ############################################################
10253:
1.378 raeburn 10254: sub course_type {
10255: my ($cid) = @_;
10256: if (!defined($cid)) {
10257: $cid = $env{'request.course.id'};
10258: }
1.404 albertel 10259: if (defined($env{'course.'.$cid.'.type'})) {
10260: return $env{'course.'.$cid.'.type'};
1.378 raeburn 10261: } else {
10262: return 'Course';
1.377 raeburn 10263: }
10264: }
1.156 albertel 10265:
1.406 raeburn 10266: sub group_term {
10267: my $crstype = &course_type();
10268: my %names = (
10269: 'Course' => 'group',
1.865 raeburn 10270: 'Community' => 'group',
1.406 raeburn 10271: );
10272: return $names{$crstype};
10273: }
10274:
1.156 albertel 10275: sub icon {
10276: my ($file)=@_;
1.505 albertel 10277: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 10278: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 10279: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 10280: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
10281: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
10282: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
10283: $curfext.".gif") {
10284: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
10285: $curfext.".gif";
10286: }
10287: }
1.249 albertel 10288: return &lonhttpdurl($iconname);
1.154 albertel 10289: }
1.84 albertel 10290:
1.575 albertel 10291: sub lonhttpdurl {
1.692 www 10292: #
10293: # Had been used for "small fry" static images on separate port 8080.
10294: # Modify here if lightweight http functionality desired again.
10295: # Currently eliminated due to increasing firewall issues.
10296: #
1.575 albertel 10297: my ($url)=@_;
1.692 www 10298: return $url;
1.215 albertel 10299: }
10300:
1.213 albertel 10301: sub connection_aborted {
10302: my ($r)=@_;
10303: $r->print(" ");$r->rflush();
10304: my $c = $r->connection;
10305: return $c->aborted();
10306: }
10307:
1.221 foxr 10308: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 10309: # strings as 'strings'.
10310: sub escape_single {
1.221 foxr 10311: my ($input) = @_;
1.223 albertel 10312: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 10313: $input =~ s/\'/\\\'/g; # Esacpe the 's....
10314: return $input;
10315: }
1.223 albertel 10316:
1.222 foxr 10317: # Same as escape_single, but escape's "'s This
10318: # can be used for "strings"
10319: sub escape_double {
10320: my ($input) = @_;
10321: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
10322: $input =~ s/\"/\\\"/g; # Esacpe the "s....
10323: return $input;
10324: }
1.223 albertel 10325:
1.222 foxr 10326: # Escapes the last element of a full URL.
10327: sub escape_url {
10328: my ($url) = @_;
1.238 raeburn 10329: my @urlslices = split(/\//, $url,-1);
1.369 www 10330: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 10331: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 10332: }
1.462 albertel 10333:
1.820 raeburn 10334: sub compare_arrays {
10335: my ($arrayref1,$arrayref2) = @_;
10336: my (@difference,%count);
10337: @difference = ();
10338: %count = ();
10339: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
10340: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
10341: foreach my $element (keys(%count)) {
10342: if ($count{$element} == 1) {
10343: push(@difference,$element);
10344: }
10345: }
10346: }
10347: return @difference;
10348: }
10349:
1.817 bisitz 10350: # -------------------------------------------------------- Initialize user login
1.462 albertel 10351: sub init_user_environment {
1.463 albertel 10352: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 10353: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
10354:
10355: my $public=($username eq 'public' && $domain eq 'public');
10356:
10357: # See if old ID present, if so, remove
10358:
10359: my ($filename,$cookie,$userroles);
10360: my $now=time;
10361:
10362: if ($public) {
10363: my $max_public=100;
10364: my $oldest;
10365: my $oldest_time=0;
10366: for(my $next=1;$next<=$max_public;$next++) {
10367: if (-e $lonids."/publicuser_$next.id") {
10368: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
10369: if ($mtime<$oldest_time || !$oldest_time) {
10370: $oldest_time=$mtime;
10371: $oldest=$next;
10372: }
10373: } else {
10374: $cookie="publicuser_$next";
10375: last;
10376: }
10377: }
10378: if (!$cookie) { $cookie="publicuser_$oldest"; }
10379: } else {
1.463 albertel 10380: # if this isn't a robot, kill any existing non-robot sessions
10381: if (!$args->{'robot'}) {
10382: opendir(DIR,$lonids);
10383: while ($filename=readdir(DIR)) {
10384: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
10385: unlink($lonids.'/'.$filename);
10386: }
1.462 albertel 10387: }
1.463 albertel 10388: closedir(DIR);
1.462 albertel 10389: }
10390: # Give them a new cookie
1.463 albertel 10391: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 10392: : $now.$$.int(rand(10000)));
1.463 albertel 10393: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 10394:
10395: # Initialize roles
10396:
10397: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
10398: }
10399: # ------------------------------------ Check browser type and MathML capability
10400:
10401: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
10402: $clientunicode,$clientos) = &decode_user_agent($r);
10403:
10404: # ------------------------------------------------------------- Get environment
10405:
10406: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
10407: my ($tmp) = keys(%userenv);
10408: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10409: # default remote control to off
10410: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
10411: } else {
10412: undef(%userenv);
10413: }
10414: if (($userenv{'interface'}) && (!$form->{'interface'})) {
10415: $form->{'interface'}=$userenv{'interface'};
10416: }
10417: $env{'environment.remote'}=$userenv{'remote'};
10418: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
10419:
10420: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 10421: foreach my $option ('interface','localpath','localres') {
10422: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 10423: }
10424: # --------------------------------------------------------- Write first profile
10425:
10426: {
10427: my %initial_env =
10428: ("user.name" => $username,
10429: "user.domain" => $domain,
10430: "user.home" => $authhost,
10431: "browser.type" => $clientbrowser,
10432: "browser.version" => $clientversion,
10433: "browser.mathml" => $clientmathml,
10434: "browser.unicode" => $clientunicode,
10435: "browser.os" => $clientos,
10436: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
10437: "request.course.fn" => '',
10438: "request.course.uri" => '',
10439: "request.course.sec" => '',
10440: "request.role" => 'cm',
10441: "request.role.adv" => $env{'user.adv'},
10442: "request.host" => $ENV{'REMOTE_ADDR'},);
10443:
10444: if ($form->{'localpath'}) {
10445: $initial_env{"browser.localpath"} = $form->{'localpath'};
10446: $initial_env{"browser.localres"} = $form->{'localres'};
10447: }
10448:
10449: if ($public) {
10450: $initial_env{"environment.remote"} = "off";
10451: }
10452: if ($form->{'interface'}) {
10453: $form->{'interface'}=~s/\W//gs;
10454: $initial_env{"browser.interface"} = $form->{'interface'};
10455: $env{'browser.interface'}=$form->{'interface'};
10456: }
10457:
1.724 raeburn 10458: foreach my $tool ('aboutme','blog','portfolio') {
10459: $userenv{'availabletools.'.$tool} =
10460: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
10461: }
10462:
1.864 raeburn 10463: foreach my $crstype ('official','unofficial','community') {
1.765 raeburn 10464: $userenv{'canrequest.'.$crstype} =
10465: &Apache::lonnet::usertools_access($username,$domain,$crstype,
10466: 'reload','requestcourses');
10467: }
10468:
1.462 albertel 10469: $env{'user.environment'} = "$lonids/$cookie.id";
10470:
10471: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
10472: &GDBM_WRCREAT(),0640)) {
10473: &_add_to_env(\%disk_env,\%initial_env);
10474: &_add_to_env(\%disk_env,\%userenv,'environment.');
10475: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 10476: if (ref($args->{'extra_env'})) {
10477: &_add_to_env(\%disk_env,$args->{'extra_env'});
10478: }
1.462 albertel 10479: untie(%disk_env);
10480: } else {
1.705 tempelho 10481: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
10482: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 10483: return 'error: '.$!;
10484: }
10485: }
10486: $env{'request.role'}='cm';
10487: $env{'request.role.adv'}=$env{'user.adv'};
10488: $env{'browser.type'}=$clientbrowser;
10489:
10490: return $cookie;
10491:
10492: }
10493:
10494: sub _add_to_env {
10495: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 10496: if (ref($env_data) eq 'HASH') {
10497: while (my ($key,$value) = each(%$env_data)) {
10498: $idf->{$prefix.$key} = $value;
10499: $env{$prefix.$key} = $value;
10500: }
1.462 albertel 10501: }
10502: }
10503:
1.685 tempelho 10504: # --- Get the symbolic name of a problem and the url
10505: sub get_symb {
10506: my ($request,$silent) = @_;
1.726 raeburn 10507: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 10508: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
10509: if ($symb eq '') {
10510: if (!$silent) {
10511: $request->print("Unable to handle ambiguous references:$url:.");
10512: return ();
10513: }
10514: }
10515: &Apache::lonenc::check_decrypt(\$symb);
10516: return ($symb);
10517: }
10518:
10519: # --------------------------------------------------------------Get annotation
10520:
10521: sub get_annotation {
10522: my ($symb,$enc) = @_;
10523:
10524: my $key = $symb;
10525: if (!$enc) {
10526: $key =
10527: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
10528: }
10529: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
10530: return $annotation{$key};
10531: }
10532:
10533: sub clean_symb {
1.731 raeburn 10534: my ($symb,$delete_enc) = @_;
1.685 tempelho 10535:
10536: &Apache::lonenc::check_decrypt(\$symb);
10537: my $enc = $env{'request.enc'};
1.731 raeburn 10538: if ($delete_enc) {
1.730 raeburn 10539: delete($env{'request.enc'});
10540: }
1.685 tempelho 10541:
10542: return ($symb,$enc);
10543: }
1.462 albertel 10544:
1.41 ng 10545: =pod
10546:
10547: =back
10548:
1.112 bowersj2 10549: =cut
1.41 ng 10550:
1.112 bowersj2 10551: 1;
10552: __END__;
1.41 ng 10553:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>