Annotation of loncom/interface/loncommon.pm, revision 1.1116
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1116 ! raeburn 4: # $Id: loncommon.pm,v 1.1115 2013/02/19 17:30:35 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.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.479 albertel 72: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 73: use DateTime::TimeZone;
1.687 raeburn 74: use DateTime::Locale::Catalog;
1.1091 foxr 75: use Text::Aspell;
1.1094 raeburn 76: use Authen::Captcha;
77: use Captcha::reCAPTCHA;
1.117 www 78:
1.517 raeburn 79: # ---------------------------------------------- Designs
80: use vars qw(%defaultdesign);
81:
1.22 www 82: my $readit;
83:
1.517 raeburn 84:
1.157 matthew 85: ##
86: ## Global Variables
87: ##
1.46 matthew 88:
1.643 foxr 89:
90: # ----------------------------------------------- SSI with retries:
91: #
92:
93: =pod
94:
1.648 raeburn 95: =head1 Server Side include with retries:
1.643 foxr 96:
97: =over 4
98:
1.648 raeburn 99: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 100:
101: Performs an ssi with some number of retries. Retries continue either
102: until the result is ok or until the retry count supplied by the
103: caller is exhausted.
104:
105: Inputs:
1.648 raeburn 106:
107: =over 4
108:
1.643 foxr 109: resource - Identifies the resource to insert.
1.648 raeburn 110:
1.643 foxr 111: retries - Count of the number of retries allowed.
1.648 raeburn 112:
1.643 foxr 113: form - Hash that identifies the rendering options.
114:
1.648 raeburn 115: =back
116:
117: Returns:
118:
119: =over 4
120:
1.643 foxr 121: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 122:
1.643 foxr 123: response - The response from the last attempt (which may or may not have been successful.
124:
1.648 raeburn 125: =back
126:
127: =back
128:
1.643 foxr 129: =cut
130:
131: sub ssi_with_retries {
132: my ($resource, $retries, %form) = @_;
133:
134:
135: my $ok = 0; # True if we got a good response.
136: my $content;
137: my $response;
138:
139: # Try to get the ssi done. within the retries count:
140:
141: do {
142: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
143: $ok = $response->is_success;
1.650 www 144: if (!$ok) {
145: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
146: }
1.643 foxr 147: $retries--;
148: } while (!$ok && ($retries > 0));
149:
150: if (!$ok) {
151: $content = ''; # On error return an empty content.
152: }
153: return ($content, $response);
154:
155: }
156:
157:
158:
1.20 www 159: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 160: my %language;
1.124 www 161: my %supported_language;
1.1088 foxr 162: my %supported_codes;
1.1048 foxr 163: my %latex_language; # For choosing hyphenation in <transl..>
164: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 165: my %cprtag;
1.192 taceyjo1 166: my %scprtag;
1.351 www 167: my %fe; my %fd; my %fm;
1.41 ng 168: my %category_extensions;
1.12 harris41 169:
1.46 matthew 170: # ---------------------------------------------- Thesaurus variables
1.144 matthew 171: #
172: # %Keywords:
173: # A hash used by &keyword to determine if a word is considered a keyword.
174: # $thesaurus_db_file
175: # Scalar containing the full path to the thesaurus database.
1.46 matthew 176:
177: my %Keywords;
178: my $thesaurus_db_file;
179:
1.144 matthew 180: #
181: # Initialize values from language.tab, copyright.tab, filetypes.tab,
182: # thesaurus.tab, and filecategories.tab.
183: #
1.18 www 184: BEGIN {
1.46 matthew 185: # Variable initialization
186: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
187: #
1.22 www 188: unless ($readit) {
1.12 harris41 189: # ------------------------------------------------------------------- languages
190: {
1.158 raeburn 191: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
192: '/language.tab';
193: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 194: while (my $line = <$fh>) {
195: next if ($line=~/^\#/);
196: chomp($line);
1.1088 foxr 197: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 198: $language{$key}=$val.' - '.$enc;
199: if ($sup) {
200: $supported_language{$key}=$sup;
1.1088 foxr 201: $supported_codes{$key} = $code;
1.158 raeburn 202: }
1.1048 foxr 203: if ($latex) {
204: $latex_language_bykey{$key} = $latex;
1.1088 foxr 205: $latex_language{$code} = $latex;
1.1048 foxr 206: }
1.158 raeburn 207: }
208: close($fh);
209: }
1.12 harris41 210: }
211: # ------------------------------------------------------------------ copyrights
212: {
1.158 raeburn 213: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
214: '/copyright.tab';
215: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 216: while (my $line = <$fh>) {
217: next if ($line=~/^\#/);
218: chomp($line);
219: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 220: $cprtag{$key}=$val;
221: }
222: close($fh);
223: }
1.12 harris41 224: }
1.351 www 225: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 226: {
227: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
228: '/source_copyright.tab';
229: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 230: while (my $line = <$fh>) {
231: next if ($line =~ /^\#/);
232: chomp($line);
233: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 234: $scprtag{$key}=$val;
235: }
236: close($fh);
237: }
238: }
1.63 www 239:
1.517 raeburn 240: # -------------------------------------------------------------- default domain designs
1.63 www 241: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 242: my $designfile = $designdir.'/default.tab';
243: if ( open (my $fh,"<$designfile") ) {
244: while (my $line = <$fh>) {
245: next if ($line =~ /^\#/);
246: chomp($line);
247: my ($key,$val)=(split(/\=/,$line));
248: if ($val) { $defaultdesign{$key}=$val; }
249: }
250: close($fh);
1.63 www 251: }
252:
1.15 harris41 253: # ------------------------------------------------------------- file categories
254: {
1.158 raeburn 255: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
256: '/filecategories.tab';
257: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 258: while (my $line = <$fh>) {
259: next if ($line =~ /^\#/);
260: chomp($line);
261: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 262: push @{$category_extensions{lc($category)}},$extension;
263: }
264: close($fh);
265: }
266:
1.15 harris41 267: }
1.12 harris41 268: # ------------------------------------------------------------------ file types
269: {
1.158 raeburn 270: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
271: '/filetypes.tab';
272: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 273: while (my $line = <$fh>) {
274: next if ($line =~ /^\#/);
275: chomp($line);
276: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 277: if ($descr ne '') {
278: $fe{$ending}=lc($emb);
279: $fd{$ending}=$descr;
1.351 www 280: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 281: }
282: }
283: close($fh);
284: }
1.12 harris41 285: }
1.22 www 286: &Apache::lonnet::logthis(
1.705 tempelho 287: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 288: $readit=1;
1.46 matthew 289: } # end of unless($readit)
1.32 matthew 290:
291: }
1.112 bowersj2 292:
1.42 matthew 293: ###############################################################
294: ## HTML and Javascript Helper Functions ##
295: ###############################################################
296:
297: =pod
298:
1.112 bowersj2 299: =head1 HTML and Javascript Functions
1.42 matthew 300:
1.112 bowersj2 301: =over 4
302:
1.648 raeburn 303: =item * &browser_and_searcher_javascript()
1.112 bowersj2 304:
305: X<browsing, javascript>X<searching, javascript>Returns a string
306: containing javascript with two functions, C<openbrowser> and
307: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
308: tags.
1.42 matthew 309:
1.648 raeburn 310: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 311:
312: inputs: formname, elementname, only, omit
313:
314: formname and elementname indicate the name of the html form and name of
315: the element that the results of the browsing selection are to be placed in.
316:
317: Specifying 'only' will restrict the browser to displaying only files
1.185 www 318: with the given extension. Can be a comma separated list.
1.42 matthew 319:
320: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 321: with the given extension. Can be a comma separated list.
1.42 matthew 322:
1.648 raeburn 323: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 324:
325: Inputs: formname, elementname
326:
327: formname and elementname specify the name of the html form and the name
328: of the element the selection from the search results will be placed in.
1.542 raeburn 329:
1.42 matthew 330: =cut
331:
332: sub browser_and_searcher_javascript {
1.199 albertel 333: my ($mode)=@_;
334: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 335: my $resurl=&escape_single(&lastresurl());
1.42 matthew 336: return <<END;
1.219 albertel 337: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 338: var editbrowser = null;
1.135 albertel 339: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 340: var url = '$resurl/?';
1.42 matthew 341: if (editbrowser == null) {
342: url += 'launch=1&';
343: }
344: url += 'catalogmode=interactive&';
1.199 albertel 345: url += 'mode=$mode&';
1.611 albertel 346: url += 'inhibitmenu=yes&';
1.42 matthew 347: url += 'form=' + formname + '&';
348: if (only != null) {
349: url += 'only=' + only + '&';
1.217 albertel 350: } else {
351: url += 'only=&';
352: }
1.42 matthew 353: if (omit != null) {
354: url += 'omit=' + omit + '&';
1.217 albertel 355: } else {
356: url += 'omit=&';
357: }
1.135 albertel 358: if (titleelement != null) {
359: url += 'titleelement=' + titleelement + '&';
1.217 albertel 360: } else {
361: url += 'titleelement=&';
362: }
1.42 matthew 363: url += 'element=' + elementname + '';
364: var title = 'Browser';
1.435 albertel 365: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 366: options += ',width=700,height=600';
367: editbrowser = open(url,title,options,'1');
368: editbrowser.focus();
369: }
370: var editsearcher;
1.135 albertel 371: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 372: var url = '/adm/searchcat?';
373: if (editsearcher == null) {
374: url += 'launch=1&';
375: }
376: url += 'catalogmode=interactive&';
1.199 albertel 377: url += 'mode=$mode&';
1.42 matthew 378: url += 'form=' + formname + '&';
1.135 albertel 379: if (titleelement != null) {
380: url += 'titleelement=' + titleelement + '&';
1.217 albertel 381: } else {
382: url += 'titleelement=&';
383: }
1.42 matthew 384: url += 'element=' + elementname + '';
385: var title = 'Search';
1.435 albertel 386: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 387: options += ',width=700,height=600';
388: editsearcher = open(url,title,options,'1');
389: editsearcher.focus();
390: }
1.219 albertel 391: // END LON-CAPA Internal -->
1.42 matthew 392: END
1.170 www 393: }
394:
395: sub lastresurl {
1.258 albertel 396: if ($env{'environment.lastresurl'}) {
397: return $env{'environment.lastresurl'}
1.170 www 398: } else {
399: return '/res';
400: }
401: }
402:
403: sub storeresurl {
404: my $resurl=&Apache::lonnet::clutter(shift);
405: unless ($resurl=~/^\/res/) { return 0; }
406: $resurl=~s/\/$//;
407: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 408: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 409: return 1;
1.42 matthew 410: }
411:
1.74 www 412: sub studentbrowser_javascript {
1.111 www 413: unless (
1.258 albertel 414: (($env{'request.course.id'}) &&
1.302 albertel 415: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
416: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
417: '/'.$env{'request.course.sec'})
418: ))
1.258 albertel 419: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 420: ) { return ''; }
1.74 www 421: return (<<'ENDSTDBRW');
1.776 bisitz 422: <script type="text/javascript" language="Javascript">
1.824 bisitz 423: // <![CDATA[
1.74 www 424: var stdeditbrowser;
1.999 www 425: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 426: var url = '/adm/pickstudent?';
427: var filter;
1.558 albertel 428: if (!ignorefilter) {
429: eval('filter=document.'+formname+'.'+uname+'.value;');
430: }
1.74 www 431: if (filter != null) {
432: if (filter != '') {
433: url += 'filter='+filter+'&';
434: }
435: }
436: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 437: '&udomelement='+udom+
438: '&clicker='+clicker;
1.111 www 439: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 440: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 441: var title = 'Student_Browser';
1.74 www 442: var options = 'scrollbars=1,resizable=1,menubar=0';
443: options += ',width=700,height=600';
444: stdeditbrowser = open(url,title,options,'1');
445: stdeditbrowser.focus();
446: }
1.824 bisitz 447: // ]]>
1.74 www 448: </script>
449: ENDSTDBRW
450: }
1.42 matthew 451:
1.1003 www 452: sub resourcebrowser_javascript {
453: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 454: return (<<'ENDRESBRW');
1.1003 www 455: <script type="text/javascript" language="Javascript">
456: // <![CDATA[
457: var reseditbrowser;
1.1004 www 458: function openresbrowser(formname,reslink) {
1.1005 www 459: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 460: var title = 'Resource_Browser';
461: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 462: options += ',width=700,height=500';
1.1004 www 463: reseditbrowser = open(url,title,options,'1');
464: reseditbrowser.focus();
1.1003 www 465: }
466: // ]]>
467: </script>
1.1004 www 468: ENDRESBRW
1.1003 www 469: }
470:
1.74 www 471: sub selectstudent_link {
1.999 www 472: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
473: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
474: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
475: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 476: if ($env{'request.course.id'}) {
1.302 albertel 477: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
478: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
479: '/'.$env{'request.course.sec'})) {
1.111 www 480: return '';
481: }
1.999 www 482: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 483: if ($courseadvonly) {
484: $callargs .= ",'',1,1";
485: }
486: return '<span class="LC_nobreak">'.
487: '<a href="javascript:openstdbrowser('.$callargs.');">'.
488: &mt('Select User').'</a></span>';
1.74 www 489: }
1.258 albertel 490: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 491: $callargs .= ",'',1";
1.793 raeburn 492: return '<span class="LC_nobreak">'.
493: '<a href="javascript:openstdbrowser('.$callargs.');">'.
494: &mt('Select User').'</a></span>';
1.111 www 495: }
496: return '';
1.91 www 497: }
498:
1.1004 www 499: sub selectresource_link {
500: my ($form,$reslink,$arg)=@_;
501:
502: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
503: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
504: unless ($env{'request.course.id'}) { return $arg; }
505: return '<span class="LC_nobreak">'.
506: '<a href="javascript:openresbrowser('.$callargs.');">'.
507: $arg.'</a></span>';
508: }
509:
510:
511:
1.653 raeburn 512: sub authorbrowser_javascript {
513: return <<"ENDAUTHORBRW";
1.776 bisitz 514: <script type="text/javascript" language="JavaScript">
1.824 bisitz 515: // <![CDATA[
1.653 raeburn 516: var stdeditbrowser;
517:
518: function openauthorbrowser(formname,udom) {
519: var url = '/adm/pickauthor?';
520: url += 'form='+formname+'&roledom='+udom;
521: var title = 'Author_Browser';
522: var options = 'scrollbars=1,resizable=1,menubar=0';
523: options += ',width=700,height=600';
524: stdeditbrowser = open(url,title,options,'1');
525: stdeditbrowser.focus();
526: }
527:
1.824 bisitz 528: // ]]>
1.653 raeburn 529: </script>
530: ENDAUTHORBRW
531: }
532:
1.91 www 533: sub coursebrowser_javascript {
1.1116 ! raeburn 534: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
! 535: $credits_element) = @_;
1.932 raeburn 536: my $wintitle = 'Course_Browser';
1.931 raeburn 537: if ($crstype eq 'Community') {
1.932 raeburn 538: $wintitle = 'Community_Browser';
1.909 raeburn 539: }
1.876 raeburn 540: my $id_functions = &javascript_index_functions();
541: my $output = '
1.776 bisitz 542: <script type="text/javascript" language="JavaScript">
1.824 bisitz 543: // <![CDATA[
1.468 raeburn 544: var stdeditbrowser;'."\n";
1.876 raeburn 545:
546: $output .= <<"ENDSTDBRW";
1.909 raeburn 547: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 548: var url = '/adm/pickcourse?';
1.895 raeburn 549: var formid = getFormIdByName(formname);
1.876 raeburn 550: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 551: if (domainfilter != null) {
552: if (domainfilter != '') {
553: url += 'domainfilter='+domainfilter+'&';
554: }
555: }
1.91 www 556: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 557: '&cdomelement='+udom+
558: '&cnameelement='+desc;
1.468 raeburn 559: if (extra_element !=null && extra_element != '') {
1.594 raeburn 560: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 561: url += '&roleelement='+extra_element;
562: if (domainfilter == null || domainfilter == '') {
563: url += '&domainfilter='+extra_element;
564: }
1.234 raeburn 565: }
1.468 raeburn 566: else {
567: if (formname == 'portform') {
568: url += '&setroles='+extra_element;
1.800 raeburn 569: } else {
570: if (formname == 'rules') {
571: url += '&fixeddom='+extra_element;
572: }
1.468 raeburn 573: }
574: }
1.230 raeburn 575: }
1.909 raeburn 576: if (type != null && type != '') {
577: url += '&type='+type;
578: }
579: if (type_elem != null && type_elem != '') {
580: url += '&typeelement='+type_elem;
581: }
1.872 raeburn 582: if (formname == 'ccrs') {
583: var ownername = document.forms[formid].ccuname.value;
584: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
585: url += '&cloner='+ownername+':'+ownerdom;
586: }
1.293 raeburn 587: if (multflag !=null && multflag != '') {
588: url += '&multiple='+multflag;
589: }
1.909 raeburn 590: var title = '$wintitle';
1.91 www 591: var options = 'scrollbars=1,resizable=1,menubar=0';
592: options += ',width=700,height=600';
593: stdeditbrowser = open(url,title,options,'1');
594: stdeditbrowser.focus();
595: }
1.876 raeburn 596: $id_functions
597: ENDSTDBRW
1.1116 ! raeburn 598: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
! 599: $output .= &setsec_javascript($sec_element,$formname,$role_element,
! 600: $credits_element);
1.876 raeburn 601: }
602: $output .= '
603: // ]]>
604: </script>';
605: return $output;
606: }
607:
608: sub javascript_index_functions {
609: return <<"ENDJS";
610:
611: function getFormIdByName(formname) {
612: for (var i=0;i<document.forms.length;i++) {
613: if (document.forms[i].name == formname) {
614: return i;
615: }
616: }
617: return -1;
618: }
619:
620: function getIndexByName(formid,item) {
621: for (var i=0;i<document.forms[formid].elements.length;i++) {
622: if (document.forms[formid].elements[i].name == item) {
623: return i;
624: }
625: }
626: return -1;
627: }
1.468 raeburn 628:
1.876 raeburn 629: function getDomainFromSelectbox(formname,udom) {
630: var userdom;
631: var formid = getFormIdByName(formname);
632: if (formid > -1) {
633: var domid = getIndexByName(formid,udom);
634: if (domid > -1) {
635: if (document.forms[formid].elements[domid].type == 'select-one') {
636: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
637: }
638: if (document.forms[formid].elements[domid].type == 'hidden') {
639: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 640: }
641: }
642: }
1.876 raeburn 643: return userdom;
644: }
645:
646: ENDJS
1.468 raeburn 647:
1.876 raeburn 648: }
649:
1.1017 raeburn 650: sub javascript_array_indexof {
1.1018 raeburn 651: return <<ENDJS;
1.1017 raeburn 652: <script type="text/javascript" language="JavaScript">
653: // <![CDATA[
654:
655: if (!Array.prototype.indexOf) {
656: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
657: "use strict";
658: if (this === void 0 || this === null) {
659: throw new TypeError();
660: }
661: var t = Object(this);
662: var len = t.length >>> 0;
663: if (len === 0) {
664: return -1;
665: }
666: var n = 0;
667: if (arguments.length > 0) {
668: n = Number(arguments[1]);
1.1088 foxr 669: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 670: n = 0;
671: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
672: n = (n > 0 || -1) * Math.floor(Math.abs(n));
673: }
674: }
675: if (n >= len) {
676: return -1;
677: }
678: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
679: for (; k < len; k++) {
680: if (k in t && t[k] === searchElement) {
681: return k;
682: }
683: }
684: return -1;
685: }
686: }
687:
688: // ]]>
689: </script>
690:
691: ENDJS
692:
693: }
694:
1.876 raeburn 695: sub userbrowser_javascript {
696: my $id_functions = &javascript_index_functions();
697: return <<"ENDUSERBRW";
698:
1.888 raeburn 699: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 700: var url = '/adm/pickuser?';
701: var userdom = getDomainFromSelectbox(formname,udom);
702: if (userdom != null) {
703: if (userdom != '') {
704: url += 'srchdom='+userdom+'&';
705: }
706: }
707: url += 'form=' + formname + '&unameelement='+uname+
708: '&udomelement='+udom+
709: '&ulastelement='+ulast+
710: '&ufirstelement='+ufirst+
711: '&uemailelement='+uemail+
1.881 raeburn 712: '&hideudomelement='+hideudom+
713: '&coursedom='+crsdom;
1.888 raeburn 714: if ((caller != null) && (caller != undefined)) {
715: url += '&caller='+caller;
716: }
1.876 raeburn 717: var title = 'User_Browser';
718: var options = 'scrollbars=1,resizable=1,menubar=0';
719: options += ',width=700,height=600';
720: var stdeditbrowser = open(url,title,options,'1');
721: stdeditbrowser.focus();
722: }
723:
1.888 raeburn 724: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 725: var formid = getFormIdByName(formname);
726: if (formid > -1) {
1.888 raeburn 727: var unameid = getIndexByName(formid,uname);
1.876 raeburn 728: var domid = getIndexByName(formid,udom);
729: var hidedomid = getIndexByName(formid,origdom);
730: if (hidedomid > -1) {
731: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 732: var unameval = document.forms[formid].elements[unameid].value;
733: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
734: if (domid > -1) {
735: var slct = document.forms[formid].elements[domid];
736: if (slct.type == 'select-one') {
737: var i;
738: for (i=0;i<slct.length;i++) {
739: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
740: }
741: }
742: if (slct.type == 'hidden') {
743: slct.value = fixeddom;
1.876 raeburn 744: }
745: }
1.468 raeburn 746: }
747: }
748: }
1.876 raeburn 749: return;
750: }
751:
752: $id_functions
753: ENDUSERBRW
1.468 raeburn 754: }
755:
756: sub setsec_javascript {
1.1116 ! raeburn 757: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 758: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
759: $communityrolestr);
760: if ($role_element ne '') {
761: my @allroles = ('st','ta','ep','in','ad');
762: foreach my $crstype ('Course','Community') {
763: if ($crstype eq 'Community') {
764: foreach my $role (@allroles) {
765: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
766: }
767: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
768: } else {
769: foreach my $role (@allroles) {
770: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
771: }
772: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
773: }
774: }
775: $rolestr = '"'.join('","',@allroles).'"';
776: $courserolestr = '"'.join('","',@courserolenames).'"';
777: $communityrolestr = '"'.join('","',@communityrolenames).'"';
778: }
1.468 raeburn 779: my $setsections = qq|
780: function setSect(sectionlist) {
1.629 raeburn 781: var sectionsArray = new Array();
782: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
783: sectionsArray = sectionlist.split(",");
784: }
1.468 raeburn 785: var numSections = sectionsArray.length;
786: document.$formname.$sec_element.length = 0;
787: if (numSections == 0) {
788: document.$formname.$sec_element.multiple=false;
789: document.$formname.$sec_element.size=1;
790: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
791: } else {
792: if (numSections == 1) {
793: document.$formname.$sec_element.multiple=false;
794: document.$formname.$sec_element.size=1;
795: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
796: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
797: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
798: } else {
799: for (var i=0; i<numSections; i++) {
800: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
801: }
802: document.$formname.$sec_element.multiple=true
803: if (numSections < 3) {
804: document.$formname.$sec_element.size=numSections;
805: } else {
806: document.$formname.$sec_element.size=3;
807: }
808: document.$formname.$sec_element.options[0].selected = false
809: }
810: }
1.91 www 811: }
1.905 raeburn 812:
813: function setRole(crstype) {
1.468 raeburn 814: |;
1.905 raeburn 815: if ($role_element eq '') {
816: $setsections .= ' return;
817: }
818: ';
819: } else {
820: $setsections .= qq|
821: var elementLength = document.$formname.$role_element.length;
822: var allroles = Array($rolestr);
823: var courserolenames = Array($courserolestr);
824: var communityrolenames = Array($communityrolestr);
825: if (elementLength != undefined) {
826: if (document.$formname.$role_element.options[5].value == 'cc') {
827: if (crstype == 'Course') {
828: return;
829: } else {
830: allroles[5] = 'co';
831: for (var i=0; i<6; i++) {
832: document.$formname.$role_element.options[i].value = allroles[i];
833: document.$formname.$role_element.options[i].text = communityrolenames[i];
834: }
835: }
836: } else {
837: if (crstype == 'Community') {
838: return;
839: } else {
840: allroles[5] = 'cc';
841: for (var i=0; i<6; i++) {
842: document.$formname.$role_element.options[i].value = allroles[i];
843: document.$formname.$role_element.options[i].text = courserolenames[i];
844: }
845: }
846: }
847: }
848: return;
849: }
850: |;
851: }
1.1116 ! raeburn 852: if ($credits_element) {
! 853: $setsections .= qq|
! 854: function setCredits(defaultcredits) {
! 855: document.$formname.$credits_element.value = defaultcredits;
! 856: return;
! 857: }
! 858: |;
! 859: }
1.468 raeburn 860: return $setsections;
861: }
862:
1.91 www 863: sub selectcourse_link {
1.909 raeburn 864: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
865: $typeelement) = @_;
866: my $type = $selecttype;
1.871 raeburn 867: my $linktext = &mt('Select Course');
868: if ($selecttype eq 'Community') {
1.909 raeburn 869: $linktext = &mt('Select Community');
1.906 raeburn 870: } elsif ($selecttype eq 'Course/Community') {
871: $linktext = &mt('Select Course/Community');
1.909 raeburn 872: $type = '';
1.1019 raeburn 873: } elsif ($selecttype eq 'Select') {
874: $linktext = &mt('Select');
875: $type = '';
1.871 raeburn 876: }
1.787 bisitz 877: return '<span class="LC_nobreak">'
878: ."<a href='"
879: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
880: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 881: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 882: ."'>".$linktext.'</a>'
1.787 bisitz 883: .'</span>';
1.74 www 884: }
1.42 matthew 885:
1.653 raeburn 886: sub selectauthor_link {
887: my ($form,$udom)=@_;
888: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
889: &mt('Select Author').'</a>';
890: }
891:
1.876 raeburn 892: sub selectuser_link {
1.881 raeburn 893: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 894: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 895: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 896: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 897: ');">'.$linktext.'</a>';
1.876 raeburn 898: }
899:
1.273 raeburn 900: sub check_uncheck_jscript {
901: my $jscript = <<"ENDSCRT";
902: function checkAll(field) {
903: if (field.length > 0) {
904: for (i = 0; i < field.length; i++) {
1.1093 raeburn 905: if (!field[i].disabled) {
906: field[i].checked = true;
907: }
1.273 raeburn 908: }
909: } else {
1.1093 raeburn 910: if (!field.disabled) {
911: field.checked = true;
912: }
1.273 raeburn 913: }
914: }
915:
916: function uncheckAll(field) {
917: if (field.length > 0) {
918: for (i = 0; i < field.length; i++) {
919: field[i].checked = false ;
1.543 albertel 920: }
921: } else {
1.273 raeburn 922: field.checked = false ;
923: }
924: }
925: ENDSCRT
926: return $jscript;
927: }
928:
1.656 www 929: sub select_timezone {
1.659 raeburn 930: my ($name,$selected,$onchange,$includeempty)=@_;
931: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
932: if ($includeempty) {
933: $output .= '<option value=""';
934: if (($selected eq '') || ($selected eq 'local')) {
935: $output .= ' selected="selected" ';
936: }
937: $output .= '> </option>';
938: }
1.657 raeburn 939: my @timezones = DateTime::TimeZone->all_names;
940: foreach my $tzone (@timezones) {
941: $output.= '<option value="'.$tzone.'"';
942: if ($tzone eq $selected) {
943: $output.=' selected="selected"';
944: }
945: $output.=">$tzone</option>\n";
1.656 www 946: }
947: $output.="</select>";
948: return $output;
949: }
1.273 raeburn 950:
1.687 raeburn 951: sub select_datelocale {
952: my ($name,$selected,$onchange,$includeempty)=@_;
953: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
954: if ($includeempty) {
955: $output .= '<option value=""';
956: if ($selected eq '') {
957: $output .= ' selected="selected" ';
958: }
959: $output .= '> </option>';
960: }
961: my (@possibles,%locale_names);
962: my @locales = DateTime::Locale::Catalog::Locales;
963: foreach my $locale (@locales) {
964: if (ref($locale) eq 'HASH') {
965: my $id = $locale->{'id'};
966: if ($id ne '') {
967: my $en_terr = $locale->{'en_territory'};
968: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 969: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 970: if (grep(/^en$/,@languages) || !@languages) {
971: if ($en_terr ne '') {
972: $locale_names{$id} = '('.$en_terr.')';
973: } elsif ($native_terr ne '') {
974: $locale_names{$id} = $native_terr;
975: }
976: } else {
977: if ($native_terr ne '') {
978: $locale_names{$id} = $native_terr.' ';
979: } elsif ($en_terr ne '') {
980: $locale_names{$id} = '('.$en_terr.')';
981: }
982: }
983: push (@possibles,$id);
984: }
985: }
986: }
987: foreach my $item (sort(@possibles)) {
988: $output.= '<option value="'.$item.'"';
989: if ($item eq $selected) {
990: $output.=' selected="selected"';
991: }
992: $output.=">$item";
993: if ($locale_names{$item} ne '') {
994: $output.=" $locale_names{$item}</option>\n";
995: }
996: $output.="</option>\n";
997: }
998: $output.="</select>";
999: return $output;
1000: }
1001:
1.792 raeburn 1002: sub select_language {
1003: my ($name,$selected,$includeempty) = @_;
1004: my %langchoices;
1005: if ($includeempty) {
1.1112 bisitz 1006: %langchoices = ('' => &mt('No language preference'));
1.792 raeburn 1007: }
1008: foreach my $id (&languageids()) {
1009: my $code = &supportedlanguagecode($id);
1010: if ($code) {
1011: $langchoices{$code} = &plainlanguagedescription($id);
1012: }
1013: }
1.970 raeburn 1014: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1015: }
1016:
1.42 matthew 1017: =pod
1.36 matthew 1018:
1.1088 foxr 1019:
1020: =item * &list_languages()
1021:
1022: Returns an array reference that is suitable for use in language prompters.
1023: Each array element is itself a two element array. The first element
1024: is the language code. The second element a descsriptiuon of the
1025: language itself. This is suitable for use in e.g.
1026: &Apache::edit::select_arg (once dereferenced that is).
1027:
1028: =cut
1029:
1030: sub list_languages {
1031: my @lang_choices;
1032:
1033: foreach my $id (&languageids()) {
1034: my $code = &supportedlanguagecode($id);
1035: if ($code) {
1036: my $selector = $supported_codes{$id};
1037: my $description = &plainlanguagedescription($id);
1038: push (@lang_choices, [$selector, $description]);
1039: }
1040: }
1041: return \@lang_choices;
1042: }
1043:
1044: =pod
1045:
1.648 raeburn 1046: =item * &linked_select_forms(...)
1.36 matthew 1047:
1048: linked_select_forms returns a string containing a <script></script> block
1049: and html for two <select> menus. The select menus will be linked in that
1050: changing the value of the first menu will result in new values being placed
1051: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1052: order unless a defined order is provided.
1.36 matthew 1053:
1054: linked_select_forms takes the following ordered inputs:
1055:
1056: =over 4
1057:
1.112 bowersj2 1058: =item * $formname, the name of the <form> tag
1.36 matthew 1059:
1.112 bowersj2 1060: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1061:
1.112 bowersj2 1062: =item * $firstdefault, the default value for the first menu
1.36 matthew 1063:
1.112 bowersj2 1064: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1065:
1.112 bowersj2 1066: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1067:
1.112 bowersj2 1068: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1069:
1.609 raeburn 1070: =item * $menuorder, the order of values in the first menu
1071:
1.1115 raeburn 1072: =item * $onchangefirst, additional javascript call to execute for an onchange
1073: event for the first <select> tag
1074:
1075: =item * $onchangesecond, additional javascript call to execute for an onchange
1076: event for the second <select> tag
1077:
1.41 ng 1078: =back
1079:
1.36 matthew 1080: Below is an example of such a hash. Only the 'text', 'default', and
1081: 'select2' keys must appear as stated. keys(%menu) are the possible
1082: values for the first select menu. The text that coincides with the
1.41 ng 1083: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1084: and text for the second menu are given in the hash pointed to by
1085: $menu{$choice1}->{'select2'}.
1086:
1.112 bowersj2 1087: my %menu = ( A1 => { text =>"Choice A1" ,
1088: default => "B3",
1089: select2 => {
1090: B1 => "Choice B1",
1091: B2 => "Choice B2",
1092: B3 => "Choice B3",
1093: B4 => "Choice B4"
1.609 raeburn 1094: },
1095: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1096: },
1097: A2 => { text =>"Choice A2" ,
1098: default => "C2",
1099: select2 => {
1100: C1 => "Choice C1",
1101: C2 => "Choice C2",
1102: C3 => "Choice C3"
1.609 raeburn 1103: },
1104: order => ['C2','C1','C3'],
1.112 bowersj2 1105: },
1106: A3 => { text =>"Choice A3" ,
1107: default => "D6",
1108: select2 => {
1109: D1 => "Choice D1",
1110: D2 => "Choice D2",
1111: D3 => "Choice D3",
1112: D4 => "Choice D4",
1113: D5 => "Choice D5",
1114: D6 => "Choice D6",
1115: D7 => "Choice D7"
1.609 raeburn 1116: },
1117: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1118: }
1119: );
1.36 matthew 1120:
1121: =cut
1122:
1123: sub linked_select_forms {
1124: my ($formname,
1125: $middletext,
1126: $firstdefault,
1127: $firstselectname,
1128: $secondselectname,
1.609 raeburn 1129: $hashref,
1130: $menuorder,
1.1115 raeburn 1131: $onchangefirst,
1132: $onchangesecond
1.36 matthew 1133: ) = @_;
1134: my $second = "document.$formname.$secondselectname";
1135: my $first = "document.$formname.$firstselectname";
1136: # output the javascript to do the changing
1137: my $result = '';
1.776 bisitz 1138: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1139: $result.="// <![CDATA[\n";
1.36 matthew 1140: $result.="var select2data = new Object();\n";
1141: $" = '","';
1142: my $debug = '';
1143: foreach my $s1 (sort(keys(%$hashref))) {
1144: $result.="select2data.d_$s1 = new Object();\n";
1145: $result.="select2data.d_$s1.def = new String('".
1146: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1147: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1148: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1149: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1150: @s2values = @{$hashref->{$s1}->{'order'}};
1151: }
1.36 matthew 1152: $result.="\"@s2values\");\n";
1153: $result.="select2data.d_$s1.texts = new Array(";
1154: my @s2texts;
1155: foreach my $value (@s2values) {
1156: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1157: }
1158: $result.="\"@s2texts\");\n";
1159: }
1160: $"=' ';
1161: $result.= <<"END";
1162:
1163: function select1_changed() {
1164: // Determine new choice
1165: var newvalue = "d_" + $first.value;
1166: // update select2
1167: var values = select2data[newvalue].values;
1168: var texts = select2data[newvalue].texts;
1169: var select2def = select2data[newvalue].def;
1170: var i;
1171: // out with the old
1172: for (i = 0; i < $second.options.length; i++) {
1173: $second.options[i] = null;
1174: }
1175: // in with the nuclear
1176: for (i=0;i<values.length; i++) {
1177: $second.options[i] = new Option(values[i]);
1.143 matthew 1178: $second.options[i].value = values[i];
1.36 matthew 1179: $second.options[i].text = texts[i];
1180: if (values[i] == select2def) {
1181: $second.options[i].selected = true;
1182: }
1183: }
1184: }
1.824 bisitz 1185: // ]]>
1.36 matthew 1186: </script>
1187: END
1188: # output the initial values for the selection lists
1.1115 raeburn 1189: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1190: my @order = sort(keys(%{$hashref}));
1191: if (ref($menuorder) eq 'ARRAY') {
1192: @order = @{$menuorder};
1193: }
1194: foreach my $value (@order) {
1.36 matthew 1195: $result.=" <option value=\"$value\" ";
1.253 albertel 1196: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1197: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1198: }
1199: $result .= "</select>\n";
1200: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1201: $result .= $middletext;
1.1115 raeburn 1202: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1203: if ($onchangesecond) {
1204: $result .= ' onchange="'.$onchangesecond.'"';
1205: }
1206: $result .= ">\n";
1.36 matthew 1207: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1208:
1209: my @secondorder = sort(keys(%select2));
1210: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1211: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1212: }
1213: foreach my $value (@secondorder) {
1.36 matthew 1214: $result.=" <option value=\"$value\" ";
1.253 albertel 1215: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1216: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1217: }
1218: $result .= "</select>\n";
1219: # return $debug;
1220: return $result;
1221: } # end of sub linked_select_forms {
1222:
1.45 matthew 1223: =pod
1.44 bowersj2 1224:
1.973 raeburn 1225: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1226:
1.112 bowersj2 1227: Returns a string corresponding to an HTML link to the given help
1228: $topic, where $topic corresponds to the name of a .tex file in
1229: /home/httpd/html/adm/help/tex, with underscores replaced by
1230: spaces.
1231:
1232: $text will optionally be linked to the same topic, allowing you to
1233: link text in addition to the graphic. If you do not want to link
1234: text, but wish to specify one of the later parameters, pass an
1235: empty string.
1236:
1237: $stayOnPage is a value that will be interpreted as a boolean. If true,
1238: the link will not open a new window. If false, the link will open
1239: a new window using Javascript. (Default is false.)
1240:
1241: $width and $height are optional numerical parameters that will
1242: override the width and height of the popped up window, which may
1.973 raeburn 1243: be useful for certain help topics with big pictures included.
1244:
1245: $imgid is the id of the img tag used for the help icon. This may be
1246: used in a javascript call to switch the image src. See
1247: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1248:
1249: =cut
1250:
1251: sub help_open_topic {
1.973 raeburn 1252: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1253: $text = "" if (not defined $text);
1.44 bowersj2 1254: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1255: $width = 500 if (not defined $width);
1.44 bowersj2 1256: $height = 400 if (not defined $height);
1257: my $filename = $topic;
1258: $filename =~ s/ /_/g;
1259:
1.48 bowersj2 1260: my $template = "";
1261: my $link;
1.572 banghart 1262:
1.159 www 1263: $topic=~s/\W/\_/g;
1.44 bowersj2 1264:
1.572 banghart 1265: if (!$stayOnPage) {
1.1033 www 1266: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1267: } elsif ($stayOnPage eq 'popup') {
1268: $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 1269: } else {
1.48 bowersj2 1270: $link = "/adm/help/${filename}.hlp";
1271: }
1272:
1273: # Add the text
1.755 neumanie 1274: if ($text ne "") {
1.763 bisitz 1275: $template.='<span class="LC_help_open_topic">'
1276: .'<a target="_top" href="'.$link.'">'
1277: .$text.'</a>';
1.48 bowersj2 1278: }
1279:
1.763 bisitz 1280: # (Always) Add the graphic
1.179 matthew 1281: my $title = &mt('Online Help');
1.667 raeburn 1282: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1283: if ($imgid ne '') {
1284: $imgid = ' id="'.$imgid.'"';
1285: }
1.763 bisitz 1286: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1287: .'<img src="'.$helpicon.'" border="0"'
1288: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1289: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1290: .' /></a>';
1291: if ($text ne "") {
1292: $template.='</span>';
1293: }
1.44 bowersj2 1294: return $template;
1295:
1.106 bowersj2 1296: }
1297:
1298: # This is a quicky function for Latex cheatsheet editing, since it
1299: # appears in at least four places
1300: sub helpLatexCheatsheet {
1.1037 www 1301: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1302: my $out;
1.106 bowersj2 1303: my $addOther = '';
1.732 raeburn 1304: if ($topic) {
1.1037 www 1305: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1306: }
1307: $out = '<span>' # Start cheatsheet
1308: .$addOther
1309: .'<span>'
1.1037 www 1310: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1311: .'</span> <span>'
1.1037 www 1312: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1313: .'</span>';
1.732 raeburn 1314: unless ($not_author) {
1.763 bisitz 1315: $out .= ' <span>'
1.1037 www 1316: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763 bisitz 1317: .'</span>';
1.732 raeburn 1318: }
1.763 bisitz 1319: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1320: return $out;
1.172 www 1321: }
1322:
1.430 albertel 1323: sub general_help {
1324: my $helptopic='Student_Intro';
1325: if ($env{'request.role'}=~/^(ca|au)/) {
1326: $helptopic='Authoring_Intro';
1.907 raeburn 1327: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1328: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1329: } elsif ($env{'request.role'}=~/^dc/) {
1330: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1331: }
1332: return $helptopic;
1333: }
1334:
1335: sub update_help_link {
1336: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1337: my $origurl = $ENV{'REQUEST_URI'};
1338: $origurl=~s|^/~|/priv/|;
1339: my $timestamp = time;
1340: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1341: $$datum = &escape($$datum);
1342: }
1343:
1344: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1345: my $output .= <<"ENDOUTPUT";
1346: <script type="text/javascript">
1.824 bisitz 1347: // <![CDATA[
1.430 albertel 1348: banner_link = '$banner_link';
1.824 bisitz 1349: // ]]>
1.430 albertel 1350: </script>
1351: ENDOUTPUT
1352: return $output;
1353: }
1354:
1355: # now just updates the help link and generates a blue icon
1.193 raeburn 1356: sub help_open_menu {
1.430 albertel 1357: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1358: = @_;
1.949 droeschl 1359: $stayOnPage = 1;
1.430 albertel 1360: my $output;
1361: if ($component_help) {
1362: if (!$text) {
1363: $output=&help_open_topic($component_help,undef,$stayOnPage,
1364: $width,$height);
1365: } else {
1366: my $help_text;
1367: $help_text=&unescape($topic);
1368: $output='<table><tr><td>'.
1369: &help_open_topic($component_help,$help_text,$stayOnPage,
1370: $width,$height).'</td></tr></table>';
1371: }
1372: }
1373: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1374: return $output.$banner_link;
1375: }
1376:
1377: sub top_nav_help {
1378: my ($text) = @_;
1.436 albertel 1379: $text = &mt($text);
1.949 droeschl 1380: my $stay_on_page = 1;
1381:
1.572 banghart 1382: my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436 albertel 1383: : "javascript:helpMenu('open')";
1.572 banghart 1384: my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436 albertel 1385:
1.201 raeburn 1386: my $title = &mt('Get help');
1.436 albertel 1387:
1388: return <<"END";
1389: $banner_link
1390: <a href="$link" title="$title">$text</a>
1391: END
1392: }
1393:
1394: sub help_menu_js {
1395: my ($text) = @_;
1.949 droeschl 1396: my $stayOnPage = 1;
1.436 albertel 1397: my $width = 620;
1398: my $height = 600;
1.430 albertel 1399: my $helptopic=&general_help();
1400: my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1401: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1402: my $start_page =
1403: &Apache::loncommon::start_page('Help Menu', undef,
1404: {'frameset' => 1,
1405: 'js_ready' => 1,
1406: 'add_entries' => {
1407: 'border' => '0',
1.579 raeburn 1408: 'rows' => "110,*",},});
1.331 albertel 1409: my $end_page =
1410: &Apache::loncommon::end_page({'frameset' => 1,
1411: 'js_ready' => 1,});
1412:
1.436 albertel 1413: my $template .= <<"ENDTEMPLATE";
1414: <script type="text/javascript">
1.877 bisitz 1415: // <![CDATA[
1.253 albertel 1416: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1417: var banner_link = '';
1.243 raeburn 1418: function helpMenu(target) {
1419: var caller = this;
1420: if (target == 'open') {
1421: var newWindow = null;
1422: try {
1.262 albertel 1423: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1424: }
1425: catch(error) {
1426: writeHelp(caller);
1427: return;
1428: }
1429: if (newWindow) {
1430: caller = newWindow;
1431: }
1.193 raeburn 1432: }
1.243 raeburn 1433: writeHelp(caller);
1434: return;
1435: }
1436: function writeHelp(caller) {
1.1072 raeburn 1437: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
1.243 raeburn 1438: caller.document.close()
1439: caller.focus()
1.193 raeburn 1440: }
1.877 bisitz 1441: // END LON-CAPA Internal -->
1.253 albertel 1442: // ]]>
1.436 albertel 1443: </script>
1.193 raeburn 1444: ENDTEMPLATE
1445: return $template;
1446: }
1447:
1.172 www 1448: sub help_open_bug {
1449: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1450: unless ($env{'user.adv'}) { return ''; }
1.172 www 1451: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1452: $text = "" if (not defined $text);
1453: $stayOnPage=1;
1.184 albertel 1454: $width = 600 if (not defined $width);
1455: $height = 600 if (not defined $height);
1.172 www 1456:
1457: $topic=~s/\W+/\+/g;
1458: my $link='';
1459: my $template='';
1.379 albertel 1460: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1461: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1462: if (!$stayOnPage)
1463: {
1464: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1465: }
1466: else
1467: {
1468: $link = $url;
1469: }
1470: # Add the text
1471: if ($text ne "")
1472: {
1473: $template .=
1474: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1475: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1476: }
1477:
1478: # Add the graphic
1.179 matthew 1479: my $title = &mt('Report a Bug');
1.215 albertel 1480: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1481: $template .= <<"ENDTEMPLATE";
1.436 albertel 1482: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1483: ENDTEMPLATE
1484: if ($text ne '') { $template.='</td></tr></table>' };
1485: return $template;
1486:
1487: }
1488:
1489: sub help_open_faq {
1490: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1491: unless ($env{'user.adv'}) { return ''; }
1.172 www 1492: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1493: $text = "" if (not defined $text);
1494: $stayOnPage=1;
1495: $width = 350 if (not defined $width);
1496: $height = 400 if (not defined $height);
1497:
1498: $topic=~s/\W+/\+/g;
1499: my $link='';
1500: my $template='';
1501: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1502: if (!$stayOnPage)
1503: {
1504: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1505: }
1506: else
1507: {
1508: $link = $url;
1509: }
1510:
1511: # Add the text
1512: if ($text ne "")
1513: {
1514: $template .=
1.173 www 1515: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1516: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1517: }
1518:
1519: # Add the graphic
1.179 matthew 1520: my $title = &mt('View the FAQ');
1.215 albertel 1521: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1522: $template .= <<"ENDTEMPLATE";
1.436 albertel 1523: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1524: ENDTEMPLATE
1525: if ($text ne '') { $template.='</td></tr></table>' };
1526: return $template;
1527:
1.44 bowersj2 1528: }
1.37 matthew 1529:
1.180 matthew 1530: ###############################################################
1531: ###############################################################
1532:
1.45 matthew 1533: =pod
1534:
1.648 raeburn 1535: =item * &change_content_javascript():
1.256 matthew 1536:
1537: This and the next function allow you to create small sections of an
1538: otherwise static HTML page that you can update on the fly with
1539: Javascript, even in Netscape 4.
1540:
1541: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1542: must be written to the HTML page once. It will prove the Javascript
1543: function "change(name, content)". Calling the change function with the
1544: name of the section
1545: you want to update, matching the name passed to C<changable_area>, and
1546: the new content you want to put in there, will put the content into
1547: that area.
1548:
1549: B<Note>: Netscape 4 only reserves enough space for the changable area
1550: to contain room for the original contents. You need to "make space"
1551: for whatever changes you wish to make, and be B<sure> to check your
1552: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1553: it's adequate for updating a one-line status display, but little more.
1554: This script will set the space to 100% width, so you only need to
1555: worry about height in Netscape 4.
1556:
1557: Modern browsers are much less limiting, and if you can commit to the
1558: user not using Netscape 4, this feature may be used freely with
1559: pretty much any HTML.
1560:
1561: =cut
1562:
1563: sub change_content_javascript {
1564: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1565: if ($env{'browser.type'} eq 'netscape' &&
1566: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1567: return (<<NETSCAPE4);
1568: function change(name, content) {
1569: doc = document.layers[name+"___escape"].layers[0].document;
1570: doc.open();
1571: doc.write(content);
1572: doc.close();
1573: }
1574: NETSCAPE4
1575: } else {
1576: # Otherwise, we need to use semi-standards-compliant code
1577: # (technically, "innerHTML" isn't standard but the equivalent
1578: # is really scary, and every useful browser supports it
1579: return (<<DOMBASED);
1580: function change(name, content) {
1581: element = document.getElementById(name);
1582: element.innerHTML = content;
1583: }
1584: DOMBASED
1585: }
1586: }
1587:
1588: =pod
1589:
1.648 raeburn 1590: =item * &changable_area($name,$origContent):
1.256 matthew 1591:
1592: This provides a "changable area" that can be modified on the fly via
1593: the Javascript code provided in C<change_content_javascript>. $name is
1594: the name you will use to reference the area later; do not repeat the
1595: same name on a given HTML page more then once. $origContent is what
1596: the area will originally contain, which can be left blank.
1597:
1598: =cut
1599:
1600: sub changable_area {
1601: my ($name, $origContent) = @_;
1602:
1.258 albertel 1603: if ($env{'browser.type'} eq 'netscape' &&
1604: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1605: # If this is netscape 4, we need to use the Layer tag
1606: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1607: } else {
1608: return "<span id='$name'>$origContent</span>";
1609: }
1610: }
1611:
1612: =pod
1613:
1.648 raeburn 1614: =item * &viewport_geometry_js
1.590 raeburn 1615:
1616: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1617:
1618: =cut
1619:
1620:
1621: sub viewport_geometry_js {
1622: return <<"GEOMETRY";
1623: var Geometry = {};
1624: function init_geometry() {
1625: if (Geometry.init) { return };
1626: Geometry.init=1;
1627: if (window.innerHeight) {
1628: Geometry.getViewportHeight = function() { return window.innerHeight; };
1629: Geometry.getViewportWidth = function() { return window.innerWidth; };
1630: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1631: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1632: }
1633: else if (document.documentElement && document.documentElement.clientHeight) {
1634: Geometry.getViewportHeight =
1635: function() { return document.documentElement.clientHeight; };
1636: Geometry.getViewportWidth =
1637: function() { return document.documentElement.clientWidth; };
1638:
1639: Geometry.getHorizontalScroll =
1640: function() { return document.documentElement.scrollLeft; };
1641: Geometry.getVerticalScroll =
1642: function() { return document.documentElement.scrollTop; };
1643: }
1644: else if (document.body.clientHeight) {
1645: Geometry.getViewportHeight =
1646: function() { return document.body.clientHeight; };
1647: Geometry.getViewportWidth =
1648: function() { return document.body.clientWidth; };
1649: Geometry.getHorizontalScroll =
1650: function() { return document.body.scrollLeft; };
1651: Geometry.getVerticalScroll =
1652: function() { return document.body.scrollTop; };
1653: }
1654: }
1655:
1656: GEOMETRY
1657: }
1658:
1659: =pod
1660:
1.648 raeburn 1661: =item * &viewport_size_js()
1.590 raeburn 1662:
1663: 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.
1664:
1665: =cut
1666:
1667: sub viewport_size_js {
1668: my $geometry = &viewport_geometry_js();
1669: return <<"DIMS";
1670:
1671: $geometry
1672:
1673: function getViewportDims(width,height) {
1674: init_geometry();
1675: width.value = Geometry.getViewportWidth();
1676: height.value = Geometry.getViewportHeight();
1677: return;
1678: }
1679:
1680: DIMS
1681: }
1682:
1683: =pod
1684:
1.648 raeburn 1685: =item * &resize_textarea_js()
1.565 albertel 1686:
1687: emits the needed javascript to resize a textarea to be as big as possible
1688:
1689: creates a function resize_textrea that takes two IDs first should be
1690: the id of the element to resize, second should be the id of a div that
1691: surrounds everything that comes after the textarea, this routine needs
1692: to be attached to the <body> for the onload and onresize events.
1693:
1.648 raeburn 1694: =back
1.565 albertel 1695:
1696: =cut
1697:
1698: sub resize_textarea_js {
1.590 raeburn 1699: my $geometry = &viewport_geometry_js();
1.565 albertel 1700: return <<"RESIZE";
1701: <script type="text/javascript">
1.824 bisitz 1702: // <![CDATA[
1.590 raeburn 1703: $geometry
1.565 albertel 1704:
1.588 albertel 1705: function getX(element) {
1706: var x = 0;
1707: while (element) {
1708: x += element.offsetLeft;
1709: element = element.offsetParent;
1710: }
1711: return x;
1712: }
1713: function getY(element) {
1714: var y = 0;
1715: while (element) {
1716: y += element.offsetTop;
1717: element = element.offsetParent;
1718: }
1719: return y;
1720: }
1721:
1722:
1.565 albertel 1723: function resize_textarea(textarea_id,bottom_id) {
1724: init_geometry();
1725: var textarea = document.getElementById(textarea_id);
1726: //alert(textarea);
1727:
1.588 albertel 1728: var textarea_top = getY(textarea);
1.565 albertel 1729: var textarea_height = textarea.offsetHeight;
1730: var bottom = document.getElementById(bottom_id);
1.588 albertel 1731: var bottom_top = getY(bottom);
1.565 albertel 1732: var bottom_height = bottom.offsetHeight;
1733: var window_height = Geometry.getViewportHeight();
1.588 albertel 1734: var fudge = 23;
1.565 albertel 1735: var new_height = window_height-fudge-textarea_top-bottom_height;
1736: if (new_height < 300) {
1737: new_height = 300;
1738: }
1739: textarea.style.height=new_height+'px';
1740: }
1.824 bisitz 1741: // ]]>
1.565 albertel 1742: </script>
1743: RESIZE
1744:
1745: }
1746:
1747: =pod
1748:
1.256 matthew 1749: =head1 Excel and CSV file utility routines
1750:
1751: =over 4
1752:
1753: =cut
1754:
1755: ###############################################################
1756: ###############################################################
1757:
1758: =pod
1759:
1.648 raeburn 1760: =item * &csv_translate($text)
1.37 matthew 1761:
1.185 www 1762: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1763: format.
1764:
1765: =cut
1766:
1.180 matthew 1767: ###############################################################
1768: ###############################################################
1.37 matthew 1769: sub csv_translate {
1770: my $text = shift;
1771: $text =~ s/\"/\"\"/g;
1.209 albertel 1772: $text =~ s/\n/ /g;
1.37 matthew 1773: return $text;
1774: }
1.180 matthew 1775:
1776: ###############################################################
1777: ###############################################################
1778:
1779: =pod
1780:
1.648 raeburn 1781: =item * &define_excel_formats()
1.180 matthew 1782:
1783: Define some commonly used Excel cell formats.
1784:
1785: Currently supported formats:
1786:
1787: =over 4
1788:
1789: =item header
1790:
1791: =item bold
1792:
1793: =item h1
1794:
1795: =item h2
1796:
1797: =item h3
1798:
1.256 matthew 1799: =item h4
1800:
1801: =item i
1802:
1.180 matthew 1803: =item date
1804:
1805: =back
1806:
1807: Inputs: $workbook
1808:
1809: Returns: $format, a hash reference.
1810:
1.1057 foxr 1811:
1.180 matthew 1812: =cut
1813:
1814: ###############################################################
1815: ###############################################################
1816: sub define_excel_formats {
1817: my ($workbook) = @_;
1818: my $format;
1819: $format->{'header'} = $workbook->add_format(bold => 1,
1820: bottom => 1,
1821: align => 'center');
1822: $format->{'bold'} = $workbook->add_format(bold=>1);
1823: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1824: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1825: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1826: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1827: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1828: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1829: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1830: return $format;
1831: }
1832:
1833: ###############################################################
1834: ###############################################################
1.113 bowersj2 1835:
1836: =pod
1837:
1.648 raeburn 1838: =item * &create_workbook()
1.255 matthew 1839:
1840: Create an Excel worksheet. If it fails, output message on the
1841: request object and return undefs.
1842:
1843: Inputs: Apache request object
1844:
1845: Returns (undef) on failure,
1846: Excel worksheet object, scalar with filename, and formats
1847: from &Apache::loncommon::define_excel_formats on success
1848:
1849: =cut
1850:
1851: ###############################################################
1852: ###############################################################
1853: sub create_workbook {
1854: my ($r) = @_;
1855: #
1856: # Create the excel spreadsheet
1857: my $filename = '/prtspool/'.
1.258 albertel 1858: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1859: time.'_'.rand(1000000000).'.xls';
1860: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1861: if (! defined($workbook)) {
1862: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1863: $r->print(
1864: '<p class="LC_error">'
1865: .&mt('Problems occurred in creating the new Excel file.')
1866: .' '.&mt('This error has been logged.')
1867: .' '.&mt('Please alert your LON-CAPA administrator.')
1868: .'</p>'
1869: );
1.255 matthew 1870: return (undef);
1871: }
1872: #
1.1014 foxr 1873: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1874: #
1875: my $format = &Apache::loncommon::define_excel_formats($workbook);
1876: return ($workbook,$filename,$format);
1877: }
1878:
1879: ###############################################################
1880: ###############################################################
1881:
1882: =pod
1883:
1.648 raeburn 1884: =item * &create_text_file()
1.113 bowersj2 1885:
1.542 raeburn 1886: Create a file to write to and eventually make available to the user.
1.256 matthew 1887: If file creation fails, outputs an error message on the request object and
1888: return undefs.
1.113 bowersj2 1889:
1.256 matthew 1890: Inputs: Apache request object, and file suffix
1.113 bowersj2 1891:
1.256 matthew 1892: Returns (undef) on failure,
1893: Filehandle and filename on success.
1.113 bowersj2 1894:
1895: =cut
1896:
1.256 matthew 1897: ###############################################################
1898: ###############################################################
1899: sub create_text_file {
1900: my ($r,$suffix) = @_;
1901: if (! defined($suffix)) { $suffix = 'txt'; };
1902: my $fh;
1903: my $filename = '/prtspool/'.
1.258 albertel 1904: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1905: time.'_'.rand(1000000000).'.'.$suffix;
1906: $fh = Apache::File->new('>/home/httpd'.$filename);
1907: if (! defined($fh)) {
1908: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1909: $r->print(
1910: '<p class="LC_error">'
1911: .&mt('Problems occurred in creating the output file.')
1912: .' '.&mt('This error has been logged.')
1913: .' '.&mt('Please alert your LON-CAPA administrator.')
1914: .'</p>'
1915: );
1.113 bowersj2 1916: }
1.256 matthew 1917: return ($fh,$filename)
1.113 bowersj2 1918: }
1919:
1920:
1.256 matthew 1921: =pod
1.113 bowersj2 1922:
1923: =back
1924:
1925: =cut
1.37 matthew 1926:
1927: ###############################################################
1.33 matthew 1928: ## Home server <option> list generating code ##
1929: ###############################################################
1.35 matthew 1930:
1.169 www 1931: # ------------------------------------------
1932:
1933: sub domain_select {
1934: my ($name,$value,$multiple)=@_;
1935: my %domains=map {
1.514 albertel 1936: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1937: } &Apache::lonnet::all_domains();
1.169 www 1938: if ($multiple) {
1939: $domains{''}=&mt('Any domain');
1.550 albertel 1940: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1941: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1942: } else {
1.550 albertel 1943: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1944: return &select_form($name,$value,\%domains);
1.169 www 1945: }
1946: }
1947:
1.282 albertel 1948: #-------------------------------------------
1949:
1950: =pod
1951:
1.519 raeburn 1952: =head1 Routines for form select boxes
1953:
1954: =over 4
1955:
1.648 raeburn 1956: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1957:
1958: Returns a string containing a <select> element int multiple mode
1959:
1960:
1961: Args:
1962: $name - name of the <select> element
1.506 raeburn 1963: $value - scalar or array ref of values that should already be selected
1.282 albertel 1964: $size - number of rows long the select element is
1.283 albertel 1965: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1966: (shown text should already have been &mt())
1.506 raeburn 1967: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1968:
1.282 albertel 1969: =cut
1970:
1971: #-------------------------------------------
1.169 www 1972: sub multiple_select_form {
1.284 albertel 1973: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1974: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1975: my $output='';
1.191 matthew 1976: if (! defined($size)) {
1977: $size = 4;
1.283 albertel 1978: if (scalar(keys(%$hash))<4) {
1979: $size = scalar(keys(%$hash));
1.191 matthew 1980: }
1981: }
1.734 bisitz 1982: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1983: my @order;
1.506 raeburn 1984: if (ref($order) eq 'ARRAY') {
1985: @order = @{$order};
1986: } else {
1987: @order = sort(keys(%$hash));
1.501 banghart 1988: }
1989: if (exists($$hash{'select_form_order'})) {
1990: @order = @{$$hash{'select_form_order'}};
1991: }
1992:
1.284 albertel 1993: foreach my $key (@order) {
1.356 albertel 1994: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1995: $output.='selected="selected" ' if ($selected{$key});
1996: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1997: }
1998: $output.="</select>\n";
1999: return $output;
2000: }
2001:
1.88 www 2002: #-------------------------------------------
2003:
2004: =pod
2005:
1.970 raeburn 2006: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2007:
2008: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2009: allow a user to select options from a ref to a hash containing:
2010: option_name => displayed text. An optional $onchange can include
2011: a javascript onchange item, e.g., onchange="this.form.submit();"
2012:
1.88 www 2013: See lonrights.pm for an example invocation and use.
2014:
2015: =cut
2016:
2017: #-------------------------------------------
2018: sub select_form {
1.970 raeburn 2019: my ($def,$name,$hashref,$onchange) = @_;
2020: return unless (ref($hashref) eq 'HASH');
2021: if ($onchange) {
2022: $onchange = ' onchange="'.$onchange.'"';
2023: }
2024: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2025: my @keys;
1.970 raeburn 2026: if (exists($hashref->{'select_form_order'})) {
2027: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2028: } else {
1.970 raeburn 2029: @keys=sort(keys(%{$hashref}));
1.128 albertel 2030: }
1.356 albertel 2031: foreach my $key (@keys) {
2032: $selectform.=
2033: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2034: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2035: ">".$hashref->{$key}."</option>\n";
1.88 www 2036: }
2037: $selectform.="</select>";
2038: return $selectform;
2039: }
2040:
1.475 www 2041: # For display filters
2042:
2043: sub display_filter {
1.1074 raeburn 2044: my ($context) = @_;
1.475 www 2045: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2046: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2047: my $phraseinput = 'hidden';
2048: my $includeinput = 'hidden';
2049: my ($checked,$includetypestext);
2050: if ($env{'form.displayfilter'} eq 'containing') {
2051: $phraseinput = 'text';
2052: if ($context eq 'parmslog') {
2053: $includeinput = 'checkbox';
2054: if ($env{'form.includetypes'}) {
2055: $checked = ' checked="checked"';
2056: }
2057: $includetypestext = &mt('Include parameter types');
2058: }
2059: } else {
2060: $includetypestext = ' ';
2061: }
2062: my ($additional,$secondid,$thirdid);
2063: if ($context eq 'parmslog') {
2064: $additional =
2065: '<label><input type="'.$includeinput.'" name="includetypes"'.
2066: $checked.' name="includetypes" value="1" id="includetypes" />'.
2067: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2068: '</label>';
2069: $secondid = 'includetypes';
2070: $thirdid = 'includetypestext';
2071: }
2072: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2073: '$secondid','$thirdid')";
2074: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2075: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2076: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2077: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2078: &mt('Filter: [_1]',
1.477 www 2079: &select_form($env{'form.displayfilter'},
2080: 'displayfilter',
1.970 raeburn 2081: {'currentfolder' => 'Current folder/page',
1.477 www 2082: 'containing' => 'Containing phrase',
1.1074 raeburn 2083: 'none' => 'None'},$onchange)).' '.
2084: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2085: &HTML::Entities::encode($env{'form.containingphrase'}).
2086: '" />'.$additional;
2087: }
2088:
2089: sub display_filter_js {
2090: my $includetext = &mt('Include parameter types');
2091: return <<"ENDJS";
2092:
2093: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2094: var firstType = 'hidden';
2095: if (setter.options[setter.selectedIndex].value == 'containing') {
2096: firstType = 'text';
2097: }
2098: firstObject = document.getElementById(firstid);
2099: if (typeof(firstObject) == 'object') {
2100: if (firstObject.type != firstType) {
2101: changeInputType(firstObject,firstType);
2102: }
2103: }
2104: if (context == 'parmslog') {
2105: var secondType = 'hidden';
2106: if (firstType == 'text') {
2107: secondType = 'checkbox';
2108: }
2109: secondObject = document.getElementById(secondid);
2110: if (typeof(secondObject) == 'object') {
2111: if (secondObject.type != secondType) {
2112: changeInputType(secondObject,secondType);
2113: }
2114: }
2115: var textItem = document.getElementById(thirdid);
2116: var currtext = textItem.innerHTML;
2117: var newtext;
2118: if (firstType == 'text') {
2119: newtext = '$includetext';
2120: } else {
2121: newtext = ' ';
2122: }
2123: if (currtext != newtext) {
2124: textItem.innerHTML = newtext;
2125: }
2126: }
2127: return;
2128: }
2129:
2130: function changeInputType(oldObject,newType) {
2131: var newObject = document.createElement('input');
2132: newObject.type = newType;
2133: if (oldObject.size) {
2134: newObject.size = oldObject.size;
2135: }
2136: if (oldObject.value) {
2137: newObject.value = oldObject.value;
2138: }
2139: if (oldObject.name) {
2140: newObject.name = oldObject.name;
2141: }
2142: if (oldObject.id) {
2143: newObject.id = oldObject.id;
2144: }
2145: oldObject.parentNode.replaceChild(newObject,oldObject);
2146: return;
2147: }
2148:
2149: ENDJS
1.475 www 2150: }
2151:
1.167 www 2152: sub gradeleveldescription {
2153: my $gradelevel=shift;
2154: my %gradelevels=(0 => 'Not specified',
2155: 1 => 'Grade 1',
2156: 2 => 'Grade 2',
2157: 3 => 'Grade 3',
2158: 4 => 'Grade 4',
2159: 5 => 'Grade 5',
2160: 6 => 'Grade 6',
2161: 7 => 'Grade 7',
2162: 8 => 'Grade 8',
2163: 9 => 'Grade 9',
2164: 10 => 'Grade 10',
2165: 11 => 'Grade 11',
2166: 12 => 'Grade 12',
2167: 13 => 'Grade 13',
2168: 14 => '100 Level',
2169: 15 => '200 Level',
2170: 16 => '300 Level',
2171: 17 => '400 Level',
2172: 18 => 'Graduate Level');
2173: return &mt($gradelevels{$gradelevel});
2174: }
2175:
1.163 www 2176: sub select_level_form {
2177: my ($deflevel,$name)=@_;
2178: unless ($deflevel) { $deflevel=0; }
1.167 www 2179: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2180: for (my $i=0; $i<=18; $i++) {
2181: $selectform.="<option value=\"$i\" ".
1.253 albertel 2182: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2183: ">".&gradeleveldescription($i)."</option>\n";
2184: }
2185: $selectform.="</select>";
2186: return $selectform;
1.163 www 2187: }
1.167 www 2188:
1.35 matthew 2189: #-------------------------------------------
2190:
1.45 matthew 2191: =pod
2192:
1.910 raeburn 2193: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35 matthew 2194:
2195: Returns a string containing a <select name='$name' size='1'> form to
2196: allow a user to select the domain to preform an operation in.
2197: See loncreateuser.pm for an example invocation and use.
2198:
1.90 www 2199: If the $includeempty flag is set, it also includes an empty choice ("no domain
2200: selected");
2201:
1.743 raeburn 2202: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2203:
1.910 raeburn 2204: 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.
2205:
2206: The optional $incdoms is a reference to an array of domains which will be the only available options.
1.563 raeburn 2207:
1.35 matthew 2208: =cut
2209:
2210: #-------------------------------------------
1.34 matthew 2211: sub select_dom_form {
1.910 raeburn 2212: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872 raeburn 2213: if ($onchange) {
1.874 raeburn 2214: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2215: }
1.910 raeburn 2216: my @domains;
2217: if (ref($incdoms) eq 'ARRAY') {
2218: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2219: } else {
2220: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2221: }
1.90 www 2222: if ($includeempty) { @domains=('',@domains); }
1.743 raeburn 2223: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2224: foreach my $dom (@domains) {
2225: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2226: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2227: if ($showdomdesc) {
2228: if ($dom ne '') {
2229: my $domdesc = &Apache::lonnet::domain($dom,'description');
2230: if ($domdesc ne '') {
2231: $selectdomain .= ' ('.$domdesc.')';
2232: }
2233: }
2234: }
2235: $selectdomain .= "</option>\n";
1.34 matthew 2236: }
2237: $selectdomain.="</select>";
2238: return $selectdomain;
2239: }
2240:
1.35 matthew 2241: #-------------------------------------------
2242:
1.45 matthew 2243: =pod
2244:
1.648 raeburn 2245: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2246:
1.586 raeburn 2247: input: 4 arguments (two required, two optional) -
2248: $domain - domain of new user
2249: $name - name of form element
2250: $default - Value of 'default' causes a default item to be first
2251: option, and selected by default.
2252: $hide - Value of 'hide' causes hiding of the name of the server,
2253: if 1 server found, or default, if 0 found.
1.594 raeburn 2254: output: returns 2 items:
1.586 raeburn 2255: (a) form element which contains either:
2256: (i) <select name="$name">
2257: <option value="$hostid1">$hostid $servers{$hostid}</option>
2258: <option value="$hostid2">$hostid $servers{$hostid}</option>
2259: </select>
2260: form item if there are multiple library servers in $domain, or
2261: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2262: if there is only one library server in $domain.
2263:
2264: (b) number of library servers found.
2265:
2266: See loncreateuser.pm for example of use.
1.35 matthew 2267:
2268: =cut
2269:
2270: #-------------------------------------------
1.586 raeburn 2271: sub home_server_form_item {
2272: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2273: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2274: my $result;
2275: my $numlib = keys(%servers);
2276: if ($numlib > 1) {
2277: $result .= '<select name="'.$name.'" />'."\n";
2278: if ($default) {
1.804 bisitz 2279: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2280: '</option>'."\n";
2281: }
2282: foreach my $hostid (sort(keys(%servers))) {
2283: $result.= '<option value="'.$hostid.'">'.
2284: $hostid.' '.$servers{$hostid}."</option>\n";
2285: }
2286: $result .= '</select>'."\n";
2287: } elsif ($numlib == 1) {
2288: my $hostid;
2289: foreach my $item (keys(%servers)) {
2290: $hostid = $item;
2291: }
2292: $result .= '<input type="hidden" name="'.$name.'" value="'.
2293: $hostid.'" />';
2294: if (!$hide) {
2295: $result .= $hostid.' '.$servers{$hostid};
2296: }
2297: $result .= "\n";
2298: } elsif ($default) {
2299: $result .= '<input type="hidden" name="'.$name.
2300: '" value="default" />';
2301: if (!$hide) {
2302: $result .= &mt('default');
2303: }
2304: $result .= "\n";
1.33 matthew 2305: }
1.586 raeburn 2306: return ($result,$numlib);
1.33 matthew 2307: }
1.112 bowersj2 2308:
2309: =pod
2310:
1.534 albertel 2311: =back
2312:
1.112 bowersj2 2313: =cut
1.87 matthew 2314:
2315: ###############################################################
1.112 bowersj2 2316: ## Decoding User Agent ##
1.87 matthew 2317: ###############################################################
2318:
2319: =pod
2320:
1.112 bowersj2 2321: =head1 Decoding the User Agent
2322:
2323: =over 4
2324:
2325: =item * &decode_user_agent()
1.87 matthew 2326:
2327: Inputs: $r
2328:
2329: Outputs:
2330:
2331: =over 4
2332:
1.112 bowersj2 2333: =item * $httpbrowser
1.87 matthew 2334:
1.112 bowersj2 2335: =item * $clientbrowser
1.87 matthew 2336:
1.112 bowersj2 2337: =item * $clientversion
1.87 matthew 2338:
1.112 bowersj2 2339: =item * $clientmathml
1.87 matthew 2340:
1.112 bowersj2 2341: =item * $clientunicode
1.87 matthew 2342:
1.112 bowersj2 2343: =item * $clientos
1.87 matthew 2344:
2345: =back
2346:
1.157 matthew 2347: =back
2348:
1.87 matthew 2349: =cut
2350:
2351: ###############################################################
2352: ###############################################################
2353: sub decode_user_agent {
1.247 albertel 2354: my ($r)=@_;
1.87 matthew 2355: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2356: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2357: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2358: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2359: my $clientbrowser='unknown';
2360: my $clientversion='0';
2361: my $clientmathml='';
2362: my $clientunicode='0';
2363: for (my $i=0;$i<=$#browsertype;$i++) {
2364: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
2365: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2366: $clientbrowser=$bname;
2367: $httpbrowser=~/$vreg/i;
2368: $clientversion=$1;
2369: $clientmathml=($clientversion>=$minv);
2370: $clientunicode=($clientversion>=$univ);
2371: }
2372: }
2373: my $clientos='unknown';
2374: if (($httpbrowser=~/linux/i) ||
2375: ($httpbrowser=~/unix/i) ||
2376: ($httpbrowser=~/ux/i) ||
2377: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2378: if (($httpbrowser=~/vax/i) ||
2379: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2380: if ($httpbrowser=~/next/i) { $clientos='next'; }
2381: if (($httpbrowser=~/mac/i) ||
2382: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
2383: if ($httpbrowser=~/win/i) { $clientos='win'; }
2384: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
2385: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
2386: $clientunicode,$clientos,);
2387: }
2388:
1.32 matthew 2389: ###############################################################
2390: ## Authentication changing form generation subroutines ##
2391: ###############################################################
2392: ##
2393: ## All of the authform_xxxxxxx subroutines take their inputs in a
2394: ## hash, and have reasonable default values.
2395: ##
2396: ## formname = the name given in the <form> tag.
1.35 matthew 2397: #-------------------------------------------
2398:
1.45 matthew 2399: =pod
2400:
1.112 bowersj2 2401: =head1 Authentication Routines
2402:
2403: =over 4
2404:
1.648 raeburn 2405: =item * &authform_xxxxxx()
1.35 matthew 2406:
2407: The authform_xxxxxx subroutines provide javascript and html forms which
2408: handle some of the conveniences required for authentication forms.
2409: This is not an optimal method, but it works.
2410:
2411: =over 4
2412:
1.112 bowersj2 2413: =item * authform_header
1.35 matthew 2414:
1.112 bowersj2 2415: =item * authform_authorwarning
1.35 matthew 2416:
1.112 bowersj2 2417: =item * authform_nochange
1.35 matthew 2418:
1.112 bowersj2 2419: =item * authform_kerberos
1.35 matthew 2420:
1.112 bowersj2 2421: =item * authform_internal
1.35 matthew 2422:
1.112 bowersj2 2423: =item * authform_filesystem
1.35 matthew 2424:
2425: =back
2426:
1.648 raeburn 2427: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2428:
1.35 matthew 2429: =cut
2430:
2431: #-------------------------------------------
1.32 matthew 2432: sub authform_header{
2433: my %in = (
2434: formname => 'cu',
1.80 albertel 2435: kerb_def_dom => '',
1.32 matthew 2436: @_,
2437: );
2438: $in{'formname'} = 'document.' . $in{'formname'};
2439: my $result='';
1.80 albertel 2440:
2441: #---------------------------------------------- Code for upper case translation
2442: my $Javascript_toUpperCase;
2443: unless ($in{kerb_def_dom}) {
2444: $Javascript_toUpperCase =<<"END";
2445: switch (choice) {
2446: case 'krb': currentform.elements[choicearg].value =
2447: currentform.elements[choicearg].value.toUpperCase();
2448: break;
2449: default:
2450: }
2451: END
2452: } else {
2453: $Javascript_toUpperCase = "";
2454: }
2455:
1.165 raeburn 2456: my $radioval = "'nochange'";
1.591 raeburn 2457: if (defined($in{'curr_authtype'})) {
2458: if ($in{'curr_authtype'} ne '') {
2459: $radioval = "'".$in{'curr_authtype'}."arg'";
2460: }
1.174 matthew 2461: }
1.165 raeburn 2462: my $argfield = 'null';
1.591 raeburn 2463: if (defined($in{'mode'})) {
1.165 raeburn 2464: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2465: if (defined($in{'curr_autharg'})) {
2466: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2467: $argfield = "'$in{'curr_autharg'}'";
2468: }
2469: }
2470: }
2471: }
2472:
1.32 matthew 2473: $result.=<<"END";
2474: var current = new Object();
1.165 raeburn 2475: current.radiovalue = $radioval;
2476: current.argfield = $argfield;
1.32 matthew 2477:
2478: function changed_radio(choice,currentform) {
2479: var choicearg = choice + 'arg';
2480: // If a radio button in changed, we need to change the argfield
2481: if (current.radiovalue != choice) {
2482: current.radiovalue = choice;
2483: if (current.argfield != null) {
2484: currentform.elements[current.argfield].value = '';
2485: }
2486: if (choice == 'nochange') {
2487: current.argfield = null;
2488: } else {
2489: current.argfield = choicearg;
2490: switch(choice) {
2491: case 'krb':
2492: currentform.elements[current.argfield].value =
2493: "$in{'kerb_def_dom'}";
2494: break;
2495: default:
2496: break;
2497: }
2498: }
2499: }
2500: return;
2501: }
1.22 www 2502:
1.32 matthew 2503: function changed_text(choice,currentform) {
2504: var choicearg = choice + 'arg';
2505: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2506: $Javascript_toUpperCase
1.32 matthew 2507: // clear old field
2508: if ((current.argfield != choicearg) && (current.argfield != null)) {
2509: currentform.elements[current.argfield].value = '';
2510: }
2511: current.argfield = choicearg;
2512: }
2513: set_auth_radio_buttons(choice,currentform);
2514: return;
1.20 www 2515: }
1.32 matthew 2516:
2517: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2518: var numauthchoices = currentform.login.length;
2519: if (typeof numauthchoices == "undefined") {
2520: return;
2521: }
1.32 matthew 2522: var i=0;
1.986 raeburn 2523: while (i < numauthchoices) {
1.32 matthew 2524: if (currentform.login[i].value == newvalue) { break; }
2525: i++;
2526: }
1.986 raeburn 2527: if (i == numauthchoices) {
1.32 matthew 2528: return;
2529: }
2530: current.radiovalue = newvalue;
2531: currentform.login[i].checked = true;
2532: return;
2533: }
2534: END
2535: return $result;
2536: }
2537:
1.1106 raeburn 2538: sub authform_authorwarning {
1.32 matthew 2539: my $result='';
1.144 matthew 2540: $result='<i>'.
2541: &mt('As a general rule, only authors or co-authors should be '.
2542: 'filesystem authenticated '.
2543: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2544: return $result;
2545: }
2546:
1.1106 raeburn 2547: sub authform_nochange {
1.32 matthew 2548: my %in = (
2549: formname => 'document.cu',
2550: kerb_def_dom => 'MSU.EDU',
2551: @_,
2552: );
1.1106 raeburn 2553: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2554: my $result;
1.1104 raeburn 2555: if (!$authnum) {
1.1105 raeburn 2556: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2557: } else {
2558: $result = '<label>'.&mt('[_1] Do not change login data',
2559: '<input type="radio" name="login" value="nochange" '.
2560: 'checked="checked" onclick="'.
1.281 albertel 2561: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2562: '</label>';
1.586 raeburn 2563: }
1.32 matthew 2564: return $result;
2565: }
2566:
1.591 raeburn 2567: sub authform_kerberos {
1.32 matthew 2568: my %in = (
2569: formname => 'document.cu',
2570: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2571: kerb_def_auth => 'krb4',
1.32 matthew 2572: @_,
2573: );
1.586 raeburn 2574: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2575: $autharg,$jscall);
1.1106 raeburn 2576: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2577: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2578: $check5 = ' checked="checked"';
1.80 albertel 2579: } else {
1.772 bisitz 2580: $check4 = ' checked="checked"';
1.80 albertel 2581: }
1.165 raeburn 2582: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2583: if (defined($in{'curr_authtype'})) {
2584: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2585: $krbcheck = ' checked="checked"';
1.623 raeburn 2586: if (defined($in{'mode'})) {
2587: if ($in{'mode'} eq 'modifyuser') {
2588: $krbcheck = '';
2589: }
2590: }
1.591 raeburn 2591: if (defined($in{'curr_kerb_ver'})) {
2592: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2593: $check5 = ' checked="checked"';
1.591 raeburn 2594: $check4 = '';
2595: } else {
1.772 bisitz 2596: $check4 = ' checked="checked"';
1.591 raeburn 2597: $check5 = '';
2598: }
1.586 raeburn 2599: }
1.591 raeburn 2600: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2601: $krbarg = $in{'curr_autharg'};
2602: }
1.586 raeburn 2603: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2604: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2605: $result =
2606: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2607: $in{'curr_autharg'},$krbver);
2608: } else {
2609: $result =
2610: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2611: }
2612: return $result;
2613: }
2614: }
2615: } else {
2616: if ($authnum == 1) {
1.784 bisitz 2617: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2618: }
2619: }
1.586 raeburn 2620: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2621: return;
1.587 raeburn 2622: } elsif ($authtype eq '') {
1.591 raeburn 2623: if (defined($in{'mode'})) {
1.587 raeburn 2624: if ($in{'mode'} eq 'modifycourse') {
2625: if ($authnum == 1) {
1.1104 raeburn 2626: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2627: }
2628: }
2629: }
1.586 raeburn 2630: }
2631: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2632: if ($authtype eq '') {
2633: $authtype = '<input type="radio" name="login" value="krb" '.
2634: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2635: $krbcheck.' />';
2636: }
2637: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2638: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2639: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2640: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2641: $in{'curr_authtype'} eq 'krb4')) {
2642: $result .= &mt
1.144 matthew 2643: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2644: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2645: '<label>'.$authtype,
1.281 albertel 2646: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2647: 'value="'.$krbarg.'" '.
1.144 matthew 2648: 'onchange="'.$jscall.'" />',
1.281 albertel 2649: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2650: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2651: '</label>');
1.586 raeburn 2652: } elsif ($can_assign{'krb4'}) {
2653: $result .= &mt
2654: ('[_1] Kerberos authenticated with domain [_2] '.
2655: '[_3] Version 4 [_4]',
2656: '<label>'.$authtype,
2657: '</label><input type="text" size="10" name="krbarg" '.
2658: 'value="'.$krbarg.'" '.
2659: 'onchange="'.$jscall.'" />',
2660: '<label><input type="hidden" name="krbver" value="4" />',
2661: '</label>');
2662: } elsif ($can_assign{'krb5'}) {
2663: $result .= &mt
2664: ('[_1] Kerberos authenticated with domain [_2] '.
2665: '[_3] Version 5 [_4]',
2666: '<label>'.$authtype,
2667: '</label><input type="text" size="10" name="krbarg" '.
2668: 'value="'.$krbarg.'" '.
2669: 'onchange="'.$jscall.'" />',
2670: '<label><input type="hidden" name="krbver" value="5" />',
2671: '</label>');
2672: }
1.32 matthew 2673: return $result;
2674: }
2675:
1.1106 raeburn 2676: sub authform_internal {
1.586 raeburn 2677: my %in = (
1.32 matthew 2678: formname => 'document.cu',
2679: kerb_def_dom => 'MSU.EDU',
2680: @_,
2681: );
1.586 raeburn 2682: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2683: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2684: if (defined($in{'curr_authtype'})) {
2685: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2686: if ($can_assign{'int'}) {
1.772 bisitz 2687: $intcheck = 'checked="checked" ';
1.623 raeburn 2688: if (defined($in{'mode'})) {
2689: if ($in{'mode'} eq 'modifyuser') {
2690: $intcheck = '';
2691: }
2692: }
1.591 raeburn 2693: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2694: $intarg = $in{'curr_autharg'};
2695: }
2696: } else {
2697: $result = &mt('Currently internally authenticated.');
2698: return $result;
1.165 raeburn 2699: }
2700: }
1.586 raeburn 2701: } else {
2702: if ($authnum == 1) {
1.784 bisitz 2703: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2704: }
2705: }
2706: if (!$can_assign{'int'}) {
2707: return;
1.587 raeburn 2708: } elsif ($authtype eq '') {
1.591 raeburn 2709: if (defined($in{'mode'})) {
1.587 raeburn 2710: if ($in{'mode'} eq 'modifycourse') {
2711: if ($authnum == 1) {
1.1104 raeburn 2712: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2713: }
2714: }
2715: }
1.165 raeburn 2716: }
1.586 raeburn 2717: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2718: if ($authtype eq '') {
2719: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2720: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2721: }
1.605 bisitz 2722: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2723: $intarg.'" onchange="'.$jscall.'" />';
2724: $result = &mt
1.144 matthew 2725: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2726: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2727: $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 2728: return $result;
2729: }
2730:
1.1104 raeburn 2731: sub authform_local {
1.32 matthew 2732: my %in = (
2733: formname => 'document.cu',
2734: kerb_def_dom => 'MSU.EDU',
2735: @_,
2736: );
1.586 raeburn 2737: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2738: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2739: if (defined($in{'curr_authtype'})) {
2740: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2741: if ($can_assign{'loc'}) {
1.772 bisitz 2742: $loccheck = 'checked="checked" ';
1.623 raeburn 2743: if (defined($in{'mode'})) {
2744: if ($in{'mode'} eq 'modifyuser') {
2745: $loccheck = '';
2746: }
2747: }
1.591 raeburn 2748: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2749: $locarg = $in{'curr_autharg'};
2750: }
2751: } else {
2752: $result = &mt('Currently using local (institutional) authentication.');
2753: return $result;
1.165 raeburn 2754: }
2755: }
1.586 raeburn 2756: } else {
2757: if ($authnum == 1) {
1.784 bisitz 2758: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2759: }
2760: }
2761: if (!$can_assign{'loc'}) {
2762: return;
1.587 raeburn 2763: } elsif ($authtype eq '') {
1.591 raeburn 2764: if (defined($in{'mode'})) {
1.587 raeburn 2765: if ($in{'mode'} eq 'modifycourse') {
2766: if ($authnum == 1) {
1.1104 raeburn 2767: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2768: }
2769: }
2770: }
1.165 raeburn 2771: }
1.586 raeburn 2772: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2773: if ($authtype eq '') {
2774: $authtype = '<input type="radio" name="login" value="loc" '.
2775: $loccheck.' onchange="'.$jscall.'" onclick="'.
2776: $jscall.'" />';
2777: }
2778: $autharg = '<input type="text" size="10" name="locarg" value="'.
2779: $locarg.'" onchange="'.$jscall.'" />';
2780: $result = &mt('[_1] Local Authentication with argument [_2]',
2781: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2782: return $result;
2783: }
2784:
1.1106 raeburn 2785: sub authform_filesystem {
1.32 matthew 2786: my %in = (
2787: formname => 'document.cu',
2788: kerb_def_dom => 'MSU.EDU',
2789: @_,
2790: );
1.586 raeburn 2791: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2792: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2793: if (defined($in{'curr_authtype'})) {
2794: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2795: if ($can_assign{'fsys'}) {
1.772 bisitz 2796: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2797: if (defined($in{'mode'})) {
2798: if ($in{'mode'} eq 'modifyuser') {
2799: $fsyscheck = '';
2800: }
2801: }
1.586 raeburn 2802: } else {
2803: $result = &mt('Currently Filesystem Authenticated.');
2804: return $result;
2805: }
2806: }
2807: } else {
2808: if ($authnum == 1) {
1.784 bisitz 2809: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2810: }
2811: }
2812: if (!$can_assign{'fsys'}) {
2813: return;
1.587 raeburn 2814: } elsif ($authtype eq '') {
1.591 raeburn 2815: if (defined($in{'mode'})) {
1.587 raeburn 2816: if ($in{'mode'} eq 'modifycourse') {
2817: if ($authnum == 1) {
1.1104 raeburn 2818: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2819: }
2820: }
2821: }
1.586 raeburn 2822: }
2823: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2824: if ($authtype eq '') {
2825: $authtype = '<input type="radio" name="login" value="fsys" '.
2826: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2827: $jscall.'" />';
2828: }
2829: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2830: ' onchange="'.$jscall.'" />';
2831: $result = &mt
1.144 matthew 2832: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2833: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2834: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2835: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2836: 'onchange="'.$jscall.'" />');
1.32 matthew 2837: return $result;
2838: }
2839:
1.586 raeburn 2840: sub get_assignable_auth {
2841: my ($dom) = @_;
2842: if ($dom eq '') {
2843: $dom = $env{'request.role.domain'};
2844: }
2845: my %can_assign = (
2846: krb4 => 1,
2847: krb5 => 1,
2848: int => 1,
2849: loc => 1,
2850: );
2851: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2852: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2853: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2854: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2855: my $context;
2856: if ($env{'request.role'} =~ /^au/) {
2857: $context = 'author';
2858: } elsif ($env{'request.role'} =~ /^dc/) {
2859: $context = 'domain';
2860: } elsif ($env{'request.course.id'}) {
2861: $context = 'course';
2862: }
2863: if ($context) {
2864: if (ref($authhash->{$context}) eq 'HASH') {
2865: %can_assign = %{$authhash->{$context}};
2866: }
2867: }
2868: }
2869: }
2870: my $authnum = 0;
2871: foreach my $key (keys(%can_assign)) {
2872: if ($can_assign{$key}) {
2873: $authnum ++;
2874: }
2875: }
2876: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2877: $authnum --;
2878: }
2879: return ($authnum,%can_assign);
2880: }
2881:
1.80 albertel 2882: ###############################################################
2883: ## Get Kerberos Defaults for Domain ##
2884: ###############################################################
2885: ##
2886: ## Returns default kerberos version and an associated argument
2887: ## as listed in file domain.tab. If not listed, provides
2888: ## appropriate default domain and kerberos version.
2889: ##
2890: #-------------------------------------------
2891:
2892: =pod
2893:
1.648 raeburn 2894: =item * &get_kerberos_defaults()
1.80 albertel 2895:
2896: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2897: version and domain. If not found, it defaults to version 4 and the
2898: domain of the server.
1.80 albertel 2899:
1.648 raeburn 2900: =over 4
2901:
1.80 albertel 2902: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2903:
1.648 raeburn 2904: =back
2905:
2906: =back
2907:
1.80 albertel 2908: =cut
2909:
2910: #-------------------------------------------
2911: sub get_kerberos_defaults {
2912: my $domain=shift;
1.641 raeburn 2913: my ($krbdef,$krbdefdom);
2914: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2915: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2916: $krbdef = $domdefaults{'auth_def'};
2917: $krbdefdom = $domdefaults{'auth_arg_def'};
2918: } else {
1.80 albertel 2919: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2920: my $krbdefdom=$1;
2921: $krbdefdom=~tr/a-z/A-Z/;
2922: $krbdef = "krb4";
2923: }
2924: return ($krbdef,$krbdefdom);
2925: }
1.112 bowersj2 2926:
1.32 matthew 2927:
1.46 matthew 2928: ###############################################################
2929: ## Thesaurus Functions ##
2930: ###############################################################
1.20 www 2931:
1.46 matthew 2932: =pod
1.20 www 2933:
1.112 bowersj2 2934: =head1 Thesaurus Functions
2935:
2936: =over 4
2937:
1.648 raeburn 2938: =item * &initialize_keywords()
1.46 matthew 2939:
2940: Initializes the package variable %Keywords if it is empty. Uses the
2941: package variable $thesaurus_db_file.
2942:
2943: =cut
2944:
2945: ###################################################
2946:
2947: sub initialize_keywords {
2948: return 1 if (scalar keys(%Keywords));
2949: # If we are here, %Keywords is empty, so fill it up
2950: # Make sure the file we need exists...
2951: if (! -e $thesaurus_db_file) {
2952: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2953: " failed because it does not exist");
2954: return 0;
2955: }
2956: # Set up the hash as a database
2957: my %thesaurus_db;
2958: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2959: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2960: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2961: $thesaurus_db_file);
2962: return 0;
2963: }
2964: # Get the average number of appearances of a word.
2965: my $avecount = $thesaurus_db{'average.count'};
2966: # Put keywords (those that appear > average) into %Keywords
2967: while (my ($word,$data)=each (%thesaurus_db)) {
2968: my ($count,undef) = split /:/,$data;
2969: $Keywords{$word}++ if ($count > $avecount);
2970: }
2971: untie %thesaurus_db;
2972: # Remove special values from %Keywords.
1.356 albertel 2973: foreach my $value ('total.count','average.count') {
2974: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2975: }
1.46 matthew 2976: return 1;
2977: }
2978:
2979: ###################################################
2980:
2981: =pod
2982:
1.648 raeburn 2983: =item * &keyword($word)
1.46 matthew 2984:
2985: Returns true if $word is a keyword. A keyword is a word that appears more
2986: than the average number of times in the thesaurus database. Calls
2987: &initialize_keywords
2988:
2989: =cut
2990:
2991: ###################################################
1.20 www 2992:
2993: sub keyword {
1.46 matthew 2994: return if (!&initialize_keywords());
2995: my $word=lc(shift());
2996: $word=~s/\W//g;
2997: return exists($Keywords{$word});
1.20 www 2998: }
1.46 matthew 2999:
3000: ###############################################################
3001:
3002: =pod
1.20 www 3003:
1.648 raeburn 3004: =item * &get_related_words()
1.46 matthew 3005:
1.160 matthew 3006: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3007: an array of words. If the keyword is not in the thesaurus, an empty array
3008: will be returned. The order of the words returned is determined by the
3009: database which holds them.
3010:
3011: Uses global $thesaurus_db_file.
3012:
1.1057 foxr 3013:
1.46 matthew 3014: =cut
3015:
3016: ###############################################################
3017: sub get_related_words {
3018: my $keyword = shift;
3019: my %thesaurus_db;
3020: if (! -e $thesaurus_db_file) {
3021: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3022: "failed because the file does not exist");
3023: return ();
3024: }
3025: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3026: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3027: return ();
3028: }
3029: my @Words=();
1.429 www 3030: my $count=0;
1.46 matthew 3031: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3032: # The first element is the number of times
3033: # the word appears. We do not need it now.
1.429 www 3034: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3035: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3036: my $threshold=$mostfrequentcount/10;
3037: foreach my $possibleword (@RelatedWords) {
3038: my ($word,$wordcount)=split(/\,/,$possibleword);
3039: if ($wordcount>$threshold) {
3040: push(@Words,$word);
3041: $count++;
3042: if ($count>10) { last; }
3043: }
1.20 www 3044: }
3045: }
1.46 matthew 3046: untie %thesaurus_db;
3047: return @Words;
1.14 harris41 3048: }
1.1090 foxr 3049: ###############################################################
3050: #
3051: # Spell checking
3052: #
3053:
3054: =pod
3055:
3056: =head1 Spell checking
3057:
3058: =over 4
3059:
3060: =item * &check_spelling($wordlist $language)
3061:
3062: Takes a string containing words and feeds it to an external
3063: spellcheck program via a pipeline. Returns a string containing
3064: them mis-spelled words.
3065:
3066: Parameters:
3067:
3068: =over 4
3069:
3070: =item - $wordlist
3071:
3072: String that will be fed into the spellcheck program.
3073:
3074: =item - $language
3075:
3076: Language string that specifies the language for which the spell
3077: check will be performed.
3078:
3079: =back
3080:
3081: =back
3082:
3083: Note: This sub assumes that aspell is installed.
3084:
3085:
3086: =cut
3087:
1.46 matthew 3088:
1.112 bowersj2 3089: =pod
3090:
3091: =back
3092:
3093: =cut
1.61 www 3094:
1.1090 foxr 3095: sub check_spelling {
3096: my ($wordlist, $language) = @_;
1.1091 foxr 3097: my @misspellings;
3098:
3099: # Generate the speller and set the langauge.
3100: # if explicitly selected:
1.1090 foxr 3101:
1.1091 foxr 3102: my $speller = Text::Aspell->new;
1.1090 foxr 3103: if ($language) {
1.1091 foxr 3104: $speller->set_option('lang', $language);
1.1090 foxr 3105: }
3106:
1.1091 foxr 3107: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3108:
1.1091 foxr 3109: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3110:
1.1091 foxr 3111: foreach my $word (@words) {
3112: if(! $speller->check($word)) {
3113: push(@misspellings, $word);
1.1090 foxr 3114: }
3115: }
1.1091 foxr 3116: return join(' ', @misspellings);
3117:
1.1090 foxr 3118: }
3119:
1.61 www 3120: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3121: =pod
3122:
1.112 bowersj2 3123: =head1 User Name Functions
3124:
3125: =over 4
3126:
1.648 raeburn 3127: =item * &plainname($uname,$udom,$first)
1.81 albertel 3128:
1.112 bowersj2 3129: Takes a users logon name and returns it as a string in
1.226 albertel 3130: "first middle last generation" form
3131: if $first is set to 'lastname' then it returns it as
3132: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3133:
3134: =cut
1.61 www 3135:
1.295 www 3136:
1.81 albertel 3137: ###############################################################
1.61 www 3138: sub plainname {
1.226 albertel 3139: my ($uname,$udom,$first)=@_;
1.537 albertel 3140: return if (!defined($uname) || !defined($udom));
1.295 www 3141: my %names=&getnames($uname,$udom);
1.226 albertel 3142: my $name=&Apache::lonnet::format_name($names{'firstname'},
3143: $names{'middlename'},
3144: $names{'lastname'},
3145: $names{'generation'},$first);
3146: $name=~s/^\s+//;
1.62 www 3147: $name=~s/\s+$//;
3148: $name=~s/\s+/ /g;
1.353 albertel 3149: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3150: return $name;
1.61 www 3151: }
1.66 www 3152:
3153: # -------------------------------------------------------------------- Nickname
1.81 albertel 3154: =pod
3155:
1.648 raeburn 3156: =item * &nickname($uname,$udom)
1.81 albertel 3157:
3158: Gets a users name and returns it as a string as
3159:
3160: ""nickname""
1.66 www 3161:
1.81 albertel 3162: if the user has a nickname or
3163:
3164: "first middle last generation"
3165:
3166: if the user does not
3167:
3168: =cut
1.66 www 3169:
3170: sub nickname {
3171: my ($uname,$udom)=@_;
1.537 albertel 3172: return if (!defined($uname) || !defined($udom));
1.295 www 3173: my %names=&getnames($uname,$udom);
1.68 albertel 3174: my $name=$names{'nickname'};
1.66 www 3175: if ($name) {
3176: $name='"'.$name.'"';
3177: } else {
3178: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3179: $names{'lastname'}.' '.$names{'generation'};
3180: $name=~s/\s+$//;
3181: $name=~s/\s+/ /g;
3182: }
3183: return $name;
3184: }
3185:
1.295 www 3186: sub getnames {
3187: my ($uname,$udom)=@_;
1.537 albertel 3188: return if (!defined($uname) || !defined($udom));
1.433 albertel 3189: if ($udom eq 'public' && $uname eq 'public') {
3190: return ('lastname' => &mt('Public'));
3191: }
1.295 www 3192: my $id=$uname.':'.$udom;
3193: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3194: if ($cached) {
3195: return %{$names};
3196: } else {
3197: my %loadnames=&Apache::lonnet::get('environment',
3198: ['firstname','middlename','lastname','generation','nickname'],
3199: $udom,$uname);
3200: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3201: return %loadnames;
3202: }
3203: }
1.61 www 3204:
1.542 raeburn 3205: # -------------------------------------------------------------------- getemails
1.648 raeburn 3206:
1.542 raeburn 3207: =pod
3208:
1.648 raeburn 3209: =item * &getemails($uname,$udom)
1.542 raeburn 3210:
3211: Gets a user's email information and returns it as a hash with keys:
3212: notification, critnotification, permanentemail
3213:
3214: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3215: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3216:
1.648 raeburn 3217:
1.542 raeburn 3218: =cut
3219:
1.648 raeburn 3220:
1.466 albertel 3221: sub getemails {
3222: my ($uname,$udom)=@_;
3223: if ($udom eq 'public' && $uname eq 'public') {
3224: return;
3225: }
1.467 www 3226: if (!$udom) { $udom=$env{'user.domain'}; }
3227: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3228: my $id=$uname.':'.$udom;
3229: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3230: if ($cached) {
3231: return %{$names};
3232: } else {
3233: my %loadnames=&Apache::lonnet::get('environment',
3234: ['notification','critnotification',
3235: 'permanentemail'],
3236: $udom,$uname);
3237: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3238: return %loadnames;
3239: }
3240: }
3241:
1.551 albertel 3242: sub flush_email_cache {
3243: my ($uname,$udom)=@_;
3244: if (!$udom) { $udom =$env{'user.domain'}; }
3245: if (!$uname) { $uname=$env{'user.name'}; }
3246: return if ($udom eq 'public' && $uname eq 'public');
3247: my $id=$uname.':'.$udom;
3248: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3249: }
3250:
1.728 raeburn 3251: # -------------------------------------------------------------------- getlangs
3252:
3253: =pod
3254:
3255: =item * &getlangs($uname,$udom)
3256:
3257: Gets a user's language preference and returns it as a hash with key:
3258: language.
3259:
3260: =cut
3261:
3262:
3263: sub getlangs {
3264: my ($uname,$udom) = @_;
3265: if (!$udom) { $udom =$env{'user.domain'}; }
3266: if (!$uname) { $uname=$env{'user.name'}; }
3267: my $id=$uname.':'.$udom;
3268: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3269: if ($cached) {
3270: return %{$langs};
3271: } else {
3272: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3273: $udom,$uname);
3274: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3275: return %loadlangs;
3276: }
3277: }
3278:
3279: sub flush_langs_cache {
3280: my ($uname,$udom)=@_;
3281: if (!$udom) { $udom =$env{'user.domain'}; }
3282: if (!$uname) { $uname=$env{'user.name'}; }
3283: return if ($udom eq 'public' && $uname eq 'public');
3284: my $id=$uname.':'.$udom;
3285: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3286: }
3287:
1.61 www 3288: # ------------------------------------------------------------------ Screenname
1.81 albertel 3289:
3290: =pod
3291:
1.648 raeburn 3292: =item * &screenname($uname,$udom)
1.81 albertel 3293:
3294: Gets a users screenname and returns it as a string
3295:
3296: =cut
1.61 www 3297:
3298: sub screenname {
3299: my ($uname,$udom)=@_;
1.258 albertel 3300: if ($uname eq $env{'user.name'} &&
3301: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3302: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3303: return $names{'screenname'};
1.62 www 3304: }
3305:
1.212 albertel 3306:
1.802 bisitz 3307: # ------------------------------------------------------------- Confirm Wrapper
3308: =pod
3309:
3310: =item confirmwrapper
3311:
3312: Wrap messages about completion of operation in box
3313:
3314: =cut
3315:
3316: sub confirmwrapper {
3317: my ($message)=@_;
3318: if ($message) {
3319: return "\n".'<div class="LC_confirm_box">'."\n"
3320: .$message."\n"
3321: .'</div>'."\n";
3322: } else {
3323: return $message;
3324: }
3325: }
3326:
1.62 www 3327: # ------------------------------------------------------------- Message Wrapper
3328:
3329: sub messagewrapper {
1.369 www 3330: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3331: return
1.441 albertel 3332: '<a href="/adm/email?compose=individual&'.
3333: 'recname='.$username.'&recdom='.$domain.
3334: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3335: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3336: }
1.802 bisitz 3337:
1.74 www 3338: # --------------------------------------------------------------- Notes Wrapper
3339:
3340: sub noteswrapper {
3341: my ($link,$un,$do)=@_;
3342: return
1.896 amueller 3343: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3344: }
1.802 bisitz 3345:
1.62 www 3346: # ------------------------------------------------------------- Aboutme Wrapper
3347:
3348: sub aboutmewrapper {
1.1070 raeburn 3349: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3350: if (!defined($username) && !defined($domain)) {
3351: return;
3352: }
1.1096 raeburn 3353: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3354: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3355: }
3356:
3357: # ------------------------------------------------------------ Syllabus Wrapper
3358:
3359: sub syllabuswrapper {
1.707 bisitz 3360: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3361: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3362: }
1.14 harris41 3363:
1.802 bisitz 3364: # -----------------------------------------------------------------------------
3365:
1.208 matthew 3366: sub track_student_link {
1.887 raeburn 3367: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3368: my $link ="/adm/trackstudent?";
1.208 matthew 3369: my $title = 'View recent activity';
3370: if (defined($sname) && $sname !~ /^\s*$/ &&
3371: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3372: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3373: $title .= ' of this student';
1.268 albertel 3374: }
1.208 matthew 3375: if (defined($target) && $target !~ /^\s*$/) {
3376: $target = qq{target="$target"};
3377: } else {
3378: $target = '';
3379: }
1.268 albertel 3380: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3381: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3382: $title = &mt($title);
3383: $linktext = &mt($linktext);
1.448 albertel 3384: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3385: &help_open_topic('View_recent_activity');
1.208 matthew 3386: }
3387:
1.781 raeburn 3388: sub slot_reservations_link {
3389: my ($linktext,$sname,$sdom,$target) = @_;
3390: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3391: my $title = 'View slot reservation history';
3392: if (defined($sname) && $sname !~ /^\s*$/ &&
3393: defined($sdom) && $sdom !~ /^\s*$/) {
3394: $link .= "&uname=$sname&udom=$sdom";
3395: $title .= ' of this student';
3396: }
3397: if (defined($target) && $target !~ /^\s*$/) {
3398: $target = qq{target="$target"};
3399: } else {
3400: $target = '';
3401: }
3402: $title = &mt($title);
3403: $linktext = &mt($linktext);
3404: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3405: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3406:
3407: }
3408:
1.508 www 3409: # ===================================================== Display a student photo
3410:
3411:
1.509 albertel 3412: sub student_image_tag {
1.508 www 3413: my ($domain,$user)=@_;
3414: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3415: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3416: return '<img src="'.$imgsrc.'" align="right" />';
3417: } else {
3418: return '';
3419: }
3420: }
3421:
1.112 bowersj2 3422: =pod
3423:
3424: =back
3425:
3426: =head1 Access .tab File Data
3427:
3428: =over 4
3429:
1.648 raeburn 3430: =item * &languageids()
1.112 bowersj2 3431:
3432: returns list of all language ids
3433:
3434: =cut
3435:
1.14 harris41 3436: sub languageids {
1.16 harris41 3437: return sort(keys(%language));
1.14 harris41 3438: }
3439:
1.112 bowersj2 3440: =pod
3441:
1.648 raeburn 3442: =item * &languagedescription()
1.112 bowersj2 3443:
3444: returns description of a specified language id
3445:
3446: =cut
3447:
1.14 harris41 3448: sub languagedescription {
1.125 www 3449: my $code=shift;
3450: return ($supported_language{$code}?'* ':'').
3451: $language{$code}.
1.126 www 3452: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3453: }
3454:
1.1048 foxr 3455: =pod
3456:
3457: =item * &plainlanguagedescription
3458:
3459: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3460: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3461:
3462: =cut
3463:
1.145 www 3464: sub plainlanguagedescription {
3465: my $code=shift;
3466: return $language{$code};
3467: }
3468:
1.1048 foxr 3469: =pod
3470:
3471: =item * &supportedlanguagecode
3472:
3473: Returns the supported language code (e.g. sptutf maps to pt) given a language
3474: code.
3475:
3476: =cut
3477:
1.145 www 3478: sub supportedlanguagecode {
3479: my $code=shift;
3480: return $supported_language{$code};
1.97 www 3481: }
3482:
1.112 bowersj2 3483: =pod
3484:
1.1048 foxr 3485: =item * &latexlanguage()
3486:
3487: Given a language key code returns the correspondnig language to use
3488: to select the correct hyphenation on LaTeX printouts. This is undef if there
3489: is no supported hyphenation for the language code.
3490:
3491: =cut
3492:
3493: sub latexlanguage {
3494: my $code = shift;
3495: return $latex_language{$code};
3496: }
3497:
3498: =pod
3499:
3500: =item * &latexhyphenation()
3501:
3502: Same as above but what's supplied is the language as it might be stored
3503: in the metadata.
3504:
3505: =cut
3506:
3507: sub latexhyphenation {
3508: my $key = shift;
3509: return $latex_language_bykey{$key};
3510: }
3511:
3512: =pod
3513:
1.648 raeburn 3514: =item * ©rightids()
1.112 bowersj2 3515:
3516: returns list of all copyrights
3517:
3518: =cut
3519:
3520: sub copyrightids {
3521: return sort(keys(%cprtag));
3522: }
3523:
3524: =pod
3525:
1.648 raeburn 3526: =item * ©rightdescription()
1.112 bowersj2 3527:
3528: returns description of a specified copyright id
3529:
3530: =cut
3531:
3532: sub copyrightdescription {
1.166 www 3533: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3534: }
1.197 matthew 3535:
3536: =pod
3537:
1.648 raeburn 3538: =item * &source_copyrightids()
1.192 taceyjo1 3539:
3540: returns list of all source copyrights
3541:
3542: =cut
3543:
3544: sub source_copyrightids {
3545: return sort(keys(%scprtag));
3546: }
3547:
3548: =pod
3549:
1.648 raeburn 3550: =item * &source_copyrightdescription()
1.192 taceyjo1 3551:
3552: returns description of a specified source copyright id
3553:
3554: =cut
3555:
3556: sub source_copyrightdescription {
3557: return &mt($scprtag{shift(@_)});
3558: }
1.112 bowersj2 3559:
3560: =pod
3561:
1.648 raeburn 3562: =item * &filecategories()
1.112 bowersj2 3563:
3564: returns list of all file categories
3565:
3566: =cut
3567:
3568: sub filecategories {
3569: return sort(keys(%category_extensions));
3570: }
3571:
3572: =pod
3573:
1.648 raeburn 3574: =item * &filecategorytypes()
1.112 bowersj2 3575:
3576: returns list of file types belonging to a given file
3577: category
3578:
3579: =cut
3580:
3581: sub filecategorytypes {
1.356 albertel 3582: my ($cat) = @_;
3583: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3584: }
3585:
3586: =pod
3587:
1.648 raeburn 3588: =item * &fileembstyle()
1.112 bowersj2 3589:
3590: returns embedding style for a specified file type
3591:
3592: =cut
3593:
3594: sub fileembstyle {
3595: return $fe{lc(shift(@_))};
1.169 www 3596: }
3597:
1.351 www 3598: sub filemimetype {
3599: return $fm{lc(shift(@_))};
3600: }
3601:
1.169 www 3602:
3603: sub filecategoryselect {
3604: my ($name,$value)=@_;
1.189 matthew 3605: return &select_form($value,$name,
1.970 raeburn 3606: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3607: }
3608:
3609: =pod
3610:
1.648 raeburn 3611: =item * &filedescription()
1.112 bowersj2 3612:
3613: returns description for a specified file type
3614:
3615: =cut
3616:
3617: sub filedescription {
1.188 matthew 3618: my $file_description = $fd{lc(shift())};
3619: $file_description =~ s:([\[\]]):~$1:g;
3620: return &mt($file_description);
1.112 bowersj2 3621: }
3622:
3623: =pod
3624:
1.648 raeburn 3625: =item * &filedescriptionex()
1.112 bowersj2 3626:
3627: returns description for a specified file type with
3628: extra formatting
3629:
3630: =cut
3631:
3632: sub filedescriptionex {
3633: my $ex=shift;
1.188 matthew 3634: my $file_description = $fd{lc($ex)};
3635: $file_description =~ s:([\[\]]):~$1:g;
3636: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3637: }
3638:
3639: # End of .tab access
3640: =pod
3641:
3642: =back
3643:
3644: =cut
3645:
3646: # ------------------------------------------------------------------ File Types
3647: sub fileextensions {
3648: return sort(keys(%fe));
3649: }
3650:
1.97 www 3651: # ----------------------------------------------------------- Display Languages
3652: # returns a hash with all desired display languages
3653: #
3654:
3655: sub display_languages {
3656: my %languages=();
1.695 raeburn 3657: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3658: $languages{$lang}=1;
1.97 www 3659: }
3660: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3661: if ($env{'form.displaylanguage'}) {
1.356 albertel 3662: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3663: $languages{$lang}=1;
1.97 www 3664: }
3665: }
3666: return %languages;
1.14 harris41 3667: }
3668:
1.582 albertel 3669: sub languages {
3670: my ($possible_langs) = @_;
1.695 raeburn 3671: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3672: if (!ref($possible_langs)) {
3673: if( wantarray ) {
3674: return @preferred_langs;
3675: } else {
3676: return $preferred_langs[0];
3677: }
3678: }
3679: my %possibilities = map { $_ => 1 } (@$possible_langs);
3680: my @preferred_possibilities;
3681: foreach my $preferred_lang (@preferred_langs) {
3682: if (exists($possibilities{$preferred_lang})) {
3683: push(@preferred_possibilities, $preferred_lang);
3684: }
3685: }
3686: if( wantarray ) {
3687: return @preferred_possibilities;
3688: }
3689: return $preferred_possibilities[0];
3690: }
3691:
1.742 raeburn 3692: sub user_lang {
3693: my ($touname,$toudom,$fromcid) = @_;
3694: my @userlangs;
3695: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3696: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3697: $env{'course.'.$fromcid.'.languages'}));
3698: } else {
3699: my %langhash = &getlangs($touname,$toudom);
3700: if ($langhash{'languages'} ne '') {
3701: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3702: } else {
3703: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3704: if ($domdefs{'lang_def'} ne '') {
3705: @userlangs = ($domdefs{'lang_def'});
3706: }
3707: }
3708: }
3709: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3710: my $user_lh = Apache::localize->get_handle(@languages);
3711: return $user_lh;
3712: }
3713:
3714:
1.112 bowersj2 3715: ###############################################################
3716: ## Student Answer Attempts ##
3717: ###############################################################
3718:
3719: =pod
3720:
3721: =head1 Alternate Problem Views
3722:
3723: =over 4
3724:
1.648 raeburn 3725: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112 bowersj2 3726: $getattempt, $regexp, $gradesub)
3727:
3728: Return string with previous attempt on problem. Arguments:
3729:
3730: =over 4
3731:
3732: =item * $symb: Problem, including path
3733:
3734: =item * $username: username of the desired student
3735:
3736: =item * $domain: domain of the desired student
1.14 harris41 3737:
1.112 bowersj2 3738: =item * $course: Course ID
1.14 harris41 3739:
1.112 bowersj2 3740: =item * $getattempt: Leave blank for all attempts, otherwise put
3741: something
1.14 harris41 3742:
1.112 bowersj2 3743: =item * $regexp: if string matches this regexp, the string will be
3744: sent to $gradesub
1.14 harris41 3745:
1.112 bowersj2 3746: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3747:
1.112 bowersj2 3748: =back
1.14 harris41 3749:
1.112 bowersj2 3750: The output string is a table containing all desired attempts, if any.
1.16 harris41 3751:
1.112 bowersj2 3752: =cut
1.1 albertel 3753:
3754: sub get_previous_attempt {
1.43 ng 3755: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 3756: my $prevattempts='';
1.43 ng 3757: no strict 'refs';
1.1 albertel 3758: if ($symb) {
1.3 albertel 3759: my (%returnhash)=
3760: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3761: if ($returnhash{'version'}) {
3762: my %lasthash=();
3763: my $version;
3764: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3765: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3766: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3767: }
1.1 albertel 3768: }
1.596 albertel 3769: $prevattempts=&start_data_table().&start_data_table_header_row();
3770: $prevattempts.='<th>'.&mt('History').'</th>';
1.978 raeburn 3771: my (%typeparts,%lasthidden);
1.945 raeburn 3772: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3773: foreach my $key (sort(keys(%lasthash))) {
3774: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3775: if ($#parts > 0) {
1.31 albertel 3776: my $data=$parts[-1];
1.989 raeburn 3777: next if ($data eq 'foilorder');
1.31 albertel 3778: pop(@parts);
1.1010 www 3779: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3780: if ($data eq 'type') {
3781: unless ($showsurv) {
3782: my $id = join(',',@parts);
3783: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3784: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3785: $lasthidden{$ign.'.'.$id} = 1;
3786: }
1.945 raeburn 3787: }
1.1010 www 3788: }
1.31 albertel 3789: } else {
1.41 ng 3790: if ($#parts == 0) {
3791: $prevattempts.='<th>'.$parts[0].'</th>';
3792: } else {
3793: $prevattempts.='<th>'.$ign.'</th>';
3794: }
1.31 albertel 3795: }
1.16 harris41 3796: }
1.596 albertel 3797: $prevattempts.=&end_data_table_header_row();
1.40 ng 3798: if ($getattempt eq '') {
3799: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945 raeburn 3800: my @hidden;
3801: if (%typeparts) {
3802: foreach my $id (keys(%typeparts)) {
3803: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
3804: push(@hidden,$id);
3805: }
3806: }
3807: }
3808: $prevattempts.=&start_data_table_row().
3809: '<td>'.&mt('Transaction [_1]',$version).'</td>';
3810: if (@hidden) {
3811: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3812: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3813: my $hide;
3814: foreach my $id (@hidden) {
3815: if ($key =~ /^\Q$id\E/) {
3816: $hide = 1;
3817: last;
3818: }
3819: }
3820: if ($hide) {
3821: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3822: if (($data eq 'award') || ($data eq 'awarddetail')) {
3823: my $value = &format_previous_attempt_value($key,
3824: $returnhash{$version.':'.$key});
3825: $prevattempts.='<td>'.$value.' </td>';
3826: } else {
3827: $prevattempts.='<td> </td>';
3828: }
3829: } else {
3830: if ($key =~ /\./) {
3831: my $value = &format_previous_attempt_value($key,
3832: $returnhash{$version.':'.$key});
3833: $prevattempts.='<td>'.$value.' </td>';
3834: } else {
3835: $prevattempts.='<td> </td>';
3836: }
3837: }
3838: }
3839: } else {
3840: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3841: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3842: my $value = &format_previous_attempt_value($key,
3843: $returnhash{$version.':'.$key});
3844: $prevattempts.='<td>'.$value.' </td>';
3845: }
3846: }
3847: $prevattempts.=&end_data_table_row();
1.40 ng 3848: }
1.1 albertel 3849: }
1.945 raeburn 3850: my @currhidden = keys(%lasthidden);
1.596 albertel 3851: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3852: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3853: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3854: if (%typeparts) {
3855: my $hidden;
3856: foreach my $id (@currhidden) {
3857: if ($key =~ /^\Q$id\E/) {
3858: $hidden = 1;
3859: last;
3860: }
3861: }
3862: if ($hidden) {
3863: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3864: if (($data eq 'award') || ($data eq 'awarddetail')) {
3865: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3866: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3867: $value = &$gradesub($value);
3868: }
3869: $prevattempts.='<td>'.$value.' </td>';
3870: } else {
3871: $prevattempts.='<td> </td>';
3872: }
3873: } else {
3874: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3875: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3876: $value = &$gradesub($value);
3877: }
3878: $prevattempts.='<td>'.$value.' </td>';
3879: }
3880: } else {
3881: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3882: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3883: $value = &$gradesub($value);
3884: }
3885: $prevattempts.='<td>'.$value.' </td>';
3886: }
1.16 harris41 3887: }
1.596 albertel 3888: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3889: } else {
1.596 albertel 3890: $prevattempts=
3891: &start_data_table().&start_data_table_row().
3892: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3893: &end_data_table_row().&end_data_table();
1.1 albertel 3894: }
3895: } else {
1.596 albertel 3896: $prevattempts=
3897: &start_data_table().&start_data_table_row().
3898: '<td>'.&mt('No data.').'</td>'.
3899: &end_data_table_row().&end_data_table();
1.1 albertel 3900: }
1.10 albertel 3901: }
3902:
1.581 albertel 3903: sub format_previous_attempt_value {
3904: my ($key,$value) = @_;
1.1011 www 3905: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3906: $value = &Apache::lonlocal::locallocaltime($value);
3907: } elsif (ref($value) eq 'ARRAY') {
3908: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3909: } elsif ($key =~ /answerstring$/) {
3910: my %answers = &Apache::lonnet::str2hash($value);
3911: my @anskeys = sort(keys(%answers));
3912: if (@anskeys == 1) {
3913: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3914: if ($answer =~ m{\0}) {
3915: $answer =~ s{\0}{,}g;
1.988 raeburn 3916: }
3917: my $tag_internal_answer_name = 'INTERNAL';
3918: if ($anskeys[0] eq $tag_internal_answer_name) {
3919: $value = $answer;
3920: } else {
3921: $value = $anskeys[0].'='.$answer;
3922: }
3923: } else {
3924: foreach my $ans (@anskeys) {
3925: my $answer = $answers{$ans};
1.1001 raeburn 3926: if ($answer =~ m{\0}) {
3927: $answer =~ s{\0}{,}g;
1.988 raeburn 3928: }
3929: $value .= $ans.'='.$answer.'<br />';;
3930: }
3931: }
1.581 albertel 3932: } else {
3933: $value = &unescape($value);
3934: }
3935: return $value;
3936: }
3937:
3938:
1.107 albertel 3939: sub relative_to_absolute {
3940: my ($url,$output)=@_;
3941: my $parser=HTML::TokeParser->new(\$output);
3942: my $token;
3943: my $thisdir=$url;
3944: my @rlinks=();
3945: while ($token=$parser->get_token) {
3946: if ($token->[0] eq 'S') {
3947: if ($token->[1] eq 'a') {
3948: if ($token->[2]->{'href'}) {
3949: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3950: }
3951: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3952: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3953: } elsif ($token->[1] eq 'base') {
3954: $thisdir=$token->[2]->{'href'};
3955: }
3956: }
3957: }
3958: $thisdir=~s-/[^/]*$--;
1.356 albertel 3959: foreach my $link (@rlinks) {
1.726 raeburn 3960: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3961: ($link=~/^\//) ||
3962: ($link=~/^javascript:/i) ||
3963: ($link=~/^mailto:/i) ||
3964: ($link=~/^\#/)) {
3965: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3966: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 3967: }
3968: }
3969: # -------------------------------------------------- Deal with Applet codebases
3970: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
3971: return $output;
3972: }
3973:
1.112 bowersj2 3974: =pod
3975:
1.648 raeburn 3976: =item * &get_student_view()
1.112 bowersj2 3977:
3978: show a snapshot of what student was looking at
3979:
3980: =cut
3981:
1.10 albertel 3982: sub get_student_view {
1.186 albertel 3983: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 3984: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 3985: my (%form);
1.10 albertel 3986: my @elements=('symb','courseid','domain','username');
3987: foreach my $element (@elements) {
1.186 albertel 3988: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 3989: }
1.186 albertel 3990: if (defined($moreenv)) {
3991: %form=(%form,%{$moreenv});
3992: }
1.236 albertel 3993: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 3994: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 3995: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 3996: $userview=~s/\<body[^\>]*\>//gi;
3997: $userview=~s/\<\/body\>//gi;
3998: $userview=~s/\<html\>//gi;
3999: $userview=~s/\<\/html\>//gi;
4000: $userview=~s/\<head\>//gi;
4001: $userview=~s/\<\/head\>//gi;
4002: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4003: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4004: if (wantarray) {
4005: return ($userview,$response);
4006: } else {
4007: return $userview;
4008: }
4009: }
4010:
4011: sub get_student_view_with_retries {
4012: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4013:
4014: my $ok = 0; # True if we got a good response.
4015: my $content;
4016: my $response;
4017:
4018: # Try to get the student_view done. within the retries count:
4019:
4020: do {
4021: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4022: $ok = $response->is_success;
4023: if (!$ok) {
4024: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4025: }
4026: $retries--;
4027: } while (!$ok && ($retries > 0));
4028:
4029: if (!$ok) {
4030: $content = ''; # On error return an empty content.
4031: }
1.651 www 4032: if (wantarray) {
4033: return ($content, $response);
4034: } else {
4035: return $content;
4036: }
1.11 albertel 4037: }
4038:
1.112 bowersj2 4039: =pod
4040:
1.648 raeburn 4041: =item * &get_student_answers()
1.112 bowersj2 4042:
4043: show a snapshot of how student was answering problem
4044:
4045: =cut
4046:
1.11 albertel 4047: sub get_student_answers {
1.100 sakharuk 4048: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4049: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4050: my (%moreenv);
1.11 albertel 4051: my @elements=('symb','courseid','domain','username');
4052: foreach my $element (@elements) {
1.186 albertel 4053: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4054: }
1.186 albertel 4055: $moreenv{'grade_target'}='answer';
4056: %moreenv=(%form,%moreenv);
1.497 raeburn 4057: $feedurl = &Apache::lonnet::clutter($feedurl);
4058: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4059: return $userview;
1.1 albertel 4060: }
1.116 albertel 4061:
4062: =pod
4063:
4064: =item * &submlink()
4065:
1.242 albertel 4066: Inputs: $text $uname $udom $symb $target
1.116 albertel 4067:
4068: Returns: A link to grades.pm such as to see the SUBM view of a student
4069:
4070: =cut
4071:
4072: ###############################################
4073: sub submlink {
1.242 albertel 4074: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4075: if (!($uname && $udom)) {
4076: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4077: &Apache::lonnet::whichuser($symb);
1.116 albertel 4078: if (!$symb) { $symb=$cursymb; }
4079: }
1.254 matthew 4080: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4081: $symb=&escape($symb);
1.960 bisitz 4082: if ($target) { $target=" target=\"$target\""; }
4083: return
4084: '<a href="/adm/grades?command=submission'.
4085: '&symb='.$symb.
4086: '&student='.$uname.
4087: '&userdom='.$udom.'"'.
4088: $target.'>'.$text.'</a>';
1.242 albertel 4089: }
4090: ##############################################
4091:
4092: =pod
4093:
4094: =item * &pgrdlink()
4095:
4096: Inputs: $text $uname $udom $symb $target
4097:
4098: Returns: A link to grades.pm such as to see the PGRD view of a student
4099:
4100: =cut
4101:
4102: ###############################################
4103: sub pgrdlink {
4104: my $link=&submlink(@_);
4105: $link=~s/(&command=submission)/$1&showgrading=yes/;
4106: return $link;
4107: }
4108: ##############################################
4109:
4110: =pod
4111:
4112: =item * &pprmlink()
4113:
4114: Inputs: $text $uname $udom $symb $target
4115:
4116: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4117: student and a specific resource
1.242 albertel 4118:
4119: =cut
4120:
4121: ###############################################
4122: sub pprmlink {
4123: my ($text,$uname,$udom,$symb,$target)=@_;
4124: if (!($uname && $udom)) {
4125: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4126: &Apache::lonnet::whichuser($symb);
1.242 albertel 4127: if (!$symb) { $symb=$cursymb; }
4128: }
1.254 matthew 4129: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4130: $symb=&escape($symb);
1.242 albertel 4131: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4132: return '<a href="/adm/parmset?command=set&'.
4133: 'symb='.$symb.'&uname='.$uname.
4134: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4135: }
4136: ##############################################
1.37 matthew 4137:
1.112 bowersj2 4138: =pod
4139:
4140: =back
4141:
4142: =cut
4143:
1.37 matthew 4144: ###############################################
1.51 www 4145:
4146:
4147: sub timehash {
1.687 raeburn 4148: my ($thistime) = @_;
4149: my $timezone = &Apache::lonlocal::gettimezone();
4150: my $dt = DateTime->from_epoch(epoch => $thistime)
4151: ->set_time_zone($timezone);
4152: my $wday = $dt->day_of_week();
4153: if ($wday == 7) { $wday = 0; }
4154: return ( 'second' => $dt->second(),
4155: 'minute' => $dt->minute(),
4156: 'hour' => $dt->hour(),
4157: 'day' => $dt->day_of_month(),
4158: 'month' => $dt->month(),
4159: 'year' => $dt->year(),
4160: 'weekday' => $wday,
4161: 'dayyear' => $dt->day_of_year(),
4162: 'dlsav' => $dt->is_dst() );
1.51 www 4163: }
4164:
1.370 www 4165: sub utc_string {
4166: my ($date)=@_;
1.371 www 4167: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4168: }
4169:
1.51 www 4170: sub maketime {
4171: my %th=@_;
1.687 raeburn 4172: my ($epoch_time,$timezone,$dt);
4173: $timezone = &Apache::lonlocal::gettimezone();
4174: eval {
4175: $dt = DateTime->new( year => $th{'year'},
4176: month => $th{'month'},
4177: day => $th{'day'},
4178: hour => $th{'hour'},
4179: minute => $th{'minute'},
4180: second => $th{'second'},
4181: time_zone => $timezone,
4182: );
4183: };
4184: if (!$@) {
4185: $epoch_time = $dt->epoch;
4186: if ($epoch_time) {
4187: return $epoch_time;
4188: }
4189: }
1.51 www 4190: return POSIX::mktime(
4191: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4192: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4193: }
4194:
4195: #########################################
1.51 www 4196:
4197: sub findallcourses {
1.482 raeburn 4198: my ($roles,$uname,$udom) = @_;
1.355 albertel 4199: my %roles;
4200: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4201: my %courses;
1.51 www 4202: my $now=time;
1.482 raeburn 4203: if (!defined($uname)) {
4204: $uname = $env{'user.name'};
4205: }
4206: if (!defined($udom)) {
4207: $udom = $env{'user.domain'};
4208: }
4209: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4210: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4211: if (!%roles) {
4212: %roles = (
4213: cc => 1,
1.907 raeburn 4214: co => 1,
1.482 raeburn 4215: in => 1,
4216: ep => 1,
4217: ta => 1,
4218: cr => 1,
4219: st => 1,
4220: );
4221: }
4222: foreach my $entry (keys(%roleshash)) {
4223: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4224: if ($trole =~ /^cr/) {
4225: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4226: } else {
4227: next if (!exists($roles{$trole}));
4228: }
4229: if ($tend) {
4230: next if ($tend < $now);
4231: }
4232: if ($tstart) {
4233: next if ($tstart > $now);
4234: }
1.1058 raeburn 4235: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4236: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4237: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4238: if ($secpart eq '') {
4239: ($cnum,$role) = split(/_/,$cnumpart);
4240: $sec = 'none';
1.1058 raeburn 4241: $value .= $cnum.'/';
1.482 raeburn 4242: } else {
4243: $cnum = $cnumpart;
4244: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4245: $value .= $cnum.'/'.$sec;
4246: }
4247: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4248: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4249: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4250: }
4251: } else {
4252: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4253: }
1.482 raeburn 4254: }
4255: } else {
4256: foreach my $key (keys(%env)) {
1.483 albertel 4257: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4258: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4259: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4260: next if ($role eq 'ca' || $role eq 'aa');
4261: next if (%roles && !exists($roles{$role}));
4262: my ($starttime,$endtime)=split(/\./,$env{$key});
4263: my $active=1;
4264: if ($starttime) {
4265: if ($now<$starttime) { $active=0; }
4266: }
4267: if ($endtime) {
4268: if ($now>$endtime) { $active=0; }
4269: }
4270: if ($active) {
1.1058 raeburn 4271: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4272: if ($sec eq '') {
4273: $sec = 'none';
1.1058 raeburn 4274: } else {
4275: $value .= $sec;
4276: }
4277: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4278: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4279: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4280: }
4281: } else {
4282: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4283: }
1.474 raeburn 4284: }
4285: }
1.51 www 4286: }
4287: }
1.474 raeburn 4288: return %courses;
1.51 www 4289: }
1.37 matthew 4290:
1.54 www 4291: ###############################################
1.474 raeburn 4292:
4293: sub blockcheck {
1.1062 raeburn 4294: my ($setters,$activity,$uname,$udom,$url) = @_;
1.490 raeburn 4295:
4296: if (!defined($udom)) {
4297: $udom = $env{'user.domain'};
4298: }
4299: if (!defined($uname)) {
4300: $uname = $env{'user.name'};
4301: }
4302:
4303: # If uname and udom are for a course, check for blocks in the course.
4304:
4305: if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062 raeburn 4306: my ($startblock,$endblock,$triggerblock) =
4307: &get_blocks($setters,$activity,$udom,$uname,$url);
4308: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4309: }
1.474 raeburn 4310:
1.502 raeburn 4311: my $startblock = 0;
4312: my $endblock = 0;
1.1062 raeburn 4313: my $triggerblock = '';
1.482 raeburn 4314: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4315:
1.490 raeburn 4316: # If uname is for a user, and activity is course-specific, i.e.,
4317: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4318:
1.490 raeburn 4319: if (($activity eq 'boards' || $activity eq 'chat' ||
4320: $activity eq 'groups') && ($env{'request.course.id'})) {
4321: foreach my $key (keys(%live_courses)) {
4322: if ($key ne $env{'request.course.id'}) {
4323: delete($live_courses{$key});
4324: }
4325: }
4326: }
4327:
4328: my $otheruser = 0;
4329: my %own_courses;
4330: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4331: # Resource belongs to user other than current user.
4332: $otheruser = 1;
4333: # Gather courses for current user
4334: %own_courses =
4335: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4336: }
4337:
4338: # Gather active course roles - course coordinator, instructor,
4339: # exam proctor, ta, student, or custom role.
1.474 raeburn 4340:
4341: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4342: my ($cdom,$cnum);
4343: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4344: $cdom = $env{'course.'.$course.'.domain'};
4345: $cnum = $env{'course.'.$course.'.num'};
4346: } else {
1.490 raeburn 4347: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4348: }
4349: my $no_ownblock = 0;
4350: my $no_userblock = 0;
1.533 raeburn 4351: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4352: # Check if current user has 'evb' priv for this
4353: if (defined($own_courses{$course})) {
4354: foreach my $sec (keys(%{$own_courses{$course}})) {
4355: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4356: if ($sec ne 'none') {
4357: $checkrole .= '/'.$sec;
4358: }
4359: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4360: $no_ownblock = 1;
4361: last;
4362: }
4363: }
4364: }
4365: # if they have 'evb' priv and are currently not playing student
4366: next if (($no_ownblock) &&
4367: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4368: }
1.474 raeburn 4369: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4370: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4371: if ($sec ne 'none') {
1.482 raeburn 4372: $checkrole .= '/'.$sec;
1.474 raeburn 4373: }
1.490 raeburn 4374: if ($otheruser) {
4375: # Resource belongs to user other than current user.
4376: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4377: my (%allroles,%userroles);
4378: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4379: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4380: my ($trole,$tdom,$tnum,$tsec);
4381: if ($entry =~ /^cr/) {
4382: ($trole,$tdom,$tnum,$tsec) =
4383: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4384: } else {
4385: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4386: }
4387: my ($spec,$area,$trest);
4388: $area = '/'.$tdom.'/'.$tnum;
4389: $trest = $tnum;
4390: if ($tsec ne '') {
4391: $area .= '/'.$tsec;
4392: $trest .= '/'.$tsec;
4393: }
4394: $spec = $trole.'.'.$area;
4395: if ($trole =~ /^cr/) {
4396: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4397: $tdom,$spec,$trest,$area);
4398: } else {
4399: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4400: $tdom,$spec,$trest,$area);
4401: }
4402: }
4403: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4404: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4405: if ($1) {
4406: $no_userblock = 1;
4407: last;
4408: }
1.486 raeburn 4409: }
4410: }
1.490 raeburn 4411: } else {
4412: # Resource belongs to current user
4413: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4414: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4415: $no_ownblock = 1;
4416: last;
4417: }
1.474 raeburn 4418: }
4419: }
4420: # if they have the evb priv and are currently not playing student
1.482 raeburn 4421: next if (($no_ownblock) &&
1.491 albertel 4422: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4423: next if ($no_userblock);
1.474 raeburn 4424:
1.866 kalberla 4425: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4426: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4427:
1.1062 raeburn 4428: my ($start,$end,$trigger) =
4429: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4430: if (($start != 0) &&
4431: (($startblock == 0) || ($startblock > $start))) {
4432: $startblock = $start;
1.1062 raeburn 4433: if ($trigger ne '') {
4434: $triggerblock = $trigger;
4435: }
1.502 raeburn 4436: }
4437: if (($end != 0) &&
4438: (($endblock == 0) || ($endblock < $end))) {
4439: $endblock = $end;
1.1062 raeburn 4440: if ($trigger ne '') {
4441: $triggerblock = $trigger;
4442: }
1.502 raeburn 4443: }
1.490 raeburn 4444: }
1.1062 raeburn 4445: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4446: }
4447:
4448: sub get_blocks {
1.1062 raeburn 4449: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4450: my $startblock = 0;
4451: my $endblock = 0;
1.1062 raeburn 4452: my $triggerblock = '';
1.490 raeburn 4453: my $course = $cdom.'_'.$cnum;
4454: $setters->{$course} = {};
4455: $setters->{$course}{'staff'} = [];
4456: $setters->{$course}{'times'} = [];
1.1062 raeburn 4457: $setters->{$course}{'triggers'} = [];
4458: my (@blockers,%triggered);
4459: my $now = time;
4460: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4461: if ($activity eq 'docs') {
4462: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4463: foreach my $block (@blockers) {
4464: if ($block =~ /^firstaccess____(.+)$/) {
4465: my $item = $1;
4466: my $type = 'map';
4467: my $timersymb = $item;
4468: if ($item eq 'course') {
4469: $type = 'course';
4470: } elsif ($item =~ /___\d+___/) {
4471: $type = 'resource';
4472: } else {
4473: $timersymb = &Apache::lonnet::symbread($item);
4474: }
4475: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4476: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4477: $triggered{$block} = {
4478: start => $start,
4479: end => $end,
4480: type => $type,
4481: };
4482: }
4483: }
4484: } else {
4485: foreach my $block (keys(%commblocks)) {
4486: if ($block =~ m/^(\d+)____(\d+)$/) {
4487: my ($start,$end) = ($1,$2);
4488: if ($start <= time && $end >= time) {
4489: if (ref($commblocks{$block}) eq 'HASH') {
4490: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4491: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4492: unless(grep(/^\Q$block\E$/,@blockers)) {
4493: push(@blockers,$block);
4494: }
4495: }
4496: }
4497: }
4498: }
4499: } elsif ($block =~ /^firstaccess____(.+)$/) {
4500: my $item = $1;
4501: my $timersymb = $item;
4502: my $type = 'map';
4503: if ($item eq 'course') {
4504: $type = 'course';
4505: } elsif ($item =~ /___\d+___/) {
4506: $type = 'resource';
4507: } else {
4508: $timersymb = &Apache::lonnet::symbread($item);
4509: }
4510: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4511: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4512: if ($start && $end) {
4513: if (($start <= time) && ($end >= time)) {
4514: unless (grep(/^\Q$block\E$/,@blockers)) {
4515: push(@blockers,$block);
4516: $triggered{$block} = {
4517: start => $start,
4518: end => $end,
4519: type => $type,
4520: };
4521: }
4522: }
1.490 raeburn 4523: }
1.1062 raeburn 4524: }
4525: }
4526: }
4527: foreach my $blocker (@blockers) {
4528: my ($staff_name,$staff_dom,$title,$blocks) =
4529: &parse_block_record($commblocks{$blocker});
4530: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4531: my ($start,$end,$triggertype);
4532: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4533: ($start,$end) = ($1,$2);
4534: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4535: $start = $triggered{$blocker}{'start'};
4536: $end = $triggered{$blocker}{'end'};
4537: $triggertype = $triggered{$blocker}{'type'};
4538: }
4539: if ($start) {
4540: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4541: if ($triggertype) {
4542: push(@{$$setters{$course}{'triggers'}},$triggertype);
4543: } else {
4544: push(@{$$setters{$course}{'triggers'}},0);
4545: }
4546: if ( ($startblock == 0) || ($startblock > $start) ) {
4547: $startblock = $start;
4548: if ($triggertype) {
4549: $triggerblock = $blocker;
1.474 raeburn 4550: }
4551: }
1.1062 raeburn 4552: if ( ($endblock == 0) || ($endblock < $end) ) {
4553: $endblock = $end;
4554: if ($triggertype) {
4555: $triggerblock = $blocker;
4556: }
4557: }
1.474 raeburn 4558: }
4559: }
1.1062 raeburn 4560: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4561: }
4562:
4563: sub parse_block_record {
4564: my ($record) = @_;
4565: my ($setuname,$setudom,$title,$blocks);
4566: if (ref($record) eq 'HASH') {
4567: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4568: $title = &unescape($record->{'event'});
4569: $blocks = $record->{'blocks'};
4570: } else {
4571: my @data = split(/:/,$record,3);
4572: if (scalar(@data) eq 2) {
4573: $title = $data[1];
4574: ($setuname,$setudom) = split(/@/,$data[0]);
4575: } else {
4576: ($setuname,$setudom,$title) = @data;
4577: }
4578: $blocks = { 'com' => 'on' };
4579: }
4580: return ($setuname,$setudom,$title,$blocks);
4581: }
4582:
1.854 kalberla 4583: sub blocking_status {
1.1062 raeburn 4584: my ($activity,$uname,$udom,$url) = @_;
1.1061 raeburn 4585: my %setters;
1.890 droeschl 4586:
1.1061 raeburn 4587: # check for active blocking
1.1062 raeburn 4588: my ($startblock,$endblock,$triggerblock) =
4589: &blockcheck(\%setters,$activity,$uname,$udom,$url);
4590: my $blocked = 0;
4591: if ($startblock && $endblock) {
4592: $blocked = 1;
4593: }
1.890 droeschl 4594:
1.1061 raeburn 4595: # caller just wants to know whether a block is active
4596: if (!wantarray) { return $blocked; }
4597:
4598: # build a link to a popup window containing the details
4599: my $querystring = "?activity=$activity";
4600: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4601: if ($activity eq 'port') {
4602: $querystring .= "&udom=$udom" if $udom;
4603: $querystring .= "&uname=$uname" if $uname;
4604: } elsif ($activity eq 'docs') {
4605: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4606: }
1.1061 raeburn 4607:
4608: my $output .= <<'END_MYBLOCK';
4609: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4610: var options = "width=" + w + ",height=" + h + ",";
4611: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4612: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4613: var newWin = window.open(url, wdwName, options);
4614: newWin.focus();
4615: }
1.890 droeschl 4616: END_MYBLOCK
1.854 kalberla 4617:
1.1061 raeburn 4618: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4619:
1.1061 raeburn 4620: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4621: my $text = &mt('Communication Blocked');
4622: if ($activity eq 'docs') {
4623: $text = &mt('Content Access Blocked');
1.1063 raeburn 4624: } elsif ($activity eq 'printout') {
4625: $text = &mt('Printing Blocked');
1.1062 raeburn 4626: }
1.1061 raeburn 4627: $output .= <<"END_BLOCK";
1.867 kalberla 4628: <div class='LC_comblock'>
1.869 kalberla 4629: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4630: title='$text'>
4631: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4632: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4633: title='$text'>$text</a>
1.867 kalberla 4634: </div>
4635:
4636: END_BLOCK
1.474 raeburn 4637:
1.1061 raeburn 4638: return ($blocked, $output);
1.854 kalberla 4639: }
1.490 raeburn 4640:
1.60 matthew 4641: ###############################################
4642:
1.682 raeburn 4643: sub check_ip_acc {
4644: my ($acc)=@_;
4645: &Apache::lonxml::debug("acc is $acc");
4646: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4647: return 1;
4648: }
4649: my $allowed=0;
4650: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4651:
4652: my $name;
4653: foreach my $pattern (split(',',$acc)) {
4654: $pattern =~ s/^\s*//;
4655: $pattern =~ s/\s*$//;
4656: if ($pattern =~ /\*$/) {
4657: #35.8.*
4658: $pattern=~s/\*//;
4659: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4660: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4661: #35.8.3.[34-56]
4662: my $low=$2;
4663: my $high=$3;
4664: $pattern=$1;
4665: if ($ip =~ /^\Q$pattern\E/) {
4666: my $last=(split(/\./,$ip))[3];
4667: if ($last <=$high && $last >=$low) { $allowed=1; }
4668: }
4669: } elsif ($pattern =~ /^\*/) {
4670: #*.msu.edu
4671: $pattern=~s/\*//;
4672: if (!defined($name)) {
4673: use Socket;
4674: my $netaddr=inet_aton($ip);
4675: ($name)=gethostbyaddr($netaddr,AF_INET);
4676: }
4677: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4678: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4679: #127.0.0.1
4680: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4681: } else {
4682: #some.name.com
4683: if (!defined($name)) {
4684: use Socket;
4685: my $netaddr=inet_aton($ip);
4686: ($name)=gethostbyaddr($netaddr,AF_INET);
4687: }
4688: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4689: }
4690: if ($allowed) { last; }
4691: }
4692: return $allowed;
4693: }
4694:
4695: ###############################################
4696:
1.60 matthew 4697: =pod
4698:
1.112 bowersj2 4699: =head1 Domain Template Functions
4700:
4701: =over 4
4702:
4703: =item * &determinedomain()
1.60 matthew 4704:
4705: Inputs: $domain (usually will be undef)
4706:
1.63 www 4707: Returns: Determines which domain should be used for designs
1.60 matthew 4708:
4709: =cut
1.54 www 4710:
1.60 matthew 4711: ###############################################
1.63 www 4712: sub determinedomain {
4713: my $domain=shift;
1.531 albertel 4714: if (! $domain) {
1.60 matthew 4715: # Determine domain if we have not been given one
1.893 raeburn 4716: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4717: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4718: if ($env{'request.role.domain'}) {
4719: $domain=$env{'request.role.domain'};
1.60 matthew 4720: }
4721: }
1.63 www 4722: return $domain;
4723: }
4724: ###############################################
1.517 raeburn 4725:
1.518 albertel 4726: sub devalidate_domconfig_cache {
4727: my ($udom)=@_;
4728: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4729: }
4730:
4731: # ---------------------- Get domain configuration for a domain
4732: sub get_domainconf {
4733: my ($udom) = @_;
4734: my $cachetime=1800;
4735: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4736: if (defined($cached)) { return %{$result}; }
4737:
4738: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4739: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4740: my (%designhash,%legacy);
1.518 albertel 4741: if (keys(%domconfig) > 0) {
4742: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4743: if (keys(%{$domconfig{'login'}})) {
4744: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4745: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4746: if ($key eq 'loginvia') {
4747: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4748: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4749: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4750: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4751: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4752: $designhash{$udom.'.login.loginvia'} = $server;
4753: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4754:
4755: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4756: } else {
1.1013 raeburn 4757: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4758: }
4759: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4760: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4761: }
1.946 raeburn 4762: }
4763: }
4764: }
4765: }
4766: } else {
4767: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4768: $designhash{$udom.'.login.'.$key.'_'.$img} =
4769: $domconfig{'login'}{$key}{$img};
4770: }
1.699 raeburn 4771: }
4772: } else {
4773: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4774: }
1.632 raeburn 4775: }
4776: } else {
4777: $legacy{'login'} = 1;
1.518 albertel 4778: }
1.632 raeburn 4779: } else {
4780: $legacy{'login'} = 1;
1.518 albertel 4781: }
4782: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4783: if (keys(%{$domconfig{'rolecolors'}})) {
4784: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4785: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4786: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4787: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4788: }
1.518 albertel 4789: }
4790: }
1.632 raeburn 4791: } else {
4792: $legacy{'rolecolors'} = 1;
1.518 albertel 4793: }
1.632 raeburn 4794: } else {
4795: $legacy{'rolecolors'} = 1;
1.518 albertel 4796: }
1.948 raeburn 4797: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4798: if ($domconfig{'autoenroll'}{'co-owners'}) {
4799: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4800: }
4801: }
1.632 raeburn 4802: if (keys(%legacy) > 0) {
4803: my %legacyhash = &get_legacy_domconf($udom);
4804: foreach my $item (keys(%legacyhash)) {
4805: if ($item =~ /^\Q$udom\E\.login/) {
4806: if ($legacy{'login'}) {
4807: $designhash{$item} = $legacyhash{$item};
4808: }
4809: } else {
4810: if ($legacy{'rolecolors'}) {
4811: $designhash{$item} = $legacyhash{$item};
4812: }
1.518 albertel 4813: }
4814: }
4815: }
1.632 raeburn 4816: } else {
4817: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4818: }
4819: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4820: $cachetime);
4821: return %designhash;
4822: }
4823:
1.632 raeburn 4824: sub get_legacy_domconf {
4825: my ($udom) = @_;
4826: my %legacyhash;
4827: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4828: my $designfile = $designdir.'/'.$udom.'.tab';
4829: if (-e $designfile) {
4830: if ( open (my $fh,"<$designfile") ) {
4831: while (my $line = <$fh>) {
4832: next if ($line =~ /^\#/);
4833: chomp($line);
4834: my ($key,$val)=(split(/\=/,$line));
4835: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4836: }
4837: close($fh);
4838: }
4839: }
1.1026 raeburn 4840: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4841: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4842: }
4843: return %legacyhash;
4844: }
4845:
1.63 www 4846: =pod
4847:
1.112 bowersj2 4848: =item * &domainlogo()
1.63 www 4849:
4850: Inputs: $domain (usually will be undef)
4851:
4852: Returns: A link to a domain logo, if the domain logo exists.
4853: If the domain logo does not exist, a description of the domain.
4854:
4855: =cut
1.112 bowersj2 4856:
1.63 www 4857: ###############################################
4858: sub domainlogo {
1.517 raeburn 4859: my $domain = &determinedomain(shift);
1.518 albertel 4860: my %designhash = &get_domainconf($domain);
1.517 raeburn 4861: # See if there is a logo
4862: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4863: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4864: if ($imgsrc =~ m{^/(adm|res)/}) {
4865: if ($imgsrc =~ m{^/res/}) {
4866: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4867: &Apache::lonnet::repcopy($local_name);
4868: }
4869: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4870: }
4871: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4872: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4873: return &Apache::lonnet::domain($domain,'description');
1.59 www 4874: } else {
1.60 matthew 4875: return '';
1.59 www 4876: }
4877: }
1.63 www 4878: ##############################################
4879:
4880: =pod
4881:
1.112 bowersj2 4882: =item * &designparm()
1.63 www 4883:
4884: Inputs: $which parameter; $domain (usually will be undef)
4885:
4886: Returns: value of designparamter $which
4887:
4888: =cut
1.112 bowersj2 4889:
1.397 albertel 4890:
1.400 albertel 4891: ##############################################
1.397 albertel 4892: sub designparm {
4893: my ($which,$domain)=@_;
4894: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4895: return $env{'environment.color.'.$which};
1.96 www 4896: }
1.63 www 4897: $domain=&determinedomain($domain);
1.1016 raeburn 4898: my %domdesign;
4899: unless ($domain eq 'public') {
4900: %domdesign = &get_domainconf($domain);
4901: }
1.520 raeburn 4902: my $output;
1.517 raeburn 4903: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4904: $output = $domdesign{$domain.'.'.$which};
1.63 www 4905: } else {
1.520 raeburn 4906: $output = $defaultdesign{$which};
4907: }
4908: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4909: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4910: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4911: if ($output =~ m{^/res/}) {
4912: my $local_name = &Apache::lonnet::filelocation('',$output);
4913: &Apache::lonnet::repcopy($local_name);
4914: }
1.520 raeburn 4915: $output = &lonhttpdurl($output);
4916: }
1.63 www 4917: }
1.520 raeburn 4918: return $output;
1.63 www 4919: }
1.59 www 4920:
1.822 bisitz 4921: ##############################################
4922: =pod
4923:
1.832 bisitz 4924: =item * &authorspace()
4925:
1.1028 raeburn 4926: Inputs: $url (usually will be undef).
1.832 bisitz 4927:
1.1028 raeburn 4928: Returns: Path to Construction Space containing the resource or
4929: directory being viewed (or for which action is being taken).
4930: If $url is provided, and begins /priv/<domain>/<uname>
4931: the path will be that portion of the $context argument.
4932: Otherwise the path will be for the author space of the current
4933: user when the current role is author, or for that of the
4934: co-author/assistant co-author space when the current role
4935: is co-author or assistant co-author.
1.832 bisitz 4936:
4937: =cut
4938:
4939: sub authorspace {
1.1028 raeburn 4940: my ($url) = @_;
4941: if ($url ne '') {
4942: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4943: return $1;
4944: }
4945: }
1.832 bisitz 4946: my $caname = '';
1.1024 www 4947: my $cadom = '';
1.1028 raeburn 4948: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4949: ($cadom,$caname) =
1.832 bisitz 4950: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4951: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4952: $caname = $env{'user.name'};
1.1024 www 4953: $cadom = $env{'user.domain'};
1.832 bisitz 4954: }
1.1028 raeburn 4955: if (($caname ne '') && ($cadom ne '')) {
4956: return "/priv/$cadom/$caname/";
4957: }
4958: return;
1.832 bisitz 4959: }
4960:
4961: ##############################################
4962: =pod
4963:
1.822 bisitz 4964: =item * &head_subbox()
4965:
4966: Inputs: $content (contains HTML code with page functions, etc.)
4967:
4968: Returns: HTML div with $content
4969: To be included in page header
4970:
4971: =cut
4972:
4973: sub head_subbox {
4974: my ($content)=@_;
4975: my $output =
1.993 raeburn 4976: '<div class="LC_head_subbox">'
1.822 bisitz 4977: .$content
4978: .'</div>'
4979: }
4980:
4981: ##############################################
4982: =pod
4983:
4984: =item * &CSTR_pageheader()
4985:
1.1026 raeburn 4986: Input: (optional) filename from which breadcrumb trail is built.
4987: In most cases no input as needed, as $env{'request.filename'}
4988: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 4989:
4990: Returns: HTML div with CSTR path and recent box
4991: To be included on Construction Space pages
4992:
4993: =cut
4994:
4995: sub CSTR_pageheader {
1.1026 raeburn 4996: my ($trailfile) = @_;
4997: if ($trailfile eq '') {
4998: $trailfile = $env{'request.filename'};
4999: }
5000:
5001: # this is for resources; directories have customtitle, and crumbs
5002: # and select recent are created in lonpubdir.pm
5003:
5004: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5005: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5006: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5007: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5008: $formaction =~ s{/+}{/}g;
1.822 bisitz 5009:
5010: my $parentpath = '';
5011: my $lastitem = '';
5012: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5013: $parentpath = $1;
5014: $lastitem = $2;
5015: } else {
5016: $lastitem = $thisdisfn;
5017: }
1.921 bisitz 5018:
5019: my $output =
1.822 bisitz 5020: '<div>'
5021: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
5022: .'<b>'.&mt('Construction Space:').'</b> '
5023: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5024: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5025: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5026:
5027: if ($lastitem) {
5028: $output .=
5029: '<span class="LC_filename">'
5030: .$lastitem
5031: .'</span>';
5032: }
5033: $output .=
5034: '<br />'
1.822 bisitz 5035: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5036: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5037: .'</form>'
5038: .&Apache::lonmenu::constspaceform()
5039: .'</div>';
1.921 bisitz 5040:
5041: return $output;
1.822 bisitz 5042: }
5043:
1.60 matthew 5044: ###############################################
5045: ###############################################
5046:
5047: =pod
5048:
1.112 bowersj2 5049: =back
5050:
1.549 albertel 5051: =head1 HTML Helpers
1.112 bowersj2 5052:
5053: =over 4
5054:
5055: =item * &bodytag()
1.60 matthew 5056:
5057: Returns a uniform header for LON-CAPA web pages.
5058:
5059: Inputs:
5060:
1.112 bowersj2 5061: =over 4
5062:
5063: =item * $title, A title to be displayed on the page.
5064:
5065: =item * $function, the current role (can be undef).
5066:
5067: =item * $addentries, extra parameters for the <body> tag.
5068:
5069: =item * $bodyonly, if defined, only return the <body> tag.
5070:
5071: =item * $domain, if defined, force a given domain.
5072:
5073: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5074: text interface only)
1.60 matthew 5075:
1.814 bisitz 5076: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5077: navigational links
1.317 albertel 5078:
1.338 albertel 5079: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5080:
1.460 albertel 5081: =item * $args, optional argument valid values are
5082: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5083: inherit_jsmath -> when creating popup window in a page,
5084: should it have jsmath forced on by the
5085: current page
1.460 albertel 5086:
1.1096 raeburn 5087: =item * $advtoolsref, optional argument, ref to an array containing
5088: inlineremote items to be added in "Functions" menu below
5089: breadcrumbs.
5090:
1.112 bowersj2 5091: =back
5092:
1.60 matthew 5093: Returns: A uniform header for LON-CAPA web pages.
5094: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5095: If $bodyonly is undef or zero, an html string containing a <body> tag and
5096: other decorations will be returned.
5097:
5098: =cut
5099:
1.54 www 5100: sub bodytag {
1.831 bisitz 5101: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5102: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5103:
1.954 raeburn 5104: my $public;
5105: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5106: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5107: $public = 1;
5108: }
1.460 albertel 5109: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339 albertel 5110:
1.183 matthew 5111: $function = &get_users_function() if (!$function);
1.339 albertel 5112: my $img = &designparm($function.'.img',$domain);
5113: my $font = &designparm($function.'.font',$domain);
5114: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5115:
1.803 bisitz 5116: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5117: 'bgcolor' => $pgbg,
1.339 albertel 5118: 'text' => $font,
5119: 'alink' => &designparm($function.'.alink',$domain),
5120: 'vlink' => &designparm($function.'.vlink',$domain),
5121: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5122: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5123:
1.63 www 5124: # role and realm
1.378 raeburn 5125: my ($role,$realm) = split(/\./,$env{'request.role'},2);
5126: if ($role eq 'ca') {
1.479 albertel 5127: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5128: $realm = &plainname($rname,$rdom);
1.378 raeburn 5129: }
1.55 www 5130: # realm
1.258 albertel 5131: if ($env{'request.course.id'}) {
1.378 raeburn 5132: if ($env{'request.role'} !~ /^cr/) {
5133: $role = &Apache::lonnet::plaintext($role,&course_type());
5134: }
1.898 raeburn 5135: if ($env{'request.course.sec'}) {
5136: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5137: }
1.359 albertel 5138: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5139: } else {
5140: $role = &Apache::lonnet::plaintext($role);
1.54 www 5141: }
1.433 albertel 5142:
1.359 albertel 5143: if (!$realm) { $realm=' '; }
1.330 albertel 5144:
1.438 albertel 5145: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5146:
1.101 www 5147: # construct main body tag
1.359 albertel 5148: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5149: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5150:
1.530 albertel 5151: if ($bodyonly) {
1.60 matthew 5152: return $bodytag;
1.798 tempelho 5153: }
1.359 albertel 5154:
1.410 albertel 5155: my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954 raeburn 5156: if ($public) {
1.433 albertel 5157: undef($role);
1.434 albertel 5158: } else {
1.1070 raeburn 5159: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5160: undef,'LC_menubuttons_link');
1.433 albertel 5161: }
1.359 albertel 5162:
1.762 bisitz 5163: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5164: #
5165: # Extra info if you are the DC
5166: my $dc_info = '';
5167: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5168: $env{'course.'.$env{'request.course.id'}.
5169: '.domain'}.'/'})) {
5170: my $cid = $env{'request.course.id'};
1.917 raeburn 5171: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5172: $dc_info =~ s/\s+$//;
1.359 albertel 5173: }
5174:
1.898 raeburn 5175: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5176: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5177:
1.916 droeschl 5178: if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
5179: return $bodytag;
5180: }
1.903 droeschl 5181:
5182: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5183:
5184: # if ($env{'request.state'} eq 'construct') {
5185: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5186: # }
5187:
1.359 albertel 5188:
5189:
1.916 droeschl 5190: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5191: if ($dc_info) {
5192: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5193: }
1.916 droeschl 5194: $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
5195: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5196: return $bodytag;
5197: }
1.894 droeschl 5198:
1.927 raeburn 5199: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
5200: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
5201: }
1.916 droeschl 5202:
1.903 droeschl 5203: $bodytag .= Apache::lonhtmlcommon::scripttag(
5204: Apache::lonmenu::utilityfunctions(), 'start');
1.816 bisitz 5205:
1.903 droeschl 5206: $bodytag .= Apache::lonmenu::primary_menu();
1.852 droeschl 5207:
1.917 raeburn 5208: if ($dc_info) {
5209: $dc_info = &dc_courseid_toggle($dc_info);
5210: }
5211: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5212:
1.903 droeschl 5213: #don't show menus for public users
1.954 raeburn 5214: if (!$public){
1.903 droeschl 5215: $bodytag .= Apache::lonmenu::secondary_menu();
5216: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5217: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5218: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5219: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5220: $args->{'bread_crumbs'});
1.1096 raeburn 5221: } elsif ($forcereg) {
5222: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5223: $args->{'group'});
5224: } else {
5225: $bodytag .=
5226: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5227: $forcereg,$args->{'group'},
5228: $args->{'bread_crumbs'},
5229: $advtoolsref);
1.920 raeburn 5230: }
1.903 droeschl 5231: }else{
5232: # this is to seperate menu from content when there's no secondary
5233: # menu. Especially needed for public accessible ressources.
5234: $bodytag .= '<hr style="clear:both" />';
5235: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5236: }
1.903 droeschl 5237:
1.235 raeburn 5238: return $bodytag;
1.182 matthew 5239: }
5240:
1.917 raeburn 5241: sub dc_courseid_toggle {
5242: my ($dc_info) = @_;
1.980 raeburn 5243: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5244: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5245: &mt('(More ...)').'</a></span>'.
5246: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5247: }
5248:
1.330 albertel 5249: sub make_attr_string {
5250: my ($register,$attr_ref) = @_;
5251:
5252: if ($attr_ref && !ref($attr_ref)) {
5253: die("addentries Must be a hash ref ".
5254: join(':',caller(1))." ".
5255: join(':',caller(0))." ");
5256: }
5257:
5258: if ($register) {
1.339 albertel 5259: my ($on_load,$on_unload);
5260: foreach my $key (keys(%{$attr_ref})) {
5261: if (lc($key) eq 'onload') {
5262: $on_load.=$attr_ref->{$key}.';';
5263: delete($attr_ref->{$key});
5264:
5265: } elsif (lc($key) eq 'onunload') {
5266: $on_unload.=$attr_ref->{$key}.';';
5267: delete($attr_ref->{$key});
5268: }
5269: }
1.953 droeschl 5270: $attr_ref->{'onload'} = $on_load;
5271: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5272: }
1.339 albertel 5273:
1.330 albertel 5274: my $attr_string;
5275: foreach my $attr (keys(%$attr_ref)) {
5276: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5277: }
5278: return $attr_string;
5279: }
5280:
5281:
1.182 matthew 5282: ###############################################
1.251 albertel 5283: ###############################################
5284:
5285: =pod
5286:
5287: =item * &endbodytag()
5288:
5289: Returns a uniform footer for LON-CAPA web pages.
5290:
1.635 raeburn 5291: Inputs: 1 - optional reference to an args hash
5292: If in the hash, key for noredirectlink has a value which evaluates to true,
5293: a 'Continue' link is not displayed if the page contains an
5294: internal redirect in the <head></head> section,
5295: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5296:
5297: =cut
5298:
5299: sub endbodytag {
1.635 raeburn 5300: my ($args) = @_;
1.1080 raeburn 5301: my $endbodytag;
5302: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5303: $endbodytag='</body>';
5304: }
1.269 albertel 5305: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5306: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5307: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5308: $endbodytag=
5309: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5310: &mt('Continue').'</a>'.
5311: $endbodytag;
5312: }
1.315 albertel 5313: }
1.251 albertel 5314: return $endbodytag;
5315: }
5316:
1.352 albertel 5317: =pod
5318:
5319: =item * &standard_css()
5320:
5321: Returns a style sheet
5322:
5323: Inputs: (all optional)
5324: domain -> force to color decorate a page for a specific
5325: domain
5326: function -> force usage of a specific rolish color scheme
5327: bgcolor -> override the default page bgcolor
5328:
5329: =cut
5330:
1.343 albertel 5331: sub standard_css {
1.345 albertel 5332: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5333: $function = &get_users_function() if (!$function);
5334: my $img = &designparm($function.'.img', $domain);
5335: my $tabbg = &designparm($function.'.tabbg', $domain);
5336: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5337: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5338: #second colour for later usage
1.345 albertel 5339: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5340: my $pgbg_or_bgcolor =
5341: $bgcolor ||
1.352 albertel 5342: &designparm($function.'.pgbg', $domain);
1.382 albertel 5343: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5344: my $alink = &designparm($function.'.alink', $domain);
5345: my $vlink = &designparm($function.'.vlink', $domain);
5346: my $link = &designparm($function.'.link', $domain);
5347:
1.602 albertel 5348: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5349: my $mono = 'monospace';
1.850 bisitz 5350: my $data_table_head = $sidebg;
5351: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5352: my $data_table_dark = '#E0E0E0';
1.470 banghart 5353: my $data_table_darker = '#CCCCCC';
1.349 albertel 5354: my $data_table_highlight = '#FFFF00';
1.352 albertel 5355: my $mail_new = '#FFBB77';
5356: my $mail_new_hover = '#DD9955';
5357: my $mail_read = '#BBBB77';
5358: my $mail_read_hover = '#999944';
5359: my $mail_replied = '#AAAA88';
5360: my $mail_replied_hover = '#888855';
5361: my $mail_other = '#99BBBB';
5362: my $mail_other_hover = '#669999';
1.391 albertel 5363: my $table_header = '#DDDDDD';
1.489 raeburn 5364: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5365: my $lg_border_color = '#C8C8C8';
1.952 onken 5366: my $button_hover = '#BF2317';
1.392 albertel 5367:
1.608 albertel 5368: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5369: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5370: : '0 3px 0 4px';
1.448 albertel 5371:
1.523 albertel 5372:
1.343 albertel 5373: return <<END;
1.947 droeschl 5374:
5375: /* needed for iframe to allow 100% height in FF */
5376: body, html {
5377: margin: 0;
5378: padding: 0 0.5%;
5379: height: 99%; /* to avoid scrollbars */
5380: }
5381:
1.795 www 5382: body {
1.911 bisitz 5383: font-family: $sans;
5384: line-height:130%;
5385: font-size:0.83em;
5386: color:$font;
1.795 www 5387: }
5388:
1.959 onken 5389: a:focus,
5390: a:focus img {
1.795 www 5391: color: red;
5392: }
1.698 harmsja 5393:
1.911 bisitz 5394: form, .inline {
5395: display: inline;
1.795 www 5396: }
1.721 harmsja 5397:
1.795 www 5398: .LC_right {
1.911 bisitz 5399: text-align:right;
1.795 www 5400: }
5401:
5402: .LC_middle {
1.911 bisitz 5403: vertical-align:middle;
1.795 www 5404: }
1.721 harmsja 5405:
1.911 bisitz 5406: .LC_400Box {
5407: width:400px;
5408: }
1.721 harmsja 5409:
1.947 droeschl 5410: .LC_iframecontainer {
5411: width: 98%;
5412: margin: 0;
5413: position: fixed;
5414: top: 8.5em;
5415: bottom: 0;
5416: }
5417:
5418: .LC_iframecontainer iframe{
5419: border: none;
5420: width: 100%;
5421: height: 100%;
5422: }
5423:
1.778 bisitz 5424: .LC_filename {
5425: font-family: $mono;
5426: white-space:pre;
1.921 bisitz 5427: font-size: 120%;
1.778 bisitz 5428: }
5429:
5430: .LC_fileicon {
5431: border: none;
5432: height: 1.3em;
5433: vertical-align: text-bottom;
5434: margin-right: 0.3em;
5435: text-decoration:none;
5436: }
5437:
1.1008 www 5438: .LC_setting {
5439: text-decoration:underline;
5440: }
5441:
1.350 albertel 5442: .LC_error {
5443: color: red;
5444: }
1.795 www 5445:
1.1097 bisitz 5446: .LC_warning {
5447: color: darkorange;
5448: }
5449:
1.457 albertel 5450: .LC_diff_removed {
1.733 bisitz 5451: color: red;
1.394 albertel 5452: }
1.532 albertel 5453:
5454: .LC_info,
1.457 albertel 5455: .LC_success,
5456: .LC_diff_added {
1.350 albertel 5457: color: green;
5458: }
1.795 www 5459:
1.802 bisitz 5460: div.LC_confirm_box {
5461: background-color: #FAFAFA;
5462: border: 1px solid $lg_border_color;
5463: margin-right: 0;
5464: padding: 5px;
5465: }
5466:
5467: div.LC_confirm_box .LC_error img,
5468: div.LC_confirm_box .LC_success img {
5469: vertical-align: middle;
5470: }
5471:
1.440 albertel 5472: .LC_icon {
1.771 droeschl 5473: border: none;
1.790 droeschl 5474: vertical-align: middle;
1.771 droeschl 5475: }
5476:
1.543 albertel 5477: .LC_docs_spacer {
5478: width: 25px;
5479: height: 1px;
1.771 droeschl 5480: border: none;
1.543 albertel 5481: }
1.346 albertel 5482:
1.532 albertel 5483: .LC_internal_info {
1.735 bisitz 5484: color: #999999;
1.532 albertel 5485: }
5486:
1.794 www 5487: .LC_discussion {
1.1050 www 5488: background: $data_table_dark;
1.911 bisitz 5489: border: 1px solid black;
5490: margin: 2px;
1.794 www 5491: }
5492:
5493: .LC_disc_action_left {
1.1050 www 5494: background: $sidebg;
1.911 bisitz 5495: text-align: left;
1.1050 www 5496: padding: 4px;
5497: margin: 2px;
1.794 www 5498: }
5499:
5500: .LC_disc_action_right {
1.1050 www 5501: background: $sidebg;
1.911 bisitz 5502: text-align: right;
1.1050 www 5503: padding: 4px;
5504: margin: 2px;
1.794 www 5505: }
5506:
5507: .LC_disc_new_item {
1.911 bisitz 5508: background: white;
5509: border: 2px solid red;
1.1050 www 5510: margin: 4px;
5511: padding: 4px;
1.794 www 5512: }
5513:
5514: .LC_disc_old_item {
1.911 bisitz 5515: background: white;
1.1050 www 5516: margin: 4px;
5517: padding: 4px;
1.794 www 5518: }
5519:
1.458 albertel 5520: table.LC_pastsubmission {
5521: border: 1px solid black;
5522: margin: 2px;
5523: }
5524:
1.924 bisitz 5525: table#LC_menubuttons {
1.345 albertel 5526: width: 100%;
5527: background: $pgbg;
1.392 albertel 5528: border: 2px;
1.402 albertel 5529: border-collapse: separate;
1.803 bisitz 5530: padding: 0;
1.345 albertel 5531: }
1.392 albertel 5532:
1.801 tempelho 5533: table#LC_title_bar a {
5534: color: $fontmenu;
5535: }
1.836 bisitz 5536:
1.807 droeschl 5537: table#LC_title_bar {
1.819 tempelho 5538: clear: both;
1.836 bisitz 5539: display: none;
1.807 droeschl 5540: }
5541:
1.795 www 5542: table#LC_title_bar,
1.933 droeschl 5543: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5544: table#LC_title_bar.LC_with_remote {
1.359 albertel 5545: width: 100%;
1.392 albertel 5546: border-color: $pgbg;
5547: border-style: solid;
5548: border-width: $border;
1.379 albertel 5549: background: $pgbg;
1.801 tempelho 5550: color: $fontmenu;
1.392 albertel 5551: border-collapse: collapse;
1.803 bisitz 5552: padding: 0;
1.819 tempelho 5553: margin: 0;
1.359 albertel 5554: }
1.795 www 5555:
1.933 droeschl 5556: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5557: margin: 0;
5558: padding: 0;
1.933 droeschl 5559: position: relative;
5560: list-style: none;
1.913 droeschl 5561: }
1.933 droeschl 5562: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5563: display: inline;
5564: }
1.933 droeschl 5565:
5566: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5567: padding: 0;
1.933 droeschl 5568: margin: 0;
5569: float: left;
1.913 droeschl 5570: }
1.933 droeschl 5571: .LC_breadcrumb_tools_tools {
5572: padding: 0;
5573: margin: 0;
1.913 droeschl 5574: float: right;
5575: }
5576:
1.359 albertel 5577: table#LC_title_bar td {
5578: background: $tabbg;
5579: }
1.795 www 5580:
1.911 bisitz 5581: table#LC_menubuttons img {
1.803 bisitz 5582: border: none;
1.346 albertel 5583: }
1.795 www 5584:
1.842 droeschl 5585: .LC_breadcrumbs_component {
1.911 bisitz 5586: float: right;
5587: margin: 0 1em;
1.357 albertel 5588: }
1.842 droeschl 5589: .LC_breadcrumbs_component img {
1.911 bisitz 5590: vertical-align: middle;
1.777 tempelho 5591: }
1.795 www 5592:
1.383 albertel 5593: td.LC_table_cell_checkbox {
5594: text-align: center;
5595: }
1.795 www 5596:
5597: .LC_fontsize_small {
1.911 bisitz 5598: font-size: 70%;
1.705 tempelho 5599: }
5600:
1.844 bisitz 5601: #LC_breadcrumbs {
1.911 bisitz 5602: clear:both;
5603: background: $sidebg;
5604: border-bottom: 1px solid $lg_border_color;
5605: line-height: 2.5em;
1.933 droeschl 5606: overflow: hidden;
1.911 bisitz 5607: margin: 0;
5608: padding: 0;
1.995 raeburn 5609: text-align: left;
1.819 tempelho 5610: }
1.862 bisitz 5611:
1.1098 bisitz 5612: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5613: clear:both;
5614: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5615: border: 1px solid $sidebg;
1.1098 bisitz 5616: margin: 0 0 10px 0;
1.966 bisitz 5617: padding: 3px;
1.995 raeburn 5618: text-align: left;
1.822 bisitz 5619: }
5620:
1.795 www 5621: .LC_fontsize_medium {
1.911 bisitz 5622: font-size: 85%;
1.705 tempelho 5623: }
5624:
1.795 www 5625: .LC_fontsize_large {
1.911 bisitz 5626: font-size: 120%;
1.705 tempelho 5627: }
5628:
1.346 albertel 5629: .LC_menubuttons_inline_text {
5630: color: $font;
1.698 harmsja 5631: font-size: 90%;
1.701 harmsja 5632: padding-left:3px;
1.346 albertel 5633: }
5634:
1.934 droeschl 5635: .LC_menubuttons_inline_text img{
5636: vertical-align: middle;
5637: }
5638:
1.1051 www 5639: li.LC_menubuttons_inline_text img {
1.951 onken 5640: cursor:pointer;
1.1002 droeschl 5641: text-decoration: none;
1.951 onken 5642: }
5643:
1.526 www 5644: .LC_menubuttons_link {
5645: text-decoration: none;
5646: }
1.795 www 5647:
1.522 albertel 5648: .LC_menubuttons_category {
1.521 www 5649: color: $font;
1.526 www 5650: background: $pgbg;
1.521 www 5651: font-size: larger;
5652: font-weight: bold;
5653: }
5654:
1.346 albertel 5655: td.LC_menubuttons_text {
1.911 bisitz 5656: color: $font;
1.346 albertel 5657: }
1.706 harmsja 5658:
1.346 albertel 5659: .LC_current_location {
5660: background: $tabbg;
5661: }
1.795 www 5662:
1.938 bisitz 5663: table.LC_data_table {
1.347 albertel 5664: border: 1px solid #000000;
1.402 albertel 5665: border-collapse: separate;
1.426 albertel 5666: border-spacing: 1px;
1.610 albertel 5667: background: $pgbg;
1.347 albertel 5668: }
1.795 www 5669:
1.422 albertel 5670: .LC_data_table_dense {
5671: font-size: small;
5672: }
1.795 www 5673:
1.507 raeburn 5674: table.LC_nested_outer {
5675: border: 1px solid #000000;
1.589 raeburn 5676: border-collapse: collapse;
1.803 bisitz 5677: border-spacing: 0;
1.507 raeburn 5678: width: 100%;
5679: }
1.795 www 5680:
1.879 raeburn 5681: table.LC_innerpickbox,
1.507 raeburn 5682: table.LC_nested {
1.803 bisitz 5683: border: none;
1.589 raeburn 5684: border-collapse: collapse;
1.803 bisitz 5685: border-spacing: 0;
1.507 raeburn 5686: width: 100%;
5687: }
1.795 www 5688:
1.911 bisitz 5689: table.LC_data_table tr th,
5690: table.LC_calendar tr th,
1.879 raeburn 5691: table.LC_prior_tries tr th,
5692: table.LC_innerpickbox tr th {
1.349 albertel 5693: font-weight: bold;
5694: background-color: $data_table_head;
1.801 tempelho 5695: color:$fontmenu;
1.701 harmsja 5696: font-size:90%;
1.347 albertel 5697: }
1.795 www 5698:
1.879 raeburn 5699: table.LC_innerpickbox tr th,
5700: table.LC_innerpickbox tr td {
5701: vertical-align: top;
5702: }
5703:
1.711 raeburn 5704: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5705: background-color: #CCCCCC;
1.711 raeburn 5706: font-weight: bold;
5707: text-align: left;
5708: }
1.795 www 5709:
1.912 bisitz 5710: table.LC_data_table tr.LC_odd_row > td {
5711: background-color: $data_table_light;
5712: padding: 2px;
5713: vertical-align: top;
5714: }
5715:
1.809 bisitz 5716: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5717: background-color: $data_table_light;
1.912 bisitz 5718: vertical-align: top;
5719: }
5720:
5721: table.LC_data_table tr.LC_even_row > td {
5722: background-color: $data_table_dark;
1.425 albertel 5723: padding: 2px;
1.900 bisitz 5724: vertical-align: top;
1.347 albertel 5725: }
1.795 www 5726:
1.809 bisitz 5727: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5728: background-color: $data_table_dark;
1.900 bisitz 5729: vertical-align: top;
1.347 albertel 5730: }
1.795 www 5731:
1.425 albertel 5732: table.LC_data_table tr.LC_data_table_highlight td {
5733: background-color: $data_table_darker;
5734: }
1.795 www 5735:
1.639 raeburn 5736: table.LC_data_table tr td.LC_leftcol_header {
5737: background-color: $data_table_head;
5738: font-weight: bold;
5739: }
1.795 www 5740:
1.451 albertel 5741: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5742: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5743: font-weight: bold;
5744: font-style: italic;
5745: text-align: center;
5746: padding: 8px;
1.347 albertel 5747: }
1.795 www 5748:
1.1114 raeburn 5749: table.LC_data_table tr.LC_empty_row td,
5750: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5751: background-color: $sidebg;
5752: }
5753:
5754: table.LC_nested tr.LC_empty_row td {
5755: background-color: #FFFFFF;
5756: }
5757:
1.890 droeschl 5758: table.LC_caption {
5759: }
5760:
1.507 raeburn 5761: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5762: padding: 4ex
5763: }
1.795 www 5764:
1.507 raeburn 5765: table.LC_nested_outer tr th {
5766: font-weight: bold;
1.801 tempelho 5767: color:$fontmenu;
1.507 raeburn 5768: background-color: $data_table_head;
1.701 harmsja 5769: font-size: small;
1.507 raeburn 5770: border-bottom: 1px solid #000000;
5771: }
1.795 www 5772:
1.507 raeburn 5773: table.LC_nested_outer tr td.LC_subheader {
5774: background-color: $data_table_head;
5775: font-weight: bold;
5776: font-size: small;
5777: border-bottom: 1px solid #000000;
5778: text-align: right;
1.451 albertel 5779: }
1.795 www 5780:
1.507 raeburn 5781: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5782: background-color: #CCCCCC;
1.451 albertel 5783: font-weight: bold;
5784: font-size: small;
1.507 raeburn 5785: text-align: center;
5786: }
1.795 www 5787:
1.589 raeburn 5788: table.LC_nested tr.LC_info_row td.LC_left_item,
5789: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5790: text-align: left;
1.451 albertel 5791: }
1.795 www 5792:
1.507 raeburn 5793: table.LC_nested td {
1.735 bisitz 5794: background-color: #FFFFFF;
1.451 albertel 5795: font-size: small;
1.507 raeburn 5796: }
1.795 www 5797:
1.507 raeburn 5798: table.LC_nested_outer tr th.LC_right_item,
5799: table.LC_nested tr.LC_info_row td.LC_right_item,
5800: table.LC_nested tr.LC_odd_row td.LC_right_item,
5801: table.LC_nested tr td.LC_right_item {
1.451 albertel 5802: text-align: right;
5803: }
5804:
1.507 raeburn 5805: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5806: background-color: #EEEEEE;
1.451 albertel 5807: }
5808:
1.473 raeburn 5809: table.LC_createuser {
5810: }
5811:
5812: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5813: font-size: small;
1.473 raeburn 5814: }
5815:
5816: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5817: background-color: #CCCCCC;
1.473 raeburn 5818: font-weight: bold;
5819: text-align: center;
5820: }
5821:
1.349 albertel 5822: table.LC_calendar {
5823: border: 1px solid #000000;
5824: border-collapse: collapse;
1.917 raeburn 5825: width: 98%;
1.349 albertel 5826: }
1.795 www 5827:
1.349 albertel 5828: table.LC_calendar_pickdate {
5829: font-size: xx-small;
5830: }
1.795 www 5831:
1.349 albertel 5832: table.LC_calendar tr td {
5833: border: 1px solid #000000;
5834: vertical-align: top;
1.917 raeburn 5835: width: 14%;
1.349 albertel 5836: }
1.795 www 5837:
1.349 albertel 5838: table.LC_calendar tr td.LC_calendar_day_empty {
5839: background-color: $data_table_dark;
5840: }
1.795 www 5841:
1.779 bisitz 5842: table.LC_calendar tr td.LC_calendar_day_current {
5843: background-color: $data_table_highlight;
1.777 tempelho 5844: }
1.795 www 5845:
1.938 bisitz 5846: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5847: background-color: $mail_new;
5848: }
1.795 www 5849:
1.938 bisitz 5850: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5851: background-color: $mail_new_hover;
5852: }
1.795 www 5853:
1.938 bisitz 5854: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5855: background-color: $mail_read;
5856: }
1.795 www 5857:
1.938 bisitz 5858: /*
5859: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5860: background-color: $mail_read_hover;
5861: }
1.938 bisitz 5862: */
1.795 www 5863:
1.938 bisitz 5864: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5865: background-color: $mail_replied;
5866: }
1.795 www 5867:
1.938 bisitz 5868: /*
5869: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5870: background-color: $mail_replied_hover;
5871: }
1.938 bisitz 5872: */
1.795 www 5873:
1.938 bisitz 5874: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5875: background-color: $mail_other;
5876: }
1.795 www 5877:
1.938 bisitz 5878: /*
5879: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5880: background-color: $mail_other_hover;
5881: }
1.938 bisitz 5882: */
1.494 raeburn 5883:
1.777 tempelho 5884: table.LC_data_table tr > td.LC_browser_file,
5885: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5886: background: #AAEE77;
1.389 albertel 5887: }
1.795 www 5888:
1.777 tempelho 5889: table.LC_data_table tr > td.LC_browser_file_locked,
5890: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5891: background: #FFAA99;
1.387 albertel 5892: }
1.795 www 5893:
1.777 tempelho 5894: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5895: background: #888888;
1.779 bisitz 5896: }
1.795 www 5897:
1.777 tempelho 5898: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 5899: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 5900: background: #F8F866;
1.777 tempelho 5901: }
1.795 www 5902:
1.696 bisitz 5903: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 5904: background: #E0E8FF;
1.387 albertel 5905: }
1.696 bisitz 5906:
1.707 bisitz 5907: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 5908: /* background: #77FF77; */
1.707 bisitz 5909: }
1.795 www 5910:
1.707 bisitz 5911: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 5912: border-right: 8px solid #FFFF77;
1.707 bisitz 5913: }
1.795 www 5914:
1.707 bisitz 5915: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 5916: border-right: 8px solid #FFAA77;
1.707 bisitz 5917: }
1.795 www 5918:
1.707 bisitz 5919: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 5920: border-right: 8px solid #FF7777;
1.707 bisitz 5921: }
1.795 www 5922:
1.707 bisitz 5923: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 5924: border-right: 8px solid #AAFF77;
1.707 bisitz 5925: }
1.795 www 5926:
1.707 bisitz 5927: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 5928: border-right: 8px solid #11CC55;
1.707 bisitz 5929: }
5930:
1.388 albertel 5931: span.LC_current_location {
1.701 harmsja 5932: font-size:larger;
1.388 albertel 5933: background: $pgbg;
5934: }
1.387 albertel 5935:
1.1029 www 5936: span.LC_current_nav_location {
5937: font-weight:bold;
5938: background: $sidebg;
5939: }
5940:
1.395 albertel 5941: span.LC_parm_menu_item {
5942: font-size: larger;
5943: }
1.795 www 5944:
1.395 albertel 5945: span.LC_parm_scope_all {
5946: color: red;
5947: }
1.795 www 5948:
1.395 albertel 5949: span.LC_parm_scope_folder {
5950: color: green;
5951: }
1.795 www 5952:
1.395 albertel 5953: span.LC_parm_scope_resource {
5954: color: orange;
5955: }
1.795 www 5956:
1.395 albertel 5957: span.LC_parm_part {
5958: color: blue;
5959: }
1.795 www 5960:
1.911 bisitz 5961: span.LC_parm_folder,
5962: span.LC_parm_symb {
1.395 albertel 5963: font-size: x-small;
5964: font-family: $mono;
5965: color: #AAAAAA;
5966: }
5967:
1.977 bisitz 5968: ul.LC_parm_parmlist li {
5969: display: inline-block;
5970: padding: 0.3em 0.8em;
5971: vertical-align: top;
5972: width: 150px;
5973: border-top:1px solid $lg_border_color;
5974: }
5975:
1.795 www 5976: td.LC_parm_overview_level_menu,
5977: td.LC_parm_overview_map_menu,
5978: td.LC_parm_overview_parm_selectors,
5979: td.LC_parm_overview_restrictions {
1.396 albertel 5980: border: 1px solid black;
5981: border-collapse: collapse;
5982: }
1.795 www 5983:
1.396 albertel 5984: table.LC_parm_overview_restrictions td {
5985: border-width: 1px 4px 1px 4px;
5986: border-style: solid;
5987: border-color: $pgbg;
5988: text-align: center;
5989: }
1.795 www 5990:
1.396 albertel 5991: table.LC_parm_overview_restrictions th {
5992: background: $tabbg;
5993: border-width: 1px 4px 1px 4px;
5994: border-style: solid;
5995: border-color: $pgbg;
5996: }
1.795 www 5997:
1.398 albertel 5998: table#LC_helpmenu {
1.803 bisitz 5999: border: none;
1.398 albertel 6000: height: 55px;
1.803 bisitz 6001: border-spacing: 0;
1.398 albertel 6002: }
6003:
6004: table#LC_helpmenu fieldset legend {
6005: font-size: larger;
6006: }
1.795 www 6007:
1.397 albertel 6008: table#LC_helpmenu_links {
6009: width: 100%;
6010: border: 1px solid black;
6011: background: $pgbg;
1.803 bisitz 6012: padding: 0;
1.397 albertel 6013: border-spacing: 1px;
6014: }
1.795 www 6015:
1.397 albertel 6016: table#LC_helpmenu_links tr td {
6017: padding: 1px;
6018: background: $tabbg;
1.399 albertel 6019: text-align: center;
6020: font-weight: bold;
1.397 albertel 6021: }
1.396 albertel 6022:
1.795 www 6023: table#LC_helpmenu_links a:link,
6024: table#LC_helpmenu_links a:visited,
1.397 albertel 6025: table#LC_helpmenu_links a:active {
6026: text-decoration: none;
6027: color: $font;
6028: }
1.795 www 6029:
1.397 albertel 6030: table#LC_helpmenu_links a:hover {
6031: text-decoration: underline;
6032: color: $vlink;
6033: }
1.396 albertel 6034:
1.417 albertel 6035: .LC_chrt_popup_exists {
6036: border: 1px solid #339933;
6037: margin: -1px;
6038: }
1.795 www 6039:
1.417 albertel 6040: .LC_chrt_popup_up {
6041: border: 1px solid yellow;
6042: margin: -1px;
6043: }
1.795 www 6044:
1.417 albertel 6045: .LC_chrt_popup {
6046: border: 1px solid #8888FF;
6047: background: #CCCCFF;
6048: }
1.795 www 6049:
1.421 albertel 6050: table.LC_pick_box {
6051: border-collapse: separate;
6052: background: white;
6053: border: 1px solid black;
6054: border-spacing: 1px;
6055: }
1.795 www 6056:
1.421 albertel 6057: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6058: background: $sidebg;
1.421 albertel 6059: font-weight: bold;
1.900 bisitz 6060: text-align: left;
1.740 bisitz 6061: vertical-align: top;
1.421 albertel 6062: width: 184px;
6063: padding: 8px;
6064: }
1.795 www 6065:
1.579 raeburn 6066: table.LC_pick_box td.LC_pick_box_value {
6067: text-align: left;
6068: padding: 8px;
6069: }
1.795 www 6070:
1.579 raeburn 6071: table.LC_pick_box td.LC_pick_box_select {
6072: text-align: left;
6073: padding: 8px;
6074: }
1.795 www 6075:
1.424 albertel 6076: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6077: padding: 0;
1.421 albertel 6078: height: 1px;
6079: background: black;
6080: }
1.795 www 6081:
1.421 albertel 6082: table.LC_pick_box td.LC_pick_box_submit {
6083: text-align: right;
6084: }
1.795 www 6085:
1.579 raeburn 6086: table.LC_pick_box td.LC_evenrow_value {
6087: text-align: left;
6088: padding: 8px;
6089: background-color: $data_table_light;
6090: }
1.795 www 6091:
1.579 raeburn 6092: table.LC_pick_box td.LC_oddrow_value {
6093: text-align: left;
6094: padding: 8px;
6095: background-color: $data_table_light;
6096: }
1.795 www 6097:
1.579 raeburn 6098: span.LC_helpform_receipt_cat {
6099: font-weight: bold;
6100: }
1.795 www 6101:
1.424 albertel 6102: table.LC_group_priv_box {
6103: background: white;
6104: border: 1px solid black;
6105: border-spacing: 1px;
6106: }
1.795 www 6107:
1.424 albertel 6108: table.LC_group_priv_box td.LC_pick_box_title {
6109: background: $tabbg;
6110: font-weight: bold;
6111: text-align: right;
6112: width: 184px;
6113: }
1.795 www 6114:
1.424 albertel 6115: table.LC_group_priv_box td.LC_groups_fixed {
6116: background: $data_table_light;
6117: text-align: center;
6118: }
1.795 www 6119:
1.424 albertel 6120: table.LC_group_priv_box td.LC_groups_optional {
6121: background: $data_table_dark;
6122: text-align: center;
6123: }
1.795 www 6124:
1.424 albertel 6125: table.LC_group_priv_box td.LC_groups_functionality {
6126: background: $data_table_darker;
6127: text-align: center;
6128: font-weight: bold;
6129: }
1.795 www 6130:
1.424 albertel 6131: table.LC_group_priv td {
6132: text-align: left;
1.803 bisitz 6133: padding: 0;
1.424 albertel 6134: }
6135:
6136: .LC_navbuttons {
6137: margin: 2ex 0ex 2ex 0ex;
6138: }
1.795 www 6139:
1.423 albertel 6140: .LC_topic_bar {
6141: font-weight: bold;
6142: background: $tabbg;
1.918 wenzelju 6143: margin: 1em 0em 1em 2em;
1.805 bisitz 6144: padding: 3px;
1.918 wenzelju 6145: font-size: 1.2em;
1.423 albertel 6146: }
1.795 www 6147:
1.423 albertel 6148: .LC_topic_bar span {
1.918 wenzelju 6149: left: 0.5em;
6150: position: absolute;
1.423 albertel 6151: vertical-align: middle;
1.918 wenzelju 6152: font-size: 1.2em;
1.423 albertel 6153: }
1.795 www 6154:
1.423 albertel 6155: table.LC_course_group_status {
6156: margin: 20px;
6157: }
1.795 www 6158:
1.423 albertel 6159: table.LC_status_selector td {
6160: vertical-align: top;
6161: text-align: center;
1.424 albertel 6162: padding: 4px;
6163: }
1.795 www 6164:
1.599 albertel 6165: div.LC_feedback_link {
1.616 albertel 6166: clear: both;
1.829 kalberla 6167: background: $sidebg;
1.779 bisitz 6168: width: 100%;
1.829 kalberla 6169: padding-bottom: 10px;
6170: border: 1px $tabbg solid;
1.833 kalberla 6171: height: 22px;
6172: line-height: 22px;
6173: padding-top: 5px;
6174: }
6175:
6176: div.LC_feedback_link img {
6177: height: 22px;
1.867 kalberla 6178: vertical-align:middle;
1.829 kalberla 6179: }
6180:
1.911 bisitz 6181: div.LC_feedback_link a {
1.829 kalberla 6182: text-decoration: none;
1.489 raeburn 6183: }
1.795 www 6184:
1.867 kalberla 6185: div.LC_comblock {
1.911 bisitz 6186: display:inline;
1.867 kalberla 6187: color:$font;
6188: font-size:90%;
6189: }
6190:
6191: div.LC_feedback_link div.LC_comblock {
6192: padding-left:5px;
6193: }
6194:
6195: div.LC_feedback_link div.LC_comblock a {
6196: color:$font;
6197: }
6198:
1.489 raeburn 6199: span.LC_feedback_link {
1.858 bisitz 6200: /* background: $feedback_link_bg; */
1.599 albertel 6201: font-size: larger;
6202: }
1.795 www 6203:
1.599 albertel 6204: span.LC_message_link {
1.858 bisitz 6205: /* background: $feedback_link_bg; */
1.599 albertel 6206: font-size: larger;
6207: position: absolute;
6208: right: 1em;
1.489 raeburn 6209: }
1.421 albertel 6210:
1.515 albertel 6211: table.LC_prior_tries {
1.524 albertel 6212: border: 1px solid #000000;
6213: border-collapse: separate;
6214: border-spacing: 1px;
1.515 albertel 6215: }
1.523 albertel 6216:
1.515 albertel 6217: table.LC_prior_tries td {
1.524 albertel 6218: padding: 2px;
1.515 albertel 6219: }
1.523 albertel 6220:
6221: .LC_answer_correct {
1.795 www 6222: background: lightgreen;
6223: color: darkgreen;
6224: padding: 6px;
1.523 albertel 6225: }
1.795 www 6226:
1.523 albertel 6227: .LC_answer_charged_try {
1.797 www 6228: background: #FFAAAA;
1.795 www 6229: color: darkred;
6230: padding: 6px;
1.523 albertel 6231: }
1.795 www 6232:
1.779 bisitz 6233: .LC_answer_not_charged_try,
1.523 albertel 6234: .LC_answer_no_grade,
6235: .LC_answer_late {
1.795 www 6236: background: lightyellow;
1.523 albertel 6237: color: black;
1.795 www 6238: padding: 6px;
1.523 albertel 6239: }
1.795 www 6240:
1.523 albertel 6241: .LC_answer_previous {
1.795 www 6242: background: lightblue;
6243: color: darkblue;
6244: padding: 6px;
1.523 albertel 6245: }
1.795 www 6246:
1.779 bisitz 6247: .LC_answer_no_message {
1.777 tempelho 6248: background: #FFFFFF;
6249: color: black;
1.795 www 6250: padding: 6px;
1.779 bisitz 6251: }
1.795 www 6252:
1.779 bisitz 6253: .LC_answer_unknown {
6254: background: orange;
6255: color: black;
1.795 www 6256: padding: 6px;
1.777 tempelho 6257: }
1.795 www 6258:
1.529 albertel 6259: span.LC_prior_numerical,
6260: span.LC_prior_string,
6261: span.LC_prior_custom,
6262: span.LC_prior_reaction,
6263: span.LC_prior_math {
1.925 bisitz 6264: font-family: $mono;
1.523 albertel 6265: white-space: pre;
6266: }
6267:
1.525 albertel 6268: span.LC_prior_string {
1.925 bisitz 6269: font-family: $mono;
1.525 albertel 6270: white-space: pre;
6271: }
6272:
1.523 albertel 6273: table.LC_prior_option {
6274: width: 100%;
6275: border-collapse: collapse;
6276: }
1.795 www 6277:
1.911 bisitz 6278: table.LC_prior_rank,
1.795 www 6279: table.LC_prior_match {
1.528 albertel 6280: border-collapse: collapse;
6281: }
1.795 www 6282:
1.528 albertel 6283: table.LC_prior_option tr td,
6284: table.LC_prior_rank tr td,
6285: table.LC_prior_match tr td {
1.524 albertel 6286: border: 1px solid #000000;
1.515 albertel 6287: }
6288:
1.855 bisitz 6289: .LC_nobreak {
1.544 albertel 6290: white-space: nowrap;
1.519 raeburn 6291: }
6292:
1.576 raeburn 6293: span.LC_cusr_emph {
6294: font-style: italic;
6295: }
6296:
1.633 raeburn 6297: span.LC_cusr_subheading {
6298: font-weight: normal;
6299: font-size: 85%;
6300: }
6301:
1.861 bisitz 6302: div.LC_docs_entry_move {
1.859 bisitz 6303: border: 1px solid #BBBBBB;
1.545 albertel 6304: background: #DDDDDD;
1.861 bisitz 6305: width: 22px;
1.859 bisitz 6306: padding: 1px;
6307: margin: 0;
1.545 albertel 6308: }
6309:
1.861 bisitz 6310: table.LC_data_table tr > td.LC_docs_entry_commands,
6311: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6312: font-size: x-small;
6313: }
1.795 www 6314:
1.861 bisitz 6315: .LC_docs_entry_parameter {
6316: white-space: nowrap;
6317: }
6318:
1.544 albertel 6319: .LC_docs_copy {
1.545 albertel 6320: color: #000099;
1.544 albertel 6321: }
1.795 www 6322:
1.544 albertel 6323: .LC_docs_cut {
1.545 albertel 6324: color: #550044;
1.544 albertel 6325: }
1.795 www 6326:
1.544 albertel 6327: .LC_docs_rename {
1.545 albertel 6328: color: #009900;
1.544 albertel 6329: }
1.795 www 6330:
1.544 albertel 6331: .LC_docs_remove {
1.545 albertel 6332: color: #990000;
6333: }
6334:
1.547 albertel 6335: .LC_docs_reinit_warn,
6336: .LC_docs_ext_edit {
6337: font-size: x-small;
6338: }
6339:
1.545 albertel 6340: table.LC_docs_adddocs td,
6341: table.LC_docs_adddocs th {
6342: border: 1px solid #BBBBBB;
6343: padding: 4px;
6344: background: #DDDDDD;
1.543 albertel 6345: }
6346:
1.584 albertel 6347: table.LC_sty_begin {
6348: background: #BBFFBB;
6349: }
1.795 www 6350:
1.584 albertel 6351: table.LC_sty_end {
6352: background: #FFBBBB;
6353: }
6354:
1.589 raeburn 6355: table.LC_double_column {
1.803 bisitz 6356: border-width: 0;
1.589 raeburn 6357: border-collapse: collapse;
6358: width: 100%;
6359: padding: 2px;
6360: }
6361:
6362: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6363: top: 2px;
1.589 raeburn 6364: left: 2px;
6365: width: 47%;
6366: vertical-align: top;
6367: }
6368:
6369: table.LC_double_column tr td.LC_right_col {
6370: top: 2px;
1.779 bisitz 6371: right: 2px;
1.589 raeburn 6372: width: 47%;
6373: vertical-align: top;
6374: }
6375:
1.591 raeburn 6376: div.LC_left_float {
6377: float: left;
6378: padding-right: 5%;
1.597 albertel 6379: padding-bottom: 4px;
1.591 raeburn 6380: }
6381:
6382: div.LC_clear_float_header {
1.597 albertel 6383: padding-bottom: 2px;
1.591 raeburn 6384: }
6385:
6386: div.LC_clear_float_footer {
1.597 albertel 6387: padding-top: 10px;
1.591 raeburn 6388: clear: both;
6389: }
6390:
1.597 albertel 6391: div.LC_grade_show_user {
1.941 bisitz 6392: /* border-left: 5px solid $sidebg; */
6393: border-top: 5px solid #000000;
6394: margin: 50px 0 0 0;
1.936 bisitz 6395: padding: 15px 0 5px 10px;
1.597 albertel 6396: }
1.795 www 6397:
1.936 bisitz 6398: div.LC_grade_show_user_odd_row {
1.941 bisitz 6399: /* border-left: 5px solid #000000; */
6400: }
6401:
6402: div.LC_grade_show_user div.LC_Box {
6403: margin-right: 50px;
1.597 albertel 6404: }
6405:
6406: div.LC_grade_submissions,
6407: div.LC_grade_message_center,
1.936 bisitz 6408: div.LC_grade_info_links {
1.597 albertel 6409: margin: 5px;
6410: width: 99%;
6411: background: #FFFFFF;
6412: }
1.795 www 6413:
1.597 albertel 6414: div.LC_grade_submissions_header,
1.936 bisitz 6415: div.LC_grade_message_center_header {
1.705 tempelho 6416: font-weight: bold;
6417: font-size: large;
1.597 albertel 6418: }
1.795 www 6419:
1.597 albertel 6420: div.LC_grade_submissions_body,
1.936 bisitz 6421: div.LC_grade_message_center_body {
1.597 albertel 6422: border: 1px solid black;
6423: width: 99%;
6424: background: #FFFFFF;
6425: }
1.795 www 6426:
1.613 albertel 6427: table.LC_scantron_action {
6428: width: 100%;
6429: }
1.795 www 6430:
1.613 albertel 6431: table.LC_scantron_action tr th {
1.698 harmsja 6432: font-weight:bold;
6433: font-style:normal;
1.613 albertel 6434: }
1.795 www 6435:
1.779 bisitz 6436: .LC_edit_problem_header,
1.614 albertel 6437: div.LC_edit_problem_footer {
1.705 tempelho 6438: font-weight: normal;
6439: font-size: medium;
1.602 albertel 6440: margin: 2px;
1.1060 bisitz 6441: background-color: $sidebg;
1.600 albertel 6442: }
1.795 www 6443:
1.600 albertel 6444: div.LC_edit_problem_header,
1.602 albertel 6445: div.LC_edit_problem_header div,
1.614 albertel 6446: div.LC_edit_problem_footer,
6447: div.LC_edit_problem_footer div,
1.602 albertel 6448: div.LC_edit_problem_editxml_header,
6449: div.LC_edit_problem_editxml_header div {
1.600 albertel 6450: margin-top: 5px;
6451: }
1.795 www 6452:
1.600 albertel 6453: div.LC_edit_problem_header_title {
1.705 tempelho 6454: font-weight: bold;
6455: font-size: larger;
1.602 albertel 6456: background: $tabbg;
6457: padding: 3px;
1.1060 bisitz 6458: margin: 0 0 5px 0;
1.602 albertel 6459: }
1.795 www 6460:
1.602 albertel 6461: table.LC_edit_problem_header_title {
6462: width: 100%;
1.600 albertel 6463: background: $tabbg;
1.602 albertel 6464: }
6465:
6466: div.LC_edit_problem_discards {
6467: float: left;
6468: padding-bottom: 5px;
6469: }
1.795 www 6470:
1.602 albertel 6471: div.LC_edit_problem_saves {
6472: float: right;
6473: padding-bottom: 5px;
1.600 albertel 6474: }
1.795 www 6475:
1.911 bisitz 6476: img.stift {
1.803 bisitz 6477: border-width: 0;
6478: vertical-align: middle;
1.677 riegler 6479: }
1.680 riegler 6480:
1.923 bisitz 6481: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6482: vertical-align: top;
1.777 tempelho 6483: }
1.795 www 6484:
1.716 raeburn 6485: div.LC_createcourse {
1.911 bisitz 6486: margin: 10px 10px 10px 10px;
1.716 raeburn 6487: }
6488:
1.917 raeburn 6489: .LC_dccid {
6490: margin: 0.2em 0 0 0;
6491: padding: 0;
6492: font-size: 90%;
6493: display:none;
6494: }
6495:
1.897 wenzelju 6496: ol.LC_primary_menu a:hover,
1.721 harmsja 6497: ol#LC_MenuBreadcrumbs a:hover,
6498: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6499: ul#LC_secondary_menu a:hover,
1.721 harmsja 6500: .LC_FormSectionClearButton input:hover
1.795 www 6501: ul.LC_TabContent li:hover a {
1.952 onken 6502: color:$button_hover;
1.911 bisitz 6503: text-decoration:none;
1.693 droeschl 6504: }
6505:
1.779 bisitz 6506: h1 {
1.911 bisitz 6507: padding: 0;
6508: line-height:130%;
1.693 droeschl 6509: }
1.698 harmsja 6510:
1.911 bisitz 6511: h2,
6512: h3,
6513: h4,
6514: h5,
6515: h6 {
6516: margin: 5px 0 5px 0;
6517: padding: 0;
6518: line-height:130%;
1.693 droeschl 6519: }
1.795 www 6520:
6521: .LC_hcell {
1.911 bisitz 6522: padding:3px 15px 3px 15px;
6523: margin: 0;
6524: background-color:$tabbg;
6525: color:$fontmenu;
6526: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6527: }
1.795 www 6528:
1.840 bisitz 6529: .LC_Box > .LC_hcell {
1.911 bisitz 6530: margin: 0 -10px 10px -10px;
1.835 bisitz 6531: }
6532:
1.721 harmsja 6533: .LC_noBorder {
1.911 bisitz 6534: border: 0;
1.698 harmsja 6535: }
1.693 droeschl 6536:
1.721 harmsja 6537: .LC_FormSectionClearButton input {
1.911 bisitz 6538: background-color:transparent;
6539: border: none;
6540: cursor:pointer;
6541: text-decoration:underline;
1.693 droeschl 6542: }
1.763 bisitz 6543:
6544: .LC_help_open_topic {
1.911 bisitz 6545: color: #FFFFFF;
6546: background-color: #EEEEFF;
6547: margin: 1px;
6548: padding: 4px;
6549: border: 1px solid #000033;
6550: white-space: nowrap;
6551: /* vertical-align: middle; */
1.759 neumanie 6552: }
1.693 droeschl 6553:
1.911 bisitz 6554: dl,
6555: ul,
6556: div,
6557: fieldset {
6558: margin: 10px 10px 10px 0;
6559: /* overflow: hidden; */
1.693 droeschl 6560: }
1.795 www 6561:
1.838 bisitz 6562: fieldset > legend {
1.911 bisitz 6563: font-weight: bold;
6564: padding: 0 5px 0 5px;
1.838 bisitz 6565: }
6566:
1.813 bisitz 6567: #LC_nav_bar {
1.911 bisitz 6568: float: left;
1.995 raeburn 6569: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6570: margin: 0 0 2px 0;
1.807 droeschl 6571: }
6572:
1.916 droeschl 6573: #LC_realm {
6574: margin: 0.2em 0 0 0;
6575: padding: 0;
6576: font-weight: bold;
6577: text-align: center;
1.995 raeburn 6578: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6579: }
6580:
1.911 bisitz 6581: #LC_nav_bar em {
6582: font-weight: bold;
6583: font-style: normal;
1.807 droeschl 6584: }
6585:
1.897 wenzelju 6586: ol.LC_primary_menu {
1.911 bisitz 6587: float: right;
1.934 droeschl 6588: margin: 0;
1.1076 raeburn 6589: padding: 0;
1.995 raeburn 6590: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6591: }
6592:
1.852 droeschl 6593: ol#LC_PathBreadcrumbs {
1.911 bisitz 6594: margin: 0;
1.693 droeschl 6595: }
6596:
1.897 wenzelju 6597: ol.LC_primary_menu li {
1.1076 raeburn 6598: color: RGB(80, 80, 80);
6599: vertical-align: middle;
6600: text-align: left;
6601: list-style: none;
6602: float: left;
6603: }
6604:
6605: ol.LC_primary_menu li a {
6606: display: block;
6607: margin: 0;
6608: padding: 0 5px 0 10px;
6609: text-decoration: none;
6610: }
6611:
6612: ol.LC_primary_menu li ul {
6613: display: none;
6614: width: 10em;
6615: background-color: $data_table_light;
6616: }
6617:
6618: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6619: display: block;
6620: position: absolute;
6621: margin: 0;
6622: padding: 0;
1.1078 raeburn 6623: z-index: 2;
1.1076 raeburn 6624: }
6625:
6626: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6627: font-size: 90%;
1.911 bisitz 6628: vertical-align: top;
1.1076 raeburn 6629: float: none;
1.1079 raeburn 6630: border-left: 1px solid black;
6631: border-right: 1px solid black;
1.1076 raeburn 6632: }
6633:
6634: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078 raeburn 6635: background-color:$data_table_light;
1.1076 raeburn 6636: }
6637:
6638: ol.LC_primary_menu li li a:hover {
6639: color:$button_hover;
6640: background-color:$data_table_dark;
1.693 droeschl 6641: }
6642:
1.897 wenzelju 6643: ol.LC_primary_menu li img {
1.911 bisitz 6644: vertical-align: bottom;
1.934 droeschl 6645: height: 1.1em;
1.1077 raeburn 6646: margin: 0.2em 0 0 0;
1.693 droeschl 6647: }
6648:
1.897 wenzelju 6649: ol.LC_primary_menu a {
1.911 bisitz 6650: color: RGB(80, 80, 80);
6651: text-decoration: none;
1.693 droeschl 6652: }
1.795 www 6653:
1.949 droeschl 6654: ol.LC_primary_menu a.LC_new_message {
6655: font-weight:bold;
6656: color: darkred;
6657: }
6658:
1.975 raeburn 6659: ol.LC_docs_parameters {
6660: margin-left: 0;
6661: padding: 0;
6662: list-style: none;
6663: }
6664:
6665: ol.LC_docs_parameters li {
6666: margin: 0;
6667: padding-right: 20px;
6668: display: inline;
6669: }
6670:
1.976 raeburn 6671: ol.LC_docs_parameters li:before {
6672: content: "\\002022 \\0020";
6673: }
6674:
6675: li.LC_docs_parameters_title {
6676: font-weight: bold;
6677: }
6678:
6679: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6680: content: "";
6681: }
6682:
1.897 wenzelju 6683: ul#LC_secondary_menu {
1.1107 raeburn 6684: clear: right;
1.911 bisitz 6685: color: $fontmenu;
6686: background: $tabbg;
6687: list-style: none;
6688: padding: 0;
6689: margin: 0;
6690: width: 100%;
1.995 raeburn 6691: text-align: left;
1.1107 raeburn 6692: float: left;
1.808 droeschl 6693: }
6694:
1.897 wenzelju 6695: ul#LC_secondary_menu li {
1.911 bisitz 6696: font-weight: bold;
6697: line-height: 1.8em;
1.1107 raeburn 6698: border-right: 1px solid black;
6699: float: left;
6700: }
6701:
6702: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6703: background-color: $data_table_light;
6704: }
6705:
6706: ul#LC_secondary_menu li a {
1.911 bisitz 6707: padding: 0 0.8em;
1.1107 raeburn 6708: }
6709:
6710: ul#LC_secondary_menu li ul {
6711: display: none;
6712: }
6713:
6714: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6715: display: block;
6716: position: absolute;
6717: margin: 0;
6718: padding: 0;
6719: list-style:none;
6720: float: none;
6721: background-color: $data_table_light;
6722: z-index: 2;
6723: margin-left: -1px;
6724: }
6725:
6726: ul#LC_secondary_menu li ul li {
6727: font-size: 90%;
6728: vertical-align: top;
6729: border-left: 1px solid black;
1.911 bisitz 6730: border-right: 1px solid black;
1.1107 raeburn 6731: background-color: $data_table_light
6732: list-style:none;
6733: float: none;
6734: }
6735:
6736: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6737: background-color: $data_table_dark;
1.807 droeschl 6738: }
6739:
1.847 tempelho 6740: ul.LC_TabContent {
1.911 bisitz 6741: display:block;
6742: background: $sidebg;
6743: border-bottom: solid 1px $lg_border_color;
6744: list-style:none;
1.1020 raeburn 6745: margin: -1px -10px 0 -10px;
1.911 bisitz 6746: padding: 0;
1.693 droeschl 6747: }
6748:
1.795 www 6749: ul.LC_TabContent li,
6750: ul.LC_TabContentBigger li {
1.911 bisitz 6751: float:left;
1.741 harmsja 6752: }
1.795 www 6753:
1.897 wenzelju 6754: ul#LC_secondary_menu li a {
1.911 bisitz 6755: color: $fontmenu;
6756: text-decoration: none;
1.693 droeschl 6757: }
1.795 www 6758:
1.721 harmsja 6759: ul.LC_TabContent {
1.952 onken 6760: min-height:20px;
1.721 harmsja 6761: }
1.795 www 6762:
6763: ul.LC_TabContent li {
1.911 bisitz 6764: vertical-align:middle;
1.959 onken 6765: padding: 0 16px 0 10px;
1.911 bisitz 6766: background-color:$tabbg;
6767: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6768: border-left: solid 1px $font;
1.721 harmsja 6769: }
1.795 www 6770:
1.847 tempelho 6771: ul.LC_TabContent .right {
1.911 bisitz 6772: float:right;
1.847 tempelho 6773: }
6774:
1.911 bisitz 6775: ul.LC_TabContent li a,
6776: ul.LC_TabContent li {
6777: color:rgb(47,47,47);
6778: text-decoration:none;
6779: font-size:95%;
6780: font-weight:bold;
1.952 onken 6781: min-height:20px;
6782: }
6783:
1.959 onken 6784: ul.LC_TabContent li a:hover,
6785: ul.LC_TabContent li a:focus {
1.952 onken 6786: color: $button_hover;
1.959 onken 6787: background:none;
6788: outline:none;
1.952 onken 6789: }
6790:
6791: ul.LC_TabContent li:hover {
6792: color: $button_hover;
6793: cursor:pointer;
1.721 harmsja 6794: }
1.795 www 6795:
1.911 bisitz 6796: ul.LC_TabContent li.active {
1.952 onken 6797: color: $font;
1.911 bisitz 6798: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6799: border-bottom:solid 1px #FFFFFF;
6800: cursor: default;
1.744 ehlerst 6801: }
1.795 www 6802:
1.959 onken 6803: ul.LC_TabContent li.active a {
6804: color:$font;
6805: background:#FFFFFF;
6806: outline: none;
6807: }
1.1047 raeburn 6808:
6809: ul.LC_TabContent li.goback {
6810: float: left;
6811: border-left: none;
6812: }
6813:
1.870 tempelho 6814: #maincoursedoc {
1.911 bisitz 6815: clear:both;
1.870 tempelho 6816: }
6817:
6818: ul.LC_TabContentBigger {
1.911 bisitz 6819: display:block;
6820: list-style:none;
6821: padding: 0;
1.870 tempelho 6822: }
6823:
1.795 www 6824: ul.LC_TabContentBigger li {
1.911 bisitz 6825: vertical-align:bottom;
6826: height: 30px;
6827: font-size:110%;
6828: font-weight:bold;
6829: color: #737373;
1.841 tempelho 6830: }
6831:
1.957 onken 6832: ul.LC_TabContentBigger li.active {
6833: position: relative;
6834: top: 1px;
6835: }
6836:
1.870 tempelho 6837: ul.LC_TabContentBigger li a {
1.911 bisitz 6838: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6839: height: 30px;
6840: line-height: 30px;
6841: text-align: center;
6842: display: block;
6843: text-decoration: none;
1.958 onken 6844: outline: none;
1.741 harmsja 6845: }
1.795 www 6846:
1.870 tempelho 6847: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6848: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6849: color:$font;
1.744 ehlerst 6850: }
1.795 www 6851:
1.870 tempelho 6852: ul.LC_TabContentBigger li b {
1.911 bisitz 6853: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6854: display: block;
6855: float: left;
6856: padding: 0 30px;
1.957 onken 6857: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6858: }
6859:
1.956 onken 6860: ul.LC_TabContentBigger li:hover b {
6861: color:$button_hover;
6862: }
6863:
1.870 tempelho 6864: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6865: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6866: color:$font;
1.957 onken 6867: border: 0;
1.741 harmsja 6868: }
1.693 droeschl 6869:
1.870 tempelho 6870:
1.862 bisitz 6871: ul.LC_CourseBreadcrumbs {
6872: background: $sidebg;
1.1020 raeburn 6873: height: 2em;
1.862 bisitz 6874: padding-left: 10px;
1.1020 raeburn 6875: margin: 0;
1.862 bisitz 6876: list-style-position: inside;
6877: }
6878:
1.911 bisitz 6879: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6880: ol#LC_PathBreadcrumbs {
1.911 bisitz 6881: padding-left: 10px;
6882: margin: 0;
1.933 droeschl 6883: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 6884: }
6885:
1.911 bisitz 6886: ol#LC_MenuBreadcrumbs li,
6887: ol#LC_PathBreadcrumbs li,
1.862 bisitz 6888: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 6889: display: inline;
1.933 droeschl 6890: white-space: normal;
1.693 droeschl 6891: }
6892:
1.823 bisitz 6893: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 6894: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 6895: text-decoration: none;
6896: font-size:90%;
1.693 droeschl 6897: }
1.795 www 6898:
1.969 droeschl 6899: ol#LC_MenuBreadcrumbs h1 {
6900: display: inline;
6901: font-size: 90%;
6902: line-height: 2.5em;
6903: margin: 0;
6904: padding: 0;
6905: }
6906:
1.795 www 6907: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 6908: text-decoration:none;
6909: font-size:100%;
6910: font-weight:bold;
1.693 droeschl 6911: }
1.795 www 6912:
1.840 bisitz 6913: .LC_Box {
1.911 bisitz 6914: border: solid 1px $lg_border_color;
6915: padding: 0 10px 10px 10px;
1.746 neumanie 6916: }
1.795 www 6917:
1.1020 raeburn 6918: .LC_DocsBox {
6919: border: solid 1px $lg_border_color;
6920: padding: 0 0 10px 10px;
6921: }
6922:
1.795 www 6923: .LC_AboutMe_Image {
1.911 bisitz 6924: float:left;
6925: margin-right:10px;
1.747 neumanie 6926: }
1.795 www 6927:
6928: .LC_Clear_AboutMe_Image {
1.911 bisitz 6929: clear:left;
1.747 neumanie 6930: }
1.795 www 6931:
1.721 harmsja 6932: dl.LC_ListStyleClean dt {
1.911 bisitz 6933: padding-right: 5px;
6934: display: table-header-group;
1.693 droeschl 6935: }
6936:
1.721 harmsja 6937: dl.LC_ListStyleClean dd {
1.911 bisitz 6938: display: table-row;
1.693 droeschl 6939: }
6940:
1.721 harmsja 6941: .LC_ListStyleClean,
6942: .LC_ListStyleSimple,
6943: .LC_ListStyleNormal,
1.795 www 6944: .LC_ListStyleSpecial {
1.911 bisitz 6945: /* display:block; */
6946: list-style-position: inside;
6947: list-style-type: none;
6948: overflow: hidden;
6949: padding: 0;
1.693 droeschl 6950: }
6951:
1.721 harmsja 6952: .LC_ListStyleSimple li,
6953: .LC_ListStyleSimple dd,
6954: .LC_ListStyleNormal li,
6955: .LC_ListStyleNormal dd,
6956: .LC_ListStyleSpecial li,
1.795 www 6957: .LC_ListStyleSpecial dd {
1.911 bisitz 6958: margin: 0;
6959: padding: 5px 5px 5px 10px;
6960: clear: both;
1.693 droeschl 6961: }
6962:
1.721 harmsja 6963: .LC_ListStyleClean li,
6964: .LC_ListStyleClean dd {
1.911 bisitz 6965: padding-top: 0;
6966: padding-bottom: 0;
1.693 droeschl 6967: }
6968:
1.721 harmsja 6969: .LC_ListStyleSimple dd,
1.795 www 6970: .LC_ListStyleSimple li {
1.911 bisitz 6971: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 6972: }
6973:
1.721 harmsja 6974: .LC_ListStyleSpecial li,
6975: .LC_ListStyleSpecial dd {
1.911 bisitz 6976: list-style-type: none;
6977: background-color: RGB(220, 220, 220);
6978: margin-bottom: 4px;
1.693 droeschl 6979: }
6980:
1.721 harmsja 6981: table.LC_SimpleTable {
1.911 bisitz 6982: margin:5px;
6983: border:solid 1px $lg_border_color;
1.795 www 6984: }
1.693 droeschl 6985:
1.721 harmsja 6986: table.LC_SimpleTable tr {
1.911 bisitz 6987: padding: 0;
6988: border:solid 1px $lg_border_color;
1.693 droeschl 6989: }
1.795 www 6990:
6991: table.LC_SimpleTable thead {
1.911 bisitz 6992: background:rgb(220,220,220);
1.693 droeschl 6993: }
6994:
1.721 harmsja 6995: div.LC_columnSection {
1.911 bisitz 6996: display: block;
6997: clear: both;
6998: overflow: hidden;
6999: margin: 0;
1.693 droeschl 7000: }
7001:
1.721 harmsja 7002: div.LC_columnSection>* {
1.911 bisitz 7003: float: left;
7004: margin: 10px 20px 10px 0;
7005: overflow:hidden;
1.693 droeschl 7006: }
1.721 harmsja 7007:
1.795 www 7008: table em {
1.911 bisitz 7009: font-weight: bold;
7010: font-style: normal;
1.748 schulted 7011: }
1.795 www 7012:
1.779 bisitz 7013: table.LC_tableBrowseRes,
1.795 www 7014: table.LC_tableOfContent {
1.911 bisitz 7015: border:none;
7016: border-spacing: 1px;
7017: padding: 3px;
7018: background-color: #FFFFFF;
7019: font-size: 90%;
1.753 droeschl 7020: }
1.789 droeschl 7021:
1.911 bisitz 7022: table.LC_tableOfContent {
7023: border-collapse: collapse;
1.789 droeschl 7024: }
7025:
1.771 droeschl 7026: table.LC_tableBrowseRes a,
1.768 schulted 7027: table.LC_tableOfContent a {
1.911 bisitz 7028: background-color: transparent;
7029: text-decoration: none;
1.753 droeschl 7030: }
7031:
1.795 www 7032: table.LC_tableOfContent img {
1.911 bisitz 7033: border: none;
7034: height: 1.3em;
7035: vertical-align: text-bottom;
7036: margin-right: 0.3em;
1.753 droeschl 7037: }
1.757 schulted 7038:
1.795 www 7039: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7040: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7041: }
7042:
1.795 www 7043: a#LC_content_toolbar_everything {
1.911 bisitz 7044: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7045: }
7046:
1.795 www 7047: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7048: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7049: }
7050:
1.795 www 7051: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7052: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7053: }
7054:
1.795 www 7055: a#LC_content_toolbar_changefolder {
1.911 bisitz 7056: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7057: }
7058:
1.795 www 7059: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7060: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7061: }
7062:
1.1043 raeburn 7063: a#LC_content_toolbar_edittoplevel {
7064: background-image:url(/res/adm/pages/edittoplevel.gif);
7065: }
7066:
1.795 www 7067: ul#LC_toolbar li a:hover {
1.911 bisitz 7068: background-position: bottom center;
1.757 schulted 7069: }
7070:
1.795 www 7071: ul#LC_toolbar {
1.911 bisitz 7072: padding: 0;
7073: margin: 2px;
7074: list-style:none;
7075: position:relative;
7076: background-color:white;
1.1082 raeburn 7077: overflow: auto;
1.757 schulted 7078: }
7079:
1.795 www 7080: ul#LC_toolbar li {
1.911 bisitz 7081: border:1px solid white;
7082: padding: 0;
7083: margin: 0;
7084: float: left;
7085: display:inline;
7086: vertical-align:middle;
1.1082 raeburn 7087: white-space: nowrap;
1.911 bisitz 7088: }
1.757 schulted 7089:
1.783 amueller 7090:
1.795 www 7091: a.LC_toolbarItem {
1.911 bisitz 7092: display:block;
7093: padding: 0;
7094: margin: 0;
7095: height: 32px;
7096: width: 32px;
7097: color:white;
7098: border: none;
7099: background-repeat:no-repeat;
7100: background-color:transparent;
1.757 schulted 7101: }
7102:
1.915 droeschl 7103: ul.LC_funclist {
7104: margin: 0;
7105: padding: 0.5em 1em 0.5em 0;
7106: }
7107:
1.933 droeschl 7108: ul.LC_funclist > li:first-child {
7109: font-weight:bold;
7110: margin-left:0.8em;
7111: }
7112:
1.915 droeschl 7113: ul.LC_funclist + ul.LC_funclist {
7114: /*
7115: left border as a seperator if we have more than
7116: one list
7117: */
7118: border-left: 1px solid $sidebg;
7119: /*
7120: this hides the left border behind the border of the
7121: outer box if element is wrapped to the next 'line'
7122: */
7123: margin-left: -1px;
7124: }
7125:
1.843 bisitz 7126: ul.LC_funclist li {
1.915 droeschl 7127: display: inline;
1.782 bisitz 7128: white-space: nowrap;
1.915 droeschl 7129: margin: 0 0 0 25px;
7130: line-height: 150%;
1.782 bisitz 7131: }
7132:
1.974 wenzelju 7133: .LC_hidden {
7134: display: none;
7135: }
7136:
1.1030 www 7137: .LCmodal-overlay {
7138: position:fixed;
7139: top:0;
7140: right:0;
7141: bottom:0;
7142: left:0;
7143: height:100%;
7144: width:100%;
7145: margin:0;
7146: padding:0;
7147: background:#999;
7148: opacity:.75;
7149: filter: alpha(opacity=75);
7150: -moz-opacity: 0.75;
7151: z-index:101;
7152: }
7153:
7154: * html .LCmodal-overlay {
7155: position: absolute;
7156: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7157: }
7158:
7159: .LCmodal-window {
7160: position:fixed;
7161: top:50%;
7162: left:50%;
7163: margin:0;
7164: padding:0;
7165: z-index:102;
7166: }
7167:
7168: * html .LCmodal-window {
7169: position:absolute;
7170: }
7171:
7172: .LCclose-window {
7173: position:absolute;
7174: width:32px;
7175: height:32px;
7176: right:8px;
7177: top:8px;
7178: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7179: text-indent:-99999px;
7180: overflow:hidden;
7181: cursor:pointer;
7182: }
7183:
1.1100 raeburn 7184: /*
7185: styles used by TTH when "Default set of options to pass to tth/m
7186: when converting TeX" in course settings has been set
7187:
7188: option passed: -t
7189:
7190: */
7191:
7192: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7193: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7194: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7195: td div.norm {line-height:normal;}
7196:
7197: /*
7198: option passed -y3
7199: */
7200:
7201: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7202: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7203: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7204:
1.343 albertel 7205: END
7206: }
7207:
1.306 albertel 7208: =pod
7209:
7210: =item * &headtag()
7211:
7212: Returns a uniform footer for LON-CAPA web pages.
7213:
1.307 albertel 7214: Inputs: $title - optional title for the head
7215: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7216: $args - optional arguments
1.319 albertel 7217: force_register - if is true call registerurl so the remote is
7218: informed
1.415 albertel 7219: redirect -> array ref of
7220: 1- seconds before redirect occurs
7221: 2- url to redirect to
7222: 3- whether the side effect should occur
1.315 albertel 7223: (side effect of setting
7224: $env{'internal.head.redirect'} to the url
7225: redirected too)
1.352 albertel 7226: domain -> force to color decorate a page for a specific
7227: domain
7228: function -> force usage of a specific rolish color scheme
7229: bgcolor -> override the default page bgcolor
1.460 albertel 7230: no_auto_mt_title
7231: -> prevent &mt()ing the title arg
1.464 albertel 7232:
1.306 albertel 7233: =cut
7234:
7235: sub headtag {
1.313 albertel 7236: my ($title,$head_extra,$args) = @_;
1.306 albertel 7237:
1.363 albertel 7238: my $function = $args->{'function'} || &get_users_function();
7239: my $domain = $args->{'domain'} || &determinedomain();
7240: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.418 albertel 7241: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7242: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7243: #time(),
1.418 albertel 7244: $env{'environment.color.timestamp'},
1.363 albertel 7245: $function,$domain,$bgcolor);
7246:
1.369 www 7247: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7248:
1.308 albertel 7249: my $result =
7250: '<head>'.
1.461 albertel 7251: &font_settings();
1.319 albertel 7252:
1.1064 raeburn 7253: my $inhibitprint = &print_suppression();
7254:
1.461 albertel 7255: if (!$args->{'frameset'}) {
7256: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7257: }
1.962 droeschl 7258: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7259: $result .= Apache::lonxml::display_title();
1.319 albertel 7260: }
1.436 albertel 7261: if (!$args->{'no_nav_bar'}
7262: && !$args->{'only_body'}
7263: && !$args->{'frameset'}) {
7264: $result .= &help_menu_js();
1.1032 www 7265: $result.=&modal_window();
1.1038 www 7266: $result.=&togglebox_script();
1.1034 www 7267: $result.=&wishlist_window();
1.1041 www 7268: $result.=&LCprogressbarUpdate_script();
1.1034 www 7269: } else {
7270: if ($args->{'add_modal'}) {
7271: $result.=&modal_window();
7272: }
7273: if ($args->{'add_wishlist'}) {
7274: $result.=&wishlist_window();
7275: }
1.1038 www 7276: if ($args->{'add_togglebox'}) {
7277: $result.=&togglebox_script();
7278: }
1.1041 www 7279: if ($args->{'add_progressbar'}) {
7280: $result.=&LCprogressbarUpdate_script();
7281: }
1.436 albertel 7282: }
1.314 albertel 7283: if (ref($args->{'redirect'})) {
1.414 albertel 7284: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7285: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7286: if (!$inhibit_continue) {
7287: $env{'internal.head.redirect'} = $url;
7288: }
1.313 albertel 7289: $result.=<<ADDMETA
7290: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7291: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7292: ADDMETA
7293: }
1.306 albertel 7294: if (!defined($title)) {
7295: $title = 'The LearningOnline Network with CAPA';
7296: }
1.460 albertel 7297: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7298: $result .= '<title> LON-CAPA '.$title.'</title>'
1.414 albertel 7299: .'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064 raeburn 7300: .$inhibitprint
1.414 albertel 7301: .$head_extra;
1.962 droeschl 7302: return $result.'</head>';
1.306 albertel 7303: }
7304:
7305: =pod
7306:
1.340 albertel 7307: =item * &font_settings()
7308:
7309: Returns neccessary <meta> to set the proper encoding
7310:
7311: Inputs: none
7312:
7313: =cut
7314:
7315: sub font_settings {
7316: my $headerstring='';
1.647 www 7317: if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340 albertel 7318: $headerstring.=
7319: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
7320: }
7321: return $headerstring;
7322: }
7323:
1.341 albertel 7324: =pod
7325:
1.1064 raeburn 7326: =item * &print_suppression()
7327:
7328: In course context returns css which causes the body to be blank when media="print",
7329: if printout generation is unavailable for the current resource.
7330:
7331: This could be because:
7332:
7333: (a) printstartdate is in the future
7334:
7335: (b) printenddate is in the past
7336:
7337: (c) there is an active exam block with "printout"
7338: functionality blocked
7339:
7340: Users with pav, pfo or evb privileges are exempt.
7341:
7342: Inputs: none
7343:
7344: =cut
7345:
7346:
7347: sub print_suppression {
7348: my $noprint;
7349: if ($env{'request.course.id'}) {
7350: my $scope = $env{'request.course.id'};
7351: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7352: (&Apache::lonnet::allowed('pfo',$scope))) {
7353: return;
7354: }
7355: if ($env{'request.course.sec'} ne '') {
7356: $scope .= "/$env{'request.course.sec'}";
7357: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7358: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7359: return;
1.1064 raeburn 7360: }
7361: }
7362: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7363: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065 raeburn 7364: my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064 raeburn 7365: if ($blocked) {
7366: my $checkrole = "cm./$cdom/$cnum";
7367: if ($env{'request.course.sec'} ne '') {
7368: $checkrole .= "/$env{'request.course.sec'}";
7369: }
7370: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7371: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7372: $noprint = 1;
7373: }
7374: }
7375: unless ($noprint) {
7376: my $symb = &Apache::lonnet::symbread();
7377: if ($symb ne '') {
7378: my $navmap = Apache::lonnavmaps::navmap->new();
7379: if (ref($navmap)) {
7380: my $res = $navmap->getBySymb($symb);
7381: if (ref($res)) {
7382: if (!$res->resprintable()) {
7383: $noprint = 1;
7384: }
7385: }
7386: }
7387: }
7388: }
7389: if ($noprint) {
7390: return <<"ENDSTYLE";
7391: <style type="text/css" media="print">
7392: body { display:none }
7393: </style>
7394: ENDSTYLE
7395: }
7396: }
7397: return;
7398: }
7399:
7400: =pod
7401:
1.341 albertel 7402: =item * &xml_begin()
7403:
7404: Returns the needed doctype and <html>
7405:
7406: Inputs: none
7407:
7408: =cut
7409:
7410: sub xml_begin {
7411: my $output='';
7412:
7413: if ($env{'browser.mathml'}) {
7414: $output='<?xml version="1.0"?>'
7415: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7416: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7417:
7418: # .'<!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">] >'
7419: .'<!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">'
7420: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7421: .'xmlns="http://www.w3.org/1999/xhtml">';
7422: } else {
1.849 bisitz 7423: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
7424: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341 albertel 7425: }
7426: return $output;
7427: }
1.340 albertel 7428:
7429: =pod
7430:
1.306 albertel 7431: =item * &start_page()
7432:
7433: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7434:
1.648 raeburn 7435: Inputs:
7436:
7437: =over 4
7438:
7439: $title - optional title for the page
7440:
7441: $head_extra - optional extra HTML to incude inside the <head>
7442:
7443: $args - additional optional args supported are:
7444:
7445: =over 8
7446:
7447: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7448: arg on
1.814 bisitz 7449: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7450: add_entries -> additional attributes to add to the <body>
7451: domain -> force to color decorate a page for a
1.317 albertel 7452: specific domain
1.648 raeburn 7453: function -> force usage of a specific rolish color
1.317 albertel 7454: scheme
1.648 raeburn 7455: redirect -> see &headtag()
7456: bgcolor -> override the default page bg color
7457: js_ready -> return a string ready for being used in
1.317 albertel 7458: a javascript writeln
1.648 raeburn 7459: html_encode -> return a string ready for being used in
1.320 albertel 7460: a html attribute
1.648 raeburn 7461: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7462: $forcereg arg
1.648 raeburn 7463: frameset -> if true will start with a <frameset>
1.330 albertel 7464: rather than <body>
1.648 raeburn 7465: skip_phases -> hash ref of
1.338 albertel 7466: head -> skip the <html><head> generation
7467: body -> skip all <body> generation
1.648 raeburn 7468: no_auto_mt_title -> prevent &mt()ing the title arg
7469: inherit_jsmath -> when creating popup window in a page,
7470: should it have jsmath forced on by the
7471: current page
1.867 kalberla 7472: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7473: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 7474: group -> includes the current group, if page is for a
7475: specific group
1.361 albertel 7476:
1.648 raeburn 7477: =back
1.460 albertel 7478:
1.648 raeburn 7479: =back
1.562 albertel 7480:
1.306 albertel 7481: =cut
7482:
7483: sub start_page {
1.309 albertel 7484: my ($title,$head_extra,$args) = @_;
1.318 albertel 7485: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7486:
1.315 albertel 7487: $env{'internal.start_page'}++;
1.1096 raeburn 7488: my ($result,@advtools);
1.964 droeschl 7489:
1.338 albertel 7490: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030 www 7491: $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338 albertel 7492: }
7493:
7494: if (! exists($args->{'skip_phases'}{'body'}) ) {
7495: if ($args->{'frameset'}) {
7496: my $attr_string = &make_attr_string($args->{'force_register'},
7497: $args->{'add_entries'});
7498: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7499: } else {
7500: $result .=
7501: &bodytag($title,
7502: $args->{'function'}, $args->{'add_entries'},
7503: $args->{'only_body'}, $args->{'domain'},
7504: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 7505: $args->{'bgcolor'}, $args,
7506: \@advtools);
1.831 bisitz 7507: }
1.330 albertel 7508: }
1.338 albertel 7509:
1.315 albertel 7510: if ($args->{'js_ready'}) {
1.713 kaisler 7511: $result = &js_ready($result);
1.315 albertel 7512: }
1.320 albertel 7513: if ($args->{'html_encode'}) {
1.713 kaisler 7514: $result = &html_encode($result);
7515: }
7516:
1.813 bisitz 7517: # Preparation for new and consistent functionlist at top of screen
7518: # if ($args->{'functionlist'}) {
7519: # $result .= &build_functionlist();
7520: #}
7521:
1.964 droeschl 7522: # Don't add anything more if only_body wanted or in const space
7523: return $result if $args->{'only_body'}
7524: || $env{'request.state'} eq 'construct';
1.813 bisitz 7525:
7526: #Breadcrumbs
1.758 kaisler 7527: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7528: &Apache::lonhtmlcommon::clear_breadcrumbs();
7529: #if any br links exists, add them to the breadcrumbs
7530: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7531: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7532: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7533: }
7534: }
1.1096 raeburn 7535: # if @advtools array contains items add then to the breadcrumbs
7536: if (@advtools > 0) {
7537: &Apache::lonmenu::advtools_crumbs(@advtools);
7538: }
1.758 kaisler 7539:
7540: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7541: if(exists($args->{'bread_crumbs_component'})){
7542: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7543: }else{
7544: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7545: }
1.320 albertel 7546: }
1.315 albertel 7547: return $result;
1.306 albertel 7548: }
7549:
7550: sub end_page {
1.315 albertel 7551: my ($args) = @_;
7552: $env{'internal.end_page'}++;
1.330 albertel 7553: my $result;
1.335 albertel 7554: if ($args->{'discussion'}) {
7555: my ($target,$parser);
7556: if (ref($args->{'discussion'})) {
7557: ($target,$parser) =($args->{'discussion'}{'target'},
7558: $args->{'discussion'}{'parser'});
7559: }
7560: $result .= &Apache::lonxml::xmlend($target,$parser);
7561: }
1.330 albertel 7562: if ($args->{'frameset'}) {
7563: $result .= '</frameset>';
7564: } else {
1.635 raeburn 7565: $result .= &endbodytag($args);
1.330 albertel 7566: }
1.1080 raeburn 7567: unless ($args->{'notbody'}) {
7568: $result .= "\n</html>";
7569: }
1.330 albertel 7570:
1.315 albertel 7571: if ($args->{'js_ready'}) {
1.317 albertel 7572: $result = &js_ready($result);
1.315 albertel 7573: }
1.335 albertel 7574:
1.320 albertel 7575: if ($args->{'html_encode'}) {
7576: $result = &html_encode($result);
7577: }
1.335 albertel 7578:
1.315 albertel 7579: return $result;
7580: }
7581:
1.1034 www 7582: sub wishlist_window {
7583: return(<<'ENDWISHLIST');
1.1046 raeburn 7584: <script type="text/javascript">
1.1034 www 7585: // <![CDATA[
7586: // <!-- BEGIN LON-CAPA Internal
7587: function set_wishlistlink(title, path) {
7588: if (!title) {
7589: title = document.title;
7590: title = title.replace(/^LON-CAPA /,'');
7591: }
7592: if (!path) {
7593: path = location.pathname;
7594: }
7595: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7596: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7597: }
7598: // END LON-CAPA Internal -->
7599: // ]]>
7600: </script>
7601: ENDWISHLIST
7602: }
7603:
1.1030 www 7604: sub modal_window {
7605: return(<<'ENDMODAL');
1.1046 raeburn 7606: <script type="text/javascript">
1.1030 www 7607: // <![CDATA[
7608: // <!-- BEGIN LON-CAPA Internal
7609: var modalWindow = {
7610: parent:"body",
7611: windowId:null,
7612: content:null,
7613: width:null,
7614: height:null,
7615: close:function()
7616: {
7617: $(".LCmodal-window").remove();
7618: $(".LCmodal-overlay").remove();
7619: },
7620: open:function()
7621: {
7622: var modal = "";
7623: modal += "<div class=\"LCmodal-overlay\"></div>";
7624: modal += "<div id=\"" + this.windowId + "\" class=\"LCmodal-window\" style=\"width:" + this.width + "px; height:" + this.height + "px; margin-top:-" + (this.height / 2) + "px; margin-left:-" + (this.width / 2) + "px;\">";
7625: modal += this.content;
7626: modal += "</div>";
7627:
7628: $(this.parent).append(modal);
7629:
7630: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7631: $(".LCclose-window").click(function(){modalWindow.close();});
7632: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7633: }
7634: };
1.1031 www 7635: var openMyModal = function(source,width,height,scrolling)
1.1030 www 7636: {
7637: modalWindow.windowId = "myModal";
7638: modalWindow.width = width;
7639: modalWindow.height = height;
1.1031 www 7640: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'></iframe>";
1.1030 www 7641: modalWindow.open();
7642: };
7643: // END LON-CAPA Internal -->
7644: // ]]>
7645: </script>
7646: ENDMODAL
7647: }
7648:
7649: sub modal_link {
1.1052 www 7650: my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030 www 7651: unless ($width) { $width=480; }
7652: unless ($height) { $height=400; }
1.1031 www 7653: unless ($scrolling) { $scrolling='yes'; }
1.1074 raeburn 7654: my $target_attr;
7655: if (defined($target)) {
7656: $target_attr = 'target="'.$target.'"';
7657: }
7658: return <<"ENDLINK";
7659: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
7660: $linktext</a>
7661: ENDLINK
1.1030 www 7662: }
7663:
1.1032 www 7664: sub modal_adhoc_script {
7665: my ($funcname,$width,$height,$content)=@_;
7666: return (<<ENDADHOC);
1.1046 raeburn 7667: <script type="text/javascript">
1.1032 www 7668: // <![CDATA[
7669: var $funcname = function()
7670: {
7671: modalWindow.windowId = "myModal";
7672: modalWindow.width = $width;
7673: modalWindow.height = $height;
7674: modalWindow.content = '$content';
7675: modalWindow.open();
7676: };
7677: // ]]>
7678: </script>
7679: ENDADHOC
7680: }
7681:
1.1041 www 7682: sub modal_adhoc_inner {
7683: my ($funcname,$width,$height,$content)=@_;
7684: my $innerwidth=$width-20;
7685: $content=&js_ready(
1.1042 www 7686: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041 www 7687: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
7688: $content.
7689: &end_scrollbox().
7690: &end_page()
7691: );
7692: return &modal_adhoc_script($funcname,$width,$height,$content);
7693: }
7694:
7695: sub modal_adhoc_window {
7696: my ($funcname,$width,$height,$content,$linktext)=@_;
7697: return &modal_adhoc_inner($funcname,$width,$height,$content).
7698: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7699: }
7700:
7701: sub modal_adhoc_launch {
7702: my ($funcname,$width,$height,$content)=@_;
7703: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7704: <script type="text/javascript">
7705: // <![CDATA[
7706: $funcname();
7707: // ]]>
7708: </script>
7709: ENDLAUNCH
7710: }
7711:
7712: sub modal_adhoc_close {
7713: return (<<ENDCLOSE);
7714: <script type="text/javascript">
7715: // <![CDATA[
7716: modalWindow.close();
7717: // ]]>
7718: </script>
7719: ENDCLOSE
7720: }
7721:
1.1038 www 7722: sub togglebox_script {
7723: return(<<ENDTOGGLE);
7724: <script type="text/javascript">
7725: // <![CDATA[
7726: function LCtoggleDisplay(id,hidetext,showtext) {
7727: link = document.getElementById(id + "link").childNodes[0];
7728: with (document.getElementById(id).style) {
7729: if (display == "none" ) {
7730: display = "inline";
7731: link.nodeValue = hidetext;
7732: } else {
7733: display = "none";
7734: link.nodeValue = showtext;
7735: }
7736: }
7737: }
7738: // ]]>
7739: </script>
7740: ENDTOGGLE
7741: }
7742:
1.1039 www 7743: sub start_togglebox {
7744: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7745: unless ($heading) { $heading=''; } else { $heading.=' '; }
7746: unless ($showtext) { $showtext=&mt('show'); }
7747: unless ($hidetext) { $hidetext=&mt('hide'); }
7748: unless ($headerbg) { $headerbg='#FFFFFF'; }
7749: return &start_data_table().
7750: &start_data_table_header_row().
7751: '<td bgcolor="'.$headerbg.'">'.$heading.
7752: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7753: $showtext.'\')">'.$showtext.'</a>]</td>'.
7754: &end_data_table_header_row().
7755: '<tr id="'.$id.'" style="display:none""><td>';
7756: }
7757:
7758: sub end_togglebox {
7759: return '</td></tr>'.&end_data_table();
7760: }
7761:
1.1041 www 7762: sub LCprogressbar_script {
1.1045 www 7763: my ($id)=@_;
1.1041 www 7764: return(<<ENDPROGRESS);
7765: <script type="text/javascript">
7766: // <![CDATA[
1.1045 www 7767: \$('#progressbar$id').progressbar({
1.1041 www 7768: value: 0,
7769: change: function(event, ui) {
7770: var newVal = \$(this).progressbar('option', 'value');
7771: \$('.pblabel', this).text(LCprogressTxt);
7772: }
7773: });
7774: // ]]>
7775: </script>
7776: ENDPROGRESS
7777: }
7778:
7779: sub LCprogressbarUpdate_script {
7780: return(<<ENDPROGRESSUPDATE);
7781: <style type="text/css">
7782: .ui-progressbar { position:relative; }
7783: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7784: </style>
7785: <script type="text/javascript">
7786: // <![CDATA[
1.1045 www 7787: var LCprogressTxt='---';
7788:
7789: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7790: LCprogressTxt=progresstext;
1.1045 www 7791: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7792: }
7793: // ]]>
7794: </script>
7795: ENDPROGRESSUPDATE
7796: }
7797:
1.1042 www 7798: my $LClastpercent;
1.1045 www 7799: my $LCidcnt;
7800: my $LCcurrentid;
1.1042 www 7801:
1.1041 www 7802: sub LCprogressbar {
1.1042 www 7803: my ($r)=(@_);
7804: $LClastpercent=0;
1.1045 www 7805: $LCidcnt++;
7806: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7807: my $starting=&mt('Starting');
7808: my $content=(<<ENDPROGBAR);
7809: <p>
1.1045 www 7810: <div id="progressbar$LCcurrentid">
1.1041 www 7811: <span class="pblabel">$starting</span>
7812: </div>
7813: </p>
7814: ENDPROGBAR
1.1045 www 7815: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7816: }
7817:
7818: sub LCprogressbarUpdate {
1.1042 www 7819: my ($r,$val,$text)=@_;
7820: unless ($val) {
7821: if ($LClastpercent) {
7822: $val=$LClastpercent;
7823: } else {
7824: $val=0;
7825: }
7826: }
1.1041 www 7827: if ($val<0) { $val=0; }
7828: if ($val>100) { $val=0; }
1.1042 www 7829: $LClastpercent=$val;
1.1041 www 7830: unless ($text) { $text=$val.'%'; }
7831: $text=&js_ready($text);
1.1044 www 7832: &r_print($r,<<ENDUPDATE);
1.1041 www 7833: <script type="text/javascript">
7834: // <![CDATA[
1.1045 www 7835: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7836: // ]]>
7837: </script>
7838: ENDUPDATE
1.1035 www 7839: }
7840:
1.1042 www 7841: sub LCprogressbarClose {
7842: my ($r)=@_;
7843: $LClastpercent=0;
1.1044 www 7844: &r_print($r,<<ENDCLOSE);
1.1042 www 7845: <script type="text/javascript">
7846: // <![CDATA[
1.1045 www 7847: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7848: // ]]>
7849: </script>
7850: ENDCLOSE
1.1044 www 7851: }
7852:
7853: sub r_print {
7854: my ($r,$to_print)=@_;
7855: if ($r) {
7856: $r->print($to_print);
7857: $r->rflush();
7858: } else {
7859: print($to_print);
7860: }
1.1042 www 7861: }
7862:
1.320 albertel 7863: sub html_encode {
7864: my ($result) = @_;
7865:
1.322 albertel 7866: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 7867:
7868: return $result;
7869: }
1.1044 www 7870:
1.317 albertel 7871: sub js_ready {
7872: my ($result) = @_;
7873:
1.323 albertel 7874: $result =~ s/[\n\r]/ /xmsg;
7875: $result =~ s/\\/\\\\/xmsg;
7876: $result =~ s/'/\\'/xmsg;
1.372 albertel 7877: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 7878:
7879: return $result;
7880: }
7881:
1.315 albertel 7882: sub validate_page {
7883: if ( exists($env{'internal.start_page'})
1.316 albertel 7884: && $env{'internal.start_page'} > 1) {
7885: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 7886: $env{'internal.start_page'}.' '.
1.316 albertel 7887: $ENV{'request.filename'});
1.315 albertel 7888: }
7889: if ( exists($env{'internal.end_page'})
1.316 albertel 7890: && $env{'internal.end_page'} > 1) {
7891: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 7892: $env{'internal.end_page'}.' '.
1.316 albertel 7893: $env{'request.filename'});
1.315 albertel 7894: }
7895: if ( exists($env{'internal.start_page'})
7896: && ! exists($env{'internal.end_page'})) {
1.316 albertel 7897: &Apache::lonnet::logthis('start_page called without end_page '.
7898: $env{'request.filename'});
1.315 albertel 7899: }
7900: if ( ! exists($env{'internal.start_page'})
7901: && exists($env{'internal.end_page'})) {
1.316 albertel 7902: &Apache::lonnet::logthis('end_page called without start_page'.
7903: $env{'request.filename'});
1.315 albertel 7904: }
1.306 albertel 7905: }
1.315 albertel 7906:
1.996 www 7907:
7908: sub start_scrollbox {
1.1075 raeburn 7909: my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998 raeburn 7910: unless ($outerwidth) { $outerwidth='520px'; }
7911: unless ($width) { $width='500px'; }
7912: unless ($height) { $height='200px'; }
1.1075 raeburn 7913: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 7914: if ($id ne '') {
1.1020 raeburn 7915: $table_id = " id='table_$id'";
7916: $div_id = " id='div_$id'";
1.1018 raeburn 7917: }
1.1075 raeburn 7918: if ($bgcolor ne '') {
7919: $tdcol = "background-color: $bgcolor;";
7920: }
7921: return <<"END";
7922: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol"><div style="overflow:auto; width:$width; height: $height;"$div_id>
7923: END
1.996 www 7924: }
7925:
7926: sub end_scrollbox {
1.1036 www 7927: return '</div></td></tr></table>';
1.996 www 7928: }
7929:
1.318 albertel 7930: sub simple_error_page {
7931: my ($r,$title,$msg) = @_;
7932: my $page =
7933: &Apache::loncommon::start_page($title).
1.1097 bisitz 7934: '<p class="LC_error">'.&mt($msg).'</p>'.
1.318 albertel 7935: &Apache::loncommon::end_page();
7936: if (ref($r)) {
7937: $r->print($page);
1.327 albertel 7938: return;
1.318 albertel 7939: }
7940: return $page;
7941: }
1.347 albertel 7942:
7943: {
1.610 albertel 7944: my @row_count;
1.961 onken 7945:
7946: sub start_data_table_count {
7947: unshift(@row_count, 0);
7948: return;
7949: }
7950:
7951: sub end_data_table_count {
7952: shift(@row_count);
7953: return;
7954: }
7955:
1.347 albertel 7956: sub start_data_table {
1.1018 raeburn 7957: my ($add_class,$id) = @_;
1.422 albertel 7958: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 7959: my $table_id;
7960: if (defined($id)) {
7961: $table_id = ' id="'.$id.'"';
7962: }
1.961 onken 7963: &start_data_table_count();
1.1018 raeburn 7964: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 7965: }
7966:
7967: sub end_data_table {
1.961 onken 7968: &end_data_table_count();
1.389 albertel 7969: return '</table>'."\n";;
1.347 albertel 7970: }
7971:
7972: sub start_data_table_row {
1.974 wenzelju 7973: my ($add_class, $id) = @_;
1.610 albertel 7974: $row_count[0]++;
7975: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 7976: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 7977: $id = (' id="'.$id.'"') unless ($id eq '');
7978: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 7979: }
1.471 banghart 7980:
7981: sub continue_data_table_row {
1.974 wenzelju 7982: my ($add_class, $id) = @_;
1.610 albertel 7983: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 7984: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
7985: $id = (' id="'.$id.'"') unless ($id eq '');
7986: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 7987: }
1.347 albertel 7988:
7989: sub end_data_table_row {
1.389 albertel 7990: return '</tr>'."\n";;
1.347 albertel 7991: }
1.367 www 7992:
1.421 albertel 7993: sub start_data_table_empty_row {
1.707 bisitz 7994: # $row_count[0]++;
1.421 albertel 7995: return '<tr class="LC_empty_row" >'."\n";;
7996: }
7997:
7998: sub end_data_table_empty_row {
7999: return '</tr>'."\n";;
8000: }
8001:
1.367 www 8002: sub start_data_table_header_row {
1.389 albertel 8003: return '<tr class="LC_header_row">'."\n";;
1.367 www 8004: }
8005:
8006: sub end_data_table_header_row {
1.389 albertel 8007: return '</tr>'."\n";;
1.367 www 8008: }
1.890 droeschl 8009:
8010: sub data_table_caption {
8011: my $caption = shift;
8012: return "<caption class=\"LC_caption\">$caption</caption>";
8013: }
1.347 albertel 8014: }
8015:
1.548 albertel 8016: =pod
8017:
8018: =item * &inhibit_menu_check($arg)
8019:
8020: Checks for a inhibitmenu state and generates output to preserve it
8021:
8022: Inputs: $arg - can be any of
8023: - undef - in which case the return value is a string
8024: to add into arguments list of a uri
8025: - 'input' - in which case the return value is a HTML
8026: <form> <input> field of type hidden to
8027: preserve the value
8028: - a url - in which case the return value is the url with
8029: the neccesary cgi args added to preserve the
8030: inhibitmenu state
8031: - a ref to a url - no return value, but the string is
8032: updated to include the neccessary cgi
8033: args to preserve the inhibitmenu state
8034:
8035: =cut
8036:
8037: sub inhibit_menu_check {
8038: my ($arg) = @_;
8039: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8040: if ($arg eq 'input') {
8041: if ($env{'form.inhibitmenu'}) {
8042: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8043: } else {
8044: return
8045: }
8046: }
8047: if ($env{'form.inhibitmenu'}) {
8048: if (ref($arg)) {
8049: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8050: } elsif ($arg eq '') {
8051: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8052: } else {
8053: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8054: }
8055: }
8056: if (!ref($arg)) {
8057: return $arg;
8058: }
8059: }
8060:
1.251 albertel 8061: ###############################################
1.182 matthew 8062:
8063: =pod
8064:
1.549 albertel 8065: =back
8066:
8067: =head1 User Information Routines
8068:
8069: =over 4
8070:
1.405 albertel 8071: =item * &get_users_function()
1.182 matthew 8072:
8073: Used by &bodytag to determine the current users primary role.
8074: Returns either 'student','coordinator','admin', or 'author'.
8075:
8076: =cut
8077:
8078: ###############################################
8079: sub get_users_function {
1.815 tempelho 8080: my $function = 'norole';
1.818 tempelho 8081: if ($env{'request.role'}=~/^(st)/) {
8082: $function='student';
8083: }
1.907 raeburn 8084: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8085: $function='coordinator';
8086: }
1.258 albertel 8087: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8088: $function='admin';
8089: }
1.826 bisitz 8090: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8091: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8092: $function='author';
8093: }
8094: return $function;
1.54 www 8095: }
1.99 www 8096:
8097: ###############################################
8098:
1.233 raeburn 8099: =pod
8100:
1.821 raeburn 8101: =item * &show_course()
8102:
8103: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8104: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8105:
8106: Inputs:
8107: None
8108:
8109: Outputs:
8110: Scalar: 1 if 'Course' to be used, 0 otherwise.
8111:
8112: =cut
8113:
8114: ###############################################
8115: sub show_course {
8116: my $course = !$env{'user.adv'};
8117: if (!$env{'user.adv'}) {
8118: foreach my $env (keys(%env)) {
8119: next if ($env !~ m/^user\.priv\./);
8120: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8121: $course = 0;
8122: last;
8123: }
8124: }
8125: }
8126: return $course;
8127: }
8128:
8129: ###############################################
8130:
8131: =pod
8132:
1.542 raeburn 8133: =item * &check_user_status()
1.274 raeburn 8134:
8135: Determines current status of supplied role for a
8136: specific user. Roles can be active, previous or future.
8137:
8138: Inputs:
8139: user's domain, user's username, course's domain,
1.375 raeburn 8140: course's number, optional section ID.
1.274 raeburn 8141:
8142: Outputs:
8143: role status: active, previous or future.
8144:
8145: =cut
8146:
8147: sub check_user_status {
1.412 raeburn 8148: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8149: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8150: my @uroles = keys %userinfo;
8151: my $srchstr;
8152: my $active_chk = 'none';
1.412 raeburn 8153: my $now = time;
1.274 raeburn 8154: if (@uroles > 0) {
1.908 raeburn 8155: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8156: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8157: } else {
1.412 raeburn 8158: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8159: }
8160: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8161: my $role_end = 0;
8162: my $role_start = 0;
8163: $active_chk = 'active';
1.412 raeburn 8164: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8165: $role_end = $1;
8166: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8167: $role_start = $1;
1.274 raeburn 8168: }
8169: }
8170: if ($role_start > 0) {
1.412 raeburn 8171: if ($now < $role_start) {
1.274 raeburn 8172: $active_chk = 'future';
8173: }
8174: }
8175: if ($role_end > 0) {
1.412 raeburn 8176: if ($now > $role_end) {
1.274 raeburn 8177: $active_chk = 'previous';
8178: }
8179: }
8180: }
8181: }
8182: return $active_chk;
8183: }
8184:
8185: ###############################################
8186:
8187: =pod
8188:
1.405 albertel 8189: =item * &get_sections()
1.233 raeburn 8190:
8191: Determines all the sections for a course including
8192: sections with students and sections containing other roles.
1.419 raeburn 8193: Incoming parameters:
8194:
8195: 1. domain
8196: 2. course number
8197: 3. reference to array containing roles for which sections should
8198: be gathered (optional).
8199: 4. reference to array containing status types for which sections
8200: should be gathered (optional).
8201:
8202: If the third argument is undefined, sections are gathered for any role.
8203: If the fourth argument is undefined, sections are gathered for any status.
8204: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8205:
1.374 raeburn 8206: Returns section hash (keys are section IDs, values are
8207: number of users in each section), subject to the
1.419 raeburn 8208: optional roles filter, optional status filter
1.233 raeburn 8209:
8210: =cut
8211:
8212: ###############################################
8213: sub get_sections {
1.419 raeburn 8214: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8215: if (!defined($cdom) || !defined($cnum)) {
8216: my $cid = $env{'request.course.id'};
8217:
8218: return if (!defined($cid));
8219:
8220: $cdom = $env{'course.'.$cid.'.domain'};
8221: $cnum = $env{'course.'.$cid.'.num'};
8222: }
8223:
8224: my %sectioncount;
1.419 raeburn 8225: my $now = time;
1.240 albertel 8226:
1.366 albertel 8227: if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276 albertel 8228: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8229: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8230: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8231: my $start_index = &Apache::loncoursedata::CL_START();
8232: my $end_index = &Apache::loncoursedata::CL_END();
8233: my $status;
1.366 albertel 8234: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8235: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8236: $data->[$status_index],
8237: $data->[$start_index],
8238: $data->[$end_index]);
8239: if ($stu_status eq 'Active') {
8240: $status = 'active';
8241: } elsif ($end < $now) {
8242: $status = 'previous';
8243: } elsif ($start > $now) {
8244: $status = 'future';
8245: }
8246: if ($section ne '-1' && $section !~ /^\s*$/) {
8247: if ((!defined($possible_status)) || (($status ne '') &&
8248: (grep/^\Q$status\E$/,@{$possible_status}))) {
8249: $sectioncount{$section}++;
8250: }
1.240 albertel 8251: }
8252: }
8253: }
8254: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8255: foreach my $user (sort(keys(%courseroles))) {
8256: if ($user !~ /^(\w{2})/) { next; }
8257: my ($role) = ($user =~ /^(\w{2})/);
8258: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8259: my ($section,$status);
1.240 albertel 8260: if ($role eq 'cr' &&
8261: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8262: $section=$1;
8263: }
8264: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8265: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8266: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8267: if ($end == -1 && $start == -1) {
8268: next; #deleted role
8269: }
8270: if (!defined($possible_status)) {
8271: $sectioncount{$section}++;
8272: } else {
8273: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8274: $status = 'active';
8275: } elsif ($end < $now) {
8276: $status = 'future';
8277: } elsif ($start > $now) {
8278: $status = 'previous';
8279: }
8280: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8281: $sectioncount{$section}++;
8282: }
8283: }
1.233 raeburn 8284: }
1.366 albertel 8285: return %sectioncount;
1.233 raeburn 8286: }
8287:
1.274 raeburn 8288: ###############################################
1.294 raeburn 8289:
8290: =pod
1.405 albertel 8291:
8292: =item * &get_course_users()
8293:
1.275 raeburn 8294: Retrieves usernames:domains for users in the specified course
8295: with specific role(s), and access status.
8296:
8297: Incoming parameters:
1.277 albertel 8298: 1. course domain
8299: 2. course number
8300: 3. access status: users must have - either active,
1.275 raeburn 8301: previous, future, or all.
1.277 albertel 8302: 4. reference to array of permissible roles
1.288 raeburn 8303: 5. reference to array of section restrictions (optional)
8304: 6. reference to results object (hash of hashes).
8305: 7. reference to optional userdata hash
1.609 raeburn 8306: 8. reference to optional statushash
1.630 raeburn 8307: 9. flag if privileged users (except those set to unhide in
8308: course settings) should be excluded
1.609 raeburn 8309: Keys of top level results hash are roles.
1.275 raeburn 8310: Keys of inner hashes are username:domain, with
8311: values set to access type.
1.288 raeburn 8312: Optional userdata hash returns an array with arguments in the
8313: same order as loncoursedata::get_classlist() for student data.
8314:
1.609 raeburn 8315: Optional statushash returns
8316:
1.288 raeburn 8317: Entries for end, start, section and status are blank because
8318: of the possibility of multiple values for non-student roles.
8319:
1.275 raeburn 8320: =cut
1.405 albertel 8321:
1.275 raeburn 8322: ###############################################
1.405 albertel 8323:
1.275 raeburn 8324: sub get_course_users {
1.630 raeburn 8325: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8326: my %idx = ();
1.419 raeburn 8327: my %seclists;
1.288 raeburn 8328:
8329: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8330: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8331: $idx{end} = &Apache::loncoursedata::CL_END();
8332: $idx{start} = &Apache::loncoursedata::CL_START();
8333: $idx{id} = &Apache::loncoursedata::CL_ID();
8334: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8335: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8336: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8337:
1.290 albertel 8338: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8339: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8340: my $now = time;
1.277 albertel 8341: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8342: my $match = 0;
1.412 raeburn 8343: my $secmatch = 0;
1.419 raeburn 8344: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8345: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8346: if ($section eq '') {
8347: $section = 'none';
8348: }
1.291 albertel 8349: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8350: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8351: $secmatch = 1;
8352: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8353: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8354: $secmatch = 1;
8355: }
8356: } else {
1.419 raeburn 8357: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8358: $secmatch = 1;
8359: }
1.290 albertel 8360: }
1.412 raeburn 8361: if (!$secmatch) {
8362: next;
8363: }
1.419 raeburn 8364: }
1.275 raeburn 8365: if (defined($$types{'active'})) {
1.288 raeburn 8366: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8367: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8368: $match = 1;
1.275 raeburn 8369: }
8370: }
8371: if (defined($$types{'previous'})) {
1.609 raeburn 8372: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8373: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8374: $match = 1;
1.275 raeburn 8375: }
8376: }
8377: if (defined($$types{'future'})) {
1.609 raeburn 8378: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8379: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8380: $match = 1;
1.275 raeburn 8381: }
8382: }
1.609 raeburn 8383: if ($match) {
8384: push(@{$seclists{$student}},$section);
8385: if (ref($userdata) eq 'HASH') {
8386: $$userdata{$student} = $$classlist{$student};
8387: }
8388: if (ref($statushash) eq 'HASH') {
8389: $statushash->{$student}{'st'}{$section} = $status;
8390: }
1.288 raeburn 8391: }
1.275 raeburn 8392: }
8393: }
1.412 raeburn 8394: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8395: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8396: my $now = time;
1.609 raeburn 8397: my %displaystatus = ( previous => 'Expired',
8398: active => 'Active',
8399: future => 'Future',
8400: );
1.630 raeburn 8401: my %nothide;
8402: if ($hidepriv) {
8403: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8404: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8405: if ($user !~ /:/) {
8406: $nothide{join(':',split(/[\@]/,$user))}=1;
8407: } else {
8408: $nothide{$user} = 1;
8409: }
8410: }
8411: }
1.439 raeburn 8412: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8413: my $match = 0;
1.412 raeburn 8414: my $secmatch = 0;
1.439 raeburn 8415: my $status;
1.412 raeburn 8416: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8417: $user =~ s/:$//;
1.439 raeburn 8418: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8419: if ($end == -1 || $start == -1) {
8420: next;
8421: }
8422: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8423: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8424: my ($uname,$udom) = split(/:/,$user);
8425: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8426: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8427: $secmatch = 1;
8428: } elsif ($usec eq '') {
1.420 albertel 8429: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8430: $secmatch = 1;
8431: }
8432: } else {
8433: if (grep(/^\Q$usec\E$/,@{$sections})) {
8434: $secmatch = 1;
8435: }
8436: }
8437: if (!$secmatch) {
8438: next;
8439: }
1.288 raeburn 8440: }
1.419 raeburn 8441: if ($usec eq '') {
8442: $usec = 'none';
8443: }
1.275 raeburn 8444: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8445: if ($hidepriv) {
8446: if ((&Apache::lonnet::privileged($uname,$udom)) &&
8447: (!$nothide{$uname.':'.$udom})) {
8448: next;
8449: }
8450: }
1.503 raeburn 8451: if ($end > 0 && $end < $now) {
1.439 raeburn 8452: $status = 'previous';
8453: } elsif ($start > $now) {
8454: $status = 'future';
8455: } else {
8456: $status = 'active';
8457: }
1.277 albertel 8458: foreach my $type (keys(%{$types})) {
1.275 raeburn 8459: if ($status eq $type) {
1.420 albertel 8460: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8461: push(@{$$users{$role}{$user}},$type);
8462: }
1.288 raeburn 8463: $match = 1;
8464: }
8465: }
1.419 raeburn 8466: if (($match) && (ref($userdata) eq 'HASH')) {
8467: if (!exists($$userdata{$uname.':'.$udom})) {
8468: &get_user_info($udom,$uname,\%idx,$userdata);
8469: }
1.420 albertel 8470: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8471: push(@{$seclists{$uname.':'.$udom}},$usec);
8472: }
1.609 raeburn 8473: if (ref($statushash) eq 'HASH') {
8474: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8475: }
1.275 raeburn 8476: }
8477: }
8478: }
8479: }
1.290 albertel 8480: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8481: if ((defined($cdom)) && (defined($cnum))) {
8482: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8483: if ( defined($csettings{'internal.courseowner'}) ) {
8484: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8485: next if ($owner eq '');
8486: my ($ownername,$ownerdom);
8487: if ($owner =~ /^([^:]+):([^:]+)$/) {
8488: $ownername = $1;
8489: $ownerdom = $2;
8490: } else {
8491: $ownername = $owner;
8492: $ownerdom = $cdom;
8493: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8494: }
8495: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8496: if (defined($userdata) &&
1.609 raeburn 8497: !exists($$userdata{$owner})) {
8498: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8499: if (!grep(/^none$/,@{$seclists{$owner}})) {
8500: push(@{$seclists{$owner}},'none');
8501: }
8502: if (ref($statushash) eq 'HASH') {
8503: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8504: }
1.290 albertel 8505: }
1.279 raeburn 8506: }
8507: }
8508: }
1.419 raeburn 8509: foreach my $user (keys(%seclists)) {
8510: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8511: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8512: }
1.275 raeburn 8513: }
8514: return;
8515: }
8516:
1.288 raeburn 8517: sub get_user_info {
8518: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8519: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8520: &plainname($uname,$udom,'lastname');
1.291 albertel 8521: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8522: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8523: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8524: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8525: return;
8526: }
1.275 raeburn 8527:
1.472 raeburn 8528: ###############################################
8529:
8530: =pod
8531:
8532: =item * &get_user_quota()
8533:
8534: Retrieves quota assigned for storage of portfolio files for a user
8535:
8536: Incoming parameters:
8537: 1. user's username
8538: 2. user's domain
8539:
8540: Returns:
1.536 raeburn 8541: 1. Disk quota (in Mb) assigned to student.
8542: 2. (Optional) Type of setting: custom or default
8543: (individually assigned or default for user's
8544: institutional status).
8545: 3. (Optional) - User's institutional status (e.g., faculty, staff
8546: or student - types as defined in localenroll::inst_usertypes
8547: for user's domain, which determines default quota for user.
8548: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8549:
8550: If a value has been stored in the user's environment,
1.536 raeburn 8551: it will return that, otherwise it returns the maximal default
8552: defined for the user's instituional status(es) in the domain.
1.472 raeburn 8553:
8554: =cut
8555:
8556: ###############################################
8557:
8558:
8559: sub get_user_quota {
8560: my ($uname,$udom) = @_;
1.536 raeburn 8561: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8562: if (!defined($udom)) {
8563: $udom = $env{'user.domain'};
8564: }
8565: if (!defined($uname)) {
8566: $uname = $env{'user.name'};
8567: }
8568: if (($udom eq '' || $uname eq '') ||
8569: ($udom eq 'public') && ($uname eq 'public')) {
8570: $quota = 0;
1.536 raeburn 8571: $quotatype = 'default';
8572: $defquota = 0;
1.472 raeburn 8573: } else {
1.536 raeburn 8574: my $inststatus;
1.472 raeburn 8575: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8576: $quota = $env{'environment.portfolioquota'};
1.536 raeburn 8577: $inststatus = $env{'environment.inststatus'};
1.472 raeburn 8578: } else {
1.536 raeburn 8579: my %userenv =
8580: &Apache::lonnet::get('environment',['portfolioquota',
8581: 'inststatus'],$udom,$uname);
1.472 raeburn 8582: my ($tmp) = keys(%userenv);
8583: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8584: $quota = $userenv{'portfolioquota'};
1.536 raeburn 8585: $inststatus = $userenv{'inststatus'};
1.472 raeburn 8586: } else {
8587: undef(%userenv);
8588: }
8589: }
1.536 raeburn 8590: ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472 raeburn 8591: if ($quota eq '') {
1.536 raeburn 8592: $quota = $defquota;
8593: $quotatype = 'default';
8594: } else {
8595: $quotatype = 'custom';
1.472 raeburn 8596: }
8597: }
1.536 raeburn 8598: if (wantarray) {
8599: return ($quota,$quotatype,$settingstatus,$defquota);
8600: } else {
8601: return $quota;
8602: }
1.472 raeburn 8603: }
8604:
8605: ###############################################
8606:
8607: =pod
8608:
8609: =item * &default_quota()
8610:
1.536 raeburn 8611: Retrieves default quota assigned for storage of user portfolio files,
8612: given an (optional) user's institutional status.
1.472 raeburn 8613:
8614: Incoming parameters:
8615: 1. domain
1.536 raeburn 8616: 2. (Optional) institutional status(es). This is a : separated list of
8617: status types (e.g., faculty, staff, student etc.)
8618: which apply to the user for whom the default is being retrieved.
8619: If the institutional status string in undefined, the domain
8620: default quota will be returned.
1.472 raeburn 8621:
8622: Returns:
8623: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536 raeburn 8624: 2. (Optional) institutional type which determined the value of the
8625: default quota.
1.472 raeburn 8626:
8627: If a value has been stored in the domain's configuration db,
8628: it will return that, otherwise it returns 20 (for backwards
8629: compatibility with domains which have not set up a configuration
8630: db file; the original statically defined portfolio quota was 20 Mb).
8631:
1.536 raeburn 8632: If the user's status includes multiple types (e.g., staff and student),
8633: the largest default quota which applies to the user determines the
8634: default quota returned.
8635:
1.780 raeburn 8636: =back
8637:
1.472 raeburn 8638: =cut
8639:
8640: ###############################################
8641:
8642:
8643: sub default_quota {
1.536 raeburn 8644: my ($udom,$inststatus) = @_;
8645: my ($defquota,$settingstatus);
8646: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8647: ['quotas'],$udom);
8648: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8649: if ($inststatus ne '') {
1.765 raeburn 8650: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8651: foreach my $item (@statuses) {
1.711 raeburn 8652: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8653: if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
8654: if ($defquota eq '') {
8655: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8656: $settingstatus = $item;
8657: } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
8658: $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
8659: $settingstatus = $item;
8660: }
8661: }
8662: } else {
8663: if ($quotahash{'quotas'}{$item} ne '') {
8664: if ($defquota eq '') {
8665: $defquota = $quotahash{'quotas'}{$item};
8666: $settingstatus = $item;
8667: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8668: $defquota = $quotahash{'quotas'}{$item};
8669: $settingstatus = $item;
8670: }
1.536 raeburn 8671: }
8672: }
8673: }
8674: }
8675: if ($defquota eq '') {
1.711 raeburn 8676: if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
8677: $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
8678: } else {
8679: $defquota = $quotahash{'quotas'}{'default'};
8680: }
1.536 raeburn 8681: $settingstatus = 'default';
8682: }
8683: } else {
8684: $settingstatus = 'default';
8685: $defquota = 20;
8686: }
8687: if (wantarray) {
8688: return ($defquota,$settingstatus);
1.472 raeburn 8689: } else {
1.536 raeburn 8690: return $defquota;
1.472 raeburn 8691: }
8692: }
8693:
1.384 raeburn 8694: sub get_secgrprole_info {
8695: my ($cdom,$cnum,$needroles,$type) = @_;
8696: my %sections_count = &get_sections($cdom,$cnum);
8697: my @sections = (sort {$a <=> $b} keys(%sections_count));
8698: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
8699: my @groups = sort(keys(%curr_groups));
8700: my $allroles = [];
8701: my $rolehash;
8702: my $accesshash = {
8703: active => 'Currently has access',
8704: future => 'Will have future access',
8705: previous => 'Previously had access',
8706: };
8707: if ($needroles) {
8708: $rolehash = {'all' => 'all'};
1.385 albertel 8709: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8710: if (&Apache::lonnet::error(%user_roles)) {
8711: undef(%user_roles);
8712: }
8713: foreach my $item (keys(%user_roles)) {
1.384 raeburn 8714: my ($role)=split(/\:/,$item,2);
8715: if ($role eq 'cr') { next; }
8716: if ($role =~ /^cr/) {
8717: $$rolehash{$role} = (split('/',$role))[3];
8718: } else {
8719: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
8720: }
8721: }
8722: foreach my $key (sort(keys(%{$rolehash}))) {
8723: push(@{$allroles},$key);
8724: }
8725: push (@{$allroles},'st');
8726: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
8727: }
8728: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
8729: }
8730:
1.555 raeburn 8731: sub user_picker {
1.994 raeburn 8732: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 8733: my $currdom = $dom;
8734: my %curr_selected = (
8735: srchin => 'dom',
1.580 raeburn 8736: srchby => 'lastname',
1.555 raeburn 8737: );
8738: my $srchterm;
1.625 raeburn 8739: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 8740: if ($srch->{'srchby'} ne '') {
8741: $curr_selected{'srchby'} = $srch->{'srchby'};
8742: }
8743: if ($srch->{'srchin'} ne '') {
8744: $curr_selected{'srchin'} = $srch->{'srchin'};
8745: }
8746: if ($srch->{'srchtype'} ne '') {
8747: $curr_selected{'srchtype'} = $srch->{'srchtype'};
8748: }
8749: if ($srch->{'srchdomain'} ne '') {
8750: $currdom = $srch->{'srchdomain'};
8751: }
8752: $srchterm = $srch->{'srchterm'};
8753: }
8754: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 8755: 'usr' => 'Search criteria',
1.563 raeburn 8756: 'doma' => 'Domain/institution to search',
1.558 albertel 8757: 'uname' => 'username',
8758: 'lastname' => 'last name',
1.555 raeburn 8759: 'lastfirst' => 'last name, first name',
1.558 albertel 8760: 'crs' => 'in this course',
1.576 raeburn 8761: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 8762: 'alc' => 'all LON-CAPA',
1.573 raeburn 8763: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 8764: 'exact' => 'is',
8765: 'contains' => 'contains',
1.569 raeburn 8766: 'begins' => 'begins with',
1.571 raeburn 8767: 'youm' => "You must include some text to search for.",
8768: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
8769: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
8770: 'yomc' => "You must choose a domain when using an institutional directory search.",
8771: 'ymcd' => "You must choose a domain when using a domain search.",
8772: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
8773: 'whse' => "When searching by last,first you must include at least one character in the first name.",
8774: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 8775: );
1.563 raeburn 8776: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
8777: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 8778:
8779: my @srchins = ('crs','dom','alc','instd');
8780:
8781: foreach my $option (@srchins) {
8782: # FIXME 'alc' option unavailable until
8783: # loncreateuser::print_user_query_page()
8784: # has been completed.
8785: next if ($option eq 'alc');
1.880 raeburn 8786: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 8787: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 8788: if ($curr_selected{'srchin'} eq $option) {
8789: $srchinsel .= '
8790: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8791: } else {
8792: $srchinsel .= '
8793: <option value="'.$option.'">'.$lt{$option}.'</option>';
8794: }
1.555 raeburn 8795: }
1.563 raeburn 8796: $srchinsel .= "\n </select>\n";
1.555 raeburn 8797:
8798: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 8799: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 8800: if ($curr_selected{'srchby'} eq $option) {
8801: $srchbysel .= '
8802: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8803: } else {
8804: $srchbysel .= '
8805: <option value="'.$option.'">'.$lt{$option}.'</option>';
8806: }
8807: }
8808: $srchbysel .= "\n </select>\n";
8809:
8810: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 8811: foreach my $option ('begins','contains','exact') {
1.555 raeburn 8812: if ($curr_selected{'srchtype'} eq $option) {
8813: $srchtypesel .= '
8814: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
8815: } else {
8816: $srchtypesel .= '
8817: <option value="'.$option.'">'.$lt{$option}.'</option>';
8818: }
8819: }
8820: $srchtypesel .= "\n </select>\n";
8821:
1.558 albertel 8822: my ($newuserscript,$new_user_create);
1.994 raeburn 8823: my $context_dom = $env{'request.role.domain'};
8824: if ($context eq 'requestcrs') {
8825: if ($env{'form.coursedom'} ne '') {
8826: $context_dom = $env{'form.coursedom'};
8827: }
8828: }
1.556 raeburn 8829: if ($forcenewuser) {
1.576 raeburn 8830: if (ref($srch) eq 'HASH') {
1.994 raeburn 8831: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 8832: if ($cancreate) {
8833: $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>';
8834: } else {
1.799 bisitz 8835: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 8836: my %usertypetext = (
8837: official => 'institutional',
8838: unofficial => 'non-institutional',
8839: );
1.799 bisitz 8840: $new_user_create = '<p class="LC_warning">'
8841: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
8842: .' '
8843: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
8844: ,'<a href="'.$helplink.'">','</a>')
8845: .'</p><br />';
1.627 raeburn 8846: }
1.576 raeburn 8847: }
8848: }
8849:
1.556 raeburn 8850: $newuserscript = <<"ENDSCRIPT";
8851:
1.570 raeburn 8852: function setSearch(createnew,callingForm) {
1.556 raeburn 8853: if (createnew == 1) {
1.570 raeburn 8854: for (var i=0; i<callingForm.srchby.length; i++) {
8855: if (callingForm.srchby.options[i].value == 'uname') {
8856: callingForm.srchby.selectedIndex = i;
1.556 raeburn 8857: }
8858: }
1.570 raeburn 8859: for (var i=0; i<callingForm.srchin.length; i++) {
8860: if ( callingForm.srchin.options[i].value == 'dom') {
8861: callingForm.srchin.selectedIndex = i;
1.556 raeburn 8862: }
8863: }
1.570 raeburn 8864: for (var i=0; i<callingForm.srchtype.length; i++) {
8865: if (callingForm.srchtype.options[i].value == 'exact') {
8866: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 8867: }
8868: }
1.570 raeburn 8869: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 8870: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 8871: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 8872: }
8873: }
8874: }
8875: }
8876: ENDSCRIPT
1.558 albertel 8877:
1.556 raeburn 8878: }
8879:
1.555 raeburn 8880: my $output = <<"END_BLOCK";
1.556 raeburn 8881: <script type="text/javascript">
1.824 bisitz 8882: // <![CDATA[
1.570 raeburn 8883: function validateEntry(callingForm) {
1.558 albertel 8884:
1.556 raeburn 8885: var checkok = 1;
1.558 albertel 8886: var srchin;
1.570 raeburn 8887: for (var i=0; i<callingForm.srchin.length; i++) {
8888: if ( callingForm.srchin[i].checked ) {
8889: srchin = callingForm.srchin[i].value;
1.558 albertel 8890: }
8891: }
8892:
1.570 raeburn 8893: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
8894: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
8895: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
8896: var srchterm = callingForm.srchterm.value;
8897: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 8898: var msg = "";
8899:
8900: if (srchterm == "") {
8901: checkok = 0;
1.571 raeburn 8902: msg += "$lt{'youm'}\\n";
1.556 raeburn 8903: }
8904:
1.569 raeburn 8905: if (srchtype== 'begins') {
8906: if (srchterm.length < 2) {
8907: checkok = 0;
1.571 raeburn 8908: msg += "$lt{'thte'}\\n";
1.569 raeburn 8909: }
8910: }
8911:
1.556 raeburn 8912: if (srchtype== 'contains') {
8913: if (srchterm.length < 3) {
8914: checkok = 0;
1.571 raeburn 8915: msg += "$lt{'thet'}\\n";
1.556 raeburn 8916: }
8917: }
8918: if (srchin == 'instd') {
8919: if (srchdomain == '') {
8920: checkok = 0;
1.571 raeburn 8921: msg += "$lt{'yomc'}\\n";
1.556 raeburn 8922: }
8923: }
8924: if (srchin == 'dom') {
8925: if (srchdomain == '') {
8926: checkok = 0;
1.571 raeburn 8927: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 8928: }
8929: }
8930: if (srchby == 'lastfirst') {
8931: if (srchterm.indexOf(",") == -1) {
8932: checkok = 0;
1.571 raeburn 8933: msg += "$lt{'whus'}\\n";
1.556 raeburn 8934: }
8935: if (srchterm.indexOf(",") == srchterm.length -1) {
8936: checkok = 0;
1.571 raeburn 8937: msg += "$lt{'whse'}\\n";
1.556 raeburn 8938: }
8939: }
8940: if (checkok == 0) {
1.571 raeburn 8941: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 8942: return;
8943: }
8944: if (checkok == 1) {
1.570 raeburn 8945: callingForm.submit();
1.556 raeburn 8946: }
8947: }
8948:
8949: $newuserscript
8950:
1.824 bisitz 8951: // ]]>
1.556 raeburn 8952: </script>
1.558 albertel 8953:
8954: $new_user_create
8955:
1.555 raeburn 8956: END_BLOCK
1.558 albertel 8957:
1.876 raeburn 8958: $output .= &Apache::lonhtmlcommon::start_pick_box().
8959: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
8960: $domform.
8961: &Apache::lonhtmlcommon::row_closure().
8962: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
8963: $srchbysel.
8964: $srchtypesel.
8965: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
8966: $srchinsel.
8967: &Apache::lonhtmlcommon::row_closure(1).
8968: &Apache::lonhtmlcommon::end_pick_box().
8969: '<br />';
1.555 raeburn 8970: return $output;
8971: }
8972:
1.612 raeburn 8973: sub user_rule_check {
1.615 raeburn 8974: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 8975: my $response;
8976: if (ref($usershash) eq 'HASH') {
8977: foreach my $user (keys(%{$usershash})) {
8978: my ($uname,$udom) = split(/:/,$user);
8979: next if ($udom eq '' || $uname eq '');
1.615 raeburn 8980: my ($id,$newuser);
1.612 raeburn 8981: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 8982: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 8983: $id = $usershash->{$user}->{'id'};
8984: }
8985: my $inst_response;
8986: if (ref($checks) eq 'HASH') {
8987: if (defined($checks->{'username'})) {
1.615 raeburn 8988: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8989: &Apache::lonnet::get_instuser($udom,$uname);
8990: } elsif (defined($checks->{'id'})) {
1.615 raeburn 8991: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 8992: &Apache::lonnet::get_instuser($udom,undef,$id);
8993: }
1.615 raeburn 8994: } else {
8995: ($inst_response,%{$inst_results->{$user}}) =
8996: &Apache::lonnet::get_instuser($udom,$uname);
8997: return;
1.612 raeburn 8998: }
1.615 raeburn 8999: if (!$got_rules->{$udom}) {
1.612 raeburn 9000: my %domconfig = &Apache::lonnet::get_dom('configuration',
9001: ['usercreation'],$udom);
9002: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9003: foreach my $item ('username','id') {
1.612 raeburn 9004: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9005: $$curr_rules{$udom}{$item} =
9006: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9007: }
9008: }
9009: }
1.615 raeburn 9010: $got_rules->{$udom} = 1;
1.585 raeburn 9011: }
1.612 raeburn 9012: foreach my $item (keys(%{$checks})) {
9013: if (ref($$curr_rules{$udom}) eq 'HASH') {
9014: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9015: if (@{$$curr_rules{$udom}{$item}} > 0) {
9016: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9017: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9018: if ($rule_check{$rule}) {
9019: $$rulematch{$user}{$item} = $rule;
9020: if ($inst_response eq 'ok') {
1.615 raeburn 9021: if (ref($inst_results) eq 'HASH') {
9022: if (ref($inst_results->{$user}) eq 'HASH') {
9023: if (keys(%{$inst_results->{$user}}) == 0) {
9024: $$alerts{$item}{$udom}{$uname} = 1;
9025: }
1.612 raeburn 9026: }
9027: }
1.615 raeburn 9028: }
9029: last;
1.585 raeburn 9030: }
9031: }
9032: }
9033: }
9034: }
9035: }
9036: }
9037: }
1.612 raeburn 9038: return;
9039: }
9040:
9041: sub user_rule_formats {
9042: my ($domain,$domdesc,$curr_rules,$check) = @_;
9043: my %text = (
9044: 'username' => 'Usernames',
9045: 'id' => 'IDs',
9046: );
9047: my $output;
9048: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9049: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9050: if (@{$ruleorder} > 0) {
1.1102 raeburn 9051: $output = '<br />'.
9052: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9053: '<span class="LC_cusr_emph">','</span>',$domdesc).
9054: ' <ul>';
1.612 raeburn 9055: foreach my $rule (@{$ruleorder}) {
9056: if (ref($curr_rules) eq 'ARRAY') {
9057: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9058: if (ref($rules->{$rule}) eq 'HASH') {
9059: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9060: $rules->{$rule}{'desc'}.'</li>';
9061: }
9062: }
9063: }
9064: }
9065: $output .= '</ul>';
9066: }
9067: }
9068: return $output;
9069: }
9070:
9071: sub instrule_disallow_msg {
1.615 raeburn 9072: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9073: my $response;
9074: my %text = (
9075: item => 'username',
9076: items => 'usernames',
9077: match => 'matches',
9078: do => 'does',
9079: action => 'a username',
9080: one => 'one',
9081: );
9082: if ($count > 1) {
9083: $text{'item'} = 'usernames';
9084: $text{'match'} ='match';
9085: $text{'do'} = 'do';
9086: $text{'action'} = 'usernames',
9087: $text{'one'} = 'ones';
9088: }
9089: if ($checkitem eq 'id') {
9090: $text{'items'} = 'IDs';
9091: $text{'item'} = 'ID';
9092: $text{'action'} = 'an ID';
1.615 raeburn 9093: if ($count > 1) {
9094: $text{'item'} = 'IDs';
9095: $text{'action'} = 'IDs';
9096: }
1.612 raeburn 9097: }
1.674 bisitz 9098: $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 9099: if ($mode eq 'upload') {
9100: if ($checkitem eq 'username') {
9101: $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'}.");
9102: } elsif ($checkitem eq 'id') {
1.674 bisitz 9103: $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 9104: }
1.669 raeburn 9105: } elsif ($mode eq 'selfcreate') {
9106: if ($checkitem eq 'id') {
9107: $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.");
9108: }
1.615 raeburn 9109: } else {
9110: if ($checkitem eq 'username') {
9111: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9112: } elsif ($checkitem eq 'id') {
9113: $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.");
9114: }
1.612 raeburn 9115: }
9116: return $response;
1.585 raeburn 9117: }
9118:
1.624 raeburn 9119: sub personal_data_fieldtitles {
9120: my %fieldtitles = &Apache::lonlocal::texthash (
9121: id => 'Student/Employee ID',
9122: permanentemail => 'E-mail address',
9123: lastname => 'Last Name',
9124: firstname => 'First Name',
9125: middlename => 'Middle Name',
9126: generation => 'Generation',
9127: gen => 'Generation',
1.765 raeburn 9128: inststatus => 'Affiliation',
1.624 raeburn 9129: );
9130: return %fieldtitles;
9131: }
9132:
1.642 raeburn 9133: sub sorted_inst_types {
9134: my ($dom) = @_;
9135: my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9136: my $othertitle = &mt('All users');
9137: if ($env{'request.course.id'}) {
1.668 raeburn 9138: $othertitle = &mt('Any users');
1.642 raeburn 9139: }
9140: my @types;
9141: if (ref($order) eq 'ARRAY') {
9142: @types = @{$order};
9143: }
9144: if (@types == 0) {
9145: if (ref($usertypes) eq 'HASH') {
9146: @types = sort(keys(%{$usertypes}));
9147: }
9148: }
9149: if (keys(%{$usertypes}) > 0) {
9150: $othertitle = &mt('Other users');
9151: }
9152: return ($othertitle,$usertypes,\@types);
9153: }
9154:
1.645 raeburn 9155: sub get_institutional_codes {
9156: my ($settings,$allcourses,$LC_code) = @_;
9157: # Get complete list of course sections to update
9158: my @currsections = ();
9159: my @currxlists = ();
9160: my $coursecode = $$settings{'internal.coursecode'};
9161:
9162: if ($$settings{'internal.sectionnums'} ne '') {
9163: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9164: }
9165:
9166: if ($$settings{'internal.crosslistings'} ne '') {
9167: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9168: }
9169:
9170: if (@currxlists > 0) {
9171: foreach (@currxlists) {
9172: if (m/^([^:]+):(\w*)$/) {
9173: unless (grep/^$1$/,@{$allcourses}) {
9174: push @{$allcourses},$1;
9175: $$LC_code{$1} = $2;
9176: }
9177: }
9178: }
9179: }
9180:
9181: if (@currsections > 0) {
9182: foreach (@currsections) {
9183: if (m/^(\w+):(\w*)$/) {
9184: my $sec = $coursecode.$1;
9185: my $lc_sec = $2;
9186: unless (grep/^$sec$/,@{$allcourses}) {
9187: push @{$allcourses},$sec;
9188: $$LC_code{$sec} = $lc_sec;
9189: }
9190: }
9191: }
9192: }
9193: return;
9194: }
9195:
1.971 raeburn 9196: sub get_standard_codeitems {
9197: return ('Year','Semester','Department','Number','Section');
9198: }
9199:
1.112 bowersj2 9200: =pod
9201:
1.780 raeburn 9202: =head1 Slot Helpers
9203:
9204: =over 4
9205:
9206: =item * sorted_slots()
9207:
1.1040 raeburn 9208: Sorts an array of slot names in order of an optional sort key,
9209: default sort is by slot start time (earliest first).
1.780 raeburn 9210:
9211: Inputs:
9212:
9213: =over 4
9214:
9215: slotsarr - Reference to array of unsorted slot names.
9216:
9217: slots - Reference to hash of hash, where outer hash keys are slot names.
9218:
1.1040 raeburn 9219: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9220:
1.549 albertel 9221: =back
9222:
1.780 raeburn 9223: Returns:
9224:
9225: =over 4
9226:
1.1040 raeburn 9227: sorted - An array of slot names sorted by a specified sort key
9228: (default sort key is start time of the slot).
1.780 raeburn 9229:
9230: =back
9231:
9232: =cut
9233:
9234:
9235: sub sorted_slots {
1.1040 raeburn 9236: my ($slotsarr,$slots,$sortkey) = @_;
9237: if ($sortkey eq '') {
9238: $sortkey = 'starttime';
9239: }
1.780 raeburn 9240: my @sorted;
9241: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9242: @sorted =
9243: sort {
9244: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9245: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9246: }
9247: if (ref($slots->{$a})) { return -1;}
9248: if (ref($slots->{$b})) { return 1;}
9249: return 0;
9250: } @{$slotsarr};
9251: }
9252: return @sorted;
9253: }
9254:
1.1040 raeburn 9255: =pod
9256:
9257: =item * get_future_slots()
9258:
9259: Inputs:
9260:
9261: =over 4
9262:
9263: cnum - course number
9264:
9265: cdom - course domain
9266:
9267: now - current UNIX time
9268:
9269: symb - optional symb
9270:
9271: =back
9272:
9273: Returns:
9274:
9275: =over 4
9276:
9277: sorted_reservable - ref to array of student_schedulable slots currently
9278: reservable, ordered by end date of reservation period.
9279:
9280: reservable_now - ref to hash of student_schedulable slots currently
9281: reservable.
9282:
9283: Keys in inner hash are:
9284: (a) symb: either blank or symb to which slot use is restricted.
9285: (b) endreserve: end date of reservation period.
9286:
9287: sorted_future - ref to array of student_schedulable slots reservable in
9288: the future, ordered by start date of reservation period.
9289:
9290: future_reservable - ref to hash of student_schedulable slots reservable
9291: in the future.
9292:
9293: Keys in inner hash are:
9294: (a) symb: either blank or symb to which slot use is restricted.
9295: (b) startreserve: start date of reservation period.
9296:
9297: =back
9298:
9299: =cut
9300:
9301: sub get_future_slots {
9302: my ($cnum,$cdom,$now,$symb) = @_;
9303: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9304: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9305: foreach my $slot (keys(%slots)) {
9306: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9307: if ($symb) {
9308: next if (($slots{$slot}->{'symb'} ne '') &&
9309: ($slots{$slot}->{'symb'} ne $symb));
9310: }
9311: if (($slots{$slot}->{'starttime'} > $now) &&
9312: ($slots{$slot}->{'endtime'} > $now)) {
9313: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9314: my $userallowed = 0;
9315: if ($slots{$slot}->{'allowedsections'}) {
9316: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9317: if (!defined($env{'request.role.sec'})
9318: && grep(/^No section assigned$/,@allowed_sec)) {
9319: $userallowed=1;
9320: } else {
9321: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9322: $userallowed=1;
9323: }
9324: }
9325: unless ($userallowed) {
9326: if (defined($env{'request.course.groups'})) {
9327: my @groups = split(/:/,$env{'request.course.groups'});
9328: foreach my $group (@groups) {
9329: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9330: $userallowed=1;
9331: last;
9332: }
9333: }
9334: }
9335: }
9336: }
9337: if ($slots{$slot}->{'allowedusers'}) {
9338: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9339: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9340: if (grep(/^\Q$user\E$/,@allowed_users)) {
9341: $userallowed = 1;
9342: }
9343: }
9344: next unless($userallowed);
9345: }
9346: my $startreserve = $slots{$slot}->{'startreserve'};
9347: my $endreserve = $slots{$slot}->{'endreserve'};
9348: my $symb = $slots{$slot}->{'symb'};
9349: if (($startreserve < $now) &&
9350: (!$endreserve || $endreserve > $now)) {
9351: my $lastres = $endreserve;
9352: if (!$lastres) {
9353: $lastres = $slots{$slot}->{'starttime'};
9354: }
9355: $reservable_now{$slot} = {
9356: symb => $symb,
9357: endreserve => $lastres
9358: };
9359: } elsif (($startreserve > $now) &&
9360: (!$endreserve || $endreserve > $startreserve)) {
9361: $future_reservable{$slot} = {
9362: symb => $symb,
9363: startreserve => $startreserve
9364: };
9365: }
9366: }
9367: }
9368: my @unsorted_reservable = keys(%reservable_now);
9369: if (@unsorted_reservable > 0) {
9370: @sorted_reservable =
9371: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9372: }
9373: my @unsorted_future = keys(%future_reservable);
9374: if (@unsorted_future > 0) {
9375: @sorted_future =
9376: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9377: }
9378: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9379: }
1.780 raeburn 9380:
9381: =pod
9382:
1.1057 foxr 9383: =back
9384:
1.549 albertel 9385: =head1 HTTP Helpers
9386:
9387: =over 4
9388:
1.648 raeburn 9389: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9390:
1.258 albertel 9391: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9392: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9393: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9394:
9395: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9396: $possible_names is an ref to an array of form element names. As an example:
9397: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9398: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9399:
9400: =cut
1.1 albertel 9401:
1.6 albertel 9402: sub get_unprocessed_cgi {
1.25 albertel 9403: my ($query,$possible_names)= @_;
1.26 matthew 9404: # $Apache::lonxml::debug=1;
1.356 albertel 9405: foreach my $pair (split(/&/,$query)) {
9406: my ($name, $value) = split(/=/,$pair);
1.369 www 9407: $name = &unescape($name);
1.25 albertel 9408: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9409: $value =~ tr/+/ /;
9410: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9411: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9412: }
1.16 harris41 9413: }
1.6 albertel 9414: }
9415:
1.112 bowersj2 9416: =pod
9417:
1.648 raeburn 9418: =item * &cacheheader()
1.112 bowersj2 9419:
9420: returns cache-controlling header code
9421:
9422: =cut
9423:
1.7 albertel 9424: sub cacheheader {
1.258 albertel 9425: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9426: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9427: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9428: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9429: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9430: return $output;
1.7 albertel 9431: }
9432:
1.112 bowersj2 9433: =pod
9434:
1.648 raeburn 9435: =item * &no_cache($r)
1.112 bowersj2 9436:
9437: specifies header code to not have cache
9438:
9439: =cut
9440:
1.9 albertel 9441: sub no_cache {
1.216 albertel 9442: my ($r) = @_;
9443: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9444: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9445: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9446: $r->no_cache(1);
9447: $r->header_out("Expires" => $date);
9448: $r->header_out("Pragma" => "no-cache");
1.123 www 9449: }
9450:
9451: sub content_type {
1.181 albertel 9452: my ($r,$type,$charset) = @_;
1.299 foxr 9453: if ($r) {
9454: # Note that printout.pl calls this with undef for $r.
9455: &no_cache($r);
9456: }
1.258 albertel 9457: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9458: unless ($charset) {
9459: $charset=&Apache::lonlocal::current_encoding;
9460: }
9461: if ($charset) { $type.='; charset='.$charset; }
9462: if ($r) {
9463: $r->content_type($type);
9464: } else {
9465: print("Content-type: $type\n\n");
9466: }
1.9 albertel 9467: }
1.25 albertel 9468:
1.112 bowersj2 9469: =pod
9470:
1.648 raeburn 9471: =item * &add_to_env($name,$value)
1.112 bowersj2 9472:
1.258 albertel 9473: adds $name to the %env hash with value
1.112 bowersj2 9474: $value, if $name already exists, the entry is converted to an array
9475: reference and $value is added to the array.
9476:
9477: =cut
9478:
1.25 albertel 9479: sub add_to_env {
9480: my ($name,$value)=@_;
1.258 albertel 9481: if (defined($env{$name})) {
9482: if (ref($env{$name})) {
1.25 albertel 9483: #already have multiple values
1.258 albertel 9484: push(@{ $env{$name} },$value);
1.25 albertel 9485: } else {
9486: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9487: my $first=$env{$name};
9488: undef($env{$name});
9489: push(@{ $env{$name} },$first,$value);
1.25 albertel 9490: }
9491: } else {
1.258 albertel 9492: $env{$name}=$value;
1.25 albertel 9493: }
1.31 albertel 9494: }
1.149 albertel 9495:
9496: =pod
9497:
1.648 raeburn 9498: =item * &get_env_multiple($name)
1.149 albertel 9499:
1.258 albertel 9500: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9501: values may be defined and end up as an array ref.
9502:
9503: returns an array of values
9504:
9505: =cut
9506:
9507: sub get_env_multiple {
9508: my ($name) = @_;
9509: my @values;
1.258 albertel 9510: if (defined($env{$name})) {
1.149 albertel 9511: # exists is it an array
1.258 albertel 9512: if (ref($env{$name})) {
9513: @values=@{ $env{$name} };
1.149 albertel 9514: } else {
1.258 albertel 9515: $values[0]=$env{$name};
1.149 albertel 9516: }
9517: }
9518: return(@values);
9519: }
9520:
1.660 raeburn 9521: sub ask_for_embedded_content {
9522: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9523: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9524: %currsubfile,%unused,$rem);
1.1071 raeburn 9525: my $counter = 0;
9526: my $numnew = 0;
1.987 raeburn 9527: my $numremref = 0;
9528: my $numinvalid = 0;
9529: my $numpathchg = 0;
9530: my $numexisting = 0;
1.1071 raeburn 9531: my $numunused = 0;
9532: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
9533: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
9534: my $heading = &mt('Upload embedded files');
9535: my $buttontext = &mt('Upload');
9536:
1.1085 raeburn 9537: my $navmap;
9538: if ($env{'request.course.id'}) {
9539: $navmap = Apache::lonnavmaps::navmap->new();
9540: }
1.984 raeburn 9541: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9542: my $current_path='/';
9543: if ($env{'form.currentpath'}) {
9544: $current_path = $env{'form.currentpath'};
9545: }
9546: if ($actionurl eq '/adm/coursegrp_portfolio') {
9547: $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9548: $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
9549: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9550: } else {
9551: $udom = $env{'user.domain'};
9552: $uname = $env{'user.name'};
9553: $url = '/userfiles/portfolio';
9554: }
1.987 raeburn 9555: $toplevel = $url.'/';
1.984 raeburn 9556: $url .= $current_path;
9557: $getpropath = 1;
1.987 raeburn 9558: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9559: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9560: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9561: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9562: $toplevel = $url;
1.984 raeburn 9563: if ($rest ne '') {
1.987 raeburn 9564: $url .= $rest;
9565: }
9566: } elsif ($actionurl eq '/adm/coursedocs') {
9567: if (ref($args) eq 'HASH') {
1.1071 raeburn 9568: $url = $args->{'docs_url'};
9569: $toplevel = $url;
1.1084 raeburn 9570: if ($args->{'context'} eq 'paste') {
9571: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9572: ($path) =
9573: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9574: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9575: $fileloc =~ s{^/}{};
9576: }
1.1071 raeburn 9577: }
1.1084 raeburn 9578: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9579: if ($env{'request.course.id'} ne '') {
9580: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9581: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9582: if (ref($args) eq 'HASH') {
9583: $url = $args->{'docs_url'};
9584: $title = $args->{'docs_title'};
9585: $toplevel = "/$url";
1.1085 raeburn 9586: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071 raeburn 9587: ($path) =
9588: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9589: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9590: $fileloc =~ s{^/}{};
9591: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9592: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9593: }
1.987 raeburn 9594: }
9595: }
9596: my $now = time();
9597: foreach my $embed_file (keys(%{$allfiles})) {
9598: my $absolutepath;
9599: if ($embed_file =~ m{^\w+://}) {
9600: $newfiles{$embed_file} = 1;
9601: $mapping{$embed_file} = $embed_file;
9602: } else {
9603: if ($embed_file =~ m{^/}) {
9604: $absolutepath = $embed_file;
9605: $embed_file =~ s{^(/+)}{};
9606: }
9607: if ($embed_file =~ m{/}) {
9608: my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
9609: $path = &check_for_traversal($path,$url,$toplevel);
9610: my $item = $fname;
9611: if ($path ne '') {
9612: $item = $path.'/'.$fname;
9613: $subdependencies{$path}{$fname} = 1;
9614: } else {
9615: $dependencies{$item} = 1;
9616: }
9617: if ($absolutepath) {
9618: $mapping{$item} = $absolutepath;
9619: } else {
9620: $mapping{$item} = $embed_file;
9621: }
9622: } else {
9623: $dependencies{$embed_file} = 1;
9624: if ($absolutepath) {
9625: $mapping{$embed_file} = $absolutepath;
9626: } else {
9627: $mapping{$embed_file} = $embed_file;
9628: }
9629: }
1.984 raeburn 9630: }
9631: }
1.1071 raeburn 9632: my $dirptr = 16384;
1.984 raeburn 9633: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 9634: $currsubfile{$path} = {};
1.984 raeburn 9635: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9636: my ($sublistref,$listerror) =
9637: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
9638: if (ref($sublistref) eq 'ARRAY') {
9639: foreach my $line (@{$sublistref}) {
9640: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 9641: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 9642: }
1.984 raeburn 9643: }
1.987 raeburn 9644: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9645: if (opendir(my $dir,$url.'/'.$path)) {
9646: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 9647: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
9648: }
1.1084 raeburn 9649: } elsif (($actionurl eq '/adm/dependencies') ||
9650: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9651: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9652: if ($env{'request.course.id'} ne '') {
9653: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9654: if ($dir ne '') {
9655: my ($sublistref,$listerror) =
9656: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
9657: if (ref($sublistref) eq 'ARRAY') {
9658: foreach my $line (@{$sublistref}) {
9659: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
9660: undef,$mtime)=split(/\&/,$line,12);
9661: unless (($testdir&$dirptr) ||
9662: ($file_name =~ /^\.\.?$/)) {
9663: $currsubfile{$path}{$file_name} = [$size,$mtime];
9664: }
9665: }
9666: }
9667: }
1.984 raeburn 9668: }
9669: }
9670: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 9671: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 9672: my $item = $path.'/'.$file;
9673: unless ($mapping{$item} eq $item) {
9674: $pathchanges{$item} = 1;
9675: }
9676: $existing{$item} = 1;
9677: $numexisting ++;
9678: } else {
9679: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 9680: }
9681: }
1.1071 raeburn 9682: if ($actionurl eq '/adm/dependencies') {
9683: foreach my $path (keys(%currsubfile)) {
9684: if (ref($currsubfile{$path}) eq 'HASH') {
9685: foreach my $file (keys(%{$currsubfile{$path}})) {
9686: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 9687: next if (($rem ne '') &&
9688: (($env{"httpref.$rem"."$path/$file"} ne '') ||
9689: (ref($navmap) &&
9690: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
9691: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9692: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 9693: $unused{$path.'/'.$file} = 1;
9694: }
9695: }
9696: }
9697: }
9698: }
1.984 raeburn 9699: }
1.987 raeburn 9700: my %currfile;
1.984 raeburn 9701: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 9702: my ($dirlistref,$listerror) =
9703: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
9704: if (ref($dirlistref) eq 'ARRAY') {
9705: foreach my $line (@{$dirlistref}) {
9706: my ($file_name,$rest) = split(/\&/,$line,2);
9707: $currfile{$file_name} = 1;
9708: }
1.984 raeburn 9709: }
1.987 raeburn 9710: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 9711: if (opendir(my $dir,$url)) {
1.987 raeburn 9712: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 9713: map {$currfile{$_} = 1;} @dir_list;
9714: }
1.1084 raeburn 9715: } elsif (($actionurl eq '/adm/dependencies') ||
9716: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9717: ($args->{'context'} eq 'paste'))) {
1.1071 raeburn 9718: if ($env{'request.course.id'} ne '') {
9719: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
9720: if ($dir ne '') {
9721: my ($dirlistref,$listerror) =
9722: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
9723: if (ref($dirlistref) eq 'ARRAY') {
9724: foreach my $line (@{$dirlistref}) {
9725: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
9726: $size,undef,$mtime)=split(/\&/,$line,12);
9727: unless (($testdir&$dirptr) ||
9728: ($file_name =~ /^\.\.?$/)) {
9729: $currfile{$file_name} = [$size,$mtime];
9730: }
9731: }
9732: }
9733: }
9734: }
1.984 raeburn 9735: }
9736: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 9737: if (exists($currfile{$file})) {
1.987 raeburn 9738: unless ($mapping{$file} eq $file) {
9739: $pathchanges{$file} = 1;
9740: }
9741: $existing{$file} = 1;
9742: $numexisting ++;
9743: } else {
1.984 raeburn 9744: $newfiles{$file} = 1;
9745: }
9746: }
1.1071 raeburn 9747: foreach my $file (keys(%currfile)) {
9748: unless (($file eq $filename) ||
9749: ($file eq $filename.'.bak') ||
9750: ($dependencies{$file})) {
1.1085 raeburn 9751: if ($actionurl eq '/adm/dependencies') {
9752: next if (($rem ne '') &&
9753: (($env{"httpref.$rem".$file} ne '') ||
9754: (ref($navmap) &&
9755: (($navmap->getResourceByUrl($rem.$file) ne '') ||
9756: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
9757: ($navmap->getResourceByUrl($rem.$1)))))));
9758: }
1.1071 raeburn 9759: $unused{$file} = 1;
9760: }
9761: }
1.1084 raeburn 9762: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
9763: ($args->{'context'} eq 'paste')) {
9764: $counter = scalar(keys(%existing));
9765: $numpathchg = scalar(keys(%pathchanges));
9766: return ($output,$counter,$numpathchg,\%existing);
9767: }
1.984 raeburn 9768: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 9769: if ($actionurl eq '/adm/dependencies') {
9770: next if ($embed_file =~ m{^\w+://});
9771: }
1.660 raeburn 9772: $upload_output .= &start_data_table_row().
1.1071 raeburn 9773: '<td><img src="'.&icon($embed_file).'" /> '.
9774: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 9775: unless ($mapping{$embed_file} eq $embed_file) {
9776: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
9777: }
9778: $upload_output .= '</td><td>';
1.1071 raeburn 9779: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.660 raeburn 9780: $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987 raeburn 9781: $numremref++;
1.660 raeburn 9782: } elsif ($args->{'error_on_invalid_names'}
9783: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987 raeburn 9784: $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
9785: $numinvalid++;
1.660 raeburn 9786: } else {
1.1071 raeburn 9787: $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 9788: $embed_file,\%mapping,
1.1071 raeburn 9789: $allfiles,$codebase,'upload');
9790: $counter ++;
9791: $numnew ++;
1.987 raeburn 9792: }
9793: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
9794: }
9795: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 9796: if ($actionurl eq '/adm/dependencies') {
9797: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
9798: $modify_output .= &start_data_table_row().
9799: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
9800: '<img src="'.&icon($embed_file).'" border="0" />'.
9801: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
9802: '<td>'.$size.'</td>'.
9803: '<td>'.$mtime.'</td>'.
9804: '<td><label><input type="checkbox" name="mod_upload_dep" '.
9805: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
9806: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
9807: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
9808: &embedded_file_element('upload_embedded',$counter,
9809: $embed_file,\%mapping,
9810: $allfiles,$codebase,'modify').
9811: '</div></td>'.
9812: &end_data_table_row()."\n";
9813: $counter ++;
9814: } else {
9815: $upload_output .= &start_data_table_row().
9816: '<td><span class="LC_filename">'.$embed_file.'</span></td>';
9817: '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
9818: &Apache::loncommon::end_data_table_row()."\n";
9819: }
9820: }
9821: my $delidx = $counter;
9822: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
9823: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
9824: $delete_output .= &start_data_table_row().
9825: '<td><img src="'.&icon($oldfile).'" />'.
9826: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
9827: '<td>'.$size.'</td>'.
9828: '<td>'.$mtime.'</td>'.
9829: '<td><label><input type="checkbox" name="del_upload_dep" '.
9830: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
9831: &embedded_file_element('upload_embedded',$delidx,
9832: $oldfile,\%mapping,$allfiles,
9833: $codebase,'delete').'</td>'.
9834: &end_data_table_row()."\n";
9835: $numunused ++;
9836: $delidx ++;
1.987 raeburn 9837: }
9838: if ($upload_output) {
9839: $upload_output = &start_data_table().
9840: $upload_output.
9841: &end_data_table()."\n";
9842: }
1.1071 raeburn 9843: if ($modify_output) {
9844: $modify_output = &start_data_table().
9845: &start_data_table_header_row().
9846: '<th>'.&mt('File').'</th>'.
9847: '<th>'.&mt('Size (KB)').'</th>'.
9848: '<th>'.&mt('Modified').'</th>'.
9849: '<th>'.&mt('Upload replacement?').'</th>'.
9850: &end_data_table_header_row().
9851: $modify_output.
9852: &end_data_table()."\n";
9853: }
9854: if ($delete_output) {
9855: $delete_output = &start_data_table().
9856: &start_data_table_header_row().
9857: '<th>'.&mt('File').'</th>'.
9858: '<th>'.&mt('Size (KB)').'</th>'.
9859: '<th>'.&mt('Modified').'</th>'.
9860: '<th>'.&mt('Delete?').'</th>'.
9861: &end_data_table_header_row().
9862: $delete_output.
9863: &end_data_table()."\n";
9864: }
1.987 raeburn 9865: my $applies = 0;
9866: if ($numremref) {
9867: $applies ++;
9868: }
9869: if ($numinvalid) {
9870: $applies ++;
9871: }
9872: if ($numexisting) {
9873: $applies ++;
9874: }
1.1071 raeburn 9875: if ($counter || $numunused) {
1.987 raeburn 9876: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
9877: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 9878: $state.'<h3>'.$heading.'</h3>';
9879: if ($actionurl eq '/adm/dependencies') {
9880: if ($numnew) {
9881: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
9882: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
9883: $upload_output.'<br />'."\n";
9884: }
9885: if ($numexisting) {
9886: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
9887: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
9888: $modify_output.'<br />'."\n";
9889: $buttontext = &mt('Save changes');
9890: }
9891: if ($numunused) {
9892: $output .= '<h4>'.&mt('Unused files').'</h4>'.
9893: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
9894: $delete_output.'<br />'."\n";
9895: $buttontext = &mt('Save changes');
9896: }
9897: } else {
9898: $output .= $upload_output.'<br />'."\n";
9899: }
9900: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
9901: $counter.'" />'."\n";
9902: if ($actionurl eq '/adm/dependencies') {
9903: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
9904: $numnew.'" />'."\n";
9905: } elsif ($actionurl eq '') {
1.987 raeburn 9906: $output .= '<input type="hidden" name="phase" value="three" />';
9907: }
9908: } elsif ($applies) {
9909: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
9910: if ($applies > 1) {
9911: $output .=
9912: &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
9913: if ($numremref) {
9914: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
9915: }
9916: if ($numinvalid) {
9917: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
9918: }
9919: if ($numexisting) {
9920: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
9921: }
9922: $output .= '</ul><br />';
9923: } elsif ($numremref) {
9924: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
9925: } elsif ($numinvalid) {
9926: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
9927: } elsif ($numexisting) {
9928: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
9929: }
9930: $output .= $upload_output.'<br />';
9931: }
9932: my ($pathchange_output,$chgcount);
1.1071 raeburn 9933: $chgcount = $counter;
1.987 raeburn 9934: if (keys(%pathchanges) > 0) {
9935: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 9936: if ($counter) {
1.987 raeburn 9937: $output .= &embedded_file_element('pathchange',$chgcount,
9938: $embed_file,\%mapping,
1.1071 raeburn 9939: $allfiles,$codebase,'change');
1.987 raeburn 9940: } else {
9941: $pathchange_output .=
9942: &start_data_table_row().
9943: '<td><input type ="checkbox" name="namechange" value="'.
9944: $chgcount.'" checked="checked" /></td>'.
9945: '<td>'.$mapping{$embed_file}.'</td>'.
9946: '<td>'.$embed_file.
9947: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 9948: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 9949: '</td>'.&end_data_table_row();
1.660 raeburn 9950: }
1.987 raeburn 9951: $numpathchg ++;
9952: $chgcount ++;
1.660 raeburn 9953: }
9954: }
1.1071 raeburn 9955: if ($counter) {
1.987 raeburn 9956: if ($numpathchg) {
9957: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
9958: $numpathchg.'" />'."\n";
9959: }
9960: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9961: ($actionurl eq '/adm/imsimport')) {
9962: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
9963: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
9964: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 9965: } elsif ($actionurl eq '/adm/dependencies') {
9966: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 9967: }
1.1071 raeburn 9968: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 9969: } elsif ($numpathchg) {
9970: my %pathchange = ();
9971: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
9972: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
9973: $output .= '<p>'.&mt('or').'</p>';
9974: }
9975: }
1.1071 raeburn 9976: return ($output,$counter,$numpathchg);
1.987 raeburn 9977: }
9978:
9979: sub embedded_file_element {
1.1071 raeburn 9980: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 9981: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
9982: (ref($codebase) eq 'HASH'));
9983: my $output;
1.1071 raeburn 9984: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 9985: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
9986: }
9987: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
9988: &escape($embed_file).'" />';
9989: unless (($context eq 'upload_embedded') &&
9990: ($mapping->{$embed_file} eq $embed_file)) {
9991: $output .='
9992: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
9993: }
9994: my $attrib;
9995: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
9996: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
9997: }
9998: $output .=
9999: "\n\t\t".
10000: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10001: $attrib.'" />';
10002: if (exists($codebase->{$mapping->{$embed_file}})) {
10003: $output .=
10004: "\n\t\t".
10005: '<input name="codebase_'.$num.'" type="hidden" value="'.
10006: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10007: }
1.987 raeburn 10008: return $output;
1.660 raeburn 10009: }
10010:
1.1071 raeburn 10011: sub get_dependency_details {
10012: my ($currfile,$currsubfile,$embed_file) = @_;
10013: my ($size,$mtime,$showsize,$showmtime);
10014: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10015: if ($embed_file =~ m{/}) {
10016: my ($path,$fname) = split(/\//,$embed_file);
10017: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10018: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10019: }
10020: } else {
10021: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10022: ($size,$mtime) = @{$currfile->{$embed_file}};
10023: }
10024: }
10025: $showsize = $size/1024.0;
10026: $showsize = sprintf("%.1f",$showsize);
10027: if ($mtime > 0) {
10028: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10029: }
10030: }
10031: return ($showsize,$showmtime);
10032: }
10033:
10034: sub ask_embedded_js {
10035: return <<"END";
10036: <script type="text/javascript"">
10037: // <![CDATA[
10038: function toggleBrowse(counter) {
10039: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10040: var fileid = document.getElementById('embedded_item_'+counter);
10041: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10042: if (chkboxid.checked == true) {
10043: uploaddivid.style.display='block';
10044: } else {
10045: uploaddivid.style.display='none';
10046: fileid.value = '';
10047: }
10048: }
10049: // ]]>
10050: </script>
10051:
10052: END
10053: }
10054:
1.661 raeburn 10055: sub upload_embedded {
10056: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10057: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10058: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10059: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10060: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10061: my $orig_uploaded_filename =
10062: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10063: foreach my $type ('orig','ref','attrib','codebase') {
10064: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10065: $env{'form.embedded_'.$type.'_'.$i} =
10066: &unescape($env{'form.embedded_'.$type.'_'.$i});
10067: }
10068: }
1.661 raeburn 10069: my ($path,$fname) =
10070: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10071: # no path, whole string is fname
10072: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10073: $fname = &Apache::lonnet::clean_filename($fname);
10074: # See if there is anything left
10075: next if ($fname eq '');
10076:
10077: # Check if file already exists as a file or directory.
10078: my ($state,$msg);
10079: if ($context eq 'portfolio') {
10080: my $port_path = $dirpath;
10081: if ($group ne '') {
10082: $port_path = "groups/$group/$port_path";
10083: }
1.987 raeburn 10084: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10085: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10086: $dir_root,$port_path,$disk_quota,
10087: $current_disk_usage,$uname,$udom);
10088: if ($state eq 'will_exceed_quota'
1.984 raeburn 10089: || $state eq 'file_locked') {
1.661 raeburn 10090: $output .= $msg;
10091: next;
10092: }
10093: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10094: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10095: if ($state eq 'exists') {
10096: $output .= $msg;
10097: next;
10098: }
10099: }
10100: # Check if extension is valid
10101: if (($fname =~ /\.(\w+)$/) &&
10102: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987 raeburn 10103: $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661 raeburn 10104: next;
10105: } elsif (($fname =~ /\.(\w+)$/) &&
10106: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10107: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10108: next;
10109: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987 raeburn 10110: $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661 raeburn 10111: next;
10112: }
10113: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
10114: if ($context eq 'portfolio') {
1.984 raeburn 10115: my $result;
10116: if ($state eq 'existingfile') {
10117: $result=
10118: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987 raeburn 10119: $dirpath.$env{'form.currentpath'}.$path);
1.661 raeburn 10120: } else {
1.984 raeburn 10121: $result=
10122: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10123: $dirpath.
10124: $env{'form.currentpath'}.$path);
1.984 raeburn 10125: if ($result !~ m|^/uploaded/|) {
10126: $output .= '<span class="LC_error">'
10127: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10128: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10129: .'</span><br />';
10130: next;
10131: } else {
1.987 raeburn 10132: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10133: $path.$fname.'</span>').'<br />';
1.984 raeburn 10134: }
1.661 raeburn 10135: }
1.987 raeburn 10136: } elsif ($context eq 'coursedoc') {
10137: my $result =
10138: &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
10139: $dirpath.'/'.$path);
10140: if ($result !~ m|^/uploaded/|) {
10141: $output .= '<span class="LC_error">'
10142: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10143: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10144: .'</span><br />';
10145: next;
10146: } else {
10147: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10148: $path.$fname.'</span>').'<br />';
10149: }
1.661 raeburn 10150: } else {
10151: # Save the file
10152: my $target = $env{'form.embedded_item_'.$i};
10153: my $fullpath = $dir_root.$dirpath.'/'.$path;
10154: my $dest = $fullpath.$fname;
10155: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10156: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10157: my $count;
10158: my $filepath = $dir_root;
1.1027 raeburn 10159: foreach my $subdir (@parts) {
10160: $filepath .= "/$subdir";
10161: if (!-e $filepath) {
1.661 raeburn 10162: mkdir($filepath,0770);
10163: }
10164: }
10165: my $fh;
10166: if (!open($fh,'>'.$dest)) {
10167: &Apache::lonnet::logthis('Failed to create '.$dest);
10168: $output .= '<span class="LC_error">'.
1.1071 raeburn 10169: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10170: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10171: '</span><br />';
10172: } else {
10173: if (!print $fh $env{'form.embedded_item_'.$i}) {
10174: &Apache::lonnet::logthis('Failed to write to '.$dest);
10175: $output .= '<span class="LC_error">'.
1.1071 raeburn 10176: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10177: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10178: '</span><br />';
10179: } else {
1.987 raeburn 10180: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10181: $url.'</span>').'<br />';
10182: unless ($context eq 'testbank') {
10183: $footer .= &mt('View embedded file: [_1]',
10184: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10185: }
10186: }
10187: close($fh);
10188: }
10189: }
10190: if ($env{'form.embedded_ref_'.$i}) {
10191: $pathchange{$i} = 1;
10192: }
10193: }
10194: if ($output) {
10195: $output = '<p>'.$output.'</p>';
10196: }
10197: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10198: $returnflag = 'ok';
1.1071 raeburn 10199: my $numpathchgs = scalar(keys(%pathchange));
10200: if ($numpathchgs > 0) {
1.987 raeburn 10201: if ($context eq 'portfolio') {
10202: $output .= '<p>'.&mt('or').'</p>';
10203: } elsif ($context eq 'testbank') {
1.1071 raeburn 10204: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10205: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10206: $returnflag = 'modify_orightml';
10207: }
10208: }
1.1071 raeburn 10209: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10210: }
10211:
10212: sub modify_html_form {
10213: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10214: my $end = 0;
10215: my $modifyform;
10216: if ($context eq 'upload_embedded') {
10217: return unless (ref($pathchange) eq 'HASH');
10218: if ($env{'form.number_embedded_items'}) {
10219: $end += $env{'form.number_embedded_items'};
10220: }
10221: if ($env{'form.number_pathchange_items'}) {
10222: $end += $env{'form.number_pathchange_items'};
10223: }
10224: if ($end) {
10225: for (my $i=0; $i<$end; $i++) {
10226: if ($i < $env{'form.number_embedded_items'}) {
10227: next unless($pathchange->{$i});
10228: }
10229: $modifyform .=
10230: &start_data_table_row().
10231: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10232: 'checked="checked" /></td>'.
10233: '<td>'.$env{'form.embedded_ref_'.$i}.
10234: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10235: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10236: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10237: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10238: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10239: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10240: '<td>'.$env{'form.embedded_orig_'.$i}.
10241: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10242: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10243: &end_data_table_row();
1.1071 raeburn 10244: }
1.987 raeburn 10245: }
10246: } else {
10247: $modifyform = $pathchgtable;
10248: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10249: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10250: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10251: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10252: }
10253: }
10254: if ($modifyform) {
1.1071 raeburn 10255: if ($actionurl eq '/adm/dependencies') {
10256: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10257: }
1.987 raeburn 10258: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10259: '<p>'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'<ol>'."\n".
10260: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10261: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10262: '</ol></p>'."\n".'<p>'.
10263: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10264: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10265: &start_data_table()."\n".
10266: &start_data_table_header_row().
10267: '<th>'.&mt('Change?').'</th>'.
10268: '<th>'.&mt('Current reference').'</th>'.
10269: '<th>'.&mt('Required reference').'</th>'.
10270: &end_data_table_header_row()."\n".
10271: $modifyform.
10272: &end_data_table().'<br />'."\n".$hiddenstate.
10273: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10274: '</form>'."\n";
10275: }
10276: return;
10277: }
10278:
10279: sub modify_html_refs {
10280: my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
10281: my $container;
10282: if ($context eq 'portfolio') {
10283: $container = $env{'form.container'};
10284: } elsif ($context eq 'coursedoc') {
10285: $container = $env{'form.primaryurl'};
1.1071 raeburn 10286: } elsif ($context eq 'manage_dependencies') {
10287: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10288: $container = "/$container";
1.987 raeburn 10289: } else {
1.1027 raeburn 10290: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10291: }
10292: my (%allfiles,%codebase,$output,$content);
10293: my @changes = &get_env_multiple('form.namechange');
1.1071 raeburn 10294: unless (@changes > 0) {
10295: if (wantarray) {
10296: return ('',0,0);
10297: } else {
10298: return;
10299: }
10300: }
10301: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10302: ($context eq 'manage_dependencies')) {
10303: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10304: if (wantarray) {
10305: return ('',0,0);
10306: } else {
10307: return;
10308: }
10309: }
1.987 raeburn 10310: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10311: if ($content eq '-1') {
10312: if (wantarray) {
10313: return ('',0,0);
10314: } else {
10315: return;
10316: }
10317: }
1.987 raeburn 10318: } else {
1.1071 raeburn 10319: unless ($container =~ /^\Q$dir_root\E/) {
10320: if (wantarray) {
10321: return ('',0,0);
10322: } else {
10323: return;
10324: }
10325: }
1.987 raeburn 10326: if (open(my $fh,"<$container")) {
10327: $content = join('', <$fh>);
10328: close($fh);
10329: } else {
1.1071 raeburn 10330: if (wantarray) {
10331: return ('',0,0);
10332: } else {
10333: return;
10334: }
1.987 raeburn 10335: }
10336: }
10337: my ($count,$codebasecount) = (0,0);
10338: my $mm = new File::MMagic;
10339: my $mime_type = $mm->checktype_contents($content);
10340: if ($mime_type eq 'text/html') {
10341: my $parse_result =
10342: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10343: \%codebase,\$content);
10344: if ($parse_result eq 'ok') {
10345: foreach my $i (@changes) {
10346: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10347: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10348: if ($allfiles{$ref}) {
10349: my $newname = $orig;
10350: my ($attrib_regexp,$codebase);
1.1006 raeburn 10351: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10352: if ($attrib_regexp =~ /:/) {
10353: $attrib_regexp =~ s/\:/|/g;
10354: }
10355: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10356: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10357: $count += $numchg;
10358: }
10359: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10360: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10361: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10362: $codebasecount ++;
10363: }
10364: }
10365: }
10366: if ($count || $codebasecount) {
10367: my $saveresult;
1.1071 raeburn 10368: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
10369: ($context eq 'manage_dependencies')) {
1.987 raeburn 10370: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10371: if ($url eq $container) {
10372: my ($fname) = ($container =~ m{/([^/]+)$});
10373: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10374: $count,'<span class="LC_filename">'.
1.1071 raeburn 10375: $fname.'</span>').'</p>';
1.987 raeburn 10376: } else {
10377: $output = '<p class="LC_error">'.
10378: &mt('Error: update failed for: [_1].',
10379: '<span class="LC_filename">'.
10380: $container.'</span>').'</p>';
10381: }
10382: } else {
10383: if (open(my $fh,">$container")) {
10384: print $fh $content;
10385: close($fh);
10386: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10387: $count,'<span class="LC_filename">'.
10388: $container.'</span>').'</p>';
1.661 raeburn 10389: } else {
1.987 raeburn 10390: $output = '<p class="LC_error">'.
10391: &mt('Error: could not update [_1].',
10392: '<span class="LC_filename">'.
10393: $container.'</span>').'</p>';
1.661 raeburn 10394: }
10395: }
10396: }
1.987 raeburn 10397: } else {
10398: &logthis('Failed to parse '.$container.
10399: ' to modify references: '.$parse_result);
1.661 raeburn 10400: }
10401: }
1.1071 raeburn 10402: if (wantarray) {
10403: return ($output,$count,$codebasecount);
10404: } else {
10405: return $output;
10406: }
1.661 raeburn 10407: }
10408:
10409: sub check_for_existing {
10410: my ($path,$fname,$element) = @_;
10411: my ($state,$msg);
10412: if (-d $path.'/'.$fname) {
10413: $state = 'exists';
10414: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10415: } elsif (-e $path.'/'.$fname) {
10416: $state = 'exists';
10417: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10418: }
10419: if ($state eq 'exists') {
10420: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10421: }
10422: return ($state,$msg);
10423: }
10424:
10425: sub check_for_upload {
10426: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10427: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10428: my $filesize = length($env{'form.'.$element});
10429: if (!$filesize) {
10430: my $msg = '<span class="LC_error">'.
10431: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10432: '<span class="LC_filename">'.$fname.'</span>',
10433: $filesize).'<br />'.
1.1007 raeburn 10434: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10435: '</span>';
10436: return ('zero_bytes',$msg);
10437: }
10438: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10439: my $getpropath = 1;
1.1021 raeburn 10440: my ($dirlistref,$listerror) =
10441: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10442: my $found_file = 0;
10443: my $locked_file = 0;
1.991 raeburn 10444: my @lockers;
10445: my $navmap;
10446: if ($env{'request.course.id'}) {
10447: $navmap = Apache::lonnavmaps::navmap->new();
10448: }
1.1021 raeburn 10449: if (ref($dirlistref) eq 'ARRAY') {
10450: foreach my $line (@{$dirlistref}) {
10451: my ($file_name,$rest)=split(/\&/,$line,2);
10452: if ($file_name eq $fname){
10453: $file_name = $path.$file_name;
10454: if ($group ne '') {
10455: $file_name = $group.$file_name;
10456: }
10457: $found_file = 1;
10458: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10459: foreach my $lock (@lockers) {
10460: if (ref($lock) eq 'ARRAY') {
10461: my ($symb,$crsid) = @{$lock};
10462: if ($crsid eq $env{'request.course.id'}) {
10463: if (ref($navmap)) {
10464: my $res = $navmap->getBySymb($symb);
10465: foreach my $part (@{$res->parts()}) {
10466: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10467: unless (($slot_status == $res->RESERVED) ||
10468: ($slot_status == $res->RESERVED_LOCATION)) {
10469: $locked_file = 1;
10470: }
1.991 raeburn 10471: }
1.1021 raeburn 10472: } else {
10473: $locked_file = 1;
1.991 raeburn 10474: }
10475: } else {
10476: $locked_file = 1;
10477: }
10478: }
1.1021 raeburn 10479: }
10480: } else {
10481: my @info = split(/\&/,$rest);
10482: my $currsize = $info[6]/1000;
10483: if ($currsize < $filesize) {
10484: my $extra = $filesize - $currsize;
10485: if (($current_disk_usage + $extra) > $disk_quota) {
10486: my $msg = '<span class="LC_error">'.
10487: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
10488: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
10489: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
10490: $disk_quota,$current_disk_usage);
10491: return ('will_exceed_quota',$msg);
10492: }
1.984 raeburn 10493: }
10494: }
1.661 raeburn 10495: }
10496: }
10497: }
10498: if (($current_disk_usage + $filesize) > $disk_quota){
10499: my $msg = '<span class="LC_error">'.
10500: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
10501: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
10502: return ('will_exceed_quota',$msg);
10503: } elsif ($found_file) {
10504: if ($locked_file) {
10505: my $msg = '<span class="LC_error">';
10506: $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>');
10507: $msg .= '</span><br />';
10508: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
10509: return ('file_locked',$msg);
10510: } else {
10511: my $msg = '<span class="LC_error">';
1.984 raeburn 10512: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.661 raeburn 10513: $msg .= '</span>';
1.984 raeburn 10514: return ('existingfile',$msg);
1.661 raeburn 10515: }
10516: }
10517: }
10518:
1.987 raeburn 10519: sub check_for_traversal {
10520: my ($path,$url,$toplevel) = @_;
10521: my @parts=split(/\//,$path);
10522: my $cleanpath;
10523: my $fullpath = $url;
10524: for (my $i=0;$i<@parts;$i++) {
10525: next if ($parts[$i] eq '.');
10526: if ($parts[$i] eq '..') {
10527: $fullpath =~ s{([^/]+/)$}{};
10528: } else {
10529: $fullpath .= $parts[$i].'/';
10530: }
10531: }
10532: if ($fullpath =~ /^\Q$url\E(.*)$/) {
10533: $cleanpath = $1;
10534: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
10535: my $curr_toprel = $1;
10536: my @parts = split(/\//,$curr_toprel);
10537: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
10538: my @urlparts = split(/\//,$url_toprel);
10539: my $doubledots;
10540: my $startdiff = -1;
10541: for (my $i=0; $i<@urlparts; $i++) {
10542: if ($startdiff == -1) {
10543: unless ($urlparts[$i] eq $parts[$i]) {
10544: $startdiff = $i;
10545: $doubledots .= '../';
10546: }
10547: } else {
10548: $doubledots .= '../';
10549: }
10550: }
10551: if ($startdiff > -1) {
10552: $cleanpath = $doubledots;
10553: for (my $i=$startdiff; $i<@parts; $i++) {
10554: $cleanpath .= $parts[$i].'/';
10555: }
10556: }
10557: }
10558: $cleanpath =~ s{(/)$}{};
10559: return $cleanpath;
10560: }
1.31 albertel 10561:
1.1053 raeburn 10562: sub is_archive_file {
10563: my ($mimetype) = @_;
10564: if (($mimetype eq 'application/octet-stream') ||
10565: ($mimetype eq 'application/x-stuffit') ||
10566: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
10567: return 1;
10568: }
10569: return;
10570: }
10571:
10572: sub decompress_form {
1.1065 raeburn 10573: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 10574: my %lt = &Apache::lonlocal::texthash (
10575: this => 'This file is an archive file.',
1.1067 raeburn 10576: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 10577: itsc => 'Its contents are as follows:',
1.1053 raeburn 10578: youm => 'You may wish to extract its contents.',
10579: extr => 'Extract contents',
1.1067 raeburn 10580: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
10581: proa => 'Process automatically?',
1.1053 raeburn 10582: yes => 'Yes',
10583: no => 'No',
1.1067 raeburn 10584: fold => 'Title for folder containing movie',
10585: movi => 'Title for page containing embedded movie',
1.1053 raeburn 10586: );
1.1065 raeburn 10587: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 10588: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 10589: my $info = &list_archive_contents($fileloc,\@paths);
10590: if (@paths) {
10591: foreach my $path (@paths) {
10592: $path =~ s{^/}{};
1.1067 raeburn 10593: if ($path =~ m{^([^/]+)/$}) {
10594: $topdir = $1;
10595: }
1.1065 raeburn 10596: if ($path =~ m{^([^/]+)/}) {
10597: $toplevel{$1} = $path;
10598: } else {
10599: $toplevel{$path} = $path;
10600: }
10601: }
10602: }
1.1067 raeburn 10603: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
10604: my @camtasia = ("$topdir/","$topdir/index.html",
10605: "$topdir/media/",
10606: "$topdir/media/$topdir.mp4",
10607: "$topdir/media/FirstFrame.png",
10608: "$topdir/media/player.swf",
10609: "$topdir/media/swfobject.js",
10610: "$topdir/media/expressInstall.swf");
10611: my @diffs = &compare_arrays(\@paths,\@camtasia);
10612: if (@diffs == 0) {
10613: $is_camtasia = 1;
10614: }
10615: }
10616: my $output;
10617: if ($is_camtasia) {
10618: $output = <<"ENDCAM";
10619: <script type="text/javascript" language="Javascript">
10620: // <![CDATA[
10621:
10622: function camtasiaToggle() {
10623: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
10624: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
10625: if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
10626:
10627: document.getElementById('camtasia_titles').style.display='block';
10628: } else {
10629: document.getElementById('camtasia_titles').style.display='none';
10630: }
10631: }
10632: }
10633: return;
10634: }
10635:
10636: // ]]>
10637: </script>
10638: <p>$lt{'camt'}</p>
10639: ENDCAM
1.1065 raeburn 10640: } else {
1.1067 raeburn 10641: $output = '<p>'.$lt{'this'};
10642: if ($info eq '') {
10643: $output .= ' '.$lt{'youm'}.'</p>'."\n";
10644: } else {
10645: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
10646: '<div><pre>'.$info.'</pre></div>';
10647: }
1.1065 raeburn 10648: }
1.1067 raeburn 10649: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 10650: my $duplicates;
10651: my $num = 0;
10652: if (ref($dirlist) eq 'ARRAY') {
10653: foreach my $item (@{$dirlist}) {
10654: if (ref($item) eq 'ARRAY') {
10655: if (exists($toplevel{$item->[0]})) {
10656: $duplicates .=
10657: &start_data_table_row().
10658: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
10659: 'value="0" checked="checked" />'.&mt('No').'</label>'.
10660: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
10661: 'value="1" />'.&mt('Yes').'</label>'.
10662: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
10663: '<td>'.$item->[0].'</td>';
10664: if ($item->[2]) {
10665: $duplicates .= '<td>'.&mt('Directory').'</td>';
10666: } else {
10667: $duplicates .= '<td>'.&mt('File').'</td>';
10668: }
10669: $duplicates .= '<td>'.$item->[3].'</td>'.
10670: '<td>'.
10671: &Apache::lonlocal::locallocaltime($item->[4]).
10672: '</td>'.
10673: &end_data_table_row();
10674: $num ++;
10675: }
10676: }
10677: }
10678: }
10679: my $itemcount;
10680: if (@paths > 0) {
10681: $itemcount = scalar(@paths);
10682: } else {
10683: $itemcount = 1;
10684: }
1.1067 raeburn 10685: if ($is_camtasia) {
10686: $output .= $lt{'auto'}.'<br />'.
10687: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
10688: '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
10689: $lt{'yes'}.'</label> <label>'.
10690: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
10691: $lt{'no'}.'</label></span><br />'.
10692: '<div id="camtasia_titles" style="display:block">'.
10693: &Apache::lonhtmlcommon::start_pick_box().
10694: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
10695: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
10696: &Apache::lonhtmlcommon::row_closure().
10697: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
10698: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
10699: &Apache::lonhtmlcommon::row_closure(1).
10700: &Apache::lonhtmlcommon::end_pick_box().
10701: '</div>';
10702: }
1.1065 raeburn 10703: $output .=
10704: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 10705: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
10706: "\n";
1.1065 raeburn 10707: if ($duplicates ne '') {
10708: $output .= '<p><span class="LC_warning">'.
10709: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
10710: &start_data_table().
10711: &start_data_table_header_row().
10712: '<th>'.&mt('Overwrite?').'</th>'.
10713: '<th>'.&mt('Name').'</th>'.
10714: '<th>'.&mt('Type').'</th>'.
10715: '<th>'.&mt('Size').'</th>'.
10716: '<th>'.&mt('Last modified').'</th>'.
10717: &end_data_table_header_row().
10718: $duplicates.
10719: &end_data_table().
10720: '</p>';
10721: }
1.1067 raeburn 10722: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 10723: if (ref($hiddenelements) eq 'HASH') {
10724: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
10725: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
10726: }
10727: }
10728: $output .= <<"END";
1.1067 raeburn 10729: <br />
1.1053 raeburn 10730: <input type="submit" name="decompress" value="$lt{'extr'}" />
10731: </form>
10732: $noextract
10733: END
10734: return $output;
10735: }
10736:
1.1065 raeburn 10737: sub decompression_utility {
10738: my ($program) = @_;
10739: my @utilities = ('tar','gunzip','bunzip2','unzip');
10740: my $location;
10741: if (grep(/^\Q$program\E$/,@utilities)) {
10742: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
10743: '/usr/sbin/') {
10744: if (-x $dir.$program) {
10745: $location = $dir.$program;
10746: last;
10747: }
10748: }
10749: }
10750: return $location;
10751: }
10752:
10753: sub list_archive_contents {
10754: my ($file,$pathsref) = @_;
10755: my (@cmd,$output);
10756: my $needsregexp;
10757: if ($file =~ /\.zip$/) {
10758: @cmd = (&decompression_utility('unzip'),"-l");
10759: $needsregexp = 1;
10760: } elsif (($file =~ m/\.tar\.gz$/) ||
10761: ($file =~ /\.tgz$/)) {
10762: @cmd = (&decompression_utility('tar'),"-ztf");
10763: } elsif ($file =~ /\.tar\.bz2$/) {
10764: @cmd = (&decompression_utility('tar'),"-jtf");
10765: } elsif ($file =~ m|\.tar$|) {
10766: @cmd = (&decompression_utility('tar'),"-tf");
10767: }
10768: if (@cmd) {
10769: undef($!);
10770: undef($@);
10771: if (open(my $fh,"-|", @cmd, $file)) {
10772: while (my $line = <$fh>) {
10773: $output .= $line;
10774: chomp($line);
10775: my $item;
10776: if ($needsregexp) {
10777: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
10778: } else {
10779: $item = $line;
10780: }
10781: if ($item ne '') {
10782: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
10783: push(@{$pathsref},$item);
10784: }
10785: }
10786: }
10787: close($fh);
10788: }
10789: }
10790: return $output;
10791: }
10792:
1.1053 raeburn 10793: sub decompress_uploaded_file {
10794: my ($file,$dir) = @_;
10795: &Apache::lonnet::appenv({'cgi.file' => $file});
10796: &Apache::lonnet::appenv({'cgi.dir' => $dir});
10797: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
10798: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
10799: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
10800: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
10801: my $decompressed = $env{'cgi.decompressed'};
10802: &Apache::lonnet::delenv('cgi.file');
10803: &Apache::lonnet::delenv('cgi.dir');
10804: &Apache::lonnet::delenv('cgi.decompressed');
10805: return ($decompressed,$result);
10806: }
10807:
1.1055 raeburn 10808: sub process_decompression {
10809: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
10810: my ($dir,$error,$warning,$output);
10811: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
10812: $error = &mt('File name not a supported archive file type.').
10813: '<br />'.&mt('File name should end with one of: [_1].',
10814: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
10815: } else {
10816: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
10817: if ($docuhome eq 'no_host') {
10818: $error = &mt('Could not determine home server for course.');
10819: } else {
10820: my @ids=&Apache::lonnet::current_machine_ids();
10821: my $currdir = "$dir_root/$destination";
10822: if (grep(/^\Q$docuhome\E$/,@ids)) {
10823: $dir = &LONCAPA::propath($docudom,$docuname).
10824: "$dir_root/$destination";
10825: } else {
10826: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
10827: "$dir_root/$docudom/$docuname/$destination";
10828: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
10829: $error = &mt('Archive file not found.');
10830: }
10831: }
1.1065 raeburn 10832: my (@to_overwrite,@to_skip);
10833: if ($env{'form.archive_overwrite_total'} > 0) {
10834: my $total = $env{'form.archive_overwrite_total'};
10835: for (my $i=0; $i<$total; $i++) {
10836: if ($env{'form.archive_overwrite_'.$i} == 1) {
10837: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
10838: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
10839: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
10840: }
10841: }
10842: }
10843: my $numskip = scalar(@to_skip);
10844: if (($numskip > 0) &&
10845: ($numskip == $env{'form.archive_itemcount'})) {
10846: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
10847: } elsif ($dir eq '') {
1.1055 raeburn 10848: $error = &mt('Directory containing archive file unavailable.');
10849: } elsif (!$error) {
1.1065 raeburn 10850: my ($decompressed,$display);
10851: if ($numskip > 0) {
10852: my $tempdir = time.'_'.$$.int(rand(10000));
10853: mkdir("$dir/$tempdir",0755);
10854: system("mv $dir/$file $dir/$tempdir/$file");
10855: ($decompressed,$display) =
10856: &decompress_uploaded_file($file,"$dir/$tempdir");
10857: foreach my $item (@to_skip) {
10858: if (($item ne '') && ($item !~ /\.\./)) {
10859: if (-f "$dir/$tempdir/$item") {
10860: unlink("$dir/$tempdir/$item");
10861: } elsif (-d "$dir/$tempdir/$item") {
10862: system("rm -rf $dir/$tempdir/$item");
10863: }
10864: }
10865: }
10866: system("mv $dir/$tempdir/* $dir");
10867: rmdir("$dir/$tempdir");
10868: } else {
10869: ($decompressed,$display) =
10870: &decompress_uploaded_file($file,$dir);
10871: }
1.1055 raeburn 10872: if ($decompressed eq 'ok') {
1.1065 raeburn 10873: $output = '<p class="LC_info">'.
10874: &mt('Files extracted successfully from archive.').
10875: '</p>'."\n";
1.1055 raeburn 10876: my ($warning,$result,@contents);
10877: my ($newdirlistref,$newlisterror) =
10878: &Apache::lonnet::dirlist($currdir,$docudom,
10879: $docuname,1);
10880: my (%is_dir,%changes,@newitems);
10881: my $dirptr = 16384;
1.1065 raeburn 10882: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 10883: foreach my $dir_line (@{$newdirlistref}) {
10884: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 10885: unless (($item =~ /^\.+$/) || ($item eq $file) ||
10886: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 10887: push(@newitems,$item);
10888: if ($dirptr&$testdir) {
10889: $is_dir{$item} = 1;
10890: }
10891: $changes{$item} = 1;
10892: }
10893: }
10894: }
10895: if (keys(%changes) > 0) {
10896: foreach my $item (sort(@newitems)) {
10897: if ($changes{$item}) {
10898: push(@contents,$item);
10899: }
10900: }
10901: }
10902: if (@contents > 0) {
1.1067 raeburn 10903: my $wantform;
10904: unless ($env{'form.autoextract_camtasia'}) {
10905: $wantform = 1;
10906: }
1.1056 raeburn 10907: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 10908: my ($count,$datatable) = &get_extracted($docudom,$docuname,
10909: $currdir,\%is_dir,
10910: \%children,\%parent,
1.1056 raeburn 10911: \@contents,\%dirorder,
10912: \%titles,$wantform);
1.1055 raeburn 10913: if ($datatable ne '') {
10914: $output .= &archive_options_form('decompressed',$datatable,
10915: $count,$hiddenelem);
1.1065 raeburn 10916: my $startcount = 6;
1.1055 raeburn 10917: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 10918: \%titles,\%children);
1.1055 raeburn 10919: }
1.1067 raeburn 10920: if ($env{'form.autoextract_camtasia'}) {
10921: my %displayed;
10922: my $total = 1;
10923: $env{'form.archive_directory'} = [];
10924: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
10925: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
10926: $path =~ s{/$}{};
10927: my $item;
10928: if ($path ne '') {
10929: $item = "$path/$titles{$i}";
10930: } else {
10931: $item = $titles{$i};
10932: }
10933: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
10934: if ($item eq $contents[0]) {
10935: push(@{$env{'form.archive_directory'}},$i);
10936: $env{'form.archive_'.$i} = 'display';
10937: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
10938: $displayed{'folder'} = $i;
10939: } elsif ($item eq "$contents[0]/index.html") {
10940: $env{'form.archive_'.$i} = 'display';
10941: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
10942: $displayed{'web'} = $i;
10943: } else {
10944: if ($item eq "$contents[0]/media") {
10945: push(@{$env{'form.archive_directory'}},$i);
10946: }
10947: $env{'form.archive_'.$i} = 'dependency';
10948: }
10949: $total ++;
10950: }
10951: for (my $i=1; $i<$total; $i++) {
10952: next if ($i == $displayed{'web'});
10953: next if ($i == $displayed{'folder'});
10954: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
10955: }
10956: $env{'form.phase'} = 'decompress_cleanup';
10957: $env{'form.archivedelete'} = 1;
10958: $env{'form.archive_count'} = $total-1;
10959: $output .=
10960: &process_extracted_files('coursedocs',$docudom,
10961: $docuname,$destination,
10962: $dir_root,$hiddenelem);
10963: }
1.1055 raeburn 10964: } else {
10965: $warning = &mt('No new items extracted from archive file.');
10966: }
10967: } else {
10968: $output = $display;
10969: $error = &mt('An error occurred during extraction from the archive file.');
10970: }
10971: }
10972: }
10973: }
10974: if ($error) {
10975: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
10976: $error.'</p>'."\n";
10977: }
10978: if ($warning) {
10979: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
10980: }
10981: return $output;
10982: }
10983:
10984: sub get_extracted {
1.1056 raeburn 10985: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
10986: $titles,$wantform) = @_;
1.1055 raeburn 10987: my $count = 0;
10988: my $depth = 0;
10989: my $datatable;
1.1056 raeburn 10990: my @hierarchy;
1.1055 raeburn 10991: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 10992: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
10993: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 10994: foreach my $item (@{$contents}) {
10995: $count ++;
1.1056 raeburn 10996: @{$dirorder->{$count}} = @hierarchy;
10997: $titles->{$count} = $item;
1.1055 raeburn 10998: &archive_hierarchy($depth,$count,$parent,$children);
10999: if ($wantform) {
11000: $datatable .= &archive_row($is_dir->{$item},$item,
11001: $currdir,$depth,$count);
11002: }
11003: if ($is_dir->{$item}) {
11004: $depth ++;
1.1056 raeburn 11005: push(@hierarchy,$count);
11006: $parent->{$depth} = $count;
1.1055 raeburn 11007: $datatable .=
11008: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11009: \$depth,\$count,\@hierarchy,$dirorder,
11010: $children,$parent,$titles,$wantform);
1.1055 raeburn 11011: $depth --;
1.1056 raeburn 11012: pop(@hierarchy);
1.1055 raeburn 11013: }
11014: }
11015: return ($count,$datatable);
11016: }
11017:
11018: sub recurse_extracted_archive {
1.1056 raeburn 11019: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11020: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11021: my $result='';
1.1056 raeburn 11022: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11023: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11024: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11025: return $result;
11026: }
11027: my $dirptr = 16384;
11028: my ($newdirlistref,$newlisterror) =
11029: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11030: if (ref($newdirlistref) eq 'ARRAY') {
11031: foreach my $dir_line (@{$newdirlistref}) {
11032: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11033: unless ($item =~ /^\.+$/) {
11034: $$count ++;
1.1056 raeburn 11035: @{$dirorder->{$$count}} = @{$hierarchy};
11036: $titles->{$$count} = $item;
1.1055 raeburn 11037: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11038:
1.1055 raeburn 11039: my $is_dir;
11040: if ($dirptr&$testdir) {
11041: $is_dir = 1;
11042: }
11043: if ($wantform) {
11044: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11045: }
11046: if ($is_dir) {
11047: $$depth ++;
1.1056 raeburn 11048: push(@{$hierarchy},$$count);
11049: $parent->{$$depth} = $$count;
1.1055 raeburn 11050: $result .=
11051: &recurse_extracted_archive("$currdir/$item",$docudom,
11052: $docuname,$depth,$count,
1.1056 raeburn 11053: $hierarchy,$dirorder,$children,
11054: $parent,$titles,$wantform);
1.1055 raeburn 11055: $$depth --;
1.1056 raeburn 11056: pop(@{$hierarchy});
1.1055 raeburn 11057: }
11058: }
11059: }
11060: }
11061: return $result;
11062: }
11063:
11064: sub archive_hierarchy {
11065: my ($depth,$count,$parent,$children) =@_;
11066: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11067: if (exists($parent->{$depth})) {
11068: $children->{$parent->{$depth}} .= $count.':';
11069: }
11070: }
11071: return;
11072: }
11073:
11074: sub archive_row {
11075: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11076: my ($name) = ($item =~ m{([^/]+)$});
11077: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11078: 'display' => 'Add as file',
1.1055 raeburn 11079: 'dependency' => 'Include as dependency',
11080: 'discard' => 'Discard',
11081: );
11082: if ($is_dir) {
1.1059 raeburn 11083: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11084: }
1.1056 raeburn 11085: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11086: my $offset = 0;
1.1055 raeburn 11087: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11088: $offset ++;
1.1065 raeburn 11089: if ($action ne 'display') {
11090: $offset ++;
11091: }
1.1055 raeburn 11092: $output .= '<td><span class="LC_nobreak">'.
11093: '<label><input type="radio" name="archive_'.$count.
11094: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11095: my $text = $choices{$action};
11096: if ($is_dir) {
11097: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11098: if ($action eq 'display') {
1.1059 raeburn 11099: $text = &mt('Add as folder');
1.1055 raeburn 11100: }
1.1056 raeburn 11101: } else {
11102: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11103:
11104: }
11105: $output .= ' /> '.$choices{$action}.'</label></span>';
11106: if ($action eq 'dependency') {
11107: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11108: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11109: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11110: '<option value=""></option>'."\n".
11111: '</select>'."\n".
11112: '</div>';
1.1059 raeburn 11113: } elsif ($action eq 'display') {
11114: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11115: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11116: '</div>';
1.1055 raeburn 11117: }
1.1056 raeburn 11118: $output .= '</td>';
1.1055 raeburn 11119: }
11120: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11121: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11122: for (my $i=0; $i<$depth; $i++) {
11123: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11124: }
11125: if ($is_dir) {
11126: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11127: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11128: } else {
11129: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11130: }
11131: $output .= ' '.$name.'</td>'."\n".
11132: &end_data_table_row();
11133: return $output;
11134: }
11135:
11136: sub archive_options_form {
1.1065 raeburn 11137: my ($form,$display,$count,$hiddenelem) = @_;
11138: my %lt = &Apache::lonlocal::texthash(
11139: perm => 'Permanently remove archive file?',
11140: hows => 'How should each extracted item be incorporated in the course?',
11141: cont => 'Content actions for all',
11142: addf => 'Add as folder/file',
11143: incd => 'Include as dependency for a displayed file',
11144: disc => 'Discard',
11145: no => 'No',
11146: yes => 'Yes',
11147: save => 'Save',
11148: );
11149: my $output = <<"END";
11150: <form name="$form" method="post" action="">
11151: <p><span class="LC_nobreak">$lt{'perm'}
11152: <label>
11153: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11154: </label>
11155:
11156: <label>
11157: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11158: </span>
11159: </p>
11160: <input type="hidden" name="phase" value="decompress_cleanup" />
11161: <br />$lt{'hows'}
11162: <div class="LC_columnSection">
11163: <fieldset>
11164: <legend>$lt{'cont'}</legend>
11165: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11166: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11167: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11168: </fieldset>
11169: </div>
11170: END
11171: return $output.
1.1055 raeburn 11172: &start_data_table()."\n".
1.1065 raeburn 11173: $display."\n".
1.1055 raeburn 11174: &end_data_table()."\n".
11175: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11176: $hiddenelem.
1.1065 raeburn 11177: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11178: '</form>';
11179: }
11180:
11181: sub archive_javascript {
1.1056 raeburn 11182: my ($startcount,$numitems,$titles,$children) = @_;
11183: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11184: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11185: my $scripttag = <<START;
11186: <script type="text/javascript">
11187: // <![CDATA[
11188:
11189: function checkAll(form,prefix) {
11190: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11191: for (var i=0; i < form.elements.length; i++) {
11192: var id = form.elements[i].id;
11193: if ((id != '') && (id != undefined)) {
11194: if (idstr.test(id)) {
11195: if (form.elements[i].type == 'radio') {
11196: form.elements[i].checked = true;
1.1056 raeburn 11197: var nostart = i-$startcount;
1.1059 raeburn 11198: var offset = nostart%7;
11199: var count = (nostart-offset)/7;
1.1056 raeburn 11200: dependencyCheck(form,count,offset);
1.1055 raeburn 11201: }
11202: }
11203: }
11204: }
11205: }
11206:
11207: function propagateCheck(form,count) {
11208: if (count > 0) {
1.1059 raeburn 11209: var startelement = $startcount + ((count-1) * 7);
11210: for (var j=1; j<6; j++) {
11211: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11212: var item = startelement + j;
11213: if (form.elements[item].type == 'radio') {
11214: if (form.elements[item].checked) {
11215: containerCheck(form,count,j);
11216: break;
11217: }
1.1055 raeburn 11218: }
11219: }
11220: }
11221: }
11222: }
11223:
11224: numitems = $numitems
1.1056 raeburn 11225: var titles = new Array(numitems);
11226: var parents = new Array(numitems);
1.1055 raeburn 11227: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11228: parents[i] = new Array;
1.1055 raeburn 11229: }
1.1059 raeburn 11230: var maintitle = '$maintitle';
1.1055 raeburn 11231:
11232: START
11233:
1.1056 raeburn 11234: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11235: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11236: for (my $i=0; $i<@contents; $i ++) {
11237: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11238: }
11239: }
11240:
1.1056 raeburn 11241: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11242: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11243: }
11244:
1.1055 raeburn 11245: $scripttag .= <<END;
11246:
11247: function containerCheck(form,count,offset) {
11248: if (count > 0) {
1.1056 raeburn 11249: dependencyCheck(form,count,offset);
1.1059 raeburn 11250: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11251: form.elements[item].checked = true;
11252: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11253: if (parents[count].length > 0) {
11254: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11255: containerCheck(form,parents[count][j],offset);
11256: }
11257: }
11258: }
11259: }
11260: }
11261:
11262: function dependencyCheck(form,count,offset) {
11263: if (count > 0) {
1.1059 raeburn 11264: var chosen = (offset+$startcount)+7*(count-1);
11265: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11266: var currtype = form.elements[depitem].type;
11267: if (form.elements[chosen].value == 'dependency') {
11268: document.getElementById('arc_depon_'+count).style.display='block';
11269: form.elements[depitem].options.length = 0;
11270: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11271: for (var i=1; i<=numitems; i++) {
11272: if (i == count) {
11273: continue;
11274: }
1.1059 raeburn 11275: var startelement = $startcount + (i-1) * 7;
11276: for (var j=1; j<6; j++) {
11277: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11278: var item = startelement + j;
11279: if (form.elements[item].type == 'radio') {
11280: if (form.elements[item].checked) {
11281: if (form.elements[item].value == 'display') {
11282: var n = form.elements[depitem].options.length;
11283: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11284: }
11285: }
11286: }
11287: }
11288: }
11289: }
11290: } else {
11291: document.getElementById('arc_depon_'+count).style.display='none';
11292: form.elements[depitem].options.length = 0;
11293: form.elements[depitem].options[0] = new Option('Select','',true,true);
11294: }
1.1059 raeburn 11295: titleCheck(form,count,offset);
1.1056 raeburn 11296: }
11297: }
11298:
11299: function propagateSelect(form,count,offset) {
11300: if (count > 0) {
1.1065 raeburn 11301: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11302: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11303: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11304: if (parents[count].length > 0) {
11305: for (var j=0; j<parents[count].length; j++) {
11306: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11307: }
11308: }
11309: }
11310: }
11311: }
1.1056 raeburn 11312:
11313: function containerSelect(form,count,offset,picked) {
11314: if (count > 0) {
1.1065 raeburn 11315: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11316: if (form.elements[item].type == 'radio') {
11317: if (form.elements[item].value == 'dependency') {
11318: if (form.elements[item+1].type == 'select-one') {
11319: for (var i=0; i<form.elements[item+1].options.length; i++) {
11320: if (form.elements[item+1].options[i].value == picked) {
11321: form.elements[item+1].selectedIndex = i;
11322: break;
11323: }
11324: }
11325: }
11326: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11327: if (parents[count].length > 0) {
11328: for (var j=0; j<parents[count].length; j++) {
11329: containerSelect(form,parents[count][j],offset,picked);
11330: }
11331: }
11332: }
11333: }
11334: }
11335: }
11336: }
11337:
1.1059 raeburn 11338: function titleCheck(form,count,offset) {
11339: if (count > 0) {
11340: var chosen = (offset+$startcount)+7*(count-1);
11341: var depitem = $startcount + ((count-1) * 7) + 2;
11342: var currtype = form.elements[depitem].type;
11343: if (form.elements[chosen].value == 'display') {
11344: document.getElementById('arc_title_'+count).style.display='block';
11345: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11346: document.getElementById('archive_title_'+count).value=maintitle;
11347: }
11348: } else {
11349: document.getElementById('arc_title_'+count).style.display='none';
11350: if (currtype == 'text') {
11351: document.getElementById('archive_title_'+count).value='';
11352: }
11353: }
11354: }
11355: return;
11356: }
11357:
1.1055 raeburn 11358: // ]]>
11359: </script>
11360: END
11361: return $scripttag;
11362: }
11363:
11364: sub process_extracted_files {
1.1067 raeburn 11365: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11366: my $numitems = $env{'form.archive_count'};
11367: return unless ($numitems);
11368: my @ids=&Apache::lonnet::current_machine_ids();
11369: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11370: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11371: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11372: if (grep(/^\Q$docuhome\E$/,@ids)) {
11373: $prefix = &LONCAPA::propath($docudom,$docuname);
11374: $pathtocheck = "$dir_root/$destination";
11375: $dir = $dir_root;
11376: $ishome = 1;
11377: } else {
11378: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11379: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11380: $dir = "$dir_root/$docudom/$docuname";
11381: }
11382: my $currdir = "$dir_root/$destination";
11383: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11384: if ($env{'form.folderpath'}) {
11385: my @items = split('&',$env{'form.folderpath'});
11386: $folders{'0'} = $items[-2];
1.1099 raeburn 11387: if ($env{'form.folderpath'} =~ /\:1$/) {
11388: $containers{'0'}='page';
11389: } else {
11390: $containers{'0'}='sequence';
11391: }
1.1055 raeburn 11392: }
11393: my @archdirs = &get_env_multiple('form.archive_directory');
11394: if ($numitems) {
11395: for (my $i=1; $i<=$numitems; $i++) {
11396: my $path = $env{'form.archive_content_'.$i};
11397: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11398: my $item = $1;
11399: $toplevelitems{$item} = $i;
11400: if (grep(/^\Q$i\E$/,@archdirs)) {
11401: $is_dir{$item} = 1;
11402: }
11403: }
11404: }
11405: }
1.1067 raeburn 11406: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11407: if (keys(%toplevelitems) > 0) {
11408: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11409: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11410: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11411: }
1.1066 raeburn 11412: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11413: if ($numitems) {
11414: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11415: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11416: my $path = $env{'form.archive_content_'.$i};
11417: if ($path =~ /^\Q$pathtocheck\E/) {
11418: if ($env{'form.archive_'.$i} eq 'discard') {
11419: if ($prefix ne '' && $path ne '') {
11420: if (-e $prefix.$path) {
1.1066 raeburn 11421: if ((@archdirs > 0) &&
11422: (grep(/^\Q$i\E$/,@archdirs))) {
11423: $todeletedir{$prefix.$path} = 1;
11424: } else {
11425: $todelete{$prefix.$path} = 1;
11426: }
1.1055 raeburn 11427: }
11428: }
11429: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 11430: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 11431: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 11432: $docstitle = $env{'form.archive_title_'.$i};
11433: if ($docstitle eq '') {
11434: $docstitle = $title;
11435: }
1.1055 raeburn 11436: $outer = 0;
1.1056 raeburn 11437: if (ref($dirorder{$i}) eq 'ARRAY') {
11438: if (@{$dirorder{$i}} > 0) {
11439: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 11440: if ($env{'form.archive_'.$item} eq 'display') {
11441: $outer = $item;
11442: last;
11443: }
11444: }
11445: }
11446: }
11447: my ($errtext,$fatal) =
11448: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
11449: '/'.$folders{$outer}.'.'.
11450: $containers{$outer});
11451: next if ($fatal);
11452: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
11453: if ($context eq 'coursedocs') {
1.1056 raeburn 11454: $mapinner{$i} = time;
1.1055 raeburn 11455: $folders{$i} = 'default_'.$mapinner{$i};
11456: $containers{$i} = 'sequence';
11457: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11458: $folders{$i}.'.'.$containers{$i};
11459: my $newidx = &LONCAPA::map::getresidx();
11460: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11461: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11462: push(@LONCAPA::map::order,$newidx);
11463: my ($outtext,$errtext) =
11464: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11465: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 11466: '.'.$containers{$outer},1,1);
1.1056 raeburn 11467: $newseqid{$i} = $newidx;
1.1067 raeburn 11468: unless ($errtext) {
11469: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
11470: }
1.1055 raeburn 11471: }
11472: } else {
11473: if ($context eq 'coursedocs') {
11474: my $newidx=&LONCAPA::map::getresidx();
11475: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
11476: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
11477: $title;
11478: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
11479: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
11480: }
11481: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11482: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
11483: }
11484: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
11485: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 11486: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 11487: unless ($ishome) {
11488: my $fetch = "$newdest{$i}/$title";
11489: $fetch =~ s/^\Q$prefix$dir\E//;
11490: $prompttofetch{$fetch} = 1;
11491: }
1.1055 raeburn 11492: }
11493: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 11494: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 11495: push(@LONCAPA::map::order, $newidx);
11496: my ($outtext,$errtext)=
11497: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
11498: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 11499: '.'.$containers{$outer},1,1);
1.1067 raeburn 11500: unless ($errtext) {
11501: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
11502: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
11503: }
11504: }
1.1055 raeburn 11505: }
11506: }
1.1086 raeburn 11507: }
11508: } else {
11509: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11510: }
11511: }
11512: for (my $i=1; $i<=$numitems; $i++) {
11513: next unless ($env{'form.archive_'.$i} eq 'dependency');
11514: my $path = $env{'form.archive_content_'.$i};
11515: if ($path =~ /^\Q$pathtocheck\E/) {
11516: my ($title) = ($path =~ m{/([^/]+)$});
11517: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
11518: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
11519: if (ref($dirorder{$i}) eq 'ARRAY') {
11520: my ($itemidx,$fullpath,$relpath);
11521: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
11522: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 11523: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 11524: if ($dirorder{$i}->[$j] eq $container) {
11525: $itemidx = $j;
1.1056 raeburn 11526: }
11527: }
1.1086 raeburn 11528: }
11529: if ($itemidx eq '') {
11530: $itemidx = 0;
11531: }
11532: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
11533: if ($mapinner{$referrer{$i}}) {
11534: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
11535: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11536: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11537: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11538: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11539: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11540: if (!-e $fullpath) {
11541: mkdir($fullpath,0755);
1.1056 raeburn 11542: }
11543: }
1.1086 raeburn 11544: } else {
11545: last;
1.1056 raeburn 11546: }
1.1086 raeburn 11547: }
11548: }
11549: } elsif ($newdest{$referrer{$i}}) {
11550: $fullpath = $newdest{$referrer{$i}};
11551: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
11552: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
11553: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
11554: last;
11555: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
11556: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
11557: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
11558: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
11559: if (!-e $fullpath) {
11560: mkdir($fullpath,0755);
1.1056 raeburn 11561: }
11562: }
1.1086 raeburn 11563: } else {
11564: last;
1.1056 raeburn 11565: }
1.1055 raeburn 11566: }
11567: }
1.1086 raeburn 11568: if ($fullpath ne '') {
11569: if (-e "$prefix$path") {
11570: system("mv $prefix$path $fullpath/$title");
11571: }
11572: if (-e "$fullpath/$title") {
11573: my $showpath;
11574: if ($relpath ne '') {
11575: $showpath = "$relpath/$title";
11576: } else {
11577: $showpath = "/$title";
11578: }
11579: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
11580: }
11581: unless ($ishome) {
11582: my $fetch = "$fullpath/$title";
11583: $fetch =~ s/^\Q$prefix$dir\E//;
11584: $prompttofetch{$fetch} = 1;
11585: }
11586: }
1.1055 raeburn 11587: }
1.1086 raeburn 11588: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
11589: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
11590: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 11591: }
11592: } else {
11593: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
11594: }
11595: }
11596: if (keys(%todelete)) {
11597: foreach my $key (keys(%todelete)) {
11598: unlink($key);
1.1066 raeburn 11599: }
11600: }
11601: if (keys(%todeletedir)) {
11602: foreach my $key (keys(%todeletedir)) {
11603: rmdir($key);
11604: }
11605: }
11606: foreach my $dir (sort(keys(%is_dir))) {
11607: if (($pathtocheck ne '') && ($dir ne '')) {
11608: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 11609: }
11610: }
1.1067 raeburn 11611: if ($result ne '') {
11612: $output .= '<ul>'."\n".
11613: $result."\n".
11614: '</ul>';
11615: }
11616: unless ($ishome) {
11617: my $replicationfail;
11618: foreach my $item (keys(%prompttofetch)) {
11619: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
11620: unless ($fetchresult eq 'ok') {
11621: $replicationfail .= '<li>'.$item.'</li>'."\n";
11622: }
11623: }
11624: if ($replicationfail) {
11625: $output .= '<p class="LC_error">'.
11626: &mt('Course home server failed to retrieve:').'<ul>'.
11627: $replicationfail.
11628: '</ul></p>';
11629: }
11630: }
1.1055 raeburn 11631: } else {
11632: $warning = &mt('No items found in archive.');
11633: }
11634: if ($error) {
11635: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11636: $error.'</p>'."\n";
11637: }
11638: if ($warning) {
11639: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11640: }
11641: return $output;
11642: }
11643:
1.1066 raeburn 11644: sub cleanup_empty_dirs {
11645: my ($path) = @_;
11646: if (($path ne '') && (-d $path)) {
11647: if (opendir(my $dirh,$path)) {
11648: my @dircontents = grep(!/^\./,readdir($dirh));
11649: my $numitems = 0;
11650: foreach my $item (@dircontents) {
11651: if (-d "$path/$item") {
1.1111 raeburn 11652: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 11653: if (-e "$path/$item") {
11654: $numitems ++;
11655: }
11656: } else {
11657: $numitems ++;
11658: }
11659: }
11660: if ($numitems == 0) {
11661: rmdir($path);
11662: }
11663: closedir($dirh);
11664: }
11665: }
11666: return;
11667: }
11668:
1.41 ng 11669: =pod
1.45 matthew 11670:
1.1068 raeburn 11671: =item &get_folder_hierarchy()
11672:
11673: Provides hierarchy of names of folders/sub-folders containing the current
11674: item,
11675:
11676: Inputs: 3
11677: - $navmap - navmaps object
11678:
11679: - $map - url for map (either the trigger itself, or map containing
11680: the resource, which is the trigger).
11681:
11682: - $showitem - 1 => show title for map itself; 0 => do not show.
11683:
11684: Outputs: 1 @pathitems - array of folder/subfolder names.
11685:
11686: =cut
11687:
11688: sub get_folder_hierarchy {
11689: my ($navmap,$map,$showitem) = @_;
11690: my @pathitems;
11691: if (ref($navmap)) {
11692: my $mapres = $navmap->getResourceByUrl($map);
11693: if (ref($mapres)) {
11694: my $pcslist = $mapres->map_hierarchy();
11695: if ($pcslist ne '') {
11696: my @pcs = split(/,/,$pcslist);
11697: foreach my $pc (@pcs) {
11698: if ($pc == 1) {
11699: push(@pathitems,&mt('Main Course Documents'));
11700: } else {
11701: my $res = $navmap->getByMapPc($pc);
11702: if (ref($res)) {
11703: my $title = $res->compTitle();
11704: $title =~ s/\W+/_/g;
11705: if ($title ne '') {
11706: push(@pathitems,$title);
11707: }
11708: }
11709: }
11710: }
11711: }
1.1071 raeburn 11712: if ($showitem) {
11713: if ($mapres->{ID} eq '0.0') {
11714: push(@pathitems,&mt('Main Course Documents'));
11715: } else {
11716: my $maptitle = $mapres->compTitle();
11717: $maptitle =~ s/\W+/_/g;
11718: if ($maptitle ne '') {
11719: push(@pathitems,$maptitle);
11720: }
1.1068 raeburn 11721: }
11722: }
11723: }
11724: }
11725: return @pathitems;
11726: }
11727:
11728: =pod
11729:
1.1015 raeburn 11730: =item * &get_turnedin_filepath()
11731:
11732: Determines path in a user's portfolio file for storage of files uploaded
11733: to a specific essayresponse or dropbox item.
11734:
11735: Inputs: 3 required + 1 optional.
11736: $symb is symb for resource, $uname and $udom are for current user (required).
11737: $caller is optional (can be "submission", if routine is called when storing
11738: an upoaded file when "Submit Answer" button was pressed).
11739:
11740: Returns array containing $path and $multiresp.
11741: $path is path in portfolio. $multiresp is 1 if this resource contains more
11742: than one file upload item. Callers of routine should append partid as a
11743: subdirectory to $path in cases where $multiresp is 1.
11744:
11745: Called by: homework/essayresponse.pm and homework/structuretags.pm
11746:
11747: =cut
11748:
11749: sub get_turnedin_filepath {
11750: my ($symb,$uname,$udom,$caller) = @_;
11751: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
11752: my $turnindir;
11753: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
11754: $turnindir = $userhash{'turnindir'};
11755: my ($path,$multiresp);
11756: if ($turnindir eq '') {
11757: if ($caller eq 'submission') {
11758: $turnindir = &mt('turned in');
11759: $turnindir =~ s/\W+/_/g;
11760: my %newhash = (
11761: 'turnindir' => $turnindir,
11762: );
11763: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
11764: }
11765: }
11766: if ($turnindir ne '') {
11767: $path = '/'.$turnindir.'/';
11768: my ($multipart,$turnin,@pathitems);
11769: my $navmap = Apache::lonnavmaps::navmap->new();
11770: if (defined($navmap)) {
11771: my $mapres = $navmap->getResourceByUrl($map);
11772: if (ref($mapres)) {
11773: my $pcslist = $mapres->map_hierarchy();
11774: if ($pcslist ne '') {
11775: foreach my $pc (split(/,/,$pcslist)) {
11776: my $res = $navmap->getByMapPc($pc);
11777: if (ref($res)) {
11778: my $title = $res->compTitle();
11779: $title =~ s/\W+/_/g;
11780: if ($title ne '') {
11781: push(@pathitems,$title);
11782: }
11783: }
11784: }
11785: }
11786: my $maptitle = $mapres->compTitle();
11787: $maptitle =~ s/\W+/_/g;
11788: if ($maptitle ne '') {
11789: push(@pathitems,$maptitle);
11790: }
11791: unless ($env{'request.state'} eq 'construct') {
11792: my $res = $navmap->getBySymb($symb);
11793: if (ref($res)) {
11794: my $partlist = $res->parts();
11795: my $totaluploads = 0;
11796: if (ref($partlist) eq 'ARRAY') {
11797: foreach my $part (@{$partlist}) {
11798: my @types = $res->responseType($part);
11799: my @ids = $res->responseIds($part);
11800: for (my $i=0; $i < scalar(@ids); $i++) {
11801: if ($types[$i] eq 'essay') {
11802: my $partid = $part.'_'.$ids[$i];
11803: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
11804: $totaluploads ++;
11805: }
11806: }
11807: }
11808: }
11809: if ($totaluploads > 1) {
11810: $multiresp = 1;
11811: }
11812: }
11813: }
11814: }
11815: } else {
11816: return;
11817: }
11818: } else {
11819: return;
11820: }
11821: my $restitle=&Apache::lonnet::gettitle($symb);
11822: $restitle =~ s/\W+/_/g;
11823: if ($restitle eq '') {
11824: $restitle = ($resurl =~ m{/[^/]+$});
11825: if ($restitle eq '') {
11826: $restitle = time;
11827: }
11828: }
11829: push(@pathitems,$restitle);
11830: $path .= join('/',@pathitems);
11831: }
11832: return ($path,$multiresp);
11833: }
11834:
11835: =pod
11836:
1.464 albertel 11837: =back
1.41 ng 11838:
1.112 bowersj2 11839: =head1 CSV Upload/Handling functions
1.38 albertel 11840:
1.41 ng 11841: =over 4
11842:
1.648 raeburn 11843: =item * &upfile_store($r)
1.41 ng 11844:
11845: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 11846: needs $env{'form.upfile'}
1.41 ng 11847: returns $datatoken to be put into hidden field
11848:
11849: =cut
1.31 albertel 11850:
11851: sub upfile_store {
11852: my $r=shift;
1.258 albertel 11853: $env{'form.upfile'}=~s/\r/\n/gs;
11854: $env{'form.upfile'}=~s/\f/\n/gs;
11855: $env{'form.upfile'}=~s/\n+/\n/gs;
11856: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 11857:
1.258 albertel 11858: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
11859: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 11860: {
1.158 raeburn 11861: my $datafile = $r->dir_config('lonDaemons').
11862: '/tmp/'.$datatoken.'.tmp';
11863: if ( open(my $fh,">$datafile") ) {
1.258 albertel 11864: print $fh $env{'form.upfile'};
1.158 raeburn 11865: close($fh);
11866: }
1.31 albertel 11867: }
11868: return $datatoken;
11869: }
11870:
1.56 matthew 11871: =pod
11872:
1.648 raeburn 11873: =item * &load_tmp_file($r)
1.41 ng 11874:
11875: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 11876: needs $env{'form.datatoken'},
11877: sets $env{'form.upfile'} to the contents of the file
1.41 ng 11878:
11879: =cut
1.31 albertel 11880:
11881: sub load_tmp_file {
11882: my $r=shift;
11883: my @studentdata=();
11884: {
1.158 raeburn 11885: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 11886: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 11887: if ( open(my $fh,"<$studentfile") ) {
11888: @studentdata=<$fh>;
11889: close($fh);
11890: }
1.31 albertel 11891: }
1.258 albertel 11892: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 11893: }
11894:
1.56 matthew 11895: =pod
11896:
1.648 raeburn 11897: =item * &upfile_record_sep()
1.41 ng 11898:
11899: Separate uploaded file into records
11900: returns array of records,
1.258 albertel 11901: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 11902:
11903: =cut
1.31 albertel 11904:
11905: sub upfile_record_sep {
1.258 albertel 11906: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 11907: } else {
1.248 albertel 11908: my @records;
1.258 albertel 11909: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 11910: if ($line=~/^\s*$/) { next; }
11911: push(@records,$line);
11912: }
11913: return @records;
1.31 albertel 11914: }
11915: }
11916:
1.56 matthew 11917: =pod
11918:
1.648 raeburn 11919: =item * &record_sep($record)
1.41 ng 11920:
1.258 albertel 11921: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 11922:
11923: =cut
11924:
1.263 www 11925: sub takeleft {
11926: my $index=shift;
11927: return substr('0000'.$index,-4,4);
11928: }
11929:
1.31 albertel 11930: sub record_sep {
11931: my $record=shift;
11932: my %components=();
1.258 albertel 11933: if ($env{'form.upfiletype'} eq 'xml') {
11934: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 11935: my $i=0;
1.356 albertel 11936: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 11937: $field=~s/^(\"|\')//;
11938: $field=~s/(\"|\')$//;
1.263 www 11939: $components{&takeleft($i)}=$field;
1.31 albertel 11940: $i++;
11941: }
1.258 albertel 11942: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 11943: my $i=0;
1.356 albertel 11944: foreach my $field (split(/\t/,$record)) {
1.31 albertel 11945: $field=~s/^(\"|\')//;
11946: $field=~s/(\"|\')$//;
1.263 www 11947: $components{&takeleft($i)}=$field;
1.31 albertel 11948: $i++;
11949: }
11950: } else {
1.561 www 11951: my $separator=',';
1.480 banghart 11952: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 11953: $separator=';';
1.480 banghart 11954: }
1.31 albertel 11955: my $i=0;
1.561 www 11956: # the character we are looking for to indicate the end of a quote or a record
11957: my $looking_for=$separator;
11958: # do not add the characters to the fields
11959: my $ignore=0;
11960: # we just encountered a separator (or the beginning of the record)
11961: my $just_found_separator=1;
11962: # store the field we are working on here
11963: my $field='';
11964: # work our way through all characters in record
11965: foreach my $character ($record=~/(.)/g) {
11966: if ($character eq $looking_for) {
11967: if ($character ne $separator) {
11968: # Found the end of a quote, again looking for separator
11969: $looking_for=$separator;
11970: $ignore=1;
11971: } else {
11972: # Found a separator, store away what we got
11973: $components{&takeleft($i)}=$field;
11974: $i++;
11975: $just_found_separator=1;
11976: $ignore=0;
11977: $field='';
11978: }
11979: next;
11980: }
11981: # single or double quotation marks after a separator indicate beginning of a quote
11982: # we are now looking for the end of the quote and need to ignore separators
11983: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
11984: $looking_for=$character;
11985: next;
11986: }
11987: # ignore would be true after we reached the end of a quote
11988: if ($ignore) { next; }
11989: if (($just_found_separator) && ($character=~/\s/)) { next; }
11990: $field.=$character;
11991: $just_found_separator=0;
1.31 albertel 11992: }
1.561 www 11993: # catch the very last entry, since we never encountered the separator
11994: $components{&takeleft($i)}=$field;
1.31 albertel 11995: }
11996: return %components;
11997: }
11998:
1.144 matthew 11999: ######################################################
12000: ######################################################
12001:
1.56 matthew 12002: =pod
12003:
1.648 raeburn 12004: =item * &upfile_select_html()
1.41 ng 12005:
1.144 matthew 12006: Return HTML code to select a file from the users machine and specify
12007: the file type.
1.41 ng 12008:
12009: =cut
12010:
1.144 matthew 12011: ######################################################
12012: ######################################################
1.31 albertel 12013: sub upfile_select_html {
1.144 matthew 12014: my %Types = (
12015: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12016: semisv => &mt('Semicolon separated values'),
1.144 matthew 12017: space => &mt('Space separated'),
12018: tab => &mt('Tabulator separated'),
12019: # xml => &mt('HTML/XML'),
12020: );
12021: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12022: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12023: foreach my $type (sort(keys(%Types))) {
12024: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12025: }
12026: $Str .= "</select>\n";
12027: return $Str;
1.31 albertel 12028: }
12029:
1.301 albertel 12030: sub get_samples {
12031: my ($records,$toget) = @_;
12032: my @samples=({});
12033: my $got=0;
12034: foreach my $rec (@$records) {
12035: my %temp = &record_sep($rec);
12036: if (! grep(/\S/, values(%temp))) { next; }
12037: if (%temp) {
12038: $samples[$got]=\%temp;
12039: $got++;
12040: if ($got == $toget) { last; }
12041: }
12042: }
12043: return \@samples;
12044: }
12045:
1.144 matthew 12046: ######################################################
12047: ######################################################
12048:
1.56 matthew 12049: =pod
12050:
1.648 raeburn 12051: =item * &csv_print_samples($r,$records)
1.41 ng 12052:
12053: Prints a table of sample values from each column uploaded $r is an
12054: Apache Request ref, $records is an arrayref from
12055: &Apache::loncommon::upfile_record_sep
12056:
12057: =cut
12058:
1.144 matthew 12059: ######################################################
12060: ######################################################
1.31 albertel 12061: sub csv_print_samples {
12062: my ($r,$records) = @_;
1.662 bisitz 12063: my $samples = &get_samples($records,5);
1.301 albertel 12064:
1.594 raeburn 12065: $r->print(&mt('Samples').'<br />'.&start_data_table().
12066: &start_data_table_header_row());
1.356 albertel 12067: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12068: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12069: $r->print(&end_data_table_header_row());
1.301 albertel 12070: foreach my $hash (@$samples) {
1.594 raeburn 12071: $r->print(&start_data_table_row());
1.356 albertel 12072: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12073: $r->print('<td>');
1.356 albertel 12074: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12075: $r->print('</td>');
12076: }
1.594 raeburn 12077: $r->print(&end_data_table_row());
1.31 albertel 12078: }
1.594 raeburn 12079: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12080: }
12081:
1.144 matthew 12082: ######################################################
12083: ######################################################
12084:
1.56 matthew 12085: =pod
12086:
1.648 raeburn 12087: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12088:
12089: Prints a table to create associations between values and table columns.
1.144 matthew 12090:
1.41 ng 12091: $r is an Apache Request ref,
12092: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12093: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12094:
12095: =cut
12096:
1.144 matthew 12097: ######################################################
12098: ######################################################
1.31 albertel 12099: sub csv_print_select_table {
12100: my ($r,$records,$d) = @_;
1.301 albertel 12101: my $i=0;
12102: my $samples = &get_samples($records,1);
1.144 matthew 12103: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12104: &start_data_table().&start_data_table_header_row().
1.144 matthew 12105: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12106: '<th>'.&mt('Column').'</th>'.
12107: &end_data_table_header_row()."\n");
1.356 albertel 12108: foreach my $array_ref (@$d) {
12109: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12110: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12111:
1.875 bisitz 12112: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12113: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12114: $r->print('<option value="none"></option>');
1.356 albertel 12115: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12116: $r->print('<option value="'.$sample.'"'.
12117: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12118: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12119: }
1.594 raeburn 12120: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12121: $i++;
12122: }
1.594 raeburn 12123: $r->print(&end_data_table());
1.31 albertel 12124: $i--;
12125: return $i;
12126: }
1.56 matthew 12127:
1.144 matthew 12128: ######################################################
12129: ######################################################
12130:
1.56 matthew 12131: =pod
1.31 albertel 12132:
1.648 raeburn 12133: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12134:
12135: Prints a table of sample values from the upload and can make associate samples to internal names.
12136:
12137: $r is an Apache Request ref,
12138: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12139: $d is an array of 2 element arrays (internal name, displayed name)
12140:
12141: =cut
12142:
1.144 matthew 12143: ######################################################
12144: ######################################################
1.31 albertel 12145: sub csv_samples_select_table {
12146: my ($r,$records,$d) = @_;
12147: my $i=0;
1.144 matthew 12148: #
1.662 bisitz 12149: my $max_samples = 5;
12150: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12151: $r->print(&start_data_table().
12152: &start_data_table_header_row().'<th>'.
12153: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12154: &end_data_table_header_row());
1.301 albertel 12155:
12156: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12157: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12158: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12159: foreach my $option (@$d) {
12160: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12161: $r->print('<option value="'.$value.'"'.
1.253 albertel 12162: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12163: $display.'</option>');
1.31 albertel 12164: }
12165: $r->print('</select></td><td>');
1.662 bisitz 12166: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12167: if (defined($samples->[$line]{$key})) {
12168: $r->print($samples->[$line]{$key}."<br />\n");
12169: }
12170: }
1.594 raeburn 12171: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12172: $i++;
12173: }
1.594 raeburn 12174: $r->print(&end_data_table());
1.31 albertel 12175: $i--;
12176: return($i);
1.115 matthew 12177: }
12178:
1.144 matthew 12179: ######################################################
12180: ######################################################
12181:
1.115 matthew 12182: =pod
12183:
1.648 raeburn 12184: =item * &clean_excel_name($name)
1.115 matthew 12185:
12186: Returns a replacement for $name which does not contain any illegal characters.
12187:
12188: =cut
12189:
1.144 matthew 12190: ######################################################
12191: ######################################################
1.115 matthew 12192: sub clean_excel_name {
12193: my ($name) = @_;
12194: $name =~ s/[:\*\?\/\\]//g;
12195: if (length($name) > 31) {
12196: $name = substr($name,0,31);
12197: }
12198: return $name;
1.25 albertel 12199: }
1.84 albertel 12200:
1.85 albertel 12201: =pod
12202:
1.648 raeburn 12203: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12204:
12205: Returns either 1 or undef
12206:
12207: 1 if the part is to be hidden, undef if it is to be shown
12208:
12209: Arguments are:
12210:
12211: $id the id of the part to be checked
12212: $symb, optional the symb of the resource to check
12213: $udom, optional the domain of the user to check for
12214: $uname, optional the username of the user to check for
12215:
12216: =cut
1.84 albertel 12217:
12218: sub check_if_partid_hidden {
12219: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12220: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12221: $symb,$udom,$uname);
1.141 albertel 12222: my $truth=1;
12223: #if the string starts with !, then the list is the list to show not hide
12224: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12225: my @hiddenlist=split(/,/,$hiddenparts);
12226: foreach my $checkid (@hiddenlist) {
1.141 albertel 12227: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12228: }
1.141 albertel 12229: return !$truth;
1.84 albertel 12230: }
1.127 matthew 12231:
1.138 matthew 12232:
12233: ############################################################
12234: ############################################################
12235:
12236: =pod
12237:
1.157 matthew 12238: =back
12239:
1.138 matthew 12240: =head1 cgi-bin script and graphing routines
12241:
1.157 matthew 12242: =over 4
12243:
1.648 raeburn 12244: =item * &get_cgi_id()
1.138 matthew 12245:
12246: Inputs: none
12247:
12248: Returns an id which can be used to pass environment variables
12249: to various cgi-bin scripts. These environment variables will
12250: be removed from the users environment after a given time by
12251: the routine &Apache::lonnet::transfer_profile_to_env.
12252:
12253: =cut
12254:
12255: ############################################################
12256: ############################################################
1.152 albertel 12257: my $uniq=0;
1.136 matthew 12258: sub get_cgi_id {
1.154 albertel 12259: $uniq=($uniq+1)%100000;
1.280 albertel 12260: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12261: }
12262:
1.127 matthew 12263: ############################################################
12264: ############################################################
12265:
12266: =pod
12267:
1.648 raeburn 12268: =item * &DrawBarGraph()
1.127 matthew 12269:
1.138 matthew 12270: Facilitates the plotting of data in a (stacked) bar graph.
12271: Puts plot definition data into the users environment in order for
12272: graph.png to plot it. Returns an <img> tag for the plot.
12273: The bars on the plot are labeled '1','2',...,'n'.
12274:
12275: Inputs:
12276:
12277: =over 4
12278:
12279: =item $Title: string, the title of the plot
12280:
12281: =item $xlabel: string, text describing the X-axis of the plot
12282:
12283: =item $ylabel: string, text describing the Y-axis of the plot
12284:
12285: =item $Max: scalar, the maximum Y value to use in the plot
12286: If $Max is < any data point, the graph will not be rendered.
12287:
1.140 matthew 12288: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12289: they are plotted. If undefined, default values will be used.
12290:
1.178 matthew 12291: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12292:
1.138 matthew 12293: =item @Values: An array of array references. Each array reference holds data
12294: to be plotted in a stacked bar chart.
12295:
1.239 matthew 12296: =item If the final element of @Values is a hash reference the key/value
12297: pairs will be added to the graph definition.
12298:
1.138 matthew 12299: =back
12300:
12301: Returns:
12302:
12303: An <img> tag which references graph.png and the appropriate identifying
12304: information for the plot.
12305:
1.127 matthew 12306: =cut
12307:
12308: ############################################################
12309: ############################################################
1.134 matthew 12310: sub DrawBarGraph {
1.178 matthew 12311: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12312: #
12313: if (! defined($colors)) {
12314: $colors = ['#33ff00',
12315: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12316: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12317: ];
12318: }
1.228 matthew 12319: my $extra_settings = {};
12320: if (ref($Values[-1]) eq 'HASH') {
12321: $extra_settings = pop(@Values);
12322: }
1.127 matthew 12323: #
1.136 matthew 12324: my $identifier = &get_cgi_id();
12325: my $id = 'cgi.'.$identifier;
1.129 matthew 12326: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12327: return '';
12328: }
1.225 matthew 12329: #
12330: my @Labels;
12331: if (defined($labels)) {
12332: @Labels = @$labels;
12333: } else {
12334: for (my $i=0;$i<@{$Values[0]};$i++) {
12335: push (@Labels,$i+1);
12336: }
12337: }
12338: #
1.129 matthew 12339: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12340: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12341: my %ValuesHash;
12342: my $NumSets=1;
12343: foreach my $array (@Values) {
12344: next if (! ref($array));
1.136 matthew 12345: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12346: join(',',@$array);
1.129 matthew 12347: }
1.127 matthew 12348: #
1.136 matthew 12349: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12350: if ($NumBars < 3) {
12351: $width = 120+$NumBars*32;
1.220 matthew 12352: $xskip = 1;
1.225 matthew 12353: $bar_width = 30;
12354: } elsif ($NumBars < 5) {
12355: $width = 120+$NumBars*20;
12356: $xskip = 1;
12357: $bar_width = 20;
1.220 matthew 12358: } elsif ($NumBars < 10) {
1.136 matthew 12359: $width = 120+$NumBars*15;
12360: $xskip = 1;
12361: $bar_width = 15;
12362: } elsif ($NumBars <= 25) {
12363: $width = 120+$NumBars*11;
12364: $xskip = 5;
12365: $bar_width = 8;
12366: } elsif ($NumBars <= 50) {
12367: $width = 120+$NumBars*8;
12368: $xskip = 5;
12369: $bar_width = 4;
12370: } else {
12371: $width = 120+$NumBars*8;
12372: $xskip = 5;
12373: $bar_width = 4;
12374: }
12375: #
1.137 matthew 12376: $Max = 1 if ($Max < 1);
12377: if ( int($Max) < $Max ) {
12378: $Max++;
12379: $Max = int($Max);
12380: }
1.127 matthew 12381: $Title = '' if (! defined($Title));
12382: $xlabel = '' if (! defined($xlabel));
12383: $ylabel = '' if (! defined($ylabel));
1.369 www 12384: $ValuesHash{$id.'.title'} = &escape($Title);
12385: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12386: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12387: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12388: $ValuesHash{$id.'.NumBars'} = $NumBars;
12389: $ValuesHash{$id.'.NumSets'} = $NumSets;
12390: $ValuesHash{$id.'.PlotType'} = 'bar';
12391: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12392: $ValuesHash{$id.'.height'} = $height;
12393: $ValuesHash{$id.'.width'} = $width;
12394: $ValuesHash{$id.'.xskip'} = $xskip;
12395: $ValuesHash{$id.'.bar_width'} = $bar_width;
12396: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12397: #
1.228 matthew 12398: # Deal with other parameters
12399: while (my ($key,$value) = each(%$extra_settings)) {
12400: $ValuesHash{$id.'.'.$key} = $value;
12401: }
12402: #
1.646 raeburn 12403: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12404: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12405: }
12406:
12407: ############################################################
12408: ############################################################
12409:
12410: =pod
12411:
1.648 raeburn 12412: =item * &DrawXYGraph()
1.137 matthew 12413:
1.138 matthew 12414: Facilitates the plotting of data in an XY graph.
12415: Puts plot definition data into the users environment in order for
12416: graph.png to plot it. Returns an <img> tag for the plot.
12417:
12418: Inputs:
12419:
12420: =over 4
12421:
12422: =item $Title: string, the title of the plot
12423:
12424: =item $xlabel: string, text describing the X-axis of the plot
12425:
12426: =item $ylabel: string, text describing the Y-axis of the plot
12427:
12428: =item $Max: scalar, the maximum Y value to use in the plot
12429: If $Max is < any data point, the graph will not be rendered.
12430:
12431: =item $colors: Array ref containing the hex color codes for the data to be
12432: plotted in. If undefined, default values will be used.
12433:
12434: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12435:
12436: =item $Ydata: Array ref containing Array refs.
1.185 www 12437: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 12438:
12439: =item %Values: hash indicating or overriding any default values which are
12440: passed to graph.png.
12441: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12442:
12443: =back
12444:
12445: Returns:
12446:
12447: An <img> tag which references graph.png and the appropriate identifying
12448: information for the plot.
12449:
1.137 matthew 12450: =cut
12451:
12452: ############################################################
12453: ############################################################
12454: sub DrawXYGraph {
12455: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
12456: #
12457: # Create the identifier for the graph
12458: my $identifier = &get_cgi_id();
12459: my $id = 'cgi.'.$identifier;
12460: #
12461: $Title = '' if (! defined($Title));
12462: $xlabel = '' if (! defined($xlabel));
12463: $ylabel = '' if (! defined($ylabel));
12464: my %ValuesHash =
12465: (
1.369 www 12466: $id.'.title' => &escape($Title),
12467: $id.'.xlabel' => &escape($xlabel),
12468: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 12469: $id.'.y_max_value'=> $Max,
12470: $id.'.labels' => join(',',@$Xlabels),
12471: $id.'.PlotType' => 'XY',
12472: );
12473: #
12474: if (defined($colors) && ref($colors) eq 'ARRAY') {
12475: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12476: }
12477: #
12478: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
12479: return '';
12480: }
12481: my $NumSets=1;
1.138 matthew 12482: foreach my $array (@{$Ydata}){
1.137 matthew 12483: next if (! ref($array));
12484: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
12485: }
1.138 matthew 12486: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 12487: #
12488: # Deal with other parameters
12489: while (my ($key,$value) = each(%Values)) {
12490: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 12491: }
12492: #
1.646 raeburn 12493: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 12494: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12495: }
12496:
12497: ############################################################
12498: ############################################################
12499:
12500: =pod
12501:
1.648 raeburn 12502: =item * &DrawXYYGraph()
1.138 matthew 12503:
12504: Facilitates the plotting of data in an XY graph with two Y axes.
12505: Puts plot definition data into the users environment in order for
12506: graph.png to plot it. Returns an <img> tag for the plot.
12507:
12508: Inputs:
12509:
12510: =over 4
12511:
12512: =item $Title: string, the title of the plot
12513:
12514: =item $xlabel: string, text describing the X-axis of the plot
12515:
12516: =item $ylabel: string, text describing the Y-axis of the plot
12517:
12518: =item $colors: Array ref containing the hex color codes for the data to be
12519: plotted in. If undefined, default values will be used.
12520:
12521: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
12522:
12523: =item $Ydata1: The first data set
12524:
12525: =item $Min1: The minimum value of the left Y-axis
12526:
12527: =item $Max1: The maximum value of the left Y-axis
12528:
12529: =item $Ydata2: The second data set
12530:
12531: =item $Min2: The minimum value of the right Y-axis
12532:
12533: =item $Max2: The maximum value of the left Y-axis
12534:
12535: =item %Values: hash indicating or overriding any default values which are
12536: passed to graph.png.
12537: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
12538:
12539: =back
12540:
12541: Returns:
12542:
12543: An <img> tag which references graph.png and the appropriate identifying
12544: information for the plot.
1.136 matthew 12545:
12546: =cut
12547:
12548: ############################################################
12549: ############################################################
1.137 matthew 12550: sub DrawXYYGraph {
12551: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
12552: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 12553: #
12554: # Create the identifier for the graph
12555: my $identifier = &get_cgi_id();
12556: my $id = 'cgi.'.$identifier;
12557: #
12558: $Title = '' if (! defined($Title));
12559: $xlabel = '' if (! defined($xlabel));
12560: $ylabel = '' if (! defined($ylabel));
12561: my %ValuesHash =
12562: (
1.369 www 12563: $id.'.title' => &escape($Title),
12564: $id.'.xlabel' => &escape($xlabel),
12565: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 12566: $id.'.labels' => join(',',@$Xlabels),
12567: $id.'.PlotType' => 'XY',
12568: $id.'.NumSets' => 2,
1.137 matthew 12569: $id.'.two_axes' => 1,
12570: $id.'.y1_max_value' => $Max1,
12571: $id.'.y1_min_value' => $Min1,
12572: $id.'.y2_max_value' => $Max2,
12573: $id.'.y2_min_value' => $Min2,
1.136 matthew 12574: );
12575: #
1.137 matthew 12576: if (defined($colors) && ref($colors) eq 'ARRAY') {
12577: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12578: }
12579: #
12580: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
12581: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 12582: return '';
12583: }
12584: my $NumSets=1;
1.137 matthew 12585: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 12586: next if (! ref($array));
12587: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 12588: }
12589: #
12590: # Deal with other parameters
12591: while (my ($key,$value) = each(%Values)) {
12592: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 12593: }
12594: #
1.646 raeburn 12595: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 12596: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 12597: }
12598:
12599: ############################################################
12600: ############################################################
12601:
12602: =pod
12603:
1.157 matthew 12604: =back
12605:
1.139 matthew 12606: =head1 Statistics helper routines?
12607:
12608: Bad place for them but what the hell.
12609:
1.157 matthew 12610: =over 4
12611:
1.648 raeburn 12612: =item * &chartlink()
1.139 matthew 12613:
12614: Returns a link to the chart for a specific student.
12615:
12616: Inputs:
12617:
12618: =over 4
12619:
12620: =item $linktext: The text of the link
12621:
12622: =item $sname: The students username
12623:
12624: =item $sdomain: The students domain
12625:
12626: =back
12627:
1.157 matthew 12628: =back
12629:
1.139 matthew 12630: =cut
12631:
12632: ############################################################
12633: ############################################################
12634: sub chartlink {
12635: my ($linktext, $sname, $sdomain) = @_;
12636: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 12637: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 12638: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 12639: '">'.$linktext.'</a>';
1.153 matthew 12640: }
12641:
12642: #######################################################
12643: #######################################################
12644:
12645: =pod
12646:
12647: =head1 Course Environment Routines
1.157 matthew 12648:
12649: =over 4
1.153 matthew 12650:
1.648 raeburn 12651: =item * &restore_course_settings()
1.153 matthew 12652:
1.648 raeburn 12653: =item * &store_course_settings()
1.153 matthew 12654:
12655: Restores/Store indicated form parameters from the course environment.
12656: Will not overwrite existing values of the form parameters.
12657:
12658: Inputs:
12659: a scalar describing the data (e.g. 'chart', 'problem_analysis')
12660:
12661: a hash ref describing the data to be stored. For example:
12662:
12663: %Save_Parameters = ('Status' => 'scalar',
12664: 'chartoutputmode' => 'scalar',
12665: 'chartoutputdata' => 'scalar',
12666: 'Section' => 'array',
1.373 raeburn 12667: 'Group' => 'array',
1.153 matthew 12668: 'StudentData' => 'array',
12669: 'Maps' => 'array');
12670:
12671: Returns: both routines return nothing
12672:
1.631 raeburn 12673: =back
12674:
1.153 matthew 12675: =cut
12676:
12677: #######################################################
12678: #######################################################
12679: sub store_course_settings {
1.496 albertel 12680: return &store_settings($env{'request.course.id'},@_);
12681: }
12682:
12683: sub store_settings {
1.153 matthew 12684: # save to the environment
12685: # appenv the same items, just to be safe
1.300 albertel 12686: my $udom = $env{'user.domain'};
12687: my $uname = $env{'user.name'};
1.496 albertel 12688: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12689: my %SaveHash;
12690: my %AppHash;
12691: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 12692: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 12693: my $envname = 'environment.'.$basename;
1.258 albertel 12694: if (exists($env{'form.'.$setting})) {
1.153 matthew 12695: # Save this value away
12696: if ($type eq 'scalar' &&
1.258 albertel 12697: (! exists($env{$envname}) ||
12698: $env{$envname} ne $env{'form.'.$setting})) {
12699: $SaveHash{$basename} = $env{'form.'.$setting};
12700: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 12701: } elsif ($type eq 'array') {
12702: my $stored_form;
1.258 albertel 12703: if (ref($env{'form.'.$setting})) {
1.153 matthew 12704: $stored_form = join(',',
12705: map {
1.369 www 12706: &escape($_);
1.258 albertel 12707: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 12708: } else {
12709: $stored_form =
1.369 www 12710: &escape($env{'form.'.$setting});
1.153 matthew 12711: }
12712: # Determine if the array contents are the same.
1.258 albertel 12713: if ($stored_form ne $env{$envname}) {
1.153 matthew 12714: $SaveHash{$basename} = $stored_form;
12715: $AppHash{$envname} = $stored_form;
12716: }
12717: }
12718: }
12719: }
12720: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 12721: $udom,$uname);
1.153 matthew 12722: if ($put_result !~ /^(ok|delayed)/) {
12723: &Apache::lonnet::logthis('unable to save form parameters, '.
12724: 'got error:'.$put_result);
12725: }
12726: # Make sure these settings stick around in this session, too
1.646 raeburn 12727: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 12728: return;
12729: }
12730:
12731: sub restore_course_settings {
1.499 albertel 12732: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 12733: }
12734:
12735: sub restore_settings {
12736: my ($context,$prefix,$Settings) = @_;
1.153 matthew 12737: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 12738: next if (exists($env{'form.'.$setting}));
1.496 albertel 12739: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 12740: '.'.$setting;
1.258 albertel 12741: if (exists($env{$envname})) {
1.153 matthew 12742: if ($type eq 'scalar') {
1.258 albertel 12743: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 12744: } elsif ($type eq 'array') {
1.258 albertel 12745: $env{'form.'.$setting} = [
1.153 matthew 12746: map {
1.369 www 12747: &unescape($_);
1.258 albertel 12748: } split(',',$env{$envname})
1.153 matthew 12749: ];
12750: }
12751: }
12752: }
1.127 matthew 12753: }
12754:
1.618 raeburn 12755: #######################################################
12756: #######################################################
12757:
12758: =pod
12759:
12760: =head1 Domain E-mail Routines
12761:
12762: =over 4
12763:
1.648 raeburn 12764: =item * &build_recipient_list()
1.618 raeburn 12765:
1.884 raeburn 12766: Build recipient lists for five types of e-mail:
1.766 raeburn 12767: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884 raeburn 12768: (d) Help requests, (e) Course requests needing approval, generated by
12769: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
12770: loncoursequeueadmin.pm respectively.
1.618 raeburn 12771:
12772: Inputs:
1.619 raeburn 12773: defmail (scalar - email address of default recipient),
1.618 raeburn 12774: mailing type (scalar - errormail, packagesmail, or helpdeskmail),
1.619 raeburn 12775: defdom (domain for which to retrieve configuration settings),
12776: origmail (scalar - email address of recipient from loncapa.conf,
12777: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 12778:
1.655 raeburn 12779: Returns: comma separated list of addresses to which to send e-mail.
12780:
12781: =back
1.618 raeburn 12782:
12783: =cut
12784:
12785: ############################################################
12786: ############################################################
12787: sub build_recipient_list {
1.619 raeburn 12788: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 12789: my @recipients;
12790: my $otheremails;
12791: my %domconfig =
12792: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
12793: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 12794: if (exists($domconfig{'contacts'}{$mailing})) {
12795: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
12796: my @contacts = ('adminemail','supportemail');
12797: foreach my $item (@contacts) {
12798: if ($domconfig{'contacts'}{$mailing}{$item}) {
12799: my $addr = $domconfig{'contacts'}{$item};
12800: if (!grep(/^\Q$addr\E$/,@recipients)) {
12801: push(@recipients,$addr);
12802: }
1.619 raeburn 12803: }
1.766 raeburn 12804: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 12805: }
12806: }
1.766 raeburn 12807: } elsif ($origmail ne '') {
12808: push(@recipients,$origmail);
1.618 raeburn 12809: }
1.619 raeburn 12810: } elsif ($origmail ne '') {
12811: push(@recipients,$origmail);
1.618 raeburn 12812: }
1.688 raeburn 12813: if (defined($defmail)) {
12814: if ($defmail ne '') {
12815: push(@recipients,$defmail);
12816: }
1.618 raeburn 12817: }
12818: if ($otheremails) {
1.619 raeburn 12819: my @others;
12820: if ($otheremails =~ /,/) {
12821: @others = split(/,/,$otheremails);
1.618 raeburn 12822: } else {
1.619 raeburn 12823: push(@others,$otheremails);
12824: }
12825: foreach my $addr (@others) {
12826: if (!grep(/^\Q$addr\E$/,@recipients)) {
12827: push(@recipients,$addr);
12828: }
1.618 raeburn 12829: }
12830: }
1.619 raeburn 12831: my $recipientlist = join(',',@recipients);
1.618 raeburn 12832: return $recipientlist;
12833: }
12834:
1.127 matthew 12835: ############################################################
12836: ############################################################
1.154 albertel 12837:
1.655 raeburn 12838: =pod
12839:
12840: =head1 Course Catalog Routines
12841:
12842: =over 4
12843:
12844: =item * &gather_categories()
12845:
12846: Converts category definitions - keys of categories hash stored in
12847: coursecategories in configuration.db on the primary library server in a
12848: domain - to an array. Also generates javascript and idx hash used to
12849: generate Domain Coordinator interface for editing Course Categories.
12850:
12851: Inputs:
1.663 raeburn 12852:
1.655 raeburn 12853: categories (reference to hash of category definitions).
1.663 raeburn 12854:
1.655 raeburn 12855: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12856: categories and subcategories).
1.663 raeburn 12857:
1.655 raeburn 12858: idx (reference to hash of counters used in Domain Coordinator interface for
12859: editing Course Categories).
1.663 raeburn 12860:
1.655 raeburn 12861: jsarray (reference to array of categories used to create Javascript arrays for
12862: Domain Coordinator interface for editing Course Categories).
12863:
12864: Returns: nothing
12865:
12866: Side effects: populates cats, idx and jsarray.
12867:
12868: =cut
12869:
12870: sub gather_categories {
12871: my ($categories,$cats,$idx,$jsarray) = @_;
12872: my %counters;
12873: my $num = 0;
12874: foreach my $item (keys(%{$categories})) {
12875: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
12876: if ($container eq '' && $depth == 0) {
12877: $cats->[$depth][$categories->{$item}] = $cat;
12878: } else {
12879: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
12880: }
12881: my ($escitem,$tail) = split(/:/,$item,2);
12882: if ($counters{$tail} eq '') {
12883: $counters{$tail} = $num;
12884: $num ++;
12885: }
12886: if (ref($idx) eq 'HASH') {
12887: $idx->{$item} = $counters{$tail};
12888: }
12889: if (ref($jsarray) eq 'ARRAY') {
12890: push(@{$jsarray->[$counters{$tail}]},$item);
12891: }
12892: }
12893: return;
12894: }
12895:
12896: =pod
12897:
12898: =item * &extract_categories()
12899:
12900: Used to generate breadcrumb trails for course categories.
12901:
12902: Inputs:
1.663 raeburn 12903:
1.655 raeburn 12904: categories (reference to hash of category definitions).
1.663 raeburn 12905:
1.655 raeburn 12906: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12907: categories and subcategories).
1.663 raeburn 12908:
1.655 raeburn 12909: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 12910:
1.655 raeburn 12911: allitems (reference to hash - key is category key
12912: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12913:
1.655 raeburn 12914: idx (reference to hash of counters used in Domain Coordinator interface for
12915: editing Course Categories).
1.663 raeburn 12916:
1.655 raeburn 12917: jsarray (reference to array of categories used to create Javascript arrays for
12918: Domain Coordinator interface for editing Course Categories).
12919:
1.665 raeburn 12920: subcats (reference to hash of arrays containing all subcategories within each
12921: category, -recursive)
12922:
1.655 raeburn 12923: Returns: nothing
12924:
12925: Side effects: populates trails and allitems hash references.
12926:
12927: =cut
12928:
12929: sub extract_categories {
1.665 raeburn 12930: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 12931: if (ref($categories) eq 'HASH') {
12932: &gather_categories($categories,$cats,$idx,$jsarray);
12933: if (ref($cats->[0]) eq 'ARRAY') {
12934: for (my $i=0; $i<@{$cats->[0]}; $i++) {
12935: my $name = $cats->[0][$i];
12936: my $item = &escape($name).'::0';
12937: my $trailstr;
12938: if ($name eq 'instcode') {
12939: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 12940: } elsif ($name eq 'communities') {
12941: $trailstr = &mt('Communities');
1.655 raeburn 12942: } else {
12943: $trailstr = $name;
12944: }
12945: if ($allitems->{$item} eq '') {
12946: push(@{$trails},$trailstr);
12947: $allitems->{$item} = scalar(@{$trails})-1;
12948: }
12949: my @parents = ($name);
12950: if (ref($cats->[1]{$name}) eq 'ARRAY') {
12951: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
12952: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 12953: if (ref($subcats) eq 'HASH') {
12954: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
12955: }
12956: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
12957: }
12958: } else {
12959: if (ref($subcats) eq 'HASH') {
12960: $subcats->{$item} = [];
1.655 raeburn 12961: }
12962: }
12963: }
12964: }
12965: }
12966: return;
12967: }
12968:
12969: =pod
12970:
12971: =item *&recurse_categories()
12972:
12973: Recursively used to generate breadcrumb trails for course categories.
12974:
12975: Inputs:
1.663 raeburn 12976:
1.655 raeburn 12977: cats (reference to array of arrays/hashes which encapsulates hierarchy of
12978: categories and subcategories).
1.663 raeburn 12979:
1.655 raeburn 12980: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 12981:
12982: category (current course category, for which breadcrumb trail is being generated).
12983:
12984: trails (reference to array of breadcrumb trails for each category).
12985:
1.655 raeburn 12986: allitems (reference to hash - key is category key
12987: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 12988:
1.655 raeburn 12989: parents (array containing containers directories for current category,
12990: back to top level).
12991:
12992: Returns: nothing
12993:
12994: Side effects: populates trails and allitems hash references
12995:
12996: =cut
12997:
12998: sub recurse_categories {
1.665 raeburn 12999: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13000: my $shallower = $depth - 1;
13001: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13002: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13003: my $name = $cats->[$depth]{$category}[$k];
13004: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13005: my $trailstr = join(' -> ',(@{$parents},$category));
13006: if ($allitems->{$item} eq '') {
13007: push(@{$trails},$trailstr);
13008: $allitems->{$item} = scalar(@{$trails})-1;
13009: }
13010: my $deeper = $depth+1;
13011: push(@{$parents},$category);
1.665 raeburn 13012: if (ref($subcats) eq 'HASH') {
13013: my $subcat = &escape($name).':'.$category.':'.$depth;
13014: for (my $j=@{$parents}; $j>=0; $j--) {
13015: my $higher;
13016: if ($j > 0) {
13017: $higher = &escape($parents->[$j]).':'.
13018: &escape($parents->[$j-1]).':'.$j;
13019: } else {
13020: $higher = &escape($parents->[$j]).'::'.$j;
13021: }
13022: push(@{$subcats->{$higher}},$subcat);
13023: }
13024: }
13025: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13026: $subcats);
1.655 raeburn 13027: pop(@{$parents});
13028: }
13029: } else {
13030: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13031: my $trailstr = join(' -> ',(@{$parents},$category));
13032: if ($allitems->{$item} eq '') {
13033: push(@{$trails},$trailstr);
13034: $allitems->{$item} = scalar(@{$trails})-1;
13035: }
13036: }
13037: return;
13038: }
13039:
1.663 raeburn 13040: =pod
13041:
13042: =item *&assign_categories_table()
13043:
13044: Create a datatable for display of hierarchical categories in a domain,
13045: with checkboxes to allow a course to be categorized.
13046:
13047: Inputs:
13048:
13049: cathash - reference to hash of categories defined for the domain (from
13050: configuration.db)
13051:
13052: currcat - scalar with an & separated list of categories assigned to a course.
13053:
1.919 raeburn 13054: type - scalar contains course type (Course or Community).
13055:
1.663 raeburn 13056: Returns: $output (markup to be displayed)
13057:
13058: =cut
13059:
13060: sub assign_categories_table {
1.919 raeburn 13061: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13062: my $output;
13063: if (ref($cathash) eq 'HASH') {
13064: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13065: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13066: $maxdepth = scalar(@cats);
13067: if (@cats > 0) {
13068: my $itemcount = 0;
13069: if (ref($cats[0]) eq 'ARRAY') {
13070: my @currcategories;
13071: if ($currcat ne '') {
13072: @currcategories = split('&',$currcat);
13073: }
1.919 raeburn 13074: my $table;
1.663 raeburn 13075: for (my $i=0; $i<@{$cats[0]}; $i++) {
13076: my $parent = $cats[0][$i];
1.919 raeburn 13077: next if ($parent eq 'instcode');
13078: if ($type eq 'Community') {
13079: next unless ($parent eq 'communities');
13080: } else {
13081: next if ($parent eq 'communities');
13082: }
1.663 raeburn 13083: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13084: my $item = &escape($parent).'::0';
13085: my $checked = '';
13086: if (@currcategories > 0) {
13087: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13088: $checked = ' checked="checked"';
1.663 raeburn 13089: }
13090: }
1.919 raeburn 13091: my $parent_title = $parent;
13092: if ($parent eq 'communities') {
13093: $parent_title = &mt('Communities');
13094: }
13095: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13096: '<input type="checkbox" name="usecategory" value="'.
13097: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13098: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13099: my $depth = 1;
13100: push(@path,$parent);
1.919 raeburn 13101: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13102: pop(@path);
1.919 raeburn 13103: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13104: $itemcount ++;
13105: }
1.919 raeburn 13106: if ($itemcount) {
13107: $output = &Apache::loncommon::start_data_table().
13108: $table.
13109: &Apache::loncommon::end_data_table();
13110: }
1.663 raeburn 13111: }
13112: }
13113: }
13114: return $output;
13115: }
13116:
13117: =pod
13118:
13119: =item *&assign_category_rows()
13120:
13121: Create a datatable row for display of nested categories in a domain,
13122: with checkboxes to allow a course to be categorized,called recursively.
13123:
13124: Inputs:
13125:
13126: itemcount - track row number for alternating colors
13127:
13128: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13129: categories and subcategories.
13130:
13131: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13132:
13133: parent - parent of current category item
13134:
13135: path - Array containing all categories back up through the hierarchy from the
13136: current category to the top level.
13137:
13138: currcategories - reference to array of current categories assigned to the course
13139:
13140: Returns: $output (markup to be displayed).
13141:
13142: =cut
13143:
13144: sub assign_category_rows {
13145: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13146: my ($text,$name,$item,$chgstr);
13147: if (ref($cats) eq 'ARRAY') {
13148: my $maxdepth = scalar(@{$cats});
13149: if (ref($cats->[$depth]) eq 'HASH') {
13150: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13151: my $numchildren = @{$cats->[$depth]{$parent}};
13152: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13153: $text .= '<td><table class="LC_datatable">';
13154: for (my $j=0; $j<$numchildren; $j++) {
13155: $name = $cats->[$depth]{$parent}[$j];
13156: $item = &escape($name).':'.&escape($parent).':'.$depth;
13157: my $deeper = $depth+1;
13158: my $checked = '';
13159: if (ref($currcategories) eq 'ARRAY') {
13160: if (@{$currcategories} > 0) {
13161: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13162: $checked = ' checked="checked"';
1.663 raeburn 13163: }
13164: }
13165: }
1.664 raeburn 13166: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13167: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13168: $item.'"'.$checked.' />'.$name.'</label></span>'.
13169: '<input type="hidden" name="catname" value="'.$name.'" />'.
13170: '</td><td>';
1.663 raeburn 13171: if (ref($path) eq 'ARRAY') {
13172: push(@{$path},$name);
13173: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13174: pop(@{$path});
13175: }
13176: $text .= '</td></tr>';
13177: }
13178: $text .= '</table></td>';
13179: }
13180: }
13181: }
13182: return $text;
13183: }
13184:
1.655 raeburn 13185: ############################################################
13186: ############################################################
13187:
13188:
1.443 albertel 13189: sub commit_customrole {
1.664 raeburn 13190: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13191: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13192: ($start?', '.&mt('starting').' '.localtime($start):'').
13193: ($end?', ending '.localtime($end):'').': <b>'.
13194: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13195: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13196: '</b><br />';
13197: return $output;
13198: }
13199:
13200: sub commit_standardrole {
1.1116 ! raeburn 13201: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13202: my ($output,$logmsg,$linefeed);
13203: if ($context eq 'auto') {
13204: $linefeed = "\n";
13205: } else {
13206: $linefeed = "<br />\n";
13207: }
1.443 albertel 13208: if ($three eq 'st') {
1.541 raeburn 13209: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 ! raeburn 13210: $one,$two,$sec,$context,$credits);
1.541 raeburn 13211: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13212: ($result eq 'unknown_course') || ($result eq 'refused')) {
13213: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13214: } else {
1.541 raeburn 13215: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13216: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13217: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13218: if ($context eq 'auto') {
13219: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13220: } else {
13221: $output .= '<b>'.$result.'</b>'.$linefeed.
13222: &mt('Add to classlist').': <b>ok</b>';
13223: }
13224: $output .= $linefeed;
1.443 albertel 13225: }
13226: } else {
13227: $output = &mt('Assigning').' '.$three.' in '.$url.
13228: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13229: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13230: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13231: if ($context eq 'auto') {
13232: $output .= $result.$linefeed;
13233: } else {
13234: $output .= '<b>'.$result.'</b>'.$linefeed;
13235: }
1.443 albertel 13236: }
13237: return $output;
13238: }
13239:
13240: sub commit_studentrole {
1.1116 ! raeburn 13241: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
! 13242: $credits) = @_;
1.626 raeburn 13243: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13244: if ($context eq 'auto') {
13245: $linefeed = "\n";
13246: } else {
13247: $linefeed = '<br />'."\n";
13248: }
1.443 albertel 13249: if (defined($one) && defined($two)) {
13250: my $cid=$one.'_'.$two;
13251: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13252: my $secchange = 0;
13253: my $expire_role_result;
13254: my $modify_section_result;
1.628 raeburn 13255: if ($oldsec ne '-1') {
13256: if ($oldsec ne $sec) {
1.443 albertel 13257: $secchange = 1;
1.628 raeburn 13258: my $now = time;
1.443 albertel 13259: my $uurl='/'.$cid;
13260: $uurl=~s/\_/\//g;
13261: if ($oldsec) {
13262: $uurl.='/'.$oldsec;
13263: }
1.626 raeburn 13264: $oldsecurl = $uurl;
1.628 raeburn 13265: $expire_role_result =
1.652 raeburn 13266: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13267: if ($env{'request.course.sec'} ne '') {
13268: if ($expire_role_result eq 'refused') {
13269: my @roles = ('st');
13270: my @statuses = ('previous');
13271: my @roledoms = ($one);
13272: my $withsec = 1;
13273: my %roleshash =
13274: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13275: \@statuses,\@roles,\@roledoms,$withsec);
13276: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13277: my ($oldstart,$oldend) =
13278: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13279: if ($oldend > 0 && $oldend <= $now) {
13280: $expire_role_result = 'ok';
13281: }
13282: }
13283: }
13284: }
1.443 albertel 13285: $result = $expire_role_result;
13286: }
13287: }
13288: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 ! raeburn 13289: $modify_section_result =
! 13290: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
! 13291: undef,undef,undef,$sec,
! 13292: $end,$start,'','',$cid,
! 13293: '',$context,$credits);
1.443 albertel 13294: if ($modify_section_result =~ /^ok/) {
13295: if ($secchange == 1) {
1.628 raeburn 13296: if ($sec eq '') {
13297: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13298: } else {
13299: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13300: }
1.443 albertel 13301: } elsif ($oldsec eq '-1') {
1.628 raeburn 13302: if ($sec eq '') {
13303: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13304: } else {
13305: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13306: }
1.443 albertel 13307: } else {
1.628 raeburn 13308: if ($sec eq '') {
13309: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13310: } else {
13311: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13312: }
1.443 albertel 13313: }
13314: } else {
1.1115 raeburn 13315: if ($secchange) {
1.628 raeburn 13316: $$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;
13317: } else {
13318: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13319: }
1.443 albertel 13320: }
13321: $result = $modify_section_result;
13322: } elsif ($secchange == 1) {
1.628 raeburn 13323: if ($oldsec eq '') {
1.1103 raeburn 13324: $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
1.628 raeburn 13325: } else {
13326: $$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;
13327: }
1.626 raeburn 13328: if ($expire_role_result eq 'refused') {
13329: my $newsecurl = '/'.$cid;
13330: $newsecurl =~ s/\_/\//g;
13331: if ($sec ne '') {
13332: $newsecurl.='/'.$sec;
13333: }
13334: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13335: if ($sec eq '') {
13336: $$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;
13337: } else {
13338: $$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;
13339: }
13340: }
13341: }
1.443 albertel 13342: }
13343: } else {
1.626 raeburn 13344: $$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 13345: $result = "error: incomplete course id\n";
13346: }
13347: return $result;
13348: }
13349:
1.1108 raeburn 13350: sub show_role_extent {
13351: my ($scope,$context,$role) = @_;
13352: $scope =~ s{^/}{};
13353: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13354: push(@courseroles,'co');
13355: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13356: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13357: $scope =~ s{/}{_};
13358: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13359: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13360: my ($audom,$auname) = split(/\//,$scope);
13361: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13362: &Apache::loncommon::plainname($auname,$audom).'</span>');
13363: } else {
13364: $scope =~ s{/$}{};
13365: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13366: &Apache::lonnet::domain($scope,'description').'</span>');
13367: }
13368: }
13369:
1.443 albertel 13370: ############################################################
13371: ############################################################
13372:
1.566 albertel 13373: sub check_clone {
1.578 raeburn 13374: my ($args,$linefeed) = @_;
1.566 albertel 13375: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13376: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13377: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13378: my $clonemsg;
13379: my $can_clone = 0;
1.944 raeburn 13380: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13381: if ($lctype ne 'community') {
13382: $lctype = 'course';
13383: }
1.566 albertel 13384: if ($clonehome eq 'no_host') {
1.944 raeburn 13385: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13386: $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'});
13387: } else {
13388: $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'});
13389: }
1.566 albertel 13390: } else {
13391: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13392: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13393: if ($clonedesc{'type'} ne 'Community') {
13394: $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'});
13395: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13396: }
13397: }
1.882 raeburn 13398: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13399: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13400: $can_clone = 1;
13401: } else {
13402: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13403: $args->{'clonedomain'},$args->{'clonecourse'});
13404: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 13405: if (grep(/^\*$/,@cloners)) {
13406: $can_clone = 1;
13407: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
13408: $can_clone = 1;
13409: } else {
1.908 raeburn 13410: my $ccrole = 'cc';
1.944 raeburn 13411: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13412: $ccrole = 'co';
13413: }
1.578 raeburn 13414: my %roleshash =
13415: &Apache::lonnet::get_my_roles($args->{'ccuname'},
13416: $args->{'ccdomain'},
1.908 raeburn 13417: 'userroles',['active'],[$ccrole],
1.578 raeburn 13418: [$args->{'clonedomain'}]);
1.908 raeburn 13419: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 13420: $can_clone = 1;
13421: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
13422: $can_clone = 1;
13423: } else {
1.944 raeburn 13424: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13425: $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'});
13426: } else {
13427: $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'});
13428: }
1.578 raeburn 13429: }
1.566 albertel 13430: }
1.578 raeburn 13431: }
1.566 albertel 13432: }
13433: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13434: }
13435:
1.444 albertel 13436: sub construct_course {
1.885 raeburn 13437: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444 albertel 13438: my $outcome;
1.541 raeburn 13439: my $linefeed = '<br />'."\n";
13440: if ($context eq 'auto') {
13441: $linefeed = "\n";
13442: }
1.566 albertel 13443:
13444: #
13445: # Are we cloning?
13446: #
13447: my ($can_clone, $clonemsg, $cloneid, $clonehome);
13448: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 13449: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 13450: if ($context ne 'auto') {
1.578 raeburn 13451: if ($clonemsg ne '') {
13452: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
13453: }
1.566 albertel 13454: }
13455: $outcome .= $clonemsg.$linefeed;
13456:
13457: if (!$can_clone) {
13458: return (0,$outcome);
13459: }
13460: }
13461:
1.444 albertel 13462: #
13463: # Open course
13464: #
13465: my $crstype = lc($args->{'crstype'});
13466: my %cenv=();
13467: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
13468: $args->{'cdescr'},
13469: $args->{'curl'},
13470: $args->{'course_home'},
13471: $args->{'nonstandard'},
13472: $args->{'crscode'},
13473: $args->{'ccuname'}.':'.
13474: $args->{'ccdomain'},
1.882 raeburn 13475: $args->{'crstype'},
1.885 raeburn 13476: $cnum,$context,$category);
1.444 albertel 13477:
13478: # Note: The testing routines depend on this being output; see
13479: # Utils::Course. This needs to at least be output as a comment
13480: # if anyone ever decides to not show this, and Utils::Course::new
13481: # will need to be suitably modified.
1.541 raeburn 13482: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 13483: if ($$courseid =~ /^error:/) {
13484: return (0,$outcome);
13485: }
13486:
1.444 albertel 13487: #
13488: # Check if created correctly
13489: #
1.479 albertel 13490: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 13491: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 13492: if ($crsuhome eq 'no_host') {
13493: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
13494: return (0,$outcome);
13495: }
1.541 raeburn 13496: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 13497:
1.444 albertel 13498: #
1.566 albertel 13499: # Do the cloning
13500: #
13501: if ($can_clone && $cloneid) {
13502: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
13503: if ($context ne 'auto') {
13504: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
13505: }
13506: $outcome .= $clonemsg.$linefeed;
13507: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 13508: # Copy all files
1.637 www 13509: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 13510: # Restore URL
1.566 albertel 13511: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 13512: # Restore title
1.566 albertel 13513: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 13514: # Restore creation date, creator and creation context.
13515: $cenv{'internal.created'}=$oldcenv{'internal.created'};
13516: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
13517: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 13518: # Mark as cloned
1.566 albertel 13519: $cenv{'clonedfrom'}=$cloneid;
1.638 www 13520: # Need to clone grading mode
13521: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
13522: $cenv{'grading'}=$newenv{'grading'};
13523: # Do not clone these environment entries
13524: &Apache::lonnet::del('environment',
13525: ['default_enrollment_start_date',
13526: 'default_enrollment_end_date',
13527: 'question.email',
13528: 'policy.email',
13529: 'comment.email',
13530: 'pch.users.denied',
1.725 raeburn 13531: 'plc.users.denied',
13532: 'hidefromcat',
13533: 'categories'],
1.638 www 13534: $$crsudom,$$crsunum);
1.444 albertel 13535: }
1.566 albertel 13536:
1.444 albertel 13537: #
13538: # Set environment (will override cloned, if existing)
13539: #
13540: my @sections = ();
13541: my @xlists = ();
13542: if ($args->{'crstype'}) {
13543: $cenv{'type'}=$args->{'crstype'};
13544: }
13545: if ($args->{'crsid'}) {
13546: $cenv{'courseid'}=$args->{'crsid'};
13547: }
13548: if ($args->{'crscode'}) {
13549: $cenv{'internal.coursecode'}=$args->{'crscode'};
13550: }
13551: if ($args->{'crsquota'} ne '') {
13552: $cenv{'internal.coursequota'}=$args->{'crsquota'};
13553: } else {
13554: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
13555: }
13556: if ($args->{'ccuname'}) {
13557: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
13558: ':'.$args->{'ccdomain'};
13559: } else {
13560: $cenv{'internal.courseowner'} = $args->{'curruser'};
13561: }
1.1116 ! raeburn 13562: if ($args->{'defaultcredits'}) {
! 13563: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
! 13564: }
1.444 albertel 13565: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
13566: if ($args->{'crssections'}) {
13567: $cenv{'internal.sectionnums'} = '';
13568: if ($args->{'crssections'} =~ m/,/) {
13569: @sections = split/,/,$args->{'crssections'};
13570: } else {
13571: $sections[0] = $args->{'crssections'};
13572: }
13573: if (@sections > 0) {
13574: foreach my $item (@sections) {
13575: my ($sec,$gp) = split/:/,$item;
13576: my $class = $args->{'crscode'}.$sec;
13577: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
13578: $cenv{'internal.sectionnums'} .= $item.',';
13579: unless ($addcheck eq 'ok') {
13580: push @badclasses, $class;
13581: }
13582: }
13583: $cenv{'internal.sectionnums'} =~ s/,$//;
13584: }
13585: }
13586: # do not hide course coordinator from staff listing,
13587: # even if privileged
13588: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13589: # add crosslistings
13590: if ($args->{'crsxlist'}) {
13591: $cenv{'internal.crosslistings'}='';
13592: if ($args->{'crsxlist'} =~ m/,/) {
13593: @xlists = split/,/,$args->{'crsxlist'};
13594: } else {
13595: $xlists[0] = $args->{'crsxlist'};
13596: }
13597: if (@xlists > 0) {
13598: foreach my $item (@xlists) {
13599: my ($xl,$gp) = split/:/,$item;
13600: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
13601: $cenv{'internal.crosslistings'} .= $item.',';
13602: unless ($addcheck eq 'ok') {
13603: push @badclasses, $xl;
13604: }
13605: }
13606: $cenv{'internal.crosslistings'} =~ s/,$//;
13607: }
13608: }
13609: if ($args->{'autoadds'}) {
13610: $cenv{'internal.autoadds'}=$args->{'autoadds'};
13611: }
13612: if ($args->{'autodrops'}) {
13613: $cenv{'internal.autodrops'}=$args->{'autodrops'};
13614: }
13615: # check for notification of enrollment changes
13616: my @notified = ();
13617: if ($args->{'notify_owner'}) {
13618: if ($args->{'ccuname'} ne '') {
13619: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
13620: }
13621: }
13622: if ($args->{'notify_dc'}) {
13623: if ($uname ne '') {
1.630 raeburn 13624: push(@notified,$uname.':'.$udom);
1.444 albertel 13625: }
13626: }
13627: if (@notified > 0) {
13628: my $notifylist;
13629: if (@notified > 1) {
13630: $notifylist = join(',',@notified);
13631: } else {
13632: $notifylist = $notified[0];
13633: }
13634: $cenv{'internal.notifylist'} = $notifylist;
13635: }
13636: if (@badclasses > 0) {
13637: my %lt=&Apache::lonlocal::texthash(
13638: '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',
13639: 'dnhr' => 'does not have rights to access enrollment in these classes',
13640: 'adby' => 'as determined by the policies of your institution on access to official classlists'
13641: );
1.541 raeburn 13642: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
13643: ' ('.$lt{'adby'}.')';
13644: if ($context eq 'auto') {
13645: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 13646: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 13647: foreach my $item (@badclasses) {
13648: if ($context eq 'auto') {
13649: $outcome .= " - $item\n";
13650: } else {
13651: $outcome .= "<li>$item</li>\n";
13652: }
13653: }
13654: if ($context eq 'auto') {
13655: $outcome .= $linefeed;
13656: } else {
1.566 albertel 13657: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 13658: }
13659: }
1.444 albertel 13660: }
13661: if ($args->{'no_end_date'}) {
13662: $args->{'endaccess'} = 0;
13663: }
13664: $cenv{'internal.autostart'}=$args->{'enrollstart'};
13665: $cenv{'internal.autoend'}=$args->{'enrollend'};
13666: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
13667: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
13668: if ($args->{'showphotos'}) {
13669: $cenv{'internal.showphotos'}=$args->{'showphotos'};
13670: }
13671: $cenv{'internal.authtype'} = $args->{'authtype'};
13672: $cenv{'internal.autharg'} = $args->{'autharg'};
13673: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
13674: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 13675: 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');
13676: if ($context eq 'auto') {
13677: $outcome .= $krb_msg;
13678: } else {
1.566 albertel 13679: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 13680: }
13681: $outcome .= $linefeed;
1.444 albertel 13682: }
13683: }
13684: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
13685: if ($args->{'setpolicy'}) {
13686: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13687: }
13688: if ($args->{'setcontent'}) {
13689: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
13690: }
13691: }
13692: if ($args->{'reshome'}) {
13693: $cenv{'reshome'}=$args->{'reshome'}.'/';
13694: $cenv{'reshome'}=~s/\/+$/\//;
13695: }
13696: #
13697: # course has keyed access
13698: #
13699: if ($args->{'setkeys'}) {
13700: $cenv{'keyaccess'}='yes';
13701: }
13702: # if specified, key authority is not course, but user
13703: # only active if keyaccess is yes
13704: if ($args->{'keyauth'}) {
1.487 albertel 13705: my ($user,$domain) = split(':',$args->{'keyauth'});
13706: $user = &LONCAPA::clean_username($user);
13707: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 13708: if ($user ne '' && $domain ne '') {
1.487 albertel 13709: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 13710: }
13711: }
13712:
13713: if ($args->{'disresdis'}) {
13714: $cenv{'pch.roles.denied'}='st';
13715: }
13716: if ($args->{'disablechat'}) {
13717: $cenv{'plc.roles.denied'}='st';
13718: }
13719:
13720: # Record we've not yet viewed the Course Initialization Helper for this
13721: # course
13722: $cenv{'course.helper.not.run'} = 1;
13723: #
13724: # Use new Randomseed
13725: #
13726: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
13727: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
13728: #
13729: # The encryption code and receipt prefix for this course
13730: #
13731: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
13732: $cenv{'internal.encpref'}=100+int(9*rand(99));
13733: #
13734: # By default, use standard grading
13735: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
13736:
1.541 raeburn 13737: $outcome .= $linefeed.&mt('Setting environment').': '.
13738: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13739: #
13740: # Open all assignments
13741: #
13742: if ($args->{'openall'}) {
13743: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
13744: my %storecontent = ($storeunder => time,
13745: $storeunder.'.type' => 'date_start');
13746:
13747: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 13748: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 13749: }
13750: #
13751: # Set first page
13752: #
13753: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
13754: || ($cloneid)) {
1.445 albertel 13755: use LONCAPA::map;
1.444 albertel 13756: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 13757:
13758: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
13759: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
13760:
1.444 albertel 13761: $outcome .= ($fatal?$errtext:'read ok').' - ';
13762: my $title; my $url;
13763: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 13764: $title=&mt('Syllabus');
1.444 albertel 13765: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
13766: } else {
1.963 raeburn 13767: $title=&mt('Table of Contents');
1.444 albertel 13768: $url='/adm/navmaps';
13769: }
1.445 albertel 13770:
13771: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
13772: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
13773:
13774: if ($errtext) { $fatal=2; }
1.541 raeburn 13775: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 13776: }
1.566 albertel 13777:
13778: return (1,$outcome);
1.444 albertel 13779: }
13780:
13781: ############################################################
13782: ############################################################
13783:
1.953 droeschl 13784: #SD
13785: # only Community and Course, or anything else?
1.378 raeburn 13786: sub course_type {
13787: my ($cid) = @_;
13788: if (!defined($cid)) {
13789: $cid = $env{'request.course.id'};
13790: }
1.404 albertel 13791: if (defined($env{'course.'.$cid.'.type'})) {
13792: return $env{'course.'.$cid.'.type'};
1.378 raeburn 13793: } else {
13794: return 'Course';
1.377 raeburn 13795: }
13796: }
1.156 albertel 13797:
1.406 raeburn 13798: sub group_term {
13799: my $crstype = &course_type();
13800: my %names = (
13801: 'Course' => 'group',
1.865 raeburn 13802: 'Community' => 'group',
1.406 raeburn 13803: );
13804: return $names{$crstype};
13805: }
13806:
1.902 raeburn 13807: sub course_types {
13808: my @types = ('official','unofficial','community');
13809: my %typename = (
13810: official => 'Official course',
13811: unofficial => 'Unofficial course',
13812: community => 'Community',
13813: );
13814: return (\@types,\%typename);
13815: }
13816:
1.156 albertel 13817: sub icon {
13818: my ($file)=@_;
1.505 albertel 13819: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 13820: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 13821: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 13822: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
13823: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
13824: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13825: $curfext.".gif") {
13826: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
13827: $curfext.".gif";
13828: }
13829: }
1.249 albertel 13830: return &lonhttpdurl($iconname);
1.154 albertel 13831: }
1.84 albertel 13832:
1.575 albertel 13833: sub lonhttpdurl {
1.692 www 13834: #
13835: # Had been used for "small fry" static images on separate port 8080.
13836: # Modify here if lightweight http functionality desired again.
13837: # Currently eliminated due to increasing firewall issues.
13838: #
1.575 albertel 13839: my ($url)=@_;
1.692 www 13840: return $url;
1.215 albertel 13841: }
13842:
1.213 albertel 13843: sub connection_aborted {
13844: my ($r)=@_;
13845: $r->print(" ");$r->rflush();
13846: my $c = $r->connection;
13847: return $c->aborted();
13848: }
13849:
1.221 foxr 13850: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 13851: # strings as 'strings'.
13852: sub escape_single {
1.221 foxr 13853: my ($input) = @_;
1.223 albertel 13854: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 13855: $input =~ s/\'/\\\'/g; # Esacpe the 's....
13856: return $input;
13857: }
1.223 albertel 13858:
1.222 foxr 13859: # Same as escape_single, but escape's "'s This
13860: # can be used for "strings"
13861: sub escape_double {
13862: my ($input) = @_;
13863: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
13864: $input =~ s/\"/\\\"/g; # Esacpe the "s....
13865: return $input;
13866: }
1.223 albertel 13867:
1.222 foxr 13868: # Escapes the last element of a full URL.
13869: sub escape_url {
13870: my ($url) = @_;
1.238 raeburn 13871: my @urlslices = split(/\//, $url,-1);
1.369 www 13872: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 13873: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 13874: }
1.462 albertel 13875:
1.820 raeburn 13876: sub compare_arrays {
13877: my ($arrayref1,$arrayref2) = @_;
13878: my (@difference,%count);
13879: @difference = ();
13880: %count = ();
13881: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
13882: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
13883: foreach my $element (keys(%count)) {
13884: if ($count{$element} == 1) {
13885: push(@difference,$element);
13886: }
13887: }
13888: }
13889: return @difference;
13890: }
13891:
1.817 bisitz 13892: # -------------------------------------------------------- Initialize user login
1.462 albertel 13893: sub init_user_environment {
1.463 albertel 13894: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 13895: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
13896:
13897: my $public=($username eq 'public' && $domain eq 'public');
13898:
13899: # See if old ID present, if so, remove
13900:
1.1062 raeburn 13901: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 13902: my $now=time;
13903:
13904: if ($public) {
13905: my $max_public=100;
13906: my $oldest;
13907: my $oldest_time=0;
13908: for(my $next=1;$next<=$max_public;$next++) {
13909: if (-e $lonids."/publicuser_$next.id") {
13910: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
13911: if ($mtime<$oldest_time || !$oldest_time) {
13912: $oldest_time=$mtime;
13913: $oldest=$next;
13914: }
13915: } else {
13916: $cookie="publicuser_$next";
13917: last;
13918: }
13919: }
13920: if (!$cookie) { $cookie="publicuser_$oldest"; }
13921: } else {
1.463 albertel 13922: # if this isn't a robot, kill any existing non-robot sessions
13923: if (!$args->{'robot'}) {
13924: opendir(DIR,$lonids);
13925: while ($filename=readdir(DIR)) {
13926: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
13927: unlink($lonids.'/'.$filename);
13928: }
1.462 albertel 13929: }
1.463 albertel 13930: closedir(DIR);
1.462 albertel 13931: }
13932: # Give them a new cookie
1.463 albertel 13933: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 13934: : $now.$$.int(rand(10000)));
1.463 albertel 13935: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 13936:
13937: # Initialize roles
13938:
1.1062 raeburn 13939: ($userroles,$firstaccenv,$timerintenv) =
13940: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 13941: }
13942: # ------------------------------------ Check browser type and MathML capability
13943:
13944: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
13945: $clientunicode,$clientos) = &decode_user_agent($r);
13946:
13947: # ------------------------------------------------------------- Get environment
13948:
13949: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
13950: my ($tmp) = keys(%userenv);
13951: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
13952: } else {
13953: undef(%userenv);
13954: }
13955: if (($userenv{'interface'}) && (!$form->{'interface'})) {
13956: $form->{'interface'}=$userenv{'interface'};
13957: }
13958: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
13959:
13960: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 13961: foreach my $option ('interface','localpath','localres') {
13962: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 13963: }
13964: # --------------------------------------------------------- Write first profile
13965:
13966: {
13967: my %initial_env =
13968: ("user.name" => $username,
13969: "user.domain" => $domain,
13970: "user.home" => $authhost,
13971: "browser.type" => $clientbrowser,
13972: "browser.version" => $clientversion,
13973: "browser.mathml" => $clientmathml,
13974: "browser.unicode" => $clientunicode,
13975: "browser.os" => $clientos,
13976: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
13977: "request.course.fn" => '',
13978: "request.course.uri" => '',
13979: "request.course.sec" => '',
13980: "request.role" => 'cm',
13981: "request.role.adv" => $env{'user.adv'},
13982: "request.host" => $ENV{'REMOTE_ADDR'},);
13983:
13984: if ($form->{'localpath'}) {
13985: $initial_env{"browser.localpath"} = $form->{'localpath'};
13986: $initial_env{"browser.localres"} = $form->{'localres'};
13987: }
13988:
13989: if ($form->{'interface'}) {
13990: $form->{'interface'}=~s/\W//gs;
13991: $initial_env{"browser.interface"} = $form->{'interface'};
13992: $env{'browser.interface'}=$form->{'interface'};
13993: }
13994:
1.981 raeburn 13995: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 13996: my %domdef;
13997: unless ($domain eq 'public') {
13998: %domdef = &Apache::lonnet::get_domain_defaults($domain);
13999: }
1.980 raeburn 14000:
1.1081 raeburn 14001: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14002: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14003: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14004: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14005: }
14006:
1.864 raeburn 14007: foreach my $crstype ('official','unofficial','community') {
1.765 raeburn 14008: $userenv{'canrequest.'.$crstype} =
14009: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14010: 'reload','requestcourses',
14011: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14012: }
14013:
1.1092 raeburn 14014: $userenv{'canrequest.author'} =
14015: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14016: 'reload','requestauthor',
14017: \%userenv,\%domdef,\%is_adv);
14018: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14019: $domain,$username);
14020: my $reqstatus = $reqauthor{'author_status'};
14021: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14022: if (ref($reqauthor{'author'}) eq 'HASH') {
14023: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14024: $reqauthor{'author'}{'timestamp'};
14025: }
14026: }
14027:
1.462 albertel 14028: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14029:
1.462 albertel 14030: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14031: &GDBM_WRCREAT(),0640)) {
14032: &_add_to_env(\%disk_env,\%initial_env);
14033: &_add_to_env(\%disk_env,\%userenv,'environment.');
14034: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14035: if (ref($firstaccenv) eq 'HASH') {
14036: &_add_to_env(\%disk_env,$firstaccenv);
14037: }
14038: if (ref($timerintenv) eq 'HASH') {
14039: &_add_to_env(\%disk_env,$timerintenv);
14040: }
1.463 albertel 14041: if (ref($args->{'extra_env'})) {
14042: &_add_to_env(\%disk_env,$args->{'extra_env'});
14043: }
1.462 albertel 14044: untie(%disk_env);
14045: } else {
1.705 tempelho 14046: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14047: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14048: return 'error: '.$!;
14049: }
14050: }
14051: $env{'request.role'}='cm';
14052: $env{'request.role.adv'}=$env{'user.adv'};
14053: $env{'browser.type'}=$clientbrowser;
14054:
14055: return $cookie;
14056:
14057: }
14058:
14059: sub _add_to_env {
14060: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14061: if (ref($env_data) eq 'HASH') {
14062: while (my ($key,$value) = each(%$env_data)) {
14063: $idf->{$prefix.$key} = $value;
14064: $env{$prefix.$key} = $value;
14065: }
1.462 albertel 14066: }
14067: }
14068:
1.685 tempelho 14069: # --- Get the symbolic name of a problem and the url
14070: sub get_symb {
14071: my ($request,$silent) = @_;
1.726 raeburn 14072: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14073: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14074: if ($symb eq '') {
14075: if (!$silent) {
1.1071 raeburn 14076: if (ref($request)) {
14077: $request->print("Unable to handle ambiguous references:$url:.");
14078: }
1.685 tempelho 14079: return ();
14080: }
14081: }
14082: &Apache::lonenc::check_decrypt(\$symb);
14083: return ($symb);
14084: }
14085:
14086: # --------------------------------------------------------------Get annotation
14087:
14088: sub get_annotation {
14089: my ($symb,$enc) = @_;
14090:
14091: my $key = $symb;
14092: if (!$enc) {
14093: $key =
14094: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14095: }
14096: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14097: return $annotation{$key};
14098: }
14099:
14100: sub clean_symb {
1.731 raeburn 14101: my ($symb,$delete_enc) = @_;
1.685 tempelho 14102:
14103: &Apache::lonenc::check_decrypt(\$symb);
14104: my $enc = $env{'request.enc'};
1.731 raeburn 14105: if ($delete_enc) {
1.730 raeburn 14106: delete($env{'request.enc'});
14107: }
1.685 tempelho 14108:
14109: return ($symb,$enc);
14110: }
1.462 albertel 14111:
1.990 raeburn 14112: sub build_release_hashes {
14113: my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
14114: return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
14115: (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
14116: (ref($randomizetry) eq 'HASH'));
14117: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14118: my ($item,$name,$value) = split(/:/,$key);
14119: if ($item eq 'parameter') {
14120: if (ref($checkparms->{$name}) eq 'ARRAY') {
14121: unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
14122: push(@{$checkparms->{$name}},$value);
14123: }
14124: } else {
14125: push(@{$checkparms->{$name}},$value);
14126: }
14127: } elsif ($item eq 'resourcetag') {
14128: if ($name eq 'responsetype') {
14129: $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
14130: }
14131: } elsif ($item eq 'course') {
14132: if ($name eq 'crstype') {
14133: $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
14134: }
14135: }
14136: }
14137: ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
14138: ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
14139: return;
14140: }
14141:
1.1083 raeburn 14142: sub update_content_constraints {
14143: my ($cdom,$cnum,$chome,$cid) = @_;
14144: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
14145: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
14146: my %checkresponsetypes;
14147: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
14148: my ($item,$name,$value) = split(/:/,$key);
14149: if ($item eq 'resourcetag') {
14150: if ($name eq 'responsetype') {
14151: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
14152: }
14153: }
14154: }
14155: my $navmap = Apache::lonnavmaps::navmap->new();
14156: if (defined($navmap)) {
14157: my %allresponses;
14158: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
14159: my %responses = $res->responseTypes();
14160: foreach my $key (keys(%responses)) {
14161: next unless(exists($checkresponsetypes{$key}));
14162: $allresponses{$key} += $responses{$key};
14163: }
14164: }
14165: foreach my $key (keys(%allresponses)) {
14166: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
14167: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
14168: ($reqdmajor,$reqdminor) = ($major,$minor);
14169: }
14170: }
14171: undef($navmap);
14172: }
14173: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
14174: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
14175: }
14176: return;
14177: }
14178:
1.1110 raeburn 14179: sub allmaps_incourse {
14180: my ($cdom,$cnum,$chome,$cid) = @_;
14181: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
14182: $cid = $env{'request.course.id'};
14183: $cdom = $env{'course.'.$cid.'.domain'};
14184: $cnum = $env{'course.'.$cid.'.num'};
14185: $chome = $env{'course.'.$cid.'.home'};
14186: }
14187: my %allmaps = ();
14188: my $lastchange =
14189: &Apache::lonnet::get_coursechange($cdom,$cnum);
14190: if ($lastchange > $env{'request.course.tied'}) {
14191: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
14192: unless ($ferr) {
14193: &update_content_constraints($cdom,$cnum,$chome,$cid);
14194: }
14195: }
14196: my $navmap = Apache::lonnavmaps::navmap->new();
14197: if (defined($navmap)) {
14198: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
14199: $allmaps{$res->src()} = 1;
14200: }
14201: }
14202: return \%allmaps;
14203: }
14204:
1.1083 raeburn 14205: sub parse_supplemental_title {
14206: my ($title) = @_;
14207:
14208: my ($foldertitle,$renametitle);
14209: if ($title =~ /&&&/) {
14210: $title = &HTML::Entites::decode($title);
14211: }
14212: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
14213: $renametitle=$4;
14214: my ($time,$uname,$udom) = ($1,$2,$3);
14215: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
14216: my $name = &plainname($uname,$udom);
14217: $name = &HTML::Entities::encode($name,'"<>&\'');
14218: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
14219: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
14220: $name.': <br />'.$foldertitle;
14221: }
14222: if (wantarray) {
14223: return ($title,$foldertitle,$renametitle);
14224: }
14225: return $title;
14226: }
14227:
1.1101 raeburn 14228: sub symb_to_docspath {
14229: my ($symb) = @_;
14230: return unless ($symb);
14231: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
14232: if ($resurl=~/\.(sequence|page)$/) {
14233: $mapurl=$resurl;
14234: } elsif ($resurl eq 'adm/navmaps') {
14235: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
14236: }
14237: my $mapresobj;
14238: my $navmap = Apache::lonnavmaps::navmap->new();
14239: if (ref($navmap)) {
14240: $mapresobj = $navmap->getResourceByUrl($mapurl);
14241: }
14242: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
14243: my $type=$2;
14244: my $path;
14245: if (ref($mapresobj)) {
14246: my $pcslist = $mapresobj->map_hierarchy();
14247: if ($pcslist ne '') {
14248: foreach my $pc (split(/,/,$pcslist)) {
14249: next if ($pc <= 1);
14250: my $res = $navmap->getByMapPc($pc);
14251: if (ref($res)) {
14252: my $thisurl = $res->src();
14253: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
14254: my $thistitle = $res->title();
14255: $path .= '&'.
14256: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
14257: &Apache::lonhtmlcommon::entity_encode($thistitle).
14258: ':'.$res->randompick().
14259: ':'.$res->randomout().
14260: ':'.$res->encrypted().
14261: ':'.$res->randomorder().
14262: ':'.$res->is_page();
14263: }
14264: }
14265: }
14266: $path =~ s/^\&//;
14267: my $maptitle = $mapresobj->title();
14268: if ($mapurl eq 'default') {
14269: $maptitle = 'Main Course Documents';
14270: }
14271: $path .= (($path ne '')? '&' : '').
14272: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
14273: &Apache::lonhtmlcommon::entity_encode($maptitle).
14274: ':'.$mapresobj->randompick().
14275: ':'.$mapresobj->randomout().
14276: ':'.$mapresobj->encrypted().
14277: ':'.$mapresobj->randomorder().
14278: ':'.$mapresobj->is_page();
14279: } else {
14280: my $maptitle = &Apache::lonnet::gettitle($mapurl);
14281: my $ispage = (($type eq 'page')? 1 : '');
14282: if ($mapurl eq 'default') {
14283: $maptitle = 'Main Course Documents';
14284: }
14285: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
14286: &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
14287: }
14288: unless ($mapurl eq 'default') {
14289: $path = 'default&'.
14290: &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
14291: ':::::&'.$path;
14292: }
14293: return $path;
14294: }
14295:
1.1094 raeburn 14296: sub captcha_display {
14297: my ($context,$lonhost) = @_;
14298: my ($output,$error);
14299: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 14300: if ($captcha eq 'original') {
1.1094 raeburn 14301: $output = &create_captcha();
14302: unless ($output) {
14303: $error = 'captcha';
14304: }
14305: } elsif ($captcha eq 'recaptcha') {
14306: $output = &create_recaptcha($pubkey);
14307: unless ($output) {
1.1095 raeburn 14308: $error = 'recaptcha';
1.1094 raeburn 14309: }
14310: }
14311: return ($output,$error);
14312: }
14313:
14314: sub captcha_response {
14315: my ($context,$lonhost) = @_;
14316: my ($captcha_chk,$captcha_error);
14317: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 14318: if ($captcha eq 'original') {
1.1094 raeburn 14319: ($captcha_chk,$captcha_error) = &check_captcha();
14320: } elsif ($captcha eq 'recaptcha') {
14321: $captcha_chk = &check_recaptcha($privkey);
14322: } else {
14323: $captcha_chk = 1;
14324: }
14325: return ($captcha_chk,$captcha_error);
14326: }
14327:
14328: sub get_captcha_config {
14329: my ($context,$lonhost) = @_;
1.1095 raeburn 14330: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 14331: my $hostname = &Apache::lonnet::hostname($lonhost);
14332: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
14333: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 14334: if ($context eq 'usercreation') {
14335: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
14336: if (ref($domconfig{$context}) eq 'HASH') {
14337: $hashtocheck = $domconfig{$context}{'cancreate'};
14338: if (ref($hashtocheck) eq 'HASH') {
14339: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
14340: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
14341: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
14342: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
14343: }
14344: if ($privkey && $pubkey) {
14345: $captcha = 'recaptcha';
14346: } else {
14347: $captcha = 'original';
14348: }
14349: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
14350: $captcha = 'original';
14351: }
1.1094 raeburn 14352: }
1.1095 raeburn 14353: } else {
14354: $captcha = 'captcha';
14355: }
14356: } elsif ($context eq 'login') {
14357: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
14358: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
14359: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
14360: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 14361: if ($privkey && $pubkey) {
14362: $captcha = 'recaptcha';
1.1095 raeburn 14363: } else {
14364: $captcha = 'original';
1.1094 raeburn 14365: }
1.1095 raeburn 14366: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
14367: $captcha = 'original';
1.1094 raeburn 14368: }
14369: }
14370: return ($captcha,$pubkey,$privkey);
14371: }
14372:
14373: sub create_captcha {
14374: my %captcha_params = &captcha_settings();
14375: my ($output,$maxtries,$tries) = ('',10,0);
14376: while ($tries < $maxtries) {
14377: $tries ++;
14378: my $captcha = Authen::Captcha->new (
14379: output_folder => $captcha_params{'output_dir'},
14380: data_folder => $captcha_params{'db_dir'},
14381: );
14382: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
14383:
14384: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
14385: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
14386: &mt('Type in the letters/numbers shown below').' '.
14387: '<input type="text" size="5" name="code" value="" /><br />'.
14388: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
14389: last;
14390: }
14391: }
14392: return $output;
14393: }
14394:
14395: sub captcha_settings {
14396: my %captcha_params = (
14397: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
14398: www_output_dir => "/captchaspool",
14399: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
14400: numchars => '5',
14401: );
14402: return %captcha_params;
14403: }
14404:
14405: sub check_captcha {
14406: my ($captcha_chk,$captcha_error);
14407: my $code = $env{'form.code'};
14408: my $md5sum = $env{'form.crypt'};
14409: my %captcha_params = &captcha_settings();
14410: my $captcha = Authen::Captcha->new(
14411: output_folder => $captcha_params{'output_dir'},
14412: data_folder => $captcha_params{'db_dir'},
14413: );
1.1109 raeburn 14414: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 14415: my %captcha_hash = (
14416: 0 => 'Code not checked (file error)',
14417: -1 => 'Failed: code expired',
14418: -2 => 'Failed: invalid code (not in database)',
14419: -3 => 'Failed: invalid code (code does not match crypt)',
14420: );
14421: if ($captcha_chk != 1) {
14422: $captcha_error = $captcha_hash{$captcha_chk}
14423: }
14424: return ($captcha_chk,$captcha_error);
14425: }
14426:
14427: sub create_recaptcha {
14428: my ($pubkey) = @_;
14429: my $captcha = Captcha::reCAPTCHA->new;
14430: return $captcha->get_options_setter({theme => 'white'})."\n".
14431: $captcha->get_html($pubkey).
14432: &mt('If either word is hard to read, [_1] will replace them.',
14433: '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
14434: '<br /><br />';
14435: }
14436:
14437: sub check_recaptcha {
14438: my ($privkey) = @_;
14439: my $captcha_chk;
14440: my $captcha = Captcha::reCAPTCHA->new;
14441: my $captcha_result =
14442: $captcha->check_answer(
14443: $privkey,
14444: $ENV{'REMOTE_ADDR'},
14445: $env{'form.recaptcha_challenge_field'},
14446: $env{'form.recaptcha_response_field'},
14447: );
14448: if ($captcha_result->{is_valid}) {
14449: $captcha_chk = 1;
14450: }
14451: return $captcha_chk;
14452: }
14453:
1.41 ng 14454: =pod
14455:
14456: =back
14457:
1.112 bowersj2 14458: =cut
1.41 ng 14459:
1.112 bowersj2 14460: 1;
14461: __END__;
1.41 ng 14462:
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