Annotation of loncom/interface/loncommon.pm, revision 1.925.2.18
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.925.2.18! raeburn 4: # $Id: loncommon.pm,v 1.925.2.17 2010/11/09 00:08:06 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.909 raeburn 485: my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
486: my $wintitle = &mt('Course Browser');
487: if ($crstype ne '') {
488: $wintitle = &mt($crstype);
489: }
1.876 raeburn 490: my $id_functions = &javascript_index_functions();
491: my $output = '
1.776 bisitz 492: <script type="text/javascript" language="JavaScript">
1.824 bisitz 493: // <![CDATA[
1.468 raeburn 494: var stdeditbrowser;'."\n";
1.876 raeburn 495:
496: $output .= <<"ENDSTDBRW";
1.909 raeburn 497: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 498: var url = '/adm/pickcourse?';
1.895 raeburn 499: var formid = getFormIdByName(formname);
1.876 raeburn 500: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 501: if (domainfilter != null) {
502: if (domainfilter != '') {
503: url += 'domainfilter='+domainfilter+'&';
504: }
505: }
1.91 www 506: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 507: '&cdomelement='+udom+
508: '&cnameelement='+desc;
1.468 raeburn 509: if (extra_element !=null && extra_element != '') {
1.594 raeburn 510: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 511: url += '&roleelement='+extra_element;
512: if (domainfilter == null || domainfilter == '') {
513: url += '&domainfilter='+extra_element;
514: }
1.234 raeburn 515: }
1.468 raeburn 516: else {
517: if (formname == 'portform') {
518: url += '&setroles='+extra_element;
1.800 raeburn 519: } else {
520: if (formname == 'rules') {
521: url += '&fixeddom='+extra_element;
522: }
1.468 raeburn 523: }
524: }
1.230 raeburn 525: }
1.909 raeburn 526: if (type != null && type != '') {
527: url += '&type='+type;
528: }
529: if (type_elem != null && type_elem != '') {
530: url += '&typeelement='+type_elem;
531: }
1.872 raeburn 532: if (formname == 'ccrs') {
533: var ownername = document.forms[formid].ccuname.value;
534: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
535: url += '&cloner='+ownername+':'+ownerdom;
536: }
1.293 raeburn 537: if (multflag !=null && multflag != '') {
538: url += '&multiple='+multflag;
539: }
1.909 raeburn 540: var title = '$wintitle';
1.91 www 541: var options = 'scrollbars=1,resizable=1,menubar=0';
542: options += ',width=700,height=600';
543: stdeditbrowser = open(url,title,options,'1');
544: stdeditbrowser.focus();
545: }
1.876 raeburn 546: $id_functions
547: ENDSTDBRW
1.905 raeburn 548: if (($sec_element ne '') || ($role_element ne '')) {
549: $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876 raeburn 550: }
551: $output .= '
552: // ]]>
553: </script>';
554: return $output;
555: }
556:
557: sub javascript_index_functions {
558: return <<"ENDJS";
559:
560: function getFormIdByName(formname) {
561: for (var i=0;i<document.forms.length;i++) {
562: if (document.forms[i].name == formname) {
563: return i;
564: }
565: }
566: return -1;
567: }
568:
569: function getIndexByName(formid,item) {
570: for (var i=0;i<document.forms[formid].elements.length;i++) {
571: if (document.forms[formid].elements[i].name == item) {
572: return i;
573: }
574: }
575: return -1;
576: }
1.468 raeburn 577:
1.876 raeburn 578: function getDomainFromSelectbox(formname,udom) {
579: var userdom;
580: var formid = getFormIdByName(formname);
581: if (formid > -1) {
582: var domid = getIndexByName(formid,udom);
583: if (domid > -1) {
584: if (document.forms[formid].elements[domid].type == 'select-one') {
585: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
586: }
587: if (document.forms[formid].elements[domid].type == 'hidden') {
588: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 589: }
590: }
591: }
1.876 raeburn 592: return userdom;
593: }
594:
595: ENDJS
1.468 raeburn 596:
1.876 raeburn 597: }
598:
599: sub userbrowser_javascript {
600: my $id_functions = &javascript_index_functions();
601: return <<"ENDUSERBRW";
602:
1.888 raeburn 603: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 604: var url = '/adm/pickuser?';
605: var userdom = getDomainFromSelectbox(formname,udom);
606: if (userdom != null) {
607: if (userdom != '') {
608: url += 'srchdom='+userdom+'&';
609: }
610: }
611: url += 'form=' + formname + '&unameelement='+uname+
612: '&udomelement='+udom+
613: '&ulastelement='+ulast+
614: '&ufirstelement='+ufirst+
615: '&uemailelement='+uemail+
1.881 raeburn 616: '&hideudomelement='+hideudom+
617: '&coursedom='+crsdom;
1.888 raeburn 618: if ((caller != null) && (caller != undefined)) {
619: url += '&caller='+caller;
620: }
1.876 raeburn 621: var title = 'User_Browser';
622: var options = 'scrollbars=1,resizable=1,menubar=0';
623: options += ',width=700,height=600';
624: var stdeditbrowser = open(url,title,options,'1');
625: stdeditbrowser.focus();
626: }
627:
1.888 raeburn 628: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 629: var formid = getFormIdByName(formname);
630: if (formid > -1) {
1.888 raeburn 631: var unameid = getIndexByName(formid,uname);
1.876 raeburn 632: var domid = getIndexByName(formid,udom);
633: var hidedomid = getIndexByName(formid,origdom);
634: if (hidedomid > -1) {
635: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 636: var unameval = document.forms[formid].elements[unameid].value;
637: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
638: if (domid > -1) {
639: var slct = document.forms[formid].elements[domid];
640: if (slct.type == 'select-one') {
641: var i;
642: for (i=0;i<slct.length;i++) {
643: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
644: }
645: }
646: if (slct.type == 'hidden') {
647: slct.value = fixeddom;
1.876 raeburn 648: }
649: }
1.468 raeburn 650: }
651: }
652: }
1.876 raeburn 653: return;
654: }
655:
656: $id_functions
657: ENDUSERBRW
1.468 raeburn 658: }
659:
660: sub setsec_javascript {
1.905 raeburn 661: my ($sec_element,$formname,$role_element) = @_;
662: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
663: $communityrolestr);
664: if ($role_element ne '') {
665: my @allroles = ('st','ta','ep','in','ad');
666: foreach my $crstype ('Course','Community') {
667: if ($crstype eq 'Community') {
668: foreach my $role (@allroles) {
669: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
670: }
671: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
672: } else {
673: foreach my $role (@allroles) {
674: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
675: }
676: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
677: }
678: }
679: $rolestr = '"'.join('","',@allroles).'"';
680: $courserolestr = '"'.join('","',@courserolenames).'"';
681: $communityrolestr = '"'.join('","',@communityrolenames).'"';
682: }
1.468 raeburn 683: my $setsections = qq|
684: function setSect(sectionlist) {
1.629 raeburn 685: var sectionsArray = new Array();
686: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
687: sectionsArray = sectionlist.split(",");
688: }
1.468 raeburn 689: var numSections = sectionsArray.length;
690: document.$formname.$sec_element.length = 0;
691: if (numSections == 0) {
692: document.$formname.$sec_element.multiple=false;
693: document.$formname.$sec_element.size=1;
694: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
695: } else {
696: if (numSections == 1) {
697: document.$formname.$sec_element.multiple=false;
698: document.$formname.$sec_element.size=1;
699: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
700: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
701: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
702: } else {
703: for (var i=0; i<numSections; i++) {
704: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
705: }
706: document.$formname.$sec_element.multiple=true
707: if (numSections < 3) {
708: document.$formname.$sec_element.size=numSections;
709: } else {
710: document.$formname.$sec_element.size=3;
711: }
712: document.$formname.$sec_element.options[0].selected = false
713: }
714: }
1.91 www 715: }
1.905 raeburn 716:
717: function setRole(crstype) {
1.468 raeburn 718: |;
1.905 raeburn 719: if ($role_element eq '') {
720: $setsections .= ' return;
721: }
722: ';
723: } else {
724: $setsections .= qq|
725: var elementLength = document.$formname.$role_element.length;
726: var allroles = Array($rolestr);
727: var courserolenames = Array($courserolestr);
728: var communityrolenames = Array($communityrolestr);
729: if (elementLength != undefined) {
730: if (document.$formname.$role_element.options[5].value == 'cc') {
731: if (crstype == 'Course') {
732: return;
733: } else {
734: allroles[5] = 'co';
735: for (var i=0; i<6; i++) {
736: document.$formname.$role_element.options[i].value = allroles[i];
737: document.$formname.$role_element.options[i].text = communityrolenames[i];
738: }
739: }
740: } else {
741: if (crstype == 'Community') {
742: return;
743: } else {
744: allroles[5] = 'cc';
745: for (var i=0; i<6; i++) {
746: document.$formname.$role_element.options[i].value = allroles[i];
747: document.$formname.$role_element.options[i].text = courserolenames[i];
748: }
749: }
750: }
751: }
752: return;
753: }
754: |;
755: }
1.468 raeburn 756: return $setsections;
757: }
758:
1.91 www 759: sub selectcourse_link {
1.909 raeburn 760: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
761: $typeelement) = @_;
762: my $type = $selecttype;
1.871 raeburn 763: my $linktext = &mt('Select Course');
764: if ($selecttype eq 'Community') {
1.909 raeburn 765: $linktext = &mt('Select Community');
1.906 raeburn 766: } elsif ($selecttype eq 'Course/Community') {
767: $linktext = &mt('Select Course/Community');
1.909 raeburn 768: $type = '';
1.871 raeburn 769: }
1.787 bisitz 770: return '<span class="LC_nobreak">'
771: ."<a href='"
772: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
773: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 774: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 775: ."'>".$linktext.'</a>'
1.787 bisitz 776: .'</span>';
1.74 www 777: }
1.42 matthew 778:
1.653 raeburn 779: sub selectauthor_link {
780: my ($form,$udom)=@_;
781: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
782: &mt('Select Author').'</a>';
783: }
784:
1.876 raeburn 785: sub selectuser_link {
1.881 raeburn 786: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 787: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 788: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 789: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 790: ');">'.$linktext.'</a>';
1.876 raeburn 791: }
792:
1.273 raeburn 793: sub check_uncheck_jscript {
794: my $jscript = <<"ENDSCRT";
795: function checkAll(field) {
796: if (field.length > 0) {
797: for (i = 0; i < field.length; i++) {
798: field[i].checked = true ;
799: }
800: } else {
801: field.checked = true
802: }
803: }
804:
805: function uncheckAll(field) {
806: if (field.length > 0) {
807: for (i = 0; i < field.length; i++) {
808: field[i].checked = false ;
1.543 albertel 809: }
810: } else {
1.273 raeburn 811: field.checked = false ;
812: }
813: }
814: ENDSCRT
815: return $jscript;
816: }
817:
1.656 www 818: sub select_timezone {
1.659 raeburn 819: my ($name,$selected,$onchange,$includeempty)=@_;
820: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
821: if ($includeempty) {
822: $output .= '<option value=""';
823: if (($selected eq '') || ($selected eq 'local')) {
824: $output .= ' selected="selected" ';
825: }
826: $output .= '> </option>';
827: }
1.657 raeburn 828: my @timezones = DateTime::TimeZone->all_names;
829: foreach my $tzone (@timezones) {
830: $output.= '<option value="'.$tzone.'"';
831: if ($tzone eq $selected) {
832: $output.=' selected="selected"';
833: }
834: $output.=">$tzone</option>\n";
1.656 www 835: }
836: $output.="</select>";
837: return $output;
838: }
1.273 raeburn 839:
1.687 raeburn 840: sub select_datelocale {
841: my ($name,$selected,$onchange,$includeempty)=@_;
842: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
843: if ($includeempty) {
844: $output .= '<option value=""';
845: if ($selected eq '') {
846: $output .= ' selected="selected" ';
847: }
848: $output .= '> </option>';
849: }
850: my (@possibles,%locale_names);
851: my @locales = DateTime::Locale::Catalog::Locales;
852: foreach my $locale (@locales) {
853: if (ref($locale) eq 'HASH') {
854: my $id = $locale->{'id'};
855: if ($id ne '') {
856: my $en_terr = $locale->{'en_territory'};
857: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 858: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 859: if (grep(/^en$/,@languages) || !@languages) {
860: if ($en_terr ne '') {
861: $locale_names{$id} = '('.$en_terr.')';
862: } elsif ($native_terr ne '') {
863: $locale_names{$id} = $native_terr;
864: }
865: } else {
866: if ($native_terr ne '') {
867: $locale_names{$id} = $native_terr.' ';
868: } elsif ($en_terr ne '') {
869: $locale_names{$id} = '('.$en_terr.')';
870: }
871: }
872: push (@possibles,$id);
873: }
874: }
875: }
876: foreach my $item (sort(@possibles)) {
877: $output.= '<option value="'.$item.'"';
878: if ($item eq $selected) {
879: $output.=' selected="selected"';
880: }
881: $output.=">$item";
882: if ($locale_names{$item} ne '') {
883: $output.=" $locale_names{$item}</option>\n";
884: }
885: $output.="</option>\n";
886: }
887: $output.="</select>";
888: return $output;
889: }
890:
1.792 raeburn 891: sub select_language {
892: my ($name,$selected,$includeempty) = @_;
893: my %langchoices;
894: if ($includeempty) {
895: %langchoices = ('' => 'No language preference');
896: }
897: foreach my $id (&languageids()) {
898: my $code = &supportedlanguagecode($id);
899: if ($code) {
900: $langchoices{$code} = &plainlanguagedescription($id);
901: }
902: }
903: return &select_form($selected,$name,%langchoices);
904: }
905:
1.42 matthew 906: =pod
1.36 matthew 907:
1.648 raeburn 908: =item * &linked_select_forms(...)
1.36 matthew 909:
910: linked_select_forms returns a string containing a <script></script> block
911: and html for two <select> menus. The select menus will be linked in that
912: changing the value of the first menu will result in new values being placed
913: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 914: order unless a defined order is provided.
1.36 matthew 915:
916: linked_select_forms takes the following ordered inputs:
917:
918: =over 4
919:
1.112 bowersj2 920: =item * $formname, the name of the <form> tag
1.36 matthew 921:
1.112 bowersj2 922: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 923:
1.112 bowersj2 924: =item * $firstdefault, the default value for the first menu
1.36 matthew 925:
1.112 bowersj2 926: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 927:
1.112 bowersj2 928: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 929:
1.112 bowersj2 930: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 931:
1.609 raeburn 932: =item * $menuorder, the order of values in the first menu
933:
1.41 ng 934: =back
935:
1.36 matthew 936: Below is an example of such a hash. Only the 'text', 'default', and
937: 'select2' keys must appear as stated. keys(%menu) are the possible
938: values for the first select menu. The text that coincides with the
1.41 ng 939: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 940: and text for the second menu are given in the hash pointed to by
941: $menu{$choice1}->{'select2'}.
942:
1.112 bowersj2 943: my %menu = ( A1 => { text =>"Choice A1" ,
944: default => "B3",
945: select2 => {
946: B1 => "Choice B1",
947: B2 => "Choice B2",
948: B3 => "Choice B3",
949: B4 => "Choice B4"
1.609 raeburn 950: },
951: order => ['B4','B3','B1','B2'],
1.112 bowersj2 952: },
953: A2 => { text =>"Choice A2" ,
954: default => "C2",
955: select2 => {
956: C1 => "Choice C1",
957: C2 => "Choice C2",
958: C3 => "Choice C3"
1.609 raeburn 959: },
960: order => ['C2','C1','C3'],
1.112 bowersj2 961: },
962: A3 => { text =>"Choice A3" ,
963: default => "D6",
964: select2 => {
965: D1 => "Choice D1",
966: D2 => "Choice D2",
967: D3 => "Choice D3",
968: D4 => "Choice D4",
969: D5 => "Choice D5",
970: D6 => "Choice D6",
971: D7 => "Choice D7"
1.609 raeburn 972: },
973: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 974: }
975: );
1.36 matthew 976:
977: =cut
978:
979: sub linked_select_forms {
980: my ($formname,
981: $middletext,
982: $firstdefault,
983: $firstselectname,
984: $secondselectname,
1.609 raeburn 985: $hashref,
986: $menuorder,
1.36 matthew 987: ) = @_;
988: my $second = "document.$formname.$secondselectname";
989: my $first = "document.$formname.$firstselectname";
990: # output the javascript to do the changing
991: my $result = '';
1.776 bisitz 992: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 993: $result.="// <![CDATA[\n";
1.36 matthew 994: $result.="var select2data = new Object();\n";
995: $" = '","';
996: my $debug = '';
997: foreach my $s1 (sort(keys(%$hashref))) {
998: $result.="select2data.d_$s1 = new Object();\n";
999: $result.="select2data.d_$s1.def = new String('".
1000: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1001: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1002: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1003: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1004: @s2values = @{$hashref->{$s1}->{'order'}};
1005: }
1.36 matthew 1006: $result.="\"@s2values\");\n";
1007: $result.="select2data.d_$s1.texts = new Array(";
1008: my @s2texts;
1009: foreach my $value (@s2values) {
1010: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1011: }
1012: $result.="\"@s2texts\");\n";
1013: }
1014: $"=' ';
1015: $result.= <<"END";
1016:
1017: function select1_changed() {
1018: // Determine new choice
1019: var newvalue = "d_" + $first.value;
1020: // update select2
1021: var values = select2data[newvalue].values;
1022: var texts = select2data[newvalue].texts;
1023: var select2def = select2data[newvalue].def;
1024: var i;
1025: // out with the old
1026: for (i = 0; i < $second.options.length; i++) {
1027: $second.options[i] = null;
1028: }
1029: // in with the nuclear
1030: for (i=0;i<values.length; i++) {
1031: $second.options[i] = new Option(values[i]);
1.143 matthew 1032: $second.options[i].value = values[i];
1.36 matthew 1033: $second.options[i].text = texts[i];
1034: if (values[i] == select2def) {
1035: $second.options[i].selected = true;
1036: }
1037: }
1038: }
1.824 bisitz 1039: // ]]>
1.36 matthew 1040: </script>
1041: END
1042: # output the initial values for the selection lists
1043: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609 raeburn 1044: my @order = sort(keys(%{$hashref}));
1045: if (ref($menuorder) eq 'ARRAY') {
1046: @order = @{$menuorder};
1047: }
1048: foreach my $value (@order) {
1.36 matthew 1049: $result.=" <option value=\"$value\" ";
1.253 albertel 1050: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1051: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1052: }
1053: $result .= "</select>\n";
1054: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1055: $result .= $middletext;
1056: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
1057: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1058:
1059: my @secondorder = sort(keys(%select2));
1060: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1061: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1062: }
1063: foreach my $value (@secondorder) {
1.36 matthew 1064: $result.=" <option value=\"$value\" ";
1.253 albertel 1065: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1066: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1067: }
1068: $result .= "</select>\n";
1069: # return $debug;
1070: return $result;
1071: } # end of sub linked_select_forms {
1072:
1.45 matthew 1073: =pod
1.44 bowersj2 1074:
1.648 raeburn 1075: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
1.44 bowersj2 1076:
1.112 bowersj2 1077: Returns a string corresponding to an HTML link to the given help
1078: $topic, where $topic corresponds to the name of a .tex file in
1079: /home/httpd/html/adm/help/tex, with underscores replaced by
1080: spaces.
1081:
1082: $text will optionally be linked to the same topic, allowing you to
1083: link text in addition to the graphic. If you do not want to link
1084: text, but wish to specify one of the later parameters, pass an
1085: empty string.
1086:
1087: $stayOnPage is a value that will be interpreted as a boolean. If true,
1088: the link will not open a new window. If false, the link will open
1089: a new window using Javascript. (Default is false.)
1090:
1091: $width and $height are optional numerical parameters that will
1092: override the width and height of the popped up window, which may
1093: be useful for certain help topics with big pictures included.
1.44 bowersj2 1094:
1095: =cut
1096:
1097: sub help_open_topic {
1.48 bowersj2 1098: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1099: $text = "" if (not defined $text);
1.44 bowersj2 1100: $stayOnPage = 0 if (not defined $stayOnPage);
1101: $width = 350 if (not defined $width);
1102: $height = 400 if (not defined $height);
1103: my $filename = $topic;
1104: $filename =~ s/ /_/g;
1105:
1.48 bowersj2 1106: my $template = "";
1107: my $link;
1.572 banghart 1108:
1.159 www 1109: $topic=~s/\W/\_/g;
1.44 bowersj2 1110:
1.572 banghart 1111: if (!$stayOnPage) {
1.72 bowersj2 1112: $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 1113: } else {
1.48 bowersj2 1114: $link = "/adm/help/${filename}.hlp";
1115: }
1116:
1117: # Add the text
1.755 neumanie 1118: if ($text ne "") {
1.763 bisitz 1119: $template.='<span class="LC_help_open_topic">'
1120: .'<a target="_top" href="'.$link.'">'
1121: .$text.'</a>';
1.48 bowersj2 1122: }
1123:
1.763 bisitz 1124: # (Always) Add the graphic
1.179 matthew 1125: my $title = &mt('Online Help');
1.667 raeburn 1126: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.763 bisitz 1127: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1128: .'<img src="'.$helpicon.'" border="0"'
1129: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.783 amueller 1130: .' title="'.$title.'"'
1.763 bisitz 1131: .' /></a>';
1132: if ($text ne "") {
1133: $template.='</span>';
1134: }
1.44 bowersj2 1135: return $template;
1136:
1.106 bowersj2 1137: }
1138:
1139: # This is a quicky function for Latex cheatsheet editing, since it
1140: # appears in at least four places
1141: sub helpLatexCheatsheet {
1.732 raeburn 1142: my ($topic,$text,$not_author) = @_;
1143: my $out;
1.106 bowersj2 1144: my $addOther = '';
1.732 raeburn 1145: if ($topic) {
1.763 bisitz 1146: $addOther = '<span>'.&Apache::loncommon::help_open_topic($topic,&mt($text),
1147: undef, undef, 600).
1148: '</span> ';
1149: }
1150: $out = '<span>' # Start cheatsheet
1151: .$addOther
1152: .'<span>'
1153: .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
1154: undef,undef,600)
1155: .'</span> <span>'
1156: .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
1157: undef,undef,600)
1158: .'</span>';
1.732 raeburn 1159: unless ($not_author) {
1.763 bisitz 1160: $out .= ' <span>'
1161: .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
1162: undef,undef,600)
1163: .'</span>';
1.732 raeburn 1164: }
1.763 bisitz 1165: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1166: return $out;
1.172 www 1167: }
1168:
1.430 albertel 1169: sub general_help {
1170: my $helptopic='Student_Intro';
1171: if ($env{'request.role'}=~/^(ca|au)/) {
1172: $helptopic='Authoring_Intro';
1.907 raeburn 1173: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1174: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1175: } elsif ($env{'request.role'}=~/^dc/) {
1176: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1177: }
1178: return $helptopic;
1179: }
1180:
1181: sub update_help_link {
1182: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1183: my $origurl = $ENV{'REQUEST_URI'};
1184: $origurl=~s|^/~|/priv/|;
1185: my $timestamp = time;
1186: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1187: $$datum = &escape($$datum);
1188: }
1189:
1190: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1191: my $output .= <<"ENDOUTPUT";
1192: <script type="text/javascript">
1.824 bisitz 1193: // <![CDATA[
1.430 albertel 1194: banner_link = '$banner_link';
1.824 bisitz 1195: // ]]>
1.430 albertel 1196: </script>
1197: ENDOUTPUT
1198: return $output;
1199: }
1200:
1201: # now just updates the help link and generates a blue icon
1.193 raeburn 1202: sub help_open_menu {
1.430 albertel 1203: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1204: = @_;
1.430 albertel 1205: $stayOnPage = 0 if (not defined $stayOnPage);
1.572 banghart 1206: # only use pop-up help (stayOnPage == 0)
1.552 banghart 1207: # if environment.remote is on (using remote control UI)
1.798 tempelho 1208: if ($env{'environment.remote'} eq 'off' ) {
1.552 banghart 1209: $stayOnPage=1;
1.430 albertel 1210: }
1211: my $output;
1212: if ($component_help) {
1213: if (!$text) {
1214: $output=&help_open_topic($component_help,undef,$stayOnPage,
1215: $width,$height);
1216: } else {
1217: my $help_text;
1218: $help_text=&unescape($topic);
1219: $output='<table><tr><td>'.
1220: &help_open_topic($component_help,$help_text,$stayOnPage,
1221: $width,$height).'</td></tr></table>';
1222: }
1223: }
1224: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1225: return $output.$banner_link;
1226: }
1227:
1228: sub top_nav_help {
1229: my ($text) = @_;
1.436 albertel 1230: $text = &mt($text);
1.572 banghart 1231: my $stay_on_page =
1.798 tempelho 1232: ($env{'environment.remote'} eq 'off' );
1.572 banghart 1233: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1234: : "javascript:helpMenu('open')";
1.572 banghart 1235: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1236:
1.201 raeburn 1237: my $title = &mt('Get help');
1.436 albertel 1238:
1239: return <<"END";
1240: $banner_link
1241: <a href="$link" title="$title">$text</a>
1242: END
1243: }
1244:
1245: sub help_menu_js {
1246: my ($text) = @_;
1247:
1248: my $stayOnPage =
1.798 tempelho 1249: ($env{'environment.remote'} eq 'off' );
1.436 albertel 1250:
1251: my $width = 620;
1252: my $height = 600;
1.430 albertel 1253: my $helptopic=&general_help();
1254: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1255: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1256: my $start_page =
1257: &Apache::loncommon::start_page('Help Menu', undef,
1258: {'frameset' => 1,
1259: 'js_ready' => 1,
1260: 'add_entries' => {
1261: 'border' => '0',
1.579 raeburn 1262: 'rows' => "110,*",},});
1.331 albertel 1263: my $end_page =
1264: &Apache::loncommon::end_page({'frameset' => 1,
1265: 'js_ready' => 1,});
1266:
1.436 albertel 1267: my $template .= <<"ENDTEMPLATE";
1268: <script type="text/javascript">
1.877 bisitz 1269: // <![CDATA[
1.253 albertel 1270: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1271: var banner_link = '';
1.243 raeburn 1272: function helpMenu(target) {
1273: var caller = this;
1274: if (target == 'open') {
1275: var newWindow = null;
1276: try {
1.262 albertel 1277: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1278: }
1279: catch(error) {
1280: writeHelp(caller);
1281: return;
1282: }
1283: if (newWindow) {
1284: caller = newWindow;
1285: }
1.193 raeburn 1286: }
1.243 raeburn 1287: writeHelp(caller);
1288: return;
1289: }
1290: function writeHelp(caller) {
1.430 albertel 1291: caller.document.writeln('$start_page<frame name="bannerframe" src="'+banner_link+'" /><frame name="bodyframe" src="$details_link" /> $end_page')
1.243 raeburn 1292: caller.document.close()
1293: caller.focus()
1.193 raeburn 1294: }
1.877 bisitz 1295: // END LON-CAPA Internal -->
1.253 albertel 1296: // ]]>
1.436 albertel 1297: </script>
1.193 raeburn 1298: ENDTEMPLATE
1299: return $template;
1300: }
1301:
1.172 www 1302: sub help_open_bug {
1303: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1304: unless ($env{'user.adv'}) { return ''; }
1.172 www 1305: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1306: $text = "" if (not defined $text);
1307: $stayOnPage = 0 if (not defined $stayOnPage);
1.798 tempelho 1308: if ($env{'environment.remote'} eq 'off' ) {
1.172 www 1309: $stayOnPage=1;
1310: }
1.184 albertel 1311: $width = 600 if (not defined $width);
1312: $height = 600 if (not defined $height);
1.172 www 1313:
1314: $topic=~s/\W+/\+/g;
1315: my $link='';
1316: my $template='';
1.379 albertel 1317: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1318: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1319: if (!$stayOnPage)
1320: {
1321: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1322: }
1323: else
1324: {
1325: $link = $url;
1326: }
1327: # Add the text
1328: if ($text ne "")
1329: {
1330: $template .=
1331: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1332: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1333: }
1334:
1335: # Add the graphic
1.179 matthew 1336: my $title = &mt('Report a Bug');
1.215 albertel 1337: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1338: $template .= <<"ENDTEMPLATE";
1.436 albertel 1339: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1340: ENDTEMPLATE
1341: if ($text ne '') { $template.='</td></tr></table>' };
1342: return $template;
1343:
1344: }
1345:
1346: sub help_open_faq {
1347: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1348: unless ($env{'user.adv'}) { return ''; }
1.172 www 1349: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1350: $text = "" if (not defined $text);
1351: $stayOnPage = 0 if (not defined $stayOnPage);
1.798 tempelho 1352: if ($env{'environment.remote'} eq 'off' ) {
1.172 www 1353: $stayOnPage=1;
1354: }
1355: $width = 350 if (not defined $width);
1356: $height = 400 if (not defined $height);
1357:
1358: $topic=~s/\W+/\+/g;
1359: my $link='';
1360: my $template='';
1361: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1362: if (!$stayOnPage)
1363: {
1364: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1365: }
1366: else
1367: {
1368: $link = $url;
1369: }
1370:
1371: # Add the text
1372: if ($text ne "")
1373: {
1374: $template .=
1.173 www 1375: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1376: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1377: }
1378:
1379: # Add the graphic
1.179 matthew 1380: my $title = &mt('View the FAQ');
1.215 albertel 1381: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1382: $template .= <<"ENDTEMPLATE";
1.436 albertel 1383: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1384: ENDTEMPLATE
1385: if ($text ne '') { $template.='</td></tr></table>' };
1386: return $template;
1387:
1.44 bowersj2 1388: }
1.37 matthew 1389:
1.180 matthew 1390: ###############################################################
1391: ###############################################################
1392:
1.45 matthew 1393: =pod
1394:
1.648 raeburn 1395: =item * &change_content_javascript():
1.256 matthew 1396:
1397: This and the next function allow you to create small sections of an
1398: otherwise static HTML page that you can update on the fly with
1399: Javascript, even in Netscape 4.
1400:
1401: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1402: must be written to the HTML page once. It will prove the Javascript
1403: function "change(name, content)". Calling the change function with the
1404: name of the section
1405: you want to update, matching the name passed to C<changable_area>, and
1406: the new content you want to put in there, will put the content into
1407: that area.
1408:
1409: B<Note>: Netscape 4 only reserves enough space for the changable area
1410: to contain room for the original contents. You need to "make space"
1411: for whatever changes you wish to make, and be B<sure> to check your
1412: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1413: it's adequate for updating a one-line status display, but little more.
1414: This script will set the space to 100% width, so you only need to
1415: worry about height in Netscape 4.
1416:
1417: Modern browsers are much less limiting, and if you can commit to the
1418: user not using Netscape 4, this feature may be used freely with
1419: pretty much any HTML.
1420:
1421: =cut
1422:
1423: sub change_content_javascript {
1424: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1425: if ($env{'browser.type'} eq 'netscape' &&
1426: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1427: return (<<NETSCAPE4);
1428: function change(name, content) {
1429: doc = document.layers[name+"___escape"].layers[0].document;
1430: doc.open();
1431: doc.write(content);
1432: doc.close();
1433: }
1434: NETSCAPE4
1435: } else {
1436: # Otherwise, we need to use semi-standards-compliant code
1437: # (technically, "innerHTML" isn't standard but the equivalent
1438: # is really scary, and every useful browser supports it
1439: return (<<DOMBASED);
1440: function change(name, content) {
1441: element = document.getElementById(name);
1442: element.innerHTML = content;
1443: }
1444: DOMBASED
1445: }
1446: }
1447:
1448: =pod
1449:
1.648 raeburn 1450: =item * &changable_area($name,$origContent):
1.256 matthew 1451:
1452: This provides a "changable area" that can be modified on the fly via
1453: the Javascript code provided in C<change_content_javascript>. $name is
1454: the name you will use to reference the area later; do not repeat the
1455: same name on a given HTML page more then once. $origContent is what
1456: the area will originally contain, which can be left blank.
1457:
1458: =cut
1459:
1460: sub changable_area {
1461: my ($name, $origContent) = @_;
1462:
1.258 albertel 1463: if ($env{'browser.type'} eq 'netscape' &&
1464: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1465: # If this is netscape 4, we need to use the Layer tag
1466: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1467: } else {
1468: return "<span id='$name'>$origContent</span>";
1469: }
1470: }
1471:
1472: =pod
1473:
1.648 raeburn 1474: =item * &viewport_geometry_js
1.590 raeburn 1475:
1476: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1477:
1478: =cut
1479:
1480:
1481: sub viewport_geometry_js {
1482: return <<"GEOMETRY";
1483: var Geometry = {};
1484: function init_geometry() {
1485: if (Geometry.init) { return };
1486: Geometry.init=1;
1487: if (window.innerHeight) {
1488: Geometry.getViewportHeight = function() { return window.innerHeight; };
1489: Geometry.getViewportWidth = function() { return window.innerWidth; };
1490: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1491: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1492: }
1493: else if (document.documentElement && document.documentElement.clientHeight) {
1494: Geometry.getViewportHeight =
1495: function() { return document.documentElement.clientHeight; };
1496: Geometry.getViewportWidth =
1497: function() { return document.documentElement.clientWidth; };
1498:
1499: Geometry.getHorizontalScroll =
1500: function() { return document.documentElement.scrollLeft; };
1501: Geometry.getVerticalScroll =
1502: function() { return document.documentElement.scrollTop; };
1503: }
1504: else if (document.body.clientHeight) {
1505: Geometry.getViewportHeight =
1506: function() { return document.body.clientHeight; };
1507: Geometry.getViewportWidth =
1508: function() { return document.body.clientWidth; };
1509: Geometry.getHorizontalScroll =
1510: function() { return document.body.scrollLeft; };
1511: Geometry.getVerticalScroll =
1512: function() { return document.body.scrollTop; };
1513: }
1514: }
1515:
1516: GEOMETRY
1517: }
1518:
1519: =pod
1520:
1.648 raeburn 1521: =item * &viewport_size_js()
1.590 raeburn 1522:
1523: 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.
1524:
1525: =cut
1526:
1527: sub viewport_size_js {
1528: my $geometry = &viewport_geometry_js();
1529: return <<"DIMS";
1530:
1531: $geometry
1532:
1533: function getViewportDims(width,height) {
1534: init_geometry();
1535: width.value = Geometry.getViewportWidth();
1536: height.value = Geometry.getViewportHeight();
1537: return;
1538: }
1539:
1540: DIMS
1541: }
1542:
1543: =pod
1544:
1.648 raeburn 1545: =item * &resize_textarea_js()
1.565 albertel 1546:
1547: emits the needed javascript to resize a textarea to be as big as possible
1548:
1549: creates a function resize_textrea that takes two IDs first should be
1550: the id of the element to resize, second should be the id of a div that
1551: surrounds everything that comes after the textarea, this routine needs
1552: to be attached to the <body> for the onload and onresize events.
1553:
1.648 raeburn 1554: =back
1.565 albertel 1555:
1556: =cut
1557:
1558: sub resize_textarea_js {
1.590 raeburn 1559: my $geometry = &viewport_geometry_js();
1.565 albertel 1560: return <<"RESIZE";
1561: <script type="text/javascript">
1.824 bisitz 1562: // <![CDATA[
1.590 raeburn 1563: $geometry
1.565 albertel 1564:
1.588 albertel 1565: function getX(element) {
1566: var x = 0;
1567: while (element) {
1568: x += element.offsetLeft;
1569: element = element.offsetParent;
1570: }
1571: return x;
1572: }
1573: function getY(element) {
1574: var y = 0;
1575: while (element) {
1576: y += element.offsetTop;
1577: element = element.offsetParent;
1578: }
1579: return y;
1580: }
1581:
1582:
1.565 albertel 1583: function resize_textarea(textarea_id,bottom_id) {
1584: init_geometry();
1585: var textarea = document.getElementById(textarea_id);
1586: //alert(textarea);
1587:
1.588 albertel 1588: var textarea_top = getY(textarea);
1.565 albertel 1589: var textarea_height = textarea.offsetHeight;
1590: var bottom = document.getElementById(bottom_id);
1.588 albertel 1591: var bottom_top = getY(bottom);
1.565 albertel 1592: var bottom_height = bottom.offsetHeight;
1593: var window_height = Geometry.getViewportHeight();
1.588 albertel 1594: var fudge = 23;
1.565 albertel 1595: var new_height = window_height-fudge-textarea_top-bottom_height;
1596: if (new_height < 300) {
1597: new_height = 300;
1598: }
1599: textarea.style.height=new_height+'px';
1600: }
1.824 bisitz 1601: // ]]>
1.565 albertel 1602: </script>
1603: RESIZE
1604:
1605: }
1606:
1607: =pod
1608:
1.256 matthew 1609: =head1 Excel and CSV file utility routines
1610:
1611: =over 4
1612:
1613: =cut
1614:
1615: ###############################################################
1616: ###############################################################
1617:
1618: =pod
1619:
1.648 raeburn 1620: =item * &csv_translate($text)
1.37 matthew 1621:
1.185 www 1622: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1623: format.
1624:
1625: =cut
1626:
1.180 matthew 1627: ###############################################################
1628: ###############################################################
1.37 matthew 1629: sub csv_translate {
1630: my $text = shift;
1631: $text =~ s/\"/\"\"/g;
1.209 albertel 1632: $text =~ s/\n/ /g;
1.37 matthew 1633: return $text;
1634: }
1.180 matthew 1635:
1636: ###############################################################
1637: ###############################################################
1638:
1639: =pod
1640:
1.648 raeburn 1641: =item * &define_excel_formats()
1.180 matthew 1642:
1643: Define some commonly used Excel cell formats.
1644:
1645: Currently supported formats:
1646:
1647: =over 4
1648:
1649: =item header
1650:
1651: =item bold
1652:
1653: =item h1
1654:
1655: =item h2
1656:
1657: =item h3
1658:
1.256 matthew 1659: =item h4
1660:
1661: =item i
1662:
1.180 matthew 1663: =item date
1664:
1665: =back
1666:
1667: Inputs: $workbook
1668:
1669: Returns: $format, a hash reference.
1670:
1671: =cut
1672:
1673: ###############################################################
1674: ###############################################################
1675: sub define_excel_formats {
1676: my ($workbook) = @_;
1677: my $format;
1678: $format->{'header'} = $workbook->add_format(bold => 1,
1679: bottom => 1,
1680: align => 'center');
1681: $format->{'bold'} = $workbook->add_format(bold=>1);
1682: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1683: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1684: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1685: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1686: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1687: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1688: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1689: return $format;
1690: }
1691:
1692: ###############################################################
1693: ###############################################################
1.113 bowersj2 1694:
1695: =pod
1696:
1.648 raeburn 1697: =item * &create_workbook()
1.255 matthew 1698:
1699: Create an Excel worksheet. If it fails, output message on the
1700: request object and return undefs.
1701:
1702: Inputs: Apache request object
1703:
1704: Returns (undef) on failure,
1705: Excel worksheet object, scalar with filename, and formats
1706: from &Apache::loncommon::define_excel_formats on success
1707:
1708: =cut
1709:
1710: ###############################################################
1711: ###############################################################
1712: sub create_workbook {
1713: my ($r) = @_;
1714: #
1715: # Create the excel spreadsheet
1716: my $filename = '/prtspool/'.
1.258 albertel 1717: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1718: time.'_'.rand(1000000000).'.xls';
1719: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1720: if (! defined($workbook)) {
1721: $r->log_error("Error creating excel spreadsheet $filename: $!");
1722: $r->print('<p>'.&mt("Unable to create new Excel file. ".
1723: "This error has been logged. ".
1724: "Please alert your LON-CAPA administrator").
1725: '</p>');
1726: return (undef);
1727: }
1728: #
1729: $workbook->set_tempdir('/home/httpd/perl/tmp');
1730: #
1731: my $format = &Apache::loncommon::define_excel_formats($workbook);
1732: return ($workbook,$filename,$format);
1733: }
1734:
1735: ###############################################################
1736: ###############################################################
1737:
1738: =pod
1739:
1.648 raeburn 1740: =item * &create_text_file()
1.113 bowersj2 1741:
1.542 raeburn 1742: Create a file to write to and eventually make available to the user.
1.256 matthew 1743: If file creation fails, outputs an error message on the request object and
1744: return undefs.
1.113 bowersj2 1745:
1.256 matthew 1746: Inputs: Apache request object, and file suffix
1.113 bowersj2 1747:
1.256 matthew 1748: Returns (undef) on failure,
1749: Filehandle and filename on success.
1.113 bowersj2 1750:
1751: =cut
1752:
1.256 matthew 1753: ###############################################################
1754: ###############################################################
1755: sub create_text_file {
1756: my ($r,$suffix) = @_;
1757: if (! defined($suffix)) { $suffix = 'txt'; };
1758: my $fh;
1759: my $filename = '/prtspool/'.
1.258 albertel 1760: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1761: time.'_'.rand(1000000000).'.'.$suffix;
1762: $fh = Apache::File->new('>/home/httpd'.$filename);
1763: if (! defined($fh)) {
1764: $r->log_error("Couldn't open $filename for output $!");
1.683 bisitz 1765: $r->print(&mt('Problems occurred in creating the output file. '
1766: .'This error has been logged. '
1767: .'Please alert your LON-CAPA administrator.'));
1.113 bowersj2 1768: }
1.256 matthew 1769: return ($fh,$filename)
1.113 bowersj2 1770: }
1771:
1772:
1.256 matthew 1773: =pod
1.113 bowersj2 1774:
1775: =back
1776:
1777: =cut
1.37 matthew 1778:
1779: ###############################################################
1.33 matthew 1780: ## Home server <option> list generating code ##
1781: ###############################################################
1.35 matthew 1782:
1.169 www 1783: # ------------------------------------------
1784:
1785: sub domain_select {
1786: my ($name,$value,$multiple)=@_;
1787: my %domains=map {
1.514 albertel 1788: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1789: } &Apache::lonnet::all_domains();
1.169 www 1790: if ($multiple) {
1791: $domains{''}=&mt('Any domain');
1.550 albertel 1792: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1793: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1794: } else {
1.550 albertel 1795: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.169 www 1796: return &select_form($name,$value,%domains);
1797: }
1798: }
1799:
1.282 albertel 1800: #-------------------------------------------
1801:
1802: =pod
1803:
1.519 raeburn 1804: =head1 Routines for form select boxes
1805:
1806: =over 4
1807:
1.648 raeburn 1808: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1809:
1810: Returns a string containing a <select> element int multiple mode
1811:
1812:
1813: Args:
1814: $name - name of the <select> element
1.506 raeburn 1815: $value - scalar or array ref of values that should already be selected
1.282 albertel 1816: $size - number of rows long the select element is
1.283 albertel 1817: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1818: (shown text should already have been &mt())
1.506 raeburn 1819: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1820:
1.282 albertel 1821: =cut
1822:
1823: #-------------------------------------------
1.169 www 1824: sub multiple_select_form {
1.284 albertel 1825: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1826: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1827: my $output='';
1.191 matthew 1828: if (! defined($size)) {
1829: $size = 4;
1.283 albertel 1830: if (scalar(keys(%$hash))<4) {
1831: $size = scalar(keys(%$hash));
1.191 matthew 1832: }
1833: }
1.734 bisitz 1834: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1835: my @order;
1.506 raeburn 1836: if (ref($order) eq 'ARRAY') {
1837: @order = @{$order};
1838: } else {
1839: @order = sort(keys(%$hash));
1.501 banghart 1840: }
1841: if (exists($$hash{'select_form_order'})) {
1842: @order = @{$$hash{'select_form_order'}};
1843: }
1844:
1.284 albertel 1845: foreach my $key (@order) {
1.356 albertel 1846: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1847: $output.='selected="selected" ' if ($selected{$key});
1848: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1849: }
1850: $output.="</select>\n";
1851: return $output;
1852: }
1853:
1.88 www 1854: #-------------------------------------------
1855:
1856: =pod
1857:
1.648 raeburn 1858: =item * &select_form($defdom,$name,%hash)
1.88 www 1859:
1860: Returns a string containing a <select name='$name' size='1'> form to
1861: allow a user to select options from a hash option_name => displayed text.
1862: See lonrights.pm for an example invocation and use.
1863:
1864: =cut
1865:
1866: #-------------------------------------------
1867: sub select_form {
1868: my ($def,$name,%hash) = @_;
1869: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1.128 albertel 1870: my @keys;
1871: if (exists($hash{'select_form_order'})) {
1872: @keys=@{$hash{'select_form_order'}};
1873: } else {
1874: @keys=sort(keys(%hash));
1875: }
1.356 albertel 1876: foreach my $key (@keys) {
1877: $selectform.=
1878: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
1879: ($key eq $def ? 'selected="selected" ' : '').
1.922 bisitz 1880: ">".$hash{$key}."</option>\n";
1.88 www 1881: }
1882: $selectform.="</select>";
1883: return $selectform;
1884: }
1885:
1.475 www 1886: # For display filters
1887:
1888: sub display_filter {
1889: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 1890: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714 bisitz 1891: return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475 www 1892: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
1893: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 1894: '</label></span> <span class="LC_nobreak">'.
1.475 www 1895: &mt('Filter [_1]',
1.477 www 1896: &select_form($env{'form.displayfilter'},
1897: 'displayfilter',
1898: ('currentfolder' => 'Current folder/page',
1899: 'containing' => 'Containing phrase',
1900: 'none' => 'None'))).
1.714 bisitz 1901: '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475 www 1902: }
1903:
1.167 www 1904: sub gradeleveldescription {
1905: my $gradelevel=shift;
1906: my %gradelevels=(0 => 'Not specified',
1907: 1 => 'Grade 1',
1908: 2 => 'Grade 2',
1909: 3 => 'Grade 3',
1910: 4 => 'Grade 4',
1911: 5 => 'Grade 5',
1912: 6 => 'Grade 6',
1913: 7 => 'Grade 7',
1914: 8 => 'Grade 8',
1915: 9 => 'Grade 9',
1916: 10 => 'Grade 10',
1917: 11 => 'Grade 11',
1918: 12 => 'Grade 12',
1919: 13 => 'Grade 13',
1920: 14 => '100 Level',
1921: 15 => '200 Level',
1922: 16 => '300 Level',
1923: 17 => '400 Level',
1924: 18 => 'Graduate Level');
1925: return &mt($gradelevels{$gradelevel});
1926: }
1927:
1.163 www 1928: sub select_level_form {
1929: my ($deflevel,$name)=@_;
1930: unless ($deflevel) { $deflevel=0; }
1.167 www 1931: my $selectform = "<select name=\"$name\" size=\"1\">\n";
1932: for (my $i=0; $i<=18; $i++) {
1933: $selectform.="<option value=\"$i\" ".
1.253 albertel 1934: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 1935: ">".&gradeleveldescription($i)."</option>\n";
1936: }
1937: $selectform.="</select>";
1938: return $selectform;
1.163 www 1939: }
1.167 www 1940:
1.35 matthew 1941: #-------------------------------------------
1942:
1.45 matthew 1943: =pod
1944:
1.910 raeburn 1945: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35 matthew 1946:
1947: Returns a string containing a <select name='$name' size='1'> form to
1948: allow a user to select the domain to preform an operation in.
1949: See loncreateuser.pm for an example invocation and use.
1950:
1.90 www 1951: If the $includeempty flag is set, it also includes an empty choice ("no domain
1952: selected");
1953:
1.743 raeburn 1954: If the $showdomdesc flag is set, the domain name is followed by the domain description.
1955:
1.910 raeburn 1956: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
1957:
1958: The optional $incdoms is a reference to an array of domains which will be the only available options.
1.563 raeburn 1959:
1.35 matthew 1960: =cut
1961:
1962: #-------------------------------------------
1.34 matthew 1963: sub select_dom_form {
1.910 raeburn 1964: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872 raeburn 1965: if ($onchange) {
1.874 raeburn 1966: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 1967: }
1.910 raeburn 1968: my @domains;
1969: if (ref($incdoms) eq 'ARRAY') {
1970: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
1971: } else {
1972: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
1973: }
1.90 www 1974: if ($includeempty) { @domains=('',@domains); }
1.743 raeburn 1975: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 1976: foreach my $dom (@domains) {
1977: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 1978: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
1979: if ($showdomdesc) {
1980: if ($dom ne '') {
1.925.2.13 raeburn 1981: my $domdesc;
1982: if ($name eq 'srchdomain') {
1983: if ($dom eq 'gci') {
1984: $domdesc = 'Faculty';
1985: } else {
1986: $domdesc = 'Students';
1987: }
1988: } else {
1989: $domdesc = &Apache::lonnet::domain($dom,'description');
1990: }
1.563 raeburn 1991: if ($domdesc ne '') {
1992: $selectdomain .= ' ('.$domdesc.')';
1993: }
1994: }
1995: }
1996: $selectdomain .= "</option>\n";
1.34 matthew 1997: }
1998: $selectdomain.="</select>";
1999: return $selectdomain;
2000: }
2001:
1.35 matthew 2002: #-------------------------------------------
2003:
1.45 matthew 2004: =pod
2005:
1.648 raeburn 2006: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2007:
1.586 raeburn 2008: input: 4 arguments (two required, two optional) -
2009: $domain - domain of new user
2010: $name - name of form element
2011: $default - Value of 'default' causes a default item to be first
2012: option, and selected by default.
2013: $hide - Value of 'hide' causes hiding of the name of the server,
2014: if 1 server found, or default, if 0 found.
1.594 raeburn 2015: output: returns 2 items:
1.586 raeburn 2016: (a) form element which contains either:
2017: (i) <select name="$name">
2018: <option value="$hostid1">$hostid $servers{$hostid}</option>
2019: <option value="$hostid2">$hostid $servers{$hostid}</option>
2020: </select>
2021: form item if there are multiple library servers in $domain, or
2022: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2023: if there is only one library server in $domain.
2024:
2025: (b) number of library servers found.
2026:
2027: See loncreateuser.pm for example of use.
1.35 matthew 2028:
2029: =cut
2030:
2031: #-------------------------------------------
1.586 raeburn 2032: sub home_server_form_item {
2033: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2034: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2035: my $result;
2036: my $numlib = keys(%servers);
2037: if ($numlib > 1) {
2038: $result .= '<select name="'.$name.'" />'."\n";
2039: if ($default) {
1.804 bisitz 2040: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2041: '</option>'."\n";
2042: }
2043: foreach my $hostid (sort(keys(%servers))) {
2044: $result.= '<option value="'.$hostid.'">'.
2045: $hostid.' '.$servers{$hostid}."</option>\n";
2046: }
2047: $result .= '</select>'."\n";
2048: } elsif ($numlib == 1) {
2049: my $hostid;
2050: foreach my $item (keys(%servers)) {
2051: $hostid = $item;
2052: }
2053: $result .= '<input type="hidden" name="'.$name.'" value="'.
2054: $hostid.'" />';
2055: if (!$hide) {
2056: $result .= $hostid.' '.$servers{$hostid};
2057: }
2058: $result .= "\n";
2059: } elsif ($default) {
2060: $result .= '<input type="hidden" name="'.$name.
2061: '" value="default" />';
2062: if (!$hide) {
2063: $result .= &mt('default');
2064: }
2065: $result .= "\n";
1.33 matthew 2066: }
1.586 raeburn 2067: return ($result,$numlib);
1.33 matthew 2068: }
1.112 bowersj2 2069:
2070: =pod
2071:
1.534 albertel 2072: =back
2073:
1.112 bowersj2 2074: =cut
1.87 matthew 2075:
2076: ###############################################################
1.112 bowersj2 2077: ## Decoding User Agent ##
1.87 matthew 2078: ###############################################################
2079:
2080: =pod
2081:
1.112 bowersj2 2082: =head1 Decoding the User Agent
2083:
2084: =over 4
2085:
2086: =item * &decode_user_agent()
1.87 matthew 2087:
2088: Inputs: $r
2089:
2090: Outputs:
2091:
2092: =over 4
2093:
1.112 bowersj2 2094: =item * $httpbrowser
1.87 matthew 2095:
1.112 bowersj2 2096: =item * $clientbrowser
1.87 matthew 2097:
1.112 bowersj2 2098: =item * $clientversion
1.87 matthew 2099:
1.112 bowersj2 2100: =item * $clientmathml
1.87 matthew 2101:
1.112 bowersj2 2102: =item * $clientunicode
1.87 matthew 2103:
1.112 bowersj2 2104: =item * $clientos
1.87 matthew 2105:
2106: =back
2107:
1.157 matthew 2108: =back
2109:
1.87 matthew 2110: =cut
2111:
2112: ###############################################################
2113: ###############################################################
2114: sub decode_user_agent {
1.247 albertel 2115: my ($r)=@_;
1.87 matthew 2116: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2117: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2118: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2119: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2120: my $clientbrowser='unknown';
2121: my $clientversion='0';
2122: my $clientmathml='';
2123: my $clientunicode='0';
2124: for (my $i=0;$i<=$#browsertype;$i++) {
2125: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2126: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2127: $clientbrowser=$bname;
2128: $httpbrowser=~/$vreg/i;
2129: $clientversion=$1;
2130: $clientmathml=($clientversion>=$minv);
2131: $clientunicode=($clientversion>=$univ);
2132: }
2133: }
2134: my $clientos='unknown';
2135: if (($httpbrowser=~/linux/i) ||
2136: ($httpbrowser=~/unix/i) ||
2137: ($httpbrowser=~/ux/i) ||
2138: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2139: if (($httpbrowser=~/vax/i) ||
2140: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2141: if ($httpbrowser=~/next/i) { $clientos='next'; }
2142: if (($httpbrowser=~/mac/i) ||
2143: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2144: if ($httpbrowser=~/win/i) { $clientos='win'; }
2145: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2146: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2147: $clientunicode,$clientos,);
2148: }
2149:
1.32 matthew 2150: ###############################################################
2151: ## Authentication changing form generation subroutines ##
2152: ###############################################################
2153: ##
2154: ## All of the authform_xxxxxxx subroutines take their inputs in a
2155: ## hash, and have reasonable default values.
2156: ##
2157: ## formname = the name given in the <form> tag.
1.35 matthew 2158: #-------------------------------------------
2159:
1.45 matthew 2160: =pod
2161:
1.112 bowersj2 2162: =head1 Authentication Routines
2163:
2164: =over 4
2165:
1.648 raeburn 2166: =item * &authform_xxxxxx()
1.35 matthew 2167:
2168: The authform_xxxxxx subroutines provide javascript and html forms which
2169: handle some of the conveniences required for authentication forms.
2170: This is not an optimal method, but it works.
2171:
2172: =over 4
2173:
1.112 bowersj2 2174: =item * authform_header
1.35 matthew 2175:
1.112 bowersj2 2176: =item * authform_authorwarning
1.35 matthew 2177:
1.112 bowersj2 2178: =item * authform_nochange
1.35 matthew 2179:
1.112 bowersj2 2180: =item * authform_kerberos
1.35 matthew 2181:
1.112 bowersj2 2182: =item * authform_internal
1.35 matthew 2183:
1.112 bowersj2 2184: =item * authform_filesystem
1.35 matthew 2185:
2186: =back
2187:
1.648 raeburn 2188: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2189:
1.35 matthew 2190: =cut
2191:
2192: #-------------------------------------------
1.32 matthew 2193: sub authform_header{
2194: my %in = (
2195: formname => 'cu',
1.80 albertel 2196: kerb_def_dom => '',
1.32 matthew 2197: @_,
2198: );
2199: $in{'formname'} = 'document.' . $in{'formname'};
2200: my $result='';
1.80 albertel 2201:
2202: #---------------------------------------------- Code for upper case translation
2203: my $Javascript_toUpperCase;
2204: unless ($in{kerb_def_dom}) {
2205: $Javascript_toUpperCase =<<"END";
2206: switch (choice) {
2207: case 'krb': currentform.elements[choicearg].value =
2208: currentform.elements[choicearg].value.toUpperCase();
2209: break;
2210: default:
2211: }
2212: END
2213: } else {
2214: $Javascript_toUpperCase = "";
2215: }
2216:
1.165 raeburn 2217: my $radioval = "'nochange'";
1.591 raeburn 2218: if (defined($in{'curr_authtype'})) {
2219: if ($in{'curr_authtype'} ne '') {
2220: $radioval = "'".$in{'curr_authtype'}."arg'";
2221: }
1.174 matthew 2222: }
1.165 raeburn 2223: my $argfield = 'null';
1.591 raeburn 2224: if (defined($in{'mode'})) {
1.165 raeburn 2225: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2226: if (defined($in{'curr_autharg'})) {
2227: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2228: $argfield = "'$in{'curr_autharg'}'";
2229: }
2230: }
2231: }
2232: }
2233:
1.32 matthew 2234: $result.=<<"END";
2235: var current = new Object();
1.165 raeburn 2236: current.radiovalue = $radioval;
2237: current.argfield = $argfield;
1.32 matthew 2238:
2239: function changed_radio(choice,currentform) {
2240: var choicearg = choice + 'arg';
2241: // If a radio button in changed, we need to change the argfield
2242: if (current.radiovalue != choice) {
2243: current.radiovalue = choice;
2244: if (current.argfield != null) {
2245: currentform.elements[current.argfield].value = '';
2246: }
2247: if (choice == 'nochange') {
2248: current.argfield = null;
2249: } else {
2250: current.argfield = choicearg;
2251: switch(choice) {
2252: case 'krb':
2253: currentform.elements[current.argfield].value =
2254: "$in{'kerb_def_dom'}";
2255: break;
2256: default:
2257: break;
2258: }
2259: }
2260: }
2261: return;
2262: }
1.22 www 2263:
1.32 matthew 2264: function changed_text(choice,currentform) {
2265: var choicearg = choice + 'arg';
2266: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2267: $Javascript_toUpperCase
1.32 matthew 2268: // clear old field
2269: if ((current.argfield != choicearg) && (current.argfield != null)) {
2270: currentform.elements[current.argfield].value = '';
2271: }
2272: current.argfield = choicearg;
2273: }
2274: set_auth_radio_buttons(choice,currentform);
2275: return;
1.20 www 2276: }
1.32 matthew 2277:
2278: function set_auth_radio_buttons(newvalue,currentform) {
2279: var i=0;
2280: while (i < currentform.login.length) {
2281: if (currentform.login[i].value == newvalue) { break; }
2282: i++;
2283: }
2284: if (i == currentform.login.length) {
2285: return;
2286: }
2287: current.radiovalue = newvalue;
2288: currentform.login[i].checked = true;
2289: return;
2290: }
2291: END
2292: return $result;
2293: }
2294:
2295: sub authform_authorwarning{
2296: my $result='';
1.144 matthew 2297: $result='<i>'.
2298: &mt('As a general rule, only authors or co-authors should be '.
2299: 'filesystem authenticated '.
2300: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2301: return $result;
2302: }
2303:
2304: sub authform_nochange{
2305: my %in = (
2306: formname => 'document.cu',
2307: kerb_def_dom => 'MSU.EDU',
2308: @_,
2309: );
1.586 raeburn 2310: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
2311: my $result;
2312: if (keys(%can_assign) == 0) {
2313: $result = &mt('Under you current role you are not permitted to change login settings for this user');
2314: } else {
2315: $result = '<label>'.&mt('[_1] Do not change login data',
2316: '<input type="radio" name="login" value="nochange" '.
2317: 'checked="checked" onclick="'.
1.281 albertel 2318: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2319: '</label>';
1.586 raeburn 2320: }
1.32 matthew 2321: return $result;
2322: }
2323:
1.591 raeburn 2324: sub authform_kerberos {
1.32 matthew 2325: my %in = (
2326: formname => 'document.cu',
2327: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2328: kerb_def_auth => 'krb4',
1.32 matthew 2329: @_,
2330: );
1.586 raeburn 2331: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2332: $autharg,$jscall);
2333: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2334: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2335: $check5 = ' checked="checked"';
1.80 albertel 2336: } else {
1.772 bisitz 2337: $check4 = ' checked="checked"';
1.80 albertel 2338: }
1.165 raeburn 2339: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2340: if (defined($in{'curr_authtype'})) {
2341: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2342: $krbcheck = ' checked="checked"';
1.623 raeburn 2343: if (defined($in{'mode'})) {
2344: if ($in{'mode'} eq 'modifyuser') {
2345: $krbcheck = '';
2346: }
2347: }
1.591 raeburn 2348: if (defined($in{'curr_kerb_ver'})) {
2349: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2350: $check5 = ' checked="checked"';
1.591 raeburn 2351: $check4 = '';
2352: } else {
1.772 bisitz 2353: $check4 = ' checked="checked"';
1.591 raeburn 2354: $check5 = '';
2355: }
1.586 raeburn 2356: }
1.591 raeburn 2357: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2358: $krbarg = $in{'curr_autharg'};
2359: }
1.586 raeburn 2360: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2361: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2362: $result =
2363: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2364: $in{'curr_autharg'},$krbver);
2365: } else {
2366: $result =
2367: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2368: }
2369: return $result;
2370: }
2371: }
2372: } else {
2373: if ($authnum == 1) {
1.784 bisitz 2374: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2375: }
2376: }
1.586 raeburn 2377: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2378: return;
1.587 raeburn 2379: } elsif ($authtype eq '') {
1.591 raeburn 2380: if (defined($in{'mode'})) {
1.587 raeburn 2381: if ($in{'mode'} eq 'modifycourse') {
2382: if ($authnum == 1) {
1.784 bisitz 2383: $authtype = '<input type="hidden" name="login" value="krb" />';
1.587 raeburn 2384: }
2385: }
2386: }
1.586 raeburn 2387: }
2388: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2389: if ($authtype eq '') {
2390: $authtype = '<input type="radio" name="login" value="krb" '.
2391: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2392: $krbcheck.' />';
2393: }
2394: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
2395: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
2396: $in{'curr_authtype'} eq 'krb5') ||
2397: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
2398: $in{'curr_authtype'} eq 'krb4')) {
2399: $result .= &mt
1.144 matthew 2400: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2401: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2402: '<label>'.$authtype,
1.281 albertel 2403: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2404: 'value="'.$krbarg.'" '.
1.144 matthew 2405: 'onchange="'.$jscall.'" />',
1.281 albertel 2406: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2407: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2408: '</label>');
1.586 raeburn 2409: } elsif ($can_assign{'krb4'}) {
2410: $result .= &mt
2411: ('[_1] Kerberos authenticated with domain [_2] '.
2412: '[_3] Version 4 [_4]',
2413: '<label>'.$authtype,
2414: '</label><input type="text" size="10" name="krbarg" '.
2415: 'value="'.$krbarg.'" '.
2416: 'onchange="'.$jscall.'" />',
2417: '<label><input type="hidden" name="krbver" value="4" />',
2418: '</label>');
2419: } elsif ($can_assign{'krb5'}) {
2420: $result .= &mt
2421: ('[_1] Kerberos authenticated with domain [_2] '.
2422: '[_3] Version 5 [_4]',
2423: '<label>'.$authtype,
2424: '</label><input type="text" size="10" name="krbarg" '.
2425: 'value="'.$krbarg.'" '.
2426: 'onchange="'.$jscall.'" />',
2427: '<label><input type="hidden" name="krbver" value="5" />',
2428: '</label>');
2429: }
1.32 matthew 2430: return $result;
2431: }
2432:
2433: sub authform_internal{
1.586 raeburn 2434: my %in = (
1.32 matthew 2435: formname => 'document.cu',
2436: kerb_def_dom => 'MSU.EDU',
2437: @_,
2438: );
1.586 raeburn 2439: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
2440: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2441: if (defined($in{'curr_authtype'})) {
2442: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2443: if ($can_assign{'int'}) {
1.772 bisitz 2444: $intcheck = 'checked="checked" ';
1.623 raeburn 2445: if (defined($in{'mode'})) {
2446: if ($in{'mode'} eq 'modifyuser') {
2447: $intcheck = '';
2448: }
2449: }
1.591 raeburn 2450: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2451: $intarg = $in{'curr_autharg'};
2452: }
2453: } else {
2454: $result = &mt('Currently internally authenticated.');
2455: return $result;
1.165 raeburn 2456: }
2457: }
1.586 raeburn 2458: } else {
2459: if ($authnum == 1) {
1.784 bisitz 2460: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2461: }
2462: }
2463: if (!$can_assign{'int'}) {
2464: return;
1.587 raeburn 2465: } elsif ($authtype eq '') {
1.591 raeburn 2466: if (defined($in{'mode'})) {
1.587 raeburn 2467: if ($in{'mode'} eq 'modifycourse') {
2468: if ($authnum == 1) {
1.784 bisitz 2469: $authtype = '<input type="hidden" name="login" value="int" />';
1.587 raeburn 2470: }
2471: }
2472: }
1.165 raeburn 2473: }
1.586 raeburn 2474: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2475: if ($authtype eq '') {
2476: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2477: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2478: }
1.605 bisitz 2479: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2480: $intarg.'" onchange="'.$jscall.'" />';
1.925.2.13 raeburn 2481: my $authtext = '[_1] Internally authenticated (with initial password [_2])';
2482: if ($in{'caller'} eq 'requestcrs') {
2483: $authtext = "[_1] Students' password, if none in the uploaded file: [_2]";
2484: }
2485: $result = &mt($authtext,'<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2486: $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 2487: return $result;
2488: }
2489:
2490: sub authform_local{
2491: my %in = (
2492: formname => 'document.cu',
2493: kerb_def_dom => 'MSU.EDU',
2494: @_,
2495: );
1.586 raeburn 2496: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
2497: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2498: if (defined($in{'curr_authtype'})) {
2499: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2500: if ($can_assign{'loc'}) {
1.772 bisitz 2501: $loccheck = 'checked="checked" ';
1.623 raeburn 2502: if (defined($in{'mode'})) {
2503: if ($in{'mode'} eq 'modifyuser') {
2504: $loccheck = '';
2505: }
2506: }
1.591 raeburn 2507: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2508: $locarg = $in{'curr_autharg'};
2509: }
2510: } else {
2511: $result = &mt('Currently using local (institutional) authentication.');
2512: return $result;
1.165 raeburn 2513: }
2514: }
1.586 raeburn 2515: } else {
2516: if ($authnum == 1) {
1.784 bisitz 2517: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2518: }
2519: }
2520: if (!$can_assign{'loc'}) {
2521: return;
1.587 raeburn 2522: } elsif ($authtype eq '') {
1.591 raeburn 2523: if (defined($in{'mode'})) {
1.587 raeburn 2524: if ($in{'mode'} eq 'modifycourse') {
2525: if ($authnum == 1) {
1.784 bisitz 2526: $authtype = '<input type="hidden" name="login" value="loc" />';
1.587 raeburn 2527: }
2528: }
2529: }
1.165 raeburn 2530: }
1.586 raeburn 2531: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2532: if ($authtype eq '') {
2533: $authtype = '<input type="radio" name="login" value="loc" '.
2534: $loccheck.' onchange="'.$jscall.'" onclick="'.
2535: $jscall.'" />';
2536: }
2537: $autharg = '<input type="text" size="10" name="locarg" value="'.
2538: $locarg.'" onchange="'.$jscall.'" />';
2539: $result = &mt('[_1] Local Authentication with argument [_2]',
2540: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2541: return $result;
2542: }
2543:
2544: sub authform_filesystem{
2545: my %in = (
2546: formname => 'document.cu',
2547: kerb_def_dom => 'MSU.EDU',
2548: @_,
2549: );
1.586 raeburn 2550: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
2551: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2552: if (defined($in{'curr_authtype'})) {
2553: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2554: if ($can_assign{'fsys'}) {
1.772 bisitz 2555: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2556: if (defined($in{'mode'})) {
2557: if ($in{'mode'} eq 'modifyuser') {
2558: $fsyscheck = '';
2559: }
2560: }
1.586 raeburn 2561: } else {
2562: $result = &mt('Currently Filesystem Authenticated.');
2563: return $result;
2564: }
2565: }
2566: } else {
2567: if ($authnum == 1) {
1.784 bisitz 2568: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2569: }
2570: }
2571: if (!$can_assign{'fsys'}) {
2572: return;
1.587 raeburn 2573: } elsif ($authtype eq '') {
1.591 raeburn 2574: if (defined($in{'mode'})) {
1.587 raeburn 2575: if ($in{'mode'} eq 'modifycourse') {
2576: if ($authnum == 1) {
1.784 bisitz 2577: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587 raeburn 2578: }
2579: }
2580: }
1.586 raeburn 2581: }
2582: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2583: if ($authtype eq '') {
2584: $authtype = '<input type="radio" name="login" value="fsys" '.
2585: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2586: $jscall.'" />';
2587: }
2588: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2589: ' onchange="'.$jscall.'" />';
2590: $result = &mt
1.144 matthew 2591: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2592: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2593: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2594: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2595: 'onchange="'.$jscall.'" />');
1.32 matthew 2596: return $result;
2597: }
2598:
1.586 raeburn 2599: sub get_assignable_auth {
2600: my ($dom) = @_;
2601: if ($dom eq '') {
2602: $dom = $env{'request.role.domain'};
2603: }
2604: my %can_assign = (
2605: krb4 => 1,
2606: krb5 => 1,
2607: int => 1,
2608: loc => 1,
2609: );
2610: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2611: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2612: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2613: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2614: my $context;
2615: if ($env{'request.role'} =~ /^au/) {
2616: $context = 'author';
2617: } elsif ($env{'request.role'} =~ /^dc/) {
2618: $context = 'domain';
2619: } elsif ($env{'request.course.id'}) {
2620: $context = 'course';
2621: }
2622: if ($context) {
2623: if (ref($authhash->{$context}) eq 'HASH') {
2624: %can_assign = %{$authhash->{$context}};
2625: }
2626: }
2627: }
2628: }
2629: my $authnum = 0;
2630: foreach my $key (keys(%can_assign)) {
2631: if ($can_assign{$key}) {
2632: $authnum ++;
2633: }
2634: }
2635: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2636: $authnum --;
2637: }
2638: return ($authnum,%can_assign);
2639: }
2640:
1.80 albertel 2641: ###############################################################
2642: ## Get Kerberos Defaults for Domain ##
2643: ###############################################################
2644: ##
2645: ## Returns default kerberos version and an associated argument
2646: ## as listed in file domain.tab. If not listed, provides
2647: ## appropriate default domain and kerberos version.
2648: ##
2649: #-------------------------------------------
2650:
2651: =pod
2652:
1.648 raeburn 2653: =item * &get_kerberos_defaults()
1.80 albertel 2654:
2655: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2656: version and domain. If not found, it defaults to version 4 and the
2657: domain of the server.
1.80 albertel 2658:
1.648 raeburn 2659: =over 4
2660:
1.80 albertel 2661: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2662:
1.648 raeburn 2663: =back
2664:
2665: =back
2666:
1.80 albertel 2667: =cut
2668:
2669: #-------------------------------------------
2670: sub get_kerberos_defaults {
2671: my $domain=shift;
1.641 raeburn 2672: my ($krbdef,$krbdefdom);
2673: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2674: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2675: $krbdef = $domdefaults{'auth_def'};
2676: $krbdefdom = $domdefaults{'auth_arg_def'};
2677: } else {
1.80 albertel 2678: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2679: my $krbdefdom=$1;
2680: $krbdefdom=~tr/a-z/A-Z/;
2681: $krbdef = "krb4";
2682: }
2683: return ($krbdef,$krbdefdom);
2684: }
1.112 bowersj2 2685:
1.32 matthew 2686:
1.46 matthew 2687: ###############################################################
2688: ## Thesaurus Functions ##
2689: ###############################################################
1.20 www 2690:
1.46 matthew 2691: =pod
1.20 www 2692:
1.112 bowersj2 2693: =head1 Thesaurus Functions
2694:
2695: =over 4
2696:
1.648 raeburn 2697: =item * &initialize_keywords()
1.46 matthew 2698:
2699: Initializes the package variable %Keywords if it is empty. Uses the
2700: package variable $thesaurus_db_file.
2701:
2702: =cut
2703:
2704: ###################################################
2705:
2706: sub initialize_keywords {
2707: return 1 if (scalar keys(%Keywords));
2708: # If we are here, %Keywords is empty, so fill it up
2709: # Make sure the file we need exists...
2710: if (! -e $thesaurus_db_file) {
2711: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2712: " failed because it does not exist");
2713: return 0;
2714: }
2715: # Set up the hash as a database
2716: my %thesaurus_db;
2717: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2718: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2719: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2720: $thesaurus_db_file);
2721: return 0;
2722: }
2723: # Get the average number of appearances of a word.
2724: my $avecount = $thesaurus_db{'average.count'};
2725: # Put keywords (those that appear > average) into %Keywords
2726: while (my ($word,$data)=each (%thesaurus_db)) {
2727: my ($count,undef) = split /:/,$data;
2728: $Keywords{$word}++ if ($count > $avecount);
2729: }
2730: untie %thesaurus_db;
2731: # Remove special values from %Keywords.
1.356 albertel 2732: foreach my $value ('total.count','average.count') {
2733: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2734: }
1.46 matthew 2735: return 1;
2736: }
2737:
2738: ###################################################
2739:
2740: =pod
2741:
1.648 raeburn 2742: =item * &keyword($word)
1.46 matthew 2743:
2744: Returns true if $word is a keyword. A keyword is a word that appears more
2745: than the average number of times in the thesaurus database. Calls
2746: &initialize_keywords
2747:
2748: =cut
2749:
2750: ###################################################
1.20 www 2751:
2752: sub keyword {
1.46 matthew 2753: return if (!&initialize_keywords());
2754: my $word=lc(shift());
2755: $word=~s/\W//g;
2756: return exists($Keywords{$word});
1.20 www 2757: }
1.46 matthew 2758:
2759: ###############################################################
2760:
2761: =pod
1.20 www 2762:
1.648 raeburn 2763: =item * &get_related_words()
1.46 matthew 2764:
1.160 matthew 2765: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 2766: an array of words. If the keyword is not in the thesaurus, an empty array
2767: will be returned. The order of the words returned is determined by the
2768: database which holds them.
2769:
2770: Uses global $thesaurus_db_file.
2771:
2772: =cut
2773:
2774: ###############################################################
2775: sub get_related_words {
2776: my $keyword = shift;
2777: my %thesaurus_db;
2778: if (! -e $thesaurus_db_file) {
2779: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
2780: "failed because the file does not exist");
2781: return ();
2782: }
2783: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2784: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2785: return ();
2786: }
2787: my @Words=();
1.429 www 2788: my $count=0;
1.46 matthew 2789: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 2790: # The first element is the number of times
2791: # the word appears. We do not need it now.
1.429 www 2792: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
2793: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
2794: my $threshold=$mostfrequentcount/10;
2795: foreach my $possibleword (@RelatedWords) {
2796: my ($word,$wordcount)=split(/\,/,$possibleword);
2797: if ($wordcount>$threshold) {
2798: push(@Words,$word);
2799: $count++;
2800: if ($count>10) { last; }
2801: }
1.20 www 2802: }
2803: }
1.46 matthew 2804: untie %thesaurus_db;
2805: return @Words;
1.14 harris41 2806: }
1.46 matthew 2807:
1.112 bowersj2 2808: =pod
2809:
2810: =back
2811:
2812: =cut
1.61 www 2813:
2814: # -------------------------------------------------------------- Plaintext name
1.81 albertel 2815: =pod
2816:
1.112 bowersj2 2817: =head1 User Name Functions
2818:
2819: =over 4
2820:
1.648 raeburn 2821: =item * &plainname($uname,$udom,$first)
1.81 albertel 2822:
1.112 bowersj2 2823: Takes a users logon name and returns it as a string in
1.226 albertel 2824: "first middle last generation" form
2825: if $first is set to 'lastname' then it returns it as
2826: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 2827:
2828: =cut
1.61 www 2829:
1.295 www 2830:
1.81 albertel 2831: ###############################################################
1.61 www 2832: sub plainname {
1.226 albertel 2833: my ($uname,$udom,$first)=@_;
1.537 albertel 2834: return if (!defined($uname) || !defined($udom));
1.295 www 2835: my %names=&getnames($uname,$udom);
1.226 albertel 2836: my $name=&Apache::lonnet::format_name($names{'firstname'},
2837: $names{'middlename'},
2838: $names{'lastname'},
2839: $names{'generation'},$first);
2840: $name=~s/^\s+//;
1.62 www 2841: $name=~s/\s+$//;
2842: $name=~s/\s+/ /g;
1.353 albertel 2843: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 2844: return $name;
1.61 www 2845: }
1.66 www 2846:
2847: # -------------------------------------------------------------------- Nickname
1.81 albertel 2848: =pod
2849:
1.648 raeburn 2850: =item * &nickname($uname,$udom)
1.81 albertel 2851:
2852: Gets a users name and returns it as a string as
2853:
2854: ""nickname""
1.66 www 2855:
1.81 albertel 2856: if the user has a nickname or
2857:
2858: "first middle last generation"
2859:
2860: if the user does not
2861:
2862: =cut
1.66 www 2863:
2864: sub nickname {
2865: my ($uname,$udom)=@_;
1.537 albertel 2866: return if (!defined($uname) || !defined($udom));
1.295 www 2867: my %names=&getnames($uname,$udom);
1.68 albertel 2868: my $name=$names{'nickname'};
1.66 www 2869: if ($name) {
2870: $name='"'.$name.'"';
2871: } else {
2872: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
2873: $names{'lastname'}.' '.$names{'generation'};
2874: $name=~s/\s+$//;
2875: $name=~s/\s+/ /g;
2876: }
2877: return $name;
2878: }
2879:
1.295 www 2880: sub getnames {
2881: my ($uname,$udom)=@_;
1.537 albertel 2882: return if (!defined($uname) || !defined($udom));
1.433 albertel 2883: if ($udom eq 'public' && $uname eq 'public') {
2884: return ('lastname' => &mt('Public'));
2885: }
1.295 www 2886: my $id=$uname.':'.$udom;
2887: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
2888: if ($cached) {
2889: return %{$names};
2890: } else {
2891: my %loadnames=&Apache::lonnet::get('environment',
2892: ['firstname','middlename','lastname','generation','nickname'],
2893: $udom,$uname);
2894: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
2895: return %loadnames;
2896: }
2897: }
1.61 www 2898:
1.542 raeburn 2899: # -------------------------------------------------------------------- getemails
1.648 raeburn 2900:
1.542 raeburn 2901: =pod
2902:
1.648 raeburn 2903: =item * &getemails($uname,$udom)
1.542 raeburn 2904:
2905: Gets a user's email information and returns it as a hash with keys:
2906: notification, critnotification, permanentemail
2907:
2908: For notification and critnotification, values are comma-separated lists
1.648 raeburn 2909: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 2910:
1.648 raeburn 2911:
1.542 raeburn 2912: =cut
2913:
1.648 raeburn 2914:
1.466 albertel 2915: sub getemails {
2916: my ($uname,$udom)=@_;
2917: if ($udom eq 'public' && $uname eq 'public') {
2918: return;
2919: }
1.467 www 2920: if (!$udom) { $udom=$env{'user.domain'}; }
2921: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 2922: my $id=$uname.':'.$udom;
2923: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
2924: if ($cached) {
2925: return %{$names};
2926: } else {
2927: my %loadnames=&Apache::lonnet::get('environment',
2928: ['notification','critnotification',
2929: 'permanentemail'],
2930: $udom,$uname);
2931: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
2932: return %loadnames;
2933: }
2934: }
2935:
1.551 albertel 2936: sub flush_email_cache {
2937: my ($uname,$udom)=@_;
2938: if (!$udom) { $udom =$env{'user.domain'}; }
2939: if (!$uname) { $uname=$env{'user.name'}; }
2940: return if ($udom eq 'public' && $uname eq 'public');
2941: my $id=$uname.':'.$udom;
2942: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
2943: }
2944:
1.728 raeburn 2945: # -------------------------------------------------------------------- getlangs
2946:
2947: =pod
2948:
2949: =item * &getlangs($uname,$udom)
2950:
2951: Gets a user's language preference and returns it as a hash with key:
2952: language.
2953:
2954: =cut
2955:
2956:
2957: sub getlangs {
2958: my ($uname,$udom) = @_;
2959: if (!$udom) { $udom =$env{'user.domain'}; }
2960: if (!$uname) { $uname=$env{'user.name'}; }
2961: my $id=$uname.':'.$udom;
2962: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
2963: if ($cached) {
2964: return %{$langs};
2965: } else {
2966: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
2967: $udom,$uname);
2968: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
2969: return %loadlangs;
2970: }
2971: }
2972:
2973: sub flush_langs_cache {
2974: my ($uname,$udom)=@_;
2975: if (!$udom) { $udom =$env{'user.domain'}; }
2976: if (!$uname) { $uname=$env{'user.name'}; }
2977: return if ($udom eq 'public' && $uname eq 'public');
2978: my $id=$uname.':'.$udom;
2979: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
2980: }
2981:
1.61 www 2982: # ------------------------------------------------------------------ Screenname
1.81 albertel 2983:
2984: =pod
2985:
1.648 raeburn 2986: =item * &screenname($uname,$udom)
1.81 albertel 2987:
2988: Gets a users screenname and returns it as a string
2989:
2990: =cut
1.61 www 2991:
2992: sub screenname {
2993: my ($uname,$udom)=@_;
1.258 albertel 2994: if ($uname eq $env{'user.name'} &&
2995: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 2996: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 2997: return $names{'screenname'};
1.62 www 2998: }
2999:
1.212 albertel 3000:
1.802 bisitz 3001: # ------------------------------------------------------------- Confirm Wrapper
3002: =pod
3003:
3004: =item confirmwrapper
3005:
3006: Wrap messages about completion of operation in box
3007:
3008: =cut
3009:
3010: sub confirmwrapper {
3011: my ($message)=@_;
3012: if ($message) {
3013: return "\n".'<div class="LC_confirm_box">'."\n"
3014: .$message."\n"
3015: .'</div>'."\n";
3016: } else {
3017: return $message;
3018: }
3019: }
3020:
1.62 www 3021: # ------------------------------------------------------------- Message Wrapper
3022:
3023: sub messagewrapper {
1.369 www 3024: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3025: return
1.441 albertel 3026: '<a href="/adm/email?compose=individual&'.
3027: 'recname='.$username.'&recdom='.$domain.
3028: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3029: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3030: }
1.802 bisitz 3031:
1.74 www 3032: # --------------------------------------------------------------- Notes Wrapper
3033:
3034: sub noteswrapper {
3035: my ($link,$un,$do)=@_;
3036: return
1.896 amueller 3037: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3038: }
1.802 bisitz 3039:
1.62 www 3040: # ------------------------------------------------------------- Aboutme Wrapper
3041:
3042: sub aboutmewrapper {
1.166 www 3043: my ($link,$username,$domain,$target)=@_;
1.447 raeburn 3044: if (!defined($username) && !defined($domain)) {
3045: return;
3046: }
1.892 amueller 3047: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.756 weissno 3048: ($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3049: }
3050:
3051: # ------------------------------------------------------------ Syllabus Wrapper
3052:
3053: sub syllabuswrapper {
1.707 bisitz 3054: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3055: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3056: }
1.14 harris41 3057:
1.802 bisitz 3058: # -----------------------------------------------------------------------------
3059:
1.208 matthew 3060: sub track_student_link {
1.887 raeburn 3061: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3062: my $link ="/adm/trackstudent?";
1.208 matthew 3063: my $title = 'View recent activity';
3064: if (defined($sname) && $sname !~ /^\s*$/ &&
3065: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3066: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3067: $title .= ' of this student';
1.268 albertel 3068: }
1.208 matthew 3069: if (defined($target) && $target !~ /^\s*$/) {
3070: $target = qq{target="$target"};
3071: } else {
3072: $target = '';
3073: }
1.268 albertel 3074: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3075: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3076: $title = &mt($title);
3077: $linktext = &mt($linktext);
1.448 albertel 3078: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3079: &help_open_topic('View_recent_activity');
1.208 matthew 3080: }
3081:
1.781 raeburn 3082: sub slot_reservations_link {
3083: my ($linktext,$sname,$sdom,$target) = @_;
3084: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3085: my $title = 'View slot reservation history';
3086: if (defined($sname) && $sname !~ /^\s*$/ &&
3087: defined($sdom) && $sdom !~ /^\s*$/) {
3088: $link .= "&uname=$sname&udom=$sdom";
3089: $title .= ' of this student';
3090: }
3091: if (defined($target) && $target !~ /^\s*$/) {
3092: $target = qq{target="$target"};
3093: } else {
3094: $target = '';
3095: }
3096: $title = &mt($title);
3097: $linktext = &mt($linktext);
3098: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3099: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3100:
3101: }
3102:
1.508 www 3103: # ===================================================== Display a student photo
3104:
3105:
1.509 albertel 3106: sub student_image_tag {
1.508 www 3107: my ($domain,$user)=@_;
3108: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3109: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3110: return '<img src="'.$imgsrc.'" align="right" />';
3111: } else {
3112: return '';
3113: }
3114: }
3115:
1.112 bowersj2 3116: =pod
3117:
3118: =back
3119:
3120: =head1 Access .tab File Data
3121:
3122: =over 4
3123:
1.648 raeburn 3124: =item * &languageids()
1.112 bowersj2 3125:
3126: returns list of all language ids
3127:
3128: =cut
3129:
1.14 harris41 3130: sub languageids {
1.16 harris41 3131: return sort(keys(%language));
1.14 harris41 3132: }
3133:
1.112 bowersj2 3134: =pod
3135:
1.648 raeburn 3136: =item * &languagedescription()
1.112 bowersj2 3137:
3138: returns description of a specified language id
3139:
3140: =cut
3141:
1.14 harris41 3142: sub languagedescription {
1.125 www 3143: my $code=shift;
3144: return ($supported_language{$code}?'* ':'').
3145: $language{$code}.
1.126 www 3146: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3147: }
3148:
3149: sub plainlanguagedescription {
3150: my $code=shift;
3151: return $language{$code};
3152: }
3153:
3154: sub supportedlanguagecode {
3155: my $code=shift;
3156: return $supported_language{$code};
1.97 www 3157: }
3158:
1.112 bowersj2 3159: =pod
3160:
1.648 raeburn 3161: =item * ©rightids()
1.112 bowersj2 3162:
3163: returns list of all copyrights
3164:
3165: =cut
3166:
3167: sub copyrightids {
3168: return sort(keys(%cprtag));
3169: }
3170:
3171: =pod
3172:
1.648 raeburn 3173: =item * ©rightdescription()
1.112 bowersj2 3174:
3175: returns description of a specified copyright id
3176:
3177: =cut
3178:
3179: sub copyrightdescription {
1.166 www 3180: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3181: }
1.197 matthew 3182:
3183: =pod
3184:
1.648 raeburn 3185: =item * &source_copyrightids()
1.192 taceyjo1 3186:
3187: returns list of all source copyrights
3188:
3189: =cut
3190:
3191: sub source_copyrightids {
3192: return sort(keys(%scprtag));
3193: }
3194:
3195: =pod
3196:
1.648 raeburn 3197: =item * &source_copyrightdescription()
1.192 taceyjo1 3198:
3199: returns description of a specified source copyright id
3200:
3201: =cut
3202:
3203: sub source_copyrightdescription {
3204: return &mt($scprtag{shift(@_)});
3205: }
1.112 bowersj2 3206:
3207: =pod
3208:
1.648 raeburn 3209: =item * &filecategories()
1.112 bowersj2 3210:
3211: returns list of all file categories
3212:
3213: =cut
3214:
3215: sub filecategories {
3216: return sort(keys(%category_extensions));
3217: }
3218:
3219: =pod
3220:
1.648 raeburn 3221: =item * &filecategorytypes()
1.112 bowersj2 3222:
3223: returns list of file types belonging to a given file
3224: category
3225:
3226: =cut
3227:
3228: sub filecategorytypes {
1.356 albertel 3229: my ($cat) = @_;
3230: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3231: }
3232:
3233: =pod
3234:
1.648 raeburn 3235: =item * &fileembstyle()
1.112 bowersj2 3236:
3237: returns embedding style for a specified file type
3238:
3239: =cut
3240:
3241: sub fileembstyle {
3242: return $fe{lc(shift(@_))};
1.169 www 3243: }
3244:
1.351 www 3245: sub filemimetype {
3246: return $fm{lc(shift(@_))};
3247: }
3248:
1.169 www 3249:
3250: sub filecategoryselect {
3251: my ($name,$value)=@_;
1.189 matthew 3252: return &select_form($value,$name,
1.169 www 3253: '' => &mt('Any category'),
3254: map { $_,$_ } sort(keys(%category_extensions)));
1.112 bowersj2 3255: }
3256:
3257: =pod
3258:
1.648 raeburn 3259: =item * &filedescription()
1.112 bowersj2 3260:
3261: returns description for a specified file type
3262:
3263: =cut
3264:
3265: sub filedescription {
1.188 matthew 3266: my $file_description = $fd{lc(shift())};
3267: $file_description =~ s:([\[\]]):~$1:g;
3268: return &mt($file_description);
1.112 bowersj2 3269: }
3270:
3271: =pod
3272:
1.648 raeburn 3273: =item * &filedescriptionex()
1.112 bowersj2 3274:
3275: returns description for a specified file type with
3276: extra formatting
3277:
3278: =cut
3279:
3280: sub filedescriptionex {
3281: my $ex=shift;
1.188 matthew 3282: my $file_description = $fd{lc($ex)};
3283: $file_description =~ s:([\[\]]):~$1:g;
3284: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3285: }
3286:
3287: # End of .tab access
3288: =pod
3289:
3290: =back
3291:
3292: =cut
3293:
3294: # ------------------------------------------------------------------ File Types
3295: sub fileextensions {
3296: return sort(keys(%fe));
3297: }
3298:
1.97 www 3299: # ----------------------------------------------------------- Display Languages
3300: # returns a hash with all desired display languages
3301: #
3302:
3303: sub display_languages {
3304: my %languages=();
1.695 raeburn 3305: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3306: $languages{$lang}=1;
1.97 www 3307: }
3308: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3309: if ($env{'form.displaylanguage'}) {
1.356 albertel 3310: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3311: $languages{$lang}=1;
1.97 www 3312: }
3313: }
3314: return %languages;
1.14 harris41 3315: }
3316:
1.582 albertel 3317: sub languages {
3318: my ($possible_langs) = @_;
1.695 raeburn 3319: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3320: if (!ref($possible_langs)) {
3321: if( wantarray ) {
3322: return @preferred_langs;
3323: } else {
3324: return $preferred_langs[0];
3325: }
3326: }
3327: my %possibilities = map { $_ => 1 } (@$possible_langs);
3328: my @preferred_possibilities;
3329: foreach my $preferred_lang (@preferred_langs) {
3330: if (exists($possibilities{$preferred_lang})) {
3331: push(@preferred_possibilities, $preferred_lang);
3332: }
3333: }
3334: if( wantarray ) {
3335: return @preferred_possibilities;
3336: }
3337: return $preferred_possibilities[0];
3338: }
3339:
1.742 raeburn 3340: sub user_lang {
3341: my ($touname,$toudom,$fromcid) = @_;
3342: my @userlangs;
3343: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3344: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3345: $env{'course.'.$fromcid.'.languages'}));
3346: } else {
3347: my %langhash = &getlangs($touname,$toudom);
3348: if ($langhash{'languages'} ne '') {
3349: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3350: } else {
3351: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3352: if ($domdefs{'lang_def'} ne '') {
3353: @userlangs = ($domdefs{'lang_def'});
3354: }
3355: }
3356: }
3357: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3358: my $user_lh = Apache::localize->get_handle(@languages);
3359: return $user_lh;
3360: }
3361:
3362:
1.112 bowersj2 3363: ###############################################################
3364: ## Student Answer Attempts ##
3365: ###############################################################
3366:
3367: =pod
3368:
3369: =head1 Alternate Problem Views
3370:
3371: =over 4
3372:
1.648 raeburn 3373: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3374: $getattempt, $regexp, $gradesub)
3375:
3376: Return string with previous attempt on problem. Arguments:
3377:
3378: =over 4
3379:
3380: =item * $symb: Problem, including path
3381:
3382: =item * $username: username of the desired student
3383:
3384: =item * $domain: domain of the desired student
1.14 harris41 3385:
1.112 bowersj2 3386: =item * $course: Course ID
1.14 harris41 3387:
1.112 bowersj2 3388: =item * $getattempt: Leave blank for all attempts, otherwise put
3389: something
1.14 harris41 3390:
1.112 bowersj2 3391: =item * $regexp: if string matches this regexp, the string will be
3392: sent to $gradesub
1.14 harris41 3393:
1.112 bowersj2 3394: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3395:
1.112 bowersj2 3396: =back
1.14 harris41 3397:
1.112 bowersj2 3398: The output string is a table containing all desired attempts, if any.
1.16 harris41 3399:
1.112 bowersj2 3400: =cut
1.1 albertel 3401:
3402: sub get_previous_attempt {
1.43 ng 3403: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3404: my $prevattempts='';
1.43 ng 3405: no strict 'refs';
1.1 albertel 3406: if ($symb) {
1.3 albertel 3407: my (%returnhash)=
3408: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3409: if ($returnhash{'version'}) {
3410: my %lasthash=();
3411: my $version;
3412: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3413: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3414: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3415: }
1.1 albertel 3416: }
1.596 albertel 3417: $prevattempts=&start_data_table().&start_data_table_header_row();
3418: $prevattempts.='<th>'.&mt('History').'</th>';
1.356 albertel 3419: foreach my $key (sort(keys(%lasthash))) {
3420: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3421: if ($#parts > 0) {
1.31 albertel 3422: my $data=$parts[-1];
3423: pop(@parts);
1.596 albertel 3424: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.31 albertel 3425: } else {
1.41 ng 3426: if ($#parts == 0) {
3427: $prevattempts.='<th>'.$parts[0].'</th>';
3428: } else {
3429: $prevattempts.='<th>'.$ign.'</th>';
3430: }
1.31 albertel 3431: }
1.16 harris41 3432: }
1.596 albertel 3433: $prevattempts.=&end_data_table_header_row();
1.40 ng 3434: if ($getattempt eq '') {
3435: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.596 albertel 3436: $prevattempts.=&start_data_table_row().
3437: '<td>'.&mt('Transaction [_1]',$version).'</td>';
1.356 albertel 3438: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3439: my $value = &format_previous_attempt_value($key,
3440: $returnhash{$version.':'.$key});
3441: $prevattempts.='<td>'.$value.' </td>';
1.40 ng 3442: }
1.596 albertel 3443: $prevattempts.=&end_data_table_row();
1.40 ng 3444: }
1.1 albertel 3445: }
1.596 albertel 3446: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3447: foreach my $key (sort(keys(%lasthash))) {
1.581 albertel 3448: my $value = &format_previous_attempt_value($key,$lasthash{$key});
1.356 albertel 3449: if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 3450: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 3451: }
1.596 albertel 3452: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3453: } else {
1.596 albertel 3454: $prevattempts=
3455: &start_data_table().&start_data_table_row().
3456: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3457: &end_data_table_row().&end_data_table();
1.1 albertel 3458: }
3459: } else {
1.596 albertel 3460: $prevattempts=
3461: &start_data_table().&start_data_table_row().
3462: '<td>'.&mt('No data.').'</td>'.
3463: &end_data_table_row().&end_data_table();
1.1 albertel 3464: }
1.10 albertel 3465: }
3466:
1.581 albertel 3467: sub format_previous_attempt_value {
3468: my ($key,$value) = @_;
3469: if ($key =~ /timestamp/) {
3470: $value = &Apache::lonlocal::locallocaltime($value);
3471: } elsif (ref($value) eq 'ARRAY') {
3472: $value = '('.join(', ', @{ $value }).')';
3473: } else {
3474: $value = &unescape($value);
3475: }
3476: return $value;
3477: }
3478:
3479:
1.107 albertel 3480: sub relative_to_absolute {
3481: my ($url,$output)=@_;
3482: my $parser=HTML::TokeParser->new(\$output);
3483: my $token;
3484: my $thisdir=$url;
3485: my @rlinks=();
3486: while ($token=$parser->get_token) {
3487: if ($token->[0] eq 'S') {
3488: if ($token->[1] eq 'a') {
3489: if ($token->[2]->{'href'}) {
3490: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3491: }
3492: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3493: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3494: } elsif ($token->[1] eq 'base') {
3495: $thisdir=$token->[2]->{'href'};
3496: }
3497: }
3498: }
3499: $thisdir=~s-/[^/]*$--;
1.356 albertel 3500: foreach my $link (@rlinks) {
1.726 raeburn 3501: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3502: ($link=~/^\//) ||
3503: ($link=~/^javascript:/i) ||
3504: ($link=~/^mailto:/i) ||
3505: ($link=~/^\#/)) {
3506: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3507: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3508: }
3509: }
3510: # -------------------------------------------------- Deal with Applet codebases
3511: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3512: return $output;
3513: }
3514:
1.112 bowersj2 3515: =pod
3516:
1.648 raeburn 3517: =item * &get_student_view()
1.112 bowersj2 3518:
3519: show a snapshot of what student was looking at
3520:
3521: =cut
3522:
1.10 albertel 3523: sub get_student_view {
1.186 albertel 3524: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3525: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3526: my (%form);
1.10 albertel 3527: my @elements=('symb','courseid','domain','username');
3528: foreach my $element (@elements) {
1.186 albertel 3529: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3530: }
1.186 albertel 3531: if (defined($moreenv)) {
3532: %form=(%form,%{$moreenv});
3533: }
1.236 albertel 3534: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3535: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3536: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3537: $userview=~s/\<body[^\>]*\>//gi;
3538: $userview=~s/\<\/body\>//gi;
3539: $userview=~s/\<html\>//gi;
3540: $userview=~s/\<\/html\>//gi;
3541: $userview=~s/\<head\>//gi;
3542: $userview=~s/\<\/head\>//gi;
3543: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 3544: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 3545: if (wantarray) {
3546: return ($userview,$response);
3547: } else {
3548: return $userview;
3549: }
3550: }
3551:
3552: sub get_student_view_with_retries {
3553: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
3554:
3555: my $ok = 0; # True if we got a good response.
3556: my $content;
3557: my $response;
3558:
3559: # Try to get the student_view done. within the retries count:
3560:
3561: do {
3562: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
3563: $ok = $response->is_success;
3564: if (!$ok) {
3565: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
3566: }
3567: $retries--;
3568: } while (!$ok && ($retries > 0));
3569:
3570: if (!$ok) {
3571: $content = ''; # On error return an empty content.
3572: }
1.651 www 3573: if (wantarray) {
3574: return ($content, $response);
3575: } else {
3576: return $content;
3577: }
1.11 albertel 3578: }
3579:
1.112 bowersj2 3580: =pod
3581:
1.648 raeburn 3582: =item * &get_student_answers()
1.112 bowersj2 3583:
3584: show a snapshot of how student was answering problem
3585:
3586: =cut
3587:
1.11 albertel 3588: sub get_student_answers {
1.100 sakharuk 3589: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 3590: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3591: my (%moreenv);
1.11 albertel 3592: my @elements=('symb','courseid','domain','username');
3593: foreach my $element (@elements) {
1.186 albertel 3594: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3595: }
1.186 albertel 3596: $moreenv{'grade_target'}='answer';
3597: %moreenv=(%form,%moreenv);
1.497 raeburn 3598: $feedurl = &Apache::lonnet::clutter($feedurl);
3599: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 3600: return $userview;
1.1 albertel 3601: }
1.116 albertel 3602:
3603: =pod
3604:
3605: =item * &submlink()
3606:
1.242 albertel 3607: Inputs: $text $uname $udom $symb $target
1.116 albertel 3608:
3609: Returns: A link to grades.pm such as to see the SUBM view of a student
3610:
3611: =cut
3612:
3613: ###############################################
3614: sub submlink {
1.242 albertel 3615: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 3616: if (!($uname && $udom)) {
3617: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3618: &Apache::lonnet::whichuser($symb);
1.116 albertel 3619: if (!$symb) { $symb=$cursymb; }
3620: }
1.254 matthew 3621: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3622: $symb=&escape($symb);
1.242 albertel 3623: if ($target) { $target="target=\"$target\""; }
3624: return '<a href="/adm/grades?&command=submission&'.
3625: 'symb='.$symb.'&student='.$uname.
3626: '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
3627: }
3628: ##############################################
3629:
3630: =pod
3631:
3632: =item * &pgrdlink()
3633:
3634: Inputs: $text $uname $udom $symb $target
3635:
3636: Returns: A link to grades.pm such as to see the PGRD view of a student
3637:
3638: =cut
3639:
3640: ###############################################
3641: sub pgrdlink {
3642: my $link=&submlink(@_);
3643: $link=~s/(&command=submission)/$1&showgrading=yes/;
3644: return $link;
3645: }
3646: ##############################################
3647:
3648: =pod
3649:
3650: =item * &pprmlink()
3651:
3652: Inputs: $text $uname $udom $symb $target
3653:
3654: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 3655: student and a specific resource
1.242 albertel 3656:
3657: =cut
3658:
3659: ###############################################
3660: sub pprmlink {
3661: my ($text,$uname,$udom,$symb,$target)=@_;
3662: if (!($uname && $udom)) {
3663: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 3664: &Apache::lonnet::whichuser($symb);
1.242 albertel 3665: if (!$symb) { $symb=$cursymb; }
3666: }
1.254 matthew 3667: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 3668: $symb=&escape($symb);
1.242 albertel 3669: if ($target) { $target="target=\"$target\""; }
1.595 albertel 3670: return '<a href="/adm/parmset?command=set&'.
3671: 'symb='.$symb.'&uname='.$uname.
3672: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 3673: }
3674: ##############################################
1.37 matthew 3675:
1.112 bowersj2 3676: =pod
3677:
3678: =back
3679:
3680: =cut
3681:
1.37 matthew 3682: ###############################################
1.51 www 3683:
3684:
3685: sub timehash {
1.687 raeburn 3686: my ($thistime) = @_;
3687: my $timezone = &Apache::lonlocal::gettimezone();
3688: my $dt = DateTime->from_epoch(epoch => $thistime)
3689: ->set_time_zone($timezone);
3690: my $wday = $dt->day_of_week();
3691: if ($wday == 7) { $wday = 0; }
3692: return ( 'second' => $dt->second(),
3693: 'minute' => $dt->minute(),
3694: 'hour' => $dt->hour(),
3695: 'day' => $dt->day_of_month(),
3696: 'month' => $dt->month(),
3697: 'year' => $dt->year(),
3698: 'weekday' => $wday,
3699: 'dayyear' => $dt->day_of_year(),
3700: 'dlsav' => $dt->is_dst() );
1.51 www 3701: }
3702:
1.370 www 3703: sub utc_string {
3704: my ($date)=@_;
1.371 www 3705: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 3706: }
3707:
1.51 www 3708: sub maketime {
3709: my %th=@_;
1.687 raeburn 3710: my ($epoch_time,$timezone,$dt);
3711: $timezone = &Apache::lonlocal::gettimezone();
3712: eval {
3713: $dt = DateTime->new( year => $th{'year'},
3714: month => $th{'month'},
3715: day => $th{'day'},
3716: hour => $th{'hour'},
3717: minute => $th{'minute'},
3718: second => $th{'second'},
3719: time_zone => $timezone,
3720: );
3721: };
3722: if (!$@) {
3723: $epoch_time = $dt->epoch;
3724: if ($epoch_time) {
3725: return $epoch_time;
3726: }
3727: }
1.51 www 3728: return POSIX::mktime(
3729: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 3730: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 3731: }
3732:
3733: #########################################
1.51 www 3734:
3735: sub findallcourses {
1.482 raeburn 3736: my ($roles,$uname,$udom) = @_;
1.355 albertel 3737: my %roles;
3738: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 3739: my %courses;
1.51 www 3740: my $now=time;
1.482 raeburn 3741: if (!defined($uname)) {
3742: $uname = $env{'user.name'};
3743: }
3744: if (!defined($udom)) {
3745: $udom = $env{'user.domain'};
3746: }
3747: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
3748: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
3749: if (!%roles) {
3750: %roles = (
3751: cc => 1,
1.907 raeburn 3752: co => 1,
1.482 raeburn 3753: in => 1,
3754: ep => 1,
3755: ta => 1,
3756: cr => 1,
3757: st => 1,
3758: );
3759: }
3760: foreach my $entry (keys(%roleshash)) {
3761: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
3762: if ($trole =~ /^cr/) {
3763: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
3764: } else {
3765: next if (!exists($roles{$trole}));
3766: }
3767: if ($tend) {
3768: next if ($tend < $now);
3769: }
3770: if ($tstart) {
3771: next if ($tstart > $now);
3772: }
3773: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
3774: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
3775: if ($secpart eq '') {
3776: ($cnum,$role) = split(/_/,$cnumpart);
3777: $sec = 'none';
3778: $realsec = '';
3779: } else {
3780: $cnum = $cnumpart;
3781: ($sec,$role) = split(/_/,$secpart);
3782: $realsec = $sec;
1.490 raeburn 3783: }
1.482 raeburn 3784: $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
3785: }
3786: } else {
3787: foreach my $key (keys(%env)) {
1.483 albertel 3788: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
3789: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 3790: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
3791: next if ($role eq 'ca' || $role eq 'aa');
3792: next if (%roles && !exists($roles{$role}));
3793: my ($starttime,$endtime)=split(/\./,$env{$key});
3794: my $active=1;
3795: if ($starttime) {
3796: if ($now<$starttime) { $active=0; }
3797: }
3798: if ($endtime) {
3799: if ($now>$endtime) { $active=0; }
3800: }
3801: if ($active) {
3802: if ($sec eq '') {
3803: $sec = 'none';
3804: }
3805: $courses{$cdom.'_'.$cnum}{$sec} =
3806: $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
1.474 raeburn 3807: }
3808: }
1.51 www 3809: }
3810: }
1.474 raeburn 3811: return %courses;
1.51 www 3812: }
1.37 matthew 3813:
1.54 www 3814: ###############################################
1.474 raeburn 3815:
3816: sub blockcheck {
1.482 raeburn 3817: my ($setters,$activity,$uname,$udom) = @_;
1.490 raeburn 3818:
3819: if (!defined($udom)) {
3820: $udom = $env{'user.domain'};
3821: }
3822: if (!defined($uname)) {
3823: $uname = $env{'user.name'};
3824: }
3825:
3826: # If uname and udom are for a course, check for blocks in the course.
3827:
3828: if (&Apache::lonnet::is_course($udom,$uname)) {
3829: my %records = &Apache::lonnet::dump('comm_block',$udom,$uname);
1.502 raeburn 3830: my ($startblock,$endblock)=&get_blocks($setters,$activity,$udom,$uname);
1.490 raeburn 3831: return ($startblock,$endblock);
3832: }
1.474 raeburn 3833:
1.502 raeburn 3834: my $startblock = 0;
3835: my $endblock = 0;
1.482 raeburn 3836: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 3837:
1.490 raeburn 3838: # If uname is for a user, and activity is course-specific, i.e.,
3839: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 3840:
1.490 raeburn 3841: if (($activity eq 'boards' || $activity eq 'chat' ||
3842: $activity eq 'groups') && ($env{'request.course.id'})) {
3843: foreach my $key (keys(%live_courses)) {
3844: if ($key ne $env{'request.course.id'}) {
3845: delete($live_courses{$key});
3846: }
3847: }
3848: }
3849:
3850: my $otheruser = 0;
3851: my %own_courses;
3852: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
3853: # Resource belongs to user other than current user.
3854: $otheruser = 1;
3855: # Gather courses for current user
3856: %own_courses =
3857: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
3858: }
3859:
3860: # Gather active course roles - course coordinator, instructor,
3861: # exam proctor, ta, student, or custom role.
1.474 raeburn 3862:
3863: foreach my $course (keys(%live_courses)) {
1.482 raeburn 3864: my ($cdom,$cnum);
3865: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
3866: $cdom = $env{'course.'.$course.'.domain'};
3867: $cnum = $env{'course.'.$course.'.num'};
3868: } else {
1.490 raeburn 3869: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 3870: }
3871: my $no_ownblock = 0;
3872: my $no_userblock = 0;
1.533 raeburn 3873: if ($otheruser && $activity ne 'com') {
1.490 raeburn 3874: # Check if current user has 'evb' priv for this
3875: if (defined($own_courses{$course})) {
3876: foreach my $sec (keys(%{$own_courses{$course}})) {
3877: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
3878: if ($sec ne 'none') {
3879: $checkrole .= '/'.$sec;
3880: }
3881: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3882: $no_ownblock = 1;
3883: last;
3884: }
3885: }
3886: }
3887: # if they have 'evb' priv and are currently not playing student
3888: next if (($no_ownblock) &&
3889: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
3890: }
1.474 raeburn 3891: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 3892: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 3893: if ($sec ne 'none') {
1.482 raeburn 3894: $checkrole .= '/'.$sec;
1.474 raeburn 3895: }
1.490 raeburn 3896: if ($otheruser) {
3897: # Resource belongs to user other than current user.
3898: # Assemble privs for that user, and check for 'evb' priv.
1.482 raeburn 3899: my ($trole,$tdom,$tnum,$tsec);
3900: my $entry = $live_courses{$course}{$sec};
3901: if ($entry =~ /^cr/) {
3902: ($trole,$tdom,$tnum,$tsec) =
3903: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
3904: } else {
3905: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
3906: }
3907: my ($spec,$area,$trest,%allroles,%userroles);
3908: $area = '/'.$tdom.'/'.$tnum;
3909: $trest = $tnum;
3910: if ($tsec ne '') {
3911: $area .= '/'.$tsec;
3912: $trest .= '/'.$tsec;
3913: }
3914: $spec = $trole.'.'.$area;
3915: if ($trole =~ /^cr/) {
3916: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
3917: $tdom,$spec,$trest,$area);
3918: } else {
3919: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
3920: $tdom,$spec,$trest,$area);
3921: }
3922: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.486 raeburn 3923: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
3924: if ($1) {
3925: $no_userblock = 1;
3926: last;
3927: }
3928: }
1.490 raeburn 3929: } else {
3930: # Resource belongs to current user
3931: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 3932: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
3933: $no_ownblock = 1;
3934: last;
3935: }
1.474 raeburn 3936: }
3937: }
3938: # if they have the evb priv and are currently not playing student
1.482 raeburn 3939: next if (($no_ownblock) &&
1.491 albertel 3940: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 3941: next if ($no_userblock);
1.474 raeburn 3942:
1.866 kalberla 3943: # Retrieve blocking times and identity of locker for course
1.490 raeburn 3944: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 3945:
3946: my ($start,$end)=&get_blocks($setters,$activity,$cdom,$cnum);
3947: if (($start != 0) &&
3948: (($startblock == 0) || ($startblock > $start))) {
3949: $startblock = $start;
3950: }
3951: if (($end != 0) &&
3952: (($endblock == 0) || ($endblock < $end))) {
3953: $endblock = $end;
3954: }
1.490 raeburn 3955: }
3956: return ($startblock,$endblock);
3957: }
3958:
3959: sub get_blocks {
3960: my ($setters,$activity,$cdom,$cnum) = @_;
3961: my $startblock = 0;
3962: my $endblock = 0;
3963: my $course = $cdom.'_'.$cnum;
3964: $setters->{$course} = {};
3965: $setters->{$course}{'staff'} = [];
3966: $setters->{$course}{'times'} = [];
3967: my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
3968: foreach my $record (keys(%records)) {
3969: my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
3970: if ($start <= time && $end >= time) {
3971: my ($staff_name,$staff_dom,$title,$blocks) =
3972: &parse_block_record($records{$record});
3973: if ($blocks->{$activity} eq 'on') {
3974: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
3975: push(@{$$setters{$course}{'times'}}, [$start,$end]);
1.491 albertel 3976: if ( ($startblock == 0) || ($startblock > $start) ) {
3977: $startblock = $start;
1.490 raeburn 3978: }
1.491 albertel 3979: if ( ($endblock == 0) || ($endblock < $end) ) {
3980: $endblock = $end;
1.474 raeburn 3981: }
3982: }
3983: }
3984: }
3985: return ($startblock,$endblock);
3986: }
3987:
3988: sub parse_block_record {
3989: my ($record) = @_;
3990: my ($setuname,$setudom,$title,$blocks);
3991: if (ref($record) eq 'HASH') {
3992: ($setuname,$setudom) = split(/:/,$record->{'setter'});
3993: $title = &unescape($record->{'event'});
3994: $blocks = $record->{'blocks'};
3995: } else {
3996: my @data = split(/:/,$record,3);
3997: if (scalar(@data) eq 2) {
3998: $title = $data[1];
3999: ($setuname,$setudom) = split(/@/,$data[0]);
4000: } else {
4001: ($setuname,$setudom,$title) = @data;
4002: }
4003: $blocks = { 'com' => 'on' };
4004: }
4005: return ($setuname,$setudom,$title,$blocks);
4006: }
4007:
1.854 kalberla 4008: sub blocking_status {
4009: my ($activity,$uname,$udom) = @_;
1.867 kalberla 4010: my %setters;
1.890 droeschl 4011:
4012: # check for active blocking
1.867 kalberla 4013: my ($startblock,$endblock)=&blockcheck(\%setters,$activity,$uname,$udom);
1.854 kalberla 4014:
1.890 droeschl 4015: my $blocked = $startblock && $endblock ? 1 : 0;
4016:
4017: # caller just wants to know whether a block is active
4018: if (!wantarray) { return $blocked; }
4019:
4020: # build a link to a popup window containing the details
4021: my $querystring = "?activity=$activity";
4022: # $uname and $udom decide whose portfolio the user is trying to look at
4023: $querystring .= "&udom=$udom" if $udom;
4024: $querystring .= "&uname=$uname" if $uname;
4025:
4026: my $output .= <<'END_MYBLOCK';
1.854 kalberla 4027: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4028: var options = "width=" + w + ",height=" + h + ",";
4029: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4030: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4031: var newWin = window.open(url, wdwName, options);
4032: newWin.focus();
4033: }
1.890 droeschl 4034: END_MYBLOCK
1.854 kalberla 4035:
1.890 droeschl 4036: $output = Apache::lonhtmlcommon::scripttag($output);
4037:
1.854 kalberla 4038: my $popupUrl = "/adm/blockingstatus/$querystring";
1.890 droeschl 4039: my $text = mt('Communication Blocked');
4040:
1.867 kalberla 4041: $output .= <<"END_BLOCK";
4042: <div class='LC_comblock'>
1.869 kalberla 4043: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4044: title='$text'>
4045: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4046: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4047: title='$text'>$text</a>
1.867 kalberla 4048: </div>
4049:
4050: END_BLOCK
1.474 raeburn 4051:
1.854 kalberla 4052: return ($blocked, $output);
4053: }
1.490 raeburn 4054:
1.60 matthew 4055: ###############################################
4056:
1.682 raeburn 4057: sub check_ip_acc {
4058: my ($acc)=@_;
4059: &Apache::lonxml::debug("acc is $acc");
4060: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4061: return 1;
4062: }
4063: my $allowed=0;
4064: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4065:
4066: my $name;
4067: foreach my $pattern (split(',',$acc)) {
4068: $pattern =~ s/^\s*//;
4069: $pattern =~ s/\s*$//;
4070: if ($pattern =~ /\*$/) {
4071: #35.8.*
4072: $pattern=~s/\*//;
4073: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4074: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4075: #35.8.3.[34-56]
4076: my $low=$2;
4077: my $high=$3;
4078: $pattern=$1;
4079: if ($ip =~ /^\Q$pattern\E/) {
4080: my $last=(split(/\./,$ip))[3];
4081: if ($last <=$high && $last >=$low) { $allowed=1; }
4082: }
4083: } elsif ($pattern =~ /^\*/) {
4084: #*.msu.edu
4085: $pattern=~s/\*//;
4086: if (!defined($name)) {
4087: use Socket;
4088: my $netaddr=inet_aton($ip);
4089: ($name)=gethostbyaddr($netaddr,AF_INET);
4090: }
4091: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4092: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4093: #127.0.0.1
4094: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4095: } else {
4096: #some.name.com
4097: if (!defined($name)) {
4098: use Socket;
4099: my $netaddr=inet_aton($ip);
4100: ($name)=gethostbyaddr($netaddr,AF_INET);
4101: }
4102: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4103: }
4104: if ($allowed) { last; }
4105: }
4106: return $allowed;
4107: }
4108:
4109: ###############################################
4110:
1.60 matthew 4111: =pod
4112:
1.112 bowersj2 4113: =head1 Domain Template Functions
4114:
4115: =over 4
4116:
4117: =item * &determinedomain()
1.60 matthew 4118:
4119: Inputs: $domain (usually will be undef)
4120:
1.63 www 4121: Returns: Determines which domain should be used for designs
1.60 matthew 4122:
4123: =cut
1.54 www 4124:
1.60 matthew 4125: ###############################################
1.63 www 4126: sub determinedomain {
4127: my $domain=shift;
1.531 albertel 4128: if (! $domain) {
1.60 matthew 4129: # Determine domain if we have not been given one
1.893 raeburn 4130: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4131: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4132: if ($env{'request.role.domain'}) {
4133: $domain=$env{'request.role.domain'};
1.60 matthew 4134: }
4135: }
1.63 www 4136: return $domain;
4137: }
4138: ###############################################
1.517 raeburn 4139:
1.518 albertel 4140: sub devalidate_domconfig_cache {
4141: my ($udom)=@_;
4142: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4143: }
4144:
4145: # ---------------------- Get domain configuration for a domain
4146: sub get_domainconf {
4147: my ($udom) = @_;
4148: my $cachetime=1800;
4149: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4150: if (defined($cached)) { return %{$result}; }
4151:
4152: my %domconfig = &Apache::lonnet::get_dom('configuration',
4153: ['login','rolecolors'],$udom);
1.632 raeburn 4154: my (%designhash,%legacy);
1.518 albertel 4155: if (keys(%domconfig) > 0) {
4156: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4157: if (keys(%{$domconfig{'login'}})) {
4158: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4159: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4160: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4161: $designhash{$udom.'.login.'.$key.'_'.$img} =
4162: $domconfig{'login'}{$key}{$img};
4163: }
4164: } else {
4165: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4166: }
1.632 raeburn 4167: }
4168: } else {
4169: $legacy{'login'} = 1;
1.518 albertel 4170: }
1.632 raeburn 4171: } else {
4172: $legacy{'login'} = 1;
1.518 albertel 4173: }
4174: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4175: if (keys(%{$domconfig{'rolecolors'}})) {
4176: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4177: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4178: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4179: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4180: }
1.518 albertel 4181: }
4182: }
1.632 raeburn 4183: } else {
4184: $legacy{'rolecolors'} = 1;
1.518 albertel 4185: }
1.632 raeburn 4186: } else {
4187: $legacy{'rolecolors'} = 1;
1.518 albertel 4188: }
1.632 raeburn 4189: if (keys(%legacy) > 0) {
4190: my %legacyhash = &get_legacy_domconf($udom);
4191: foreach my $item (keys(%legacyhash)) {
4192: if ($item =~ /^\Q$udom\E\.login/) {
4193: if ($legacy{'login'}) {
4194: $designhash{$item} = $legacyhash{$item};
4195: }
4196: } else {
4197: if ($legacy{'rolecolors'}) {
4198: $designhash{$item} = $legacyhash{$item};
4199: }
1.518 albertel 4200: }
4201: }
4202: }
1.632 raeburn 4203: } else {
4204: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4205: }
4206: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4207: $cachetime);
4208: return %designhash;
4209: }
4210:
1.632 raeburn 4211: sub get_legacy_domconf {
4212: my ($udom) = @_;
4213: my %legacyhash;
4214: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4215: my $designfile = $designdir.'/'.$udom.'.tab';
4216: if (-e $designfile) {
4217: if ( open (my $fh,"<$designfile") ) {
4218: while (my $line = <$fh>) {
4219: next if ($line =~ /^\#/);
4220: chomp($line);
4221: my ($key,$val)=(split(/\=/,$line));
4222: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4223: }
4224: close($fh);
4225: }
4226: }
4227: if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
4228: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4229: }
4230: return %legacyhash;
4231: }
4232:
1.63 www 4233: =pod
4234:
1.112 bowersj2 4235: =item * &domainlogo()
1.63 www 4236:
4237: Inputs: $domain (usually will be undef)
4238:
4239: Returns: A link to a domain logo, if the domain logo exists.
4240: If the domain logo does not exist, a description of the domain.
4241:
4242: =cut
1.112 bowersj2 4243:
1.63 www 4244: ###############################################
4245: sub domainlogo {
1.517 raeburn 4246: my $domain = &determinedomain(shift);
1.518 albertel 4247: my %designhash = &get_domainconf($domain);
1.517 raeburn 4248: # See if there is a logo
4249: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4250: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4251: if ($imgsrc =~ m{^/(adm|res)/}) {
4252: if ($imgsrc =~ m{^/res/}) {
4253: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4254: &Apache::lonnet::repcopy($local_name);
4255: }
4256: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4257: }
4258: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4259: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4260: return &Apache::lonnet::domain($domain,'description');
1.59 www 4261: } else {
1.60 matthew 4262: return '';
1.59 www 4263: }
4264: }
1.63 www 4265: ##############################################
4266:
4267: =pod
4268:
1.112 bowersj2 4269: =item * &designparm()
1.63 www 4270:
4271: Inputs: $which parameter; $domain (usually will be undef)
4272:
4273: Returns: value of designparamter $which
4274:
4275: =cut
1.112 bowersj2 4276:
1.397 albertel 4277:
1.400 albertel 4278: ##############################################
1.397 albertel 4279: sub designparm {
4280: my ($which,$domain)=@_;
4281: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4282: return $env{'environment.color.'.$which};
1.96 www 4283: }
1.63 www 4284: $domain=&determinedomain($domain);
1.518 albertel 4285: my %domdesign = &get_domainconf($domain);
1.520 raeburn 4286: my $output;
1.517 raeburn 4287: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4288: $output = $domdesign{$domain.'.'.$which};
1.63 www 4289: } else {
1.520 raeburn 4290: $output = $defaultdesign{$which};
4291: }
4292: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4293: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4294: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4295: if ($output =~ m{^/res/}) {
4296: my $local_name = &Apache::lonnet::filelocation('',$output);
4297: &Apache::lonnet::repcopy($local_name);
4298: }
1.520 raeburn 4299: $output = &lonhttpdurl($output);
4300: }
1.63 www 4301: }
1.520 raeburn 4302: return $output;
1.63 www 4303: }
1.59 www 4304:
1.822 bisitz 4305: ##############################################
4306: =pod
4307:
1.832 bisitz 4308: =item * &authorspace()
4309:
4310: Inputs: ./.
4311:
4312: Returns: Path to the Construction Space of the current user's
4313: accessed author space
4314: The author space will be that of the current user
4315: when accessing the own author space
4316: and that of the co-author/assistent co-author
4317: when accessing the co-author's/assistent co-author's
4318: space
4319:
4320: =cut
4321:
4322: sub authorspace {
4323: my $caname = '';
4324: if ($env{'request.role'} =~ /^ca|^aa/) {
4325: (undef,$caname) =
4326: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
4327: } else {
4328: $caname = $env{'user.name'};
4329: }
4330: return '/priv/'.$caname.'/';
4331: }
4332:
4333: ##############################################
4334: =pod
4335:
1.822 bisitz 4336: =item * &head_subbox()
4337:
4338: Inputs: $content (contains HTML code with page functions, etc.)
4339:
4340: Returns: HTML div with $content
4341: To be included in page header
4342:
4343: =cut
4344:
4345: sub head_subbox {
4346: my ($content)=@_;
4347: my $output =
1.844 bisitz 4348: '<div id="LC_head_subbox">'
1.822 bisitz 4349: .$content
4350: .'</div>'
4351: }
4352:
4353: ##############################################
4354: =pod
4355:
4356: =item * &CSTR_pageheader()
4357:
4358: Inputs: ./.
4359:
4360: Returns: HTML div with CSTR path and recent box
4361: To be included on Construction Space pages
4362:
4363: =cut
4364:
4365: sub CSTR_pageheader {
4366: # this is for resources; directories have customtitle, and crumbs
4367: # and select recent are created in lonpubdir.pm
4368: my ($uname,$thisdisfn)=
4369: ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
4370: my $formaction='/priv/'.$uname.'/'.$thisdisfn;
4371: $formaction=~s/\/+/\//g;
4372:
4373: my $parentpath = '';
4374: my $lastitem = '';
4375: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
4376: $parentpath = $1;
4377: $lastitem = $2;
4378: } else {
4379: $lastitem = $thisdisfn;
4380: }
1.921 bisitz 4381:
4382: my $output =
1.822 bisitz 4383: '<div>'
4384: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
4385: .'<b>'.&mt('Construction Space:').'</b> '
4386: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 4387: .'" target="_top">' #FIXME lonpubdir: target="_parent"
4388: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef);
4389:
4390: if ($lastitem) {
4391: $output .=
4392: '<span class="LC_filename">'
4393: .$lastitem
4394: .'</span>';
4395: }
4396: $output .=
4397: '<br />'
1.822 bisitz 4398: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
4399: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
4400: .'</form>'
4401: .&Apache::lonmenu::constspaceform()
4402: .'</div>';
1.921 bisitz 4403:
4404: return $output;
1.822 bisitz 4405: }
4406:
1.60 matthew 4407: ###############################################
4408: ###############################################
4409:
4410: =pod
4411:
1.112 bowersj2 4412: =back
4413:
1.549 albertel 4414: =head1 HTML Helpers
1.112 bowersj2 4415:
4416: =over 4
4417:
4418: =item * &bodytag()
1.60 matthew 4419:
4420: Returns a uniform header for LON-CAPA web pages.
4421:
4422: Inputs:
4423:
1.112 bowersj2 4424: =over 4
4425:
4426: =item * $title, A title to be displayed on the page.
4427:
4428: =item * $function, the current role (can be undef).
4429:
4430: =item * $addentries, extra parameters for the <body> tag.
4431:
4432: =item * $bodyonly, if defined, only return the <body> tag.
4433:
4434: =item * $domain, if defined, force a given domain.
4435:
4436: =item * $forcereg, if page should register as content page (relevant for
1.86 www 4437: text interface only)
1.60 matthew 4438:
1.814 bisitz 4439: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
4440: navigational links
1.317 albertel 4441:
1.338 albertel 4442: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
4443:
1.361 albertel 4444: =item * $no_inline_link, if true and in remote mode, don't show the
4445: 'Switch To Inline Menu' link
4446:
1.460 albertel 4447: =item * $args, optional argument valid values are
4448: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 4449: inherit_jsmath -> when creating popup window in a page,
4450: should it have jsmath forced on by the
4451: current page
1.460 albertel 4452:
1.112 bowersj2 4453: =back
4454:
1.60 matthew 4455: Returns: A uniform header for LON-CAPA web pages.
4456: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
4457: If $bodyonly is undef or zero, an html string containing a <body> tag and
4458: other decorations will be returned.
4459:
4460: =cut
4461:
1.54 www 4462: sub bodytag {
1.831 bisitz 4463: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.816 bisitz 4464: $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_;
1.339 albertel 4465:
1.460 albertel 4466: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 4467:
1.183 matthew 4468: $function = &get_users_function() if (!$function);
1.339 albertel 4469: my $img = &designparm($function.'.img',$domain);
4470: my $font = &designparm($function.'.font',$domain);
4471: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
4472:
1.803 bisitz 4473: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 4474: 'bgcolor' => $pgbg,
1.339 albertel 4475: 'text' => $font,
4476: 'alink' => &designparm($function.'.alink',$domain),
4477: 'vlink' => &designparm($function.'.vlink',$domain),
4478: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 4479: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 4480:
1.925.2.4 raeburn 4481: my $custommenu;
4482: if ($env{'environment.remote'} eq 'off') {
4483: $custommenu = &needs_gci_custom();
4484: }
1.63 www 4485: # role and realm
1.378 raeburn 4486: my ($role,$realm) = split(/\./,$env{'request.role'},2);
4487: if ($role eq 'ca') {
1.479 albertel 4488: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 4489: $realm = &plainname($rname,$rdom);
1.378 raeburn 4490: }
1.55 www 4491: # realm
1.258 albertel 4492: if ($env{'request.course.id'}) {
1.378 raeburn 4493: if ($env{'request.role'} !~ /^cr/) {
1.925.2.17 raeburn 4494: if (($custommenu) && (($role eq 'cm') || ($env{'form.context'} eq 'requestcrs'))) {
1.925.2.4 raeburn 4495: undef($role);
4496: } else {
4497: $role = &Apache::lonnet::plaintext($role,&course_type());
4498: }
1.378 raeburn 4499: }
1.925.2.17 raeburn 4500: if (defined($role) && $env{'request.course.sec'}) {
1.898 raeburn 4501: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
1.925.2.17 raeburn 4502: }
4503: if ($env{'form.context'} eq 'requestcrs') {
4504: undef($realm);
4505: } else {
4506: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
4507: }
1.378 raeburn 4508: } else {
1.925.2.4 raeburn 4509: if (($custommenu) && ($role eq 'cm')) {
4510: undef($role);
4511: } else {
4512: $role = &Apache::lonnet::plaintext($role);
4513: }
1.54 www 4514: }
1.433 albertel 4515:
1.359 albertel 4516: if (!$realm) { $realm=' '; }
1.55 www 4517: # Set messages
1.60 matthew 4518: my $messages=&domainlogo($domain);
1.330 albertel 4519:
1.438 albertel 4520: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 4521:
1.101 www 4522: # construct main body tag
1.359 albertel 4523: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 4524: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 4525:
1.530 albertel 4526: if ($bodyonly) {
1.60 matthew 4527: return $bodytag;
1.798 tempelho 4528: }
1.359 albertel 4529:
1.410 albertel 4530: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.433 albertel 4531: if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
4532: undef($role);
1.434 albertel 4533: } else {
4534: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
1.433 albertel 4535: }
1.359 albertel 4536:
1.762 bisitz 4537: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 4538: #
4539: # Extra info if you are the DC
4540: my $dc_info = '';
4541: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
4542: $env{'course.'.$env{'request.course.id'}.
4543: '.domain'}.'/'})) {
4544: my $cid = $env{'request.course.id'};
1.917 raeburn 4545: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 4546: $dc_info =~ s/\s+$//;
1.359 albertel 4547: }
4548:
1.898 raeburn 4549: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 4550: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
4551:
1.837 bisitz 4552: if ($env{'environment.remote'} eq 'off') {
1.359 albertel 4553: # No Remote
1.916 droeschl 4554: if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
4555: return $bodytag;
4556: }
1.903 droeschl 4557:
4558: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
4559:
4560: # if ($env{'request.state'} eq 'construct') {
4561: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
4562: # }
4563:
1.925.2.4 raeburn 4564: my $role_selector;
1.925.2.17 raeburn 4565: if (($custommenu) && !($env{'form.context'} eq 'requestcrs') &&
4566: ($env{'request.course.id'}) &&
1.925.2.14 raeburn 4567: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq 'gcitest')) {
1.925.2.4 raeburn 4568: $role_selector = &Apache::lonmenu::roles_selector(
4569: $env{'course.' . $env{'request.course.id'} . '.domain'},
4570: $env{'course.' . $env{'request.course.id'} . '.num'} );
4571: if ($role_selector) {
4572: $role_selector = '<br />'.$role_selector;
4573: }
4574: }
1.925.2.14 raeburn 4575: my $cid = $env{'request.course.id'};
4576: my %gcicourses = (
4577: gci_9615072b469884921gcil1 => 'review',
4578: gci_1H96711d710194bfegcil1 => 'submit',
4579: gci_5422913620b814c90gcil1 => 'tutorial',
4580: );
1.925.2.17 raeburn 4581: if (($custommenu && $cid && !$gcicourses{$cid}) &&
4582: !($env{'form.context'} eq 'requestcrs') ||
4583: ($env{'user.domain'} eq 'gcitest')) {
1.925.2.14 raeburn 4584: my $role = 'st';
4585: if ($custommenu) {
4586: $role = 'cc';
4587: }
4588: my ($switcher_js,$switcher,$formname);
4589: $formname = 'pickrole';
4590: my %courses = &existing_gcitest_courses($role);
4591: my $numcourses = keys(%courses);
4592: my $reqdcount = 0;
4593: if ($cid) {
4594: if ($courses{$cid}) {
4595: $reqdcount = 1;
4596: }
4597: }
4598: if ($numcourses > $reqdcount) {
4599: $switcher = &gcitest_switcher($role,$formname,%courses);
4600: my $current;
4601: if ($cid) {
4602: $current = $role.'./'.$env{'course.'.$cid.'.domain'}.
4603: '/'.$env{'course.'.$cid.'.num'};
4604: }
4605: $switcher_js = &Apache::loncommon::gcitest_switcher_js($current,$numcourses,$formname);
4606: if ($switcher_js) {
4607: $switcher_js= <<"ENDSCRIPT";
4608: <script type="text/javascript">
4609: // <![CDATA[
4610:
4611: $switcher_js
4612:
4613: // ]]>
4614: </script>
4615: ENDSCRIPT
4616: }
4617: }
4618: if ($switcher) {
4619: $switcher = $switcher_js.$switcher;
4620: if ($role_selector) {
4621: $role_selector .= ' '.$switcher;
4622: } else {
4623: $role_selector .= '<br />'.$switcher;
4624: }
4625: }
4626: }
1.359 albertel 4627:
1.916 droeschl 4628: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 4629: if ($dc_info) {
4630: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
4631: }
1.916 droeschl 4632: $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
4633: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 4634: return $bodytag;
4635: }
1.925.2.17 raeburn 4636: if ($env{'request.noversionuri'} eq '/adm/navmaps' &&
4637: $env{'environment.remotenavmap'} eq 'on') {
4638: return $bodytag;
4639: }
1.894 droeschl 4640:
1.925.2.14 raeburn 4641: if ($cid && $gcicourses{$cid} eq 'tutorial') {
4642: $bodytag .= '<div class="LC_page_header">';
1.925.2.17 raeburn 4643: }
4644:
1.925.2.4 raeburn 4645: $bodytag .= qq|<div id="LC_nav_bar">$name $role $role_selector</div>|;
1.916 droeschl 4646:
1.903 droeschl 4647: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.925.2.2 raeburn 4648: Apache::lonmenu::utilityfunctions('',$custommenu), 'start');
1.816 bisitz 4649:
1.903 droeschl 4650: $bodytag .= Apache::lonmenu::primary_menu();
1.852 droeschl 4651:
1.917 raeburn 4652: if ($dc_info) {
4653: $dc_info = &dc_courseid_toggle($dc_info);
4654: }
4655: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.925.2.14 raeburn 4656: if ($cid && $gcicourses{$cid} eq 'tutorial') {
4657: $bodytag .= '</div>';
4658: }
1.916 droeschl 4659:
1.903 droeschl 4660: #don't show menus for public users
4661: if($env{'user.name'} ne 'public' && $env{'user.domain'} ne 'public'){
1.925.2.5 raeburn 4662: if (($custommenu) &&
4663: ($env{'request.role'} !~ m{^st\./gcitest/$match_courseid})) {
1.925.2.2 raeburn 4664: $bodytag .= &Apache::lonmenu::gci_secondary_menu();
1.925.2.16 raeburn 4665: } elsif ($env{'request.role'} ne 'cm' || &check_for_gci_dc()) {
1.925.2.2 raeburn 4666: $bodytag .= Apache::lonmenu::secondary_menu();
4667: }
1.903 droeschl 4668: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 4669: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
4670: if ($env{'request.state'} eq 'construct') {
4671: $bodytag .= &Apache::lonmenu::innerregister($forcereg,'',
4672: $args->{'bread_crumbs'});
4673: } elsif ($forcereg) {
4674: $bodytag .= &Apache::lonmenu::innerregister($forcereg);
1.925.2.14 raeburn 4675: } elsif ($custommenu && $env{'request.course.id'} &&
4676: &Apache::lonnet::allowed('mdc', $env{'request.course.id'})) {
1.925.2.17 raeburn 4677: if ((($env{'request.noversionuri'} eq '/adm/navmaps') &&
4678: ($env{'request.noversionuri'} ne 'on')) ||
4679: (($env{'request.noversionuri'} eq '/adm/coursedocs') &&
4680: (!($env{'form.context'} eq 'requestcrs'))) ||
4681: (($env{'request.noversionuri'} eq '/adm/createuser') &&
4682: (!($env{'form.context'} eq 'requestcrs'))) ||
1.925.2.16 raeburn 4683: ($env{'request.noversionuri'} eq '/adm/whatsnew') ||
4684: ($env{'request.noversionuri'} eq '/cgi-bin/printout.pl') ||
4685: ($env{'request.noversionuri'} eq '/adm/printout') ||
4686: ($env{'request.noversionuri'} eq '/adm/statistics')) {
4687:
1.925.2.14 raeburn 4688: my @advtools = &concept_test_manager();
1.925.2.16 raeburn 4689: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.925.2.14 raeburn 4690: &Apache::lonhtmlcommon::add_breadcrumb_tool(
4691: 'advtools',@advtools);
4692: my $advlinks;
4693: my $legendtext = '<a class="LC_menubuttons_link" href="/adm/menu">'.&mt('Management').'</a>';
4694: &Apache::lonhtmlcommon::render_advtools(\$advlinks,$legendtext);
4695: $bodytag .= $advlinks;
4696: }
1.920 raeburn 4697: }
1.903 droeschl 4698: }else{
4699: # this is to seperate menu from content when there's no secondary
4700: # menu. Especially needed for public accessible ressources.
4701: $bodytag .= '<hr style="clear:both" />';
4702: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 4703: }
1.903 droeschl 4704:
1.235 raeburn 4705: return $bodytag;
1.94 www 4706: }
1.95 www 4707:
1.93 www 4708: #
1.95 www 4709: # Top frame rendering, Remote is up
1.93 www 4710: #
1.359 albertel 4711:
1.517 raeburn 4712: my $imgsrc = $img;
4713: if ($img =~ /^\/adm/) {
1.575 albertel 4714: $imgsrc = &lonhttpdurl($img);
1.517 raeburn 4715: }
4716: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
1.359 albertel 4717:
1.305 www 4718: # Explicit link to get inline menu
1.361 albertel 4719: my $menu= ($no_inline_link?''
1.883 droeschl 4720: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
1.917 raeburn 4721:
4722: if ($dc_info) {
4723: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
4724: }
4725:
1.916 droeschl 4726: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.897 wenzelju 4727: <ol class="LC_primary_menu LC_right">
1.853 droeschl 4728: <li>$menu</li>
1.917 raeburn 4729: </ol><div id="LC_realm"> $realm $dc_info</div>| unless $env{'form.inhibitmenu'};
1.94 www 4730: return(<<ENDBODY);
1.60 matthew 4731: $bodytag
1.359 albertel 4732: <table id="LC_title_bar" class="LC_with_remote">
1.791 tempelho 4733: <tr><td>$upperleft</td>
4734: <td>$messages </td>
1.54 www 4735: </tr>
1.359 albertel 4736: <tr><td>$titleinfo $dc_info $menu</td>
1.368 albertel 4737: </tr>
1.356 albertel 4738: </table>
1.54 www 4739: ENDBODY
1.182 matthew 4740: }
4741:
1.925.2.14 raeburn 4742: sub concept_test_manager {
4743: my @advtools;
4744: my %items = (
4745: docs => {
4746: desc => 'Edit Test',
4747: action => "go('/adm/coursedocs')",
4748: tooltip => 'Assemble or modify Concept Test'
4749: },
4750: cprv => {
4751: desc => 'Enrollment/Activity',
4752: action => "go('/adm/createuser')",
4753: tooltip => 'Enrollment and student activity',
4754: },
4755: new => {
4756: desc => "What's New?",
4757: action => "go('/adm/whatsnew')",
4758: tooltip => 'Recent events/action items in Concept Test' ,
4759: },
4760: prnt => {
4761: desc => 'Print Test',
4762: action => "go('/adm/printout');",
4763: tooltip => 'Prepare printable Concept Test',
4764: },
4765: chrt => {
4766: desc => 'Test Statistics',
4767: action => "go('/adm/statistics');",
4768: tooltip => 'Concept Test Statistics',
4769: },
4770: rcrs => {
4771: desc => 'Create New Test',
4772: action => "switchpage('createtest');",
4773: tooltip => 'Create new Concept Test',
4774: },
4775: );
4776: my @ordered = ('docs','cprv','new','prnt','chrt','rcrs');
4777: foreach my $item (@ordered) {
4778: push(@advtools,
4779: '<a title="'.$items{$item}{tooltip}.'" class="LC_menubuttons_link" href="javascript:'.
4780: $items{$item}{action}.';">'.
4781: '<img src="'.'/res/adm/pages/'.$item.'22.png" alt="'.$items{$item}{tooltip}.
4782: '" border="0" class="LC_icon" />'.
4783: '<span class="LC_menubuttons_inline_text">'.$items{$item}{desc}.'</span></a>');
4784: }
4785: return @advtools;
4786: }
4787:
1.917 raeburn 4788: sub dc_courseid_toggle {
4789: my ($dc_info) = @_;
4790: return ' <span id="dccidtext" class="LC_cusr_subheading">'.
4791: '<a href="javascript:showCourseID();">'.
4792: &mt('(More ...)').'</a></span>'.
4793: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
4794: }
4795:
1.330 albertel 4796: sub make_attr_string {
4797: my ($register,$attr_ref) = @_;
4798:
4799: if ($attr_ref && !ref($attr_ref)) {
4800: die("addentries Must be a hash ref ".
4801: join(':',caller(1))." ".
4802: join(':',caller(0))." ");
4803: }
4804:
4805: if ($register) {
1.339 albertel 4806: my ($on_load,$on_unload);
4807: foreach my $key (keys(%{$attr_ref})) {
4808: if (lc($key) eq 'onload') {
4809: $on_load.=$attr_ref->{$key}.';';
4810: delete($attr_ref->{$key});
4811:
4812: } elsif (lc($key) eq 'onunload') {
4813: $on_unload.=$attr_ref->{$key}.';';
4814: delete($attr_ref->{$key});
4815: }
4816: }
4817: $attr_ref->{'onload'} =
4818: &Apache::lonmenu::loadevents(). $on_load;
4819: $attr_ref->{'onunload'}=
4820: &Apache::lonmenu::unloadevents().$on_unload;
4821: }
4822:
4823: # Accessibility font enhance
4824: if ($env{'browser.fontenhance'} eq 'on') {
4825: my $style;
4826: foreach my $key (keys(%{$attr_ref})) {
4827: if (lc($key) eq 'style') {
4828: $style.=$attr_ref->{$key}.';';
4829: delete($attr_ref->{$key});
4830: }
4831: }
4832: $attr_ref->{'style'}=$style.'; font-size: x-large;';
1.330 albertel 4833: }
1.339 albertel 4834:
1.330 albertel 4835: my $attr_string;
4836: foreach my $attr (keys(%$attr_ref)) {
4837: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
4838: }
4839: return $attr_string;
4840: }
4841:
4842:
1.182 matthew 4843: ###############################################
1.251 albertel 4844: ###############################################
4845:
4846: =pod
4847:
4848: =item * &endbodytag()
4849:
4850: Returns a uniform footer for LON-CAPA web pages.
4851:
1.635 raeburn 4852: Inputs: 1 - optional reference to an args hash
4853: If in the hash, key for noredirectlink has a value which evaluates to true,
4854: a 'Continue' link is not displayed if the page contains an
4855: internal redirect in the <head></head> section,
4856: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 4857:
4858: =cut
4859:
4860: sub endbodytag {
1.635 raeburn 4861: my ($args) = @_;
1.251 albertel 4862: my $endbodytag='</body>';
1.269 albertel 4863: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 4864: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 4865: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
4866: $endbodytag=
4867: "<br /><a href=\"$env{'internal.head.redirect'}\">".
4868: &mt('Continue').'</a>'.
4869: $endbodytag;
4870: }
1.315 albertel 4871: }
1.251 albertel 4872: return $endbodytag;
4873: }
4874:
1.352 albertel 4875: =pod
4876:
4877: =item * &standard_css()
4878:
4879: Returns a style sheet
4880:
4881: Inputs: (all optional)
4882: domain -> force to color decorate a page for a specific
4883: domain
4884: function -> force usage of a specific rolish color scheme
4885: bgcolor -> override the default page bgcolor
4886:
4887: =cut
4888:
1.343 albertel 4889: sub standard_css {
1.345 albertel 4890: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 4891: $function = &get_users_function() if (!$function);
4892: my $img = &designparm($function.'.img', $domain);
4893: my $tabbg = &designparm($function.'.tabbg', $domain);
4894: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 4895: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 4896: #second colour for later usage
1.345 albertel 4897: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 4898: my $pgbg_or_bgcolor =
4899: $bgcolor ||
1.352 albertel 4900: &designparm($function.'.pgbg', $domain);
1.382 albertel 4901: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 4902: my $alink = &designparm($function.'.alink', $domain);
4903: my $vlink = &designparm($function.'.vlink', $domain);
4904: my $link = &designparm($function.'.link', $domain);
4905:
1.704 muellerd 4906: my $loginbg = &designparm('login.sidebg',$domain);
1.712 muellerd 4907: my $bgcol = &designparm('login.bgcol',$domain);
4908: my $textcol = &designparm('login.textcol',$domain);
1.704 muellerd 4909:
1.602 albertel 4910: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 4911: my $mono = 'monospace';
1.850 bisitz 4912: my $data_table_head = $sidebg;
4913: my $data_table_light = '#FAFAFA';
4914: my $data_table_dark = '#F0F0F0';
1.470 banghart 4915: my $data_table_darker = '#CCCCCC';
1.349 albertel 4916: my $data_table_highlight = '#FFFF00';
1.352 albertel 4917: my $mail_new = '#FFBB77';
4918: my $mail_new_hover = '#DD9955';
4919: my $mail_read = '#BBBB77';
4920: my $mail_read_hover = '#999944';
4921: my $mail_replied = '#AAAA88';
4922: my $mail_replied_hover = '#888855';
4923: my $mail_other = '#99BBBB';
4924: my $mail_other_hover = '#669999';
1.391 albertel 4925: my $table_header = '#DDDDDD';
1.489 raeburn 4926: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 4927: my $lg_border_color = '#C8C8C8';
1.392 albertel 4928:
1.608 albertel 4929: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 4930: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
4931: : '0 3px 0 4px';
1.448 albertel 4932:
1.523 albertel 4933:
1.343 albertel 4934: return <<END;
1.795 www 4935: body {
1.911 bisitz 4936: font-family: $sans;
4937: line-height:130%;
4938: font-size:0.83em;
4939: color:$font;
1.795 www 4940: }
4941:
1.911 bisitz 4942: a:focus {
1.795 www 4943: color: red;
1.911 bisitz 4944: background: yellow;
1.795 www 4945: }
1.698 harmsja 4946:
1.911 bisitz 4947: form, .inline {
4948: display: inline;
1.795 www 4949: }
1.721 harmsja 4950:
1.795 www 4951: .LC_right {
1.911 bisitz 4952: text-align:right;
1.795 www 4953: }
4954:
4955: .LC_middle {
1.911 bisitz 4956: vertical-align:middle;
1.795 www 4957: }
1.721 harmsja 4958:
4959: /* just for tests */
1.911 bisitz 4960: .LC_400Box {
4961: width:400px;
4962: }
1.721 harmsja 4963: /* end */
4964:
1.778 bisitz 4965: .LC_filename {
4966: font-family: $mono;
4967: white-space:pre;
1.921 bisitz 4968: font-size: 120%;
1.778 bisitz 4969: }
4970:
4971: .LC_fileicon {
4972: border: none;
4973: height: 1.3em;
4974: vertical-align: text-bottom;
4975: margin-right: 0.3em;
4976: text-decoration:none;
4977: }
4978:
1.350 albertel 4979: .LC_error {
4980: color: red;
4981: font-size: larger;
4982: }
1.795 www 4983:
1.457 albertel 4984: .LC_warning,
4985: .LC_diff_removed {
1.733 bisitz 4986: color: red;
1.394 albertel 4987: }
1.532 albertel 4988:
4989: .LC_info,
1.457 albertel 4990: .LC_success,
4991: .LC_diff_added {
1.350 albertel 4992: color: green;
4993: }
1.795 www 4994:
1.802 bisitz 4995: div.LC_confirm_box {
4996: background-color: #FAFAFA;
4997: border: 1px solid $lg_border_color;
4998: margin-right: 0;
4999: padding: 5px;
5000: }
5001:
5002: div.LC_confirm_box .LC_error img,
5003: div.LC_confirm_box .LC_success img {
5004: vertical-align: middle;
5005: }
5006:
1.440 albertel 5007: .LC_icon {
1.771 droeschl 5008: border: none;
1.790 droeschl 5009: vertical-align: middle;
1.771 droeschl 5010: }
5011:
1.543 albertel 5012: .LC_docs_spacer {
5013: width: 25px;
5014: height: 1px;
1.771 droeschl 5015: border: none;
1.543 albertel 5016: }
1.346 albertel 5017:
1.532 albertel 5018: .LC_internal_info {
1.735 bisitz 5019: color: #999999;
1.532 albertel 5020: }
5021:
1.794 www 5022: .LC_discussion {
1.911 bisitz 5023: background: $tabbg;
5024: border: 1px solid black;
5025: margin: 2px;
1.794 www 5026: }
5027:
5028: .LC_disc_action_links_bar {
1.911 bisitz 5029: background: $tabbg;
5030: border: none;
5031: margin: 4px;
1.794 www 5032: }
5033:
5034: .LC_disc_action_left {
1.911 bisitz 5035: text-align: left;
1.794 www 5036: }
5037:
5038: .LC_disc_action_right {
1.911 bisitz 5039: text-align: right;
1.794 www 5040: }
5041:
5042: .LC_disc_new_item {
1.911 bisitz 5043: background: white;
5044: border: 2px solid red;
5045: margin: 2px;
1.794 www 5046: }
5047:
5048: .LC_disc_old_item {
1.911 bisitz 5049: background: white;
5050: border: 1px solid black;
5051: margin: 2px;
1.794 www 5052: }
5053:
1.458 albertel 5054: table.LC_pastsubmission {
5055: border: 1px solid black;
5056: margin: 2px;
5057: }
5058:
1.924 bisitz 5059: table#LC_menubuttons {
1.345 albertel 5060: width: 100%;
5061: background: $pgbg;
1.392 albertel 5062: border: 2px;
1.402 albertel 5063: border-collapse: separate;
1.803 bisitz 5064: padding: 0;
1.345 albertel 5065: }
1.392 albertel 5066:
1.801 tempelho 5067: table#LC_title_bar a {
5068: color: $fontmenu;
5069: }
1.836 bisitz 5070:
1.807 droeschl 5071: table#LC_title_bar {
1.819 tempelho 5072: clear: both;
1.836 bisitz 5073: display: none;
1.807 droeschl 5074: }
5075:
1.795 www 5076: table#LC_title_bar,
5077: table.LC_breadcrumbs,
1.393 albertel 5078: table#LC_title_bar.LC_with_remote {
1.359 albertel 5079: width: 100%;
1.392 albertel 5080: border-color: $pgbg;
5081: border-style: solid;
5082: border-width: $border;
1.379 albertel 5083: background: $pgbg;
1.801 tempelho 5084: color: $fontmenu;
1.392 albertel 5085: border-collapse: collapse;
1.803 bisitz 5086: padding: 0;
1.819 tempelho 5087: margin: 0;
1.359 albertel 5088: }
1.795 www 5089:
1.925.2.14 raeburn 5090: ul.LC_breadcrumb_tools_outerlist {
5091: margin: 0;
5092: padding: 0;
5093: position: relative;
5094: list-style: none;
5095: }
5096: ul.LC_breadcrumb_tools_outerlist li {
5097: display: inline;
5098: }
5099:
5100: .LC_breadcrumb_tools_navigation {
5101: padding: 0;
5102: margin: 0;
5103: float: left;
5104: }
5105: .LC_breadcrumb_tools_tools {
5106: padding: 0;
5107: margin: 0;
5108: float: right;
5109: }
5110:
5111: div.LC_GCI_Menu {
5112: width:900px;
5113: }
5114:
5115: div.LC_GCI_Menu:after {
5116: content:'';
5117: display:block;
5118: clear:both;
5119: }
5120:
5121: div.LC_GCI_Menu_left {
5122: float:left;
5123: width:400px;
5124: }
5125:
5126: div.LC_GCI_Menu_right {
5127: float:left;
5128: width:400px;;
5129: }
5130:
1.925.2.13 raeburn 5131: dl.LC_GCI_Menu {
5132: width:300px;
5133: float:left;
5134: margin-right:2em;
5135: }
5136:
5137: dl.LC_GCI_Menu dt {
5138: font-weight: bold;
5139: font-size:0.9em;
5140: margin-bottom:0.7em;
5141: }
5142:
1.925.2.14 raeburn 5143: dl.LC_GCI_Menu dt a {
5144: color: $font;
5145: }
5146:
1.925.2.13 raeburn 5147: dl.LC_GCI_Menu dd {
5148: font-size:0.8em;
5149: margin:0 0 2em 0;
5150: padding-left:4.5em;
5151: line-height:1.5em;
5152: background:none no-repeat left top;
5153: }
5154:
1.359 albertel 5155: table#LC_title_bar td {
5156: background: $tabbg;
5157: }
1.795 www 5158:
1.911 bisitz 5159: table#LC_menubuttons img {
1.803 bisitz 5160: border: none;
1.346 albertel 5161: }
1.795 www 5162:
1.842 droeschl 5163: .LC_breadcrumbs_component {
1.911 bisitz 5164: float: right;
1.925.2.14 raeburn 5165: margin: 0.25em 1em;
1.357 albertel 5166: }
1.842 droeschl 5167: .LC_breadcrumbs_component img {
1.911 bisitz 5168: vertical-align: middle;
1.777 tempelho 5169: }
1.795 www 5170:
1.383 albertel 5171: td.LC_table_cell_checkbox {
5172: text-align: center;
5173: }
1.795 www 5174:
5175: .LC_fontsize_small {
1.911 bisitz 5176: font-size: 70%;
1.705 tempelho 5177: }
5178:
1.844 bisitz 5179: #LC_breadcrumbs {
1.911 bisitz 5180: clear:both;
5181: background: $sidebg;
5182: border-bottom: 1px solid $lg_border_color;
5183: line-height: 2.5em;
1.925.2.14 raeburn 5184: overflow: hidden;
1.911 bisitz 5185: margin: 0;
5186: padding: 0;
1.925.2.14 raeburn 5187: text-align: left;
1.819 tempelho 5188: }
1.862 bisitz 5189:
1.839 droeschl 5190: /* Preliminary fix to hide breadcrumbs inside remote control window */
1.844 bisitz 5191: #LC_remote #LC_breadcrumbs {
1.911 bisitz 5192: display:none;
1.839 droeschl 5193: }
1.819 tempelho 5194:
1.844 bisitz 5195: #LC_head_subbox {
1.911 bisitz 5196: clear:both;
5197: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5198: border: 1px solid $sidebg;
1.925.2.14 raeburn 5199: margin: 0 0 0 0;
1.822 bisitz 5200: }
5201:
1.795 www 5202: .LC_fontsize_medium {
1.911 bisitz 5203: font-size: 85%;
1.705 tempelho 5204: }
5205:
1.795 www 5206: .LC_fontsize_large {
1.911 bisitz 5207: font-size: 120%;
1.705 tempelho 5208: }
5209:
1.346 albertel 5210: .LC_menubuttons_inline_text {
5211: color: $font;
1.698 harmsja 5212: font-size: 90%;
1.701 harmsja 5213: padding-left:3px;
1.346 albertel 5214: }
5215:
1.526 www 5216: .LC_menubuttons_link {
5217: text-decoration: none;
5218: }
1.795 www 5219:
1.522 albertel 5220: .LC_menubuttons_category {
1.521 www 5221: color: $font;
1.526 www 5222: background: $pgbg;
1.521 www 5223: font-size: larger;
5224: font-weight: bold;
5225: }
5226:
1.346 albertel 5227: td.LC_menubuttons_text {
1.911 bisitz 5228: color: $font;
1.346 albertel 5229: }
1.706 harmsja 5230:
1.346 albertel 5231: .LC_current_location {
5232: background: $tabbg;
5233: }
1.795 www 5234:
5235: table.LC_data_table,
5236: table.LC_mail_list {
1.347 albertel 5237: border: 1px solid #000000;
1.402 albertel 5238: border-collapse: separate;
1.426 albertel 5239: border-spacing: 1px;
1.610 albertel 5240: background: $pgbg;
1.347 albertel 5241: }
1.795 www 5242:
1.422 albertel 5243: .LC_data_table_dense {
5244: font-size: small;
5245: }
1.795 www 5246:
1.507 raeburn 5247: table.LC_nested_outer {
5248: border: 1px solid #000000;
1.589 raeburn 5249: border-collapse: collapse;
1.803 bisitz 5250: border-spacing: 0;
1.507 raeburn 5251: width: 100%;
5252: }
1.795 www 5253:
1.879 raeburn 5254: table.LC_innerpickbox,
1.507 raeburn 5255: table.LC_nested {
1.803 bisitz 5256: border: none;
1.589 raeburn 5257: border-collapse: collapse;
1.803 bisitz 5258: border-spacing: 0;
1.507 raeburn 5259: width: 100%;
5260: }
1.795 www 5261:
1.911 bisitz 5262: table.LC_data_table tr th,
5263: table.LC_calendar tr th,
1.795 www 5264: table.LC_mail_list tr th,
1.879 raeburn 5265: table.LC_prior_tries tr th,
5266: table.LC_innerpickbox tr th {
1.349 albertel 5267: font-weight: bold;
5268: background-color: $data_table_head;
1.801 tempelho 5269: color:$fontmenu;
1.701 harmsja 5270: font-size:90%;
1.347 albertel 5271: }
1.795 www 5272:
1.879 raeburn 5273: table.LC_innerpickbox tr th,
5274: table.LC_innerpickbox tr td {
5275: vertical-align: top;
5276: }
5277:
1.711 raeburn 5278: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5279: background-color: #CCCCCC;
1.711 raeburn 5280: font-weight: bold;
5281: text-align: left;
5282: }
1.795 www 5283:
1.912 bisitz 5284: table.LC_data_table tr.LC_odd_row > td {
5285: background-color: $data_table_light;
5286: padding: 2px;
5287: vertical-align: top;
5288: }
5289:
1.809 bisitz 5290: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5291: background-color: $data_table_light;
1.912 bisitz 5292: vertical-align: top;
5293: }
5294:
5295: table.LC_data_table tr.LC_even_row > td {
5296: background-color: $data_table_dark;
1.425 albertel 5297: padding: 2px;
1.900 bisitz 5298: vertical-align: top;
1.347 albertel 5299: }
1.795 www 5300:
1.809 bisitz 5301: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5302: background-color: $data_table_dark;
1.900 bisitz 5303: vertical-align: top;
1.347 albertel 5304: }
1.795 www 5305:
1.425 albertel 5306: table.LC_data_table tr.LC_data_table_highlight td {
5307: background-color: $data_table_darker;
5308: }
1.795 www 5309:
1.639 raeburn 5310: table.LC_data_table tr td.LC_leftcol_header {
5311: background-color: $data_table_head;
5312: font-weight: bold;
5313: }
1.795 www 5314:
1.451 albertel 5315: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5316: table.LC_nested tr.LC_empty_row td {
1.347 albertel 5317: background-color: #FFFFFF;
1.421 albertel 5318: font-weight: bold;
5319: font-style: italic;
5320: text-align: center;
5321: padding: 8px;
1.347 albertel 5322: }
1.795 www 5323:
1.890 droeschl 5324: table.LC_caption {
5325: }
5326:
1.507 raeburn 5327: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5328: padding: 4ex
5329: }
1.795 www 5330:
1.507 raeburn 5331: table.LC_nested_outer tr th {
5332: font-weight: bold;
1.801 tempelho 5333: color:$fontmenu;
1.507 raeburn 5334: background-color: $data_table_head;
1.701 harmsja 5335: font-size: small;
1.507 raeburn 5336: border-bottom: 1px solid #000000;
5337: }
1.795 www 5338:
1.507 raeburn 5339: table.LC_nested_outer tr td.LC_subheader {
5340: background-color: $data_table_head;
5341: font-weight: bold;
5342: font-size: small;
5343: border-bottom: 1px solid #000000;
5344: text-align: right;
1.451 albertel 5345: }
1.795 www 5346:
1.507 raeburn 5347: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5348: background-color: #CCCCCC;
1.451 albertel 5349: font-weight: bold;
5350: font-size: small;
1.507 raeburn 5351: text-align: center;
5352: }
1.795 www 5353:
1.589 raeburn 5354: table.LC_nested tr.LC_info_row td.LC_left_item,
5355: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5356: text-align: left;
1.451 albertel 5357: }
1.795 www 5358:
1.507 raeburn 5359: table.LC_nested td {
1.735 bisitz 5360: background-color: #FFFFFF;
1.451 albertel 5361: font-size: small;
1.507 raeburn 5362: }
1.795 www 5363:
1.507 raeburn 5364: table.LC_nested_outer tr th.LC_right_item,
5365: table.LC_nested tr.LC_info_row td.LC_right_item,
5366: table.LC_nested tr.LC_odd_row td.LC_right_item,
5367: table.LC_nested tr td.LC_right_item {
1.451 albertel 5368: text-align: right;
5369: }
5370:
1.507 raeburn 5371: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5372: background-color: #EEEEEE;
1.451 albertel 5373: }
5374:
1.473 raeburn 5375: table.LC_createuser {
5376: }
5377:
5378: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5379: font-size: small;
1.473 raeburn 5380: }
5381:
5382: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5383: background-color: #CCCCCC;
1.473 raeburn 5384: font-weight: bold;
5385: text-align: center;
5386: }
5387:
1.349 albertel 5388: table.LC_calendar {
5389: border: 1px solid #000000;
5390: border-collapse: collapse;
1.917 raeburn 5391: width: 98%;
1.349 albertel 5392: }
1.795 www 5393:
1.349 albertel 5394: table.LC_calendar_pickdate {
5395: font-size: xx-small;
5396: }
1.795 www 5397:
1.349 albertel 5398: table.LC_calendar tr td {
5399: border: 1px solid #000000;
5400: vertical-align: top;
1.917 raeburn 5401: width: 14%;
1.349 albertel 5402: }
1.795 www 5403:
1.349 albertel 5404: table.LC_calendar tr td.LC_calendar_day_empty {
5405: background-color: $data_table_dark;
5406: }
1.795 www 5407:
1.779 bisitz 5408: table.LC_calendar tr td.LC_calendar_day_current {
5409: background-color: $data_table_highlight;
1.777 tempelho 5410: }
1.795 www 5411:
1.349 albertel 5412: table.LC_mail_list tr.LC_mail_new {
5413: background-color: $mail_new;
5414: }
1.795 www 5415:
1.349 albertel 5416: table.LC_mail_list tr.LC_mail_new:hover {
5417: background-color: $mail_new_hover;
5418: }
1.795 www 5419:
1.349 albertel 5420: table.LC_mail_list tr.LC_mail_read {
5421: background-color: $mail_read;
5422: }
1.795 www 5423:
1.349 albertel 5424: table.LC_mail_list tr.LC_mail_read:hover {
5425: background-color: $mail_read_hover;
5426: }
1.795 www 5427:
1.349 albertel 5428: table.LC_mail_list tr.LC_mail_replied {
5429: background-color: $mail_replied;
5430: }
1.795 www 5431:
1.349 albertel 5432: table.LC_mail_list tr.LC_mail_replied:hover {
5433: background-color: $mail_replied_hover;
5434: }
1.795 www 5435:
1.349 albertel 5436: table.LC_mail_list tr.LC_mail_other {
5437: background-color: $mail_other;
5438: }
1.795 www 5439:
1.349 albertel 5440: table.LC_mail_list tr.LC_mail_other:hover {
5441: background-color: $mail_other_hover;
5442: }
1.494 raeburn 5443:
1.777 tempelho 5444: table.LC_data_table tr > td.LC_browser_file,
5445: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5446: background: #AAEE77;
1.389 albertel 5447: }
1.795 www 5448:
1.777 tempelho 5449: table.LC_data_table tr > td.LC_browser_file_locked,
5450: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5451: background: #FFAA99;
1.387 albertel 5452: }
1.795 www 5453:
1.777 tempelho 5454: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5455: background: #888888;
1.779 bisitz 5456: }
1.795 www 5457:
1.777 tempelho 5458: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5459: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5460: background: #F8F866;
1.777 tempelho 5461: }
1.795 www 5462:
1.696 bisitz 5463: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5464: background: #E0E8FF;
1.387 albertel 5465: }
1.696 bisitz 5466:
1.707 bisitz 5467: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5468: /* background: #77FF77; */
1.707 bisitz 5469: }
1.795 www 5470:
1.707 bisitz 5471: table.LC_data_table tr > td.LC_roles_future {
5472: background: #FFFF77;
5473: }
1.795 www 5474:
1.707 bisitz 5475: table.LC_data_table tr > td.LC_roles_will {
5476: background: #FFAA77;
5477: }
1.795 www 5478:
1.707 bisitz 5479: table.LC_data_table tr > td.LC_roles_expired {
5480: background: #FF7777;
5481: }
1.795 www 5482:
1.707 bisitz 5483: table.LC_data_table tr > td.LC_roles_will_not {
5484: background: #AAFF77;
5485: }
1.795 www 5486:
1.707 bisitz 5487: table.LC_data_table tr > td.LC_roles_selected {
5488: background: #11CC55;
5489: }
5490:
1.388 albertel 5491: span.LC_current_location {
1.701 harmsja 5492: font-size:larger;
1.388 albertel 5493: background: $pgbg;
5494: }
1.387 albertel 5495:
1.395 albertel 5496: span.LC_parm_menu_item {
5497: font-size: larger;
5498: }
1.795 www 5499:
1.395 albertel 5500: span.LC_parm_scope_all {
5501: color: red;
5502: }
1.795 www 5503:
1.395 albertel 5504: span.LC_parm_scope_folder {
5505: color: green;
5506: }
1.795 www 5507:
1.395 albertel 5508: span.LC_parm_scope_resource {
5509: color: orange;
5510: }
1.795 www 5511:
1.395 albertel 5512: span.LC_parm_part {
5513: color: blue;
5514: }
1.795 www 5515:
1.911 bisitz 5516: span.LC_parm_folder,
5517: span.LC_parm_symb {
1.395 albertel 5518: font-size: x-small;
5519: font-family: $mono;
5520: color: #AAAAAA;
5521: }
5522:
1.795 www 5523: td.LC_parm_overview_level_menu,
5524: td.LC_parm_overview_map_menu,
5525: td.LC_parm_overview_parm_selectors,
5526: td.LC_parm_overview_restrictions {
1.396 albertel 5527: border: 1px solid black;
5528: border-collapse: collapse;
5529: }
1.795 www 5530:
1.396 albertel 5531: table.LC_parm_overview_restrictions td {
5532: border-width: 1px 4px 1px 4px;
5533: border-style: solid;
5534: border-color: $pgbg;
5535: text-align: center;
5536: }
1.795 www 5537:
1.396 albertel 5538: table.LC_parm_overview_restrictions th {
5539: background: $tabbg;
5540: border-width: 1px 4px 1px 4px;
5541: border-style: solid;
5542: border-color: $pgbg;
5543: }
1.795 www 5544:
1.398 albertel 5545: table#LC_helpmenu {
1.803 bisitz 5546: border: none;
1.398 albertel 5547: height: 55px;
1.803 bisitz 5548: border-spacing: 0;
1.398 albertel 5549: }
5550:
5551: table#LC_helpmenu fieldset legend {
5552: font-size: larger;
5553: }
1.795 www 5554:
1.397 albertel 5555: table#LC_helpmenu_links {
5556: width: 100%;
5557: border: 1px solid black;
5558: background: $pgbg;
1.803 bisitz 5559: padding: 0;
1.397 albertel 5560: border-spacing: 1px;
5561: }
1.795 www 5562:
1.397 albertel 5563: table#LC_helpmenu_links tr td {
5564: padding: 1px;
5565: background: $tabbg;
1.399 albertel 5566: text-align: center;
5567: font-weight: bold;
1.397 albertel 5568: }
1.396 albertel 5569:
1.795 www 5570: table#LC_helpmenu_links a:link,
5571: table#LC_helpmenu_links a:visited,
1.397 albertel 5572: table#LC_helpmenu_links a:active {
5573: text-decoration: none;
5574: color: $font;
5575: }
1.795 www 5576:
1.397 albertel 5577: table#LC_helpmenu_links a:hover {
5578: text-decoration: underline;
5579: color: $vlink;
5580: }
1.396 albertel 5581:
1.417 albertel 5582: .LC_chrt_popup_exists {
5583: border: 1px solid #339933;
5584: margin: -1px;
5585: }
1.795 www 5586:
1.417 albertel 5587: .LC_chrt_popup_up {
5588: border: 1px solid yellow;
5589: margin: -1px;
5590: }
1.795 www 5591:
1.417 albertel 5592: .LC_chrt_popup {
5593: border: 1px solid #8888FF;
5594: background: #CCCCFF;
5595: }
1.795 www 5596:
1.421 albertel 5597: table.LC_pick_box {
5598: border-collapse: separate;
5599: background: white;
5600: border: 1px solid black;
5601: border-spacing: 1px;
5602: }
1.795 www 5603:
1.421 albertel 5604: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 5605: background: $sidebg;
1.421 albertel 5606: font-weight: bold;
1.900 bisitz 5607: text-align: left;
1.740 bisitz 5608: vertical-align: top;
1.421 albertel 5609: width: 184px;
5610: padding: 8px;
5611: }
1.795 www 5612:
1.579 raeburn 5613: table.LC_pick_box td.LC_pick_box_value {
5614: text-align: left;
5615: padding: 8px;
5616: }
1.795 www 5617:
1.579 raeburn 5618: table.LC_pick_box td.LC_pick_box_select {
5619: text-align: left;
5620: padding: 8px;
5621: }
1.795 www 5622:
1.424 albertel 5623: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 5624: padding: 0;
1.421 albertel 5625: height: 1px;
5626: background: black;
5627: }
1.795 www 5628:
1.421 albertel 5629: table.LC_pick_box td.LC_pick_box_submit {
5630: text-align: right;
5631: }
1.795 www 5632:
1.579 raeburn 5633: table.LC_pick_box td.LC_evenrow_value {
5634: text-align: left;
5635: padding: 8px;
5636: background-color: $data_table_light;
5637: }
1.795 www 5638:
1.579 raeburn 5639: table.LC_pick_box td.LC_oddrow_value {
5640: text-align: left;
5641: padding: 8px;
5642: background-color: $data_table_light;
5643: }
1.795 www 5644:
1.579 raeburn 5645: span.LC_helpform_receipt_cat {
5646: font-weight: bold;
5647: }
1.795 www 5648:
1.424 albertel 5649: table.LC_group_priv_box {
5650: background: white;
5651: border: 1px solid black;
5652: border-spacing: 1px;
5653: }
1.795 www 5654:
1.424 albertel 5655: table.LC_group_priv_box td.LC_pick_box_title {
5656: background: $tabbg;
5657: font-weight: bold;
5658: text-align: right;
5659: width: 184px;
5660: }
1.795 www 5661:
1.424 albertel 5662: table.LC_group_priv_box td.LC_groups_fixed {
5663: background: $data_table_light;
5664: text-align: center;
5665: }
1.795 www 5666:
1.424 albertel 5667: table.LC_group_priv_box td.LC_groups_optional {
5668: background: $data_table_dark;
5669: text-align: center;
5670: }
1.795 www 5671:
1.424 albertel 5672: table.LC_group_priv_box td.LC_groups_functionality {
5673: background: $data_table_darker;
5674: text-align: center;
5675: font-weight: bold;
5676: }
1.795 www 5677:
1.424 albertel 5678: table.LC_group_priv td {
5679: text-align: left;
1.803 bisitz 5680: padding: 0;
1.424 albertel 5681: }
5682:
1.421 albertel 5683: table.LC_notify_front_page {
5684: background: white;
5685: border: 1px solid black;
5686: padding: 8px;
5687: }
1.795 www 5688:
1.421 albertel 5689: table.LC_notify_front_page td {
5690: padding: 8px;
5691: }
1.795 www 5692:
1.424 albertel 5693: .LC_navbuttons {
5694: margin: 2ex 0ex 2ex 0ex;
5695: }
1.795 www 5696:
1.423 albertel 5697: .LC_topic_bar {
5698: font-weight: bold;
5699: background: $tabbg;
1.918 wenzelju 5700: margin: 1em 0em 1em 2em;
1.805 bisitz 5701: padding: 3px;
1.918 wenzelju 5702: font-size: 1.2em;
1.423 albertel 5703: }
1.795 www 5704:
1.423 albertel 5705: .LC_topic_bar span {
1.918 wenzelju 5706: left: 0.5em;
5707: position: absolute;
1.423 albertel 5708: vertical-align: middle;
1.918 wenzelju 5709: font-size: 1.2em;
1.423 albertel 5710: }
1.795 www 5711:
1.423 albertel 5712: .LC_topic_bar img {
5713: vertical-align: bottom;
5714: }
1.795 www 5715:
1.423 albertel 5716: table.LC_course_group_status {
5717: margin: 20px;
5718: }
1.795 www 5719:
1.423 albertel 5720: table.LC_status_selector td {
5721: vertical-align: top;
5722: text-align: center;
1.424 albertel 5723: padding: 4px;
5724: }
1.795 www 5725:
1.599 albertel 5726: div.LC_feedback_link {
1.616 albertel 5727: clear: both;
1.829 kalberla 5728: background: $sidebg;
1.779 bisitz 5729: width: 100%;
1.829 kalberla 5730: padding-bottom: 10px;
5731: border: 1px $tabbg solid;
1.833 kalberla 5732: height: 22px;
5733: line-height: 22px;
5734: padding-top: 5px;
5735: }
5736:
5737: div.LC_feedback_link img {
5738: height: 22px;
1.867 kalberla 5739: vertical-align:middle;
1.829 kalberla 5740: }
5741:
1.911 bisitz 5742: div.LC_feedback_link a {
1.829 kalberla 5743: text-decoration: none;
1.489 raeburn 5744: }
1.795 www 5745:
1.867 kalberla 5746: div.LC_comblock {
1.911 bisitz 5747: display:inline;
1.867 kalberla 5748: color:$font;
5749: font-size:90%;
5750: }
5751:
5752: div.LC_feedback_link div.LC_comblock {
5753: padding-left:5px;
5754: }
5755:
5756: div.LC_feedback_link div.LC_comblock a {
5757: color:$font;
5758: }
5759:
1.489 raeburn 5760: span.LC_feedback_link {
1.858 bisitz 5761: /* background: $feedback_link_bg; */
1.599 albertel 5762: font-size: larger;
5763: }
1.795 www 5764:
1.599 albertel 5765: span.LC_message_link {
1.858 bisitz 5766: /* background: $feedback_link_bg; */
1.599 albertel 5767: font-size: larger;
5768: position: absolute;
5769: right: 1em;
1.489 raeburn 5770: }
1.421 albertel 5771:
1.515 albertel 5772: table.LC_prior_tries {
1.524 albertel 5773: border: 1px solid #000000;
5774: border-collapse: separate;
5775: border-spacing: 1px;
1.515 albertel 5776: }
1.523 albertel 5777:
1.515 albertel 5778: table.LC_prior_tries td {
1.524 albertel 5779: padding: 2px;
1.515 albertel 5780: }
1.523 albertel 5781:
5782: .LC_answer_correct {
1.795 www 5783: background: lightgreen;
5784: color: darkgreen;
5785: padding: 6px;
1.523 albertel 5786: }
1.795 www 5787:
1.523 albertel 5788: .LC_answer_charged_try {
1.797 www 5789: background: #FFAAAA;
1.795 www 5790: color: darkred;
5791: padding: 6px;
1.523 albertel 5792: }
1.795 www 5793:
1.779 bisitz 5794: .LC_answer_not_charged_try,
1.523 albertel 5795: .LC_answer_no_grade,
5796: .LC_answer_late {
1.795 www 5797: background: lightyellow;
1.523 albertel 5798: color: black;
1.795 www 5799: padding: 6px;
1.523 albertel 5800: }
1.795 www 5801:
1.523 albertel 5802: .LC_answer_previous {
1.795 www 5803: background: lightblue;
5804: color: darkblue;
5805: padding: 6px;
1.523 albertel 5806: }
1.795 www 5807:
1.779 bisitz 5808: .LC_answer_no_message {
1.777 tempelho 5809: background: #FFFFFF;
5810: color: black;
1.795 www 5811: padding: 6px;
1.779 bisitz 5812: }
1.795 www 5813:
1.779 bisitz 5814: .LC_answer_unknown {
5815: background: orange;
5816: color: black;
1.795 www 5817: padding: 6px;
1.777 tempelho 5818: }
1.795 www 5819:
1.529 albertel 5820: span.LC_prior_numerical,
5821: span.LC_prior_string,
5822: span.LC_prior_custom,
5823: span.LC_prior_reaction,
5824: span.LC_prior_math {
1.925 bisitz 5825: font-family: $mono;
1.523 albertel 5826: white-space: pre;
5827: }
5828:
1.525 albertel 5829: span.LC_prior_string {
1.925 bisitz 5830: font-family: $mono;
1.525 albertel 5831: white-space: pre;
5832: }
5833:
1.523 albertel 5834: table.LC_prior_option {
5835: width: 100%;
5836: border-collapse: collapse;
5837: }
1.795 www 5838:
1.911 bisitz 5839: table.LC_prior_rank,
1.795 www 5840: table.LC_prior_match {
1.528 albertel 5841: border-collapse: collapse;
5842: }
1.795 www 5843:
1.528 albertel 5844: table.LC_prior_option tr td,
5845: table.LC_prior_rank tr td,
5846: table.LC_prior_match tr td {
1.524 albertel 5847: border: 1px solid #000000;
1.515 albertel 5848: }
5849:
1.855 bisitz 5850: .LC_nobreak {
1.544 albertel 5851: white-space: nowrap;
1.519 raeburn 5852: }
5853:
1.576 raeburn 5854: span.LC_cusr_emph {
5855: font-style: italic;
5856: }
5857:
1.633 raeburn 5858: span.LC_cusr_subheading {
5859: font-weight: normal;
5860: font-size: 85%;
5861: }
5862:
1.861 bisitz 5863: div.LC_docs_entry_move {
1.859 bisitz 5864: border: 1px solid #BBBBBB;
1.545 albertel 5865: background: #DDDDDD;
1.861 bisitz 5866: width: 22px;
1.859 bisitz 5867: padding: 1px;
5868: margin: 0;
1.545 albertel 5869: }
5870:
1.861 bisitz 5871: table.LC_data_table tr > td.LC_docs_entry_commands,
5872: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 5873: background: #DDDDDD;
5874: font-size: x-small;
5875: }
1.795 www 5876:
1.861 bisitz 5877: .LC_docs_entry_parameter {
5878: white-space: nowrap;
5879: }
5880:
1.544 albertel 5881: .LC_docs_copy {
1.545 albertel 5882: color: #000099;
1.544 albertel 5883: }
1.795 www 5884:
1.544 albertel 5885: .LC_docs_cut {
1.545 albertel 5886: color: #550044;
1.544 albertel 5887: }
1.795 www 5888:
1.544 albertel 5889: .LC_docs_rename {
1.545 albertel 5890: color: #009900;
1.544 albertel 5891: }
1.795 www 5892:
1.544 albertel 5893: .LC_docs_remove {
1.545 albertel 5894: color: #990000;
5895: }
5896:
1.547 albertel 5897: .LC_docs_reinit_warn,
5898: .LC_docs_ext_edit {
5899: font-size: x-small;
5900: }
5901:
1.545 albertel 5902: table.LC_docs_adddocs td,
5903: table.LC_docs_adddocs th {
5904: border: 1px solid #BBBBBB;
5905: padding: 4px;
5906: background: #DDDDDD;
1.543 albertel 5907: }
5908:
1.584 albertel 5909: table.LC_sty_begin {
5910: background: #BBFFBB;
5911: }
1.795 www 5912:
1.584 albertel 5913: table.LC_sty_end {
5914: background: #FFBBBB;
5915: }
5916:
1.589 raeburn 5917: table.LC_double_column {
1.803 bisitz 5918: border-width: 0;
1.589 raeburn 5919: border-collapse: collapse;
5920: width: 100%;
5921: padding: 2px;
5922: }
5923:
5924: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 5925: top: 2px;
1.589 raeburn 5926: left: 2px;
5927: width: 47%;
5928: vertical-align: top;
5929: }
5930:
5931: table.LC_double_column tr td.LC_right_col {
5932: top: 2px;
1.779 bisitz 5933: right: 2px;
1.589 raeburn 5934: width: 47%;
5935: vertical-align: top;
5936: }
5937:
1.591 raeburn 5938: div.LC_left_float {
5939: float: left;
5940: padding-right: 5%;
1.597 albertel 5941: padding-bottom: 4px;
1.591 raeburn 5942: }
5943:
5944: div.LC_clear_float_header {
1.597 albertel 5945: padding-bottom: 2px;
1.591 raeburn 5946: }
5947:
5948: div.LC_clear_float_footer {
1.597 albertel 5949: padding-top: 10px;
1.591 raeburn 5950: clear: both;
5951: }
5952:
1.597 albertel 5953: div.LC_grade_show_user {
5954: margin-top: 20px;
5955: border: 1px solid black;
5956: }
1.795 www 5957:
1.597 albertel 5958: div.LC_grade_user_name {
5959: background: #DDDDEE;
5960: border-bottom: 1px solid black;
1.705 tempelho 5961: font-weight: bold;
5962: font-size: large;
1.597 albertel 5963: }
1.795 www 5964:
1.597 albertel 5965: div.LC_grade_show_user_odd_row div.LC_grade_user_name {
5966: background: #DDEEDD;
5967: }
5968:
5969: div.LC_grade_show_problem,
5970: div.LC_grade_submissions,
5971: div.LC_grade_message_center,
5972: div.LC_grade_info_links,
5973: div.LC_grade_assign {
5974: margin: 5px;
5975: width: 99%;
5976: background: #FFFFFF;
5977: }
1.795 www 5978:
1.597 albertel 5979: div.LC_grade_show_problem_header,
5980: div.LC_grade_submissions_header,
5981: div.LC_grade_message_center_header,
5982: div.LC_grade_assign_header {
1.705 tempelho 5983: font-weight: bold;
5984: font-size: large;
1.597 albertel 5985: }
1.795 www 5986:
1.597 albertel 5987: div.LC_grade_show_problem_problem,
5988: div.LC_grade_submissions_body,
5989: div.LC_grade_message_center_body,
5990: div.LC_grade_assign_body {
5991: border: 1px solid black;
5992: width: 99%;
5993: background: #FFFFFF;
5994: }
1.795 www 5995:
1.598 albertel 5996: span.LC_grade_check_note {
1.705 tempelho 5997: font-weight: normal;
5998: font-size: medium;
1.598 albertel 5999: display: inline;
6000: position: absolute;
6001: right: 1em;
6002: }
1.597 albertel 6003:
1.613 albertel 6004: table.LC_scantron_action {
6005: width: 100%;
6006: }
1.795 www 6007:
1.613 albertel 6008: table.LC_scantron_action tr th {
1.698 harmsja 6009: font-weight:bold;
6010: font-style:normal;
1.613 albertel 6011: }
1.795 www 6012:
1.779 bisitz 6013: .LC_edit_problem_header,
1.614 albertel 6014: div.LC_edit_problem_footer {
1.705 tempelho 6015: font-weight: normal;
6016: font-size: medium;
1.602 albertel 6017: margin: 2px;
1.600 albertel 6018: }
1.795 www 6019:
1.600 albertel 6020: div.LC_edit_problem_header,
1.602 albertel 6021: div.LC_edit_problem_header div,
1.614 albertel 6022: div.LC_edit_problem_footer,
6023: div.LC_edit_problem_footer div,
1.602 albertel 6024: div.LC_edit_problem_editxml_header,
6025: div.LC_edit_problem_editxml_header div {
1.600 albertel 6026: margin-top: 5px;
6027: }
1.795 www 6028:
1.600 albertel 6029: div.LC_edit_problem_header_title {
1.705 tempelho 6030: font-weight: bold;
6031: font-size: larger;
1.602 albertel 6032: background: $tabbg;
6033: padding: 3px;
6034: }
1.795 www 6035:
1.602 albertel 6036: table.LC_edit_problem_header_title {
1.705 tempelho 6037: font-size: larger;
6038: font-weight: bold;
1.602 albertel 6039: width: 100%;
6040: border-color: $pgbg;
6041: border-style: solid;
6042: border-width: $border;
1.600 albertel 6043: background: $tabbg;
1.602 albertel 6044: border-collapse: collapse;
1.803 bisitz 6045: padding: 0;
1.602 albertel 6046: }
6047:
6048: div.LC_edit_problem_discards {
6049: float: left;
6050: padding-bottom: 5px;
6051: }
1.795 www 6052:
1.602 albertel 6053: div.LC_edit_problem_saves {
6054: float: right;
6055: padding-bottom: 5px;
1.600 albertel 6056: }
1.795 www 6057:
1.911 bisitz 6058: img.stift {
1.803 bisitz 6059: border-width: 0;
6060: vertical-align: middle;
1.677 riegler 6061: }
1.680 riegler 6062:
1.923 bisitz 6063: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6064: vertical-align: top;
1.777 tempelho 6065: }
1.795 www 6066:
1.716 raeburn 6067: div.LC_createcourse {
1.911 bisitz 6068: margin: 10px 10px 10px 10px;
1.716 raeburn 6069: }
6070:
1.917 raeburn 6071: .LC_dccid {
6072: margin: 0.2em 0 0 0;
6073: padding: 0;
6074: font-size: 90%;
6075: display:none;
6076: }
6077:
1.693 droeschl 6078: /* ---- Remove when done ----
6079: # The following styles is part of the redesign of LON-CAPA and are
6080: # subject to change during this project.
6081: # Don't rely on their current functionality as they might be
6082: # changed or removed.
6083: # --------------------------*/
6084:
1.698 harmsja 6085: a:hover,
1.897 wenzelju 6086: ol.LC_primary_menu a:hover,
1.721 harmsja 6087: ol#LC_MenuBreadcrumbs a:hover,
6088: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6089: ul#LC_secondary_menu a:hover,
1.721 harmsja 6090: .LC_FormSectionClearButton input:hover
1.795 www 6091: ul.LC_TabContent li:hover a {
1.911 bisitz 6092: color:#BF2317;
6093: text-decoration:none;
1.693 droeschl 6094: }
6095:
1.779 bisitz 6096: h1 {
1.911 bisitz 6097: padding: 0;
6098: line-height:130%;
1.693 droeschl 6099: }
1.698 harmsja 6100:
1.911 bisitz 6101: h2,
6102: h3,
6103: h4,
6104: h5,
6105: h6 {
6106: margin: 5px 0 5px 0;
6107: padding: 0;
6108: line-height:130%;
1.693 droeschl 6109: }
1.795 www 6110:
6111: .LC_hcell {
1.911 bisitz 6112: padding:3px 15px 3px 15px;
6113: margin: 0;
6114: background-color:$tabbg;
6115: color:$fontmenu;
6116: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6117: }
1.795 www 6118:
1.840 bisitz 6119: .LC_Box > .LC_hcell {
1.911 bisitz 6120: margin: 0 -10px 10px -10px;
1.835 bisitz 6121: }
6122:
1.721 harmsja 6123: .LC_noBorder {
1.911 bisitz 6124: border: 0;
1.698 harmsja 6125: }
1.693 droeschl 6126:
1.721 harmsja 6127: .LC_FormSectionClearButton input {
1.911 bisitz 6128: background-color:transparent;
6129: border: none;
6130: cursor:pointer;
6131: text-decoration:underline;
1.693 droeschl 6132: }
1.763 bisitz 6133:
6134: .LC_help_open_topic {
1.911 bisitz 6135: color: #FFFFFF;
6136: background-color: #EEEEFF;
6137: margin: 1px;
6138: padding: 4px;
6139: border: 1px solid #000033;
6140: white-space: nowrap;
6141: /* vertical-align: middle; */
1.759 neumanie 6142: }
1.693 droeschl 6143:
1.911 bisitz 6144: dl,
6145: ul,
6146: div,
6147: fieldset {
6148: margin: 10px 10px 10px 0;
6149: /* overflow: hidden; */
1.693 droeschl 6150: }
1.795 www 6151:
1.838 bisitz 6152: fieldset > legend {
1.911 bisitz 6153: font-weight: bold;
6154: padding: 0 5px 0 5px;
1.838 bisitz 6155: }
6156:
1.925.2.14 raeburn 6157: div.LC_page_header {
6158: background-color: $pgbg_or_bgcolor;
6159: margin: 0 0 1.0em 0;
6160: }
6161:
1.813 bisitz 6162: #LC_nav_bar {
1.911 bisitz 6163: float: left;
6164: margin: 0.2em 0 0 0;
1.807 droeschl 6165: }
6166:
1.916 droeschl 6167: #LC_realm {
6168: margin: 0.2em 0 0 0;
6169: padding: 0;
6170: font-weight: bold;
6171: text-align: center;
6172: }
6173:
1.911 bisitz 6174: #LC_nav_bar em {
6175: font-weight: bold;
6176: font-style: normal;
1.807 droeschl 6177: }
6178:
1.897 wenzelju 6179: ol.LC_primary_menu {
1.911 bisitz 6180: float: right;
6181: margin: 0.2em 0 0 0;
1.807 droeschl 6182: }
6183:
1.925.2.15 raeburn 6184: span.LC_new_message{
6185: font-weight:bold;
6186: color: darkred;
6187: }
6188:
1.852 droeschl 6189: ol#LC_PathBreadcrumbs {
1.911 bisitz 6190: margin: 0;
1.693 droeschl 6191: }
6192:
1.897 wenzelju 6193: ol.LC_primary_menu li {
1.911 bisitz 6194: display: inline;
6195: padding: 5px 5px 0 10px;
6196: vertical-align: top;
1.693 droeschl 6197: }
6198:
1.897 wenzelju 6199: ol.LC_primary_menu li img {
1.911 bisitz 6200: vertical-align: bottom;
1.693 droeschl 6201: }
6202:
1.897 wenzelju 6203: ol.LC_primary_menu a {
1.911 bisitz 6204: font-size: 90%;
6205: color: RGB(80, 80, 80);
6206: text-decoration: none;
1.693 droeschl 6207: }
1.795 www 6208:
1.897 wenzelju 6209: ul#LC_secondary_menu {
1.911 bisitz 6210: clear: both;
6211: color: $fontmenu;
6212: background: $tabbg;
6213: list-style: none;
6214: padding: 0;
6215: margin: 0;
6216: width: 100%;
1.808 droeschl 6217: }
6218:
1.897 wenzelju 6219: ul#LC_secondary_menu li {
1.911 bisitz 6220: font-weight: bold;
6221: line-height: 1.8em;
6222: padding: 0 0.8em;
6223: border-right: 1px solid black;
6224: display: inline;
6225: vertical-align: middle;
1.807 droeschl 6226: }
6227:
1.847 tempelho 6228: ul.LC_TabContent {
1.911 bisitz 6229: display:block;
6230: background: $sidebg;
6231: border-bottom: solid 1px $lg_border_color;
6232: list-style:none;
6233: margin: 0 -10px;
6234: padding: 0;
1.693 droeschl 6235: }
6236:
1.795 www 6237: ul.LC_TabContent li,
6238: ul.LC_TabContentBigger li {
1.911 bisitz 6239: float:left;
1.741 harmsja 6240: }
1.795 www 6241:
1.897 wenzelju 6242: ul#LC_secondary_menu li a {
1.911 bisitz 6243: color: $fontmenu;
6244: text-decoration: none;
1.693 droeschl 6245: }
1.795 www 6246:
1.721 harmsja 6247: ul.LC_TabContent {
1.911 bisitz 6248: min-height:1.5em;
1.721 harmsja 6249: }
1.795 www 6250:
6251: ul.LC_TabContent li {
1.911 bisitz 6252: vertical-align:middle;
6253: padding: 0 10px 0 10px;
6254: background-color:$tabbg;
6255: border-bottom:solid 1px $lg_border_color;
1.721 harmsja 6256: }
1.795 www 6257:
1.847 tempelho 6258: ul.LC_TabContent .right {
1.911 bisitz 6259: float:right;
1.847 tempelho 6260: }
6261:
1.911 bisitz 6262: ul.LC_TabContent li a,
6263: ul.LC_TabContent li {
6264: color:rgb(47,47,47);
6265: text-decoration:none;
6266: font-size:95%;
6267: font-weight:bold;
6268: padding-right: 16px;
1.721 harmsja 6269: }
1.795 www 6270:
1.911 bisitz 6271: ul.LC_TabContent li:hover,
6272: ul.LC_TabContent li.active {
6273: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
6274: border-bottom:solid 2px #FFFFFF;
6275: padding-right: 16px;
1.744 ehlerst 6276: }
1.795 www 6277:
1.870 tempelho 6278: #maincoursedoc {
1.911 bisitz 6279: clear:both;
1.870 tempelho 6280: }
6281:
6282: ul.LC_TabContentBigger {
1.911 bisitz 6283: display:block;
6284: list-style:none;
6285: padding: 0;
1.870 tempelho 6286: }
6287:
1.795 www 6288: ul.LC_TabContentBigger li {
1.911 bisitz 6289: vertical-align:bottom;
6290: height: 30px;
6291: font-size:110%;
6292: font-weight:bold;
6293: color: #737373;
1.841 tempelho 6294: }
6295:
1.870 tempelho 6296:
6297: ul.LC_TabContentBigger li a {
1.911 bisitz 6298: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6299: height: 30px;
6300: line-height: 30px;
6301: text-align: center;
6302: display: block;
6303: text-decoration: none;
1.741 harmsja 6304: }
1.795 www 6305:
1.911 bisitz 6306: ul.LC_TabContentBigger li:hover a,
1.870 tempelho 6307: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6308: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6309: color:$font;
6310: text-decoration: underline;
1.744 ehlerst 6311: }
1.795 www 6312:
1.870 tempelho 6313:
6314: ul.LC_TabContentBigger li b {
1.911 bisitz 6315: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6316: display: block;
6317: float: left;
6318: padding: 0 30px;
1.870 tempelho 6319: }
6320:
6321: ul.LC_TabContentBigger li:hover b,
6322: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6323: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6324: color:$font;
6325: border-bottom: 1px solid #FFFFFF;
1.741 harmsja 6326: }
1.693 droeschl 6327:
1.870 tempelho 6328:
1.862 bisitz 6329: ul.LC_CourseBreadcrumbs {
6330: background: $sidebg;
6331: line-height: 32px;
6332: padding-left: 10px;
6333: margin: 0 0 10px 0;
6334: list-style-position: inside;
6335:
6336: }
6337:
1.911 bisitz 6338: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6339: ol#LC_PathBreadcrumbs {
1.911 bisitz 6340: padding-left: 10px;
6341: margin: 0;
1.925.2.14 raeburn 6342: margin: 0;
6343: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6344: }
6345:
1.911 bisitz 6346: ol#LC_MenuBreadcrumbs li,
6347: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6348: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6349: display: inline;
1.925.2.14 raeburn 6350: white-space: normal;
1.693 droeschl 6351: }
6352:
1.823 bisitz 6353: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6354: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6355: text-decoration: none;
6356: font-size:90%;
1.693 droeschl 6357: }
1.795 www 6358:
1.925.2.14 raeburn 6359: ol#LC_MenuBreadcrumbs h1 {
6360: display: inline;
6361: font-size: 90%;
6362: line-height: 2.5em;
6363: margin: 0;
6364: padding: 0;
6365: }
6366:
1.795 www 6367: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6368: text-decoration:none;
6369: font-size:100%;
6370: font-weight:bold;
1.693 droeschl 6371: }
1.795 www 6372:
1.840 bisitz 6373: .LC_Box {
1.911 bisitz 6374: border: solid 1px $lg_border_color;
6375: padding: 0 10px 10px 10px;
1.746 neumanie 6376: }
1.795 www 6377:
6378: .LC_AboutMe_Image {
1.911 bisitz 6379: float:left;
6380: margin-right:10px;
1.747 neumanie 6381: }
1.795 www 6382:
6383: .LC_Clear_AboutMe_Image {
1.911 bisitz 6384: clear:left;
1.747 neumanie 6385: }
1.795 www 6386:
1.721 harmsja 6387: dl.LC_ListStyleClean dt {
1.911 bisitz 6388: padding-right: 5px;
6389: display: table-header-group;
1.693 droeschl 6390: }
6391:
1.721 harmsja 6392: dl.LC_ListStyleClean dd {
1.911 bisitz 6393: display: table-row;
1.693 droeschl 6394: }
6395:
1.721 harmsja 6396: .LC_ListStyleClean,
6397: .LC_ListStyleSimple,
6398: .LC_ListStyleNormal,
1.795 www 6399: .LC_ListStyleSpecial {
1.911 bisitz 6400: /* display:block; */
6401: list-style-position: inside;
6402: list-style-type: none;
6403: overflow: hidden;
6404: padding: 0;
1.693 droeschl 6405: }
6406:
1.721 harmsja 6407: .LC_ListStyleSimple li,
6408: .LC_ListStyleSimple dd,
6409: .LC_ListStyleNormal li,
6410: .LC_ListStyleNormal dd,
6411: .LC_ListStyleSpecial li,
1.795 www 6412: .LC_ListStyleSpecial dd {
1.911 bisitz 6413: margin: 0;
6414: padding: 5px 5px 5px 10px;
6415: clear: both;
1.693 droeschl 6416: }
6417:
1.721 harmsja 6418: .LC_ListStyleClean li,
6419: .LC_ListStyleClean dd {
1.911 bisitz 6420: padding-top: 0;
6421: padding-bottom: 0;
1.693 droeschl 6422: }
6423:
1.721 harmsja 6424: .LC_ListStyleSimple dd,
1.795 www 6425: .LC_ListStyleSimple li {
1.911 bisitz 6426: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 6427: }
6428:
1.721 harmsja 6429: .LC_ListStyleSpecial li,
6430: .LC_ListStyleSpecial dd {
1.911 bisitz 6431: list-style-type: none;
6432: background-color: RGB(220, 220, 220);
6433: margin-bottom: 4px;
1.693 droeschl 6434: }
6435:
1.721 harmsja 6436: table.LC_SimpleTable {
1.911 bisitz 6437: margin:5px;
6438: border:solid 1px $lg_border_color;
1.795 www 6439: }
1.693 droeschl 6440:
1.721 harmsja 6441: table.LC_SimpleTable tr {
1.911 bisitz 6442: padding: 0;
6443: border:solid 1px $lg_border_color;
1.693 droeschl 6444: }
1.795 www 6445:
6446: table.LC_SimpleTable thead {
1.911 bisitz 6447: background:rgb(220,220,220);
1.693 droeschl 6448: }
6449:
1.721 harmsja 6450: div.LC_columnSection {
1.911 bisitz 6451: display: block;
6452: clear: both;
6453: overflow: hidden;
6454: margin: 0;
1.693 droeschl 6455: }
6456:
1.721 harmsja 6457: div.LC_columnSection>* {
1.911 bisitz 6458: float: left;
6459: margin: 10px 20px 10px 0;
6460: overflow:hidden;
1.693 droeschl 6461: }
1.721 harmsja 6462:
1.694 tempelho 6463: .LC_loginpage_container {
1.911 bisitz 6464: text-align:left;
6465: margin : 0 auto;
6466: width:90%;
6467: padding: 10px;
6468: height: auto;
6469: background-color:#FFFFFF;
6470: border:1px solid #CCCCCC;
1.694 tempelho 6471: }
6472:
6473:
6474: .LC_loginpage_loginContainer {
1.911 bisitz 6475: float:left;
6476: width: 182px;
6477: padding: 2px;
6478: border:1px solid #CCCCCC;
6479: background-color:$loginbg;
1.694 tempelho 6480: }
6481:
1.795 www 6482: .LC_loginpage_loginContainer h2 {
1.911 bisitz 6483: margin-top: 0;
6484: display:block;
6485: background:$bgcol;
6486: color:$textcol;
6487: padding-left:5px;
1.712 muellerd 6488: }
1.785 tempelho 6489:
1.694 tempelho 6490: .LC_loginpage_loginInfo {
1.911 bisitz 6491: float:left;
6492: width:182px;
6493: border:1px solid #CCCCCC;
6494: padding:2px;
1.712 muellerd 6495: }
6496:
1.694 tempelho 6497: .LC_loginpage_space {
1.911 bisitz 6498: clear: both;
6499: margin-bottom: 20px;
6500: border-bottom: 1px solid #CCCCCC;
1.694 tempelho 6501: }
6502:
1.785 tempelho 6503: .LC_loginpage_floatLeft {
1.911 bisitz 6504: float: left;
6505: width: 200px;
6506: margin: 0;
1.785 tempelho 6507: }
6508:
1.795 www 6509: table em {
1.911 bisitz 6510: font-weight: bold;
6511: font-style: normal;
1.748 schulted 6512: }
1.795 www 6513:
1.779 bisitz 6514: table.LC_tableBrowseRes,
1.795 www 6515: table.LC_tableOfContent {
1.911 bisitz 6516: border:none;
6517: border-spacing: 1px;
6518: padding: 3px;
6519: background-color: #FFFFFF;
6520: font-size: 90%;
1.753 droeschl 6521: }
1.789 droeschl 6522:
1.911 bisitz 6523: table.LC_tableOfContent {
6524: border-collapse: collapse;
1.789 droeschl 6525: }
6526:
1.771 droeschl 6527: table.LC_tableBrowseRes a,
1.768 schulted 6528: table.LC_tableOfContent a {
1.911 bisitz 6529: background-color: transparent;
6530: text-decoration: none;
1.753 droeschl 6531: }
6532:
1.795 www 6533: table.LC_tableOfContent img {
1.911 bisitz 6534: border: none;
6535: height: 1.3em;
6536: vertical-align: text-bottom;
6537: margin-right: 0.3em;
1.753 droeschl 6538: }
1.757 schulted 6539:
1.795 www 6540: a#LC_content_toolbar_firsthomework {
1.911 bisitz 6541: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 6542: }
6543:
1.795 www 6544: a#LC_content_toolbar_launchnav {
1.911 bisitz 6545: background-image:url(/res/adm/pages/start-navigation.gif);
1.774 ehlerst 6546: }
6547:
1.795 www 6548: a#LC_content_toolbar_closenav {
1.911 bisitz 6549: background-image:url(/res/adm/pages/close-navigation.gif);
1.774 ehlerst 6550: }
6551:
1.795 www 6552: a#LC_content_toolbar_everything {
1.911 bisitz 6553: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 6554: }
6555:
1.795 www 6556: a#LC_content_toolbar_uncompleted {
1.911 bisitz 6557: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 6558: }
6559:
1.795 www 6560: #LC_content_toolbar_clearbubbles {
1.911 bisitz 6561: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 6562: }
6563:
1.795 www 6564: a#LC_content_toolbar_changefolder {
1.911 bisitz 6565: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 6566: }
6567:
1.795 www 6568: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 6569: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 6570: }
6571:
1.925.2.17 raeburn 6572: a#LC_content_toolbar_management {
1.925.2.18! raeburn 6573: background-image:url(/res/adm/pages/navtomenu.png);
1.925.2.17 raeburn 6574: }
6575:
1.795 www 6576: ul#LC_toolbar li a:hover {
1.911 bisitz 6577: background-position: bottom center;
1.757 schulted 6578: }
6579:
1.795 www 6580: ul#LC_toolbar {
1.911 bisitz 6581: padding: 0;
6582: margin: 2px;
6583: list-style:none;
6584: position:relative;
6585: background-color:white;
1.757 schulted 6586: }
6587:
1.795 www 6588: ul#LC_toolbar li {
1.911 bisitz 6589: border:1px solid white;
6590: padding: 0;
6591: margin: 0;
6592: float: left;
6593: display:inline;
6594: vertical-align:middle;
6595: }
1.757 schulted 6596:
1.783 amueller 6597:
1.795 www 6598: a.LC_toolbarItem {
1.911 bisitz 6599: display:block;
6600: padding: 0;
6601: margin: 0;
6602: height: 32px;
6603: width: 32px;
6604: color:white;
6605: border: none;
6606: background-repeat:no-repeat;
6607: background-color:transparent;
1.757 schulted 6608: }
6609:
1.915 droeschl 6610: ul.LC_funclist {
6611: margin: 0;
6612: padding: 0.5em 1em 0.5em 0;
6613: }
6614:
1.925.2.14 raeburn 6615: ul.LC_funclist > li:first-child {
6616: font-weight:bold;
6617: margin-left:0.8em;
6618: }
6619:
1.915 droeschl 6620: ul.LC_funclist + ul.LC_funclist {
6621: /*
6622: left border as a seperator if we have more than
6623: one list
6624: */
6625: border-left: 1px solid $sidebg;
6626: /*
6627: this hides the left border behind the border of the
6628: outer box if element is wrapped to the next 'line'
6629: */
6630: margin-left: -1px;
6631: }
6632:
1.843 bisitz 6633: ul.LC_funclist li {
1.915 droeschl 6634: display: inline;
1.782 bisitz 6635: white-space: nowrap;
1.915 droeschl 6636: margin: 0 0 0 25px;
6637: line-height: 150%;
1.782 bisitz 6638: }
6639:
1.925.2.1 raeburn 6640: #gciheader {
6641: float:left;
6642: width:100%;
6643: background:#DAE0D2 url("/gcimenu_bg.gif") repeat-x bottom;
6644: font-size:93%;
6645: line-height:normal;
1.925.2.14 raeburn 6646: margin: 0.5em 0 0.5em 0;
1.925.2.1 raeburn 6647: }
6648: #gciheader ul {
6649: margin:0;
1.925.2.16 raeburn 6650: padding:10px 10px 0;
1.925.2.1 raeburn 6651: list-style:none;
6652: }
6653: #gciheader li {
6654: float:left;
6655: background:url("/gcimenu_left.gif") no-repeat left top;
6656: margin:0;
6657: padding:0 0 0 9px;
6658: }
6659: #gciheader a {
6660: display:block;
6661: background:url("/gcimenu_right.gif") no-repeat right top;
6662: padding:5px 15px 4px 6px;
6663: }
6664: #gciheader #current {
6665: background-image:url("/gcimenu_left_on.gif");
6666: }
6667: #gciheader #current a {
6668: background-image:url("/gcimenu_right_on.gif");
6669: padding-bottom:5px;
6670: }
1.757 schulted 6671:
1.343 albertel 6672: END
6673: }
6674:
1.306 albertel 6675: =pod
6676:
6677: =item * &headtag()
6678:
6679: Returns a uniform footer for LON-CAPA web pages.
6680:
1.307 albertel 6681: Inputs: $title - optional title for the head
6682: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 6683: $args - optional arguments
1.319 albertel 6684: force_register - if is true call registerurl so the remote is
6685: informed
1.415 albertel 6686: redirect -> array ref of
6687: 1- seconds before redirect occurs
6688: 2- url to redirect to
6689: 3- whether the side effect should occur
1.315 albertel 6690: (side effect of setting
6691: $env{'internal.head.redirect'} to the url
6692: redirected too)
1.352 albertel 6693: domain -> force to color decorate a page for a specific
6694: domain
6695: function -> force usage of a specific rolish color scheme
6696: bgcolor -> override the default page bgcolor
1.460 albertel 6697: no_auto_mt_title
6698: -> prevent &mt()ing the title arg
1.464 albertel 6699:
1.306 albertel 6700: =cut
6701:
6702: sub headtag {
1.313 albertel 6703: my ($title,$head_extra,$args) = @_;
1.306 albertel 6704:
1.363 albertel 6705: my $function = $args->{'function'} || &get_users_function();
6706: my $domain = $args->{'domain'} || &determinedomain();
6707: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 6708: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 6709: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 6710: #time(),
1.418 albertel 6711: $env{'environment.color.timestamp'},
1.363 albertel 6712: $function,$domain,$bgcolor);
6713:
1.369 www 6714: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 6715:
1.308 albertel 6716: my $result =
6717: '<head>'.
1.461 albertel 6718: &font_settings();
1.319 albertel 6719:
1.461 albertel 6720: if (!$args->{'frameset'}) {
6721: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
6722: }
1.319 albertel 6723: if ($args->{'force_register'}) {
6724: $result .= &Apache::lonmenu::registerurl(1);
6725: }
1.436 albertel 6726: if (!$args->{'no_nav_bar'}
6727: && !$args->{'only_body'}
6728: && !$args->{'frameset'}) {
6729: $result .= &help_menu_js();
6730: }
1.319 albertel 6731:
1.314 albertel 6732: if (ref($args->{'redirect'})) {
1.414 albertel 6733: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 6734: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 6735: if (!$inhibit_continue) {
6736: $env{'internal.head.redirect'} = $url;
6737: }
1.313 albertel 6738: $result.=<<ADDMETA
6739: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 6740: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 6741: ADDMETA
6742: }
1.306 albertel 6743: if (!defined($title)) {
6744: $title = 'The LearningOnline Network with CAPA';
6745: }
1.460 albertel 6746: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
6747: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 6748: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
6749: .$head_extra;
1.306 albertel 6750: return $result;
6751: }
6752:
6753: =pod
6754:
1.340 albertel 6755: =item * &font_settings()
6756:
6757: Returns neccessary <meta> to set the proper encoding
6758:
6759: Inputs: none
6760:
6761: =cut
6762:
6763: sub font_settings {
6764: my $headerstring='';
1.647 www 6765: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 6766: $headerstring.=
6767: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
6768: }
6769: return $headerstring;
6770: }
6771:
1.341 albertel 6772: =pod
6773:
6774: =item * &xml_begin()
6775:
6776: Returns the needed doctype and <html>
6777:
6778: Inputs: none
6779:
6780: =cut
6781:
6782: sub xml_begin {
6783: my $output='';
6784:
1.592 albertel 6785: if ($env{'internal.start_page'}==1) {
6786: &Apache::lonhtmlcommon::init_htmlareafields();
6787: }
1.342 albertel 6788:
1.341 albertel 6789: if ($env{'browser.mathml'}) {
6790: $output='<?xml version="1.0"?>'
6791: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
6792: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
6793:
6794: # .'<!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">] >'
6795: .'<!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">'
6796: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
6797: .'xmlns="http://www.w3.org/1999/xhtml">';
6798: } else {
1.849 bisitz 6799: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
6800: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 6801: }
6802: return $output;
6803: }
1.340 albertel 6804:
6805: =pod
6806:
1.306 albertel 6807: =item * &endheadtag()
6808:
6809: Returns a uniform </head> for LON-CAPA web pages.
6810:
6811: Inputs: none
6812:
6813: =cut
6814:
6815: sub endheadtag {
6816: return '</head>';
6817: }
6818:
6819: =pod
6820:
6821: =item * &head()
6822:
6823: Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
6824:
1.648 raeburn 6825: Inputs:
6826:
6827: =over 4
6828:
6829: $title - optional title for the page
6830:
6831: $head_extra - optional extra HTML to put inside the <head>
6832:
6833: =back
1.405 albertel 6834:
1.306 albertel 6835: =cut
6836:
6837: sub head {
1.325 albertel 6838: my ($title,$head_extra,$args) = @_;
6839: return &headtag($title,$head_extra,$args).&endheadtag();
1.306 albertel 6840: }
6841:
6842: =pod
6843:
6844: =item * &start_page()
6845:
6846: Returns a complete <html> .. <body> section for LON-CAPA web pages.
6847:
1.648 raeburn 6848: Inputs:
6849:
6850: =over 4
6851:
6852: $title - optional title for the page
6853:
6854: $head_extra - optional extra HTML to incude inside the <head>
6855:
6856: $args - additional optional args supported are:
6857:
6858: =over 8
6859:
6860: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 6861: arg on
1.814 bisitz 6862: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 6863: add_entries -> additional attributes to add to the <body>
6864: domain -> force to color decorate a page for a
1.317 albertel 6865: specific domain
1.648 raeburn 6866: function -> force usage of a specific rolish color
1.317 albertel 6867: scheme
1.648 raeburn 6868: redirect -> see &headtag()
6869: bgcolor -> override the default page bg color
6870: js_ready -> return a string ready for being used in
1.317 albertel 6871: a javascript writeln
1.648 raeburn 6872: html_encode -> return a string ready for being used in
1.320 albertel 6873: a html attribute
1.648 raeburn 6874: force_register -> if is true will turn on the &bodytag()
1.317 albertel 6875: $forcereg arg
1.648 raeburn 6876: frameset -> if true will start with a <frameset>
1.330 albertel 6877: rather than <body>
1.648 raeburn 6878: skip_phases -> hash ref of
1.338 albertel 6879: head -> skip the <html><head> generation
6880: body -> skip all <body> generation
1.648 raeburn 6881: no_inline_link -> if true and in remote mode, don't show the
1.361 albertel 6882: 'Switch To Inline Menu' link
1.648 raeburn 6883: no_auto_mt_title -> prevent &mt()ing the title arg
6884: inherit_jsmath -> when creating popup window in a page,
6885: should it have jsmath forced on by the
6886: current page
1.867 kalberla 6887: bread_crumbs -> Array containing breadcrumbs
6888: bread_crumbs_components -> if exists show it as headline else show only the breadcrumbs
1.361 albertel 6889:
1.648 raeburn 6890: =back
1.460 albertel 6891:
1.648 raeburn 6892: =back
1.562 albertel 6893:
1.306 albertel 6894: =cut
6895:
6896: sub start_page {
1.309 albertel 6897: my ($title,$head_extra,$args) = @_;
1.318 albertel 6898: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.313 albertel 6899: my %head_args;
1.352 albertel 6900: foreach my $arg ('redirect','force_register','domain','function',
1.460 albertel 6901: 'bgcolor','frameset','no_nav_bar','only_body',
6902: 'no_auto_mt_title') {
1.319 albertel 6903: if (defined($args->{$arg})) {
1.324 raeburn 6904: $head_args{$arg} = $args->{$arg};
1.319 albertel 6905: }
1.313 albertel 6906: }
1.319 albertel 6907:
1.315 albertel 6908: $env{'internal.start_page'}++;
1.338 albertel 6909: my $result;
6910: if (! exists($args->{'skip_phases'}{'head'}) ) {
6911: $result.=
1.341 albertel 6912: &xml_begin().
1.338 albertel 6913: &headtag($title,$head_extra,\%head_args).&endheadtag();
6914: }
6915:
6916: if (! exists($args->{'skip_phases'}{'body'}) ) {
6917: if ($args->{'frameset'}) {
6918: my $attr_string = &make_attr_string($args->{'force_register'},
6919: $args->{'add_entries'});
6920: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 6921: } else {
6922: $result .=
6923: &bodytag($title,
6924: $args->{'function'}, $args->{'add_entries'},
6925: $args->{'only_body'}, $args->{'domain'},
6926: $args->{'force_register'}, $args->{'no_nav_bar'},
6927: $args->{'bgcolor'}, $args->{'no_inline_link'},
6928: $args);
6929: }
1.330 albertel 6930: }
1.338 albertel 6931:
1.315 albertel 6932: if ($args->{'js_ready'}) {
1.713 kaisler 6933: $result = &js_ready($result);
1.315 albertel 6934: }
1.320 albertel 6935: if ($args->{'html_encode'}) {
1.713 kaisler 6936: $result = &html_encode($result);
6937: }
6938:
1.813 bisitz 6939: # Preparation for new and consistent functionlist at top of screen
6940: # if ($args->{'functionlist'}) {
6941: # $result .= &build_functionlist();
6942: #}
6943:
6944: # Don't add anything more if only_body wanted
6945: return $result if $args->{'only_body'};
6946:
1.920 raeburn 6947: #Breadcrumbs for Construction Space provided by &bodytag.
6948: if (($env{'environment.remote'} eq 'off') && ($env{'request.state'} eq 'construct')) {
6949: return $result;
6950: }
6951:
1.813 bisitz 6952: #Breadcrumbs
1.758 kaisler 6953: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
6954: &Apache::lonhtmlcommon::clear_breadcrumbs();
6955: #if any br links exists, add them to the breadcrumbs
6956: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6957: foreach my $crumb (@{$args->{'bread_crumbs'}}){
6958: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
6959: }
6960: }
6961:
6962: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
6963: if(exists($args->{'bread_crumbs_component'})){
6964: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.925.2.16 raeburn 6965: } elsif (exists($args->{'bread_crumbs_menulink'})) {
1.925.2.17 raeburn 6966: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$args->{'bread_crumbs_menulink'});
1.925.2.16 raeburn 6967: } else {
1.925.2.17 raeburn 6968: $result .= &Apache::lonhtmlcommon::breadcrumbs();
1.758 kaisler 6969: }
1.320 albertel 6970: }
1.315 albertel 6971: return $result;
1.306 albertel 6972: }
6973:
1.330 albertel 6974:
1.306 albertel 6975: =pod
6976:
6977: =item * &head()
6978:
6979: Returns a complete </body></html> section for LON-CAPA web pages.
6980:
1.315 albertel 6981: Inputs: $args - additional optional args supported are:
6982: js_ready -> return a string ready for being used in
6983: a javascript writeln
1.320 albertel 6984: html_encode -> return a string ready for being used in
6985: a html attribute
1.330 albertel 6986: frameset -> if true will start with a <frameset>
6987: rather than <body>
1.493 albertel 6988: dicsussion -> if true will get discussion from
6989: lonxml::xmlend
6990: (you can pass the target and parser arguments
6991: through optional 'target' and 'parser' args
6992: to this routine)
1.306 albertel 6993:
6994: =cut
6995:
6996: sub end_page {
1.315 albertel 6997: my ($args) = @_;
6998: $env{'internal.end_page'}++;
1.330 albertel 6999: my $result;
1.335 albertel 7000: if ($args->{'discussion'}) {
7001: my ($target,$parser);
7002: if (ref($args->{'discussion'})) {
7003: ($target,$parser) =($args->{'discussion'}{'target'},
7004: $args->{'discussion'}{'parser'});
7005: }
7006: $result .= &Apache::lonxml::xmlend($target,$parser);
7007: }
7008:
1.330 albertel 7009: if ($args->{'frameset'}) {
7010: $result .= '</frameset>';
7011: } else {
1.635 raeburn 7012: $result .= &endbodytag($args);
1.330 albertel 7013: }
7014: $result .= "\n</html>";
7015:
1.315 albertel 7016: if ($args->{'js_ready'}) {
1.317 albertel 7017: $result = &js_ready($result);
1.315 albertel 7018: }
1.335 albertel 7019:
1.320 albertel 7020: if ($args->{'html_encode'}) {
7021: $result = &html_encode($result);
7022: }
1.335 albertel 7023:
1.315 albertel 7024: return $result;
7025: }
7026:
1.320 albertel 7027: sub html_encode {
7028: my ($result) = @_;
7029:
1.322 albertel 7030: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7031:
7032: return $result;
7033: }
1.317 albertel 7034: sub js_ready {
7035: my ($result) = @_;
7036:
1.323 albertel 7037: $result =~ s/[\n\r]/ /xmsg;
7038: $result =~ s/\\/\\\\/xmsg;
7039: $result =~ s/'/\\'/xmsg;
1.372 albertel 7040: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7041:
7042: return $result;
7043: }
7044:
1.315 albertel 7045: sub validate_page {
7046: if ( exists($env{'internal.start_page'})
1.316 albertel 7047: && $env{'internal.start_page'} > 1) {
7048: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7049: $env{'internal.start_page'}.' '.
1.316 albertel 7050: $ENV{'request.filename'});
1.315 albertel 7051: }
7052: if ( exists($env{'internal.end_page'})
1.316 albertel 7053: && $env{'internal.end_page'} > 1) {
7054: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7055: $env{'internal.end_page'}.' '.
1.316 albertel 7056: $env{'request.filename'});
1.315 albertel 7057: }
7058: if ( exists($env{'internal.start_page'})
7059: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7060: &Apache::lonnet::logthis('start_page called without end_page '.
7061: $env{'request.filename'});
1.315 albertel 7062: }
7063: if ( ! exists($env{'internal.start_page'})
7064: && exists($env{'internal.end_page'})) {
1.316 albertel 7065: &Apache::lonnet::logthis('end_page called without start_page'.
7066: $env{'request.filename'});
1.315 albertel 7067: }
1.306 albertel 7068: }
1.315 albertel 7069:
1.318 albertel 7070: sub simple_error_page {
7071: my ($r,$title,$msg) = @_;
7072: my $page =
7073: &Apache::loncommon::start_page($title).
7074: &mt($msg).
7075: &Apache::loncommon::end_page();
7076: if (ref($r)) {
7077: $r->print($page);
1.327 albertel 7078: return;
1.318 albertel 7079: }
7080: return $page;
7081: }
1.347 albertel 7082:
7083: {
1.610 albertel 7084: my @row_count;
1.347 albertel 7085: sub start_data_table {
1.422 albertel 7086: my ($add_class) = @_;
7087: my $css_class = (join(' ','LC_data_table',$add_class));
1.610 albertel 7088: unshift(@row_count,0);
1.422 albertel 7089: return '<table class="'.$css_class.'">'."\n";
1.347 albertel 7090: }
7091:
7092: sub end_data_table {
1.610 albertel 7093: shift(@row_count);
1.389 albertel 7094: return '</table>'."\n";;
1.347 albertel 7095: }
7096:
7097: sub start_data_table_row {
1.422 albertel 7098: my ($add_class) = @_;
1.610 albertel 7099: $row_count[0]++;
7100: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 7101: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.422 albertel 7102: return '<tr class="'.$css_class.'">'."\n";;
1.347 albertel 7103: }
1.471 banghart 7104:
7105: sub continue_data_table_row {
7106: my ($add_class) = @_;
1.610 albertel 7107: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 7108: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');;
1.471 banghart 7109: return '<tr class="'.$css_class.'">'."\n";;
7110: }
1.347 albertel 7111:
7112: sub end_data_table_row {
1.389 albertel 7113: return '</tr>'."\n";;
1.347 albertel 7114: }
1.367 www 7115:
1.421 albertel 7116: sub start_data_table_empty_row {
1.707 bisitz 7117: # $row_count[0]++;
1.421 albertel 7118: return '<tr class="LC_empty_row" >'."\n";;
7119: }
7120:
7121: sub end_data_table_empty_row {
7122: return '</tr>'."\n";;
7123: }
7124:
1.367 www 7125: sub start_data_table_header_row {
1.389 albertel 7126: return '<tr class="LC_header_row">'."\n";;
1.367 www 7127: }
7128:
7129: sub end_data_table_header_row {
1.389 albertel 7130: return '</tr>'."\n";;
1.367 www 7131: }
1.890 droeschl 7132:
7133: sub data_table_caption {
7134: my $caption = shift;
7135: return "<caption class=\"LC_caption\">$caption</caption>";
7136: }
1.347 albertel 7137: }
7138:
1.548 albertel 7139: =pod
7140:
7141: =item * &inhibit_menu_check($arg)
7142:
7143: Checks for a inhibitmenu state and generates output to preserve it
7144:
7145: Inputs: $arg - can be any of
7146: - undef - in which case the return value is a string
7147: to add into arguments list of a uri
7148: - 'input' - in which case the return value is a HTML
7149: <form> <input> field of type hidden to
7150: preserve the value
7151: - a url - in which case the return value is the url with
7152: the neccesary cgi args added to preserve the
7153: inhibitmenu state
7154: - a ref to a url - no return value, but the string is
7155: updated to include the neccessary cgi
7156: args to preserve the inhibitmenu state
7157:
7158: =cut
7159:
7160: sub inhibit_menu_check {
7161: my ($arg) = @_;
7162: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
7163: if ($arg eq 'input') {
7164: if ($env{'form.inhibitmenu'}) {
7165: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
7166: } else {
7167: return
7168: }
7169: }
7170: if ($env{'form.inhibitmenu'}) {
7171: if (ref($arg)) {
7172: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
7173: } elsif ($arg eq '') {
7174: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
7175: } else {
7176: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
7177: }
7178: }
7179: if (!ref($arg)) {
7180: return $arg;
7181: }
7182: }
7183:
1.251 albertel 7184: ###############################################
1.182 matthew 7185:
7186: =pod
7187:
1.549 albertel 7188: =back
7189:
7190: =head1 User Information Routines
7191:
7192: =over 4
7193:
1.405 albertel 7194: =item * &get_users_function()
1.182 matthew 7195:
7196: Used by &bodytag to determine the current users primary role.
7197: Returns either 'student','coordinator','admin', or 'author'.
7198:
7199: =cut
7200:
7201: ###############################################
7202: sub get_users_function {
1.815 tempelho 7203: my $function = 'norole';
1.818 tempelho 7204: if ($env{'request.role'}=~/^(st)/) {
7205: $function='student';
7206: }
1.907 raeburn 7207: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 7208: $function='coordinator';
7209: }
1.258 albertel 7210: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 7211: $function='admin';
7212: }
1.826 bisitz 7213: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.182 matthew 7214: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
7215: $function='author';
7216: }
7217: return $function;
1.54 www 7218: }
1.99 www 7219:
7220: ###############################################
7221:
1.233 raeburn 7222: =pod
7223:
1.821 raeburn 7224: =item * &show_course()
7225:
7226: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
7227: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
7228:
7229: Inputs:
7230: None
7231:
7232: Outputs:
7233: Scalar: 1 if 'Course' to be used, 0 otherwise.
7234:
7235: =cut
7236:
7237: ###############################################
7238: sub show_course {
7239: my $course = !$env{'user.adv'};
7240: if (!$env{'user.adv'}) {
7241: foreach my $env (keys(%env)) {
7242: next if ($env !~ m/^user\.priv\./);
7243: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
7244: $course = 0;
7245: last;
7246: }
7247: }
7248: }
7249: return $course;
7250: }
7251:
7252: ###############################################
7253:
7254: =pod
7255:
1.542 raeburn 7256: =item * &check_user_status()
1.274 raeburn 7257:
7258: Determines current status of supplied role for a
7259: specific user. Roles can be active, previous or future.
7260:
7261: Inputs:
7262: user's domain, user's username, course's domain,
1.375 raeburn 7263: course's number, optional section ID.
1.274 raeburn 7264:
7265: Outputs:
7266: role status: active, previous or future.
7267:
7268: =cut
7269:
7270: sub check_user_status {
1.412 raeburn 7271: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.274 raeburn 7272: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
7273: my @uroles = keys %userinfo;
7274: my $srchstr;
7275: my $active_chk = 'none';
1.412 raeburn 7276: my $now = time;
1.274 raeburn 7277: if (@uroles > 0) {
1.908 raeburn 7278: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 7279: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
7280: } else {
1.412 raeburn 7281: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
7282: }
7283: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 7284: my $role_end = 0;
7285: my $role_start = 0;
7286: $active_chk = 'active';
1.412 raeburn 7287: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
7288: $role_end = $1;
7289: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
7290: $role_start = $1;
1.274 raeburn 7291: }
7292: }
7293: if ($role_start > 0) {
1.412 raeburn 7294: if ($now < $role_start) {
1.274 raeburn 7295: $active_chk = 'future';
7296: }
7297: }
7298: if ($role_end > 0) {
1.412 raeburn 7299: if ($now > $role_end) {
1.274 raeburn 7300: $active_chk = 'previous';
7301: }
7302: }
7303: }
7304: }
7305: return $active_chk;
7306: }
7307:
7308: ###############################################
7309:
7310: =pod
7311:
1.405 albertel 7312: =item * &get_sections()
1.233 raeburn 7313:
7314: Determines all the sections for a course including
7315: sections with students and sections containing other roles.
1.419 raeburn 7316: Incoming parameters:
7317:
7318: 1. domain
7319: 2. course number
7320: 3. reference to array containing roles for which sections should
7321: be gathered (optional).
7322: 4. reference to array containing status types for which sections
7323: should be gathered (optional).
7324:
7325: If the third argument is undefined, sections are gathered for any role.
7326: If the fourth argument is undefined, sections are gathered for any status.
7327: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 7328:
1.374 raeburn 7329: Returns section hash (keys are section IDs, values are
7330: number of users in each section), subject to the
1.419 raeburn 7331: optional roles filter, optional status filter
1.233 raeburn 7332:
7333: =cut
7334:
7335: ###############################################
7336: sub get_sections {
1.419 raeburn 7337: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 7338: if (!defined($cdom) || !defined($cnum)) {
7339: my $cid = $env{'request.course.id'};
7340:
7341: return if (!defined($cid));
7342:
7343: $cdom = $env{'course.'.$cid.'.domain'};
7344: $cnum = $env{'course.'.$cid.'.num'};
7345: }
7346:
7347: my %sectioncount;
1.419 raeburn 7348: my $now = time;
1.240 albertel 7349:
1.366 albertel 7350: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 7351: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 7352: my $sec_index = &Apache::loncoursedata::CL_SECTION();
7353: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 7354: my $start_index = &Apache::loncoursedata::CL_START();
7355: my $end_index = &Apache::loncoursedata::CL_END();
7356: my $status;
1.366 albertel 7357: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 7358: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
7359: $data->[$status_index],
7360: $data->[$start_index],
7361: $data->[$end_index]);
7362: if ($stu_status eq 'Active') {
7363: $status = 'active';
7364: } elsif ($end < $now) {
7365: $status = 'previous';
7366: } elsif ($start > $now) {
7367: $status = 'future';
7368: }
7369: if ($section ne '-1' && $section !~ /^\s*$/) {
7370: if ((!defined($possible_status)) || (($status ne '') &&
7371: (grep/^\Q$status\E$/,@{$possible_status}))) {
7372: $sectioncount{$section}++;
7373: }
1.240 albertel 7374: }
7375: }
7376: }
7377: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7378: foreach my $user (sort(keys(%courseroles))) {
7379: if ($user !~ /^(\w{2})/) { next; }
7380: my ($role) = ($user =~ /^(\w{2})/);
7381: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 7382: my ($section,$status);
1.240 albertel 7383: if ($role eq 'cr' &&
7384: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
7385: $section=$1;
7386: }
7387: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
7388: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 7389: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
7390: if ($end == -1 && $start == -1) {
7391: next; #deleted role
7392: }
7393: if (!defined($possible_status)) {
7394: $sectioncount{$section}++;
7395: } else {
7396: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
7397: $status = 'active';
7398: } elsif ($end < $now) {
7399: $status = 'future';
7400: } elsif ($start > $now) {
7401: $status = 'previous';
7402: }
7403: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
7404: $sectioncount{$section}++;
7405: }
7406: }
1.233 raeburn 7407: }
1.366 albertel 7408: return %sectioncount;
1.233 raeburn 7409: }
7410:
1.274 raeburn 7411: ###############################################
1.294 raeburn 7412:
7413: =pod
1.405 albertel 7414:
7415: =item * &get_course_users()
7416:
1.275 raeburn 7417: Retrieves usernames:domains for users in the specified course
7418: with specific role(s), and access status.
7419:
7420: Incoming parameters:
1.277 albertel 7421: 1. course domain
7422: 2. course number
7423: 3. access status: users must have - either active,
1.275 raeburn 7424: previous, future, or all.
1.277 albertel 7425: 4. reference to array of permissible roles
1.288 raeburn 7426: 5. reference to array of section restrictions (optional)
7427: 6. reference to results object (hash of hashes).
7428: 7. reference to optional userdata hash
1.609 raeburn 7429: 8. reference to optional statushash
1.630 raeburn 7430: 9. flag if privileged users (except those set to unhide in
7431: course settings) should be excluded
1.609 raeburn 7432: Keys of top level results hash are roles.
1.275 raeburn 7433: Keys of inner hashes are username:domain, with
7434: values set to access type.
1.288 raeburn 7435: Optional userdata hash returns an array with arguments in the
7436: same order as loncoursedata::get_classlist() for student data.
7437:
1.609 raeburn 7438: Optional statushash returns
7439:
1.288 raeburn 7440: Entries for end, start, section and status are blank because
7441: of the possibility of multiple values for non-student roles.
7442:
1.275 raeburn 7443: =cut
1.405 albertel 7444:
1.275 raeburn 7445: ###############################################
1.405 albertel 7446:
1.275 raeburn 7447: sub get_course_users {
1.630 raeburn 7448: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 7449: my %idx = ();
1.419 raeburn 7450: my %seclists;
1.288 raeburn 7451:
7452: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
7453: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
7454: $idx{end} = &Apache::loncoursedata::CL_END();
7455: $idx{start} = &Apache::loncoursedata::CL_START();
7456: $idx{id} = &Apache::loncoursedata::CL_ID();
7457: $idx{section} = &Apache::loncoursedata::CL_SECTION();
7458: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
7459: $idx{status} = &Apache::loncoursedata::CL_STATUS();
7460:
1.290 albertel 7461: if (grep(/^st$/,@{$roles})) {
1.276 albertel 7462: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 7463: my $now = time;
1.277 albertel 7464: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 7465: my $match = 0;
1.412 raeburn 7466: my $secmatch = 0;
1.419 raeburn 7467: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 7468: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 7469: if ($section eq '') {
7470: $section = 'none';
7471: }
1.291 albertel 7472: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 7473: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 7474: $secmatch = 1;
7475: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 7476: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 7477: $secmatch = 1;
7478: }
7479: } else {
1.419 raeburn 7480: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 7481: $secmatch = 1;
7482: }
1.290 albertel 7483: }
1.412 raeburn 7484: if (!$secmatch) {
7485: next;
7486: }
1.419 raeburn 7487: }
1.275 raeburn 7488: if (defined($$types{'active'})) {
1.288 raeburn 7489: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 7490: push(@{$$users{st}{$student}},'active');
1.288 raeburn 7491: $match = 1;
1.275 raeburn 7492: }
7493: }
7494: if (defined($$types{'previous'})) {
1.609 raeburn 7495: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 7496: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 7497: $match = 1;
1.275 raeburn 7498: }
7499: }
7500: if (defined($$types{'future'})) {
1.609 raeburn 7501: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 7502: push(@{$$users{st}{$student}},'future');
1.288 raeburn 7503: $match = 1;
1.275 raeburn 7504: }
7505: }
1.609 raeburn 7506: if ($match) {
7507: push(@{$seclists{$student}},$section);
7508: if (ref($userdata) eq 'HASH') {
7509: $$userdata{$student} = $$classlist{$student};
7510: }
7511: if (ref($statushash) eq 'HASH') {
7512: $statushash->{$student}{'st'}{$section} = $status;
7513: }
1.288 raeburn 7514: }
1.275 raeburn 7515: }
7516: }
1.412 raeburn 7517: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 7518: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7519: my $now = time;
1.609 raeburn 7520: my %displaystatus = ( previous => 'Expired',
7521: active => 'Active',
7522: future => 'Future',
7523: );
1.630 raeburn 7524: my %nothide;
7525: if ($hidepriv) {
7526: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
7527: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
7528: if ($user !~ /:/) {
7529: $nothide{join(':',split(/[\@]/,$user))}=1;
7530: } else {
7531: $nothide{$user} = 1;
7532: }
7533: }
7534: }
1.439 raeburn 7535: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 7536: my $match = 0;
1.412 raeburn 7537: my $secmatch = 0;
1.439 raeburn 7538: my $status;
1.412 raeburn 7539: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 7540: $user =~ s/:$//;
1.439 raeburn 7541: my ($end,$start) = split(/:/,$coursepersonnel{$person});
7542: if ($end == -1 || $start == -1) {
7543: next;
7544: }
7545: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
7546: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 7547: my ($uname,$udom) = split(/:/,$user);
7548: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 7549: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 7550: $secmatch = 1;
7551: } elsif ($usec eq '') {
1.420 albertel 7552: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 7553: $secmatch = 1;
7554: }
7555: } else {
7556: if (grep(/^\Q$usec\E$/,@{$sections})) {
7557: $secmatch = 1;
7558: }
7559: }
7560: if (!$secmatch) {
7561: next;
7562: }
1.288 raeburn 7563: }
1.419 raeburn 7564: if ($usec eq '') {
7565: $usec = 'none';
7566: }
1.275 raeburn 7567: if ($uname ne '' && $udom ne '') {
1.630 raeburn 7568: if ($hidepriv) {
7569: if ((&Apache::lonnet::privileged($uname,$udom)) &&
7570: (!$nothide{$uname.':'.$udom})) {
7571: next;
7572: }
7573: }
1.503 raeburn 7574: if ($end > 0 && $end < $now) {
1.439 raeburn 7575: $status = 'previous';
7576: } elsif ($start > $now) {
7577: $status = 'future';
7578: } else {
7579: $status = 'active';
7580: }
1.277 albertel 7581: foreach my $type (keys(%{$types})) {
1.275 raeburn 7582: if ($status eq $type) {
1.420 albertel 7583: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 7584: push(@{$$users{$role}{$user}},$type);
7585: }
1.288 raeburn 7586: $match = 1;
7587: }
7588: }
1.419 raeburn 7589: if (($match) && (ref($userdata) eq 'HASH')) {
7590: if (!exists($$userdata{$uname.':'.$udom})) {
7591: &get_user_info($udom,$uname,\%idx,$userdata);
7592: }
1.420 albertel 7593: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 7594: push(@{$seclists{$uname.':'.$udom}},$usec);
7595: }
1.609 raeburn 7596: if (ref($statushash) eq 'HASH') {
7597: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
7598: }
1.275 raeburn 7599: }
7600: }
7601: }
7602: }
1.290 albertel 7603: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 7604: if ((defined($cdom)) && (defined($cnum))) {
7605: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
7606: if ( defined($csettings{'internal.courseowner'}) ) {
7607: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 7608: next if ($owner eq '');
7609: my ($ownername,$ownerdom);
7610: if ($owner =~ /^([^:]+):([^:]+)$/) {
7611: $ownername = $1;
7612: $ownerdom = $2;
7613: } else {
7614: $ownername = $owner;
7615: $ownerdom = $cdom;
7616: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 7617: }
7618: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 7619: if (defined($userdata) &&
1.609 raeburn 7620: !exists($$userdata{$owner})) {
7621: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
7622: if (!grep(/^none$/,@{$seclists{$owner}})) {
7623: push(@{$seclists{$owner}},'none');
7624: }
7625: if (ref($statushash) eq 'HASH') {
7626: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 7627: }
1.290 albertel 7628: }
1.279 raeburn 7629: }
7630: }
7631: }
1.419 raeburn 7632: foreach my $user (keys(%seclists)) {
7633: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
7634: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
7635: }
1.275 raeburn 7636: }
7637: return;
7638: }
7639:
1.288 raeburn 7640: sub get_user_info {
7641: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 7642: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
7643: &plainname($uname,$udom,'lastname');
1.291 albertel 7644: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 7645: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 7646: my %idhash = &Apache::lonnet::idrget($udom,($uname));
7647: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 7648: return;
7649: }
1.275 raeburn 7650:
1.472 raeburn 7651: ###############################################
7652:
7653: =pod
7654:
7655: =item * &get_user_quota()
7656:
7657: Retrieves quota assigned for storage of portfolio files for a user
7658:
7659: Incoming parameters:
7660: 1. user's username
7661: 2. user's domain
7662:
7663: Returns:
1.536 raeburn 7664: 1. Disk quota (in Mb) assigned to student.
7665: 2. (Optional) Type of setting: custom or default
7666: (individually assigned or default for user's
7667: institutional status).
7668: 3. (Optional) - User's institutional status (e.g., faculty, staff
7669: or student - types as defined in localenroll::inst_usertypes
7670: for user's domain, which determines default quota for user.
7671: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 7672:
7673: If a value has been stored in the user's environment,
1.536 raeburn 7674: it will return that, otherwise it returns the maximal default
7675: defined for the user's instituional status(es) in the domain.
1.472 raeburn 7676:
7677: =cut
7678:
7679: ###############################################
7680:
7681:
7682: sub get_user_quota {
7683: my ($uname,$udom) = @_;
1.536 raeburn 7684: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 7685: if (!defined($udom)) {
7686: $udom = $env{'user.domain'};
7687: }
7688: if (!defined($uname)) {
7689: $uname = $env{'user.name'};
7690: }
7691: if (($udom eq '' || $uname eq '') ||
7692: ($udom eq 'public') && ($uname eq 'public')) {
7693: $quota = 0;
1.536 raeburn 7694: $quotatype = 'default';
7695: $defquota = 0;
1.472 raeburn 7696: } else {
1.536 raeburn 7697: my $inststatus;
1.472 raeburn 7698: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
7699: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 7700: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 7701: } else {
1.536 raeburn 7702: my %userenv =
7703: &Apache::lonnet::get('environment',['portfolioquota',
7704: 'inststatus'],$udom,$uname);
1.472 raeburn 7705: my ($tmp) = keys(%userenv);
7706: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
7707: $quota = $userenv{'portfolioquota'};
1.536 raeburn 7708: $inststatus = $userenv{'inststatus'};
1.472 raeburn 7709: } else {
7710: undef(%userenv);
7711: }
7712: }
1.536 raeburn 7713: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 7714: if ($quota eq '') {
1.536 raeburn 7715: $quota = $defquota;
7716: $quotatype = 'default';
7717: } else {
7718: $quotatype = 'custom';
1.472 raeburn 7719: }
7720: }
1.536 raeburn 7721: if (wantarray) {
7722: return ($quota,$quotatype,$settingstatus,$defquota);
7723: } else {
7724: return $quota;
7725: }
1.472 raeburn 7726: }
7727:
7728: ###############################################
7729:
7730: =pod
7731:
7732: =item * &default_quota()
7733:
1.536 raeburn 7734: Retrieves default quota assigned for storage of user portfolio files,
7735: given an (optional) user's institutional status.
1.472 raeburn 7736:
7737: Incoming parameters:
7738: 1. domain
1.536 raeburn 7739: 2. (Optional) institutional status(es). This is a : separated list of
7740: status types (e.g., faculty, staff, student etc.)
7741: which apply to the user for whom the default is being retrieved.
7742: If the institutional status string in undefined, the domain
7743: default quota will be returned.
1.472 raeburn 7744:
7745: Returns:
7746: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 7747: 2. (Optional) institutional type which determined the value of the
7748: default quota.
1.472 raeburn 7749:
7750: If a value has been stored in the domain's configuration db,
7751: it will return that, otherwise it returns 20 (for backwards
7752: compatibility with domains which have not set up a configuration
7753: db file; the original statically defined portfolio quota was 20 Mb).
7754:
1.536 raeburn 7755: If the user's status includes multiple types (e.g., staff and student),
7756: the largest default quota which applies to the user determines the
7757: default quota returned.
7758:
1.780 raeburn 7759: =back
7760:
1.472 raeburn 7761: =cut
7762:
7763: ###############################################
7764:
7765:
7766: sub default_quota {
1.536 raeburn 7767: my ($udom,$inststatus) = @_;
7768: my ($defquota,$settingstatus);
7769: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 7770: ['quotas'],$udom);
7771: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 7772: if ($inststatus ne '') {
1.765 raeburn 7773: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 7774: foreach my $item (@statuses) {
1.711 raeburn 7775: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
7776: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
7777: if ($defquota eq '') {
7778: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
7779: $settingstatus = $item;
7780: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
7781: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
7782: $settingstatus = $item;
7783: }
7784: }
7785: } else {
7786: if ($quotahash{'quotas'}{$item} ne '') {
7787: if ($defquota eq '') {
7788: $defquota = $quotahash{'quotas'}{$item};
7789: $settingstatus = $item;
7790: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
7791: $defquota = $quotahash{'quotas'}{$item};
7792: $settingstatus = $item;
7793: }
1.536 raeburn 7794: }
7795: }
7796: }
7797: }
7798: if ($defquota eq '') {
1.711 raeburn 7799: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
7800: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
7801: } else {
7802: $defquota = $quotahash{'quotas'}{'default'};
7803: }
1.536 raeburn 7804: $settingstatus = 'default';
7805: }
7806: } else {
7807: $settingstatus = 'default';
7808: $defquota = 20;
7809: }
7810: if (wantarray) {
7811: return ($defquota,$settingstatus);
1.472 raeburn 7812: } else {
1.536 raeburn 7813: return $defquota;
1.472 raeburn 7814: }
7815: }
7816:
1.384 raeburn 7817: sub get_secgrprole_info {
7818: my ($cdom,$cnum,$needroles,$type) = @_;
7819: my %sections_count = &get_sections($cdom,$cnum);
7820: my @sections = (sort {$a <=> $b} keys(%sections_count));
7821: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
7822: my @groups = sort(keys(%curr_groups));
7823: my $allroles = [];
7824: my $rolehash;
7825: my $accesshash = {
7826: active => 'Currently has access',
7827: future => 'Will have future access',
7828: previous => 'Previously had access',
7829: };
7830: if ($needroles) {
7831: $rolehash = {'all' => 'all'};
1.385 albertel 7832: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
7833: if (&Apache::lonnet::error(%user_roles)) {
7834: undef(%user_roles);
7835: }
7836: foreach my $item (keys(%user_roles)) {
1.384 raeburn 7837: my ($role)=split(/\:/,$item,2);
7838: if ($role eq 'cr') { next; }
7839: if ($role =~ /^cr/) {
7840: $$rolehash{$role} = (split('/',$role))[3];
7841: } else {
7842: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
7843: }
7844: }
7845: foreach my $key (sort(keys(%{$rolehash}))) {
7846: push(@{$allroles},$key);
7847: }
7848: push (@{$allroles},'st');
7849: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
7850: }
7851: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
7852: }
7853:
1.555 raeburn 7854: sub user_picker {
1.627 raeburn 7855: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
1.555 raeburn 7856: my $currdom = $dom;
7857: my %curr_selected = (
7858: srchin => 'dom',
1.580 raeburn 7859: srchby => 'lastname',
1.555 raeburn 7860: );
7861: my $srchterm;
1.625 raeburn 7862: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 7863: if ($srch->{'srchby'} ne '') {
7864: $curr_selected{'srchby'} = $srch->{'srchby'};
7865: }
7866: if ($srch->{'srchin'} ne '') {
7867: $curr_selected{'srchin'} = $srch->{'srchin'};
7868: }
7869: if ($srch->{'srchtype'} ne '') {
7870: $curr_selected{'srchtype'} = $srch->{'srchtype'};
7871: }
7872: if ($srch->{'srchdomain'} ne '') {
7873: $currdom = $srch->{'srchdomain'};
7874: }
7875: $srchterm = $srch->{'srchterm'};
7876: }
7877: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 7878: 'usr' => 'Search criteria',
1.563 raeburn 7879: 'doma' => 'Domain/institution to search',
1.558 albertel 7880: 'uname' => 'username',
7881: 'lastname' => 'last name',
1.555 raeburn 7882: 'lastfirst' => 'last name, first name',
1.558 albertel 7883: 'crs' => 'in this course',
1.576 raeburn 7884: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 7885: 'alc' => 'all LON-CAPA',
1.573 raeburn 7886: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 7887: 'exact' => 'is',
7888: 'contains' => 'contains',
1.569 raeburn 7889: 'begins' => 'begins with',
1.571 raeburn 7890: 'youm' => "You must include some text to search for.",
7891: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
7892: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
7893: 'yomc' => "You must choose a domain when using an institutional directory search.",
7894: 'ymcd' => "You must choose a domain when using a domain search.",
7895: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
7896: 'whse' => "When searching by last,first you must include at least one character in the first name.",
7897: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 7898: );
1.925.2.13 raeburn 7899: my $domform = &select_dom_form($currdom,'srchdomain',undef,1);
1.563 raeburn 7900: my $srchinsel = ' <select name="srchin">';
1.925.2.13 raeburn 7901:
1.555 raeburn 7902: my @srchins = ('crs','dom','alc','instd');
7903:
7904: foreach my $option (@srchins) {
7905: # FIXME 'alc' option unavailable until
7906: # loncreateuser::print_user_query_page()
7907: # has been completed.
7908: next if ($option eq 'alc');
1.880 raeburn 7909: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 7910: next if ($option eq 'crs' && !$env{'request.course.id'});
1.925.2.13 raeburn 7911: next if ($option eq 'instd');
1.563 raeburn 7912: if ($curr_selected{'srchin'} eq $option) {
7913: $srchinsel .= '
1.925.2.13 raeburn 7914: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
1.563 raeburn 7915: } else {
7916: $srchinsel .= '
1.925.2.13 raeburn 7917: <option value="'.$option.'">'.$lt{$option}.'</option>';
1.563 raeburn 7918: }
1.555 raeburn 7919: }
1.563 raeburn 7920: $srchinsel .= "\n </select>\n";
1.555 raeburn 7921:
7922: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 7923: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 7924: if ($curr_selected{'srchby'} eq $option) {
7925: $srchbysel .= '
7926: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7927: } else {
7928: $srchbysel .= '
7929: <option value="'.$option.'">'.$lt{$option}.'</option>';
7930: }
7931: }
7932: $srchbysel .= "\n </select>\n";
7933:
7934: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 7935: foreach my $option ('begins','contains','exact') {
1.555 raeburn 7936: if ($curr_selected{'srchtype'} eq $option) {
7937: $srchtypesel .= '
7938: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
7939: } else {
7940: $srchtypesel .= '
7941: <option value="'.$option.'">'.$lt{$option}.'</option>';
7942: }
7943: }
7944: $srchtypesel .= "\n </select>\n";
7945:
1.558 albertel 7946: my ($newuserscript,$new_user_create);
1.556 raeburn 7947:
7948: if ($forcenewuser) {
1.576 raeburn 7949: if (ref($srch) eq 'HASH') {
7950: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
1.627 raeburn 7951: if ($cancreate) {
7952: $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>';
7953: } else {
1.799 bisitz 7954: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 7955: my %usertypetext = (
7956: official => 'institutional',
7957: unofficial => 'non-institutional',
7958: );
1.799 bisitz 7959: $new_user_create = '<p class="LC_warning">'
7960: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
1.925.2.13 raeburn 7961: .'<br />'
7962: .&mt('Enter a valid e-mail address as the username for the new user.').' '.&mt('Please contact the [_1]helpdesk[_2] for assistance.'
7963: ,'<a href="'.$helplink.'">','</a>')
1.799 bisitz 7964: .'</p><br />';
1.627 raeburn 7965: }
1.576 raeburn 7966: }
7967: }
7968:
1.556 raeburn 7969: $newuserscript = <<"ENDSCRIPT";
7970:
1.570 raeburn 7971: function setSearch(createnew,callingForm) {
1.556 raeburn 7972: if (createnew == 1) {
1.570 raeburn 7973: for (var i=0; i<callingForm.srchby.length; i++) {
7974: if (callingForm.srchby.options[i].value == 'uname') {
7975: callingForm.srchby.selectedIndex = i;
1.556 raeburn 7976: }
7977: }
1.570 raeburn 7978: for (var i=0; i<callingForm.srchin.length; i++) {
7979: if ( callingForm.srchin.options[i].value == 'dom') {
7980: callingForm.srchin.selectedIndex = i;
1.556 raeburn 7981: }
7982: }
1.570 raeburn 7983: for (var i=0; i<callingForm.srchtype.length; i++) {
7984: if (callingForm.srchtype.options[i].value == 'exact') {
7985: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 7986: }
7987: }
1.570 raeburn 7988: for (var i=0; i<callingForm.srchdomain.length; i++) {
7989: if (callingForm.srchdomain.options[i].value == '$env{'request.role.domain'}') {
7990: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 7991: }
7992: }
7993: }
7994: }
7995: ENDSCRIPT
1.558 albertel 7996:
1.556 raeburn 7997: }
7998:
1.555 raeburn 7999: my $output = <<"END_BLOCK";
1.556 raeburn 8000: <script type="text/javascript">
1.824 bisitz 8001: // <![CDATA[
1.570 raeburn 8002: function validateEntry(callingForm) {
1.558 albertel 8003:
1.556 raeburn 8004: var checkok = 1;
1.558 albertel 8005: var srchin;
1.570 raeburn 8006: for (var i=0; i<callingForm.srchin.length; i++) {
8007: if ( callingForm.srchin[i].checked ) {
8008: srchin = callingForm.srchin[i].value;
1.558 albertel 8009: }
8010: }
8011:
1.570 raeburn 8012: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
8013: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
8014: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
8015: var srchterm = callingForm.srchterm.value;
8016: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 8017: var msg = "";
8018:
8019: if (srchterm == "") {
8020: checkok = 0;
1.571 raeburn 8021: msg += "$lt{'youm'}\\n";
1.556 raeburn 8022: }
8023:
1.569 raeburn 8024: if (srchtype== 'begins') {
8025: if (srchterm.length < 2) {
8026: checkok = 0;
1.571 raeburn 8027: msg += "$lt{'thte'}\\n";
1.569 raeburn 8028: }
8029: }
8030:
1.556 raeburn 8031: if (srchtype== 'contains') {
8032: if (srchterm.length < 3) {
8033: checkok = 0;
1.571 raeburn 8034: msg += "$lt{'thet'}\\n";
1.556 raeburn 8035: }
8036: }
8037: if (srchin == 'instd') {
8038: if (srchdomain == '') {
8039: checkok = 0;
1.571 raeburn 8040: msg += "$lt{'yomc'}\\n";
1.556 raeburn 8041: }
8042: }
8043: if (srchin == 'dom') {
8044: if (srchdomain == '') {
8045: checkok = 0;
1.571 raeburn 8046: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 8047: }
8048: }
8049: if (srchby == 'lastfirst') {
8050: if (srchterm.indexOf(",") == -1) {
8051: checkok = 0;
1.571 raeburn 8052: msg += "$lt{'whus'}\\n";
1.556 raeburn 8053: }
8054: if (srchterm.indexOf(",") == srchterm.length -1) {
8055: checkok = 0;
1.571 raeburn 8056: msg += "$lt{'whse'}\\n";
1.556 raeburn 8057: }
8058: }
8059: if (checkok == 0) {
1.571 raeburn 8060: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 8061: return;
8062: }
8063: if (checkok == 1) {
1.570 raeburn 8064: callingForm.submit();
1.556 raeburn 8065: }
8066: }
8067:
8068: $newuserscript
8069:
1.824 bisitz 8070: // ]]>
1.556 raeburn 8071: </script>
1.558 albertel 8072:
8073: $new_user_create
8074:
1.555 raeburn 8075: END_BLOCK
1.558 albertel 8076:
1.876 raeburn 8077: $output .= &Apache::lonhtmlcommon::start_pick_box().
8078: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
8079: $domform.
8080: &Apache::lonhtmlcommon::row_closure().
8081: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
8082: $srchbysel.
8083: $srchtypesel.
8084: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
8085: $srchinsel.
8086: &Apache::lonhtmlcommon::row_closure(1).
8087: &Apache::lonhtmlcommon::end_pick_box().
8088: '<br />';
1.555 raeburn 8089: return $output;
8090: }
8091:
1.612 raeburn 8092: sub user_rule_check {
1.615 raeburn 8093: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 8094: my $response;
8095: if (ref($usershash) eq 'HASH') {
8096: foreach my $user (keys(%{$usershash})) {
8097: my ($uname,$udom) = split(/:/,$user);
8098: next if ($udom eq '' || $uname eq '');
1.615 raeburn 8099: my ($id,$newuser);
1.612 raeburn 8100: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 8101: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 8102: $id = $usershash->{$user}->{'id'};
8103: }
8104: my $inst_response;
8105: if (ref($checks) eq 'HASH') {
8106: if (defined($checks->{'username'})) {
1.615 raeburn 8107: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8108: &Apache::lonnet::get_instuser($udom,$uname);
8109: } elsif (defined($checks->{'id'})) {
1.615 raeburn 8110: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8111: &Apache::lonnet::get_instuser($udom,undef,$id);
8112: }
1.615 raeburn 8113: } else {
8114: ($inst_response,%{$inst_results->{$user}}) =
8115: &Apache::lonnet::get_instuser($udom,$uname);
8116: return;
1.612 raeburn 8117: }
1.615 raeburn 8118: if (!$got_rules->{$udom}) {
1.612 raeburn 8119: my %domconfig = &Apache::lonnet::get_dom('configuration',
8120: ['usercreation'],$udom);
8121: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 8122: foreach my $item ('username','id') {
1.612 raeburn 8123: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
8124: $$curr_rules{$udom}{$item} =
8125: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 8126: }
8127: }
8128: }
1.615 raeburn 8129: $got_rules->{$udom} = 1;
1.585 raeburn 8130: }
1.612 raeburn 8131: foreach my $item (keys(%{$checks})) {
8132: if (ref($$curr_rules{$udom}) eq 'HASH') {
8133: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
8134: if (@{$$curr_rules{$udom}{$item}} > 0) {
8135: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
8136: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
8137: if ($rule_check{$rule}) {
8138: $$rulematch{$user}{$item} = $rule;
8139: if ($inst_response eq 'ok') {
1.615 raeburn 8140: if (ref($inst_results) eq 'HASH') {
8141: if (ref($inst_results->{$user}) eq 'HASH') {
8142: if (keys(%{$inst_results->{$user}}) == 0) {
8143: $$alerts{$item}{$udom}{$uname} = 1;
8144: }
1.612 raeburn 8145: }
8146: }
1.615 raeburn 8147: }
8148: last;
1.585 raeburn 8149: }
8150: }
8151: }
8152: }
8153: }
8154: }
8155: }
8156: }
1.612 raeburn 8157: return;
8158: }
8159:
8160: sub user_rule_formats {
8161: my ($domain,$domdesc,$curr_rules,$check) = @_;
8162: my %text = (
8163: 'username' => 'Usernames',
8164: 'id' => 'IDs',
8165: );
8166: my $output;
8167: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
8168: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
8169: if (@{$ruleorder} > 0) {
8170: $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>';
8171: foreach my $rule (@{$ruleorder}) {
8172: if (ref($curr_rules) eq 'ARRAY') {
8173: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
8174: if (ref($rules->{$rule}) eq 'HASH') {
8175: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
8176: $rules->{$rule}{'desc'}.'</li>';
8177: }
8178: }
8179: }
8180: }
8181: $output .= '</ul>';
8182: }
8183: }
8184: return $output;
8185: }
8186:
8187: sub instrule_disallow_msg {
1.615 raeburn 8188: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 8189: my $response;
8190: my %text = (
8191: item => 'username',
8192: items => 'usernames',
8193: match => 'matches',
8194: do => 'does',
8195: action => 'a username',
8196: one => 'one',
8197: );
8198: if ($count > 1) {
8199: $text{'item'} = 'usernames';
8200: $text{'match'} ='match';
8201: $text{'do'} = 'do';
8202: $text{'action'} = 'usernames',
8203: $text{'one'} = 'ones';
8204: }
8205: if ($checkitem eq 'id') {
8206: $text{'items'} = 'IDs';
8207: $text{'item'} = 'ID';
8208: $text{'action'} = 'an ID';
1.615 raeburn 8209: if ($count > 1) {
8210: $text{'item'} = 'IDs';
8211: $text{'action'} = 'IDs';
8212: }
1.612 raeburn 8213: }
1.674 bisitz 8214: $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 8215: if ($mode eq 'upload') {
8216: if ($checkitem eq 'username') {
8217: $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'}.");
8218: } elsif ($checkitem eq 'id') {
1.674 bisitz 8219: $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 8220: }
1.669 raeburn 8221: } elsif ($mode eq 'selfcreate') {
8222: if ($checkitem eq 'id') {
8223: $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.");
8224: }
1.615 raeburn 8225: } else {
8226: if ($checkitem eq 'username') {
8227: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
8228: } elsif ($checkitem eq 'id') {
8229: $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.");
8230: }
1.612 raeburn 8231: }
8232: return $response;
1.585 raeburn 8233: }
8234:
1.624 raeburn 8235: sub personal_data_fieldtitles {
8236: my %fieldtitles = &Apache::lonlocal::texthash (
8237: id => 'Student/Employee ID',
8238: permanentemail => 'E-mail address',
8239: lastname => 'Last Name',
8240: firstname => 'First Name',
8241: middlename => 'Middle Name',
8242: generation => 'Generation',
8243: gen => 'Generation',
1.765 raeburn 8244: inststatus => 'Affiliation',
1.624 raeburn 8245: );
8246: return %fieldtitles;
8247: }
8248:
1.642 raeburn 8249: sub sorted_inst_types {
8250: my ($dom) = @_;
8251: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
8252: my $othertitle = &mt('All users');
8253: if ($env{'request.course.id'}) {
1.668 raeburn 8254: $othertitle = &mt('Any users');
1.642 raeburn 8255: }
8256: my @types;
8257: if (ref($order) eq 'ARRAY') {
8258: @types = @{$order};
8259: }
8260: if (@types == 0) {
8261: if (ref($usertypes) eq 'HASH') {
8262: @types = sort(keys(%{$usertypes}));
8263: }
8264: }
8265: if (keys(%{$usertypes}) > 0) {
8266: $othertitle = &mt('Other users');
8267: }
8268: return ($othertitle,$usertypes,\@types);
8269: }
8270:
1.645 raeburn 8271: sub get_institutional_codes {
8272: my ($settings,$allcourses,$LC_code) = @_;
8273: # Get complete list of course sections to update
8274: my @currsections = ();
8275: my @currxlists = ();
8276: my $coursecode = $$settings{'internal.coursecode'};
8277:
8278: if ($$settings{'internal.sectionnums'} ne '') {
8279: @currsections = split(/,/,$$settings{'internal.sectionnums'});
8280: }
8281:
8282: if ($$settings{'internal.crosslistings'} ne '') {
8283: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
8284: }
8285:
8286: if (@currxlists > 0) {
8287: foreach (@currxlists) {
8288: if (m/^([^:]+):(\w*)$/) {
8289: unless (grep/^$1$/,@{$allcourses}) {
8290: push @{$allcourses},$1;
8291: $$LC_code{$1} = $2;
8292: }
8293: }
8294: }
8295: }
8296:
8297: if (@currsections > 0) {
8298: foreach (@currsections) {
8299: if (m/^(\w+):(\w*)$/) {
8300: my $sec = $coursecode.$1;
8301: my $lc_sec = $2;
8302: unless (grep/^$sec$/,@{$allcourses}) {
8303: push @{$allcourses},$sec;
8304: $$LC_code{$sec} = $lc_sec;
8305: }
8306: }
8307: }
8308: }
8309: return;
8310: }
8311:
1.112 bowersj2 8312: =pod
8313:
1.780 raeburn 8314: =head1 Slot Helpers
8315:
8316: =over 4
8317:
8318: =item * sorted_slots()
8319:
8320: Sorts an array of slot names in order of slot start time (earliest first).
8321:
8322: Inputs:
8323:
8324: =over 4
8325:
8326: slotsarr - Reference to array of unsorted slot names.
8327:
8328: slots - Reference to hash of hash, where outer hash keys are slot names.
8329:
1.549 albertel 8330: =back
8331:
1.780 raeburn 8332: Returns:
8333:
8334: =over 4
8335:
8336: sorted - An array of slot names sorted by the start time of the slot.
8337:
8338: =back
8339:
8340: =back
8341:
8342: =cut
8343:
8344:
8345: sub sorted_slots {
8346: my ($slotsarr,$slots) = @_;
8347: my @sorted;
8348: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
8349: @sorted =
8350: sort {
8351: if (ref($slots->{$a}) && ref($slots->{$b})) {
8352: return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
8353: }
8354: if (ref($slots->{$a})) { return -1;}
8355: if (ref($slots->{$b})) { return 1;}
8356: return 0;
8357: } @{$slotsarr};
8358: }
8359: return @sorted;
8360: }
8361:
8362:
8363: =pod
8364:
1.549 albertel 8365: =head1 HTTP Helpers
8366:
8367: =over 4
8368:
1.648 raeburn 8369: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 8370:
1.258 albertel 8371: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 8372: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 8373: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 8374:
8375: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
8376: $possible_names is an ref to an array of form element names. As an example:
8377: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 8378: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 8379:
8380: =cut
1.1 albertel 8381:
1.6 albertel 8382: sub get_unprocessed_cgi {
1.25 albertel 8383: my ($query,$possible_names)= @_;
1.26 matthew 8384: # $Apache::lonxml::debug=1;
1.356 albertel 8385: foreach my $pair (split(/&/,$query)) {
8386: my ($name, $value) = split(/=/,$pair);
1.369 www 8387: $name = &unescape($name);
1.25 albertel 8388: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
8389: $value =~ tr/+/ /;
8390: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 8391: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 8392: }
1.16 harris41 8393: }
1.6 albertel 8394: }
8395:
1.112 bowersj2 8396: =pod
8397:
1.648 raeburn 8398: =item * &cacheheader()
1.112 bowersj2 8399:
8400: returns cache-controlling header code
8401:
8402: =cut
8403:
1.7 albertel 8404: sub cacheheader {
1.258 albertel 8405: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 8406: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
8407: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 8408: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
8409: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 8410: return $output;
1.7 albertel 8411: }
8412:
1.112 bowersj2 8413: =pod
8414:
1.648 raeburn 8415: =item * &no_cache($r)
1.112 bowersj2 8416:
8417: specifies header code to not have cache
8418:
8419: =cut
8420:
1.9 albertel 8421: sub no_cache {
1.216 albertel 8422: my ($r) = @_;
8423: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 8424: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 8425: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
8426: $r->no_cache(1);
8427: $r->header_out("Expires" => $date);
8428: $r->header_out("Pragma" => "no-cache");
1.123 www 8429: }
8430:
8431: sub content_type {
1.181 albertel 8432: my ($r,$type,$charset) = @_;
1.299 foxr 8433: if ($r) {
8434: # Note that printout.pl calls this with undef for $r.
8435: &no_cache($r);
8436: }
1.258 albertel 8437: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 8438: unless ($charset) {
8439: $charset=&Apache::lonlocal::current_encoding;
8440: }
8441: if ($charset) { $type.='; charset='.$charset; }
8442: if ($r) {
8443: $r->content_type($type);
8444: } else {
8445: print("Content-type: $type\n\n");
8446: }
1.9 albertel 8447: }
1.25 albertel 8448:
1.112 bowersj2 8449: =pod
8450:
1.648 raeburn 8451: =item * &add_to_env($name,$value)
1.112 bowersj2 8452:
1.258 albertel 8453: adds $name to the %env hash with value
1.112 bowersj2 8454: $value, if $name already exists, the entry is converted to an array
8455: reference and $value is added to the array.
8456:
8457: =cut
8458:
1.25 albertel 8459: sub add_to_env {
8460: my ($name,$value)=@_;
1.258 albertel 8461: if (defined($env{$name})) {
8462: if (ref($env{$name})) {
1.25 albertel 8463: #already have multiple values
1.258 albertel 8464: push(@{ $env{$name} },$value);
1.25 albertel 8465: } else {
8466: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 8467: my $first=$env{$name};
8468: undef($env{$name});
8469: push(@{ $env{$name} },$first,$value);
1.25 albertel 8470: }
8471: } else {
1.258 albertel 8472: $env{$name}=$value;
1.25 albertel 8473: }
1.31 albertel 8474: }
1.149 albertel 8475:
8476: =pod
8477:
1.648 raeburn 8478: =item * &get_env_multiple($name)
1.149 albertel 8479:
1.258 albertel 8480: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 8481: values may be defined and end up as an array ref.
8482:
8483: returns an array of values
8484:
8485: =cut
8486:
8487: sub get_env_multiple {
8488: my ($name) = @_;
8489: my @values;
1.258 albertel 8490: if (defined($env{$name})) {
1.149 albertel 8491: # exists is it an array
1.258 albertel 8492: if (ref($env{$name})) {
8493: @values=@{ $env{$name} };
1.149 albertel 8494: } else {
1.258 albertel 8495: $values[0]=$env{$name};
1.149 albertel 8496: }
8497: }
8498: return(@values);
8499: }
8500:
1.660 raeburn 8501: sub ask_for_embedded_content {
8502: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
8503: my $upload_output = '
8504: <form name="upload_embedded" action="'.$actionurl.'"
8505: method="post" enctype="multipart/form-data">';
8506: $upload_output .= $state;
1.661 raeburn 8507: $upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();
1.660 raeburn 8508:
8509: my $num = 0;
8510: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
8511: $upload_output .= &start_data_table_row().
8512: '<td>'.$embed_file.'</td><td>';
8513: if ($args->{'ignore_remote_references'}
8514: && $embed_file =~ m{^\w+://}) {
8515: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
8516: } elsif ($args->{'error_on_invalid_names'}
8517: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
8518:
8519: $upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';
8520:
8521: } else {
8522: $upload_output .='
1.661 raeburn 8523: <input name="embedded_item_'.$num.'" type="file" value="" />
1.660 raeburn 8524: <input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
8525: my $attrib = join(':',@{$$allfiles{$embed_file}});
8526: $upload_output .=
8527: "\n\t\t".
8528: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
8529: $attrib.'" />';
8530: if (exists($$codebase{$embed_file})) {
8531: $upload_output .=
8532: "\n\t\t".
8533: '<input name="codebase_'.$num.'" type="hidden" value="'.
8534: &escape($$codebase{$embed_file}).'" />';
8535: }
8536: }
8537: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
8538: $num++;
8539: }
8540: $upload_output .= &Apache::loncommon::end_data_table().'<br />
8541: <input type ="hidden" name="number_embedded_items" value="'.$num.'" />
8542: <input type ="submit" value="'.&mt('Upload Listed Files').'" />
8543: '.&mt('(only files for which a location has been provided will be uploaded)').'
8544: </form>';
8545: return $upload_output;
8546: }
8547:
1.661 raeburn 8548: sub upload_embedded {
8549: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
8550: $current_disk_usage) = @_;
8551: my $output;
8552: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
8553: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
8554: my $orig_uploaded_filename =
8555: $env{'form.embedded_item_'.$i.'.filename'};
8556:
8557: $env{'form.embedded_orig_'.$i} =
8558: &unescape($env{'form.embedded_orig_'.$i});
8559: my ($path,$fname) =
8560: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
8561: # no path, whole string is fname
8562: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
8563:
8564: $path = $env{'form.currentpath'}.$path;
8565: $fname = &Apache::lonnet::clean_filename($fname);
8566: # See if there is anything left
8567: next if ($fname eq '');
8568:
8569: # Check if file already exists as a file or directory.
8570: my ($state,$msg);
8571: if ($context eq 'portfolio') {
8572: my $port_path = $dirpath;
8573: if ($group ne '') {
8574: $port_path = "groups/$group/$port_path";
8575: }
8576: ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
8577: $dir_root,$port_path,$disk_quota,
8578: $current_disk_usage,$uname,$udom);
8579: if ($state eq 'will_exceed_quota'
8580: || $state eq 'file_locked'
8581: || $state eq 'file_exists' ) {
8582: $output .= $msg;
8583: next;
8584: }
8585: } elsif (($context eq 'author') || ($context eq 'testbank')) {
8586: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
8587: if ($state eq 'exists') {
8588: $output .= $msg;
8589: next;
8590: }
8591: }
8592: # Check if extension is valid
8593: if (($fname =~ /\.(\w+)$/) &&
8594: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
8595: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
8596: next;
8597: } elsif (($fname =~ /\.(\w+)$/) &&
8598: (!defined(&Apache::loncommon::fileembstyle($1)))) {
8599: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
8600: next;
8601: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
8602: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
8603: next;
8604: }
8605:
8606: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
8607: if ($context eq 'portfolio') {
8608: my $result=
8609: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
8610: $dirpath.$path);
8611: if ($result !~ m|^/uploaded/|) {
8612: $output .= '<span class="LC_error">'
8613: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
8614: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
8615: .'</span><br />';
8616: next;
8617: } else {
8618: $output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
8619: $path.$fname.'</span>').'</p>';
8620: }
8621: } else {
8622: # Save the file
8623: my $target = $env{'form.embedded_item_'.$i};
8624: my $fullpath = $dir_root.$dirpath.'/'.$path;
8625: my $dest = $fullpath.$fname;
8626: my $url = $url_root.$dirpath.'/'.$path.$fname;
8627: my @parts=split(/\//,$fullpath);
8628: my $count;
8629: my $filepath = $dir_root;
8630: for ($count=4;$count<=$#parts;$count++) {
8631: $filepath .= "/$parts[$count]";
8632: if ((-e $filepath)!=1) {
8633: mkdir($filepath,0770);
8634: }
8635: }
8636: my $fh;
8637: if (!open($fh,'>'.$dest)) {
8638: &Apache::lonnet::logthis('Failed to create '.$dest);
8639: $output .= '<span class="LC_error">'.
8640: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
8641: '</span><br />';
8642: } else {
8643: if (!print $fh $env{'form.embedded_item_'.$i}) {
8644: &Apache::lonnet::logthis('Failed to write to '.$dest);
8645: $output .= '<span class="LC_error">'.
8646: &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
8647: '</span><br />';
8648: } else {
8649: if ($context eq 'testbank') {
8650: $output .= &mt('Embedded file uploaded successfully:').
8651: ' <a href="'.$url.'">'.
8652: $orig_uploaded_filename.'</a><br />';
8653: } else {
1.705 tempelho 8654: $output .= '<span class=\"LC_fontsize_large\">'.
1.661 raeburn 8655: &mt('View embedded file: [_1]','<a href="'.$url.'">'.
1.705 tempelho 8656: $orig_uploaded_filename.'</a>').'</span><br />';
1.661 raeburn 8657: }
8658: }
8659: close($fh);
8660: }
8661: }
8662: }
8663: return $output;
8664: }
8665:
8666: sub check_for_existing {
8667: my ($path,$fname,$element) = @_;
8668: my ($state,$msg);
8669: if (-d $path.'/'.$fname) {
8670: $state = 'exists';
8671: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
8672: } elsif (-e $path.'/'.$fname) {
8673: $state = 'exists';
8674: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
8675: }
8676: if ($state eq 'exists') {
8677: $msg = '<span class="LC_error">'.$msg.'</span><br />';
8678: }
8679: return ($state,$msg);
8680: }
8681:
8682: sub check_for_upload {
8683: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
8684: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
8685: my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
8686: my $getpropath = 1;
8687: my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
8688: $getpropath);
8689: my $found_file = 0;
8690: my $locked_file = 0;
8691: foreach my $line (@dir_list) {
8692: my ($file_name)=split(/\&/,$line,2);
8693: if ($file_name eq $fname){
8694: $file_name = $path.$file_name;
8695: if ($group ne '') {
8696: $file_name = $group.$file_name;
8697: }
8698: $found_file = 1;
8699: if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
8700: $locked_file = 1;
8701: }
8702: }
8703: }
8704: if (($current_disk_usage + $filesize) > $disk_quota){
8705: my $msg = '<span class="LC_error">'.
8706: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
8707: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
8708: return ('will_exceed_quota',$msg);
8709: } elsif ($found_file) {
8710: if ($locked_file) {
8711: my $msg = '<span class="LC_error">';
8712: $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>');
8713: $msg .= '</span><br />';
8714: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
8715: return ('file_locked',$msg);
8716: } else {
8717: my $msg = '<span class="LC_error">';
8718: $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'});
8719: $msg .= '</span>';
8720: $msg .= '<br />';
8721: $msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
8722: return ('file_exists',$msg);
8723: }
8724: }
8725: }
8726:
1.31 albertel 8727:
1.41 ng 8728: =pod
1.45 matthew 8729:
1.464 albertel 8730: =back
1.41 ng 8731:
1.112 bowersj2 8732: =head1 CSV Upload/Handling functions
1.38 albertel 8733:
1.41 ng 8734: =over 4
8735:
1.648 raeburn 8736: =item * &upfile_store($r)
1.41 ng 8737:
8738: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 8739: needs $env{'form.upfile'}
1.41 ng 8740: returns $datatoken to be put into hidden field
8741:
8742: =cut
1.31 albertel 8743:
8744: sub upfile_store {
8745: my $r=shift;
1.258 albertel 8746: $env{'form.upfile'}=~s/\r/\n/gs;
8747: $env{'form.upfile'}=~s/\f/\n/gs;
8748: $env{'form.upfile'}=~s/\n+/\n/gs;
8749: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 8750:
1.258 albertel 8751: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
8752: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 8753: {
1.158 raeburn 8754: my $datafile = $r->dir_config('lonDaemons').
8755: '/tmp/'.$datatoken.'.tmp';
8756: if ( open(my $fh,">$datafile") ) {
1.258 albertel 8757: print $fh $env{'form.upfile'};
1.158 raeburn 8758: close($fh);
8759: }
1.31 albertel 8760: }
8761: return $datatoken;
8762: }
8763:
1.56 matthew 8764: =pod
8765:
1.648 raeburn 8766: =item * &load_tmp_file($r)
1.41 ng 8767:
8768: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 8769: needs $env{'form.datatoken'},
8770: sets $env{'form.upfile'} to the contents of the file
1.41 ng 8771:
8772: =cut
1.31 albertel 8773:
8774: sub load_tmp_file {
8775: my $r=shift;
8776: my @studentdata=();
8777: {
1.158 raeburn 8778: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 8779: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 8780: if ( open(my $fh,"<$studentfile") ) {
8781: @studentdata=<$fh>;
8782: close($fh);
8783: }
1.31 albertel 8784: }
1.258 albertel 8785: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 8786: }
8787:
1.56 matthew 8788: =pod
8789:
1.648 raeburn 8790: =item * &upfile_record_sep()
1.41 ng 8791:
8792: Separate uploaded file into records
8793: returns array of records,
1.258 albertel 8794: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 8795:
8796: =cut
1.31 albertel 8797:
8798: sub upfile_record_sep {
1.258 albertel 8799: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 8800: } else {
1.248 albertel 8801: my @records;
1.258 albertel 8802: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 8803: if ($line=~/^\s*$/) { next; }
8804: push(@records,$line);
8805: }
8806: return @records;
1.31 albertel 8807: }
8808: }
8809:
1.56 matthew 8810: =pod
8811:
1.648 raeburn 8812: =item * &record_sep($record)
1.41 ng 8813:
1.258 albertel 8814: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 8815:
8816: =cut
8817:
1.263 www 8818: sub takeleft {
8819: my $index=shift;
8820: return substr('0000'.$index,-4,4);
8821: }
8822:
1.31 albertel 8823: sub record_sep {
8824: my $record=shift;
8825: my %components=();
1.258 albertel 8826: if ($env{'form.upfiletype'} eq 'xml') {
8827: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 8828: my $i=0;
1.356 albertel 8829: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 8830: $field=~s/^(\"|\')//;
8831: $field=~s/(\"|\')$//;
1.263 www 8832: $components{&takeleft($i)}=$field;
1.31 albertel 8833: $i++;
8834: }
1.258 albertel 8835: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 8836: my $i=0;
1.356 albertel 8837: foreach my $field (split(/\t/,$record)) {
1.31 albertel 8838: $field=~s/^(\"|\')//;
8839: $field=~s/(\"|\')$//;
1.263 www 8840: $components{&takeleft($i)}=$field;
1.31 albertel 8841: $i++;
8842: }
8843: } else {
1.561 www 8844: my $separator=',';
1.480 banghart 8845: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 8846: $separator=';';
1.480 banghart 8847: }
1.31 albertel 8848: my $i=0;
1.561 www 8849: # the character we are looking for to indicate the end of a quote or a record
8850: my $looking_for=$separator;
8851: # do not add the characters to the fields
8852: my $ignore=0;
8853: # we just encountered a separator (or the beginning of the record)
8854: my $just_found_separator=1;
8855: # store the field we are working on here
8856: my $field='';
8857: # work our way through all characters in record
8858: foreach my $character ($record=~/(.)/g) {
8859: if ($character eq $looking_for) {
8860: if ($character ne $separator) {
8861: # Found the end of a quote, again looking for separator
8862: $looking_for=$separator;
8863: $ignore=1;
8864: } else {
8865: # Found a separator, store away what we got
8866: $components{&takeleft($i)}=$field;
8867: $i++;
8868: $just_found_separator=1;
8869: $ignore=0;
8870: $field='';
8871: }
8872: next;
8873: }
8874: # single or double quotation marks after a separator indicate beginning of a quote
8875: # we are now looking for the end of the quote and need to ignore separators
8876: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
8877: $looking_for=$character;
8878: next;
8879: }
8880: # ignore would be true after we reached the end of a quote
8881: if ($ignore) { next; }
8882: if (($just_found_separator) && ($character=~/\s/)) { next; }
8883: $field.=$character;
8884: $just_found_separator=0;
1.31 albertel 8885: }
1.561 www 8886: # catch the very last entry, since we never encountered the separator
8887: $components{&takeleft($i)}=$field;
1.31 albertel 8888: }
8889: return %components;
8890: }
8891:
1.144 matthew 8892: ######################################################
8893: ######################################################
8894:
1.56 matthew 8895: =pod
8896:
1.648 raeburn 8897: =item * &upfile_select_html()
1.41 ng 8898:
1.144 matthew 8899: Return HTML code to select a file from the users machine and specify
8900: the file type.
1.41 ng 8901:
8902: =cut
8903:
1.144 matthew 8904: ######################################################
8905: ######################################################
1.31 albertel 8906: sub upfile_select_html {
1.144 matthew 8907: my %Types = (
8908: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 8909: semisv => &mt('Semicolon separated values'),
1.144 matthew 8910: space => &mt('Space separated'),
8911: tab => &mt('Tabulator separated'),
8912: # xml => &mt('HTML/XML'),
8913: );
8914: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 8915: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 8916: foreach my $type (sort(keys(%Types))) {
8917: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
8918: }
8919: $Str .= "</select>\n";
8920: return $Str;
1.31 albertel 8921: }
8922:
1.301 albertel 8923: sub get_samples {
8924: my ($records,$toget) = @_;
8925: my @samples=({});
8926: my $got=0;
8927: foreach my $rec (@$records) {
8928: my %temp = &record_sep($rec);
8929: if (! grep(/\S/, values(%temp))) { next; }
8930: if (%temp) {
8931: $samples[$got]=\%temp;
8932: $got++;
8933: if ($got == $toget) { last; }
8934: }
8935: }
8936: return \@samples;
8937: }
8938:
1.144 matthew 8939: ######################################################
8940: ######################################################
8941:
1.56 matthew 8942: =pod
8943:
1.648 raeburn 8944: =item * &csv_print_samples($r,$records)
1.41 ng 8945:
8946: Prints a table of sample values from each column uploaded $r is an
8947: Apache Request ref, $records is an arrayref from
8948: &Apache::loncommon::upfile_record_sep
8949:
8950: =cut
8951:
1.144 matthew 8952: ######################################################
8953: ######################################################
1.31 albertel 8954: sub csv_print_samples {
8955: my ($r,$records) = @_;
1.662 bisitz 8956: my $samples = &get_samples($records,5);
1.301 albertel 8957:
1.594 raeburn 8958: $r->print(&mt('Samples').'<br />'.&start_data_table().
8959: &start_data_table_header_row());
1.356 albertel 8960: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 8961: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 8962: $r->print(&end_data_table_header_row());
1.301 albertel 8963: foreach my $hash (@$samples) {
1.594 raeburn 8964: $r->print(&start_data_table_row());
1.356 albertel 8965: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 8966: $r->print('<td>');
1.356 albertel 8967: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 8968: $r->print('</td>');
8969: }
1.594 raeburn 8970: $r->print(&end_data_table_row());
1.31 albertel 8971: }
1.594 raeburn 8972: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 8973: }
8974:
1.144 matthew 8975: ######################################################
8976: ######################################################
8977:
1.56 matthew 8978: =pod
8979:
1.648 raeburn 8980: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 8981:
8982: Prints a table to create associations between values and table columns.
1.144 matthew 8983:
1.41 ng 8984: $r is an Apache Request ref,
8985: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 8986: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 8987:
8988: =cut
8989:
1.144 matthew 8990: ######################################################
8991: ######################################################
1.31 albertel 8992: sub csv_print_select_table {
8993: my ($r,$records,$d) = @_;
1.301 albertel 8994: my $i=0;
8995: my $samples = &get_samples($records,1);
1.144 matthew 8996: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 8997: &start_data_table().&start_data_table_header_row().
1.144 matthew 8998: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 8999: '<th>'.&mt('Column').'</th>'.
9000: &end_data_table_header_row()."\n");
1.356 albertel 9001: foreach my $array_ref (@$d) {
9002: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 9003: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 9004:
1.875 bisitz 9005: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 9006: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 9007: $r->print('<option value="none"></option>');
1.356 albertel 9008: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
9009: $r->print('<option value="'.$sample.'"'.
9010: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 9011: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 9012: }
1.594 raeburn 9013: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 9014: $i++;
9015: }
1.594 raeburn 9016: $r->print(&end_data_table());
1.31 albertel 9017: $i--;
9018: return $i;
9019: }
1.56 matthew 9020:
1.144 matthew 9021: ######################################################
9022: ######################################################
9023:
1.56 matthew 9024: =pod
1.31 albertel 9025:
1.648 raeburn 9026: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 9027:
9028: Prints a table of sample values from the upload and can make associate samples to internal names.
9029:
9030: $r is an Apache Request ref,
9031: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
9032: $d is an array of 2 element arrays (internal name, displayed name)
9033:
9034: =cut
9035:
1.144 matthew 9036: ######################################################
9037: ######################################################
1.31 albertel 9038: sub csv_samples_select_table {
9039: my ($r,$records,$d) = @_;
9040: my $i=0;
1.144 matthew 9041: #
1.662 bisitz 9042: my $max_samples = 5;
9043: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 9044: $r->print(&start_data_table().
9045: &start_data_table_header_row().'<th>'.
9046: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
9047: &end_data_table_header_row());
1.301 albertel 9048:
9049: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 9050: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 9051: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 9052: foreach my $option (@$d) {
9053: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 9054: $r->print('<option value="'.$value.'"'.
1.253 albertel 9055: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 9056: $display.'</option>');
1.31 albertel 9057: }
9058: $r->print('</select></td><td>');
1.662 bisitz 9059: foreach my $line (0..($max_samples-1)) {
1.301 albertel 9060: if (defined($samples->[$line]{$key})) {
9061: $r->print($samples->[$line]{$key}."<br />\n");
9062: }
9063: }
1.594 raeburn 9064: $r->print('</td>'.&end_data_table_row());
1.31 albertel 9065: $i++;
9066: }
1.594 raeburn 9067: $r->print(&end_data_table());
1.31 albertel 9068: $i--;
9069: return($i);
1.115 matthew 9070: }
9071:
1.144 matthew 9072: ######################################################
9073: ######################################################
9074:
1.115 matthew 9075: =pod
9076:
1.648 raeburn 9077: =item * &clean_excel_name($name)
1.115 matthew 9078:
9079: Returns a replacement for $name which does not contain any illegal characters.
9080:
9081: =cut
9082:
1.144 matthew 9083: ######################################################
9084: ######################################################
1.115 matthew 9085: sub clean_excel_name {
9086: my ($name) = @_;
9087: $name =~ s/[:\*\?\/\\]//g;
9088: if (length($name) > 31) {
9089: $name = substr($name,0,31);
9090: }
9091: return $name;
1.25 albertel 9092: }
1.84 albertel 9093:
1.85 albertel 9094: =pod
9095:
1.648 raeburn 9096: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 9097:
9098: Returns either 1 or undef
9099:
9100: 1 if the part is to be hidden, undef if it is to be shown
9101:
9102: Arguments are:
9103:
9104: $id the id of the part to be checked
9105: $symb, optional the symb of the resource to check
9106: $udom, optional the domain of the user to check for
9107: $uname, optional the username of the user to check for
9108:
9109: =cut
1.84 albertel 9110:
9111: sub check_if_partid_hidden {
9112: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 9113: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 9114: $symb,$udom,$uname);
1.141 albertel 9115: my $truth=1;
9116: #if the string starts with !, then the list is the list to show not hide
9117: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 9118: my @hiddenlist=split(/,/,$hiddenparts);
9119: foreach my $checkid (@hiddenlist) {
1.141 albertel 9120: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 9121: }
1.141 albertel 9122: return !$truth;
1.84 albertel 9123: }
1.127 matthew 9124:
1.138 matthew 9125:
9126: ############################################################
9127: ############################################################
9128:
9129: =pod
9130:
1.157 matthew 9131: =back
9132:
1.138 matthew 9133: =head1 cgi-bin script and graphing routines
9134:
1.157 matthew 9135: =over 4
9136:
1.648 raeburn 9137: =item * &get_cgi_id()
1.138 matthew 9138:
9139: Inputs: none
9140:
9141: Returns an id which can be used to pass environment variables
9142: to various cgi-bin scripts. These environment variables will
9143: be removed from the users environment after a given time by
9144: the routine &Apache::lonnet::transfer_profile_to_env.
9145:
9146: =cut
9147:
9148: ############################################################
9149: ############################################################
1.152 albertel 9150: my $uniq=0;
1.136 matthew 9151: sub get_cgi_id {
1.154 albertel 9152: $uniq=($uniq+1)%100000;
1.280 albertel 9153: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 9154: }
9155:
1.127 matthew 9156: ############################################################
9157: ############################################################
9158:
9159: =pod
9160:
1.648 raeburn 9161: =item * &DrawBarGraph()
1.127 matthew 9162:
1.138 matthew 9163: Facilitates the plotting of data in a (stacked) bar graph.
9164: Puts plot definition data into the users environment in order for
9165: graph.png to plot it. Returns an <img> tag for the plot.
9166: The bars on the plot are labeled '1','2',...,'n'.
9167:
9168: Inputs:
9169:
9170: =over 4
9171:
9172: =item $Title: string, the title of the plot
9173:
9174: =item $xlabel: string, text describing the X-axis of the plot
9175:
9176: =item $ylabel: string, text describing the Y-axis of the plot
9177:
9178: =item $Max: scalar, the maximum Y value to use in the plot
9179: If $Max is < any data point, the graph will not be rendered.
9180:
1.140 matthew 9181: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 9182: they are plotted. If undefined, default values will be used.
9183:
1.178 matthew 9184: =item $labels: array ref holding the labels to use on the x-axis for the bars.
9185:
1.138 matthew 9186: =item @Values: An array of array references. Each array reference holds data
9187: to be plotted in a stacked bar chart.
9188:
1.239 matthew 9189: =item If the final element of @Values is a hash reference the key/value
9190: pairs will be added to the graph definition.
9191:
1.138 matthew 9192: =back
9193:
9194: Returns:
9195:
9196: An <img> tag which references graph.png and the appropriate identifying
9197: information for the plot.
9198:
1.127 matthew 9199: =cut
9200:
9201: ############################################################
9202: ############################################################
1.134 matthew 9203: sub DrawBarGraph {
1.178 matthew 9204: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 9205: #
9206: if (! defined($colors)) {
9207: $colors = ['#33ff00',
9208: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
9209: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
9210: ];
9211: }
1.228 matthew 9212: my $extra_settings = {};
9213: if (ref($Values[-1]) eq 'HASH') {
9214: $extra_settings = pop(@Values);
9215: }
1.127 matthew 9216: #
1.136 matthew 9217: my $identifier = &get_cgi_id();
9218: my $id = 'cgi.'.$identifier;
1.129 matthew 9219: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 9220: return '';
9221: }
1.225 matthew 9222: #
9223: my @Labels;
9224: if (defined($labels)) {
9225: @Labels = @$labels;
9226: } else {
9227: for (my $i=0;$i<@{$Values[0]};$i++) {
9228: push (@Labels,$i+1);
9229: }
9230: }
9231: #
1.129 matthew 9232: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 9233: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 9234: my %ValuesHash;
9235: my $NumSets=1;
9236: foreach my $array (@Values) {
9237: next if (! ref($array));
1.136 matthew 9238: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 9239: join(',',@$array);
1.129 matthew 9240: }
1.127 matthew 9241: #
1.136 matthew 9242: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 9243: if ($NumBars < 3) {
9244: $width = 120+$NumBars*32;
1.220 matthew 9245: $xskip = 1;
1.225 matthew 9246: $bar_width = 30;
9247: } elsif ($NumBars < 5) {
9248: $width = 120+$NumBars*20;
9249: $xskip = 1;
9250: $bar_width = 20;
1.220 matthew 9251: } elsif ($NumBars < 10) {
1.136 matthew 9252: $width = 120+$NumBars*15;
9253: $xskip = 1;
9254: $bar_width = 15;
9255: } elsif ($NumBars <= 25) {
9256: $width = 120+$NumBars*11;
9257: $xskip = 5;
9258: $bar_width = 8;
9259: } elsif ($NumBars <= 50) {
9260: $width = 120+$NumBars*8;
9261: $xskip = 5;
9262: $bar_width = 4;
9263: } else {
9264: $width = 120+$NumBars*8;
9265: $xskip = 5;
9266: $bar_width = 4;
9267: }
9268: #
1.137 matthew 9269: $Max = 1 if ($Max < 1);
9270: if ( int($Max) < $Max ) {
9271: $Max++;
9272: $Max = int($Max);
9273: }
1.127 matthew 9274: $Title = '' if (! defined($Title));
9275: $xlabel = '' if (! defined($xlabel));
9276: $ylabel = '' if (! defined($ylabel));
1.369 www 9277: $ValuesHash{$id.'.title'} = &escape($Title);
9278: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
9279: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 9280: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 9281: $ValuesHash{$id.'.NumBars'} = $NumBars;
9282: $ValuesHash{$id.'.NumSets'} = $NumSets;
9283: $ValuesHash{$id.'.PlotType'} = 'bar';
9284: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
9285: $ValuesHash{$id.'.height'} = $height;
9286: $ValuesHash{$id.'.width'} = $width;
9287: $ValuesHash{$id.'.xskip'} = $xskip;
9288: $ValuesHash{$id.'.bar_width'} = $bar_width;
9289: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 9290: #
1.228 matthew 9291: # Deal with other parameters
9292: while (my ($key,$value) = each(%$extra_settings)) {
9293: $ValuesHash{$id.'.'.$key} = $value;
9294: }
9295: #
1.646 raeburn 9296: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 9297: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
9298: }
9299:
9300: ############################################################
9301: ############################################################
9302:
9303: =pod
9304:
1.648 raeburn 9305: =item * &DrawXYGraph()
1.137 matthew 9306:
1.138 matthew 9307: Facilitates the plotting of data in an XY graph.
9308: Puts plot definition data into the users environment in order for
9309: graph.png to plot it. Returns an <img> tag for the plot.
9310:
9311: Inputs:
9312:
9313: =over 4
9314:
9315: =item $Title: string, the title of the plot
9316:
9317: =item $xlabel: string, text describing the X-axis of the plot
9318:
9319: =item $ylabel: string, text describing the Y-axis of the plot
9320:
9321: =item $Max: scalar, the maximum Y value to use in the plot
9322: If $Max is < any data point, the graph will not be rendered.
9323:
9324: =item $colors: Array ref containing the hex color codes for the data to be
9325: plotted in. If undefined, default values will be used.
9326:
9327: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
9328:
9329: =item $Ydata: Array ref containing Array refs.
1.185 www 9330: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 9331:
9332: =item %Values: hash indicating or overriding any default values which are
9333: passed to graph.png.
9334: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
9335:
9336: =back
9337:
9338: Returns:
9339:
9340: An <img> tag which references graph.png and the appropriate identifying
9341: information for the plot.
9342:
1.137 matthew 9343: =cut
9344:
9345: ############################################################
9346: ############################################################
9347: sub DrawXYGraph {
9348: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
9349: #
9350: # Create the identifier for the graph
9351: my $identifier = &get_cgi_id();
9352: my $id = 'cgi.'.$identifier;
9353: #
9354: $Title = '' if (! defined($Title));
9355: $xlabel = '' if (! defined($xlabel));
9356: $ylabel = '' if (! defined($ylabel));
9357: my %ValuesHash =
9358: (
1.369 www 9359: $id.'.title' => &escape($Title),
9360: $id.'.xlabel' => &escape($xlabel),
9361: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 9362: $id.'.y_max_value'=> $Max,
9363: $id.'.labels' => join(',',@$Xlabels),
9364: $id.'.PlotType' => 'XY',
9365: );
9366: #
9367: if (defined($colors) && ref($colors) eq 'ARRAY') {
9368: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
9369: }
9370: #
9371: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
9372: return '';
9373: }
9374: my $NumSets=1;
1.138 matthew 9375: foreach my $array (@{$Ydata}){
1.137 matthew 9376: next if (! ref($array));
9377: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
9378: }
1.138 matthew 9379: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 9380: #
9381: # Deal with other parameters
9382: while (my ($key,$value) = each(%Values)) {
9383: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 9384: }
9385: #
1.646 raeburn 9386: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 9387: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
9388: }
9389:
9390: ############################################################
9391: ############################################################
9392:
9393: =pod
9394:
1.648 raeburn 9395: =item * &DrawXYYGraph()
1.138 matthew 9396:
9397: Facilitates the plotting of data in an XY graph with two Y axes.
9398: Puts plot definition data into the users environment in order for
9399: graph.png to plot it. Returns an <img> tag for the plot.
9400:
9401: Inputs:
9402:
9403: =over 4
9404:
9405: =item $Title: string, the title of the plot
9406:
9407: =item $xlabel: string, text describing the X-axis of the plot
9408:
9409: =item $ylabel: string, text describing the Y-axis of the plot
9410:
9411: =item $colors: Array ref containing the hex color codes for the data to be
9412: plotted in. If undefined, default values will be used.
9413:
9414: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
9415:
9416: =item $Ydata1: The first data set
9417:
9418: =item $Min1: The minimum value of the left Y-axis
9419:
9420: =item $Max1: The maximum value of the left Y-axis
9421:
9422: =item $Ydata2: The second data set
9423:
9424: =item $Min2: The minimum value of the right Y-axis
9425:
9426: =item $Max2: The maximum value of the left Y-axis
9427:
9428: =item %Values: hash indicating or overriding any default values which are
9429: passed to graph.png.
9430: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
9431:
9432: =back
9433:
9434: Returns:
9435:
9436: An <img> tag which references graph.png and the appropriate identifying
9437: information for the plot.
1.136 matthew 9438:
9439: =cut
9440:
9441: ############################################################
9442: ############################################################
1.137 matthew 9443: sub DrawXYYGraph {
9444: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
9445: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 9446: #
9447: # Create the identifier for the graph
9448: my $identifier = &get_cgi_id();
9449: my $id = 'cgi.'.$identifier;
9450: #
9451: $Title = '' if (! defined($Title));
9452: $xlabel = '' if (! defined($xlabel));
9453: $ylabel = '' if (! defined($ylabel));
9454: my %ValuesHash =
9455: (
1.369 www 9456: $id.'.title' => &escape($Title),
9457: $id.'.xlabel' => &escape($xlabel),
9458: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 9459: $id.'.labels' => join(',',@$Xlabels),
9460: $id.'.PlotType' => 'XY',
9461: $id.'.NumSets' => 2,
1.137 matthew 9462: $id.'.two_axes' => 1,
9463: $id.'.y1_max_value' => $Max1,
9464: $id.'.y1_min_value' => $Min1,
9465: $id.'.y2_max_value' => $Max2,
9466: $id.'.y2_min_value' => $Min2,
1.136 matthew 9467: );
9468: #
1.137 matthew 9469: if (defined($colors) && ref($colors) eq 'ARRAY') {
9470: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
9471: }
9472: #
9473: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
9474: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 9475: return '';
9476: }
9477: my $NumSets=1;
1.137 matthew 9478: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 9479: next if (! ref($array));
9480: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 9481: }
9482: #
9483: # Deal with other parameters
9484: while (my ($key,$value) = each(%Values)) {
9485: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 9486: }
9487: #
1.646 raeburn 9488: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 9489: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 9490: }
9491:
9492: ############################################################
9493: ############################################################
9494:
9495: =pod
9496:
1.157 matthew 9497: =back
9498:
1.139 matthew 9499: =head1 Statistics helper routines?
9500:
9501: Bad place for them but what the hell.
9502:
1.157 matthew 9503: =over 4
9504:
1.648 raeburn 9505: =item * &chartlink()
1.139 matthew 9506:
9507: Returns a link to the chart for a specific student.
9508:
9509: Inputs:
9510:
9511: =over 4
9512:
9513: =item $linktext: The text of the link
9514:
9515: =item $sname: The students username
9516:
9517: =item $sdomain: The students domain
9518:
9519: =back
9520:
1.157 matthew 9521: =back
9522:
1.139 matthew 9523: =cut
9524:
9525: ############################################################
9526: ############################################################
9527: sub chartlink {
9528: my ($linktext, $sname, $sdomain) = @_;
9529: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 9530: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 9531: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 9532: '">'.$linktext.'</a>';
1.153 matthew 9533: }
9534:
9535: #######################################################
9536: #######################################################
9537:
9538: =pod
9539:
9540: =head1 Course Environment Routines
1.157 matthew 9541:
9542: =over 4
1.153 matthew 9543:
1.648 raeburn 9544: =item * &restore_course_settings()
1.153 matthew 9545:
1.648 raeburn 9546: =item * &store_course_settings()
1.153 matthew 9547:
9548: Restores/Store indicated form parameters from the course environment.
9549: Will not overwrite existing values of the form parameters.
9550:
9551: Inputs:
9552: a scalar describing the data (e.g. 'chart', 'problem_analysis')
9553:
9554: a hash ref describing the data to be stored. For example:
9555:
9556: %Save_Parameters = ('Status' => 'scalar',
9557: 'chartoutputmode' => 'scalar',
9558: 'chartoutputdata' => 'scalar',
9559: 'Section' => 'array',
1.373 raeburn 9560: 'Group' => 'array',
1.153 matthew 9561: 'StudentData' => 'array',
9562: 'Maps' => 'array');
9563:
9564: Returns: both routines return nothing
9565:
1.631 raeburn 9566: =back
9567:
1.153 matthew 9568: =cut
9569:
9570: #######################################################
9571: #######################################################
9572: sub store_course_settings {
1.496 albertel 9573: return &store_settings($env{'request.course.id'},@_);
9574: }
9575:
9576: sub store_settings {
1.153 matthew 9577: # save to the environment
9578: # appenv the same items, just to be safe
1.300 albertel 9579: my $udom = $env{'user.domain'};
9580: my $uname = $env{'user.name'};
1.496 albertel 9581: my ($context,$prefix,$Settings) = @_;
1.153 matthew 9582: my %SaveHash;
9583: my %AppHash;
9584: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 9585: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 9586: my $envname = 'environment.'.$basename;
1.258 albertel 9587: if (exists($env{'form.'.$setting})) {
1.153 matthew 9588: # Save this value away
9589: if ($type eq 'scalar' &&
1.258 albertel 9590: (! exists($env{$envname}) ||
9591: $env{$envname} ne $env{'form.'.$setting})) {
9592: $SaveHash{$basename} = $env{'form.'.$setting};
9593: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 9594: } elsif ($type eq 'array') {
9595: my $stored_form;
1.258 albertel 9596: if (ref($env{'form.'.$setting})) {
1.153 matthew 9597: $stored_form = join(',',
9598: map {
1.369 www 9599: &escape($_);
1.258 albertel 9600: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 9601: } else {
9602: $stored_form =
1.369 www 9603: &escape($env{'form.'.$setting});
1.153 matthew 9604: }
9605: # Determine if the array contents are the same.
1.258 albertel 9606: if ($stored_form ne $env{$envname}) {
1.153 matthew 9607: $SaveHash{$basename} = $stored_form;
9608: $AppHash{$envname} = $stored_form;
9609: }
9610: }
9611: }
9612: }
9613: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 9614: $udom,$uname);
1.153 matthew 9615: if ($put_result !~ /^(ok|delayed)/) {
9616: &Apache::lonnet::logthis('unable to save form parameters, '.
9617: 'got error:'.$put_result);
9618: }
9619: # Make sure these settings stick around in this session, too
1.646 raeburn 9620: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 9621: return;
9622: }
9623:
9624: sub restore_course_settings {
1.499 albertel 9625: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 9626: }
9627:
9628: sub restore_settings {
9629: my ($context,$prefix,$Settings) = @_;
1.153 matthew 9630: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 9631: next if (exists($env{'form.'.$setting}));
1.496 albertel 9632: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 9633: '.'.$setting;
1.258 albertel 9634: if (exists($env{$envname})) {
1.153 matthew 9635: if ($type eq 'scalar') {
1.258 albertel 9636: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 9637: } elsif ($type eq 'array') {
1.258 albertel 9638: $env{'form.'.$setting} = [
1.153 matthew 9639: map {
1.369 www 9640: &unescape($_);
1.258 albertel 9641: } split(',',$env{$envname})
1.153 matthew 9642: ];
9643: }
9644: }
9645: }
1.127 matthew 9646: }
9647:
1.618 raeburn 9648: #######################################################
9649: #######################################################
9650:
9651: =pod
9652:
9653: =head1 Domain E-mail Routines
9654:
9655: =over 4
9656:
1.648 raeburn 9657: =item * &build_recipient_list()
1.618 raeburn 9658:
1.884 raeburn 9659: Build recipient lists for five types of e-mail:
1.766 raeburn 9660: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884 raeburn 9661: (d) Help requests, (e) Course requests needing approval, generated by
9662: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
9663: loncoursequeueadmin.pm respectively.
1.618 raeburn 9664:
9665: Inputs:
1.619 raeburn 9666: defmail (scalar - email address of default recipient),
1.618 raeburn 9667: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 9668: defdom (domain for which to retrieve configuration settings),
9669: origmail (scalar - email address of recipient from loncapa.conf,
9670: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 9671:
1.655 raeburn 9672: Returns: comma separated list of addresses to which to send e-mail.
9673:
9674: =back
1.618 raeburn 9675:
9676: =cut
9677:
9678: ############################################################
9679: ############################################################
9680: sub build_recipient_list {
1.619 raeburn 9681: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 9682: my @recipients;
9683: my $otheremails;
9684: my %domconfig =
9685: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
9686: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 9687: if (exists($domconfig{'contacts'}{$mailing})) {
9688: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
9689: my @contacts = ('adminemail','supportemail');
9690: foreach my $item (@contacts) {
9691: if ($domconfig{'contacts'}{$mailing}{$item}) {
9692: my $addr = $domconfig{'contacts'}{$item};
9693: if (!grep(/^\Q$addr\E$/,@recipients)) {
9694: push(@recipients,$addr);
9695: }
1.619 raeburn 9696: }
1.766 raeburn 9697: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 9698: }
9699: }
1.766 raeburn 9700: } elsif ($origmail ne '') {
9701: push(@recipients,$origmail);
1.618 raeburn 9702: }
1.619 raeburn 9703: } elsif ($origmail ne '') {
9704: push(@recipients,$origmail);
1.618 raeburn 9705: }
1.688 raeburn 9706: if (defined($defmail)) {
9707: if ($defmail ne '') {
9708: push(@recipients,$defmail);
9709: }
1.618 raeburn 9710: }
9711: if ($otheremails) {
1.619 raeburn 9712: my @others;
9713: if ($otheremails =~ /,/) {
9714: @others = split(/,/,$otheremails);
1.618 raeburn 9715: } else {
1.619 raeburn 9716: push(@others,$otheremails);
9717: }
9718: foreach my $addr (@others) {
9719: if (!grep(/^\Q$addr\E$/,@recipients)) {
9720: push(@recipients,$addr);
9721: }
1.618 raeburn 9722: }
9723: }
1.619 raeburn 9724: my $recipientlist = join(',',@recipients);
1.618 raeburn 9725: return $recipientlist;
9726: }
9727:
1.127 matthew 9728: ############################################################
9729: ############################################################
1.154 albertel 9730:
1.655 raeburn 9731: =pod
9732:
9733: =head1 Course Catalog Routines
9734:
9735: =over 4
9736:
9737: =item * &gather_categories()
9738:
9739: Converts category definitions - keys of categories hash stored in
9740: coursecategories in configuration.db on the primary library server in a
9741: domain - to an array. Also generates javascript and idx hash used to
9742: generate Domain Coordinator interface for editing Course Categories.
9743:
9744: Inputs:
1.663 raeburn 9745:
1.655 raeburn 9746: categories (reference to hash of category definitions).
1.663 raeburn 9747:
1.655 raeburn 9748: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9749: categories and subcategories).
1.663 raeburn 9750:
1.655 raeburn 9751: idx (reference to hash of counters used in Domain Coordinator interface for
9752: editing Course Categories).
1.663 raeburn 9753:
1.655 raeburn 9754: jsarray (reference to array of categories used to create Javascript arrays for
9755: Domain Coordinator interface for editing Course Categories).
9756:
9757: Returns: nothing
9758:
9759: Side effects: populates cats, idx and jsarray.
9760:
9761: =cut
9762:
9763: sub gather_categories {
9764: my ($categories,$cats,$idx,$jsarray) = @_;
9765: my %counters;
9766: my $num = 0;
9767: foreach my $item (keys(%{$categories})) {
9768: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
9769: if ($container eq '' && $depth == 0) {
9770: $cats->[$depth][$categories->{$item}] = $cat;
9771: } else {
9772: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
9773: }
9774: my ($escitem,$tail) = split(/:/,$item,2);
9775: if ($counters{$tail} eq '') {
9776: $counters{$tail} = $num;
9777: $num ++;
9778: }
9779: if (ref($idx) eq 'HASH') {
9780: $idx->{$item} = $counters{$tail};
9781: }
9782: if (ref($jsarray) eq 'ARRAY') {
9783: push(@{$jsarray->[$counters{$tail}]},$item);
9784: }
9785: }
9786: return;
9787: }
9788:
9789: =pod
9790:
9791: =item * &extract_categories()
9792:
9793: Used to generate breadcrumb trails for course categories.
9794:
9795: Inputs:
1.663 raeburn 9796:
1.655 raeburn 9797: categories (reference to hash of category definitions).
1.663 raeburn 9798:
1.655 raeburn 9799: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9800: categories and subcategories).
1.663 raeburn 9801:
1.655 raeburn 9802: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 9803:
1.655 raeburn 9804: allitems (reference to hash - key is category key
9805: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 9806:
1.655 raeburn 9807: idx (reference to hash of counters used in Domain Coordinator interface for
9808: editing Course Categories).
1.663 raeburn 9809:
1.655 raeburn 9810: jsarray (reference to array of categories used to create Javascript arrays for
9811: Domain Coordinator interface for editing Course Categories).
9812:
1.665 raeburn 9813: subcats (reference to hash of arrays containing all subcategories within each
9814: category, -recursive)
9815:
1.655 raeburn 9816: Returns: nothing
9817:
9818: Side effects: populates trails and allitems hash references.
9819:
9820: =cut
9821:
9822: sub extract_categories {
1.665 raeburn 9823: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 9824: if (ref($categories) eq 'HASH') {
9825: &gather_categories($categories,$cats,$idx,$jsarray);
9826: if (ref($cats->[0]) eq 'ARRAY') {
9827: for (my $i=0; $i<@{$cats->[0]}; $i++) {
9828: my $name = $cats->[0][$i];
9829: my $item = &escape($name).'::0';
9830: my $trailstr;
9831: if ($name eq 'instcode') {
9832: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 9833: } elsif ($name eq 'communities') {
9834: $trailstr = &mt('Communities');
1.655 raeburn 9835: } else {
9836: $trailstr = $name;
9837: }
9838: if ($allitems->{$item} eq '') {
9839: push(@{$trails},$trailstr);
9840: $allitems->{$item} = scalar(@{$trails})-1;
9841: }
9842: my @parents = ($name);
9843: if (ref($cats->[1]{$name}) eq 'ARRAY') {
9844: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
9845: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 9846: if (ref($subcats) eq 'HASH') {
9847: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
9848: }
9849: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
9850: }
9851: } else {
9852: if (ref($subcats) eq 'HASH') {
9853: $subcats->{$item} = [];
1.655 raeburn 9854: }
9855: }
9856: }
9857: }
9858: }
9859: return;
9860: }
9861:
9862: =pod
9863:
9864: =item *&recurse_categories()
9865:
9866: Recursively used to generate breadcrumb trails for course categories.
9867:
9868: Inputs:
1.663 raeburn 9869:
1.655 raeburn 9870: cats (reference to array of arrays/hashes which encapsulates hierarchy of
9871: categories and subcategories).
1.663 raeburn 9872:
1.655 raeburn 9873: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 9874:
9875: category (current course category, for which breadcrumb trail is being generated).
9876:
9877: trails (reference to array of breadcrumb trails for each category).
9878:
1.655 raeburn 9879: allitems (reference to hash - key is category key
9880: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 9881:
1.655 raeburn 9882: parents (array containing containers directories for current category,
9883: back to top level).
9884:
9885: Returns: nothing
9886:
9887: Side effects: populates trails and allitems hash references
9888:
9889: =cut
9890:
9891: sub recurse_categories {
1.665 raeburn 9892: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 9893: my $shallower = $depth - 1;
9894: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
9895: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
9896: my $name = $cats->[$depth]{$category}[$k];
9897: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9898: my $trailstr = join(' -> ',(@{$parents},$category));
9899: if ($allitems->{$item} eq '') {
9900: push(@{$trails},$trailstr);
9901: $allitems->{$item} = scalar(@{$trails})-1;
9902: }
9903: my $deeper = $depth+1;
9904: push(@{$parents},$category);
1.665 raeburn 9905: if (ref($subcats) eq 'HASH') {
9906: my $subcat = &escape($name).':'.$category.':'.$depth;
9907: for (my $j=@{$parents}; $j>=0; $j--) {
9908: my $higher;
9909: if ($j > 0) {
9910: $higher = &escape($parents->[$j]).':'.
9911: &escape($parents->[$j-1]).':'.$j;
9912: } else {
9913: $higher = &escape($parents->[$j]).'::'.$j;
9914: }
9915: push(@{$subcats->{$higher}},$subcat);
9916: }
9917: }
9918: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
9919: $subcats);
1.655 raeburn 9920: pop(@{$parents});
9921: }
9922: } else {
9923: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
9924: my $trailstr = join(' -> ',(@{$parents},$category));
9925: if ($allitems->{$item} eq '') {
9926: push(@{$trails},$trailstr);
9927: $allitems->{$item} = scalar(@{$trails})-1;
9928: }
9929: }
9930: return;
9931: }
9932:
1.663 raeburn 9933: =pod
9934:
9935: =item *&assign_categories_table()
9936:
9937: Create a datatable for display of hierarchical categories in a domain,
9938: with checkboxes to allow a course to be categorized.
9939:
9940: Inputs:
9941:
9942: cathash - reference to hash of categories defined for the domain (from
9943: configuration.db)
9944:
9945: currcat - scalar with an & separated list of categories assigned to a course.
9946:
1.919 raeburn 9947: type - scalar contains course type (Course or Community).
9948:
1.663 raeburn 9949: Returns: $output (markup to be displayed)
9950:
9951: =cut
9952:
9953: sub assign_categories_table {
1.919 raeburn 9954: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 9955: my $output;
9956: if (ref($cathash) eq 'HASH') {
9957: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
9958: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
9959: $maxdepth = scalar(@cats);
9960: if (@cats > 0) {
9961: my $itemcount = 0;
9962: if (ref($cats[0]) eq 'ARRAY') {
9963: my @currcategories;
9964: if ($currcat ne '') {
9965: @currcategories = split('&',$currcat);
9966: }
1.919 raeburn 9967: my $table;
1.663 raeburn 9968: for (my $i=0; $i<@{$cats[0]}; $i++) {
9969: my $parent = $cats[0][$i];
1.919 raeburn 9970: next if ($parent eq 'instcode');
9971: if ($type eq 'Community') {
9972: next unless ($parent eq 'communities');
9973: } else {
9974: next if ($parent eq 'communities');
9975: }
1.663 raeburn 9976: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
9977: my $item = &escape($parent).'::0';
9978: my $checked = '';
9979: if (@currcategories > 0) {
9980: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 9981: $checked = ' checked="checked"';
1.663 raeburn 9982: }
9983: }
1.919 raeburn 9984: my $parent_title = $parent;
9985: if ($parent eq 'communities') {
9986: $parent_title = &mt('Communities');
9987: }
9988: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
9989: '<input type="checkbox" name="usecategory" value="'.
9990: $item.'"'.$checked.' />'.$parent_title.'</span>'.
9991: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 9992: my $depth = 1;
9993: push(@path,$parent);
1.919 raeburn 9994: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 9995: pop(@path);
1.919 raeburn 9996: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 9997: $itemcount ++;
9998: }
1.919 raeburn 9999: if ($itemcount) {
10000: $output = &Apache::loncommon::start_data_table().
10001: $table.
10002: &Apache::loncommon::end_data_table();
10003: }
1.663 raeburn 10004: }
10005: }
10006: }
10007: return $output;
10008: }
10009:
10010: =pod
10011:
10012: =item *&assign_category_rows()
10013:
10014: Create a datatable row for display of nested categories in a domain,
10015: with checkboxes to allow a course to be categorized,called recursively.
10016:
10017: Inputs:
10018:
10019: itemcount - track row number for alternating colors
10020:
10021: cats - reference to array of arrays/hashes which encapsulates hierarchy of
10022: categories and subcategories.
10023:
10024: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
10025:
10026: parent - parent of current category item
10027:
10028: path - Array containing all categories back up through the hierarchy from the
10029: current category to the top level.
10030:
10031: currcategories - reference to array of current categories assigned to the course
10032:
10033: Returns: $output (markup to be displayed).
10034:
10035: =cut
10036:
10037: sub assign_category_rows {
10038: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
10039: my ($text,$name,$item,$chgstr);
10040: if (ref($cats) eq 'ARRAY') {
10041: my $maxdepth = scalar(@{$cats});
10042: if (ref($cats->[$depth]) eq 'HASH') {
10043: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
10044: my $numchildren = @{$cats->[$depth]{$parent}};
10045: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
10046: $text .= '<td><table class="LC_datatable">';
10047: for (my $j=0; $j<$numchildren; $j++) {
10048: $name = $cats->[$depth]{$parent}[$j];
10049: $item = &escape($name).':'.&escape($parent).':'.$depth;
10050: my $deeper = $depth+1;
10051: my $checked = '';
10052: if (ref($currcategories) eq 'ARRAY') {
10053: if (@{$currcategories} > 0) {
10054: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 10055: $checked = ' checked="checked"';
1.663 raeburn 10056: }
10057: }
10058: }
1.664 raeburn 10059: $text .= '<tr><td><span class="LC_nobreak"><label>'.
10060: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 10061: $item.'"'.$checked.' />'.$name.'</label></span>'.
10062: '<input type="hidden" name="catname" value="'.$name.'" />'.
10063: '</td><td>';
1.663 raeburn 10064: if (ref($path) eq 'ARRAY') {
10065: push(@{$path},$name);
10066: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
10067: pop(@{$path});
10068: }
10069: $text .= '</td></tr>';
10070: }
10071: $text .= '</table></td>';
10072: }
10073: }
10074: }
10075: return $text;
10076: }
10077:
1.655 raeburn 10078: ############################################################
10079: ############################################################
10080:
10081:
1.443 albertel 10082: sub commit_customrole {
1.664 raeburn 10083: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 10084: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 10085: ($start?', '.&mt('starting').' '.localtime($start):'').
10086: ($end?', ending '.localtime($end):'').': <b>'.
10087: &Apache::lonnet::assigncustomrole(
1.664 raeburn 10088: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 10089: '</b><br />';
10090: return $output;
10091: }
10092:
10093: sub commit_standardrole {
1.541 raeburn 10094: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
10095: my ($output,$logmsg,$linefeed);
10096: if ($context eq 'auto') {
10097: $linefeed = "\n";
10098: } else {
10099: $linefeed = "<br />\n";
10100: }
1.443 albertel 10101: if ($three eq 'st') {
1.541 raeburn 10102: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
10103: $one,$two,$sec,$context);
10104: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 10105: ($result eq 'unknown_course') || ($result eq 'refused')) {
10106: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 10107: } else {
1.541 raeburn 10108: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 10109: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 10110: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
10111: if ($context eq 'auto') {
10112: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
10113: } else {
10114: $output .= '<b>'.$result.'</b>'.$linefeed.
10115: &mt('Add to classlist').': <b>ok</b>';
10116: }
10117: $output .= $linefeed;
1.443 albertel 10118: }
10119: } else {
10120: $output = &mt('Assigning').' '.$three.' in '.$url.
10121: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 10122: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 10123: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 10124: if ($context eq 'auto') {
10125: $output .= $result.$linefeed;
10126: } else {
10127: $output .= '<b>'.$result.'</b>'.$linefeed;
10128: }
1.443 albertel 10129: }
10130: return $output;
10131: }
10132:
10133: sub commit_studentrole {
1.541 raeburn 10134: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626 raeburn 10135: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 10136: if ($context eq 'auto') {
10137: $linefeed = "\n";
10138: } else {
10139: $linefeed = '<br />'."\n";
10140: }
1.443 albertel 10141: if (defined($one) && defined($two)) {
10142: my $cid=$one.'_'.$two;
10143: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
10144: my $secchange = 0;
10145: my $expire_role_result;
10146: my $modify_section_result;
1.628 raeburn 10147: if ($oldsec ne '-1') {
10148: if ($oldsec ne $sec) {
1.443 albertel 10149: $secchange = 1;
1.628 raeburn 10150: my $now = time;
1.443 albertel 10151: my $uurl='/'.$cid;
10152: $uurl=~s/\_/\//g;
10153: if ($oldsec) {
10154: $uurl.='/'.$oldsec;
10155: }
1.626 raeburn 10156: $oldsecurl = $uurl;
1.628 raeburn 10157: $expire_role_result =
1.652 raeburn 10158: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 10159: if ($env{'request.course.sec'} ne '') {
10160: if ($expire_role_result eq 'refused') {
10161: my @roles = ('st');
10162: my @statuses = ('previous');
10163: my @roledoms = ($one);
10164: my $withsec = 1;
10165: my %roleshash =
10166: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
10167: \@statuses,\@roles,\@roledoms,$withsec);
10168: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
10169: my ($oldstart,$oldend) =
10170: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
10171: if ($oldend > 0 && $oldend <= $now) {
10172: $expire_role_result = 'ok';
10173: }
10174: }
10175: }
10176: }
1.443 albertel 10177: $result = $expire_role_result;
10178: }
10179: }
10180: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652 raeburn 10181: $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443 albertel 10182: if ($modify_section_result =~ /^ok/) {
10183: if ($secchange == 1) {
1.628 raeburn 10184: if ($sec eq '') {
10185: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
10186: } else {
10187: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
10188: }
1.443 albertel 10189: } elsif ($oldsec eq '-1') {
1.628 raeburn 10190: if ($sec eq '') {
10191: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
10192: } else {
10193: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
10194: }
1.443 albertel 10195: } else {
1.628 raeburn 10196: if ($sec eq '') {
10197: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
10198: } else {
10199: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
10200: }
1.443 albertel 10201: }
10202: } else {
1.628 raeburn 10203: if ($secchange) {
10204: $$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;
10205: } else {
10206: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
10207: }
1.443 albertel 10208: }
10209: $result = $modify_section_result;
10210: } elsif ($secchange == 1) {
1.628 raeburn 10211: if ($oldsec eq '') {
10212: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
10213: } else {
10214: $$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;
10215: }
1.626 raeburn 10216: if ($expire_role_result eq 'refused') {
10217: my $newsecurl = '/'.$cid;
10218: $newsecurl =~ s/\_/\//g;
10219: if ($sec ne '') {
10220: $newsecurl.='/'.$sec;
10221: }
10222: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
10223: if ($sec eq '') {
10224: $$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;
10225: } else {
10226: $$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;
10227: }
10228: }
10229: }
1.443 albertel 10230: }
10231: } else {
1.626 raeburn 10232: $$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 10233: $result = "error: incomplete course id\n";
10234: }
10235: return $result;
10236: }
10237:
10238: ############################################################
10239: ############################################################
10240:
1.566 albertel 10241: sub check_clone {
1.578 raeburn 10242: my ($args,$linefeed) = @_;
1.566 albertel 10243: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
10244: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
10245: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
10246: my $clonemsg;
10247: my $can_clone = 0;
1.925.2.11 raeburn 10248: my $lctype = lc($args->{'crstype'});
1.908 raeburn 10249: if ($lctype ne 'community') {
10250: $lctype = 'course';
10251: }
1.566 albertel 10252: if ($clonehome eq 'no_host') {
1.925.2.11 raeburn 10253: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 10254: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
10255: } else {
10256: $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'});
10257: }
1.566 albertel 10258: } else {
10259: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.925.2.11 raeburn 10260: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 10261: if ($clonedesc{'type'} ne 'Community') {
10262: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
10263: return ($can_clone, $clonemsg, $cloneid, $clonehome);
10264: }
10265: }
1.882 raeburn 10266: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
10267: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 10268: $can_clone = 1;
10269: } else {
10270: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
10271: $args->{'clonedomain'},$args->{'clonecourse'});
10272: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 10273: if (grep(/^\*$/,@cloners)) {
10274: $can_clone = 1;
10275: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
10276: $can_clone = 1;
10277: } else {
1.908 raeburn 10278: my $ccrole = 'cc';
1.925.2.11 raeburn 10279: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 10280: $ccrole = 'co';
10281: }
1.578 raeburn 10282: my %roleshash =
10283: &Apache::lonnet::get_my_roles($args->{'ccuname'},
10284: $args->{'ccdomain'},
1.908 raeburn 10285: 'userroles',['active'],[$ccrole],
1.578 raeburn 10286: [$args->{'clonedomain'}]);
1.908 raeburn 10287: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.578 raeburn 10288: $can_clone = 1;
10289: } else {
1.925.2.11 raeburn 10290: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 10291: $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
10292: } else {
10293: $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'});
10294: }
1.578 raeburn 10295: }
1.566 albertel 10296: }
1.578 raeburn 10297: }
1.566 albertel 10298: }
10299: return ($can_clone, $clonemsg, $cloneid, $clonehome);
10300: }
10301:
1.444 albertel 10302: sub construct_course {
1.885 raeburn 10303: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 10304: my $outcome;
1.541 raeburn 10305: my $linefeed = '<br />'."\n";
10306: if ($context eq 'auto') {
10307: $linefeed = "\n";
10308: }
1.566 albertel 10309:
10310: #
10311: # Are we cloning?
10312: #
10313: my ($can_clone, $clonemsg, $cloneid, $clonehome);
10314: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 10315: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 10316: if ($context ne 'auto') {
1.578 raeburn 10317: if ($clonemsg ne '') {
10318: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
10319: }
1.566 albertel 10320: }
10321: $outcome .= $clonemsg.$linefeed;
10322:
10323: if (!$can_clone) {
10324: return (0,$outcome);
10325: }
10326: }
10327:
1.444 albertel 10328: #
10329: # Open course
10330: #
10331: my $crstype = lc($args->{'crstype'});
10332: my %cenv=();
10333: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
10334: $args->{'cdescr'},
10335: $args->{'curl'},
10336: $args->{'course_home'},
10337: $args->{'nonstandard'},
10338: $args->{'crscode'},
10339: $args->{'ccuname'}.':'.
10340: $args->{'ccdomain'},
1.882 raeburn 10341: $args->{'crstype'},
1.885 raeburn 10342: $cnum,$context,$category);
1.444 albertel 10343:
10344: # Note: The testing routines depend on this being output; see
10345: # Utils::Course. This needs to at least be output as a comment
10346: # if anyone ever decides to not show this, and Utils::Course::new
10347: # will need to be suitably modified.
1.541 raeburn 10348: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.444 albertel 10349: #
10350: # Check if created correctly
10351: #
1.479 albertel 10352: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 10353: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.541 raeburn 10354: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 10355:
1.444 albertel 10356: #
1.566 albertel 10357: # Do the cloning
10358: #
10359: if ($can_clone && $cloneid) {
10360: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
10361: if ($context ne 'auto') {
10362: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
10363: }
10364: $outcome .= $clonemsg.$linefeed;
10365: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 10366: # Copy all files
1.637 www 10367: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 10368: # Restore URL
1.566 albertel 10369: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 10370: # Restore title
1.566 albertel 10371: $cenv{'description'}=$oldcenv{'description'};
1.444 albertel 10372: # Mark as cloned
1.566 albertel 10373: $cenv{'clonedfrom'}=$cloneid;
1.638 www 10374: # Need to clone grading mode
10375: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
10376: $cenv{'grading'}=$newenv{'grading'};
10377: # Do not clone these environment entries
10378: &Apache::lonnet::del('environment',
10379: ['default_enrollment_start_date',
10380: 'default_enrollment_end_date',
10381: 'question.email',
10382: 'policy.email',
10383: 'comment.email',
10384: 'pch.users.denied',
1.725 raeburn 10385: 'plc.users.denied',
10386: 'hidefromcat',
10387: 'categories'],
1.638 www 10388: $$crsudom,$$crsunum);
1.444 albertel 10389: }
1.566 albertel 10390:
1.444 albertel 10391: #
10392: # Set environment (will override cloned, if existing)
10393: #
10394: my @sections = ();
10395: my @xlists = ();
10396: if ($args->{'crstype'}) {
10397: $cenv{'type'}=$args->{'crstype'};
10398: }
10399: if ($args->{'crsid'}) {
10400: $cenv{'courseid'}=$args->{'crsid'};
10401: }
10402: if ($args->{'crscode'}) {
10403: $cenv{'internal.coursecode'}=$args->{'crscode'};
10404: }
10405: if ($args->{'crsquota'} ne '') {
10406: $cenv{'internal.coursequota'}=$args->{'crsquota'};
10407: } else {
10408: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
10409: }
10410: if ($args->{'ccuname'}) {
10411: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
10412: ':'.$args->{'ccdomain'};
10413: } else {
10414: $cenv{'internal.courseowner'} = $args->{'curruser'};
10415: }
10416: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
10417: if ($args->{'crssections'}) {
10418: $cenv{'internal.sectionnums'} = '';
10419: if ($args->{'crssections'} =~ m/,/) {
10420: @sections = split/,/,$args->{'crssections'};
10421: } else {
10422: $sections[0] = $args->{'crssections'};
10423: }
10424: if (@sections > 0) {
10425: foreach my $item (@sections) {
10426: my ($sec,$gp) = split/:/,$item;
10427: my $class = $args->{'crscode'}.$sec;
10428: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
10429: $cenv{'internal.sectionnums'} .= $item.',';
10430: unless ($addcheck eq 'ok') {
10431: push @badclasses, $class;
10432: }
10433: }
10434: $cenv{'internal.sectionnums'} =~ s/,$//;
10435: }
10436: }
10437: # do not hide course coordinator from staff listing,
10438: # even if privileged
10439: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10440: # add crosslistings
10441: if ($args->{'crsxlist'}) {
10442: $cenv{'internal.crosslistings'}='';
10443: if ($args->{'crsxlist'} =~ m/,/) {
10444: @xlists = split/,/,$args->{'crsxlist'};
10445: } else {
10446: $xlists[0] = $args->{'crsxlist'};
10447: }
10448: if (@xlists > 0) {
10449: foreach my $item (@xlists) {
10450: my ($xl,$gp) = split/:/,$item;
10451: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
10452: $cenv{'internal.crosslistings'} .= $item.',';
10453: unless ($addcheck eq 'ok') {
10454: push @badclasses, $xl;
10455: }
10456: }
10457: $cenv{'internal.crosslistings'} =~ s/,$//;
10458: }
10459: }
10460: if ($args->{'autoadds'}) {
10461: $cenv{'internal.autoadds'}=$args->{'autoadds'};
10462: }
10463: if ($args->{'autodrops'}) {
10464: $cenv{'internal.autodrops'}=$args->{'autodrops'};
10465: }
10466: # check for notification of enrollment changes
10467: my @notified = ();
10468: if ($args->{'notify_owner'}) {
10469: if ($args->{'ccuname'} ne '') {
10470: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
10471: }
10472: }
10473: if ($args->{'notify_dc'}) {
10474: if ($uname ne '') {
1.630 raeburn 10475: push(@notified,$uname.':'.$udom);
1.444 albertel 10476: }
10477: }
10478: if (@notified > 0) {
10479: my $notifylist;
10480: if (@notified > 1) {
10481: $notifylist = join(',',@notified);
10482: } else {
10483: $notifylist = $notified[0];
10484: }
10485: $cenv{'internal.notifylist'} = $notifylist;
10486: }
10487: if (@badclasses > 0) {
10488: my %lt=&Apache::lonlocal::texthash(
10489: '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',
10490: 'dnhr' => 'does not have rights to access enrollment in these classes',
10491: 'adby' => 'as determined by the policies of your institution on access to official classlists'
10492: );
1.541 raeburn 10493: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
10494: ' ('.$lt{'adby'}.')';
10495: if ($context eq 'auto') {
10496: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 10497: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 10498: foreach my $item (@badclasses) {
10499: if ($context eq 'auto') {
10500: $outcome .= " - $item\n";
10501: } else {
10502: $outcome .= "<li>$item</li>\n";
10503: }
10504: }
10505: if ($context eq 'auto') {
10506: $outcome .= $linefeed;
10507: } else {
1.566 albertel 10508: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 10509: }
10510: }
1.444 albertel 10511: }
10512: if ($args->{'no_end_date'}) {
10513: $args->{'endaccess'} = 0;
10514: }
10515: $cenv{'internal.autostart'}=$args->{'enrollstart'};
10516: $cenv{'internal.autoend'}=$args->{'enrollend'};
10517: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
10518: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
10519: if ($args->{'showphotos'}) {
10520: $cenv{'internal.showphotos'}=$args->{'showphotos'};
10521: }
10522: $cenv{'internal.authtype'} = $args->{'authtype'};
10523: $cenv{'internal.autharg'} = $args->{'autharg'};
10524: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
10525: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 10526: 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');
10527: if ($context eq 'auto') {
10528: $outcome .= $krb_msg;
10529: } else {
1.566 albertel 10530: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 10531: }
10532: $outcome .= $linefeed;
1.444 albertel 10533: }
10534: }
10535: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
10536: if ($args->{'setpolicy'}) {
10537: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10538: }
10539: if ($args->{'setcontent'}) {
10540: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
10541: }
10542: }
10543: if ($args->{'reshome'}) {
10544: $cenv{'reshome'}=$args->{'reshome'}.'/';
10545: $cenv{'reshome'}=~s/\/+$/\//;
10546: }
10547: #
10548: # course has keyed access
10549: #
10550: if ($args->{'setkeys'}) {
10551: $cenv{'keyaccess'}='yes';
10552: }
10553: # if specified, key authority is not course, but user
10554: # only active if keyaccess is yes
10555: if ($args->{'keyauth'}) {
1.487 albertel 10556: my ($user,$domain) = split(':',$args->{'keyauth'});
10557: $user = &LONCAPA::clean_username($user);
10558: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 10559: if ($user ne '' && $domain ne '') {
1.487 albertel 10560: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 10561: }
10562: }
10563:
10564: if ($args->{'disresdis'}) {
10565: $cenv{'pch.roles.denied'}='st';
10566: }
10567: if ($args->{'disablechat'}) {
10568: $cenv{'plc.roles.denied'}='st';
10569: }
10570:
10571: # Record we've not yet viewed the Course Initialization Helper for this
10572: # course
10573: $cenv{'course.helper.not.run'} = 1;
10574: #
10575: # Use new Randomseed
10576: #
10577: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
10578: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
10579: #
10580: # The encryption code and receipt prefix for this course
10581: #
10582: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
10583: $cenv{'internal.encpref'}=100+int(9*rand(99));
10584: #
10585: # By default, use standard grading
10586: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
10587:
1.541 raeburn 10588: $outcome .= $linefeed.&mt('Setting environment').': '.
10589: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 10590: #
10591: # Open all assignments
10592: #
10593: if ($args->{'openall'}) {
10594: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
10595: my %storecontent = ($storeunder => time,
10596: $storeunder.'.type' => 'date_start');
10597:
10598: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 10599: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 10600: }
10601: #
10602: # Set first page
10603: #
10604: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
10605: || ($cloneid)) {
1.445 albertel 10606: use LONCAPA::map;
1.444 albertel 10607: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 10608:
10609: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
10610: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
10611:
1.444 albertel 10612: $outcome .= ($fatal?$errtext:'read ok').' - ';
10613: my $title; my $url;
10614: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 10615: $title=&mt('Syllabus');
1.444 albertel 10616: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
10617: } else {
1.690 bisitz 10618: $title=&mt('Navigate Contents');
1.444 albertel 10619: $url='/adm/navmaps';
10620: }
1.445 albertel 10621:
10622: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
10623: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
10624:
10625: if ($errtext) { $fatal=2; }
1.541 raeburn 10626: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 10627: }
1.566 albertel 10628:
1.925.2.12 raeburn 10629: if ($args->{'cloneroster'}) {
10630: my ($numadded,$clisterror) = &Apache::lonclonecourse::copyroster($cloneid,$$courseid,$args->{'startaccess'},$args->{'endaccess'});
10631: if ($clisterror) {
10632: $outcome .= "\0".&mt('An error occurred when copying the student roster from the old course to the new course; the error was: [_1].',$clisterror).$linefeed;
10633: if ($numadded) {
10634: $outcome .= &mt('Although [quant,_1,student] have received roles in the new course the roster does not report this. It is ').$linefeed;
10635: }
10636: } else {
10637: if ($numadded) {
10638: $outcome .= "\0".&mt('[quant,_1,student] copied from roster for old course to roster for new course.',$numadded).$linefeed;
10639: } else {
10640: $outcome .= "\0".&mt('No students have been enrolled in the new Concept Test.').' '.&mt('This is because either (a) an error occurred, or (b) there were no students with either current access or access which ended on/after the current default end date set for access to the old course.').$linefeed;
10641: }
10642: }
10643: }
1.566 albertel 10644: return (1,$outcome);
1.444 albertel 10645: }
10646:
10647: ############################################################
10648: ############################################################
10649:
1.378 raeburn 10650: sub course_type {
10651: my ($cid) = @_;
10652: if (!defined($cid)) {
10653: $cid = $env{'request.course.id'};
10654: }
1.404 albertel 10655: if (defined($env{'course.'.$cid.'.type'})) {
10656: return $env{'course.'.$cid.'.type'};
1.378 raeburn 10657: } else {
10658: return 'Course';
1.377 raeburn 10659: }
10660: }
1.156 albertel 10661:
1.406 raeburn 10662: sub group_term {
10663: my $crstype = &course_type();
10664: my %names = (
10665: 'Course' => 'group',
1.865 raeburn 10666: 'Community' => 'group',
1.406 raeburn 10667: );
10668: return $names{$crstype};
10669: }
10670:
1.902 raeburn 10671: sub course_types {
10672: my @types = ('official','unofficial','community');
10673: my %typename = (
10674: official => 'Official course',
10675: unofficial => 'Unofficial course',
10676: community => 'Community',
10677: );
10678: return (\@types,\%typename);
10679: }
10680:
1.156 albertel 10681: sub icon {
10682: my ($file)=@_;
1.505 albertel 10683: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 10684: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 10685: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 10686: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
10687: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
10688: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
10689: $curfext.".gif") {
10690: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
10691: $curfext.".gif";
10692: }
10693: }
1.249 albertel 10694: return &lonhttpdurl($iconname);
1.154 albertel 10695: }
1.84 albertel 10696:
1.575 albertel 10697: sub lonhttpdurl {
1.692 www 10698: #
10699: # Had been used for "small fry" static images on separate port 8080.
10700: # Modify here if lightweight http functionality desired again.
10701: # Currently eliminated due to increasing firewall issues.
10702: #
1.575 albertel 10703: my ($url)=@_;
1.692 www 10704: return $url;
1.215 albertel 10705: }
10706:
1.213 albertel 10707: sub connection_aborted {
10708: my ($r)=@_;
10709: $r->print(" ");$r->rflush();
10710: my $c = $r->connection;
10711: return $c->aborted();
10712: }
10713:
1.221 foxr 10714: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 10715: # strings as 'strings'.
10716: sub escape_single {
1.221 foxr 10717: my ($input) = @_;
1.223 albertel 10718: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 10719: $input =~ s/\'/\\\'/g; # Esacpe the 's....
10720: return $input;
10721: }
1.223 albertel 10722:
1.222 foxr 10723: # Same as escape_single, but escape's "'s This
10724: # can be used for "strings"
10725: sub escape_double {
10726: my ($input) = @_;
10727: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
10728: $input =~ s/\"/\\\"/g; # Esacpe the "s....
10729: return $input;
10730: }
1.223 albertel 10731:
1.222 foxr 10732: # Escapes the last element of a full URL.
10733: sub escape_url {
10734: my ($url) = @_;
1.238 raeburn 10735: my @urlslices = split(/\//, $url,-1);
1.369 www 10736: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 10737: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 10738: }
1.462 albertel 10739:
1.820 raeburn 10740: sub compare_arrays {
10741: my ($arrayref1,$arrayref2) = @_;
10742: my (@difference,%count);
10743: @difference = ();
10744: %count = ();
10745: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
10746: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
10747: foreach my $element (keys(%count)) {
10748: if ($count{$element} == 1) {
10749: push(@difference,$element);
10750: }
10751: }
10752: }
10753: return @difference;
10754: }
10755:
1.817 bisitz 10756: # -------------------------------------------------------- Initialize user login
1.462 albertel 10757: sub init_user_environment {
1.463 albertel 10758: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 10759: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
10760:
10761: my $public=($username eq 'public' && $domain eq 'public');
10762:
10763: # See if old ID present, if so, remove
10764:
10765: my ($filename,$cookie,$userroles);
10766: my $now=time;
10767:
10768: if ($public) {
10769: my $max_public=100;
10770: my $oldest;
10771: my $oldest_time=0;
10772: for(my $next=1;$next<=$max_public;$next++) {
10773: if (-e $lonids."/publicuser_$next.id") {
10774: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
10775: if ($mtime<$oldest_time || !$oldest_time) {
10776: $oldest_time=$mtime;
10777: $oldest=$next;
10778: }
10779: } else {
10780: $cookie="publicuser_$next";
10781: last;
10782: }
10783: }
10784: if (!$cookie) { $cookie="publicuser_$oldest"; }
10785: } else {
1.463 albertel 10786: # if this isn't a robot, kill any existing non-robot sessions
10787: if (!$args->{'robot'}) {
10788: opendir(DIR,$lonids);
10789: while ($filename=readdir(DIR)) {
10790: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
10791: unlink($lonids.'/'.$filename);
10792: }
1.462 albertel 10793: }
1.463 albertel 10794: closedir(DIR);
1.462 albertel 10795: }
10796: # Give them a new cookie
1.463 albertel 10797: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 10798: : $now.$$.int(rand(10000)));
1.463 albertel 10799: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 10800:
10801: # Initialize roles
10802:
10803: $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
10804: }
10805: # ------------------------------------ Check browser type and MathML capability
10806:
10807: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
10808: $clientunicode,$clientos) = &decode_user_agent($r);
10809:
10810: # ------------------------------------------------------------- Get environment
10811:
10812: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
10813: my ($tmp) = keys(%userenv);
10814: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10815: # default remote control to off
10816: if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
10817: } else {
10818: undef(%userenv);
10819: }
10820: if (($userenv{'interface'}) && (!$form->{'interface'})) {
10821: $form->{'interface'}=$userenv{'interface'};
10822: }
10823: $env{'environment.remote'}=$userenv{'remote'};
10824: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
10825:
10826: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 10827: foreach my $option ('interface','localpath','localres') {
10828: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 10829: }
10830: # --------------------------------------------------------- Write first profile
10831:
10832: {
10833: my %initial_env =
10834: ("user.name" => $username,
10835: "user.domain" => $domain,
10836: "user.home" => $authhost,
10837: "browser.type" => $clientbrowser,
10838: "browser.version" => $clientversion,
10839: "browser.mathml" => $clientmathml,
10840: "browser.unicode" => $clientunicode,
10841: "browser.os" => $clientos,
10842: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
10843: "request.course.fn" => '',
10844: "request.course.uri" => '',
10845: "request.course.sec" => '',
10846: "request.role" => 'cm',
10847: "request.role.adv" => $env{'user.adv'},
10848: "request.host" => $ENV{'REMOTE_ADDR'},);
10849:
10850: if ($form->{'localpath'}) {
10851: $initial_env{"browser.localpath"} = $form->{'localpath'};
10852: $initial_env{"browser.localres"} = $form->{'localres'};
10853: }
10854:
10855: if ($public) {
10856: $initial_env{"environment.remote"} = "off";
10857: }
10858: if ($form->{'interface'}) {
10859: $form->{'interface'}=~s/\W//gs;
10860: $initial_env{"browser.interface"} = $form->{'interface'};
10861: $env{'browser.interface'}=$form->{'interface'};
10862: }
10863:
1.724 raeburn 10864: foreach my $tool ('aboutme','blog','portfolio') {
10865: $userenv{'availabletools.'.$tool} =
10866: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
10867: }
10868:
1.864 raeburn 10869: foreach my $crstype ('official','unofficial','community') {
1.765 raeburn 10870: $userenv{'canrequest.'.$crstype} =
10871: &Apache::lonnet::usertools_access($username,$domain,$crstype,
10872: 'reload','requestcourses');
10873: }
10874:
1.462 albertel 10875: $env{'user.environment'} = "$lonids/$cookie.id";
10876:
10877: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
10878: &GDBM_WRCREAT(),0640)) {
10879: &_add_to_env(\%disk_env,\%initial_env);
10880: &_add_to_env(\%disk_env,\%userenv,'environment.');
10881: &_add_to_env(\%disk_env,$userroles);
1.463 albertel 10882: if (ref($args->{'extra_env'})) {
10883: &_add_to_env(\%disk_env,$args->{'extra_env'});
10884: }
1.462 albertel 10885: untie(%disk_env);
10886: } else {
1.705 tempelho 10887: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
10888: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 10889: return 'error: '.$!;
10890: }
10891: }
10892: $env{'request.role'}='cm';
10893: $env{'request.role.adv'}=$env{'user.adv'};
10894: $env{'browser.type'}=$clientbrowser;
10895:
10896: return $cookie;
10897:
10898: }
10899:
10900: sub _add_to_env {
10901: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 10902: if (ref($env_data) eq 'HASH') {
10903: while (my ($key,$value) = each(%$env_data)) {
10904: $idf->{$prefix.$key} = $value;
10905: $env{$prefix.$key} = $value;
10906: }
1.462 albertel 10907: }
10908: }
10909:
1.925.2.8 raeburn 10910: sub new_roles_update {
10911: my $rolecount = 0;
10912: foreach my $envkey (keys(%env)) {
10913: next unless ($envkey =~ /^user\.role\./);
10914: $rolecount ++;
10915: }
1.925.2.9 raeburn 10916: my $newrolecount = 0;
1.925.2.8 raeburn 10917: if (!$rolecount) {
10918: my %userenv;
10919: foreach my $crstype ('official','unofficial','community') {
10920: $userenv{'canrequest.'.$crstype} =
10921: &Apache::lonnet::usertools_access($env{'user.name'},
10922: $env{'user.domain'},$crstype,'reload','requestcourses');
10923: }
10924: my $then=$env{'user.login.time'};
10925: my $refresh=time;
10926: my (%userroles,%allroles,%allgroups,@newroles);
10927: my %roleshash =
10928: &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active','future','previous'],undef,undef,1);
10929: foreach my $item (keys(%roleshash)) {
10930: my ($uname,$udom,$role,$section) = split(':',$item);
10931: my $where = '/'.$udom.'/'.$uname;
10932: my ($tstart,$tend) = split(':',$roleshash{$item});
10933: if ($section ne '') {
10934: $where .= '/'.$section;
10935: }
10936: my $spec = $role.'.'.$where;
10937: &Apache::lonnet::set_arearole($role,$where,$tstart,$tend,
10938: $env{'user.domain'},$env{'user.name'});
10939: $userroles{'user.role.'.$spec} = $tstart.'.'.$tend;
1.925.2.9 raeburn 10940: $newrolecount ++;
1.925.2.8 raeburn 10941: unless (grep(/^\Q$role\E$/,@newroles)) {
10942: push(@newroles,$role);
10943: }
10944: my $status =
10945: &Apache::lonnet::curr_role_status($tstart,$tend,$refresh,$then);
10946: if ($status eq 'active') {
10947: &Apache::lonnet::gather_roleprivs(\%allroles,\%allgroups,\%userroles,
10948: $where,$role,$tstart,$tend);
10949: }
10950: }
10951: if (@newroles) {
10952: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles,
10953: \%allgroups);
1.925.2.10 raeburn 10954: &Apache::lonnet::appenv(\%userroles,[@newroles,'cm']);
1.925.2.8 raeburn 10955: $userenv{'user.adv'} = $adv;
10956: $userenv{'user.author'} = $author;
10957: $userenv{'user.refresh.time'} = $refresh;
10958: }
10959: &Apache::lonnet::appenv(\%userenv);
10960: }
1.925.2.9 raeburn 10961: return $newrolecount;
1.925.2.8 raeburn 10962: }
10963:
1.685 tempelho 10964: # --- Get the symbolic name of a problem and the url
10965: sub get_symb {
10966: my ($request,$silent) = @_;
1.726 raeburn 10967: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 10968: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
10969: if ($symb eq '') {
10970: if (!$silent) {
10971: $request->print("Unable to handle ambiguous references:$url:.");
10972: return ();
10973: }
10974: }
10975: &Apache::lonenc::check_decrypt(\$symb);
10976: return ($symb);
10977: }
10978:
10979: # --------------------------------------------------------------Get annotation
10980:
10981: sub get_annotation {
10982: my ($symb,$enc) = @_;
10983:
10984: my $key = $symb;
10985: if (!$enc) {
10986: $key =
10987: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
10988: }
10989: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
10990: return $annotation{$key};
10991: }
10992:
10993: sub clean_symb {
1.731 raeburn 10994: my ($symb,$delete_enc) = @_;
1.685 tempelho 10995:
10996: &Apache::lonenc::check_decrypt(\$symb);
10997: my $enc = $env{'request.enc'};
1.731 raeburn 10998: if ($delete_enc) {
1.730 raeburn 10999: delete($env{'request.enc'});
11000: }
1.685 tempelho 11001:
11002: return ($symb,$enc);
11003: }
1.462 albertel 11004:
1.925.2.1 raeburn 11005: sub needs_gci_custom {
11006: my $custommenu;
11007: my $numdc = &check_for_gci_dc();
11008: unless ($numdc) {
11009: my $then=$env{'user.login.time'};
11010: my $now = time;
11011: my %cnums = (
11012: review => '9615072b469884921gcil1',
11013: submit => '1H96711d710194bfegcil1',
11014: );
11015: if ($env{'user.role.st./gci/'.$cnums{'review'}}) {
11016: my ($start,$end) =
11017: split('.',$env{'user.role.st./gci/'.$cnums{'review'}});
11018: if (((!$start) || ($start && $start <= $now)) &&
11019: ((!$end) || ($end > $now))) {
11020: $custommenu = 1;
11021: if ($env{'user.role.cc./gci/'.$cnums{'review'}}) {
11022: my ($ccstart,$ccend) =
11023: split('.',$env{'user.role.cc./gci/'.$cnums{'review'}});
11024: if (((!$start) || ($start && $start <= $now)) &&
11025: ((!$end) || ($end > $now))) {
11026: $custommenu = '';
11027: }
11028: }
11029: }
11030: }
11031: }
11032: return $custommenu;
11033: }
11034:
11035: sub check_for_gci_dc {
11036: my $then=$env{'user.login.time'};
11037: my $numdc = 0;
11038: foreach my $dom ('gci','gcitest') {
11039: if ($env{'user.role.dc./'.$dom.'/'}) {
11040: my $livedc = 1;
11041: my ($tstart,$tend)=split(/\./,$env{'user.role.dc./'.$dom.'/'});
11042: if ($tstart && $tstart>$then) { $livedc = 0; }
11043: if ($tend && $tend <$then) { $livedc = 0; }
11044: if ($livedc) {
11045: $numdc++;
11046: }
11047: }
11048: }
11049: return $numdc;
11050: }
11051:
11052: sub existing_gcitest_courses {
1.925.2.6 raeburn 11053: my ($role) = @_;
1.925.2.1 raeburn 11054: my %courses;
11055: my $cdom = 'gcitest';
11056: my $now = time;
11057: foreach my $envkey (keys(%env)) {
11058: my $cnum;
11059: if ($envkey =~ m{^user\.role\.\Q$role\E\./\Q$cdom\E/($match_courseid)$}) {
11060: $cnum = $1;
11061: } else {
11062: next;
11063: }
1.925.2.16 raeburn 11064: my ($tstart,$tend) = split(/\./,$env{$envkey});
1.925.2.1 raeburn 11065: if (((!$tstart) || ($tstart < $now)) && ((!$tend) || ($tend > $now))) {
1.925.2.3 raeburn 11066: my $descr = $env{'course.'.$cdom.'_'.$cnum.'.description'};
11067: if ($descr ne '') {
11068: $courses{$cdom.'_'.$cnum}{'description'} = $descr;
1.925.2.1 raeburn 11069: }
11070: }
11071: }
11072: return %courses;
11073: }
11074:
1.925.2.14 raeburn 11075: sub gcitest_switcher {
11076: my ($role,$formname,%courses) = @_;
11077: my $output;
11078: my %Sortby;
11079: foreach my $course (sort(keys(%courses))) {
11080: next unless (ref($courses{$course}) eq 'HASH');
11081: my $clean_title = $courses{$course}{'description'};
11082: $clean_title =~ s/\W+//g;
11083: if ($clean_title eq '') {
11084: $clean_title = $courses{$course}{'description'};
11085: }
11086: push(@{$Sortby{$clean_title}},$course);
11087: }
11088: my @sorted_courses = sort { lc($a) cmp lc($b) } (keys(%Sortby));
11089: my $default;
11090: if (@sorted_courses > 1) {
11091: if (($env{'request.course.id'}) && ($courses{$env{'request.course.id'}})) {
11092: $default = &mt('Switch concept test ...');
11093: } else {
11094: $default = &mt('Select a concept test ...');
11095: }
11096: } else {
11097: unless (($env{'request.course.id'}) && ($courses{$env{'request.course.id'}})) {
11098: $default = &mt('Select concept test ...');
11099: }
11100: }
11101: if ($default) {
11102: $output = '<form name="'.$formname.'" action="/adm/roles" method="post">'.
11103: '<select name="newrole" onchange="javascript:courseswitcher();">'.
11104: '<option value="" selected="selected">'.$default.'</option>';
11105: foreach my $item (@sorted_courses) {
11106: foreach my $course (@{$Sortby{$item}}) {
11107: my ($cdom,$cnum) = split('_',$course);
11108: $output .= '<option value="'.$role.'./'.$cdom.'/'.$cnum.'">'.$courses{$course}{'description'}.'</option>';
11109: }
11110: }
11111: $output .= '</select><input type="hidden" name="selectrole" value="" /></form>';
11112: }
11113: return $output;
11114: }
11115:
11116: sub gcitest_switcher_js {
11117: my ($current,$numcourses,$formname) = @_;
11118: my $output = <<"ENDJS";
11119:
11120: function courseswitcher(caller) {
11121: var numcourses = $numcourses;
11122: var current = '$current';
11123: var choice = document.$formname.newrole.options[document.$formname.newrole.selectedIndex].value;
11124: if (choice == '') {
11125: if (caller == 'icon') {
11126: alert('No Concept Test selected');
11127: }
11128: document.$formname.selectrole.value = '';
11129: return;
11130: }
11131: if (choice == current) {
11132: if ((caller != 'icon') && (numcourses > 1)) {
11133: alert('You have selected the current course.\\nPlease select a different Concept Test course');
11134: }
11135: document.$formname.newrole.selectedIndex = 0;
11136: document.$formname.selectrole.value = '';
11137: return;
11138: }
11139: document.$formname.selectrole.value = '1';
11140: document.$formname.submit();
11141: return;
11142: }
11143:
11144: ENDJS
11145: return $output;
11146: }
11147:
11148:
11149:
1.41 ng 11150: =pod
11151:
11152: =back
11153:
1.112 bowersj2 11154: =cut
1.41 ng 11155:
1.112 bowersj2 11156: 1;
11157: __END__;
1.41 ng 11158:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface