Annotation of loncom/interface/loncommon.pm, revision 1.1220
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1220 ! raeburn 4: # $Id: loncommon.pm,v 1.1219 2015/04/28 12:59:08 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.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1220 ! raeburn 76: use Encode();
1.1091 foxr 77: use Text::Aspell;
1.1094 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.1174 raeburn 80: use Crypt::DES;
81: use DynaLoader; # for Crypt::DES version
1.117 www 82:
1.517 raeburn 83: # ---------------------------------------------- Designs
84: use vars qw(%defaultdesign);
85:
1.22 www 86: my $readit;
87:
1.517 raeburn 88:
1.157 matthew 89: ##
90: ## Global Variables
91: ##
1.46 matthew 92:
1.643 foxr 93:
94: # ----------------------------------------------- SSI with retries:
95: #
96:
97: =pod
98:
1.648 raeburn 99: =head1 Server Side include with retries:
1.643 foxr 100:
101: =over 4
102:
1.648 raeburn 103: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 104:
105: Performs an ssi with some number of retries. Retries continue either
106: until the result is ok or until the retry count supplied by the
107: caller is exhausted.
108:
109: Inputs:
1.648 raeburn 110:
111: =over 4
112:
1.643 foxr 113: resource - Identifies the resource to insert.
1.648 raeburn 114:
1.643 foxr 115: retries - Count of the number of retries allowed.
1.648 raeburn 116:
1.643 foxr 117: form - Hash that identifies the rendering options.
118:
1.648 raeburn 119: =back
120:
121: Returns:
122:
123: =over 4
124:
1.643 foxr 125: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 126:
1.643 foxr 127: response - The response from the last attempt (which may or may not have been successful.
128:
1.648 raeburn 129: =back
130:
131: =back
132:
1.643 foxr 133: =cut
134:
135: sub ssi_with_retries {
136: my ($resource, $retries, %form) = @_;
137:
138:
139: my $ok = 0; # True if we got a good response.
140: my $content;
141: my $response;
142:
143: # Try to get the ssi done. within the retries count:
144:
145: do {
146: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
147: $ok = $response->is_success;
1.650 www 148: if (!$ok) {
149: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
150: }
1.643 foxr 151: $retries--;
152: } while (!$ok && ($retries > 0));
153:
154: if (!$ok) {
155: $content = ''; # On error return an empty content.
156: }
157: return ($content, $response);
158:
159: }
160:
161:
162:
1.20 www 163: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 164: my %language;
1.124 www 165: my %supported_language;
1.1088 foxr 166: my %supported_codes;
1.1048 foxr 167: my %latex_language; # For choosing hyphenation in <transl..>
168: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 169: my %cprtag;
1.192 taceyjo1 170: my %scprtag;
1.351 www 171: my %fe; my %fd; my %fm;
1.41 ng 172: my %category_extensions;
1.12 harris41 173:
1.46 matthew 174: # ---------------------------------------------- Thesaurus variables
1.144 matthew 175: #
176: # %Keywords:
177: # A hash used by &keyword to determine if a word is considered a keyword.
178: # $thesaurus_db_file
179: # Scalar containing the full path to the thesaurus database.
1.46 matthew 180:
181: my %Keywords;
182: my $thesaurus_db_file;
183:
1.144 matthew 184: #
185: # Initialize values from language.tab, copyright.tab, filetypes.tab,
186: # thesaurus.tab, and filecategories.tab.
187: #
1.18 www 188: BEGIN {
1.46 matthew 189: # Variable initialization
190: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
191: #
1.22 www 192: unless ($readit) {
1.12 harris41 193: # ------------------------------------------------------------------- languages
194: {
1.158 raeburn 195: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
196: '/language.tab';
197: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 198: while (my $line = <$fh>) {
199: next if ($line=~/^\#/);
200: chomp($line);
1.1088 foxr 201: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 202: $language{$key}=$val.' - '.$enc;
203: if ($sup) {
204: $supported_language{$key}=$sup;
1.1088 foxr 205: $supported_codes{$key} = $code;
1.158 raeburn 206: }
1.1048 foxr 207: if ($latex) {
208: $latex_language_bykey{$key} = $latex;
1.1088 foxr 209: $latex_language{$code} = $latex;
1.1048 foxr 210: }
1.158 raeburn 211: }
212: close($fh);
213: }
1.12 harris41 214: }
215: # ------------------------------------------------------------------ copyrights
216: {
1.158 raeburn 217: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
218: '/copyright.tab';
219: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 220: while (my $line = <$fh>) {
221: next if ($line=~/^\#/);
222: chomp($line);
223: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 224: $cprtag{$key}=$val;
225: }
226: close($fh);
227: }
1.12 harris41 228: }
1.351 www 229: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 230: {
231: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
232: '/source_copyright.tab';
233: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 234: while (my $line = <$fh>) {
235: next if ($line =~ /^\#/);
236: chomp($line);
237: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 238: $scprtag{$key}=$val;
239: }
240: close($fh);
241: }
242: }
1.63 www 243:
1.517 raeburn 244: # -------------------------------------------------------------- default domain designs
1.63 www 245: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 246: my $designfile = $designdir.'/default.tab';
247: if ( open (my $fh,"<$designfile") ) {
248: while (my $line = <$fh>) {
249: next if ($line =~ /^\#/);
250: chomp($line);
251: my ($key,$val)=(split(/\=/,$line));
252: if ($val) { $defaultdesign{$key}=$val; }
253: }
254: close($fh);
1.63 www 255: }
256:
1.15 harris41 257: # ------------------------------------------------------------- file categories
258: {
1.158 raeburn 259: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
260: '/filecategories.tab';
261: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 262: while (my $line = <$fh>) {
263: next if ($line =~ /^\#/);
264: chomp($line);
265: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 266: push @{$category_extensions{lc($category)}},$extension;
267: }
268: close($fh);
269: }
270:
1.15 harris41 271: }
1.12 harris41 272: # ------------------------------------------------------------------ file types
273: {
1.158 raeburn 274: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
275: '/filetypes.tab';
276: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 277: while (my $line = <$fh>) {
278: next if ($line =~ /^\#/);
279: chomp($line);
280: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 281: if ($descr ne '') {
282: $fe{$ending}=lc($emb);
283: $fd{$ending}=$descr;
1.351 www 284: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 285: }
286: }
287: close($fh);
288: }
1.12 harris41 289: }
1.22 www 290: &Apache::lonnet::logthis(
1.705 tempelho 291: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 292: $readit=1;
1.46 matthew 293: } # end of unless($readit)
1.32 matthew 294:
295: }
1.112 bowersj2 296:
1.42 matthew 297: ###############################################################
298: ## HTML and Javascript Helper Functions ##
299: ###############################################################
300:
301: =pod
302:
1.112 bowersj2 303: =head1 HTML and Javascript Functions
1.42 matthew 304:
1.112 bowersj2 305: =over 4
306:
1.648 raeburn 307: =item * &browser_and_searcher_javascript()
1.112 bowersj2 308:
309: X<browsing, javascript>X<searching, javascript>Returns a string
310: containing javascript with two functions, C<openbrowser> and
311: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
312: tags.
1.42 matthew 313:
1.648 raeburn 314: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 315:
316: inputs: formname, elementname, only, omit
317:
318: formname and elementname indicate the name of the html form and name of
319: the element that the results of the browsing selection are to be placed in.
320:
321: Specifying 'only' will restrict the browser to displaying only files
1.185 www 322: with the given extension. Can be a comma separated list.
1.42 matthew 323:
324: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 325: with the given extension. Can be a comma separated list.
1.42 matthew 326:
1.648 raeburn 327: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 328:
329: Inputs: formname, elementname
330:
331: formname and elementname specify the name of the html form and the name
332: of the element the selection from the search results will be placed in.
1.542 raeburn 333:
1.42 matthew 334: =cut
335:
336: sub browser_and_searcher_javascript {
1.199 albertel 337: my ($mode)=@_;
338: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 339: my $resurl=&escape_single(&lastresurl());
1.42 matthew 340: return <<END;
1.219 albertel 341: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 342: var editbrowser = null;
1.135 albertel 343: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 344: var url = '$resurl/?';
1.42 matthew 345: if (editbrowser == null) {
346: url += 'launch=1&';
347: }
348: url += 'catalogmode=interactive&';
1.199 albertel 349: url += 'mode=$mode&';
1.611 albertel 350: url += 'inhibitmenu=yes&';
1.42 matthew 351: url += 'form=' + formname + '&';
352: if (only != null) {
353: url += 'only=' + only + '&';
1.217 albertel 354: } else {
355: url += 'only=&';
356: }
1.42 matthew 357: if (omit != null) {
358: url += 'omit=' + omit + '&';
1.217 albertel 359: } else {
360: url += 'omit=&';
361: }
1.135 albertel 362: if (titleelement != null) {
363: url += 'titleelement=' + titleelement + '&';
1.217 albertel 364: } else {
365: url += 'titleelement=&';
366: }
1.42 matthew 367: url += 'element=' + elementname + '';
368: var title = 'Browser';
1.435 albertel 369: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 370: options += ',width=700,height=600';
371: editbrowser = open(url,title,options,'1');
372: editbrowser.focus();
373: }
374: var editsearcher;
1.135 albertel 375: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 376: var url = '/adm/searchcat?';
377: if (editsearcher == null) {
378: url += 'launch=1&';
379: }
380: url += 'catalogmode=interactive&';
1.199 albertel 381: url += 'mode=$mode&';
1.42 matthew 382: url += 'form=' + formname + '&';
1.135 albertel 383: if (titleelement != null) {
384: url += 'titleelement=' + titleelement + '&';
1.217 albertel 385: } else {
386: url += 'titleelement=&';
387: }
1.42 matthew 388: url += 'element=' + elementname + '';
389: var title = 'Search';
1.435 albertel 390: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 391: options += ',width=700,height=600';
392: editsearcher = open(url,title,options,'1');
393: editsearcher.focus();
394: }
1.219 albertel 395: // END LON-CAPA Internal -->
1.42 matthew 396: END
1.170 www 397: }
398:
399: sub lastresurl {
1.258 albertel 400: if ($env{'environment.lastresurl'}) {
401: return $env{'environment.lastresurl'}
1.170 www 402: } else {
403: return '/res';
404: }
405: }
406:
407: sub storeresurl {
408: my $resurl=&Apache::lonnet::clutter(shift);
409: unless ($resurl=~/^\/res/) { return 0; }
410: $resurl=~s/\/$//;
411: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 412: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 413: return 1;
1.42 matthew 414: }
415:
1.74 www 416: sub studentbrowser_javascript {
1.111 www 417: unless (
1.258 albertel 418: (($env{'request.course.id'}) &&
1.302 albertel 419: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
420: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
421: '/'.$env{'request.course.sec'})
422: ))
1.258 albertel 423: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 424: ) { return ''; }
1.74 www 425: return (<<'ENDSTDBRW');
1.776 bisitz 426: <script type="text/javascript" language="Javascript">
1.824 bisitz 427: // <![CDATA[
1.74 www 428: var stdeditbrowser;
1.999 www 429: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 430: var url = '/adm/pickstudent?';
431: var filter;
1.558 albertel 432: if (!ignorefilter) {
433: eval('filter=document.'+formname+'.'+uname+'.value;');
434: }
1.74 www 435: if (filter != null) {
436: if (filter != '') {
437: url += 'filter='+filter+'&';
438: }
439: }
440: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 441: '&udomelement='+udom+
442: '&clicker='+clicker;
1.111 www 443: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 444: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 445: var title = 'Student_Browser';
1.74 www 446: var options = 'scrollbars=1,resizable=1,menubar=0';
447: options += ',width=700,height=600';
448: stdeditbrowser = open(url,title,options,'1');
449: stdeditbrowser.focus();
450: }
1.824 bisitz 451: // ]]>
1.74 www 452: </script>
453: ENDSTDBRW
454: }
1.42 matthew 455:
1.1003 www 456: sub resourcebrowser_javascript {
457: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 458: return (<<'ENDRESBRW');
1.1003 www 459: <script type="text/javascript" language="Javascript">
460: // <![CDATA[
461: var reseditbrowser;
1.1004 www 462: function openresbrowser(formname,reslink) {
1.1005 www 463: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 464: var title = 'Resource_Browser';
465: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 466: options += ',width=700,height=500';
1.1004 www 467: reseditbrowser = open(url,title,options,'1');
468: reseditbrowser.focus();
1.1003 www 469: }
470: // ]]>
471: </script>
1.1004 www 472: ENDRESBRW
1.1003 www 473: }
474:
1.74 www 475: sub selectstudent_link {
1.999 www 476: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
477: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
478: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
479: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 480: if ($env{'request.course.id'}) {
1.302 albertel 481: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
482: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
483: '/'.$env{'request.course.sec'})) {
1.111 www 484: return '';
485: }
1.999 www 486: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 487: if ($courseadvonly) {
488: $callargs .= ",'',1,1";
489: }
490: return '<span class="LC_nobreak">'.
491: '<a href="javascript:openstdbrowser('.$callargs.');">'.
492: &mt('Select User').'</a></span>';
1.74 www 493: }
1.258 albertel 494: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 495: $callargs .= ",'',1";
1.793 raeburn 496: return '<span class="LC_nobreak">'.
497: '<a href="javascript:openstdbrowser('.$callargs.');">'.
498: &mt('Select User').'</a></span>';
1.111 www 499: }
500: return '';
1.91 www 501: }
502:
1.1004 www 503: sub selectresource_link {
504: my ($form,$reslink,$arg)=@_;
505:
506: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
507: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
508: unless ($env{'request.course.id'}) { return $arg; }
509: return '<span class="LC_nobreak">'.
510: '<a href="javascript:openresbrowser('.$callargs.');">'.
511: $arg.'</a></span>';
512: }
513:
514:
515:
1.653 raeburn 516: sub authorbrowser_javascript {
517: return <<"ENDAUTHORBRW";
1.776 bisitz 518: <script type="text/javascript" language="JavaScript">
1.824 bisitz 519: // <![CDATA[
1.653 raeburn 520: var stdeditbrowser;
521:
522: function openauthorbrowser(formname,udom) {
523: var url = '/adm/pickauthor?';
524: url += 'form='+formname+'&roledom='+udom;
525: var title = 'Author_Browser';
526: var options = 'scrollbars=1,resizable=1,menubar=0';
527: options += ',width=700,height=600';
528: stdeditbrowser = open(url,title,options,'1');
529: stdeditbrowser.focus();
530: }
531:
1.824 bisitz 532: // ]]>
1.653 raeburn 533: </script>
534: ENDAUTHORBRW
535: }
536:
1.91 www 537: sub coursebrowser_javascript {
1.1116 raeburn 538: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
539: $credits_element) = @_;
1.932 raeburn 540: my $wintitle = 'Course_Browser';
1.931 raeburn 541: if ($crstype eq 'Community') {
1.932 raeburn 542: $wintitle = 'Community_Browser';
1.909 raeburn 543: }
1.876 raeburn 544: my $id_functions = &javascript_index_functions();
545: my $output = '
1.776 bisitz 546: <script type="text/javascript" language="JavaScript">
1.824 bisitz 547: // <![CDATA[
1.468 raeburn 548: var stdeditbrowser;'."\n";
1.876 raeburn 549:
550: $output .= <<"ENDSTDBRW";
1.909 raeburn 551: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 552: var url = '/adm/pickcourse?';
1.895 raeburn 553: var formid = getFormIdByName(formname);
1.876 raeburn 554: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 555: if (domainfilter != null) {
556: if (domainfilter != '') {
557: url += 'domainfilter='+domainfilter+'&';
558: }
559: }
1.91 www 560: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 561: '&cdomelement='+udom+
562: '&cnameelement='+desc;
1.468 raeburn 563: if (extra_element !=null && extra_element != '') {
1.594 raeburn 564: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 565: url += '&roleelement='+extra_element;
566: if (domainfilter == null || domainfilter == '') {
567: url += '&domainfilter='+extra_element;
568: }
1.234 raeburn 569: }
1.468 raeburn 570: else {
571: if (formname == 'portform') {
572: url += '&setroles='+extra_element;
1.800 raeburn 573: } else {
574: if (formname == 'rules') {
575: url += '&fixeddom='+extra_element;
576: }
1.468 raeburn 577: }
578: }
1.230 raeburn 579: }
1.909 raeburn 580: if (type != null && type != '') {
581: url += '&type='+type;
582: }
583: if (type_elem != null && type_elem != '') {
584: url += '&typeelement='+type_elem;
585: }
1.872 raeburn 586: if (formname == 'ccrs') {
587: var ownername = document.forms[formid].ccuname.value;
588: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
589: url += '&cloner='+ownername+':'+ownerdom;
590: }
1.293 raeburn 591: if (multflag !=null && multflag != '') {
592: url += '&multiple='+multflag;
593: }
1.909 raeburn 594: var title = '$wintitle';
1.91 www 595: var options = 'scrollbars=1,resizable=1,menubar=0';
596: options += ',width=700,height=600';
597: stdeditbrowser = open(url,title,options,'1');
598: stdeditbrowser.focus();
599: }
1.876 raeburn 600: $id_functions
601: ENDSTDBRW
1.1116 raeburn 602: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
603: $output .= &setsec_javascript($sec_element,$formname,$role_element,
604: $credits_element);
1.876 raeburn 605: }
606: $output .= '
607: // ]]>
608: </script>';
609: return $output;
610: }
611:
612: sub javascript_index_functions {
613: return <<"ENDJS";
614:
615: function getFormIdByName(formname) {
616: for (var i=0;i<document.forms.length;i++) {
617: if (document.forms[i].name == formname) {
618: return i;
619: }
620: }
621: return -1;
622: }
623:
624: function getIndexByName(formid,item) {
625: for (var i=0;i<document.forms[formid].elements.length;i++) {
626: if (document.forms[formid].elements[i].name == item) {
627: return i;
628: }
629: }
630: return -1;
631: }
1.468 raeburn 632:
1.876 raeburn 633: function getDomainFromSelectbox(formname,udom) {
634: var userdom;
635: var formid = getFormIdByName(formname);
636: if (formid > -1) {
637: var domid = getIndexByName(formid,udom);
638: if (domid > -1) {
639: if (document.forms[formid].elements[domid].type == 'select-one') {
640: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
641: }
642: if (document.forms[formid].elements[domid].type == 'hidden') {
643: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 644: }
645: }
646: }
1.876 raeburn 647: return userdom;
648: }
649:
650: ENDJS
1.468 raeburn 651:
1.876 raeburn 652: }
653:
1.1017 raeburn 654: sub javascript_array_indexof {
1.1018 raeburn 655: return <<ENDJS;
1.1017 raeburn 656: <script type="text/javascript" language="JavaScript">
657: // <![CDATA[
658:
659: if (!Array.prototype.indexOf) {
660: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
661: "use strict";
662: if (this === void 0 || this === null) {
663: throw new TypeError();
664: }
665: var t = Object(this);
666: var len = t.length >>> 0;
667: if (len === 0) {
668: return -1;
669: }
670: var n = 0;
671: if (arguments.length > 0) {
672: n = Number(arguments[1]);
1.1088 foxr 673: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 674: n = 0;
675: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
676: n = (n > 0 || -1) * Math.floor(Math.abs(n));
677: }
678: }
679: if (n >= len) {
680: return -1;
681: }
682: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
683: for (; k < len; k++) {
684: if (k in t && t[k] === searchElement) {
685: return k;
686: }
687: }
688: return -1;
689: }
690: }
691:
692: // ]]>
693: </script>
694:
695: ENDJS
696:
697: }
698:
1.876 raeburn 699: sub userbrowser_javascript {
700: my $id_functions = &javascript_index_functions();
701: return <<"ENDUSERBRW";
702:
1.888 raeburn 703: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 704: var url = '/adm/pickuser?';
705: var userdom = getDomainFromSelectbox(formname,udom);
706: if (userdom != null) {
707: if (userdom != '') {
708: url += 'srchdom='+userdom+'&';
709: }
710: }
711: url += 'form=' + formname + '&unameelement='+uname+
712: '&udomelement='+udom+
713: '&ulastelement='+ulast+
714: '&ufirstelement='+ufirst+
715: '&uemailelement='+uemail+
1.881 raeburn 716: '&hideudomelement='+hideudom+
717: '&coursedom='+crsdom;
1.888 raeburn 718: if ((caller != null) && (caller != undefined)) {
719: url += '&caller='+caller;
720: }
1.876 raeburn 721: var title = 'User_Browser';
722: var options = 'scrollbars=1,resizable=1,menubar=0';
723: options += ',width=700,height=600';
724: var stdeditbrowser = open(url,title,options,'1');
725: stdeditbrowser.focus();
726: }
727:
1.888 raeburn 728: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 729: var formid = getFormIdByName(formname);
730: if (formid > -1) {
1.888 raeburn 731: var unameid = getIndexByName(formid,uname);
1.876 raeburn 732: var domid = getIndexByName(formid,udom);
733: var hidedomid = getIndexByName(formid,origdom);
734: if (hidedomid > -1) {
735: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 736: var unameval = document.forms[formid].elements[unameid].value;
737: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
738: if (domid > -1) {
739: var slct = document.forms[formid].elements[domid];
740: if (slct.type == 'select-one') {
741: var i;
742: for (i=0;i<slct.length;i++) {
743: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
744: }
745: }
746: if (slct.type == 'hidden') {
747: slct.value = fixeddom;
1.876 raeburn 748: }
749: }
1.468 raeburn 750: }
751: }
752: }
1.876 raeburn 753: return;
754: }
755:
756: $id_functions
757: ENDUSERBRW
1.468 raeburn 758: }
759:
760: sub setsec_javascript {
1.1116 raeburn 761: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 762: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
763: $communityrolestr);
764: if ($role_element ne '') {
765: my @allroles = ('st','ta','ep','in','ad');
766: foreach my $crstype ('Course','Community') {
767: if ($crstype eq 'Community') {
768: foreach my $role (@allroles) {
769: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
770: }
771: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
772: } else {
773: foreach my $role (@allroles) {
774: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
775: }
776: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
777: }
778: }
779: $rolestr = '"'.join('","',@allroles).'"';
780: $courserolestr = '"'.join('","',@courserolenames).'"';
781: $communityrolestr = '"'.join('","',@communityrolenames).'"';
782: }
1.468 raeburn 783: my $setsections = qq|
784: function setSect(sectionlist) {
1.629 raeburn 785: var sectionsArray = new Array();
786: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
787: sectionsArray = sectionlist.split(",");
788: }
1.468 raeburn 789: var numSections = sectionsArray.length;
790: document.$formname.$sec_element.length = 0;
791: if (numSections == 0) {
792: document.$formname.$sec_element.multiple=false;
793: document.$formname.$sec_element.size=1;
794: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
795: } else {
796: if (numSections == 1) {
797: document.$formname.$sec_element.multiple=false;
798: document.$formname.$sec_element.size=1;
799: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
800: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
801: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
802: } else {
803: for (var i=0; i<numSections; i++) {
804: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
805: }
806: document.$formname.$sec_element.multiple=true
807: if (numSections < 3) {
808: document.$formname.$sec_element.size=numSections;
809: } else {
810: document.$formname.$sec_element.size=3;
811: }
812: document.$formname.$sec_element.options[0].selected = false
813: }
814: }
1.91 www 815: }
1.905 raeburn 816:
817: function setRole(crstype) {
1.468 raeburn 818: |;
1.905 raeburn 819: if ($role_element eq '') {
820: $setsections .= ' return;
821: }
822: ';
823: } else {
824: $setsections .= qq|
825: var elementLength = document.$formname.$role_element.length;
826: var allroles = Array($rolestr);
827: var courserolenames = Array($courserolestr);
828: var communityrolenames = Array($communityrolestr);
829: if (elementLength != undefined) {
830: if (document.$formname.$role_element.options[5].value == 'cc') {
831: if (crstype == 'Course') {
832: return;
833: } else {
834: allroles[5] = 'co';
835: for (var i=0; i<6; i++) {
836: document.$formname.$role_element.options[i].value = allroles[i];
837: document.$formname.$role_element.options[i].text = communityrolenames[i];
838: }
839: }
840: } else {
841: if (crstype == 'Community') {
842: return;
843: } else {
844: allroles[5] = 'cc';
845: for (var i=0; i<6; i++) {
846: document.$formname.$role_element.options[i].value = allroles[i];
847: document.$formname.$role_element.options[i].text = courserolenames[i];
848: }
849: }
850: }
851: }
852: return;
853: }
854: |;
855: }
1.1116 raeburn 856: if ($credits_element) {
857: $setsections .= qq|
858: function setCredits(defaultcredits) {
859: document.$formname.$credits_element.value = defaultcredits;
860: return;
861: }
862: |;
863: }
1.468 raeburn 864: return $setsections;
865: }
866:
1.91 www 867: sub selectcourse_link {
1.909 raeburn 868: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
869: $typeelement) = @_;
870: my $type = $selecttype;
1.871 raeburn 871: my $linktext = &mt('Select Course');
872: if ($selecttype eq 'Community') {
1.909 raeburn 873: $linktext = &mt('Select Community');
1.906 raeburn 874: } elsif ($selecttype eq 'Course/Community') {
875: $linktext = &mt('Select Course/Community');
1.909 raeburn 876: $type = '';
1.1019 raeburn 877: } elsif ($selecttype eq 'Select') {
878: $linktext = &mt('Select');
879: $type = '';
1.871 raeburn 880: }
1.787 bisitz 881: return '<span class="LC_nobreak">'
882: ."<a href='"
883: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
884: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 885: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 886: ."'>".$linktext.'</a>'
1.787 bisitz 887: .'</span>';
1.74 www 888: }
1.42 matthew 889:
1.653 raeburn 890: sub selectauthor_link {
891: my ($form,$udom)=@_;
892: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
893: &mt('Select Author').'</a>';
894: }
895:
1.876 raeburn 896: sub selectuser_link {
1.881 raeburn 897: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 898: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 899: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 900: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 901: ');">'.$linktext.'</a>';
1.876 raeburn 902: }
903:
1.273 raeburn 904: sub check_uncheck_jscript {
905: my $jscript = <<"ENDSCRT";
906: function checkAll(field) {
907: if (field.length > 0) {
908: for (i = 0; i < field.length; i++) {
1.1093 raeburn 909: if (!field[i].disabled) {
910: field[i].checked = true;
911: }
1.273 raeburn 912: }
913: } else {
1.1093 raeburn 914: if (!field.disabled) {
915: field.checked = true;
916: }
1.273 raeburn 917: }
918: }
919:
920: function uncheckAll(field) {
921: if (field.length > 0) {
922: for (i = 0; i < field.length; i++) {
923: field[i].checked = false ;
1.543 albertel 924: }
925: } else {
1.273 raeburn 926: field.checked = false ;
927: }
928: }
929: ENDSCRT
930: return $jscript;
931: }
932:
1.656 www 933: sub select_timezone {
1.659 raeburn 934: my ($name,$selected,$onchange,$includeempty)=@_;
935: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
936: if ($includeempty) {
937: $output .= '<option value=""';
938: if (($selected eq '') || ($selected eq 'local')) {
939: $output .= ' selected="selected" ';
940: }
941: $output .= '> </option>';
942: }
1.657 raeburn 943: my @timezones = DateTime::TimeZone->all_names;
944: foreach my $tzone (@timezones) {
945: $output.= '<option value="'.$tzone.'"';
946: if ($tzone eq $selected) {
947: $output.=' selected="selected"';
948: }
949: $output.=">$tzone</option>\n";
1.656 www 950: }
951: $output.="</select>";
952: return $output;
953: }
1.273 raeburn 954:
1.687 raeburn 955: sub select_datelocale {
956: my ($name,$selected,$onchange,$includeempty)=@_;
957: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
958: if ($includeempty) {
959: $output .= '<option value=""';
960: if ($selected eq '') {
961: $output .= ' selected="selected" ';
962: }
963: $output .= '> </option>';
964: }
965: my (@possibles,%locale_names);
966: my @locales = DateTime::Locale::Catalog::Locales;
967: foreach my $locale (@locales) {
968: if (ref($locale) eq 'HASH') {
969: my $id = $locale->{'id'};
970: if ($id ne '') {
971: my $en_terr = $locale->{'en_territory'};
972: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 973: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 974: if (grep(/^en$/,@languages) || !@languages) {
975: if ($en_terr ne '') {
976: $locale_names{$id} = '('.$en_terr.')';
977: } elsif ($native_terr ne '') {
978: $locale_names{$id} = $native_terr;
979: }
980: } else {
981: if ($native_terr ne '') {
982: $locale_names{$id} = $native_terr.' ';
983: } elsif ($en_terr ne '') {
984: $locale_names{$id} = '('.$en_terr.')';
985: }
986: }
1.1220 ! raeburn 987: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687 raeburn 988: push (@possibles,$id);
989: }
990: }
991: }
992: foreach my $item (sort(@possibles)) {
993: $output.= '<option value="'.$item.'"';
994: if ($item eq $selected) {
995: $output.=' selected="selected"';
996: }
997: $output.=">$item";
998: if ($locale_names{$item} ne '') {
1.1220 ! raeburn 999: $output.=' '.$locale_names{$item};
1.687 raeburn 1000: }
1001: $output.="</option>\n";
1002: }
1003: $output.="</select>";
1004: return $output;
1005: }
1006:
1.792 raeburn 1007: sub select_language {
1008: my ($name,$selected,$includeempty) = @_;
1009: my %langchoices;
1010: if ($includeempty) {
1.1117 raeburn 1011: %langchoices = ('' => 'No language preference');
1.792 raeburn 1012: }
1013: foreach my $id (&languageids()) {
1014: my $code = &supportedlanguagecode($id);
1015: if ($code) {
1016: $langchoices{$code} = &plainlanguagedescription($id);
1017: }
1018: }
1.1117 raeburn 1019: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1020: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1021: }
1022:
1.42 matthew 1023: =pod
1.36 matthew 1024:
1.1088 foxr 1025:
1026: =item * &list_languages()
1027:
1028: Returns an array reference that is suitable for use in language prompters.
1029: Each array element is itself a two element array. The first element
1030: is the language code. The second element a descsriptiuon of the
1031: language itself. This is suitable for use in e.g.
1032: &Apache::edit::select_arg (once dereferenced that is).
1033:
1034: =cut
1035:
1036: sub list_languages {
1037: my @lang_choices;
1038:
1039: foreach my $id (&languageids()) {
1040: my $code = &supportedlanguagecode($id);
1041: if ($code) {
1042: my $selector = $supported_codes{$id};
1043: my $description = &plainlanguagedescription($id);
1044: push (@lang_choices, [$selector, $description]);
1045: }
1046: }
1047: return \@lang_choices;
1048: }
1049:
1050: =pod
1051:
1.648 raeburn 1052: =item * &linked_select_forms(...)
1.36 matthew 1053:
1054: linked_select_forms returns a string containing a <script></script> block
1055: and html for two <select> menus. The select menus will be linked in that
1056: changing the value of the first menu will result in new values being placed
1057: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1058: order unless a defined order is provided.
1.36 matthew 1059:
1060: linked_select_forms takes the following ordered inputs:
1061:
1062: =over 4
1063:
1.112 bowersj2 1064: =item * $formname, the name of the <form> tag
1.36 matthew 1065:
1.112 bowersj2 1066: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1067:
1.112 bowersj2 1068: =item * $firstdefault, the default value for the first menu
1.36 matthew 1069:
1.112 bowersj2 1070: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1071:
1.112 bowersj2 1072: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1073:
1.112 bowersj2 1074: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1075:
1.609 raeburn 1076: =item * $menuorder, the order of values in the first menu
1077:
1.1115 raeburn 1078: =item * $onchangefirst, additional javascript call to execute for an onchange
1079: event for the first <select> tag
1080:
1081: =item * $onchangesecond, additional javascript call to execute for an onchange
1082: event for the second <select> tag
1083:
1.41 ng 1084: =back
1085:
1.36 matthew 1086: Below is an example of such a hash. Only the 'text', 'default', and
1087: 'select2' keys must appear as stated. keys(%menu) are the possible
1088: values for the first select menu. The text that coincides with the
1.41 ng 1089: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1090: and text for the second menu are given in the hash pointed to by
1091: $menu{$choice1}->{'select2'}.
1092:
1.112 bowersj2 1093: my %menu = ( A1 => { text =>"Choice A1" ,
1094: default => "B3",
1095: select2 => {
1096: B1 => "Choice B1",
1097: B2 => "Choice B2",
1098: B3 => "Choice B3",
1099: B4 => "Choice B4"
1.609 raeburn 1100: },
1101: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1102: },
1103: A2 => { text =>"Choice A2" ,
1104: default => "C2",
1105: select2 => {
1106: C1 => "Choice C1",
1107: C2 => "Choice C2",
1108: C3 => "Choice C3"
1.609 raeburn 1109: },
1110: order => ['C2','C1','C3'],
1.112 bowersj2 1111: },
1112: A3 => { text =>"Choice A3" ,
1113: default => "D6",
1114: select2 => {
1115: D1 => "Choice D1",
1116: D2 => "Choice D2",
1117: D3 => "Choice D3",
1118: D4 => "Choice D4",
1119: D5 => "Choice D5",
1120: D6 => "Choice D6",
1121: D7 => "Choice D7"
1.609 raeburn 1122: },
1123: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1124: }
1125: );
1.36 matthew 1126:
1127: =cut
1128:
1129: sub linked_select_forms {
1130: my ($formname,
1131: $middletext,
1132: $firstdefault,
1133: $firstselectname,
1134: $secondselectname,
1.609 raeburn 1135: $hashref,
1136: $menuorder,
1.1115 raeburn 1137: $onchangefirst,
1138: $onchangesecond
1.36 matthew 1139: ) = @_;
1140: my $second = "document.$formname.$secondselectname";
1141: my $first = "document.$formname.$firstselectname";
1142: # output the javascript to do the changing
1143: my $result = '';
1.776 bisitz 1144: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1145: $result.="// <![CDATA[\n";
1.36 matthew 1146: $result.="var select2data = new Object();\n";
1147: $" = '","';
1148: my $debug = '';
1149: foreach my $s1 (sort(keys(%$hashref))) {
1150: $result.="select2data.d_$s1 = new Object();\n";
1151: $result.="select2data.d_$s1.def = new String('".
1152: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1153: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1154: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1155: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1156: @s2values = @{$hashref->{$s1}->{'order'}};
1157: }
1.36 matthew 1158: $result.="\"@s2values\");\n";
1159: $result.="select2data.d_$s1.texts = new Array(";
1160: my @s2texts;
1161: foreach my $value (@s2values) {
1162: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1163: }
1164: $result.="\"@s2texts\");\n";
1165: }
1166: $"=' ';
1167: $result.= <<"END";
1168:
1169: function select1_changed() {
1170: // Determine new choice
1171: var newvalue = "d_" + $first.value;
1172: // update select2
1173: var values = select2data[newvalue].values;
1174: var texts = select2data[newvalue].texts;
1175: var select2def = select2data[newvalue].def;
1176: var i;
1177: // out with the old
1178: for (i = 0; i < $second.options.length; i++) {
1179: $second.options[i] = null;
1180: }
1181: // in with the nuclear
1182: for (i=0;i<values.length; i++) {
1183: $second.options[i] = new Option(values[i]);
1.143 matthew 1184: $second.options[i].value = values[i];
1.36 matthew 1185: $second.options[i].text = texts[i];
1186: if (values[i] == select2def) {
1187: $second.options[i].selected = true;
1188: }
1189: }
1190: }
1.824 bisitz 1191: // ]]>
1.36 matthew 1192: </script>
1193: END
1194: # output the initial values for the selection lists
1.1115 raeburn 1195: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1196: my @order = sort(keys(%{$hashref}));
1197: if (ref($menuorder) eq 'ARRAY') {
1198: @order = @{$menuorder};
1199: }
1200: foreach my $value (@order) {
1.36 matthew 1201: $result.=" <option value=\"$value\" ";
1.253 albertel 1202: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1203: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1204: }
1205: $result .= "</select>\n";
1206: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1207: $result .= $middletext;
1.1115 raeburn 1208: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1209: if ($onchangesecond) {
1210: $result .= ' onchange="'.$onchangesecond.'"';
1211: }
1212: $result .= ">\n";
1.36 matthew 1213: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1214:
1215: my @secondorder = sort(keys(%select2));
1216: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1217: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1218: }
1219: foreach my $value (@secondorder) {
1.36 matthew 1220: $result.=" <option value=\"$value\" ";
1.253 albertel 1221: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1222: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1223: }
1224: $result .= "</select>\n";
1225: # return $debug;
1226: return $result;
1227: } # end of sub linked_select_forms {
1228:
1.45 matthew 1229: =pod
1.44 bowersj2 1230:
1.973 raeburn 1231: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1232:
1.112 bowersj2 1233: Returns a string corresponding to an HTML link to the given help
1234: $topic, where $topic corresponds to the name of a .tex file in
1235: /home/httpd/html/adm/help/tex, with underscores replaced by
1236: spaces.
1237:
1238: $text will optionally be linked to the same topic, allowing you to
1239: link text in addition to the graphic. If you do not want to link
1240: text, but wish to specify one of the later parameters, pass an
1241: empty string.
1242:
1243: $stayOnPage is a value that will be interpreted as a boolean. If true,
1244: the link will not open a new window. If false, the link will open
1245: a new window using Javascript. (Default is false.)
1246:
1247: $width and $height are optional numerical parameters that will
1248: override the width and height of the popped up window, which may
1.973 raeburn 1249: be useful for certain help topics with big pictures included.
1250:
1251: $imgid is the id of the img tag used for the help icon. This may be
1252: used in a javascript call to switch the image src. See
1253: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1254:
1255: =cut
1256:
1257: sub help_open_topic {
1.973 raeburn 1258: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1259: $text = "" if (not defined $text);
1.44 bowersj2 1260: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1261: $width = 500 if (not defined $width);
1.44 bowersj2 1262: $height = 400 if (not defined $height);
1263: my $filename = $topic;
1264: $filename =~ s/ /_/g;
1265:
1.48 bowersj2 1266: my $template = "";
1267: my $link;
1.572 banghart 1268:
1.159 www 1269: $topic=~s/\W/\_/g;
1.44 bowersj2 1270:
1.572 banghart 1271: if (!$stayOnPage) {
1.1033 www 1272: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1273: } elsif ($stayOnPage eq 'popup') {
1274: $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 1275: } else {
1.48 bowersj2 1276: $link = "/adm/help/${filename}.hlp";
1277: }
1278:
1279: # Add the text
1.755 neumanie 1280: if ($text ne "") {
1.763 bisitz 1281: $template.='<span class="LC_help_open_topic">'
1282: .'<a target="_top" href="'.$link.'">'
1283: .$text.'</a>';
1.48 bowersj2 1284: }
1285:
1.763 bisitz 1286: # (Always) Add the graphic
1.179 matthew 1287: my $title = &mt('Online Help');
1.667 raeburn 1288: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1289: if ($imgid ne '') {
1290: $imgid = ' id="'.$imgid.'"';
1291: }
1.763 bisitz 1292: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1293: .'<img src="'.$helpicon.'" border="0"'
1294: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1295: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1296: .' /></a>';
1297: if ($text ne "") {
1298: $template.='</span>';
1299: }
1.44 bowersj2 1300: return $template;
1301:
1.106 bowersj2 1302: }
1303:
1304: # This is a quicky function for Latex cheatsheet editing, since it
1305: # appears in at least four places
1306: sub helpLatexCheatsheet {
1.1037 www 1307: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1308: my $out;
1.106 bowersj2 1309: my $addOther = '';
1.732 raeburn 1310: if ($topic) {
1.1037 www 1311: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1312: }
1313: $out = '<span>' # Start cheatsheet
1314: .$addOther
1315: .'<span>'
1.1037 www 1316: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1317: .'</span> <span>'
1.1037 www 1318: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1319: .'</span>';
1.732 raeburn 1320: unless ($not_author) {
1.1186 kruse 1321: $out .= '<span>'
1322: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1323: .'</span> <span>'
1324: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1325: .'</span>';
1.732 raeburn 1326: }
1.763 bisitz 1327: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1328: return $out;
1.172 www 1329: }
1330:
1.430 albertel 1331: sub general_help {
1332: my $helptopic='Student_Intro';
1333: if ($env{'request.role'}=~/^(ca|au)/) {
1334: $helptopic='Authoring_Intro';
1.907 raeburn 1335: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1336: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1337: } elsif ($env{'request.role'}=~/^dc/) {
1338: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1339: }
1340: return $helptopic;
1341: }
1342:
1343: sub update_help_link {
1344: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1345: my $origurl = $ENV{'REQUEST_URI'};
1346: $origurl=~s|^/~|/priv/|;
1347: my $timestamp = time;
1348: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1349: $$datum = &escape($$datum);
1350: }
1351:
1352: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1353: my $output .= <<"ENDOUTPUT";
1354: <script type="text/javascript">
1.824 bisitz 1355: // <![CDATA[
1.430 albertel 1356: banner_link = '$banner_link';
1.824 bisitz 1357: // ]]>
1.430 albertel 1358: </script>
1359: ENDOUTPUT
1360: return $output;
1361: }
1362:
1363: # now just updates the help link and generates a blue icon
1.193 raeburn 1364: sub help_open_menu {
1.430 albertel 1365: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1366: = @_;
1.949 droeschl 1367: $stayOnPage = 1;
1.430 albertel 1368: my $output;
1369: if ($component_help) {
1370: if (!$text) {
1371: $output=&help_open_topic($component_help,undef,$stayOnPage,
1372: $width,$height);
1373: } else {
1374: my $help_text;
1375: $help_text=&unescape($topic);
1376: $output='<table><tr><td>'.
1377: &help_open_topic($component_help,$help_text,$stayOnPage,
1378: $width,$height).'</td></tr></table>';
1379: }
1380: }
1381: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1382: return $output.$banner_link;
1383: }
1384:
1385: sub top_nav_help {
1386: my ($text) = @_;
1.436 albertel 1387: $text = &mt($text);
1.949 droeschl 1388: my $stay_on_page = 1;
1389:
1.1168 raeburn 1390: my ($link,$banner_link);
1391: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1392: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1393: : "javascript:helpMenu('open')";
1394: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1395: }
1.201 raeburn 1396: my $title = &mt('Get help');
1.1168 raeburn 1397: if ($link) {
1398: return <<"END";
1.436 albertel 1399: $banner_link
1.1159 raeburn 1400: <a href="$link" title="$title">$text</a>
1.436 albertel 1401: END
1.1168 raeburn 1402: } else {
1403: return ' '.$text.' ';
1404: }
1.436 albertel 1405: }
1406:
1407: sub help_menu_js {
1.1154 raeburn 1408: my ($httphost) = @_;
1.949 droeschl 1409: my $stayOnPage = 1;
1.436 albertel 1410: my $width = 620;
1411: my $height = 600;
1.430 albertel 1412: my $helptopic=&general_help();
1.1154 raeburn 1413: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1414: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1415: my $start_page =
1416: &Apache::loncommon::start_page('Help Menu', undef,
1417: {'frameset' => 1,
1418: 'js_ready' => 1,
1.1154 raeburn 1419: 'use_absolute' => $httphost,
1.331 albertel 1420: 'add_entries' => {
1.1168 raeburn 1421: 'border' => '0',
1.579 raeburn 1422: 'rows' => "110,*",},});
1.331 albertel 1423: my $end_page =
1424: &Apache::loncommon::end_page({'frameset' => 1,
1425: 'js_ready' => 1,});
1426:
1.436 albertel 1427: my $template .= <<"ENDTEMPLATE";
1428: <script type="text/javascript">
1.877 bisitz 1429: // <![CDATA[
1.253 albertel 1430: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1431: var banner_link = '';
1.243 raeburn 1432: function helpMenu(target) {
1433: var caller = this;
1434: if (target == 'open') {
1435: var newWindow = null;
1436: try {
1.262 albertel 1437: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1438: }
1439: catch(error) {
1440: writeHelp(caller);
1441: return;
1442: }
1443: if (newWindow) {
1444: caller = newWindow;
1445: }
1.193 raeburn 1446: }
1.243 raeburn 1447: writeHelp(caller);
1448: return;
1449: }
1450: function writeHelp(caller) {
1.1168 raeburn 1451: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1452: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1453: caller.document.close();
1454: caller.focus();
1.193 raeburn 1455: }
1.877 bisitz 1456: // END LON-CAPA Internal -->
1.253 albertel 1457: // ]]>
1.436 albertel 1458: </script>
1.193 raeburn 1459: ENDTEMPLATE
1460: return $template;
1461: }
1462:
1.172 www 1463: sub help_open_bug {
1464: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1465: unless ($env{'user.adv'}) { return ''; }
1.172 www 1466: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1467: $text = "" if (not defined $text);
1468: $stayOnPage=1;
1.184 albertel 1469: $width = 600 if (not defined $width);
1470: $height = 600 if (not defined $height);
1.172 www 1471:
1472: $topic=~s/\W+/\+/g;
1473: my $link='';
1474: my $template='';
1.379 albertel 1475: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1476: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1477: if (!$stayOnPage)
1478: {
1479: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1480: }
1481: else
1482: {
1483: $link = $url;
1484: }
1485: # Add the text
1486: if ($text ne "")
1487: {
1488: $template .=
1489: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1490: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1491: }
1492:
1493: # Add the graphic
1.179 matthew 1494: my $title = &mt('Report a Bug');
1.215 albertel 1495: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1496: $template .= <<"ENDTEMPLATE";
1.436 albertel 1497: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1498: ENDTEMPLATE
1499: if ($text ne '') { $template.='</td></tr></table>' };
1500: return $template;
1501:
1502: }
1503:
1504: sub help_open_faq {
1505: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1506: unless ($env{'user.adv'}) { return ''; }
1.172 www 1507: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1508: $text = "" if (not defined $text);
1509: $stayOnPage=1;
1510: $width = 350 if (not defined $width);
1511: $height = 400 if (not defined $height);
1512:
1513: $topic=~s/\W+/\+/g;
1514: my $link='';
1515: my $template='';
1516: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1517: if (!$stayOnPage)
1518: {
1519: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1520: }
1521: else
1522: {
1523: $link = $url;
1524: }
1525:
1526: # Add the text
1527: if ($text ne "")
1528: {
1529: $template .=
1.173 www 1530: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1531: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1532: }
1533:
1534: # Add the graphic
1.179 matthew 1535: my $title = &mt('View the FAQ');
1.215 albertel 1536: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1537: $template .= <<"ENDTEMPLATE";
1.436 albertel 1538: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1539: ENDTEMPLATE
1540: if ($text ne '') { $template.='</td></tr></table>' };
1541: return $template;
1542:
1.44 bowersj2 1543: }
1.37 matthew 1544:
1.180 matthew 1545: ###############################################################
1546: ###############################################################
1547:
1.45 matthew 1548: =pod
1549:
1.648 raeburn 1550: =item * &change_content_javascript():
1.256 matthew 1551:
1552: This and the next function allow you to create small sections of an
1553: otherwise static HTML page that you can update on the fly with
1554: Javascript, even in Netscape 4.
1555:
1556: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1557: must be written to the HTML page once. It will prove the Javascript
1558: function "change(name, content)". Calling the change function with the
1559: name of the section
1560: you want to update, matching the name passed to C<changable_area>, and
1561: the new content you want to put in there, will put the content into
1562: that area.
1563:
1564: B<Note>: Netscape 4 only reserves enough space for the changable area
1565: to contain room for the original contents. You need to "make space"
1566: for whatever changes you wish to make, and be B<sure> to check your
1567: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1568: it's adequate for updating a one-line status display, but little more.
1569: This script will set the space to 100% width, so you only need to
1570: worry about height in Netscape 4.
1571:
1572: Modern browsers are much less limiting, and if you can commit to the
1573: user not using Netscape 4, this feature may be used freely with
1574: pretty much any HTML.
1575:
1576: =cut
1577:
1578: sub change_content_javascript {
1579: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1580: if ($env{'browser.type'} eq 'netscape' &&
1581: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1582: return (<<NETSCAPE4);
1583: function change(name, content) {
1584: doc = document.layers[name+"___escape"].layers[0].document;
1585: doc.open();
1586: doc.write(content);
1587: doc.close();
1588: }
1589: NETSCAPE4
1590: } else {
1591: # Otherwise, we need to use semi-standards-compliant code
1592: # (technically, "innerHTML" isn't standard but the equivalent
1593: # is really scary, and every useful browser supports it
1594: return (<<DOMBASED);
1595: function change(name, content) {
1596: element = document.getElementById(name);
1597: element.innerHTML = content;
1598: }
1599: DOMBASED
1600: }
1601: }
1602:
1603: =pod
1604:
1.648 raeburn 1605: =item * &changable_area($name,$origContent):
1.256 matthew 1606:
1607: This provides a "changable area" that can be modified on the fly via
1608: the Javascript code provided in C<change_content_javascript>. $name is
1609: the name you will use to reference the area later; do not repeat the
1610: same name on a given HTML page more then once. $origContent is what
1611: the area will originally contain, which can be left blank.
1612:
1613: =cut
1614:
1615: sub changable_area {
1616: my ($name, $origContent) = @_;
1617:
1.258 albertel 1618: if ($env{'browser.type'} eq 'netscape' &&
1619: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1620: # If this is netscape 4, we need to use the Layer tag
1621: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1622: } else {
1623: return "<span id='$name'>$origContent</span>";
1624: }
1625: }
1626:
1627: =pod
1628:
1.648 raeburn 1629: =item * &viewport_geometry_js
1.590 raeburn 1630:
1631: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1632:
1633: =cut
1634:
1635:
1636: sub viewport_geometry_js {
1637: return <<"GEOMETRY";
1638: var Geometry = {};
1639: function init_geometry() {
1640: if (Geometry.init) { return };
1641: Geometry.init=1;
1642: if (window.innerHeight) {
1643: Geometry.getViewportHeight = function() { return window.innerHeight; };
1644: Geometry.getViewportWidth = function() { return window.innerWidth; };
1645: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1646: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1647: }
1648: else if (document.documentElement && document.documentElement.clientHeight) {
1649: Geometry.getViewportHeight =
1650: function() { return document.documentElement.clientHeight; };
1651: Geometry.getViewportWidth =
1652: function() { return document.documentElement.clientWidth; };
1653:
1654: Geometry.getHorizontalScroll =
1655: function() { return document.documentElement.scrollLeft; };
1656: Geometry.getVerticalScroll =
1657: function() { return document.documentElement.scrollTop; };
1658: }
1659: else if (document.body.clientHeight) {
1660: Geometry.getViewportHeight =
1661: function() { return document.body.clientHeight; };
1662: Geometry.getViewportWidth =
1663: function() { return document.body.clientWidth; };
1664: Geometry.getHorizontalScroll =
1665: function() { return document.body.scrollLeft; };
1666: Geometry.getVerticalScroll =
1667: function() { return document.body.scrollTop; };
1668: }
1669: }
1670:
1671: GEOMETRY
1672: }
1673:
1674: =pod
1675:
1.648 raeburn 1676: =item * &viewport_size_js()
1.590 raeburn 1677:
1678: 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.
1679:
1680: =cut
1681:
1682: sub viewport_size_js {
1683: my $geometry = &viewport_geometry_js();
1684: return <<"DIMS";
1685:
1686: $geometry
1687:
1688: function getViewportDims(width,height) {
1689: init_geometry();
1690: width.value = Geometry.getViewportWidth();
1691: height.value = Geometry.getViewportHeight();
1692: return;
1693: }
1694:
1695: DIMS
1696: }
1697:
1698: =pod
1699:
1.648 raeburn 1700: =item * &resize_textarea_js()
1.565 albertel 1701:
1702: emits the needed javascript to resize a textarea to be as big as possible
1703:
1704: creates a function resize_textrea that takes two IDs first should be
1705: the id of the element to resize, second should be the id of a div that
1706: surrounds everything that comes after the textarea, this routine needs
1707: to be attached to the <body> for the onload and onresize events.
1708:
1.648 raeburn 1709: =back
1.565 albertel 1710:
1711: =cut
1712:
1713: sub resize_textarea_js {
1.590 raeburn 1714: my $geometry = &viewport_geometry_js();
1.565 albertel 1715: return <<"RESIZE";
1716: <script type="text/javascript">
1.824 bisitz 1717: // <![CDATA[
1.590 raeburn 1718: $geometry
1.565 albertel 1719:
1.588 albertel 1720: function getX(element) {
1721: var x = 0;
1722: while (element) {
1723: x += element.offsetLeft;
1724: element = element.offsetParent;
1725: }
1726: return x;
1727: }
1728: function getY(element) {
1729: var y = 0;
1730: while (element) {
1731: y += element.offsetTop;
1732: element = element.offsetParent;
1733: }
1734: return y;
1735: }
1736:
1737:
1.565 albertel 1738: function resize_textarea(textarea_id,bottom_id) {
1739: init_geometry();
1740: var textarea = document.getElementById(textarea_id);
1741: //alert(textarea);
1742:
1.588 albertel 1743: var textarea_top = getY(textarea);
1.565 albertel 1744: var textarea_height = textarea.offsetHeight;
1745: var bottom = document.getElementById(bottom_id);
1.588 albertel 1746: var bottom_top = getY(bottom);
1.565 albertel 1747: var bottom_height = bottom.offsetHeight;
1748: var window_height = Geometry.getViewportHeight();
1.588 albertel 1749: var fudge = 23;
1.565 albertel 1750: var new_height = window_height-fudge-textarea_top-bottom_height;
1751: if (new_height < 300) {
1752: new_height = 300;
1753: }
1754: textarea.style.height=new_height+'px';
1755: }
1.824 bisitz 1756: // ]]>
1.565 albertel 1757: </script>
1758: RESIZE
1759:
1760: }
1761:
1.1205 golterma 1762: sub colorfuleditor_js {
1763: return <<"COLORFULEDIT"
1764: <script type="text/javascript">
1765: // <![CDATA[>
1766: function fold_box(curDepth, lastresource){
1767:
1768: // we need a list because there can be several blocks you need to fold in one tag
1769: var block = document.getElementsByName('foldblock_'+curDepth);
1770: // but there is only one folding button per tag
1771: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1772:
1773: if(block.item(0).style.display == 'none'){
1774:
1775: foldbutton.value = '@{[&mt("Hide")]}';
1776: for (i = 0; i < block.length; i++){
1777: block.item(i).style.display = '';
1778: }
1779: }else{
1780:
1781: foldbutton.value = '@{[&mt("Show")]}';
1782: for (i = 0; i < block.length; i++){
1783: // block.item(i).style.visibility = 'collapse';
1784: block.item(i).style.display = 'none';
1785: }
1786: };
1787: saveState(lastresource);
1788: }
1789:
1790: function saveState (lastresource) {
1791:
1792: var tag_list = getTagList();
1793: if(tag_list != null){
1794: var timestamp = new Date().getTime();
1795: var key = lastresource;
1796:
1797: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1798: // starting with timestamp
1799: var value = timestamp+';';
1800:
1801: // building the list of key-value pairs
1802: for(var i = 0; i < tag_list.length; i++){
1803: value += tag_list[i]+',';
1804: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1805: }
1806:
1807: // only iterate whole storage if nothing to override
1808: if(localStorage.getItem(key) == null){
1809:
1810: // prevent storage from growing large
1811: if(localStorage.length > 50){
1812: var regex_getTimestamp = /^(?:\d)+;/;
1813: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1814: var oldest_key;
1815:
1816: for(var i = 1; i < localStorage.length; i++){
1817: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1818: oldest_key = localStorage.key(i);
1819: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1820: }
1821: }
1822: localStorage.removeItem(oldest_key);
1823: }
1824: }
1825: localStorage.setItem(key,value);
1826: }
1827: }
1828:
1829: // restore folding status of blocks (on page load)
1830: function restoreState (lastresource) {
1831: if(localStorage.getItem(lastresource) != null){
1832: var key = lastresource;
1833: var value = localStorage.getItem(key);
1834: var regex_delTimestamp = /^\d+;/;
1835:
1836: value.replace(regex_delTimestamp, '');
1837:
1838: var valueArr = value.split(';');
1839: var pairs;
1840: var elements;
1841: for (var i = 0; i < valueArr.length; i++){
1842: pairs = valueArr[i].split(',');
1843: elements = document.getElementsByName(pairs[0]);
1844:
1845: for (var j = 0; j < elements.length; j++){
1846: elements[j].style.display = pairs[1];
1847: if (pairs[1] == "none"){
1848: var regex_id = /([_\\d]+)\$/;
1849: regex_id.exec(pairs[0]);
1850: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1851: }
1852: }
1853: }
1854: }
1855: }
1856:
1857: function getTagList () {
1858:
1859: var stringToSearch = document.lonhomework.innerHTML;
1860:
1861: var ret = new Array();
1862: var regex_findBlock = /(foldblock_.*?)"/g;
1863: var tag_list = stringToSearch.match(regex_findBlock);
1864:
1865: if(tag_list != null){
1866: for(var i = 0; i < tag_list.length; i++){
1867: ret.push(tag_list[i].replace(/"/, ''));
1868: }
1869: }
1870: return ret;
1871: }
1872:
1873: function saveScrollPosition (resource) {
1874: var tag_list = getTagList();
1875:
1876: // we dont always want to jump to the first block
1877: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1878: if(\$(window).scrollTop() > 170){
1879: if(tag_list != null){
1880: var result;
1881: for(var i = 0; i < tag_list.length; i++){
1882: if(isElementInViewport(tag_list[i])){
1883: result += tag_list[i]+';';
1884: }
1885: }
1886: sessionStorage.setItem('anchor_'+resource, result);
1887: }
1888: } else {
1889: // we dont need to save zero, just delete the item to leave everything tidy
1890: sessionStorage.removeItem('anchor_'+resource);
1891: }
1892: }
1893:
1894: function restoreScrollPosition(resource){
1895:
1896: var elem = sessionStorage.getItem('anchor_'+resource);
1897: if(elem != null){
1898: var tag_list = elem.split(';');
1899: var elem_list;
1900:
1901: for(var i = 0; i < tag_list.length; i++){
1902: elem_list = document.getElementsByName(tag_list[i]);
1903:
1904: if(elem_list.length > 0){
1905: elem = elem_list[0];
1906: break;
1907: }
1908: }
1909: elem.scrollIntoView();
1910: }
1911: }
1912:
1913: function isElementInViewport(el) {
1914:
1915: // change to last element instead of first
1916: var elem = document.getElementsByName(el);
1917: var rect = elem[0].getBoundingClientRect();
1918:
1919: return (
1920: rect.top >= 0 &&
1921: rect.left >= 0 &&
1922: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1923: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1924: );
1925: }
1926:
1927: function autosize(depth){
1928: var cmInst = window['cm'+depth];
1929: var fitsizeButton = document.getElementById('fitsize'+depth);
1930:
1931: // is fixed size, switching to dynamic
1932: if (sessionStorage.getItem("autosized_"+depth) == null) {
1933: cmInst.setSize("","auto");
1934: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1935: sessionStorage.setItem("autosized_"+depth, "yes");
1936:
1937: // is dynamic size, switching to fixed
1938: } else {
1939: cmInst.setSize("","300px");
1940: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1941: sessionStorage.removeItem("autosized_"+depth);
1942: }
1943: }
1944:
1945:
1946:
1947: // ]]>
1948: </script>
1949: COLORFULEDIT
1950: }
1951:
1952: sub xmleditor_js {
1953: return <<XMLEDIT
1954: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1955: <script type="text/javascript">
1956: // <![CDATA[>
1957:
1958: function saveScrollPosition (resource) {
1959:
1960: var scrollPos = \$(window).scrollTop();
1961: sessionStorage.setItem(resource,scrollPos);
1962: }
1963:
1964: function restoreScrollPosition(resource){
1965:
1966: var scrollPos = sessionStorage.getItem(resource);
1967: \$(window).scrollTop(scrollPos);
1968: }
1969:
1970: // unless internet explorer
1971: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1972:
1973: \$(document).ready(function() {
1974: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1975: });
1976: }
1977:
1978: // inserts text at cursor position into codemirror (xml editor only)
1979: function insertText(text){
1980: cm.focus();
1981: var curPos = cm.getCursor();
1982: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1983: }
1984: // ]]>
1985: </script>
1986: XMLEDIT
1987: }
1988:
1989: sub insert_folding_button {
1990: my $curDepth = $Apache::lonxml::curdepth;
1991: my $lastresource = $env{'request.ambiguous'};
1992:
1993: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
1994: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
1995: }
1996:
1.565 albertel 1997: =pod
1998:
1.256 matthew 1999: =head1 Excel and CSV file utility routines
2000:
2001: =cut
2002:
2003: ###############################################################
2004: ###############################################################
2005:
2006: =pod
2007:
1.1162 raeburn 2008: =over 4
2009:
1.648 raeburn 2010: =item * &csv_translate($text)
1.37 matthew 2011:
1.185 www 2012: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2013: format.
2014:
2015: =cut
2016:
1.180 matthew 2017: ###############################################################
2018: ###############################################################
1.37 matthew 2019: sub csv_translate {
2020: my $text = shift;
2021: $text =~ s/\"/\"\"/g;
1.209 albertel 2022: $text =~ s/\n/ /g;
1.37 matthew 2023: return $text;
2024: }
1.180 matthew 2025:
2026: ###############################################################
2027: ###############################################################
2028:
2029: =pod
2030:
1.648 raeburn 2031: =item * &define_excel_formats()
1.180 matthew 2032:
2033: Define some commonly used Excel cell formats.
2034:
2035: Currently supported formats:
2036:
2037: =over 4
2038:
2039: =item header
2040:
2041: =item bold
2042:
2043: =item h1
2044:
2045: =item h2
2046:
2047: =item h3
2048:
1.256 matthew 2049: =item h4
2050:
2051: =item i
2052:
1.180 matthew 2053: =item date
2054:
2055: =back
2056:
2057: Inputs: $workbook
2058:
2059: Returns: $format, a hash reference.
2060:
1.1057 foxr 2061:
1.180 matthew 2062: =cut
2063:
2064: ###############################################################
2065: ###############################################################
2066: sub define_excel_formats {
2067: my ($workbook) = @_;
2068: my $format;
2069: $format->{'header'} = $workbook->add_format(bold => 1,
2070: bottom => 1,
2071: align => 'center');
2072: $format->{'bold'} = $workbook->add_format(bold=>1);
2073: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2074: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2075: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2076: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2077: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2078: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2079: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2080: return $format;
2081: }
2082:
2083: ###############################################################
2084: ###############################################################
1.113 bowersj2 2085:
2086: =pod
2087:
1.648 raeburn 2088: =item * &create_workbook()
1.255 matthew 2089:
2090: Create an Excel worksheet. If it fails, output message on the
2091: request object and return undefs.
2092:
2093: Inputs: Apache request object
2094:
2095: Returns (undef) on failure,
2096: Excel worksheet object, scalar with filename, and formats
2097: from &Apache::loncommon::define_excel_formats on success
2098:
2099: =cut
2100:
2101: ###############################################################
2102: ###############################################################
2103: sub create_workbook {
2104: my ($r) = @_;
2105: #
2106: # Create the excel spreadsheet
2107: my $filename = '/prtspool/'.
1.258 albertel 2108: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2109: time.'_'.rand(1000000000).'.xls';
2110: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2111: if (! defined($workbook)) {
2112: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2113: $r->print(
2114: '<p class="LC_error">'
2115: .&mt('Problems occurred in creating the new Excel file.')
2116: .' '.&mt('This error has been logged.')
2117: .' '.&mt('Please alert your LON-CAPA administrator.')
2118: .'</p>'
2119: );
1.255 matthew 2120: return (undef);
2121: }
2122: #
1.1014 foxr 2123: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2124: #
2125: my $format = &Apache::loncommon::define_excel_formats($workbook);
2126: return ($workbook,$filename,$format);
2127: }
2128:
2129: ###############################################################
2130: ###############################################################
2131:
2132: =pod
2133:
1.648 raeburn 2134: =item * &create_text_file()
1.113 bowersj2 2135:
1.542 raeburn 2136: Create a file to write to and eventually make available to the user.
1.256 matthew 2137: If file creation fails, outputs an error message on the request object and
2138: return undefs.
1.113 bowersj2 2139:
1.256 matthew 2140: Inputs: Apache request object, and file suffix
1.113 bowersj2 2141:
1.256 matthew 2142: Returns (undef) on failure,
2143: Filehandle and filename on success.
1.113 bowersj2 2144:
2145: =cut
2146:
1.256 matthew 2147: ###############################################################
2148: ###############################################################
2149: sub create_text_file {
2150: my ($r,$suffix) = @_;
2151: if (! defined($suffix)) { $suffix = 'txt'; };
2152: my $fh;
2153: my $filename = '/prtspool/'.
1.258 albertel 2154: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2155: time.'_'.rand(1000000000).'.'.$suffix;
2156: $fh = Apache::File->new('>/home/httpd'.$filename);
2157: if (! defined($fh)) {
2158: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2159: $r->print(
2160: '<p class="LC_error">'
2161: .&mt('Problems occurred in creating the output file.')
2162: .' '.&mt('This error has been logged.')
2163: .' '.&mt('Please alert your LON-CAPA administrator.')
2164: .'</p>'
2165: );
1.113 bowersj2 2166: }
1.256 matthew 2167: return ($fh,$filename)
1.113 bowersj2 2168: }
2169:
2170:
1.256 matthew 2171: =pod
1.113 bowersj2 2172:
2173: =back
2174:
2175: =cut
1.37 matthew 2176:
2177: ###############################################################
1.33 matthew 2178: ## Home server <option> list generating code ##
2179: ###############################################################
1.35 matthew 2180:
1.169 www 2181: # ------------------------------------------
2182:
2183: sub domain_select {
2184: my ($name,$value,$multiple)=@_;
2185: my %domains=map {
1.514 albertel 2186: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2187: } &Apache::lonnet::all_domains();
1.169 www 2188: if ($multiple) {
2189: $domains{''}=&mt('Any domain');
1.550 albertel 2190: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2191: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2192: } else {
1.550 albertel 2193: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2194: return &select_form($name,$value,\%domains);
1.169 www 2195: }
2196: }
2197:
1.282 albertel 2198: #-------------------------------------------
2199:
2200: =pod
2201:
1.519 raeburn 2202: =head1 Routines for form select boxes
2203:
2204: =over 4
2205:
1.648 raeburn 2206: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2207:
2208: Returns a string containing a <select> element int multiple mode
2209:
2210:
2211: Args:
2212: $name - name of the <select> element
1.506 raeburn 2213: $value - scalar or array ref of values that should already be selected
1.282 albertel 2214: $size - number of rows long the select element is
1.283 albertel 2215: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2216: (shown text should already have been &mt())
1.506 raeburn 2217: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2218:
1.282 albertel 2219: =cut
2220:
2221: #-------------------------------------------
1.169 www 2222: sub multiple_select_form {
1.284 albertel 2223: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2224: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2225: my $output='';
1.191 matthew 2226: if (! defined($size)) {
2227: $size = 4;
1.283 albertel 2228: if (scalar(keys(%$hash))<4) {
2229: $size = scalar(keys(%$hash));
1.191 matthew 2230: }
2231: }
1.734 bisitz 2232: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2233: my @order;
1.506 raeburn 2234: if (ref($order) eq 'ARRAY') {
2235: @order = @{$order};
2236: } else {
2237: @order = sort(keys(%$hash));
1.501 banghart 2238: }
2239: if (exists($$hash{'select_form_order'})) {
2240: @order = @{$$hash{'select_form_order'}};
2241: }
2242:
1.284 albertel 2243: foreach my $key (@order) {
1.356 albertel 2244: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2245: $output.='selected="selected" ' if ($selected{$key});
2246: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2247: }
2248: $output.="</select>\n";
2249: return $output;
2250: }
2251:
1.88 www 2252: #-------------------------------------------
2253:
2254: =pod
2255:
1.970 raeburn 2256: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2257:
2258: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2259: allow a user to select options from a ref to a hash containing:
2260: option_name => displayed text. An optional $onchange can include
2261: a javascript onchange item, e.g., onchange="this.form.submit();"
2262:
1.88 www 2263: See lonrights.pm for an example invocation and use.
2264:
2265: =cut
2266:
2267: #-------------------------------------------
2268: sub select_form {
1.970 raeburn 2269: my ($def,$name,$hashref,$onchange) = @_;
2270: return unless (ref($hashref) eq 'HASH');
2271: if ($onchange) {
2272: $onchange = ' onchange="'.$onchange.'"';
2273: }
2274: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2275: my @keys;
1.970 raeburn 2276: if (exists($hashref->{'select_form_order'})) {
2277: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2278: } else {
1.970 raeburn 2279: @keys=sort(keys(%{$hashref}));
1.128 albertel 2280: }
1.356 albertel 2281: foreach my $key (@keys) {
2282: $selectform.=
2283: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2284: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2285: ">".$hashref->{$key}."</option>\n";
1.88 www 2286: }
2287: $selectform.="</select>";
2288: return $selectform;
2289: }
2290:
1.475 www 2291: # For display filters
2292:
2293: sub display_filter {
1.1074 raeburn 2294: my ($context) = @_;
1.475 www 2295: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2296: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2297: my $phraseinput = 'hidden';
2298: my $includeinput = 'hidden';
2299: my ($checked,$includetypestext);
2300: if ($env{'form.displayfilter'} eq 'containing') {
2301: $phraseinput = 'text';
2302: if ($context eq 'parmslog') {
2303: $includeinput = 'checkbox';
2304: if ($env{'form.includetypes'}) {
2305: $checked = ' checked="checked"';
2306: }
2307: $includetypestext = &mt('Include parameter types');
2308: }
2309: } else {
2310: $includetypestext = ' ';
2311: }
2312: my ($additional,$secondid,$thirdid);
2313: if ($context eq 'parmslog') {
2314: $additional =
2315: '<label><input type="'.$includeinput.'" name="includetypes"'.
2316: $checked.' name="includetypes" value="1" id="includetypes" />'.
2317: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2318: '</label>';
2319: $secondid = 'includetypes';
2320: $thirdid = 'includetypestext';
2321: }
2322: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2323: '$secondid','$thirdid')";
2324: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2325: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2326: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2327: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2328: &mt('Filter: [_1]',
1.477 www 2329: &select_form($env{'form.displayfilter'},
2330: 'displayfilter',
1.970 raeburn 2331: {'currentfolder' => 'Current folder/page',
1.477 www 2332: 'containing' => 'Containing phrase',
1.1074 raeburn 2333: 'none' => 'None'},$onchange)).' '.
2334: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2335: &HTML::Entities::encode($env{'form.containingphrase'}).
2336: '" />'.$additional;
2337: }
2338:
2339: sub display_filter_js {
2340: my $includetext = &mt('Include parameter types');
2341: return <<"ENDJS";
2342:
2343: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2344: var firstType = 'hidden';
2345: if (setter.options[setter.selectedIndex].value == 'containing') {
2346: firstType = 'text';
2347: }
2348: firstObject = document.getElementById(firstid);
2349: if (typeof(firstObject) == 'object') {
2350: if (firstObject.type != firstType) {
2351: changeInputType(firstObject,firstType);
2352: }
2353: }
2354: if (context == 'parmslog') {
2355: var secondType = 'hidden';
2356: if (firstType == 'text') {
2357: secondType = 'checkbox';
2358: }
2359: secondObject = document.getElementById(secondid);
2360: if (typeof(secondObject) == 'object') {
2361: if (secondObject.type != secondType) {
2362: changeInputType(secondObject,secondType);
2363: }
2364: }
2365: var textItem = document.getElementById(thirdid);
2366: var currtext = textItem.innerHTML;
2367: var newtext;
2368: if (firstType == 'text') {
2369: newtext = '$includetext';
2370: } else {
2371: newtext = ' ';
2372: }
2373: if (currtext != newtext) {
2374: textItem.innerHTML = newtext;
2375: }
2376: }
2377: return;
2378: }
2379:
2380: function changeInputType(oldObject,newType) {
2381: var newObject = document.createElement('input');
2382: newObject.type = newType;
2383: if (oldObject.size) {
2384: newObject.size = oldObject.size;
2385: }
2386: if (oldObject.value) {
2387: newObject.value = oldObject.value;
2388: }
2389: if (oldObject.name) {
2390: newObject.name = oldObject.name;
2391: }
2392: if (oldObject.id) {
2393: newObject.id = oldObject.id;
2394: }
2395: oldObject.parentNode.replaceChild(newObject,oldObject);
2396: return;
2397: }
2398:
2399: ENDJS
1.475 www 2400: }
2401:
1.167 www 2402: sub gradeleveldescription {
2403: my $gradelevel=shift;
2404: my %gradelevels=(0 => 'Not specified',
2405: 1 => 'Grade 1',
2406: 2 => 'Grade 2',
2407: 3 => 'Grade 3',
2408: 4 => 'Grade 4',
2409: 5 => 'Grade 5',
2410: 6 => 'Grade 6',
2411: 7 => 'Grade 7',
2412: 8 => 'Grade 8',
2413: 9 => 'Grade 9',
2414: 10 => 'Grade 10',
2415: 11 => 'Grade 11',
2416: 12 => 'Grade 12',
2417: 13 => 'Grade 13',
2418: 14 => '100 Level',
2419: 15 => '200 Level',
2420: 16 => '300 Level',
2421: 17 => '400 Level',
2422: 18 => 'Graduate Level');
2423: return &mt($gradelevels{$gradelevel});
2424: }
2425:
1.163 www 2426: sub select_level_form {
2427: my ($deflevel,$name)=@_;
2428: unless ($deflevel) { $deflevel=0; }
1.167 www 2429: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2430: for (my $i=0; $i<=18; $i++) {
2431: $selectform.="<option value=\"$i\" ".
1.253 albertel 2432: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2433: ">".&gradeleveldescription($i)."</option>\n";
2434: }
2435: $selectform.="</select>";
2436: return $selectform;
1.163 www 2437: }
1.167 www 2438:
1.35 matthew 2439: #-------------------------------------------
2440:
1.45 matthew 2441: =pod
2442:
1.1121 raeburn 2443: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2444:
2445: Returns a string containing a <select name='$name' size='1'> form to
2446: allow a user to select the domain to preform an operation in.
2447: See loncreateuser.pm for an example invocation and use.
2448:
1.90 www 2449: If the $includeempty flag is set, it also includes an empty choice ("no domain
2450: selected");
2451:
1.743 raeburn 2452: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2453:
1.910 raeburn 2454: 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.
2455:
1.1121 raeburn 2456: The optional $incdoms is a reference to an array of domains which will be the only available options.
2457:
2458: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2459:
1.35 matthew 2460: =cut
2461:
2462: #-------------------------------------------
1.34 matthew 2463: sub select_dom_form {
1.1121 raeburn 2464: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2465: if ($onchange) {
1.874 raeburn 2466: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2467: }
1.1121 raeburn 2468: my (@domains,%exclude);
1.910 raeburn 2469: if (ref($incdoms) eq 'ARRAY') {
2470: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2471: } else {
2472: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2473: }
1.90 www 2474: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2475: if (ref($excdoms) eq 'ARRAY') {
2476: map { $exclude{$_} = 1; } @{$excdoms};
2477: }
1.743 raeburn 2478: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2479: foreach my $dom (@domains) {
1.1121 raeburn 2480: next if ($exclude{$dom});
1.356 albertel 2481: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2482: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2483: if ($showdomdesc) {
2484: if ($dom ne '') {
2485: my $domdesc = &Apache::lonnet::domain($dom,'description');
2486: if ($domdesc ne '') {
2487: $selectdomain .= ' ('.$domdesc.')';
2488: }
2489: }
2490: }
2491: $selectdomain .= "</option>\n";
1.34 matthew 2492: }
2493: $selectdomain.="</select>";
2494: return $selectdomain;
2495: }
2496:
1.35 matthew 2497: #-------------------------------------------
2498:
1.45 matthew 2499: =pod
2500:
1.648 raeburn 2501: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2502:
1.586 raeburn 2503: input: 4 arguments (two required, two optional) -
2504: $domain - domain of new user
2505: $name - name of form element
2506: $default - Value of 'default' causes a default item to be first
2507: option, and selected by default.
2508: $hide - Value of 'hide' causes hiding of the name of the server,
2509: if 1 server found, or default, if 0 found.
1.594 raeburn 2510: output: returns 2 items:
1.586 raeburn 2511: (a) form element which contains either:
2512: (i) <select name="$name">
2513: <option value="$hostid1">$hostid $servers{$hostid}</option>
2514: <option value="$hostid2">$hostid $servers{$hostid}</option>
2515: </select>
2516: form item if there are multiple library servers in $domain, or
2517: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2518: if there is only one library server in $domain.
2519:
2520: (b) number of library servers found.
2521:
2522: See loncreateuser.pm for example of use.
1.35 matthew 2523:
2524: =cut
2525:
2526: #-------------------------------------------
1.586 raeburn 2527: sub home_server_form_item {
2528: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2529: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2530: my $result;
2531: my $numlib = keys(%servers);
2532: if ($numlib > 1) {
2533: $result .= '<select name="'.$name.'" />'."\n";
2534: if ($default) {
1.804 bisitz 2535: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2536: '</option>'."\n";
2537: }
2538: foreach my $hostid (sort(keys(%servers))) {
2539: $result.= '<option value="'.$hostid.'">'.
2540: $hostid.' '.$servers{$hostid}."</option>\n";
2541: }
2542: $result .= '</select>'."\n";
2543: } elsif ($numlib == 1) {
2544: my $hostid;
2545: foreach my $item (keys(%servers)) {
2546: $hostid = $item;
2547: }
2548: $result .= '<input type="hidden" name="'.$name.'" value="'.
2549: $hostid.'" />';
2550: if (!$hide) {
2551: $result .= $hostid.' '.$servers{$hostid};
2552: }
2553: $result .= "\n";
2554: } elsif ($default) {
2555: $result .= '<input type="hidden" name="'.$name.
2556: '" value="default" />';
2557: if (!$hide) {
2558: $result .= &mt('default');
2559: }
2560: $result .= "\n";
1.33 matthew 2561: }
1.586 raeburn 2562: return ($result,$numlib);
1.33 matthew 2563: }
1.112 bowersj2 2564:
2565: =pod
2566:
1.534 albertel 2567: =back
2568:
1.112 bowersj2 2569: =cut
1.87 matthew 2570:
2571: ###############################################################
1.112 bowersj2 2572: ## Decoding User Agent ##
1.87 matthew 2573: ###############################################################
2574:
2575: =pod
2576:
1.112 bowersj2 2577: =head1 Decoding the User Agent
2578:
2579: =over 4
2580:
2581: =item * &decode_user_agent()
1.87 matthew 2582:
2583: Inputs: $r
2584:
2585: Outputs:
2586:
2587: =over 4
2588:
1.112 bowersj2 2589: =item * $httpbrowser
1.87 matthew 2590:
1.112 bowersj2 2591: =item * $clientbrowser
1.87 matthew 2592:
1.112 bowersj2 2593: =item * $clientversion
1.87 matthew 2594:
1.112 bowersj2 2595: =item * $clientmathml
1.87 matthew 2596:
1.112 bowersj2 2597: =item * $clientunicode
1.87 matthew 2598:
1.112 bowersj2 2599: =item * $clientos
1.87 matthew 2600:
1.1137 raeburn 2601: =item * $clientmobile
2602:
1.1141 raeburn 2603: =item * $clientinfo
2604:
1.1194 raeburn 2605: =item * $clientosversion
2606:
1.87 matthew 2607: =back
2608:
1.157 matthew 2609: =back
2610:
1.87 matthew 2611: =cut
2612:
2613: ###############################################################
2614: ###############################################################
2615: sub decode_user_agent {
1.247 albertel 2616: my ($r)=@_;
1.87 matthew 2617: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2618: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2619: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2620: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2621: my $clientbrowser='unknown';
2622: my $clientversion='0';
2623: my $clientmathml='';
2624: my $clientunicode='0';
1.1137 raeburn 2625: my $clientmobile=0;
1.1194 raeburn 2626: my $clientosversion='';
1.87 matthew 2627: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2628: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2629: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2630: $clientbrowser=$bname;
2631: $httpbrowser=~/$vreg/i;
2632: $clientversion=$1;
2633: $clientmathml=($clientversion>=$minv);
2634: $clientunicode=($clientversion>=$univ);
2635: }
2636: }
2637: my $clientos='unknown';
1.1141 raeburn 2638: my $clientinfo;
1.87 matthew 2639: if (($httpbrowser=~/linux/i) ||
2640: ($httpbrowser=~/unix/i) ||
2641: ($httpbrowser=~/ux/i) ||
2642: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2643: if (($httpbrowser=~/vax/i) ||
2644: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2645: if ($httpbrowser=~/next/i) { $clientos='next'; }
2646: if (($httpbrowser=~/mac/i) ||
2647: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2648: if ($httpbrowser=~/win/i) {
2649: $clientos='win';
2650: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2651: $clientosversion = $1;
2652: }
2653: }
1.87 matthew 2654: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2655: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2656: $clientmobile=lc($1);
2657: }
1.1141 raeburn 2658: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2659: $clientinfo = 'firefox-'.$1;
2660: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2661: $clientinfo = 'chromeframe-'.$1;
2662: }
1.87 matthew 2663: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2664: $clientunicode,$clientos,$clientmobile,$clientinfo,
2665: $clientosversion);
1.87 matthew 2666: }
2667:
1.32 matthew 2668: ###############################################################
2669: ## Authentication changing form generation subroutines ##
2670: ###############################################################
2671: ##
2672: ## All of the authform_xxxxxxx subroutines take their inputs in a
2673: ## hash, and have reasonable default values.
2674: ##
2675: ## formname = the name given in the <form> tag.
1.35 matthew 2676: #-------------------------------------------
2677:
1.45 matthew 2678: =pod
2679:
1.112 bowersj2 2680: =head1 Authentication Routines
2681:
2682: =over 4
2683:
1.648 raeburn 2684: =item * &authform_xxxxxx()
1.35 matthew 2685:
2686: The authform_xxxxxx subroutines provide javascript and html forms which
2687: handle some of the conveniences required for authentication forms.
2688: This is not an optimal method, but it works.
2689:
2690: =over 4
2691:
1.112 bowersj2 2692: =item * authform_header
1.35 matthew 2693:
1.112 bowersj2 2694: =item * authform_authorwarning
1.35 matthew 2695:
1.112 bowersj2 2696: =item * authform_nochange
1.35 matthew 2697:
1.112 bowersj2 2698: =item * authform_kerberos
1.35 matthew 2699:
1.112 bowersj2 2700: =item * authform_internal
1.35 matthew 2701:
1.112 bowersj2 2702: =item * authform_filesystem
1.35 matthew 2703:
2704: =back
2705:
1.648 raeburn 2706: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2707:
1.35 matthew 2708: =cut
2709:
2710: #-------------------------------------------
1.32 matthew 2711: sub authform_header{
2712: my %in = (
2713: formname => 'cu',
1.80 albertel 2714: kerb_def_dom => '',
1.32 matthew 2715: @_,
2716: );
2717: $in{'formname'} = 'document.' . $in{'formname'};
2718: my $result='';
1.80 albertel 2719:
2720: #---------------------------------------------- Code for upper case translation
2721: my $Javascript_toUpperCase;
2722: unless ($in{kerb_def_dom}) {
2723: $Javascript_toUpperCase =<<"END";
2724: switch (choice) {
2725: case 'krb': currentform.elements[choicearg].value =
2726: currentform.elements[choicearg].value.toUpperCase();
2727: break;
2728: default:
2729: }
2730: END
2731: } else {
2732: $Javascript_toUpperCase = "";
2733: }
2734:
1.165 raeburn 2735: my $radioval = "'nochange'";
1.591 raeburn 2736: if (defined($in{'curr_authtype'})) {
2737: if ($in{'curr_authtype'} ne '') {
2738: $radioval = "'".$in{'curr_authtype'}."arg'";
2739: }
1.174 matthew 2740: }
1.165 raeburn 2741: my $argfield = 'null';
1.591 raeburn 2742: if (defined($in{'mode'})) {
1.165 raeburn 2743: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2744: if (defined($in{'curr_autharg'})) {
2745: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2746: $argfield = "'$in{'curr_autharg'}'";
2747: }
2748: }
2749: }
2750: }
2751:
1.32 matthew 2752: $result.=<<"END";
2753: var current = new Object();
1.165 raeburn 2754: current.radiovalue = $radioval;
2755: current.argfield = $argfield;
1.32 matthew 2756:
2757: function changed_radio(choice,currentform) {
2758: var choicearg = choice + 'arg';
2759: // If a radio button in changed, we need to change the argfield
2760: if (current.radiovalue != choice) {
2761: current.radiovalue = choice;
2762: if (current.argfield != null) {
2763: currentform.elements[current.argfield].value = '';
2764: }
2765: if (choice == 'nochange') {
2766: current.argfield = null;
2767: } else {
2768: current.argfield = choicearg;
2769: switch(choice) {
2770: case 'krb':
2771: currentform.elements[current.argfield].value =
2772: "$in{'kerb_def_dom'}";
2773: break;
2774: default:
2775: break;
2776: }
2777: }
2778: }
2779: return;
2780: }
1.22 www 2781:
1.32 matthew 2782: function changed_text(choice,currentform) {
2783: var choicearg = choice + 'arg';
2784: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2785: $Javascript_toUpperCase
1.32 matthew 2786: // clear old field
2787: if ((current.argfield != choicearg) && (current.argfield != null)) {
2788: currentform.elements[current.argfield].value = '';
2789: }
2790: current.argfield = choicearg;
2791: }
2792: set_auth_radio_buttons(choice,currentform);
2793: return;
1.20 www 2794: }
1.32 matthew 2795:
2796: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2797: var numauthchoices = currentform.login.length;
2798: if (typeof numauthchoices == "undefined") {
2799: return;
2800: }
1.32 matthew 2801: var i=0;
1.986 raeburn 2802: while (i < numauthchoices) {
1.32 matthew 2803: if (currentform.login[i].value == newvalue) { break; }
2804: i++;
2805: }
1.986 raeburn 2806: if (i == numauthchoices) {
1.32 matthew 2807: return;
2808: }
2809: current.radiovalue = newvalue;
2810: currentform.login[i].checked = true;
2811: return;
2812: }
2813: END
2814: return $result;
2815: }
2816:
1.1106 raeburn 2817: sub authform_authorwarning {
1.32 matthew 2818: my $result='';
1.144 matthew 2819: $result='<i>'.
2820: &mt('As a general rule, only authors or co-authors should be '.
2821: 'filesystem authenticated '.
2822: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2823: return $result;
2824: }
2825:
1.1106 raeburn 2826: sub authform_nochange {
1.32 matthew 2827: my %in = (
2828: formname => 'document.cu',
2829: kerb_def_dom => 'MSU.EDU',
2830: @_,
2831: );
1.1106 raeburn 2832: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2833: my $result;
1.1104 raeburn 2834: if (!$authnum) {
1.1105 raeburn 2835: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2836: } else {
2837: $result = '<label>'.&mt('[_1] Do not change login data',
2838: '<input type="radio" name="login" value="nochange" '.
2839: 'checked="checked" onclick="'.
1.281 albertel 2840: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2841: '</label>';
1.586 raeburn 2842: }
1.32 matthew 2843: return $result;
2844: }
2845:
1.591 raeburn 2846: sub authform_kerberos {
1.32 matthew 2847: my %in = (
2848: formname => 'document.cu',
2849: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2850: kerb_def_auth => 'krb4',
1.32 matthew 2851: @_,
2852: );
1.586 raeburn 2853: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2854: $autharg,$jscall);
1.1106 raeburn 2855: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2856: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2857: $check5 = ' checked="checked"';
1.80 albertel 2858: } else {
1.772 bisitz 2859: $check4 = ' checked="checked"';
1.80 albertel 2860: }
1.165 raeburn 2861: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2862: if (defined($in{'curr_authtype'})) {
2863: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2864: $krbcheck = ' checked="checked"';
1.623 raeburn 2865: if (defined($in{'mode'})) {
2866: if ($in{'mode'} eq 'modifyuser') {
2867: $krbcheck = '';
2868: }
2869: }
1.591 raeburn 2870: if (defined($in{'curr_kerb_ver'})) {
2871: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2872: $check5 = ' checked="checked"';
1.591 raeburn 2873: $check4 = '';
2874: } else {
1.772 bisitz 2875: $check4 = ' checked="checked"';
1.591 raeburn 2876: $check5 = '';
2877: }
1.586 raeburn 2878: }
1.591 raeburn 2879: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2880: $krbarg = $in{'curr_autharg'};
2881: }
1.586 raeburn 2882: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2883: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2884: $result =
2885: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2886: $in{'curr_autharg'},$krbver);
2887: } else {
2888: $result =
2889: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2890: }
2891: return $result;
2892: }
2893: }
2894: } else {
2895: if ($authnum == 1) {
1.784 bisitz 2896: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2897: }
2898: }
1.586 raeburn 2899: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2900: return;
1.587 raeburn 2901: } elsif ($authtype eq '') {
1.591 raeburn 2902: if (defined($in{'mode'})) {
1.587 raeburn 2903: if ($in{'mode'} eq 'modifycourse') {
2904: if ($authnum == 1) {
1.1104 raeburn 2905: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2906: }
2907: }
2908: }
1.586 raeburn 2909: }
2910: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2911: if ($authtype eq '') {
2912: $authtype = '<input type="radio" name="login" value="krb" '.
2913: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2914: $krbcheck.' />';
2915: }
2916: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2917: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2918: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2919: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2920: $in{'curr_authtype'} eq 'krb4')) {
2921: $result .= &mt
1.144 matthew 2922: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2923: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2924: '<label>'.$authtype,
1.281 albertel 2925: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2926: 'value="'.$krbarg.'" '.
1.144 matthew 2927: 'onchange="'.$jscall.'" />',
1.281 albertel 2928: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2929: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2930: '</label>');
1.586 raeburn 2931: } elsif ($can_assign{'krb4'}) {
2932: $result .= &mt
2933: ('[_1] Kerberos authenticated with domain [_2] '.
2934: '[_3] Version 4 [_4]',
2935: '<label>'.$authtype,
2936: '</label><input type="text" size="10" name="krbarg" '.
2937: 'value="'.$krbarg.'" '.
2938: 'onchange="'.$jscall.'" />',
2939: '<label><input type="hidden" name="krbver" value="4" />',
2940: '</label>');
2941: } elsif ($can_assign{'krb5'}) {
2942: $result .= &mt
2943: ('[_1] Kerberos authenticated with domain [_2] '.
2944: '[_3] Version 5 [_4]',
2945: '<label>'.$authtype,
2946: '</label><input type="text" size="10" name="krbarg" '.
2947: 'value="'.$krbarg.'" '.
2948: 'onchange="'.$jscall.'" />',
2949: '<label><input type="hidden" name="krbver" value="5" />',
2950: '</label>');
2951: }
1.32 matthew 2952: return $result;
2953: }
2954:
1.1106 raeburn 2955: sub authform_internal {
1.586 raeburn 2956: my %in = (
1.32 matthew 2957: formname => 'document.cu',
2958: kerb_def_dom => 'MSU.EDU',
2959: @_,
2960: );
1.586 raeburn 2961: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2962: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2963: if (defined($in{'curr_authtype'})) {
2964: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2965: if ($can_assign{'int'}) {
1.772 bisitz 2966: $intcheck = 'checked="checked" ';
1.623 raeburn 2967: if (defined($in{'mode'})) {
2968: if ($in{'mode'} eq 'modifyuser') {
2969: $intcheck = '';
2970: }
2971: }
1.591 raeburn 2972: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2973: $intarg = $in{'curr_autharg'};
2974: }
2975: } else {
2976: $result = &mt('Currently internally authenticated.');
2977: return $result;
1.165 raeburn 2978: }
2979: }
1.586 raeburn 2980: } else {
2981: if ($authnum == 1) {
1.784 bisitz 2982: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2983: }
2984: }
2985: if (!$can_assign{'int'}) {
2986: return;
1.587 raeburn 2987: } elsif ($authtype eq '') {
1.591 raeburn 2988: if (defined($in{'mode'})) {
1.587 raeburn 2989: if ($in{'mode'} eq 'modifycourse') {
2990: if ($authnum == 1) {
1.1104 raeburn 2991: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2992: }
2993: }
2994: }
1.165 raeburn 2995: }
1.586 raeburn 2996: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2997: if ($authtype eq '') {
2998: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2999: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
3000: }
1.605 bisitz 3001: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3002: $intarg.'" onchange="'.$jscall.'" />';
3003: $result = &mt
1.144 matthew 3004: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3005: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3006: $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 3007: return $result;
3008: }
3009:
1.1104 raeburn 3010: sub authform_local {
1.32 matthew 3011: my %in = (
3012: formname => 'document.cu',
3013: kerb_def_dom => 'MSU.EDU',
3014: @_,
3015: );
1.586 raeburn 3016: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3017: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3018: if (defined($in{'curr_authtype'})) {
3019: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3020: if ($can_assign{'loc'}) {
1.772 bisitz 3021: $loccheck = 'checked="checked" ';
1.623 raeburn 3022: if (defined($in{'mode'})) {
3023: if ($in{'mode'} eq 'modifyuser') {
3024: $loccheck = '';
3025: }
3026: }
1.591 raeburn 3027: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3028: $locarg = $in{'curr_autharg'};
3029: }
3030: } else {
3031: $result = &mt('Currently using local (institutional) authentication.');
3032: return $result;
1.165 raeburn 3033: }
3034: }
1.586 raeburn 3035: } else {
3036: if ($authnum == 1) {
1.784 bisitz 3037: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3038: }
3039: }
3040: if (!$can_assign{'loc'}) {
3041: return;
1.587 raeburn 3042: } elsif ($authtype eq '') {
1.591 raeburn 3043: if (defined($in{'mode'})) {
1.587 raeburn 3044: if ($in{'mode'} eq 'modifycourse') {
3045: if ($authnum == 1) {
1.1104 raeburn 3046: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3047: }
3048: }
3049: }
1.165 raeburn 3050: }
1.586 raeburn 3051: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3052: if ($authtype eq '') {
3053: $authtype = '<input type="radio" name="login" value="loc" '.
3054: $loccheck.' onchange="'.$jscall.'" onclick="'.
3055: $jscall.'" />';
3056: }
3057: $autharg = '<input type="text" size="10" name="locarg" value="'.
3058: $locarg.'" onchange="'.$jscall.'" />';
3059: $result = &mt('[_1] Local Authentication with argument [_2]',
3060: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3061: return $result;
3062: }
3063:
1.1106 raeburn 3064: sub authform_filesystem {
1.32 matthew 3065: my %in = (
3066: formname => 'document.cu',
3067: kerb_def_dom => 'MSU.EDU',
3068: @_,
3069: );
1.586 raeburn 3070: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3071: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3072: if (defined($in{'curr_authtype'})) {
3073: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3074: if ($can_assign{'fsys'}) {
1.772 bisitz 3075: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3076: if (defined($in{'mode'})) {
3077: if ($in{'mode'} eq 'modifyuser') {
3078: $fsyscheck = '';
3079: }
3080: }
1.586 raeburn 3081: } else {
3082: $result = &mt('Currently Filesystem Authenticated.');
3083: return $result;
3084: }
3085: }
3086: } else {
3087: if ($authnum == 1) {
1.784 bisitz 3088: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3089: }
3090: }
3091: if (!$can_assign{'fsys'}) {
3092: return;
1.587 raeburn 3093: } elsif ($authtype eq '') {
1.591 raeburn 3094: if (defined($in{'mode'})) {
1.587 raeburn 3095: if ($in{'mode'} eq 'modifycourse') {
3096: if ($authnum == 1) {
1.1104 raeburn 3097: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3098: }
3099: }
3100: }
1.586 raeburn 3101: }
3102: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3103: if ($authtype eq '') {
3104: $authtype = '<input type="radio" name="login" value="fsys" '.
3105: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3106: $jscall.'" />';
3107: }
3108: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3109: ' onchange="'.$jscall.'" />';
3110: $result = &mt
1.144 matthew 3111: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3112: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3113: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3114: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3115: 'onchange="'.$jscall.'" />');
1.32 matthew 3116: return $result;
3117: }
3118:
1.586 raeburn 3119: sub get_assignable_auth {
3120: my ($dom) = @_;
3121: if ($dom eq '') {
3122: $dom = $env{'request.role.domain'};
3123: }
3124: my %can_assign = (
3125: krb4 => 1,
3126: krb5 => 1,
3127: int => 1,
3128: loc => 1,
3129: );
3130: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3131: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3132: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3133: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3134: my $context;
3135: if ($env{'request.role'} =~ /^au/) {
3136: $context = 'author';
3137: } elsif ($env{'request.role'} =~ /^dc/) {
3138: $context = 'domain';
3139: } elsif ($env{'request.course.id'}) {
3140: $context = 'course';
3141: }
3142: if ($context) {
3143: if (ref($authhash->{$context}) eq 'HASH') {
3144: %can_assign = %{$authhash->{$context}};
3145: }
3146: }
3147: }
3148: }
3149: my $authnum = 0;
3150: foreach my $key (keys(%can_assign)) {
3151: if ($can_assign{$key}) {
3152: $authnum ++;
3153: }
3154: }
3155: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3156: $authnum --;
3157: }
3158: return ($authnum,%can_assign);
3159: }
3160:
1.80 albertel 3161: ###############################################################
3162: ## Get Kerberos Defaults for Domain ##
3163: ###############################################################
3164: ##
3165: ## Returns default kerberos version and an associated argument
3166: ## as listed in file domain.tab. If not listed, provides
3167: ## appropriate default domain and kerberos version.
3168: ##
3169: #-------------------------------------------
3170:
3171: =pod
3172:
1.648 raeburn 3173: =item * &get_kerberos_defaults()
1.80 albertel 3174:
3175: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3176: version and domain. If not found, it defaults to version 4 and the
3177: domain of the server.
1.80 albertel 3178:
1.648 raeburn 3179: =over 4
3180:
1.80 albertel 3181: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3182:
1.648 raeburn 3183: =back
3184:
3185: =back
3186:
1.80 albertel 3187: =cut
3188:
3189: #-------------------------------------------
3190: sub get_kerberos_defaults {
3191: my $domain=shift;
1.641 raeburn 3192: my ($krbdef,$krbdefdom);
3193: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3194: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3195: $krbdef = $domdefaults{'auth_def'};
3196: $krbdefdom = $domdefaults{'auth_arg_def'};
3197: } else {
1.80 albertel 3198: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3199: my $krbdefdom=$1;
3200: $krbdefdom=~tr/a-z/A-Z/;
3201: $krbdef = "krb4";
3202: }
3203: return ($krbdef,$krbdefdom);
3204: }
1.112 bowersj2 3205:
1.32 matthew 3206:
1.46 matthew 3207: ###############################################################
3208: ## Thesaurus Functions ##
3209: ###############################################################
1.20 www 3210:
1.46 matthew 3211: =pod
1.20 www 3212:
1.112 bowersj2 3213: =head1 Thesaurus Functions
3214:
3215: =over 4
3216:
1.648 raeburn 3217: =item * &initialize_keywords()
1.46 matthew 3218:
3219: Initializes the package variable %Keywords if it is empty. Uses the
3220: package variable $thesaurus_db_file.
3221:
3222: =cut
3223:
3224: ###################################################
3225:
3226: sub initialize_keywords {
3227: return 1 if (scalar keys(%Keywords));
3228: # If we are here, %Keywords is empty, so fill it up
3229: # Make sure the file we need exists...
3230: if (! -e $thesaurus_db_file) {
3231: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3232: " failed because it does not exist");
3233: return 0;
3234: }
3235: # Set up the hash as a database
3236: my %thesaurus_db;
3237: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3238: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3239: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3240: $thesaurus_db_file);
3241: return 0;
3242: }
3243: # Get the average number of appearances of a word.
3244: my $avecount = $thesaurus_db{'average.count'};
3245: # Put keywords (those that appear > average) into %Keywords
3246: while (my ($word,$data)=each (%thesaurus_db)) {
3247: my ($count,undef) = split /:/,$data;
3248: $Keywords{$word}++ if ($count > $avecount);
3249: }
3250: untie %thesaurus_db;
3251: # Remove special values from %Keywords.
1.356 albertel 3252: foreach my $value ('total.count','average.count') {
3253: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3254: }
1.46 matthew 3255: return 1;
3256: }
3257:
3258: ###################################################
3259:
3260: =pod
3261:
1.648 raeburn 3262: =item * &keyword($word)
1.46 matthew 3263:
3264: Returns true if $word is a keyword. A keyword is a word that appears more
3265: than the average number of times in the thesaurus database. Calls
3266: &initialize_keywords
3267:
3268: =cut
3269:
3270: ###################################################
1.20 www 3271:
3272: sub keyword {
1.46 matthew 3273: return if (!&initialize_keywords());
3274: my $word=lc(shift());
3275: $word=~s/\W//g;
3276: return exists($Keywords{$word});
1.20 www 3277: }
1.46 matthew 3278:
3279: ###############################################################
3280:
3281: =pod
1.20 www 3282:
1.648 raeburn 3283: =item * &get_related_words()
1.46 matthew 3284:
1.160 matthew 3285: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3286: an array of words. If the keyword is not in the thesaurus, an empty array
3287: will be returned. The order of the words returned is determined by the
3288: database which holds them.
3289:
3290: Uses global $thesaurus_db_file.
3291:
1.1057 foxr 3292:
1.46 matthew 3293: =cut
3294:
3295: ###############################################################
3296: sub get_related_words {
3297: my $keyword = shift;
3298: my %thesaurus_db;
3299: if (! -e $thesaurus_db_file) {
3300: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3301: "failed because the file does not exist");
3302: return ();
3303: }
3304: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3305: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3306: return ();
3307: }
3308: my @Words=();
1.429 www 3309: my $count=0;
1.46 matthew 3310: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3311: # The first element is the number of times
3312: # the word appears. We do not need it now.
1.429 www 3313: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3314: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3315: my $threshold=$mostfrequentcount/10;
3316: foreach my $possibleword (@RelatedWords) {
3317: my ($word,$wordcount)=split(/\,/,$possibleword);
3318: if ($wordcount>$threshold) {
3319: push(@Words,$word);
3320: $count++;
3321: if ($count>10) { last; }
3322: }
1.20 www 3323: }
3324: }
1.46 matthew 3325: untie %thesaurus_db;
3326: return @Words;
1.14 harris41 3327: }
1.1090 foxr 3328: ###############################################################
3329: #
3330: # Spell checking
3331: #
3332:
3333: =pod
3334:
1.1142 raeburn 3335: =back
3336:
1.1090 foxr 3337: =head1 Spell checking
3338:
3339: =over 4
3340:
3341: =item * &check_spelling($wordlist $language)
3342:
3343: Takes a string containing words and feeds it to an external
3344: spellcheck program via a pipeline. Returns a string containing
3345: them mis-spelled words.
3346:
3347: Parameters:
3348:
3349: =over 4
3350:
3351: =item - $wordlist
3352:
3353: String that will be fed into the spellcheck program.
3354:
3355: =item - $language
3356:
3357: Language string that specifies the language for which the spell
3358: check will be performed.
3359:
3360: =back
3361:
3362: =back
3363:
3364: Note: This sub assumes that aspell is installed.
3365:
3366:
3367: =cut
3368:
1.46 matthew 3369:
1.1090 foxr 3370: sub check_spelling {
3371: my ($wordlist, $language) = @_;
1.1091 foxr 3372: my @misspellings;
3373:
3374: # Generate the speller and set the langauge.
3375: # if explicitly selected:
1.1090 foxr 3376:
1.1091 foxr 3377: my $speller = Text::Aspell->new;
1.1090 foxr 3378: if ($language) {
1.1091 foxr 3379: $speller->set_option('lang', $language);
1.1090 foxr 3380: }
3381:
1.1091 foxr 3382: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3383:
1.1091 foxr 3384: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3385:
1.1091 foxr 3386: foreach my $word (@words) {
3387: if(! $speller->check($word)) {
3388: push(@misspellings, $word);
1.1090 foxr 3389: }
3390: }
1.1091 foxr 3391: return join(' ', @misspellings);
3392:
1.1090 foxr 3393: }
3394:
1.61 www 3395: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3396: =pod
3397:
1.112 bowersj2 3398: =head1 User Name Functions
3399:
3400: =over 4
3401:
1.648 raeburn 3402: =item * &plainname($uname,$udom,$first)
1.81 albertel 3403:
1.112 bowersj2 3404: Takes a users logon name and returns it as a string in
1.226 albertel 3405: "first middle last generation" form
3406: if $first is set to 'lastname' then it returns it as
3407: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3408:
3409: =cut
1.61 www 3410:
1.295 www 3411:
1.81 albertel 3412: ###############################################################
1.61 www 3413: sub plainname {
1.226 albertel 3414: my ($uname,$udom,$first)=@_;
1.537 albertel 3415: return if (!defined($uname) || !defined($udom));
1.295 www 3416: my %names=&getnames($uname,$udom);
1.226 albertel 3417: my $name=&Apache::lonnet::format_name($names{'firstname'},
3418: $names{'middlename'},
3419: $names{'lastname'},
3420: $names{'generation'},$first);
3421: $name=~s/^\s+//;
1.62 www 3422: $name=~s/\s+$//;
3423: $name=~s/\s+/ /g;
1.353 albertel 3424: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3425: return $name;
1.61 www 3426: }
1.66 www 3427:
3428: # -------------------------------------------------------------------- Nickname
1.81 albertel 3429: =pod
3430:
1.648 raeburn 3431: =item * &nickname($uname,$udom)
1.81 albertel 3432:
3433: Gets a users name and returns it as a string as
3434:
3435: ""nickname""
1.66 www 3436:
1.81 albertel 3437: if the user has a nickname or
3438:
3439: "first middle last generation"
3440:
3441: if the user does not
3442:
3443: =cut
1.66 www 3444:
3445: sub nickname {
3446: my ($uname,$udom)=@_;
1.537 albertel 3447: return if (!defined($uname) || !defined($udom));
1.295 www 3448: my %names=&getnames($uname,$udom);
1.68 albertel 3449: my $name=$names{'nickname'};
1.66 www 3450: if ($name) {
3451: $name='"'.$name.'"';
3452: } else {
3453: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3454: $names{'lastname'}.' '.$names{'generation'};
3455: $name=~s/\s+$//;
3456: $name=~s/\s+/ /g;
3457: }
3458: return $name;
3459: }
3460:
1.295 www 3461: sub getnames {
3462: my ($uname,$udom)=@_;
1.537 albertel 3463: return if (!defined($uname) || !defined($udom));
1.433 albertel 3464: if ($udom eq 'public' && $uname eq 'public') {
3465: return ('lastname' => &mt('Public'));
3466: }
1.295 www 3467: my $id=$uname.':'.$udom;
3468: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3469: if ($cached) {
3470: return %{$names};
3471: } else {
3472: my %loadnames=&Apache::lonnet::get('environment',
3473: ['firstname','middlename','lastname','generation','nickname'],
3474: $udom,$uname);
3475: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3476: return %loadnames;
3477: }
3478: }
1.61 www 3479:
1.542 raeburn 3480: # -------------------------------------------------------------------- getemails
1.648 raeburn 3481:
1.542 raeburn 3482: =pod
3483:
1.648 raeburn 3484: =item * &getemails($uname,$udom)
1.542 raeburn 3485:
3486: Gets a user's email information and returns it as a hash with keys:
3487: notification, critnotification, permanentemail
3488:
3489: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3490: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3491:
1.648 raeburn 3492:
1.542 raeburn 3493: =cut
3494:
1.648 raeburn 3495:
1.466 albertel 3496: sub getemails {
3497: my ($uname,$udom)=@_;
3498: if ($udom eq 'public' && $uname eq 'public') {
3499: return;
3500: }
1.467 www 3501: if (!$udom) { $udom=$env{'user.domain'}; }
3502: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3503: my $id=$uname.':'.$udom;
3504: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3505: if ($cached) {
3506: return %{$names};
3507: } else {
3508: my %loadnames=&Apache::lonnet::get('environment',
3509: ['notification','critnotification',
3510: 'permanentemail'],
3511: $udom,$uname);
3512: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3513: return %loadnames;
3514: }
3515: }
3516:
1.551 albertel 3517: sub flush_email_cache {
3518: my ($uname,$udom)=@_;
3519: if (!$udom) { $udom =$env{'user.domain'}; }
3520: if (!$uname) { $uname=$env{'user.name'}; }
3521: return if ($udom eq 'public' && $uname eq 'public');
3522: my $id=$uname.':'.$udom;
3523: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3524: }
3525:
1.728 raeburn 3526: # -------------------------------------------------------------------- getlangs
3527:
3528: =pod
3529:
3530: =item * &getlangs($uname,$udom)
3531:
3532: Gets a user's language preference and returns it as a hash with key:
3533: language.
3534:
3535: =cut
3536:
3537:
3538: sub getlangs {
3539: my ($uname,$udom) = @_;
3540: if (!$udom) { $udom =$env{'user.domain'}; }
3541: if (!$uname) { $uname=$env{'user.name'}; }
3542: my $id=$uname.':'.$udom;
3543: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3544: if ($cached) {
3545: return %{$langs};
3546: } else {
3547: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3548: $udom,$uname);
3549: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3550: return %loadlangs;
3551: }
3552: }
3553:
3554: sub flush_langs_cache {
3555: my ($uname,$udom)=@_;
3556: if (!$udom) { $udom =$env{'user.domain'}; }
3557: if (!$uname) { $uname=$env{'user.name'}; }
3558: return if ($udom eq 'public' && $uname eq 'public');
3559: my $id=$uname.':'.$udom;
3560: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3561: }
3562:
1.61 www 3563: # ------------------------------------------------------------------ Screenname
1.81 albertel 3564:
3565: =pod
3566:
1.648 raeburn 3567: =item * &screenname($uname,$udom)
1.81 albertel 3568:
3569: Gets a users screenname and returns it as a string
3570:
3571: =cut
1.61 www 3572:
3573: sub screenname {
3574: my ($uname,$udom)=@_;
1.258 albertel 3575: if ($uname eq $env{'user.name'} &&
3576: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3577: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3578: return $names{'screenname'};
1.62 www 3579: }
3580:
1.212 albertel 3581:
1.802 bisitz 3582: # ------------------------------------------------------------- Confirm Wrapper
3583: =pod
3584:
1.1142 raeburn 3585: =item * &confirmwrapper($message)
1.802 bisitz 3586:
3587: Wrap messages about completion of operation in box
3588:
3589: =cut
3590:
3591: sub confirmwrapper {
3592: my ($message)=@_;
3593: if ($message) {
3594: return "\n".'<div class="LC_confirm_box">'."\n"
3595: .$message."\n"
3596: .'</div>'."\n";
3597: } else {
3598: return $message;
3599: }
3600: }
3601:
1.62 www 3602: # ------------------------------------------------------------- Message Wrapper
3603:
3604: sub messagewrapper {
1.369 www 3605: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3606: return
1.441 albertel 3607: '<a href="/adm/email?compose=individual&'.
3608: 'recname='.$username.'&recdom='.$domain.
3609: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3610: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3611: }
1.802 bisitz 3612:
1.74 www 3613: # --------------------------------------------------------------- Notes Wrapper
3614:
3615: sub noteswrapper {
3616: my ($link,$un,$do)=@_;
3617: return
1.896 amueller 3618: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3619: }
1.802 bisitz 3620:
1.62 www 3621: # ------------------------------------------------------------- Aboutme Wrapper
3622:
3623: sub aboutmewrapper {
1.1070 raeburn 3624: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3625: if (!defined($username) && !defined($domain)) {
3626: return;
3627: }
1.1096 raeburn 3628: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3629: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3630: }
3631:
3632: # ------------------------------------------------------------ Syllabus Wrapper
3633:
3634: sub syllabuswrapper {
1.707 bisitz 3635: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3636: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3637: }
1.14 harris41 3638:
1.802 bisitz 3639: # -----------------------------------------------------------------------------
3640:
1.208 matthew 3641: sub track_student_link {
1.887 raeburn 3642: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3643: my $link ="/adm/trackstudent?";
1.208 matthew 3644: my $title = 'View recent activity';
3645: if (defined($sname) && $sname !~ /^\s*$/ &&
3646: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3647: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3648: $title .= ' of this student';
1.268 albertel 3649: }
1.208 matthew 3650: if (defined($target) && $target !~ /^\s*$/) {
3651: $target = qq{target="$target"};
3652: } else {
3653: $target = '';
3654: }
1.268 albertel 3655: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3656: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3657: $title = &mt($title);
3658: $linktext = &mt($linktext);
1.448 albertel 3659: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3660: &help_open_topic('View_recent_activity');
1.208 matthew 3661: }
3662:
1.781 raeburn 3663: sub slot_reservations_link {
3664: my ($linktext,$sname,$sdom,$target) = @_;
3665: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3666: my $title = 'View slot reservation history';
3667: if (defined($sname) && $sname !~ /^\s*$/ &&
3668: defined($sdom) && $sdom !~ /^\s*$/) {
3669: $link .= "&uname=$sname&udom=$sdom";
3670: $title .= ' of this student';
3671: }
3672: if (defined($target) && $target !~ /^\s*$/) {
3673: $target = qq{target="$target"};
3674: } else {
3675: $target = '';
3676: }
3677: $title = &mt($title);
3678: $linktext = &mt($linktext);
3679: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3680: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3681:
3682: }
3683:
1.508 www 3684: # ===================================================== Display a student photo
3685:
3686:
1.509 albertel 3687: sub student_image_tag {
1.508 www 3688: my ($domain,$user)=@_;
3689: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3690: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3691: return '<img src="'.$imgsrc.'" align="right" />';
3692: } else {
3693: return '';
3694: }
3695: }
3696:
1.112 bowersj2 3697: =pod
3698:
3699: =back
3700:
3701: =head1 Access .tab File Data
3702:
3703: =over 4
3704:
1.648 raeburn 3705: =item * &languageids()
1.112 bowersj2 3706:
3707: returns list of all language ids
3708:
3709: =cut
3710:
1.14 harris41 3711: sub languageids {
1.16 harris41 3712: return sort(keys(%language));
1.14 harris41 3713: }
3714:
1.112 bowersj2 3715: =pod
3716:
1.648 raeburn 3717: =item * &languagedescription()
1.112 bowersj2 3718:
3719: returns description of a specified language id
3720:
3721: =cut
3722:
1.14 harris41 3723: sub languagedescription {
1.125 www 3724: my $code=shift;
3725: return ($supported_language{$code}?'* ':'').
3726: $language{$code}.
1.126 www 3727: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3728: }
3729:
1.1048 foxr 3730: =pod
3731:
3732: =item * &plainlanguagedescription
3733:
3734: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3735: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3736:
3737: =cut
3738:
1.145 www 3739: sub plainlanguagedescription {
3740: my $code=shift;
3741: return $language{$code};
3742: }
3743:
1.1048 foxr 3744: =pod
3745:
3746: =item * &supportedlanguagecode
3747:
3748: Returns the supported language code (e.g. sptutf maps to pt) given a language
3749: code.
3750:
3751: =cut
3752:
1.145 www 3753: sub supportedlanguagecode {
3754: my $code=shift;
3755: return $supported_language{$code};
1.97 www 3756: }
3757:
1.112 bowersj2 3758: =pod
3759:
1.1048 foxr 3760: =item * &latexlanguage()
3761:
3762: Given a language key code returns the correspondnig language to use
3763: to select the correct hyphenation on LaTeX printouts. This is undef if there
3764: is no supported hyphenation for the language code.
3765:
3766: =cut
3767:
3768: sub latexlanguage {
3769: my $code = shift;
3770: return $latex_language{$code};
3771: }
3772:
3773: =pod
3774:
3775: =item * &latexhyphenation()
3776:
3777: Same as above but what's supplied is the language as it might be stored
3778: in the metadata.
3779:
3780: =cut
3781:
3782: sub latexhyphenation {
3783: my $key = shift;
3784: return $latex_language_bykey{$key};
3785: }
3786:
3787: =pod
3788:
1.648 raeburn 3789: =item * ©rightids()
1.112 bowersj2 3790:
3791: returns list of all copyrights
3792:
3793: =cut
3794:
3795: sub copyrightids {
3796: return sort(keys(%cprtag));
3797: }
3798:
3799: =pod
3800:
1.648 raeburn 3801: =item * ©rightdescription()
1.112 bowersj2 3802:
3803: returns description of a specified copyright id
3804:
3805: =cut
3806:
3807: sub copyrightdescription {
1.166 www 3808: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3809: }
1.197 matthew 3810:
3811: =pod
3812:
1.648 raeburn 3813: =item * &source_copyrightids()
1.192 taceyjo1 3814:
3815: returns list of all source copyrights
3816:
3817: =cut
3818:
3819: sub source_copyrightids {
3820: return sort(keys(%scprtag));
3821: }
3822:
3823: =pod
3824:
1.648 raeburn 3825: =item * &source_copyrightdescription()
1.192 taceyjo1 3826:
3827: returns description of a specified source copyright id
3828:
3829: =cut
3830:
3831: sub source_copyrightdescription {
3832: return &mt($scprtag{shift(@_)});
3833: }
1.112 bowersj2 3834:
3835: =pod
3836:
1.648 raeburn 3837: =item * &filecategories()
1.112 bowersj2 3838:
3839: returns list of all file categories
3840:
3841: =cut
3842:
3843: sub filecategories {
3844: return sort(keys(%category_extensions));
3845: }
3846:
3847: =pod
3848:
1.648 raeburn 3849: =item * &filecategorytypes()
1.112 bowersj2 3850:
3851: returns list of file types belonging to a given file
3852: category
3853:
3854: =cut
3855:
3856: sub filecategorytypes {
1.356 albertel 3857: my ($cat) = @_;
3858: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3859: }
3860:
3861: =pod
3862:
1.648 raeburn 3863: =item * &fileembstyle()
1.112 bowersj2 3864:
3865: returns embedding style for a specified file type
3866:
3867: =cut
3868:
3869: sub fileembstyle {
3870: return $fe{lc(shift(@_))};
1.169 www 3871: }
3872:
1.351 www 3873: sub filemimetype {
3874: return $fm{lc(shift(@_))};
3875: }
3876:
1.169 www 3877:
3878: sub filecategoryselect {
3879: my ($name,$value)=@_;
1.189 matthew 3880: return &select_form($value,$name,
1.970 raeburn 3881: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3882: }
3883:
3884: =pod
3885:
1.648 raeburn 3886: =item * &filedescription()
1.112 bowersj2 3887:
3888: returns description for a specified file type
3889:
3890: =cut
3891:
3892: sub filedescription {
1.188 matthew 3893: my $file_description = $fd{lc(shift())};
3894: $file_description =~ s:([\[\]]):~$1:g;
3895: return &mt($file_description);
1.112 bowersj2 3896: }
3897:
3898: =pod
3899:
1.648 raeburn 3900: =item * &filedescriptionex()
1.112 bowersj2 3901:
3902: returns description for a specified file type with
3903: extra formatting
3904:
3905: =cut
3906:
3907: sub filedescriptionex {
3908: my $ex=shift;
1.188 matthew 3909: my $file_description = $fd{lc($ex)};
3910: $file_description =~ s:([\[\]]):~$1:g;
3911: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3912: }
3913:
3914: # End of .tab access
3915: =pod
3916:
3917: =back
3918:
3919: =cut
3920:
3921: # ------------------------------------------------------------------ File Types
3922: sub fileextensions {
3923: return sort(keys(%fe));
3924: }
3925:
1.97 www 3926: # ----------------------------------------------------------- Display Languages
3927: # returns a hash with all desired display languages
3928: #
3929:
3930: sub display_languages {
3931: my %languages=();
1.695 raeburn 3932: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3933: $languages{$lang}=1;
1.97 www 3934: }
3935: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3936: if ($env{'form.displaylanguage'}) {
1.356 albertel 3937: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3938: $languages{$lang}=1;
1.97 www 3939: }
3940: }
3941: return %languages;
1.14 harris41 3942: }
3943:
1.582 albertel 3944: sub languages {
3945: my ($possible_langs) = @_;
1.695 raeburn 3946: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3947: if (!ref($possible_langs)) {
3948: if( wantarray ) {
3949: return @preferred_langs;
3950: } else {
3951: return $preferred_langs[0];
3952: }
3953: }
3954: my %possibilities = map { $_ => 1 } (@$possible_langs);
3955: my @preferred_possibilities;
3956: foreach my $preferred_lang (@preferred_langs) {
3957: if (exists($possibilities{$preferred_lang})) {
3958: push(@preferred_possibilities, $preferred_lang);
3959: }
3960: }
3961: if( wantarray ) {
3962: return @preferred_possibilities;
3963: }
3964: return $preferred_possibilities[0];
3965: }
3966:
1.742 raeburn 3967: sub user_lang {
3968: my ($touname,$toudom,$fromcid) = @_;
3969: my @userlangs;
3970: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3971: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3972: $env{'course.'.$fromcid.'.languages'}));
3973: } else {
3974: my %langhash = &getlangs($touname,$toudom);
3975: if ($langhash{'languages'} ne '') {
3976: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3977: } else {
3978: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3979: if ($domdefs{'lang_def'} ne '') {
3980: @userlangs = ($domdefs{'lang_def'});
3981: }
3982: }
3983: }
3984: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3985: my $user_lh = Apache::localize->get_handle(@languages);
3986: return $user_lh;
3987: }
3988:
3989:
1.112 bowersj2 3990: ###############################################################
3991: ## Student Answer Attempts ##
3992: ###############################################################
3993:
3994: =pod
3995:
3996: =head1 Alternate Problem Views
3997:
3998: =over 4
3999:
1.648 raeburn 4000: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4001: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4002:
4003: Return string with previous attempt on problem. Arguments:
4004:
4005: =over 4
4006:
4007: =item * $symb: Problem, including path
4008:
4009: =item * $username: username of the desired student
4010:
4011: =item * $domain: domain of the desired student
1.14 harris41 4012:
1.112 bowersj2 4013: =item * $course: Course ID
1.14 harris41 4014:
1.112 bowersj2 4015: =item * $getattempt: Leave blank for all attempts, otherwise put
4016: something
1.14 harris41 4017:
1.112 bowersj2 4018: =item * $regexp: if string matches this regexp, the string will be
4019: sent to $gradesub
1.14 harris41 4020:
1.112 bowersj2 4021: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4022:
1.1199 raeburn 4023: =item * $usec: section of the desired student
4024:
4025: =item * $identifier: counter for student (multiple students one problem) or
4026: problem (one student; whole sequence).
4027:
1.112 bowersj2 4028: =back
1.14 harris41 4029:
1.112 bowersj2 4030: The output string is a table containing all desired attempts, if any.
1.16 harris41 4031:
1.112 bowersj2 4032: =cut
1.1 albertel 4033:
4034: sub get_previous_attempt {
1.1199 raeburn 4035: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4036: my $prevattempts='';
1.43 ng 4037: no strict 'refs';
1.1 albertel 4038: if ($symb) {
1.3 albertel 4039: my (%returnhash)=
4040: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4041: if ($returnhash{'version'}) {
4042: my %lasthash=();
4043: my $version;
4044: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4045: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4046: if ($key =~ /\.rawrndseed$/) {
4047: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4048: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4049: } else {
4050: $lasthash{$key}=$returnhash{$version.':'.$key};
4051: }
1.19 harris41 4052: }
1.1 albertel 4053: }
1.596 albertel 4054: $prevattempts=&start_data_table().&start_data_table_header_row();
4055: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4056: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4057: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4058: foreach my $key (sort(keys(%lasthash))) {
4059: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4060: if ($#parts > 0) {
1.31 albertel 4061: my $data=$parts[-1];
1.989 raeburn 4062: next if ($data eq 'foilorder');
1.31 albertel 4063: pop(@parts);
1.1010 www 4064: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4065: if ($data eq 'type') {
4066: unless ($showsurv) {
4067: my $id = join(',',@parts);
4068: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4069: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4070: $lasthidden{$ign.'.'.$id} = 1;
4071: }
1.945 raeburn 4072: }
1.1199 raeburn 4073: if ($identifier ne '') {
4074: my $id = join(',',@parts);
4075: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4076: $domain,$username,$usec,undef,$course) =~ /^no/) {
4077: $hidestatus{$ign.'.'.$id} = 1;
4078: }
4079: }
4080: } elsif ($data eq 'regrader') {
4081: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4082: my $id = join(',',@parts);
4083: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4084: }
1.1010 www 4085: }
1.31 albertel 4086: } else {
1.41 ng 4087: if ($#parts == 0) {
4088: $prevattempts.='<th>'.$parts[0].'</th>';
4089: } else {
4090: $prevattempts.='<th>'.$ign.'</th>';
4091: }
1.31 albertel 4092: }
1.16 harris41 4093: }
1.596 albertel 4094: $prevattempts.=&end_data_table_header_row();
1.40 ng 4095: if ($getattempt eq '') {
1.1199 raeburn 4096: my (%solved,%resets,%probstatus);
1.1200 raeburn 4097: if (($identifier ne '') && (keys(%regraded) > 0)) {
4098: for ($version=1;$version<=$returnhash{'version'};$version++) {
4099: foreach my $id (keys(%regraded)) {
4100: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4101: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4102: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4103: push(@{$resets{$id}},$version);
1.1199 raeburn 4104: }
4105: }
4106: }
1.1200 raeburn 4107: }
4108: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4109: my (@hidden,@unsolved);
1.945 raeburn 4110: if (%typeparts) {
4111: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4112: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4113: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4114: push(@hidden,$id);
1.1199 raeburn 4115: } elsif ($identifier ne '') {
4116: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4117: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4118: ($hidestatus{$id})) {
1.1200 raeburn 4119: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4120: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4121: push(@{$solved{$id}},$version);
4122: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4123: (ref($solved{$id}) eq 'ARRAY')) {
4124: my $skip;
4125: if (ref($resets{$id}) eq 'ARRAY') {
4126: foreach my $reset (@{$resets{$id}}) {
4127: if ($reset > $solved{$id}[-1]) {
4128: $skip=1;
4129: last;
4130: }
4131: }
4132: }
4133: unless ($skip) {
4134: my ($ign,$partslist) = split(/\./,$id,2);
4135: push(@unsolved,$partslist);
4136: }
4137: }
4138: }
1.945 raeburn 4139: }
4140: }
4141: }
4142: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4143: '<td>'.&mt('Transaction [_1]',$version);
4144: if (@unsolved) {
4145: $prevattempts .= '<span class="LC_nobreak"><label>'.
4146: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4147: &mt('Hide').'</label></span>';
4148: }
4149: $prevattempts .= '</td>';
1.945 raeburn 4150: if (@hidden) {
4151: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4152: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4153: my $hide;
4154: foreach my $id (@hidden) {
4155: if ($key =~ /^\Q$id\E/) {
4156: $hide = 1;
4157: last;
4158: }
4159: }
4160: if ($hide) {
4161: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4162: if (($data eq 'award') || ($data eq 'awarddetail')) {
4163: my $value = &format_previous_attempt_value($key,
4164: $returnhash{$version.':'.$key});
1.1173 kruse 4165: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4166: } else {
4167: $prevattempts.='<td> </td>';
4168: }
4169: } else {
4170: if ($key =~ /\./) {
1.1212 raeburn 4171: my $value = $returnhash{$version.':'.$key};
4172: if ($key =~ /\.rndseed$/) {
4173: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4174: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4175: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4176: }
4177: }
4178: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4179: ' </td>';
1.945 raeburn 4180: } else {
4181: $prevattempts.='<td> </td>';
4182: }
4183: }
4184: }
4185: } else {
4186: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4187: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4188: my $value = $returnhash{$version.':'.$key};
4189: if ($key =~ /\.rndseed$/) {
4190: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4191: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4192: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4193: }
4194: }
4195: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4196: ' </td>';
1.945 raeburn 4197: }
4198: }
4199: $prevattempts.=&end_data_table_row();
1.40 ng 4200: }
1.1 albertel 4201: }
1.945 raeburn 4202: my @currhidden = keys(%lasthidden);
1.596 albertel 4203: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4204: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4205: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4206: if (%typeparts) {
4207: my $hidden;
4208: foreach my $id (@currhidden) {
4209: if ($key =~ /^\Q$id\E/) {
4210: $hidden = 1;
4211: last;
4212: }
4213: }
4214: if ($hidden) {
4215: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4216: if (($data eq 'award') || ($data eq 'awarddetail')) {
4217: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4218: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4219: $value = &$gradesub($value);
4220: }
1.1173 kruse 4221: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4222: } else {
4223: $prevattempts.='<td> </td>';
4224: }
4225: } else {
4226: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4227: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4228: $value = &$gradesub($value);
4229: }
1.1173 kruse 4230: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4231: }
4232: } else {
4233: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4234: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4235: $value = &$gradesub($value);
4236: }
1.1173 kruse 4237: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4238: }
1.16 harris41 4239: }
1.596 albertel 4240: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4241: } else {
1.596 albertel 4242: $prevattempts=
4243: &start_data_table().&start_data_table_row().
4244: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4245: &end_data_table_row().&end_data_table();
1.1 albertel 4246: }
4247: } else {
1.596 albertel 4248: $prevattempts=
4249: &start_data_table().&start_data_table_row().
4250: '<td>'.&mt('No data.').'</td>'.
4251: &end_data_table_row().&end_data_table();
1.1 albertel 4252: }
1.10 albertel 4253: }
4254:
1.581 albertel 4255: sub format_previous_attempt_value {
4256: my ($key,$value) = @_;
1.1011 www 4257: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4258: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4259: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4260: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4261: } elsif ($key =~ /answerstring$/) {
4262: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4263: my @answer = %answers;
4264: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4265: my @anskeys = sort(keys(%answers));
4266: if (@anskeys == 1) {
4267: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4268: if ($answer =~ m{\0}) {
4269: $answer =~ s{\0}{,}g;
1.988 raeburn 4270: }
4271: my $tag_internal_answer_name = 'INTERNAL';
4272: if ($anskeys[0] eq $tag_internal_answer_name) {
4273: $value = $answer;
4274: } else {
4275: $value = $anskeys[0].'='.$answer;
4276: }
4277: } else {
4278: foreach my $ans (@anskeys) {
4279: my $answer = $answers{$ans};
1.1001 raeburn 4280: if ($answer =~ m{\0}) {
4281: $answer =~ s{\0}{,}g;
1.988 raeburn 4282: }
4283: $value .= $ans.'='.$answer.'<br />';;
4284: }
4285: }
1.581 albertel 4286: } else {
1.1173 kruse 4287: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4288: }
4289: return $value;
4290: }
4291:
4292:
1.107 albertel 4293: sub relative_to_absolute {
4294: my ($url,$output)=@_;
4295: my $parser=HTML::TokeParser->new(\$output);
4296: my $token;
4297: my $thisdir=$url;
4298: my @rlinks=();
4299: while ($token=$parser->get_token) {
4300: if ($token->[0] eq 'S') {
4301: if ($token->[1] eq 'a') {
4302: if ($token->[2]->{'href'}) {
4303: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4304: }
4305: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4306: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4307: } elsif ($token->[1] eq 'base') {
4308: $thisdir=$token->[2]->{'href'};
4309: }
4310: }
4311: }
4312: $thisdir=~s-/[^/]*$--;
1.356 albertel 4313: foreach my $link (@rlinks) {
1.726 raeburn 4314: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4315: ($link=~/^\//) ||
4316: ($link=~/^javascript:/i) ||
4317: ($link=~/^mailto:/i) ||
4318: ($link=~/^\#/)) {
4319: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4320: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4321: }
4322: }
4323: # -------------------------------------------------- Deal with Applet codebases
4324: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4325: return $output;
4326: }
4327:
1.112 bowersj2 4328: =pod
4329:
1.648 raeburn 4330: =item * &get_student_view()
1.112 bowersj2 4331:
4332: show a snapshot of what student was looking at
4333:
4334: =cut
4335:
1.10 albertel 4336: sub get_student_view {
1.186 albertel 4337: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4338: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4339: my (%form);
1.10 albertel 4340: my @elements=('symb','courseid','domain','username');
4341: foreach my $element (@elements) {
1.186 albertel 4342: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4343: }
1.186 albertel 4344: if (defined($moreenv)) {
4345: %form=(%form,%{$moreenv});
4346: }
1.236 albertel 4347: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4348: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4349: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4350: $userview=~s/\<body[^\>]*\>//gi;
4351: $userview=~s/\<\/body\>//gi;
4352: $userview=~s/\<html\>//gi;
4353: $userview=~s/\<\/html\>//gi;
4354: $userview=~s/\<head\>//gi;
4355: $userview=~s/\<\/head\>//gi;
4356: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4357: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4358: if (wantarray) {
4359: return ($userview,$response);
4360: } else {
4361: return $userview;
4362: }
4363: }
4364:
4365: sub get_student_view_with_retries {
4366: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4367:
4368: my $ok = 0; # True if we got a good response.
4369: my $content;
4370: my $response;
4371:
4372: # Try to get the student_view done. within the retries count:
4373:
4374: do {
4375: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4376: $ok = $response->is_success;
4377: if (!$ok) {
4378: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4379: }
4380: $retries--;
4381: } while (!$ok && ($retries > 0));
4382:
4383: if (!$ok) {
4384: $content = ''; # On error return an empty content.
4385: }
1.651 www 4386: if (wantarray) {
4387: return ($content, $response);
4388: } else {
4389: return $content;
4390: }
1.11 albertel 4391: }
4392:
1.112 bowersj2 4393: =pod
4394:
1.648 raeburn 4395: =item * &get_student_answers()
1.112 bowersj2 4396:
4397: show a snapshot of how student was answering problem
4398:
4399: =cut
4400:
1.11 albertel 4401: sub get_student_answers {
1.100 sakharuk 4402: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4403: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4404: my (%moreenv);
1.11 albertel 4405: my @elements=('symb','courseid','domain','username');
4406: foreach my $element (@elements) {
1.186 albertel 4407: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4408: }
1.186 albertel 4409: $moreenv{'grade_target'}='answer';
4410: %moreenv=(%form,%moreenv);
1.497 raeburn 4411: $feedurl = &Apache::lonnet::clutter($feedurl);
4412: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4413: return $userview;
1.1 albertel 4414: }
1.116 albertel 4415:
4416: =pod
4417:
4418: =item * &submlink()
4419:
1.242 albertel 4420: Inputs: $text $uname $udom $symb $target
1.116 albertel 4421:
4422: Returns: A link to grades.pm such as to see the SUBM view of a student
4423:
4424: =cut
4425:
4426: ###############################################
4427: sub submlink {
1.242 albertel 4428: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4429: if (!($uname && $udom)) {
4430: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4431: &Apache::lonnet::whichuser($symb);
1.116 albertel 4432: if (!$symb) { $symb=$cursymb; }
4433: }
1.254 matthew 4434: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4435: $symb=&escape($symb);
1.960 bisitz 4436: if ($target) { $target=" target=\"$target\""; }
4437: return
4438: '<a href="/adm/grades?command=submission'.
4439: '&symb='.$symb.
4440: '&student='.$uname.
4441: '&userdom='.$udom.'"'.
4442: $target.'>'.$text.'</a>';
1.242 albertel 4443: }
4444: ##############################################
4445:
4446: =pod
4447:
4448: =item * &pgrdlink()
4449:
4450: Inputs: $text $uname $udom $symb $target
4451:
4452: Returns: A link to grades.pm such as to see the PGRD view of a student
4453:
4454: =cut
4455:
4456: ###############################################
4457: sub pgrdlink {
4458: my $link=&submlink(@_);
4459: $link=~s/(&command=submission)/$1&showgrading=yes/;
4460: return $link;
4461: }
4462: ##############################################
4463:
4464: =pod
4465:
4466: =item * &pprmlink()
4467:
4468: Inputs: $text $uname $udom $symb $target
4469:
4470: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4471: student and a specific resource
1.242 albertel 4472:
4473: =cut
4474:
4475: ###############################################
4476: sub pprmlink {
4477: my ($text,$uname,$udom,$symb,$target)=@_;
4478: if (!($uname && $udom)) {
4479: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4480: &Apache::lonnet::whichuser($symb);
1.242 albertel 4481: if (!$symb) { $symb=$cursymb; }
4482: }
1.254 matthew 4483: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4484: $symb=&escape($symb);
1.242 albertel 4485: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4486: return '<a href="/adm/parmset?command=set&'.
4487: 'symb='.$symb.'&uname='.$uname.
4488: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4489: }
4490: ##############################################
1.37 matthew 4491:
1.112 bowersj2 4492: =pod
4493:
4494: =back
4495:
4496: =cut
4497:
1.37 matthew 4498: ###############################################
1.51 www 4499:
4500:
4501: sub timehash {
1.687 raeburn 4502: my ($thistime) = @_;
4503: my $timezone = &Apache::lonlocal::gettimezone();
4504: my $dt = DateTime->from_epoch(epoch => $thistime)
4505: ->set_time_zone($timezone);
4506: my $wday = $dt->day_of_week();
4507: if ($wday == 7) { $wday = 0; }
4508: return ( 'second' => $dt->second(),
4509: 'minute' => $dt->minute(),
4510: 'hour' => $dt->hour(),
4511: 'day' => $dt->day_of_month(),
4512: 'month' => $dt->month(),
4513: 'year' => $dt->year(),
4514: 'weekday' => $wday,
4515: 'dayyear' => $dt->day_of_year(),
4516: 'dlsav' => $dt->is_dst() );
1.51 www 4517: }
4518:
1.370 www 4519: sub utc_string {
4520: my ($date)=@_;
1.371 www 4521: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4522: }
4523:
1.51 www 4524: sub maketime {
4525: my %th=@_;
1.687 raeburn 4526: my ($epoch_time,$timezone,$dt);
4527: $timezone = &Apache::lonlocal::gettimezone();
4528: eval {
4529: $dt = DateTime->new( year => $th{'year'},
4530: month => $th{'month'},
4531: day => $th{'day'},
4532: hour => $th{'hour'},
4533: minute => $th{'minute'},
4534: second => $th{'second'},
4535: time_zone => $timezone,
4536: );
4537: };
4538: if (!$@) {
4539: $epoch_time = $dt->epoch;
4540: if ($epoch_time) {
4541: return $epoch_time;
4542: }
4543: }
1.51 www 4544: return POSIX::mktime(
4545: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4546: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4547: }
4548:
4549: #########################################
1.51 www 4550:
4551: sub findallcourses {
1.482 raeburn 4552: my ($roles,$uname,$udom) = @_;
1.355 albertel 4553: my %roles;
4554: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4555: my %courses;
1.51 www 4556: my $now=time;
1.482 raeburn 4557: if (!defined($uname)) {
4558: $uname = $env{'user.name'};
4559: }
4560: if (!defined($udom)) {
4561: $udom = $env{'user.domain'};
4562: }
4563: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4564: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4565: if (!%roles) {
4566: %roles = (
4567: cc => 1,
1.907 raeburn 4568: co => 1,
1.482 raeburn 4569: in => 1,
4570: ep => 1,
4571: ta => 1,
4572: cr => 1,
4573: st => 1,
4574: );
4575: }
4576: foreach my $entry (keys(%roleshash)) {
4577: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4578: if ($trole =~ /^cr/) {
4579: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4580: } else {
4581: next if (!exists($roles{$trole}));
4582: }
4583: if ($tend) {
4584: next if ($tend < $now);
4585: }
4586: if ($tstart) {
4587: next if ($tstart > $now);
4588: }
1.1058 raeburn 4589: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4590: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4591: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4592: if ($secpart eq '') {
4593: ($cnum,$role) = split(/_/,$cnumpart);
4594: $sec = 'none';
1.1058 raeburn 4595: $value .= $cnum.'/';
1.482 raeburn 4596: } else {
4597: $cnum = $cnumpart;
4598: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4599: $value .= $cnum.'/'.$sec;
4600: }
4601: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4602: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4603: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4604: }
4605: } else {
4606: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4607: }
1.482 raeburn 4608: }
4609: } else {
4610: foreach my $key (keys(%env)) {
1.483 albertel 4611: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4612: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4613: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4614: next if ($role eq 'ca' || $role eq 'aa');
4615: next if (%roles && !exists($roles{$role}));
4616: my ($starttime,$endtime)=split(/\./,$env{$key});
4617: my $active=1;
4618: if ($starttime) {
4619: if ($now<$starttime) { $active=0; }
4620: }
4621: if ($endtime) {
4622: if ($now>$endtime) { $active=0; }
4623: }
4624: if ($active) {
1.1058 raeburn 4625: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4626: if ($sec eq '') {
4627: $sec = 'none';
1.1058 raeburn 4628: } else {
4629: $value .= $sec;
4630: }
4631: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4632: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4633: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4634: }
4635: } else {
4636: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4637: }
1.474 raeburn 4638: }
4639: }
1.51 www 4640: }
4641: }
1.474 raeburn 4642: return %courses;
1.51 www 4643: }
1.37 matthew 4644:
1.54 www 4645: ###############################################
1.474 raeburn 4646:
4647: sub blockcheck {
1.1189 raeburn 4648: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4649:
1.1189 raeburn 4650: if (defined($udom) && defined($uname)) {
4651: # If uname and udom are for a course, check for blocks in the course.
4652: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4653: my ($startblock,$endblock,$triggerblock) =
4654: &get_blocks($setters,$activity,$udom,$uname,$url);
4655: return ($startblock,$endblock,$triggerblock);
4656: }
4657: } else {
1.490 raeburn 4658: $udom = $env{'user.domain'};
4659: $uname = $env{'user.name'};
4660: }
4661:
1.502 raeburn 4662: my $startblock = 0;
4663: my $endblock = 0;
1.1062 raeburn 4664: my $triggerblock = '';
1.482 raeburn 4665: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4666:
1.490 raeburn 4667: # If uname is for a user, and activity is course-specific, i.e.,
4668: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4669:
1.490 raeburn 4670: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4671: $activity eq 'groups' || $activity eq 'printout') &&
4672: ($env{'request.course.id'})) {
1.490 raeburn 4673: foreach my $key (keys(%live_courses)) {
4674: if ($key ne $env{'request.course.id'}) {
4675: delete($live_courses{$key});
4676: }
4677: }
4678: }
4679:
4680: my $otheruser = 0;
4681: my %own_courses;
4682: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4683: # Resource belongs to user other than current user.
4684: $otheruser = 1;
4685: # Gather courses for current user
4686: %own_courses =
4687: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4688: }
4689:
4690: # Gather active course roles - course coordinator, instructor,
4691: # exam proctor, ta, student, or custom role.
1.474 raeburn 4692:
4693: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4694: my ($cdom,$cnum);
4695: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4696: $cdom = $env{'course.'.$course.'.domain'};
4697: $cnum = $env{'course.'.$course.'.num'};
4698: } else {
1.490 raeburn 4699: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4700: }
4701: my $no_ownblock = 0;
4702: my $no_userblock = 0;
1.533 raeburn 4703: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4704: # Check if current user has 'evb' priv for this
4705: if (defined($own_courses{$course})) {
4706: foreach my $sec (keys(%{$own_courses{$course}})) {
4707: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4708: if ($sec ne 'none') {
4709: $checkrole .= '/'.$sec;
4710: }
4711: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4712: $no_ownblock = 1;
4713: last;
4714: }
4715: }
4716: }
4717: # if they have 'evb' priv and are currently not playing student
4718: next if (($no_ownblock) &&
4719: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4720: }
1.474 raeburn 4721: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4722: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4723: if ($sec ne 'none') {
1.482 raeburn 4724: $checkrole .= '/'.$sec;
1.474 raeburn 4725: }
1.490 raeburn 4726: if ($otheruser) {
4727: # Resource belongs to user other than current user.
4728: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4729: my (%allroles,%userroles);
4730: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4731: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4732: my ($trole,$tdom,$tnum,$tsec);
4733: if ($entry =~ /^cr/) {
4734: ($trole,$tdom,$tnum,$tsec) =
4735: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4736: } else {
4737: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4738: }
4739: my ($spec,$area,$trest);
4740: $area = '/'.$tdom.'/'.$tnum;
4741: $trest = $tnum;
4742: if ($tsec ne '') {
4743: $area .= '/'.$tsec;
4744: $trest .= '/'.$tsec;
4745: }
4746: $spec = $trole.'.'.$area;
4747: if ($trole =~ /^cr/) {
4748: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4749: $tdom,$spec,$trest,$area);
4750: } else {
4751: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4752: $tdom,$spec,$trest,$area);
4753: }
4754: }
4755: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4756: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4757: if ($1) {
4758: $no_userblock = 1;
4759: last;
4760: }
1.486 raeburn 4761: }
4762: }
1.490 raeburn 4763: } else {
4764: # Resource belongs to current user
4765: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4766: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4767: $no_ownblock = 1;
4768: last;
4769: }
1.474 raeburn 4770: }
4771: }
4772: # if they have the evb priv and are currently not playing student
1.482 raeburn 4773: next if (($no_ownblock) &&
1.491 albertel 4774: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4775: next if ($no_userblock);
1.474 raeburn 4776:
1.866 kalberla 4777: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4778: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4779:
1.1062 raeburn 4780: my ($start,$end,$trigger) =
4781: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4782: if (($start != 0) &&
4783: (($startblock == 0) || ($startblock > $start))) {
4784: $startblock = $start;
1.1062 raeburn 4785: if ($trigger ne '') {
4786: $triggerblock = $trigger;
4787: }
1.502 raeburn 4788: }
4789: if (($end != 0) &&
4790: (($endblock == 0) || ($endblock < $end))) {
4791: $endblock = $end;
1.1062 raeburn 4792: if ($trigger ne '') {
4793: $triggerblock = $trigger;
4794: }
1.502 raeburn 4795: }
1.490 raeburn 4796: }
1.1062 raeburn 4797: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4798: }
4799:
4800: sub get_blocks {
1.1062 raeburn 4801: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4802: my $startblock = 0;
4803: my $endblock = 0;
1.1062 raeburn 4804: my $triggerblock = '';
1.490 raeburn 4805: my $course = $cdom.'_'.$cnum;
4806: $setters->{$course} = {};
4807: $setters->{$course}{'staff'} = [];
4808: $setters->{$course}{'times'} = [];
1.1062 raeburn 4809: $setters->{$course}{'triggers'} = [];
4810: my (@blockers,%triggered);
4811: my $now = time;
4812: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4813: if ($activity eq 'docs') {
4814: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4815: foreach my $block (@blockers) {
4816: if ($block =~ /^firstaccess____(.+)$/) {
4817: my $item = $1;
4818: my $type = 'map';
4819: my $timersymb = $item;
4820: if ($item eq 'course') {
4821: $type = 'course';
4822: } elsif ($item =~ /___\d+___/) {
4823: $type = 'resource';
4824: } else {
4825: $timersymb = &Apache::lonnet::symbread($item);
4826: }
4827: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4828: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4829: $triggered{$block} = {
4830: start => $start,
4831: end => $end,
4832: type => $type,
4833: };
4834: }
4835: }
4836: } else {
4837: foreach my $block (keys(%commblocks)) {
4838: if ($block =~ m/^(\d+)____(\d+)$/) {
4839: my ($start,$end) = ($1,$2);
4840: if ($start <= time && $end >= time) {
4841: if (ref($commblocks{$block}) eq 'HASH') {
4842: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4843: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4844: unless(grep(/^\Q$block\E$/,@blockers)) {
4845: push(@blockers,$block);
4846: }
4847: }
4848: }
4849: }
4850: }
4851: } elsif ($block =~ /^firstaccess____(.+)$/) {
4852: my $item = $1;
4853: my $timersymb = $item;
4854: my $type = 'map';
4855: if ($item eq 'course') {
4856: $type = 'course';
4857: } elsif ($item =~ /___\d+___/) {
4858: $type = 'resource';
4859: } else {
4860: $timersymb = &Apache::lonnet::symbread($item);
4861: }
4862: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4863: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4864: if ($start && $end) {
4865: if (($start <= time) && ($end >= time)) {
4866: unless (grep(/^\Q$block\E$/,@blockers)) {
4867: push(@blockers,$block);
4868: $triggered{$block} = {
4869: start => $start,
4870: end => $end,
4871: type => $type,
4872: };
4873: }
4874: }
1.490 raeburn 4875: }
1.1062 raeburn 4876: }
4877: }
4878: }
4879: foreach my $blocker (@blockers) {
4880: my ($staff_name,$staff_dom,$title,$blocks) =
4881: &parse_block_record($commblocks{$blocker});
4882: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4883: my ($start,$end,$triggertype);
4884: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4885: ($start,$end) = ($1,$2);
4886: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4887: $start = $triggered{$blocker}{'start'};
4888: $end = $triggered{$blocker}{'end'};
4889: $triggertype = $triggered{$blocker}{'type'};
4890: }
4891: if ($start) {
4892: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4893: if ($triggertype) {
4894: push(@{$$setters{$course}{'triggers'}},$triggertype);
4895: } else {
4896: push(@{$$setters{$course}{'triggers'}},0);
4897: }
4898: if ( ($startblock == 0) || ($startblock > $start) ) {
4899: $startblock = $start;
4900: if ($triggertype) {
4901: $triggerblock = $blocker;
1.474 raeburn 4902: }
4903: }
1.1062 raeburn 4904: if ( ($endblock == 0) || ($endblock < $end) ) {
4905: $endblock = $end;
4906: if ($triggertype) {
4907: $triggerblock = $blocker;
4908: }
4909: }
1.474 raeburn 4910: }
4911: }
1.1062 raeburn 4912: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4913: }
4914:
4915: sub parse_block_record {
4916: my ($record) = @_;
4917: my ($setuname,$setudom,$title,$blocks);
4918: if (ref($record) eq 'HASH') {
4919: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4920: $title = &unescape($record->{'event'});
4921: $blocks = $record->{'blocks'};
4922: } else {
4923: my @data = split(/:/,$record,3);
4924: if (scalar(@data) eq 2) {
4925: $title = $data[1];
4926: ($setuname,$setudom) = split(/@/,$data[0]);
4927: } else {
4928: ($setuname,$setudom,$title) = @data;
4929: }
4930: $blocks = { 'com' => 'on' };
4931: }
4932: return ($setuname,$setudom,$title,$blocks);
4933: }
4934:
1.854 kalberla 4935: sub blocking_status {
1.1189 raeburn 4936: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4937: my %setters;
1.890 droeschl 4938:
1.1061 raeburn 4939: # check for active blocking
1.1062 raeburn 4940: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4941: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4942: my $blocked = 0;
4943: if ($startblock && $endblock) {
4944: $blocked = 1;
4945: }
1.890 droeschl 4946:
1.1061 raeburn 4947: # caller just wants to know whether a block is active
4948: if (!wantarray) { return $blocked; }
4949:
4950: # build a link to a popup window containing the details
4951: my $querystring = "?activity=$activity";
4952: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4953: if ($activity eq 'port') {
4954: $querystring .= "&udom=$udom" if $udom;
4955: $querystring .= "&uname=$uname" if $uname;
4956: } elsif ($activity eq 'docs') {
4957: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4958: }
1.1061 raeburn 4959:
4960: my $output .= <<'END_MYBLOCK';
4961: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4962: var options = "width=" + w + ",height=" + h + ",";
4963: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4964: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4965: var newWin = window.open(url, wdwName, options);
4966: newWin.focus();
4967: }
1.890 droeschl 4968: END_MYBLOCK
1.854 kalberla 4969:
1.1061 raeburn 4970: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4971:
1.1061 raeburn 4972: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4973: my $text = &mt('Communication Blocked');
1.1217 raeburn 4974: my $class = 'LC_comblock';
1.1062 raeburn 4975: if ($activity eq 'docs') {
4976: $text = &mt('Content Access Blocked');
1.1217 raeburn 4977: $class = '';
1.1063 raeburn 4978: } elsif ($activity eq 'printout') {
4979: $text = &mt('Printing Blocked');
1.1062 raeburn 4980: }
1.1061 raeburn 4981: $output .= <<"END_BLOCK";
1.1217 raeburn 4982: <div class='$class'>
1.869 kalberla 4983: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4984: title='$text'>
4985: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4986: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4987: title='$text'>$text</a>
1.867 kalberla 4988: </div>
4989:
4990: END_BLOCK
1.474 raeburn 4991:
1.1061 raeburn 4992: return ($blocked, $output);
1.854 kalberla 4993: }
1.490 raeburn 4994:
1.60 matthew 4995: ###############################################
4996:
1.682 raeburn 4997: sub check_ip_acc {
1.1201 raeburn 4998: my ($acc,$clientip)=@_;
1.682 raeburn 4999: &Apache::lonxml::debug("acc is $acc");
5000: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5001: return 1;
5002: }
1.1219 raeburn 5003: my $allowed;
1.1201 raeburn 5004: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682 raeburn 5005:
5006: my $name;
1.1219 raeburn 5007: my %access = (
5008: allowfrom => 1,
5009: denyfrom => 0,
5010: );
5011: my @allows;
5012: my @denies;
5013: foreach my $item (split(',',$acc)) {
5014: $item =~ s/^\s*//;
5015: $item =~ s/\s*$//;
5016: my $pattern;
5017: if ($item =~ /^\!(.+)$/) {
5018: push(@denies,$1);
5019: } else {
5020: push(@allows,$item);
5021: }
5022: }
5023: my $numdenies = scalar(@denies);
5024: my $numallows = scalar(@allows);
5025: my $count = 0;
5026: foreach my $pattern (@denies,@allows) {
5027: $count ++;
5028: my $acctype = 'allowfrom';
5029: if ($count <= $numdenies) {
5030: $acctype = 'denyfrom';
5031: }
1.682 raeburn 5032: if ($pattern =~ /\*$/) {
5033: #35.8.*
5034: $pattern=~s/\*//;
1.1219 raeburn 5035: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5036: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5037: #35.8.3.[34-56]
5038: my $low=$2;
5039: my $high=$3;
5040: $pattern=$1;
5041: if ($ip =~ /^\Q$pattern\E/) {
5042: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5043: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5044: }
5045: } elsif ($pattern =~ /^\*/) {
5046: #*.msu.edu
5047: $pattern=~s/\*//;
5048: if (!defined($name)) {
5049: use Socket;
5050: my $netaddr=inet_aton($ip);
5051: ($name)=gethostbyaddr($netaddr,AF_INET);
5052: }
1.1219 raeburn 5053: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5054: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5055: #127.0.0.1
1.1219 raeburn 5056: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5057: } else {
5058: #some.name.com
5059: if (!defined($name)) {
5060: use Socket;
5061: my $netaddr=inet_aton($ip);
5062: ($name)=gethostbyaddr($netaddr,AF_INET);
5063: }
1.1219 raeburn 5064: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5065: }
5066: if ($allowed =~ /^(0|1)$/) { last; }
5067: }
5068: if ($allowed eq '') {
5069: if ($numdenies && !$numallows) {
5070: $allowed = 1;
5071: } else {
5072: $allowed = 0;
1.682 raeburn 5073: }
5074: }
5075: return $allowed;
5076: }
5077:
5078: ###############################################
5079:
1.60 matthew 5080: =pod
5081:
1.112 bowersj2 5082: =head1 Domain Template Functions
5083:
5084: =over 4
5085:
5086: =item * &determinedomain()
1.60 matthew 5087:
5088: Inputs: $domain (usually will be undef)
5089:
1.63 www 5090: Returns: Determines which domain should be used for designs
1.60 matthew 5091:
5092: =cut
1.54 www 5093:
1.60 matthew 5094: ###############################################
1.63 www 5095: sub determinedomain {
5096: my $domain=shift;
1.531 albertel 5097: if (! $domain) {
1.60 matthew 5098: # Determine domain if we have not been given one
1.893 raeburn 5099: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5100: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5101: if ($env{'request.role.domain'}) {
5102: $domain=$env{'request.role.domain'};
1.60 matthew 5103: }
5104: }
1.63 www 5105: return $domain;
5106: }
5107: ###############################################
1.517 raeburn 5108:
1.518 albertel 5109: sub devalidate_domconfig_cache {
5110: my ($udom)=@_;
5111: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5112: }
5113:
5114: # ---------------------- Get domain configuration for a domain
5115: sub get_domainconf {
5116: my ($udom) = @_;
5117: my $cachetime=1800;
5118: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5119: if (defined($cached)) { return %{$result}; }
5120:
5121: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5122: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5123: my (%designhash,%legacy);
1.518 albertel 5124: if (keys(%domconfig) > 0) {
5125: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5126: if (keys(%{$domconfig{'login'}})) {
5127: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5128: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5129: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5130: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5131: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5132: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5133: if ($key eq 'loginvia') {
5134: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5135: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5136: $designhash{$udom.'.login.loginvia'} = $server;
5137: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5138:
5139: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5140: } else {
5141: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5142: }
1.948 raeburn 5143: }
1.1208 raeburn 5144: } elsif ($key eq 'headtag') {
5145: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5146: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5147: }
1.946 raeburn 5148: }
1.1208 raeburn 5149: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5150: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5151: }
1.946 raeburn 5152: }
5153: }
5154: }
5155: } else {
5156: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5157: $designhash{$udom.'.login.'.$key.'_'.$img} =
5158: $domconfig{'login'}{$key}{$img};
5159: }
1.699 raeburn 5160: }
5161: } else {
5162: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5163: }
1.632 raeburn 5164: }
5165: } else {
5166: $legacy{'login'} = 1;
1.518 albertel 5167: }
1.632 raeburn 5168: } else {
5169: $legacy{'login'} = 1;
1.518 albertel 5170: }
5171: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5172: if (keys(%{$domconfig{'rolecolors'}})) {
5173: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5174: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5175: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5176: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5177: }
1.518 albertel 5178: }
5179: }
1.632 raeburn 5180: } else {
5181: $legacy{'rolecolors'} = 1;
1.518 albertel 5182: }
1.632 raeburn 5183: } else {
5184: $legacy{'rolecolors'} = 1;
1.518 albertel 5185: }
1.948 raeburn 5186: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5187: if ($domconfig{'autoenroll'}{'co-owners'}) {
5188: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5189: }
5190: }
1.632 raeburn 5191: if (keys(%legacy) > 0) {
5192: my %legacyhash = &get_legacy_domconf($udom);
5193: foreach my $item (keys(%legacyhash)) {
5194: if ($item =~ /^\Q$udom\E\.login/) {
5195: if ($legacy{'login'}) {
5196: $designhash{$item} = $legacyhash{$item};
5197: }
5198: } else {
5199: if ($legacy{'rolecolors'}) {
5200: $designhash{$item} = $legacyhash{$item};
5201: }
1.518 albertel 5202: }
5203: }
5204: }
1.632 raeburn 5205: } else {
5206: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5207: }
5208: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5209: $cachetime);
5210: return %designhash;
5211: }
5212:
1.632 raeburn 5213: sub get_legacy_domconf {
5214: my ($udom) = @_;
5215: my %legacyhash;
5216: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5217: my $designfile = $designdir.'/'.$udom.'.tab';
5218: if (-e $designfile) {
5219: if ( open (my $fh,"<$designfile") ) {
5220: while (my $line = <$fh>) {
5221: next if ($line =~ /^\#/);
5222: chomp($line);
5223: my ($key,$val)=(split(/\=/,$line));
5224: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5225: }
5226: close($fh);
5227: }
5228: }
1.1026 raeburn 5229: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5230: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5231: }
5232: return %legacyhash;
5233: }
5234:
1.63 www 5235: =pod
5236:
1.112 bowersj2 5237: =item * &domainlogo()
1.63 www 5238:
5239: Inputs: $domain (usually will be undef)
5240:
5241: Returns: A link to a domain logo, if the domain logo exists.
5242: If the domain logo does not exist, a description of the domain.
5243:
5244: =cut
1.112 bowersj2 5245:
1.63 www 5246: ###############################################
5247: sub domainlogo {
1.517 raeburn 5248: my $domain = &determinedomain(shift);
1.518 albertel 5249: my %designhash = &get_domainconf($domain);
1.517 raeburn 5250: # See if there is a logo
5251: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5252: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5253: if ($imgsrc =~ m{^/(adm|res)/}) {
5254: if ($imgsrc =~ m{^/res/}) {
5255: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5256: &Apache::lonnet::repcopy($local_name);
5257: }
5258: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5259: }
5260: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5261: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5262: return &Apache::lonnet::domain($domain,'description');
1.59 www 5263: } else {
1.60 matthew 5264: return '';
1.59 www 5265: }
5266: }
1.63 www 5267: ##############################################
5268:
5269: =pod
5270:
1.112 bowersj2 5271: =item * &designparm()
1.63 www 5272:
5273: Inputs: $which parameter; $domain (usually will be undef)
5274:
5275: Returns: value of designparamter $which
5276:
5277: =cut
1.112 bowersj2 5278:
1.397 albertel 5279:
1.400 albertel 5280: ##############################################
1.397 albertel 5281: sub designparm {
5282: my ($which,$domain)=@_;
5283: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5284: return $env{'environment.color.'.$which};
1.96 www 5285: }
1.63 www 5286: $domain=&determinedomain($domain);
1.1016 raeburn 5287: my %domdesign;
5288: unless ($domain eq 'public') {
5289: %domdesign = &get_domainconf($domain);
5290: }
1.520 raeburn 5291: my $output;
1.517 raeburn 5292: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5293: $output = $domdesign{$domain.'.'.$which};
1.63 www 5294: } else {
1.520 raeburn 5295: $output = $defaultdesign{$which};
5296: }
5297: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5298: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5299: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5300: if ($output =~ m{^/res/}) {
5301: my $local_name = &Apache::lonnet::filelocation('',$output);
5302: &Apache::lonnet::repcopy($local_name);
5303: }
1.520 raeburn 5304: $output = &lonhttpdurl($output);
5305: }
1.63 www 5306: }
1.520 raeburn 5307: return $output;
1.63 www 5308: }
1.59 www 5309:
1.822 bisitz 5310: ##############################################
5311: =pod
5312:
1.832 bisitz 5313: =item * &authorspace()
5314:
1.1028 raeburn 5315: Inputs: $url (usually will be undef).
1.832 bisitz 5316:
1.1132 raeburn 5317: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5318: directory being viewed (or for which action is being taken).
5319: If $url is provided, and begins /priv/<domain>/<uname>
5320: the path will be that portion of the $context argument.
5321: Otherwise the path will be for the author space of the current
5322: user when the current role is author, or for that of the
5323: co-author/assistant co-author space when the current role
5324: is co-author or assistant co-author.
1.832 bisitz 5325:
5326: =cut
5327:
5328: sub authorspace {
1.1028 raeburn 5329: my ($url) = @_;
5330: if ($url ne '') {
5331: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5332: return $1;
5333: }
5334: }
1.832 bisitz 5335: my $caname = '';
1.1024 www 5336: my $cadom = '';
1.1028 raeburn 5337: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5338: ($cadom,$caname) =
1.832 bisitz 5339: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5340: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5341: $caname = $env{'user.name'};
1.1024 www 5342: $cadom = $env{'user.domain'};
1.832 bisitz 5343: }
1.1028 raeburn 5344: if (($caname ne '') && ($cadom ne '')) {
5345: return "/priv/$cadom/$caname/";
5346: }
5347: return;
1.832 bisitz 5348: }
5349:
5350: ##############################################
5351: =pod
5352:
1.822 bisitz 5353: =item * &head_subbox()
5354:
5355: Inputs: $content (contains HTML code with page functions, etc.)
5356:
5357: Returns: HTML div with $content
5358: To be included in page header
5359:
5360: =cut
5361:
5362: sub head_subbox {
5363: my ($content)=@_;
5364: my $output =
1.993 raeburn 5365: '<div class="LC_head_subbox">'
1.822 bisitz 5366: .$content
5367: .'</div>'
5368: }
5369:
5370: ##############################################
5371: =pod
5372:
5373: =item * &CSTR_pageheader()
5374:
1.1026 raeburn 5375: Input: (optional) filename from which breadcrumb trail is built.
5376: In most cases no input as needed, as $env{'request.filename'}
5377: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5378:
5379: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5380: To be included on Authoring Space pages
1.822 bisitz 5381:
5382: =cut
5383:
5384: sub CSTR_pageheader {
1.1026 raeburn 5385: my ($trailfile) = @_;
5386: if ($trailfile eq '') {
5387: $trailfile = $env{'request.filename'};
5388: }
5389:
5390: # this is for resources; directories have customtitle, and crumbs
5391: # and select recent are created in lonpubdir.pm
5392:
5393: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5394: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5395: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5396: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5397: $formaction =~ s{/+}{/}g;
1.822 bisitz 5398:
5399: my $parentpath = '';
5400: my $lastitem = '';
5401: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5402: $parentpath = $1;
5403: $lastitem = $2;
5404: } else {
5405: $lastitem = $thisdisfn;
5406: }
1.921 bisitz 5407:
5408: my $output =
1.822 bisitz 5409: '<div>'
5410: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5411: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5412: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5413: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5414: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5415:
5416: if ($lastitem) {
5417: $output .=
5418: '<span class="LC_filename">'
5419: .$lastitem
5420: .'</span>';
5421: }
5422: $output .=
5423: '<br />'
1.822 bisitz 5424: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5425: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5426: .'</form>'
5427: .&Apache::lonmenu::constspaceform()
5428: .'</div>';
1.921 bisitz 5429:
5430: return $output;
1.822 bisitz 5431: }
5432:
1.60 matthew 5433: ###############################################
5434: ###############################################
5435:
5436: =pod
5437:
1.112 bowersj2 5438: =back
5439:
1.549 albertel 5440: =head1 HTML Helpers
1.112 bowersj2 5441:
5442: =over 4
5443:
5444: =item * &bodytag()
1.60 matthew 5445:
5446: Returns a uniform header for LON-CAPA web pages.
5447:
5448: Inputs:
5449:
1.112 bowersj2 5450: =over 4
5451:
5452: =item * $title, A title to be displayed on the page.
5453:
5454: =item * $function, the current role (can be undef).
5455:
5456: =item * $addentries, extra parameters for the <body> tag.
5457:
5458: =item * $bodyonly, if defined, only return the <body> tag.
5459:
5460: =item * $domain, if defined, force a given domain.
5461:
5462: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5463: text interface only)
1.60 matthew 5464:
1.814 bisitz 5465: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5466: navigational links
1.317 albertel 5467:
1.338 albertel 5468: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5469:
1.460 albertel 5470: =item * $args, optional argument valid values are
5471: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5472: inherit_jsmath -> when creating popup window in a page,
5473: should it have jsmath forced on by the
5474: current page
1.460 albertel 5475:
1.1096 raeburn 5476: =item * $advtoolsref, optional argument, ref to an array containing
5477: inlineremote items to be added in "Functions" menu below
5478: breadcrumbs.
5479:
1.112 bowersj2 5480: =back
5481:
1.60 matthew 5482: Returns: A uniform header for LON-CAPA web pages.
5483: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5484: If $bodyonly is undef or zero, an html string containing a <body> tag and
5485: other decorations will be returned.
5486:
5487: =cut
5488:
1.54 www 5489: sub bodytag {
1.831 bisitz 5490: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5491: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5492:
1.954 raeburn 5493: my $public;
5494: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5495: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5496: $public = 1;
5497: }
1.460 albertel 5498: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5499: my $httphost = $args->{'use_absolute'};
1.339 albertel 5500:
1.183 matthew 5501: $function = &get_users_function() if (!$function);
1.339 albertel 5502: my $img = &designparm($function.'.img',$domain);
5503: my $font = &designparm($function.'.font',$domain);
5504: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5505:
1.803 bisitz 5506: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5507: 'bgcolor' => $pgbg,
1.339 albertel 5508: 'text' => $font,
5509: 'alink' => &designparm($function.'.alink',$domain),
5510: 'vlink' => &designparm($function.'.vlink',$domain),
5511: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5512: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5513:
1.63 www 5514: # role and realm
1.1178 raeburn 5515: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5516: if ($realm) {
5517: $realm = '/'.$realm;
5518: }
1.378 raeburn 5519: if ($role eq 'ca') {
1.479 albertel 5520: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5521: $realm = &plainname($rname,$rdom);
1.378 raeburn 5522: }
1.55 www 5523: # realm
1.258 albertel 5524: if ($env{'request.course.id'}) {
1.378 raeburn 5525: if ($env{'request.role'} !~ /^cr/) {
5526: $role = &Apache::lonnet::plaintext($role,&course_type());
5527: }
1.898 raeburn 5528: if ($env{'request.course.sec'}) {
5529: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5530: }
1.359 albertel 5531: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5532: } else {
5533: $role = &Apache::lonnet::plaintext($role);
1.54 www 5534: }
1.433 albertel 5535:
1.359 albertel 5536: if (!$realm) { $realm=' '; }
1.330 albertel 5537:
1.438 albertel 5538: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5539:
1.101 www 5540: # construct main body tag
1.359 albertel 5541: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5542: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5543:
1.1131 raeburn 5544: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5545:
1.1130 raeburn 5546: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5547: return $bodytag;
1.1130 raeburn 5548: }
1.359 albertel 5549:
1.954 raeburn 5550: if ($public) {
1.433 albertel 5551: undef($role);
5552: }
1.359 albertel 5553:
1.762 bisitz 5554: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5555: #
5556: # Extra info if you are the DC
5557: my $dc_info = '';
5558: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5559: $env{'course.'.$env{'request.course.id'}.
5560: '.domain'}.'/'})) {
5561: my $cid = $env{'request.course.id'};
1.917 raeburn 5562: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5563: $dc_info =~ s/\s+$//;
1.359 albertel 5564: }
5565:
1.898 raeburn 5566: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5567:
1.903 droeschl 5568: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5569:
5570: # if ($env{'request.state'} eq 'construct') {
5571: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5572: # }
5573:
1.1130 raeburn 5574: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5575: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5576:
1.1130 raeburn 5577: my ($left,$right) = Apache::lonmenu::primary_menu();
1.359 albertel 5578:
1.916 droeschl 5579: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5580: if ($dc_info) {
5581: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5582: }
1.1130 raeburn 5583: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5584: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5585: return $bodytag;
5586: }
1.894 droeschl 5587:
1.927 raeburn 5588: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5589: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5590: }
1.916 droeschl 5591:
1.1130 raeburn 5592: $bodytag .= $right;
1.852 droeschl 5593:
1.917 raeburn 5594: if ($dc_info) {
5595: $dc_info = &dc_courseid_toggle($dc_info);
5596: }
5597: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5598:
1.1169 raeburn 5599: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5600: if ($args->{'no_secondary_menu'}) {
5601: return $bodytag;
5602: }
1.1169 raeburn 5603: #don't show menus for public users
1.954 raeburn 5604: if (!$public){
1.1154 raeburn 5605: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5606: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5607: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5608: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5609: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5610: $args->{'bread_crumbs'});
1.1096 raeburn 5611: } elsif ($forcereg) {
5612: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5613: $args->{'group'});
5614: } else {
5615: $bodytag .=
5616: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5617: $forcereg,$args->{'group'},
5618: $args->{'bread_crumbs'},
5619: $advtoolsref);
1.920 raeburn 5620: }
1.903 droeschl 5621: }else{
5622: # this is to seperate menu from content when there's no secondary
5623: # menu. Especially needed for public accessible ressources.
5624: $bodytag .= '<hr style="clear:both" />';
5625: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5626: }
1.903 droeschl 5627:
1.235 raeburn 5628: return $bodytag;
1.182 matthew 5629: }
5630:
1.917 raeburn 5631: sub dc_courseid_toggle {
5632: my ($dc_info) = @_;
1.980 raeburn 5633: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5634: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5635: &mt('(More ...)').'</a></span>'.
5636: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5637: }
5638:
1.330 albertel 5639: sub make_attr_string {
5640: my ($register,$attr_ref) = @_;
5641:
5642: if ($attr_ref && !ref($attr_ref)) {
5643: die("addentries Must be a hash ref ".
5644: join(':',caller(1))." ".
5645: join(':',caller(0))." ");
5646: }
5647:
5648: if ($register) {
1.339 albertel 5649: my ($on_load,$on_unload);
5650: foreach my $key (keys(%{$attr_ref})) {
5651: if (lc($key) eq 'onload') {
5652: $on_load.=$attr_ref->{$key}.';';
5653: delete($attr_ref->{$key});
5654:
5655: } elsif (lc($key) eq 'onunload') {
5656: $on_unload.=$attr_ref->{$key}.';';
5657: delete($attr_ref->{$key});
5658: }
5659: }
1.953 droeschl 5660: $attr_ref->{'onload'} = $on_load;
5661: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5662: }
1.339 albertel 5663:
1.330 albertel 5664: my $attr_string;
1.1159 raeburn 5665: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5666: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5667: }
5668: return $attr_string;
5669: }
5670:
5671:
1.182 matthew 5672: ###############################################
1.251 albertel 5673: ###############################################
5674:
5675: =pod
5676:
5677: =item * &endbodytag()
5678:
5679: Returns a uniform footer for LON-CAPA web pages.
5680:
1.635 raeburn 5681: Inputs: 1 - optional reference to an args hash
5682: If in the hash, key for noredirectlink has a value which evaluates to true,
5683: a 'Continue' link is not displayed if the page contains an
5684: internal redirect in the <head></head> section,
5685: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5686:
5687: =cut
5688:
5689: sub endbodytag {
1.635 raeburn 5690: my ($args) = @_;
1.1080 raeburn 5691: my $endbodytag;
5692: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5693: $endbodytag='</body>';
5694: }
1.269 albertel 5695: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5696: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5697: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5698: $endbodytag=
5699: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5700: &mt('Continue').'</a>'.
5701: $endbodytag;
5702: }
1.315 albertel 5703: }
1.251 albertel 5704: return $endbodytag;
5705: }
5706:
1.352 albertel 5707: =pod
5708:
5709: =item * &standard_css()
5710:
5711: Returns a style sheet
5712:
5713: Inputs: (all optional)
5714: domain -> force to color decorate a page for a specific
5715: domain
5716: function -> force usage of a specific rolish color scheme
5717: bgcolor -> override the default page bgcolor
5718:
5719: =cut
5720:
1.343 albertel 5721: sub standard_css {
1.345 albertel 5722: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5723: $function = &get_users_function() if (!$function);
5724: my $img = &designparm($function.'.img', $domain);
5725: my $tabbg = &designparm($function.'.tabbg', $domain);
5726: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5727: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5728: #second colour for later usage
1.345 albertel 5729: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5730: my $pgbg_or_bgcolor =
5731: $bgcolor ||
1.352 albertel 5732: &designparm($function.'.pgbg', $domain);
1.382 albertel 5733: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5734: my $alink = &designparm($function.'.alink', $domain);
5735: my $vlink = &designparm($function.'.vlink', $domain);
5736: my $link = &designparm($function.'.link', $domain);
5737:
1.602 albertel 5738: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5739: my $mono = 'monospace';
1.850 bisitz 5740: my $data_table_head = $sidebg;
5741: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5742: my $data_table_dark = '#E0E0E0';
1.470 banghart 5743: my $data_table_darker = '#CCCCCC';
1.349 albertel 5744: my $data_table_highlight = '#FFFF00';
1.352 albertel 5745: my $mail_new = '#FFBB77';
5746: my $mail_new_hover = '#DD9955';
5747: my $mail_read = '#BBBB77';
5748: my $mail_read_hover = '#999944';
5749: my $mail_replied = '#AAAA88';
5750: my $mail_replied_hover = '#888855';
5751: my $mail_other = '#99BBBB';
5752: my $mail_other_hover = '#669999';
1.391 albertel 5753: my $table_header = '#DDDDDD';
1.489 raeburn 5754: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5755: my $lg_border_color = '#C8C8C8';
1.952 onken 5756: my $button_hover = '#BF2317';
1.392 albertel 5757:
1.608 albertel 5758: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5759: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5760: : '0 3px 0 4px';
1.448 albertel 5761:
1.523 albertel 5762:
1.343 albertel 5763: return <<END;
1.947 droeschl 5764:
5765: /* needed for iframe to allow 100% height in FF */
5766: body, html {
5767: margin: 0;
5768: padding: 0 0.5%;
5769: height: 99%; /* to avoid scrollbars */
5770: }
5771:
1.795 www 5772: body {
1.911 bisitz 5773: font-family: $sans;
5774: line-height:130%;
5775: font-size:0.83em;
5776: color:$font;
1.795 www 5777: }
5778:
1.959 onken 5779: a:focus,
5780: a:focus img {
1.795 www 5781: color: red;
5782: }
1.698 harmsja 5783:
1.911 bisitz 5784: form, .inline {
5785: display: inline;
1.795 www 5786: }
1.721 harmsja 5787:
1.795 www 5788: .LC_right {
1.911 bisitz 5789: text-align:right;
1.795 www 5790: }
5791:
5792: .LC_middle {
1.911 bisitz 5793: vertical-align:middle;
1.795 www 5794: }
1.721 harmsja 5795:
1.1130 raeburn 5796: .LC_floatleft {
5797: float: left;
5798: }
5799:
5800: .LC_floatright {
5801: float: right;
5802: }
5803:
1.911 bisitz 5804: .LC_400Box {
5805: width:400px;
5806: }
1.721 harmsja 5807:
1.947 droeschl 5808: .LC_iframecontainer {
5809: width: 98%;
5810: margin: 0;
5811: position: fixed;
5812: top: 8.5em;
5813: bottom: 0;
5814: }
5815:
5816: .LC_iframecontainer iframe{
5817: border: none;
5818: width: 100%;
5819: height: 100%;
5820: }
5821:
1.778 bisitz 5822: .LC_filename {
5823: font-family: $mono;
5824: white-space:pre;
1.921 bisitz 5825: font-size: 120%;
1.778 bisitz 5826: }
5827:
5828: .LC_fileicon {
5829: border: none;
5830: height: 1.3em;
5831: vertical-align: text-bottom;
5832: margin-right: 0.3em;
5833: text-decoration:none;
5834: }
5835:
1.1008 www 5836: .LC_setting {
5837: text-decoration:underline;
5838: }
5839:
1.350 albertel 5840: .LC_error {
5841: color: red;
5842: }
1.795 www 5843:
1.1097 bisitz 5844: .LC_warning {
5845: color: darkorange;
5846: }
5847:
1.457 albertel 5848: .LC_diff_removed {
1.733 bisitz 5849: color: red;
1.394 albertel 5850: }
1.532 albertel 5851:
5852: .LC_info,
1.457 albertel 5853: .LC_success,
5854: .LC_diff_added {
1.350 albertel 5855: color: green;
5856: }
1.795 www 5857:
1.802 bisitz 5858: div.LC_confirm_box {
5859: background-color: #FAFAFA;
5860: border: 1px solid $lg_border_color;
5861: margin-right: 0;
5862: padding: 5px;
5863: }
5864:
5865: div.LC_confirm_box .LC_error img,
5866: div.LC_confirm_box .LC_success img {
5867: vertical-align: middle;
5868: }
5869:
1.440 albertel 5870: .LC_icon {
1.771 droeschl 5871: border: none;
1.790 droeschl 5872: vertical-align: middle;
1.771 droeschl 5873: }
5874:
1.543 albertel 5875: .LC_docs_spacer {
5876: width: 25px;
5877: height: 1px;
1.771 droeschl 5878: border: none;
1.543 albertel 5879: }
1.346 albertel 5880:
1.532 albertel 5881: .LC_internal_info {
1.735 bisitz 5882: color: #999999;
1.532 albertel 5883: }
5884:
1.794 www 5885: .LC_discussion {
1.1050 www 5886: background: $data_table_dark;
1.911 bisitz 5887: border: 1px solid black;
5888: margin: 2px;
1.794 www 5889: }
5890:
5891: .LC_disc_action_left {
1.1050 www 5892: background: $sidebg;
1.911 bisitz 5893: text-align: left;
1.1050 www 5894: padding: 4px;
5895: margin: 2px;
1.794 www 5896: }
5897:
5898: .LC_disc_action_right {
1.1050 www 5899: background: $sidebg;
1.911 bisitz 5900: text-align: right;
1.1050 www 5901: padding: 4px;
5902: margin: 2px;
1.794 www 5903: }
5904:
5905: .LC_disc_new_item {
1.911 bisitz 5906: background: white;
5907: border: 2px solid red;
1.1050 www 5908: margin: 4px;
5909: padding: 4px;
1.794 www 5910: }
5911:
5912: .LC_disc_old_item {
1.911 bisitz 5913: background: white;
1.1050 www 5914: margin: 4px;
5915: padding: 4px;
1.794 www 5916: }
5917:
1.458 albertel 5918: table.LC_pastsubmission {
5919: border: 1px solid black;
5920: margin: 2px;
5921: }
5922:
1.924 bisitz 5923: table#LC_menubuttons {
1.345 albertel 5924: width: 100%;
5925: background: $pgbg;
1.392 albertel 5926: border: 2px;
1.402 albertel 5927: border-collapse: separate;
1.803 bisitz 5928: padding: 0;
1.345 albertel 5929: }
1.392 albertel 5930:
1.801 tempelho 5931: table#LC_title_bar a {
5932: color: $fontmenu;
5933: }
1.836 bisitz 5934:
1.807 droeschl 5935: table#LC_title_bar {
1.819 tempelho 5936: clear: both;
1.836 bisitz 5937: display: none;
1.807 droeschl 5938: }
5939:
1.795 www 5940: table#LC_title_bar,
1.933 droeschl 5941: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5942: table#LC_title_bar.LC_with_remote {
1.359 albertel 5943: width: 100%;
1.392 albertel 5944: border-color: $pgbg;
5945: border-style: solid;
5946: border-width: $border;
1.379 albertel 5947: background: $pgbg;
1.801 tempelho 5948: color: $fontmenu;
1.392 albertel 5949: border-collapse: collapse;
1.803 bisitz 5950: padding: 0;
1.819 tempelho 5951: margin: 0;
1.359 albertel 5952: }
1.795 www 5953:
1.933 droeschl 5954: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5955: margin: 0;
5956: padding: 0;
1.933 droeschl 5957: position: relative;
5958: list-style: none;
1.913 droeschl 5959: }
1.933 droeschl 5960: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5961: display: inline;
5962: }
1.933 droeschl 5963:
5964: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5965: padding: 0;
1.933 droeschl 5966: margin: 0;
5967: float: left;
1.913 droeschl 5968: }
1.933 droeschl 5969: .LC_breadcrumb_tools_tools {
5970: padding: 0;
5971: margin: 0;
1.913 droeschl 5972: float: right;
5973: }
5974:
1.359 albertel 5975: table#LC_title_bar td {
5976: background: $tabbg;
5977: }
1.795 www 5978:
1.911 bisitz 5979: table#LC_menubuttons img {
1.803 bisitz 5980: border: none;
1.346 albertel 5981: }
1.795 www 5982:
1.842 droeschl 5983: .LC_breadcrumbs_component {
1.911 bisitz 5984: float: right;
5985: margin: 0 1em;
1.357 albertel 5986: }
1.842 droeschl 5987: .LC_breadcrumbs_component img {
1.911 bisitz 5988: vertical-align: middle;
1.777 tempelho 5989: }
1.795 www 5990:
1.383 albertel 5991: td.LC_table_cell_checkbox {
5992: text-align: center;
5993: }
1.795 www 5994:
5995: .LC_fontsize_small {
1.911 bisitz 5996: font-size: 70%;
1.705 tempelho 5997: }
5998:
1.844 bisitz 5999: #LC_breadcrumbs {
1.911 bisitz 6000: clear:both;
6001: background: $sidebg;
6002: border-bottom: 1px solid $lg_border_color;
6003: line-height: 2.5em;
1.933 droeschl 6004: overflow: hidden;
1.911 bisitz 6005: margin: 0;
6006: padding: 0;
1.995 raeburn 6007: text-align: left;
1.819 tempelho 6008: }
1.862 bisitz 6009:
1.1098 bisitz 6010: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6011: clear:both;
6012: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6013: border: 1px solid $sidebg;
1.1098 bisitz 6014: margin: 0 0 10px 0;
1.966 bisitz 6015: padding: 3px;
1.995 raeburn 6016: text-align: left;
1.822 bisitz 6017: }
6018:
1.795 www 6019: .LC_fontsize_medium {
1.911 bisitz 6020: font-size: 85%;
1.705 tempelho 6021: }
6022:
1.795 www 6023: .LC_fontsize_large {
1.911 bisitz 6024: font-size: 120%;
1.705 tempelho 6025: }
6026:
1.346 albertel 6027: .LC_menubuttons_inline_text {
6028: color: $font;
1.698 harmsja 6029: font-size: 90%;
1.701 harmsja 6030: padding-left:3px;
1.346 albertel 6031: }
6032:
1.934 droeschl 6033: .LC_menubuttons_inline_text img{
6034: vertical-align: middle;
6035: }
6036:
1.1051 www 6037: li.LC_menubuttons_inline_text img {
1.951 onken 6038: cursor:pointer;
1.1002 droeschl 6039: text-decoration: none;
1.951 onken 6040: }
6041:
1.526 www 6042: .LC_menubuttons_link {
6043: text-decoration: none;
6044: }
1.795 www 6045:
1.522 albertel 6046: .LC_menubuttons_category {
1.521 www 6047: color: $font;
1.526 www 6048: background: $pgbg;
1.521 www 6049: font-size: larger;
6050: font-weight: bold;
6051: }
6052:
1.346 albertel 6053: td.LC_menubuttons_text {
1.911 bisitz 6054: color: $font;
1.346 albertel 6055: }
1.706 harmsja 6056:
1.346 albertel 6057: .LC_current_location {
6058: background: $tabbg;
6059: }
1.795 www 6060:
1.938 bisitz 6061: table.LC_data_table {
1.347 albertel 6062: border: 1px solid #000000;
1.402 albertel 6063: border-collapse: separate;
1.426 albertel 6064: border-spacing: 1px;
1.610 albertel 6065: background: $pgbg;
1.347 albertel 6066: }
1.795 www 6067:
1.422 albertel 6068: .LC_data_table_dense {
6069: font-size: small;
6070: }
1.795 www 6071:
1.507 raeburn 6072: table.LC_nested_outer {
6073: border: 1px solid #000000;
1.589 raeburn 6074: border-collapse: collapse;
1.803 bisitz 6075: border-spacing: 0;
1.507 raeburn 6076: width: 100%;
6077: }
1.795 www 6078:
1.879 raeburn 6079: table.LC_innerpickbox,
1.507 raeburn 6080: table.LC_nested {
1.803 bisitz 6081: border: none;
1.589 raeburn 6082: border-collapse: collapse;
1.803 bisitz 6083: border-spacing: 0;
1.507 raeburn 6084: width: 100%;
6085: }
1.795 www 6086:
1.911 bisitz 6087: table.LC_data_table tr th,
6088: table.LC_calendar tr th,
1.879 raeburn 6089: table.LC_prior_tries tr th,
6090: table.LC_innerpickbox tr th {
1.349 albertel 6091: font-weight: bold;
6092: background-color: $data_table_head;
1.801 tempelho 6093: color:$fontmenu;
1.701 harmsja 6094: font-size:90%;
1.347 albertel 6095: }
1.795 www 6096:
1.879 raeburn 6097: table.LC_innerpickbox tr th,
6098: table.LC_innerpickbox tr td {
6099: vertical-align: top;
6100: }
6101:
1.711 raeburn 6102: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6103: background-color: #CCCCCC;
1.711 raeburn 6104: font-weight: bold;
6105: text-align: left;
6106: }
1.795 www 6107:
1.912 bisitz 6108: table.LC_data_table tr.LC_odd_row > td {
6109: background-color: $data_table_light;
6110: padding: 2px;
6111: vertical-align: top;
6112: }
6113:
1.809 bisitz 6114: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6115: background-color: $data_table_light;
1.912 bisitz 6116: vertical-align: top;
6117: }
6118:
6119: table.LC_data_table tr.LC_even_row > td {
6120: background-color: $data_table_dark;
1.425 albertel 6121: padding: 2px;
1.900 bisitz 6122: vertical-align: top;
1.347 albertel 6123: }
1.795 www 6124:
1.809 bisitz 6125: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6126: background-color: $data_table_dark;
1.900 bisitz 6127: vertical-align: top;
1.347 albertel 6128: }
1.795 www 6129:
1.425 albertel 6130: table.LC_data_table tr.LC_data_table_highlight td {
6131: background-color: $data_table_darker;
6132: }
1.795 www 6133:
1.639 raeburn 6134: table.LC_data_table tr td.LC_leftcol_header {
6135: background-color: $data_table_head;
6136: font-weight: bold;
6137: }
1.795 www 6138:
1.451 albertel 6139: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6140: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6141: font-weight: bold;
6142: font-style: italic;
6143: text-align: center;
6144: padding: 8px;
1.347 albertel 6145: }
1.795 www 6146:
1.1114 raeburn 6147: table.LC_data_table tr.LC_empty_row td,
6148: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6149: background-color: $sidebg;
6150: }
6151:
6152: table.LC_nested tr.LC_empty_row td {
6153: background-color: #FFFFFF;
6154: }
6155:
1.890 droeschl 6156: table.LC_caption {
6157: }
6158:
1.507 raeburn 6159: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6160: padding: 4ex
6161: }
1.795 www 6162:
1.507 raeburn 6163: table.LC_nested_outer tr th {
6164: font-weight: bold;
1.801 tempelho 6165: color:$fontmenu;
1.507 raeburn 6166: background-color: $data_table_head;
1.701 harmsja 6167: font-size: small;
1.507 raeburn 6168: border-bottom: 1px solid #000000;
6169: }
1.795 www 6170:
1.507 raeburn 6171: table.LC_nested_outer tr td.LC_subheader {
6172: background-color: $data_table_head;
6173: font-weight: bold;
6174: font-size: small;
6175: border-bottom: 1px solid #000000;
6176: text-align: right;
1.451 albertel 6177: }
1.795 www 6178:
1.507 raeburn 6179: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6180: background-color: #CCCCCC;
1.451 albertel 6181: font-weight: bold;
6182: font-size: small;
1.507 raeburn 6183: text-align: center;
6184: }
1.795 www 6185:
1.589 raeburn 6186: table.LC_nested tr.LC_info_row td.LC_left_item,
6187: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6188: text-align: left;
1.451 albertel 6189: }
1.795 www 6190:
1.507 raeburn 6191: table.LC_nested td {
1.735 bisitz 6192: background-color: #FFFFFF;
1.451 albertel 6193: font-size: small;
1.507 raeburn 6194: }
1.795 www 6195:
1.507 raeburn 6196: table.LC_nested_outer tr th.LC_right_item,
6197: table.LC_nested tr.LC_info_row td.LC_right_item,
6198: table.LC_nested tr.LC_odd_row td.LC_right_item,
6199: table.LC_nested tr td.LC_right_item {
1.451 albertel 6200: text-align: right;
6201: }
6202:
1.507 raeburn 6203: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6204: background-color: #EEEEEE;
1.451 albertel 6205: }
6206:
1.473 raeburn 6207: table.LC_createuser {
6208: }
6209:
6210: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6211: font-size: small;
1.473 raeburn 6212: }
6213:
6214: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6215: background-color: #CCCCCC;
1.473 raeburn 6216: font-weight: bold;
6217: text-align: center;
6218: }
6219:
1.349 albertel 6220: table.LC_calendar {
6221: border: 1px solid #000000;
6222: border-collapse: collapse;
1.917 raeburn 6223: width: 98%;
1.349 albertel 6224: }
1.795 www 6225:
1.349 albertel 6226: table.LC_calendar_pickdate {
6227: font-size: xx-small;
6228: }
1.795 www 6229:
1.349 albertel 6230: table.LC_calendar tr td {
6231: border: 1px solid #000000;
6232: vertical-align: top;
1.917 raeburn 6233: width: 14%;
1.349 albertel 6234: }
1.795 www 6235:
1.349 albertel 6236: table.LC_calendar tr td.LC_calendar_day_empty {
6237: background-color: $data_table_dark;
6238: }
1.795 www 6239:
1.779 bisitz 6240: table.LC_calendar tr td.LC_calendar_day_current {
6241: background-color: $data_table_highlight;
1.777 tempelho 6242: }
1.795 www 6243:
1.938 bisitz 6244: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6245: background-color: $mail_new;
6246: }
1.795 www 6247:
1.938 bisitz 6248: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6249: background-color: $mail_new_hover;
6250: }
1.795 www 6251:
1.938 bisitz 6252: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6253: background-color: $mail_read;
6254: }
1.795 www 6255:
1.938 bisitz 6256: /*
6257: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6258: background-color: $mail_read_hover;
6259: }
1.938 bisitz 6260: */
1.795 www 6261:
1.938 bisitz 6262: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6263: background-color: $mail_replied;
6264: }
1.795 www 6265:
1.938 bisitz 6266: /*
6267: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6268: background-color: $mail_replied_hover;
6269: }
1.938 bisitz 6270: */
1.795 www 6271:
1.938 bisitz 6272: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6273: background-color: $mail_other;
6274: }
1.795 www 6275:
1.938 bisitz 6276: /*
6277: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6278: background-color: $mail_other_hover;
6279: }
1.938 bisitz 6280: */
1.494 raeburn 6281:
1.777 tempelho 6282: table.LC_data_table tr > td.LC_browser_file,
6283: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6284: background: #AAEE77;
1.389 albertel 6285: }
1.795 www 6286:
1.777 tempelho 6287: table.LC_data_table tr > td.LC_browser_file_locked,
6288: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6289: background: #FFAA99;
1.387 albertel 6290: }
1.795 www 6291:
1.777 tempelho 6292: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6293: background: #888888;
1.779 bisitz 6294: }
1.795 www 6295:
1.777 tempelho 6296: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6297: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6298: background: #F8F866;
1.777 tempelho 6299: }
1.795 www 6300:
1.696 bisitz 6301: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6302: background: #E0E8FF;
1.387 albertel 6303: }
1.696 bisitz 6304:
1.707 bisitz 6305: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6306: /* background: #77FF77; */
1.707 bisitz 6307: }
1.795 www 6308:
1.707 bisitz 6309: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6310: border-right: 8px solid #FFFF77;
1.707 bisitz 6311: }
1.795 www 6312:
1.707 bisitz 6313: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6314: border-right: 8px solid #FFAA77;
1.707 bisitz 6315: }
1.795 www 6316:
1.707 bisitz 6317: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6318: border-right: 8px solid #FF7777;
1.707 bisitz 6319: }
1.795 www 6320:
1.707 bisitz 6321: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6322: border-right: 8px solid #AAFF77;
1.707 bisitz 6323: }
1.795 www 6324:
1.707 bisitz 6325: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6326: border-right: 8px solid #11CC55;
1.707 bisitz 6327: }
6328:
1.388 albertel 6329: span.LC_current_location {
1.701 harmsja 6330: font-size:larger;
1.388 albertel 6331: background: $pgbg;
6332: }
1.387 albertel 6333:
1.1029 www 6334: span.LC_current_nav_location {
6335: font-weight:bold;
6336: background: $sidebg;
6337: }
6338:
1.395 albertel 6339: span.LC_parm_menu_item {
6340: font-size: larger;
6341: }
1.795 www 6342:
1.395 albertel 6343: span.LC_parm_scope_all {
6344: color: red;
6345: }
1.795 www 6346:
1.395 albertel 6347: span.LC_parm_scope_folder {
6348: color: green;
6349: }
1.795 www 6350:
1.395 albertel 6351: span.LC_parm_scope_resource {
6352: color: orange;
6353: }
1.795 www 6354:
1.395 albertel 6355: span.LC_parm_part {
6356: color: blue;
6357: }
1.795 www 6358:
1.911 bisitz 6359: span.LC_parm_folder,
6360: span.LC_parm_symb {
1.395 albertel 6361: font-size: x-small;
6362: font-family: $mono;
6363: color: #AAAAAA;
6364: }
6365:
1.977 bisitz 6366: ul.LC_parm_parmlist li {
6367: display: inline-block;
6368: padding: 0.3em 0.8em;
6369: vertical-align: top;
6370: width: 150px;
6371: border-top:1px solid $lg_border_color;
6372: }
6373:
1.795 www 6374: td.LC_parm_overview_level_menu,
6375: td.LC_parm_overview_map_menu,
6376: td.LC_parm_overview_parm_selectors,
6377: td.LC_parm_overview_restrictions {
1.396 albertel 6378: border: 1px solid black;
6379: border-collapse: collapse;
6380: }
1.795 www 6381:
1.396 albertel 6382: table.LC_parm_overview_restrictions td {
6383: border-width: 1px 4px 1px 4px;
6384: border-style: solid;
6385: border-color: $pgbg;
6386: text-align: center;
6387: }
1.795 www 6388:
1.396 albertel 6389: table.LC_parm_overview_restrictions th {
6390: background: $tabbg;
6391: border-width: 1px 4px 1px 4px;
6392: border-style: solid;
6393: border-color: $pgbg;
6394: }
1.795 www 6395:
1.398 albertel 6396: table#LC_helpmenu {
1.803 bisitz 6397: border: none;
1.398 albertel 6398: height: 55px;
1.803 bisitz 6399: border-spacing: 0;
1.398 albertel 6400: }
6401:
6402: table#LC_helpmenu fieldset legend {
6403: font-size: larger;
6404: }
1.795 www 6405:
1.397 albertel 6406: table#LC_helpmenu_links {
6407: width: 100%;
6408: border: 1px solid black;
6409: background: $pgbg;
1.803 bisitz 6410: padding: 0;
1.397 albertel 6411: border-spacing: 1px;
6412: }
1.795 www 6413:
1.397 albertel 6414: table#LC_helpmenu_links tr td {
6415: padding: 1px;
6416: background: $tabbg;
1.399 albertel 6417: text-align: center;
6418: font-weight: bold;
1.397 albertel 6419: }
1.396 albertel 6420:
1.795 www 6421: table#LC_helpmenu_links a:link,
6422: table#LC_helpmenu_links a:visited,
1.397 albertel 6423: table#LC_helpmenu_links a:active {
6424: text-decoration: none;
6425: color: $font;
6426: }
1.795 www 6427:
1.397 albertel 6428: table#LC_helpmenu_links a:hover {
6429: text-decoration: underline;
6430: color: $vlink;
6431: }
1.396 albertel 6432:
1.417 albertel 6433: .LC_chrt_popup_exists {
6434: border: 1px solid #339933;
6435: margin: -1px;
6436: }
1.795 www 6437:
1.417 albertel 6438: .LC_chrt_popup_up {
6439: border: 1px solid yellow;
6440: margin: -1px;
6441: }
1.795 www 6442:
1.417 albertel 6443: .LC_chrt_popup {
6444: border: 1px solid #8888FF;
6445: background: #CCCCFF;
6446: }
1.795 www 6447:
1.421 albertel 6448: table.LC_pick_box {
6449: border-collapse: separate;
6450: background: white;
6451: border: 1px solid black;
6452: border-spacing: 1px;
6453: }
1.795 www 6454:
1.421 albertel 6455: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6456: background: $sidebg;
1.421 albertel 6457: font-weight: bold;
1.900 bisitz 6458: text-align: left;
1.740 bisitz 6459: vertical-align: top;
1.421 albertel 6460: width: 184px;
6461: padding: 8px;
6462: }
1.795 www 6463:
1.579 raeburn 6464: table.LC_pick_box td.LC_pick_box_value {
6465: text-align: left;
6466: padding: 8px;
6467: }
1.795 www 6468:
1.579 raeburn 6469: table.LC_pick_box td.LC_pick_box_select {
6470: text-align: left;
6471: padding: 8px;
6472: }
1.795 www 6473:
1.424 albertel 6474: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6475: padding: 0;
1.421 albertel 6476: height: 1px;
6477: background: black;
6478: }
1.795 www 6479:
1.421 albertel 6480: table.LC_pick_box td.LC_pick_box_submit {
6481: text-align: right;
6482: }
1.795 www 6483:
1.579 raeburn 6484: table.LC_pick_box td.LC_evenrow_value {
6485: text-align: left;
6486: padding: 8px;
6487: background-color: $data_table_light;
6488: }
1.795 www 6489:
1.579 raeburn 6490: table.LC_pick_box td.LC_oddrow_value {
6491: text-align: left;
6492: padding: 8px;
6493: background-color: $data_table_light;
6494: }
1.795 www 6495:
1.579 raeburn 6496: span.LC_helpform_receipt_cat {
6497: font-weight: bold;
6498: }
1.795 www 6499:
1.424 albertel 6500: table.LC_group_priv_box {
6501: background: white;
6502: border: 1px solid black;
6503: border-spacing: 1px;
6504: }
1.795 www 6505:
1.424 albertel 6506: table.LC_group_priv_box td.LC_pick_box_title {
6507: background: $tabbg;
6508: font-weight: bold;
6509: text-align: right;
6510: width: 184px;
6511: }
1.795 www 6512:
1.424 albertel 6513: table.LC_group_priv_box td.LC_groups_fixed {
6514: background: $data_table_light;
6515: text-align: center;
6516: }
1.795 www 6517:
1.424 albertel 6518: table.LC_group_priv_box td.LC_groups_optional {
6519: background: $data_table_dark;
6520: text-align: center;
6521: }
1.795 www 6522:
1.424 albertel 6523: table.LC_group_priv_box td.LC_groups_functionality {
6524: background: $data_table_darker;
6525: text-align: center;
6526: font-weight: bold;
6527: }
1.795 www 6528:
1.424 albertel 6529: table.LC_group_priv td {
6530: text-align: left;
1.803 bisitz 6531: padding: 0;
1.424 albertel 6532: }
6533:
6534: .LC_navbuttons {
6535: margin: 2ex 0ex 2ex 0ex;
6536: }
1.795 www 6537:
1.423 albertel 6538: .LC_topic_bar {
6539: font-weight: bold;
6540: background: $tabbg;
1.918 wenzelju 6541: margin: 1em 0em 1em 2em;
1.805 bisitz 6542: padding: 3px;
1.918 wenzelju 6543: font-size: 1.2em;
1.423 albertel 6544: }
1.795 www 6545:
1.423 albertel 6546: .LC_topic_bar span {
1.918 wenzelju 6547: left: 0.5em;
6548: position: absolute;
1.423 albertel 6549: vertical-align: middle;
1.918 wenzelju 6550: font-size: 1.2em;
1.423 albertel 6551: }
1.795 www 6552:
1.423 albertel 6553: table.LC_course_group_status {
6554: margin: 20px;
6555: }
1.795 www 6556:
1.423 albertel 6557: table.LC_status_selector td {
6558: vertical-align: top;
6559: text-align: center;
1.424 albertel 6560: padding: 4px;
6561: }
1.795 www 6562:
1.599 albertel 6563: div.LC_feedback_link {
1.616 albertel 6564: clear: both;
1.829 kalberla 6565: background: $sidebg;
1.779 bisitz 6566: width: 100%;
1.829 kalberla 6567: padding-bottom: 10px;
6568: border: 1px $tabbg solid;
1.833 kalberla 6569: height: 22px;
6570: line-height: 22px;
6571: padding-top: 5px;
6572: }
6573:
6574: div.LC_feedback_link img {
6575: height: 22px;
1.867 kalberla 6576: vertical-align:middle;
1.829 kalberla 6577: }
6578:
1.911 bisitz 6579: div.LC_feedback_link a {
1.829 kalberla 6580: text-decoration: none;
1.489 raeburn 6581: }
1.795 www 6582:
1.867 kalberla 6583: div.LC_comblock {
1.911 bisitz 6584: display:inline;
1.867 kalberla 6585: color:$font;
6586: font-size:90%;
6587: }
6588:
6589: div.LC_feedback_link div.LC_comblock {
6590: padding-left:5px;
6591: }
6592:
6593: div.LC_feedback_link div.LC_comblock a {
6594: color:$font;
6595: }
6596:
1.489 raeburn 6597: span.LC_feedback_link {
1.858 bisitz 6598: /* background: $feedback_link_bg; */
1.599 albertel 6599: font-size: larger;
6600: }
1.795 www 6601:
1.599 albertel 6602: span.LC_message_link {
1.858 bisitz 6603: /* background: $feedback_link_bg; */
1.599 albertel 6604: font-size: larger;
6605: position: absolute;
6606: right: 1em;
1.489 raeburn 6607: }
1.421 albertel 6608:
1.515 albertel 6609: table.LC_prior_tries {
1.524 albertel 6610: border: 1px solid #000000;
6611: border-collapse: separate;
6612: border-spacing: 1px;
1.515 albertel 6613: }
1.523 albertel 6614:
1.515 albertel 6615: table.LC_prior_tries td {
1.524 albertel 6616: padding: 2px;
1.515 albertel 6617: }
1.523 albertel 6618:
6619: .LC_answer_correct {
1.795 www 6620: background: lightgreen;
6621: color: darkgreen;
6622: padding: 6px;
1.523 albertel 6623: }
1.795 www 6624:
1.523 albertel 6625: .LC_answer_charged_try {
1.797 www 6626: background: #FFAAAA;
1.795 www 6627: color: darkred;
6628: padding: 6px;
1.523 albertel 6629: }
1.795 www 6630:
1.779 bisitz 6631: .LC_answer_not_charged_try,
1.523 albertel 6632: .LC_answer_no_grade,
6633: .LC_answer_late {
1.795 www 6634: background: lightyellow;
1.523 albertel 6635: color: black;
1.795 www 6636: padding: 6px;
1.523 albertel 6637: }
1.795 www 6638:
1.523 albertel 6639: .LC_answer_previous {
1.795 www 6640: background: lightblue;
6641: color: darkblue;
6642: padding: 6px;
1.523 albertel 6643: }
1.795 www 6644:
1.779 bisitz 6645: .LC_answer_no_message {
1.777 tempelho 6646: background: #FFFFFF;
6647: color: black;
1.795 www 6648: padding: 6px;
1.779 bisitz 6649: }
1.795 www 6650:
1.779 bisitz 6651: .LC_answer_unknown {
6652: background: orange;
6653: color: black;
1.795 www 6654: padding: 6px;
1.777 tempelho 6655: }
1.795 www 6656:
1.529 albertel 6657: span.LC_prior_numerical,
6658: span.LC_prior_string,
6659: span.LC_prior_custom,
6660: span.LC_prior_reaction,
6661: span.LC_prior_math {
1.925 bisitz 6662: font-family: $mono;
1.523 albertel 6663: white-space: pre;
6664: }
6665:
1.525 albertel 6666: span.LC_prior_string {
1.925 bisitz 6667: font-family: $mono;
1.525 albertel 6668: white-space: pre;
6669: }
6670:
1.523 albertel 6671: table.LC_prior_option {
6672: width: 100%;
6673: border-collapse: collapse;
6674: }
1.795 www 6675:
1.911 bisitz 6676: table.LC_prior_rank,
1.795 www 6677: table.LC_prior_match {
1.528 albertel 6678: border-collapse: collapse;
6679: }
1.795 www 6680:
1.528 albertel 6681: table.LC_prior_option tr td,
6682: table.LC_prior_rank tr td,
6683: table.LC_prior_match tr td {
1.524 albertel 6684: border: 1px solid #000000;
1.515 albertel 6685: }
6686:
1.855 bisitz 6687: .LC_nobreak {
1.544 albertel 6688: white-space: nowrap;
1.519 raeburn 6689: }
6690:
1.576 raeburn 6691: span.LC_cusr_emph {
6692: font-style: italic;
6693: }
6694:
1.633 raeburn 6695: span.LC_cusr_subheading {
6696: font-weight: normal;
6697: font-size: 85%;
6698: }
6699:
1.861 bisitz 6700: div.LC_docs_entry_move {
1.859 bisitz 6701: border: 1px solid #BBBBBB;
1.545 albertel 6702: background: #DDDDDD;
1.861 bisitz 6703: width: 22px;
1.859 bisitz 6704: padding: 1px;
6705: margin: 0;
1.545 albertel 6706: }
6707:
1.861 bisitz 6708: table.LC_data_table tr > td.LC_docs_entry_commands,
6709: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6710: font-size: x-small;
6711: }
1.795 www 6712:
1.861 bisitz 6713: .LC_docs_entry_parameter {
6714: white-space: nowrap;
6715: }
6716:
1.544 albertel 6717: .LC_docs_copy {
1.545 albertel 6718: color: #000099;
1.544 albertel 6719: }
1.795 www 6720:
1.544 albertel 6721: .LC_docs_cut {
1.545 albertel 6722: color: #550044;
1.544 albertel 6723: }
1.795 www 6724:
1.544 albertel 6725: .LC_docs_rename {
1.545 albertel 6726: color: #009900;
1.544 albertel 6727: }
1.795 www 6728:
1.544 albertel 6729: .LC_docs_remove {
1.545 albertel 6730: color: #990000;
6731: }
6732:
1.547 albertel 6733: .LC_docs_reinit_warn,
6734: .LC_docs_ext_edit {
6735: font-size: x-small;
6736: }
6737:
1.545 albertel 6738: table.LC_docs_adddocs td,
6739: table.LC_docs_adddocs th {
6740: border: 1px solid #BBBBBB;
6741: padding: 4px;
6742: background: #DDDDDD;
1.543 albertel 6743: }
6744:
1.584 albertel 6745: table.LC_sty_begin {
6746: background: #BBFFBB;
6747: }
1.795 www 6748:
1.584 albertel 6749: table.LC_sty_end {
6750: background: #FFBBBB;
6751: }
6752:
1.589 raeburn 6753: table.LC_double_column {
1.803 bisitz 6754: border-width: 0;
1.589 raeburn 6755: border-collapse: collapse;
6756: width: 100%;
6757: padding: 2px;
6758: }
6759:
6760: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6761: top: 2px;
1.589 raeburn 6762: left: 2px;
6763: width: 47%;
6764: vertical-align: top;
6765: }
6766:
6767: table.LC_double_column tr td.LC_right_col {
6768: top: 2px;
1.779 bisitz 6769: right: 2px;
1.589 raeburn 6770: width: 47%;
6771: vertical-align: top;
6772: }
6773:
1.591 raeburn 6774: div.LC_left_float {
6775: float: left;
6776: padding-right: 5%;
1.597 albertel 6777: padding-bottom: 4px;
1.591 raeburn 6778: }
6779:
6780: div.LC_clear_float_header {
1.597 albertel 6781: padding-bottom: 2px;
1.591 raeburn 6782: }
6783:
6784: div.LC_clear_float_footer {
1.597 albertel 6785: padding-top: 10px;
1.591 raeburn 6786: clear: both;
6787: }
6788:
1.597 albertel 6789: div.LC_grade_show_user {
1.941 bisitz 6790: /* border-left: 5px solid $sidebg; */
6791: border-top: 5px solid #000000;
6792: margin: 50px 0 0 0;
1.936 bisitz 6793: padding: 15px 0 5px 10px;
1.597 albertel 6794: }
1.795 www 6795:
1.936 bisitz 6796: div.LC_grade_show_user_odd_row {
1.941 bisitz 6797: /* border-left: 5px solid #000000; */
6798: }
6799:
6800: div.LC_grade_show_user div.LC_Box {
6801: margin-right: 50px;
1.597 albertel 6802: }
6803:
6804: div.LC_grade_submissions,
6805: div.LC_grade_message_center,
1.936 bisitz 6806: div.LC_grade_info_links {
1.597 albertel 6807: margin: 5px;
6808: width: 99%;
6809: background: #FFFFFF;
6810: }
1.795 www 6811:
1.597 albertel 6812: div.LC_grade_submissions_header,
1.936 bisitz 6813: div.LC_grade_message_center_header {
1.705 tempelho 6814: font-weight: bold;
6815: font-size: large;
1.597 albertel 6816: }
1.795 www 6817:
1.597 albertel 6818: div.LC_grade_submissions_body,
1.936 bisitz 6819: div.LC_grade_message_center_body {
1.597 albertel 6820: border: 1px solid black;
6821: width: 99%;
6822: background: #FFFFFF;
6823: }
1.795 www 6824:
1.613 albertel 6825: table.LC_scantron_action {
6826: width: 100%;
6827: }
1.795 www 6828:
1.613 albertel 6829: table.LC_scantron_action tr th {
1.698 harmsja 6830: font-weight:bold;
6831: font-style:normal;
1.613 albertel 6832: }
1.795 www 6833:
1.779 bisitz 6834: .LC_edit_problem_header,
1.614 albertel 6835: div.LC_edit_problem_footer {
1.705 tempelho 6836: font-weight: normal;
6837: font-size: medium;
1.602 albertel 6838: margin: 2px;
1.1060 bisitz 6839: background-color: $sidebg;
1.600 albertel 6840: }
1.795 www 6841:
1.600 albertel 6842: div.LC_edit_problem_header,
1.602 albertel 6843: div.LC_edit_problem_header div,
1.614 albertel 6844: div.LC_edit_problem_footer,
6845: div.LC_edit_problem_footer div,
1.602 albertel 6846: div.LC_edit_problem_editxml_header,
6847: div.LC_edit_problem_editxml_header div {
1.1205 golterma 6848: z-index: 100;
1.600 albertel 6849: }
1.795 www 6850:
1.600 albertel 6851: div.LC_edit_problem_header_title {
1.705 tempelho 6852: font-weight: bold;
6853: font-size: larger;
1.602 albertel 6854: background: $tabbg;
6855: padding: 3px;
1.1060 bisitz 6856: margin: 0 0 5px 0;
1.602 albertel 6857: }
1.795 www 6858:
1.602 albertel 6859: table.LC_edit_problem_header_title {
6860: width: 100%;
1.600 albertel 6861: background: $tabbg;
1.602 albertel 6862: }
6863:
1.1205 golterma 6864: div.LC_edit_actionbar {
6865: background-color: $sidebg;
1.1218 droeschl 6866: margin: 0;
6867: padding: 0;
6868: line-height: 200%;
1.602 albertel 6869: }
1.795 www 6870:
1.1218 droeschl 6871: div.LC_edit_actionbar div{
6872: padding: 0;
6873: margin: 0;
6874: display: inline-block;
1.600 albertel 6875: }
1.795 www 6876:
1.1124 bisitz 6877: .LC_edit_opt {
6878: padding-left: 1em;
6879: white-space: nowrap;
6880: }
6881:
1.1152 golterma 6882: .LC_edit_problem_latexhelper{
6883: text-align: right;
6884: }
6885:
6886: #LC_edit_problem_colorful div{
6887: margin-left: 40px;
6888: }
6889:
1.1205 golterma 6890: #LC_edit_problem_codemirror div{
6891: margin-left: 0px;
6892: }
6893:
1.911 bisitz 6894: img.stift {
1.803 bisitz 6895: border-width: 0;
6896: vertical-align: middle;
1.677 riegler 6897: }
1.680 riegler 6898:
1.923 bisitz 6899: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6900: vertical-align: top;
1.777 tempelho 6901: }
1.795 www 6902:
1.716 raeburn 6903: div.LC_createcourse {
1.911 bisitz 6904: margin: 10px 10px 10px 10px;
1.716 raeburn 6905: }
6906:
1.917 raeburn 6907: .LC_dccid {
1.1130 raeburn 6908: float: right;
1.917 raeburn 6909: margin: 0.2em 0 0 0;
6910: padding: 0;
6911: font-size: 90%;
6912: display:none;
6913: }
6914:
1.897 wenzelju 6915: ol.LC_primary_menu a:hover,
1.721 harmsja 6916: ol#LC_MenuBreadcrumbs a:hover,
6917: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6918: ul#LC_secondary_menu a:hover,
1.721 harmsja 6919: .LC_FormSectionClearButton input:hover
1.795 www 6920: ul.LC_TabContent li:hover a {
1.952 onken 6921: color:$button_hover;
1.911 bisitz 6922: text-decoration:none;
1.693 droeschl 6923: }
6924:
1.779 bisitz 6925: h1 {
1.911 bisitz 6926: padding: 0;
6927: line-height:130%;
1.693 droeschl 6928: }
1.698 harmsja 6929:
1.911 bisitz 6930: h2,
6931: h3,
6932: h4,
6933: h5,
6934: h6 {
6935: margin: 5px 0 5px 0;
6936: padding: 0;
6937: line-height:130%;
1.693 droeschl 6938: }
1.795 www 6939:
6940: .LC_hcell {
1.911 bisitz 6941: padding:3px 15px 3px 15px;
6942: margin: 0;
6943: background-color:$tabbg;
6944: color:$fontmenu;
6945: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6946: }
1.795 www 6947:
1.840 bisitz 6948: .LC_Box > .LC_hcell {
1.911 bisitz 6949: margin: 0 -10px 10px -10px;
1.835 bisitz 6950: }
6951:
1.721 harmsja 6952: .LC_noBorder {
1.911 bisitz 6953: border: 0;
1.698 harmsja 6954: }
1.693 droeschl 6955:
1.721 harmsja 6956: .LC_FormSectionClearButton input {
1.911 bisitz 6957: background-color:transparent;
6958: border: none;
6959: cursor:pointer;
6960: text-decoration:underline;
1.693 droeschl 6961: }
1.763 bisitz 6962:
6963: .LC_help_open_topic {
1.911 bisitz 6964: color: #FFFFFF;
6965: background-color: #EEEEFF;
6966: margin: 1px;
6967: padding: 4px;
6968: border: 1px solid #000033;
6969: white-space: nowrap;
6970: /* vertical-align: middle; */
1.759 neumanie 6971: }
1.693 droeschl 6972:
1.911 bisitz 6973: dl,
6974: ul,
6975: div,
6976: fieldset {
6977: margin: 10px 10px 10px 0;
6978: /* overflow: hidden; */
1.693 droeschl 6979: }
1.795 www 6980:
1.1211 raeburn 6981: article.geogebraweb div {
6982: margin: 0;
6983: }
6984:
1.838 bisitz 6985: fieldset > legend {
1.911 bisitz 6986: font-weight: bold;
6987: padding: 0 5px 0 5px;
1.838 bisitz 6988: }
6989:
1.813 bisitz 6990: #LC_nav_bar {
1.911 bisitz 6991: float: left;
1.995 raeburn 6992: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6993: margin: 0 0 2px 0;
1.807 droeschl 6994: }
6995:
1.916 droeschl 6996: #LC_realm {
6997: margin: 0.2em 0 0 0;
6998: padding: 0;
6999: font-weight: bold;
7000: text-align: center;
1.995 raeburn 7001: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7002: }
7003:
1.911 bisitz 7004: #LC_nav_bar em {
7005: font-weight: bold;
7006: font-style: normal;
1.807 droeschl 7007: }
7008:
1.897 wenzelju 7009: ol.LC_primary_menu {
1.934 droeschl 7010: margin: 0;
1.1076 raeburn 7011: padding: 0;
1.807 droeschl 7012: }
7013:
1.852 droeschl 7014: ol#LC_PathBreadcrumbs {
1.911 bisitz 7015: margin: 0;
1.693 droeschl 7016: }
7017:
1.897 wenzelju 7018: ol.LC_primary_menu li {
1.1076 raeburn 7019: color: RGB(80, 80, 80);
7020: vertical-align: middle;
7021: text-align: left;
7022: list-style: none;
1.1205 golterma 7023: position: relative;
1.1076 raeburn 7024: float: left;
1.1205 golterma 7025: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7026: line-height: 1.5em;
1.1076 raeburn 7027: }
7028:
1.1205 golterma 7029: ol.LC_primary_menu li a,
7030: ol.LC_primary_menu li p {
1.1076 raeburn 7031: display: block;
7032: margin: 0;
7033: padding: 0 5px 0 10px;
7034: text-decoration: none;
7035: }
7036:
1.1205 golterma 7037: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7038: display: inline-block;
7039: width: 95%;
7040: text-align: left;
7041: }
7042:
7043: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7044: display: inline-block;
7045: width: 5%;
7046: float: right;
7047: text-align: right;
7048: font-size: 70%;
7049: }
7050:
7051: ol.LC_primary_menu ul {
1.1076 raeburn 7052: display: none;
1.1205 golterma 7053: width: 15em;
1.1076 raeburn 7054: background-color: $data_table_light;
1.1205 golterma 7055: position: absolute;
7056: top: 100%;
1.1076 raeburn 7057: }
7058:
1.1205 golterma 7059: ol.LC_primary_menu ul ul {
7060: left: 100%;
7061: top: 0;
7062: }
7063:
7064: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7065: display: block;
7066: position: absolute;
7067: margin: 0;
7068: padding: 0;
1.1078 raeburn 7069: z-index: 2;
1.1076 raeburn 7070: }
7071:
7072: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7073: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7074: font-size: 90%;
1.911 bisitz 7075: vertical-align: top;
1.1076 raeburn 7076: float: none;
1.1079 raeburn 7077: border-left: 1px solid black;
7078: border-right: 1px solid black;
1.1205 golterma 7079: /* A dark bottom border to visualize different menu options;
7080: overwritten in the create_submenu routine for the last border-bottom of the menu */
7081: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7082: }
7083:
1.1205 golterma 7084: ol.LC_primary_menu li li p:hover {
7085: color:$button_hover;
7086: text-decoration:none;
7087: background-color:$data_table_dark;
1.1076 raeburn 7088: }
7089:
7090: ol.LC_primary_menu li li a:hover {
7091: color:$button_hover;
7092: background-color:$data_table_dark;
1.693 droeschl 7093: }
7094:
1.1205 golterma 7095: /* Font-size equal to the size of the predecessors*/
7096: ol.LC_primary_menu li:hover li li {
7097: font-size: 100%;
7098: }
7099:
1.897 wenzelju 7100: ol.LC_primary_menu li img {
1.911 bisitz 7101: vertical-align: bottom;
1.934 droeschl 7102: height: 1.1em;
1.1077 raeburn 7103: margin: 0.2em 0 0 0;
1.693 droeschl 7104: }
7105:
1.897 wenzelju 7106: ol.LC_primary_menu a {
1.911 bisitz 7107: color: RGB(80, 80, 80);
7108: text-decoration: none;
1.693 droeschl 7109: }
1.795 www 7110:
1.949 droeschl 7111: ol.LC_primary_menu a.LC_new_message {
7112: font-weight:bold;
7113: color: darkred;
7114: }
7115:
1.975 raeburn 7116: ol.LC_docs_parameters {
7117: margin-left: 0;
7118: padding: 0;
7119: list-style: none;
7120: }
7121:
7122: ol.LC_docs_parameters li {
7123: margin: 0;
7124: padding-right: 20px;
7125: display: inline;
7126: }
7127:
1.976 raeburn 7128: ol.LC_docs_parameters li:before {
7129: content: "\\002022 \\0020";
7130: }
7131:
7132: li.LC_docs_parameters_title {
7133: font-weight: bold;
7134: }
7135:
7136: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7137: content: "";
7138: }
7139:
1.897 wenzelju 7140: ul#LC_secondary_menu {
1.1107 raeburn 7141: clear: right;
1.911 bisitz 7142: color: $fontmenu;
7143: background: $tabbg;
7144: list-style: none;
7145: padding: 0;
7146: margin: 0;
7147: width: 100%;
1.995 raeburn 7148: text-align: left;
1.1107 raeburn 7149: float: left;
1.808 droeschl 7150: }
7151:
1.897 wenzelju 7152: ul#LC_secondary_menu li {
1.911 bisitz 7153: font-weight: bold;
7154: line-height: 1.8em;
1.1107 raeburn 7155: border-right: 1px solid black;
7156: float: left;
7157: }
7158:
7159: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7160: background-color: $data_table_light;
7161: }
7162:
7163: ul#LC_secondary_menu li a {
1.911 bisitz 7164: padding: 0 0.8em;
1.1107 raeburn 7165: }
7166:
7167: ul#LC_secondary_menu li ul {
7168: display: none;
7169: }
7170:
7171: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7172: display: block;
7173: position: absolute;
7174: margin: 0;
7175: padding: 0;
7176: list-style:none;
7177: float: none;
7178: background-color: $data_table_light;
7179: z-index: 2;
7180: margin-left: -1px;
7181: }
7182:
7183: ul#LC_secondary_menu li ul li {
7184: font-size: 90%;
7185: vertical-align: top;
7186: border-left: 1px solid black;
1.911 bisitz 7187: border-right: 1px solid black;
1.1119 raeburn 7188: background-color: $data_table_light;
1.1107 raeburn 7189: list-style:none;
7190: float: none;
7191: }
7192:
7193: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7194: background-color: $data_table_dark;
1.807 droeschl 7195: }
7196:
1.847 tempelho 7197: ul.LC_TabContent {
1.911 bisitz 7198: display:block;
7199: background: $sidebg;
7200: border-bottom: solid 1px $lg_border_color;
7201: list-style:none;
1.1020 raeburn 7202: margin: -1px -10px 0 -10px;
1.911 bisitz 7203: padding: 0;
1.693 droeschl 7204: }
7205:
1.795 www 7206: ul.LC_TabContent li,
7207: ul.LC_TabContentBigger li {
1.911 bisitz 7208: float:left;
1.741 harmsja 7209: }
1.795 www 7210:
1.897 wenzelju 7211: ul#LC_secondary_menu li a {
1.911 bisitz 7212: color: $fontmenu;
7213: text-decoration: none;
1.693 droeschl 7214: }
1.795 www 7215:
1.721 harmsja 7216: ul.LC_TabContent {
1.952 onken 7217: min-height:20px;
1.721 harmsja 7218: }
1.795 www 7219:
7220: ul.LC_TabContent li {
1.911 bisitz 7221: vertical-align:middle;
1.959 onken 7222: padding: 0 16px 0 10px;
1.911 bisitz 7223: background-color:$tabbg;
7224: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7225: border-left: solid 1px $font;
1.721 harmsja 7226: }
1.795 www 7227:
1.847 tempelho 7228: ul.LC_TabContent .right {
1.911 bisitz 7229: float:right;
1.847 tempelho 7230: }
7231:
1.911 bisitz 7232: ul.LC_TabContent li a,
7233: ul.LC_TabContent li {
7234: color:rgb(47,47,47);
7235: text-decoration:none;
7236: font-size:95%;
7237: font-weight:bold;
1.952 onken 7238: min-height:20px;
7239: }
7240:
1.959 onken 7241: ul.LC_TabContent li a:hover,
7242: ul.LC_TabContent li a:focus {
1.952 onken 7243: color: $button_hover;
1.959 onken 7244: background:none;
7245: outline:none;
1.952 onken 7246: }
7247:
7248: ul.LC_TabContent li:hover {
7249: color: $button_hover;
7250: cursor:pointer;
1.721 harmsja 7251: }
1.795 www 7252:
1.911 bisitz 7253: ul.LC_TabContent li.active {
1.952 onken 7254: color: $font;
1.911 bisitz 7255: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7256: border-bottom:solid 1px #FFFFFF;
7257: cursor: default;
1.744 ehlerst 7258: }
1.795 www 7259:
1.959 onken 7260: ul.LC_TabContent li.active a {
7261: color:$font;
7262: background:#FFFFFF;
7263: outline: none;
7264: }
1.1047 raeburn 7265:
7266: ul.LC_TabContent li.goback {
7267: float: left;
7268: border-left: none;
7269: }
7270:
1.870 tempelho 7271: #maincoursedoc {
1.911 bisitz 7272: clear:both;
1.870 tempelho 7273: }
7274:
7275: ul.LC_TabContentBigger {
1.911 bisitz 7276: display:block;
7277: list-style:none;
7278: padding: 0;
1.870 tempelho 7279: }
7280:
1.795 www 7281: ul.LC_TabContentBigger li {
1.911 bisitz 7282: vertical-align:bottom;
7283: height: 30px;
7284: font-size:110%;
7285: font-weight:bold;
7286: color: #737373;
1.841 tempelho 7287: }
7288:
1.957 onken 7289: ul.LC_TabContentBigger li.active {
7290: position: relative;
7291: top: 1px;
7292: }
7293:
1.870 tempelho 7294: ul.LC_TabContentBigger li a {
1.911 bisitz 7295: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7296: height: 30px;
7297: line-height: 30px;
7298: text-align: center;
7299: display: block;
7300: text-decoration: none;
1.958 onken 7301: outline: none;
1.741 harmsja 7302: }
1.795 www 7303:
1.870 tempelho 7304: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7305: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7306: color:$font;
1.744 ehlerst 7307: }
1.795 www 7308:
1.870 tempelho 7309: ul.LC_TabContentBigger li b {
1.911 bisitz 7310: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7311: display: block;
7312: float: left;
7313: padding: 0 30px;
1.957 onken 7314: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7315: }
7316:
1.956 onken 7317: ul.LC_TabContentBigger li:hover b {
7318: color:$button_hover;
7319: }
7320:
1.870 tempelho 7321: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7322: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7323: color:$font;
1.957 onken 7324: border: 0;
1.741 harmsja 7325: }
1.693 droeschl 7326:
1.870 tempelho 7327:
1.862 bisitz 7328: ul.LC_CourseBreadcrumbs {
7329: background: $sidebg;
1.1020 raeburn 7330: height: 2em;
1.862 bisitz 7331: padding-left: 10px;
1.1020 raeburn 7332: margin: 0;
1.862 bisitz 7333: list-style-position: inside;
7334: }
7335:
1.911 bisitz 7336: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7337: ol#LC_PathBreadcrumbs {
1.911 bisitz 7338: padding-left: 10px;
7339: margin: 0;
1.933 droeschl 7340: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7341: }
7342:
1.911 bisitz 7343: ol#LC_MenuBreadcrumbs li,
7344: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7345: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7346: display: inline;
1.933 droeschl 7347: white-space: normal;
1.693 droeschl 7348: }
7349:
1.823 bisitz 7350: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7351: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7352: text-decoration: none;
7353: font-size:90%;
1.693 droeschl 7354: }
1.795 www 7355:
1.969 droeschl 7356: ol#LC_MenuBreadcrumbs h1 {
7357: display: inline;
7358: font-size: 90%;
7359: line-height: 2.5em;
7360: margin: 0;
7361: padding: 0;
7362: }
7363:
1.795 www 7364: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7365: text-decoration:none;
7366: font-size:100%;
7367: font-weight:bold;
1.693 droeschl 7368: }
1.795 www 7369:
1.840 bisitz 7370: .LC_Box {
1.911 bisitz 7371: border: solid 1px $lg_border_color;
7372: padding: 0 10px 10px 10px;
1.746 neumanie 7373: }
1.795 www 7374:
1.1020 raeburn 7375: .LC_DocsBox {
7376: border: solid 1px $lg_border_color;
7377: padding: 0 0 10px 10px;
7378: }
7379:
1.795 www 7380: .LC_AboutMe_Image {
1.911 bisitz 7381: float:left;
7382: margin-right:10px;
1.747 neumanie 7383: }
1.795 www 7384:
7385: .LC_Clear_AboutMe_Image {
1.911 bisitz 7386: clear:left;
1.747 neumanie 7387: }
1.795 www 7388:
1.721 harmsja 7389: dl.LC_ListStyleClean dt {
1.911 bisitz 7390: padding-right: 5px;
7391: display: table-header-group;
1.693 droeschl 7392: }
7393:
1.721 harmsja 7394: dl.LC_ListStyleClean dd {
1.911 bisitz 7395: display: table-row;
1.693 droeschl 7396: }
7397:
1.721 harmsja 7398: .LC_ListStyleClean,
7399: .LC_ListStyleSimple,
7400: .LC_ListStyleNormal,
1.795 www 7401: .LC_ListStyleSpecial {
1.911 bisitz 7402: /* display:block; */
7403: list-style-position: inside;
7404: list-style-type: none;
7405: overflow: hidden;
7406: padding: 0;
1.693 droeschl 7407: }
7408:
1.721 harmsja 7409: .LC_ListStyleSimple li,
7410: .LC_ListStyleSimple dd,
7411: .LC_ListStyleNormal li,
7412: .LC_ListStyleNormal dd,
7413: .LC_ListStyleSpecial li,
1.795 www 7414: .LC_ListStyleSpecial dd {
1.911 bisitz 7415: margin: 0;
7416: padding: 5px 5px 5px 10px;
7417: clear: both;
1.693 droeschl 7418: }
7419:
1.721 harmsja 7420: .LC_ListStyleClean li,
7421: .LC_ListStyleClean dd {
1.911 bisitz 7422: padding-top: 0;
7423: padding-bottom: 0;
1.693 droeschl 7424: }
7425:
1.721 harmsja 7426: .LC_ListStyleSimple dd,
1.795 www 7427: .LC_ListStyleSimple li {
1.911 bisitz 7428: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7429: }
7430:
1.721 harmsja 7431: .LC_ListStyleSpecial li,
7432: .LC_ListStyleSpecial dd {
1.911 bisitz 7433: list-style-type: none;
7434: background-color: RGB(220, 220, 220);
7435: margin-bottom: 4px;
1.693 droeschl 7436: }
7437:
1.721 harmsja 7438: table.LC_SimpleTable {
1.911 bisitz 7439: margin:5px;
7440: border:solid 1px $lg_border_color;
1.795 www 7441: }
1.693 droeschl 7442:
1.721 harmsja 7443: table.LC_SimpleTable tr {
1.911 bisitz 7444: padding: 0;
7445: border:solid 1px $lg_border_color;
1.693 droeschl 7446: }
1.795 www 7447:
7448: table.LC_SimpleTable thead {
1.911 bisitz 7449: background:rgb(220,220,220);
1.693 droeschl 7450: }
7451:
1.721 harmsja 7452: div.LC_columnSection {
1.911 bisitz 7453: display: block;
7454: clear: both;
7455: overflow: hidden;
7456: margin: 0;
1.693 droeschl 7457: }
7458:
1.721 harmsja 7459: div.LC_columnSection>* {
1.911 bisitz 7460: float: left;
7461: margin: 10px 20px 10px 0;
7462: overflow:hidden;
1.693 droeschl 7463: }
1.721 harmsja 7464:
1.795 www 7465: table em {
1.911 bisitz 7466: font-weight: bold;
7467: font-style: normal;
1.748 schulted 7468: }
1.795 www 7469:
1.779 bisitz 7470: table.LC_tableBrowseRes,
1.795 www 7471: table.LC_tableOfContent {
1.911 bisitz 7472: border:none;
7473: border-spacing: 1px;
7474: padding: 3px;
7475: background-color: #FFFFFF;
7476: font-size: 90%;
1.753 droeschl 7477: }
1.789 droeschl 7478:
1.911 bisitz 7479: table.LC_tableOfContent {
7480: border-collapse: collapse;
1.789 droeschl 7481: }
7482:
1.771 droeschl 7483: table.LC_tableBrowseRes a,
1.768 schulted 7484: table.LC_tableOfContent a {
1.911 bisitz 7485: background-color: transparent;
7486: text-decoration: none;
1.753 droeschl 7487: }
7488:
1.795 www 7489: table.LC_tableOfContent img {
1.911 bisitz 7490: border: none;
7491: height: 1.3em;
7492: vertical-align: text-bottom;
7493: margin-right: 0.3em;
1.753 droeschl 7494: }
1.757 schulted 7495:
1.795 www 7496: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7497: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7498: }
7499:
1.795 www 7500: a#LC_content_toolbar_everything {
1.911 bisitz 7501: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7502: }
7503:
1.795 www 7504: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7505: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7506: }
7507:
1.795 www 7508: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7509: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7510: }
7511:
1.795 www 7512: a#LC_content_toolbar_changefolder {
1.911 bisitz 7513: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7514: }
7515:
1.795 www 7516: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7517: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7518: }
7519:
1.1043 raeburn 7520: a#LC_content_toolbar_edittoplevel {
7521: background-image:url(/res/adm/pages/edittoplevel.gif);
7522: }
7523:
1.795 www 7524: ul#LC_toolbar li a:hover {
1.911 bisitz 7525: background-position: bottom center;
1.757 schulted 7526: }
7527:
1.795 www 7528: ul#LC_toolbar {
1.911 bisitz 7529: padding: 0;
7530: margin: 2px;
7531: list-style:none;
7532: position:relative;
7533: background-color:white;
1.1082 raeburn 7534: overflow: auto;
1.757 schulted 7535: }
7536:
1.795 www 7537: ul#LC_toolbar li {
1.911 bisitz 7538: border:1px solid white;
7539: padding: 0;
7540: margin: 0;
7541: float: left;
7542: display:inline;
7543: vertical-align:middle;
1.1082 raeburn 7544: white-space: nowrap;
1.911 bisitz 7545: }
1.757 schulted 7546:
1.783 amueller 7547:
1.795 www 7548: a.LC_toolbarItem {
1.911 bisitz 7549: display:block;
7550: padding: 0;
7551: margin: 0;
7552: height: 32px;
7553: width: 32px;
7554: color:white;
7555: border: none;
7556: background-repeat:no-repeat;
7557: background-color:transparent;
1.757 schulted 7558: }
7559:
1.915 droeschl 7560: ul.LC_funclist {
7561: margin: 0;
7562: padding: 0.5em 1em 0.5em 0;
7563: }
7564:
1.933 droeschl 7565: ul.LC_funclist > li:first-child {
7566: font-weight:bold;
7567: margin-left:0.8em;
7568: }
7569:
1.915 droeschl 7570: ul.LC_funclist + ul.LC_funclist {
7571: /*
7572: left border as a seperator if we have more than
7573: one list
7574: */
7575: border-left: 1px solid $sidebg;
7576: /*
7577: this hides the left border behind the border of the
7578: outer box if element is wrapped to the next 'line'
7579: */
7580: margin-left: -1px;
7581: }
7582:
1.843 bisitz 7583: ul.LC_funclist li {
1.915 droeschl 7584: display: inline;
1.782 bisitz 7585: white-space: nowrap;
1.915 droeschl 7586: margin: 0 0 0 25px;
7587: line-height: 150%;
1.782 bisitz 7588: }
7589:
1.974 wenzelju 7590: .LC_hidden {
7591: display: none;
7592: }
7593:
1.1030 www 7594: .LCmodal-overlay {
7595: position:fixed;
7596: top:0;
7597: right:0;
7598: bottom:0;
7599: left:0;
7600: height:100%;
7601: width:100%;
7602: margin:0;
7603: padding:0;
7604: background:#999;
7605: opacity:.75;
7606: filter: alpha(opacity=75);
7607: -moz-opacity: 0.75;
7608: z-index:101;
7609: }
7610:
7611: * html .LCmodal-overlay {
7612: position: absolute;
7613: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7614: }
7615:
7616: .LCmodal-window {
7617: position:fixed;
7618: top:50%;
7619: left:50%;
7620: margin:0;
7621: padding:0;
7622: z-index:102;
7623: }
7624:
7625: * html .LCmodal-window {
7626: position:absolute;
7627: }
7628:
7629: .LCclose-window {
7630: position:absolute;
7631: width:32px;
7632: height:32px;
7633: right:8px;
7634: top:8px;
7635: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7636: text-indent:-99999px;
7637: overflow:hidden;
7638: cursor:pointer;
7639: }
7640:
1.1100 raeburn 7641: /*
7642: styles used by TTH when "Default set of options to pass to tth/m
7643: when converting TeX" in course settings has been set
7644:
7645: option passed: -t
7646:
7647: */
7648:
7649: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7650: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7651: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7652: td div.norm {line-height:normal;}
7653:
7654: /*
7655: option passed -y3
7656: */
7657:
7658: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7659: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7660: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7661:
1.343 albertel 7662: END
7663: }
7664:
1.306 albertel 7665: =pod
7666:
7667: =item * &headtag()
7668:
7669: Returns a uniform footer for LON-CAPA web pages.
7670:
1.307 albertel 7671: Inputs: $title - optional title for the head
7672: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7673: $args - optional arguments
1.319 albertel 7674: force_register - if is true call registerurl so the remote is
7675: informed
1.415 albertel 7676: redirect -> array ref of
7677: 1- seconds before redirect occurs
7678: 2- url to redirect to
7679: 3- whether the side effect should occur
1.315 albertel 7680: (side effect of setting
7681: $env{'internal.head.redirect'} to the url
7682: redirected too)
1.352 albertel 7683: domain -> force to color decorate a page for a specific
7684: domain
7685: function -> force usage of a specific rolish color scheme
7686: bgcolor -> override the default page bgcolor
1.460 albertel 7687: no_auto_mt_title
7688: -> prevent &mt()ing the title arg
1.464 albertel 7689:
1.306 albertel 7690: =cut
7691:
7692: sub headtag {
1.313 albertel 7693: my ($title,$head_extra,$args) = @_;
1.306 albertel 7694:
1.363 albertel 7695: my $function = $args->{'function'} || &get_users_function();
7696: my $domain = $args->{'domain'} || &determinedomain();
7697: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7698: my $httphost = $args->{'use_absolute'};
1.418 albertel 7699: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7700: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7701: #time(),
1.418 albertel 7702: $env{'environment.color.timestamp'},
1.363 albertel 7703: $function,$domain,$bgcolor);
7704:
1.369 www 7705: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7706:
1.308 albertel 7707: my $result =
7708: '<head>'.
1.1160 raeburn 7709: &font_settings($args);
1.319 albertel 7710:
1.1188 raeburn 7711: my $inhibitprint;
7712: if ($args->{'print_suppress'}) {
7713: $inhibitprint = &print_suppression();
7714: }
1.1064 raeburn 7715:
1.461 albertel 7716: if (!$args->{'frameset'}) {
7717: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7718: }
1.962 droeschl 7719: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7720: $result .= Apache::lonxml::display_title();
1.319 albertel 7721: }
1.436 albertel 7722: if (!$args->{'no_nav_bar'}
7723: && !$args->{'only_body'}
7724: && !$args->{'frameset'}) {
1.1154 raeburn 7725: $result .= &help_menu_js($httphost);
1.1032 www 7726: $result.=&modal_window();
1.1038 www 7727: $result.=&togglebox_script();
1.1034 www 7728: $result.=&wishlist_window();
1.1041 www 7729: $result.=&LCprogressbarUpdate_script();
1.1034 www 7730: } else {
7731: if ($args->{'add_modal'}) {
7732: $result.=&modal_window();
7733: }
7734: if ($args->{'add_wishlist'}) {
7735: $result.=&wishlist_window();
7736: }
1.1038 www 7737: if ($args->{'add_togglebox'}) {
7738: $result.=&togglebox_script();
7739: }
1.1041 www 7740: if ($args->{'add_progressbar'}) {
7741: $result.=&LCprogressbarUpdate_script();
7742: }
1.436 albertel 7743: }
1.314 albertel 7744: if (ref($args->{'redirect'})) {
1.414 albertel 7745: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7746: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7747: if (!$inhibit_continue) {
7748: $env{'internal.head.redirect'} = $url;
7749: }
1.313 albertel 7750: $result.=<<ADDMETA
7751: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7752: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7753: ADDMETA
1.1210 raeburn 7754: } else {
7755: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7756: my $requrl = $env{'request.uri'};
7757: if ($requrl eq '') {
7758: $requrl = $ENV{'REQUEST_URI'};
7759: $requrl =~ s/\?.+$//;
7760: }
7761: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7762: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7763: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7764: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7765: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7766: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7767: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7768: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7769: if ($domdefs{'offloadnow'}{$lonhost}) {
7770: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7771: if (($newserver) && ($newserver ne $lonhost)) {
7772: my $numsec = 5;
7773: my $timeout = $numsec * 1000;
7774: my ($newurl,$locknum,%locks,$msg);
7775: if ($env{'request.role.adv'}) {
7776: ($locknum,%locks) = &Apache::lonnet::get_locks();
7777: }
7778: my $disable_submit = 0;
7779: if ($requrl =~ /$LONCAPA::assess_re/) {
7780: $disable_submit = 1;
7781: }
7782: if ($locknum) {
7783: my @lockinfo = sort(values(%locks));
7784: $msg = &mt('Once the following tasks are complete: ')."\\n".
7785: join(", ",sort(values(%locks)))."\\n".
7786: &mt('your session will be transferred to a different server, after you click "Roles".');
7787: } else {
7788: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7789: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7790: }
7791: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7792: $newurl = '/adm/switchserver?otherserver='.$newserver;
7793: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7794: $newurl .= '&role='.$env{'request.role'};
7795: }
7796: if ($env{'request.symb'}) {
7797: $newurl .= '&symb='.$env{'request.symb'};
7798: } else {
7799: $newurl .= '&origurl='.$requrl;
7800: }
7801: }
7802: $result.=<<OFFLOAD
7803: <meta http-equiv="pragma" content="no-cache" />
7804: <script type="text/javascript">
1.1215 raeburn 7805: // <![CDATA[
1.1210 raeburn 7806: function LC_Offload_Now() {
7807: var dest = "$newurl";
7808: if (dest != '') {
7809: window.location.href="$newurl";
7810: }
7811: }
1.1214 raeburn 7812: \$(document).ready(function () {
7813: window.alert('$msg');
7814: if ($disable_submit) {
1.1210 raeburn 7815: \$(".LC_hwk_submit").prop("disabled", true);
7816: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 7817: }
7818: setTimeout('LC_Offload_Now()', $timeout);
7819: });
1.1215 raeburn 7820: // ]]>
1.1210 raeburn 7821: </script>
7822: OFFLOAD
7823: }
7824: }
7825: }
7826: }
7827: }
7828: }
1.313 albertel 7829: }
1.306 albertel 7830: if (!defined($title)) {
7831: $title = 'The LearningOnline Network with CAPA';
7832: }
1.460 albertel 7833: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7834: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7835: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7836: if (!$args->{'frameset'}) {
7837: $result .= ' /';
7838: }
7839: $result .= '>'
1.1064 raeburn 7840: .$inhibitprint
1.414 albertel 7841: .$head_extra;
1.1137 raeburn 7842: if ($env{'browser.mobile'}) {
7843: $result .= '
7844: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7845: <meta name="apple-mobile-web-app-capable" content="yes" />';
7846: }
1.962 droeschl 7847: return $result.'</head>';
1.306 albertel 7848: }
7849:
7850: =pod
7851:
1.340 albertel 7852: =item * &font_settings()
7853:
7854: Returns neccessary <meta> to set the proper encoding
7855:
1.1160 raeburn 7856: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7857:
7858: =cut
7859:
7860: sub font_settings {
1.1160 raeburn 7861: my ($args) = @_;
1.340 albertel 7862: my $headerstring='';
1.1160 raeburn 7863: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7864: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7865: $headerstring.=
7866: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7867: if (!$args->{'frameset'}) {
7868: $headerstring.= ' /';
7869: }
7870: $headerstring .= '>'."\n";
1.340 albertel 7871: }
7872: return $headerstring;
7873: }
7874:
1.341 albertel 7875: =pod
7876:
1.1064 raeburn 7877: =item * &print_suppression()
7878:
7879: In course context returns css which causes the body to be blank when media="print",
7880: if printout generation is unavailable for the current resource.
7881:
7882: This could be because:
7883:
7884: (a) printstartdate is in the future
7885:
7886: (b) printenddate is in the past
7887:
7888: (c) there is an active exam block with "printout"
7889: functionality blocked
7890:
7891: Users with pav, pfo or evb privileges are exempt.
7892:
7893: Inputs: none
7894:
7895: =cut
7896:
7897:
7898: sub print_suppression {
7899: my $noprint;
7900: if ($env{'request.course.id'}) {
7901: my $scope = $env{'request.course.id'};
7902: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7903: (&Apache::lonnet::allowed('pfo',$scope))) {
7904: return;
7905: }
7906: if ($env{'request.course.sec'} ne '') {
7907: $scope .= "/$env{'request.course.sec'}";
7908: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7909: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7910: return;
1.1064 raeburn 7911: }
7912: }
7913: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7914: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 7915: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7916: if ($blocked) {
7917: my $checkrole = "cm./$cdom/$cnum";
7918: if ($env{'request.course.sec'} ne '') {
7919: $checkrole .= "/$env{'request.course.sec'}";
7920: }
7921: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7922: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7923: $noprint = 1;
7924: }
7925: }
7926: unless ($noprint) {
7927: my $symb = &Apache::lonnet::symbread();
7928: if ($symb ne '') {
7929: my $navmap = Apache::lonnavmaps::navmap->new();
7930: if (ref($navmap)) {
7931: my $res = $navmap->getBySymb($symb);
7932: if (ref($res)) {
7933: if (!$res->resprintable()) {
7934: $noprint = 1;
7935: }
7936: }
7937: }
7938: }
7939: }
7940: if ($noprint) {
7941: return <<"ENDSTYLE";
7942: <style type="text/css" media="print">
7943: body { display:none }
7944: </style>
7945: ENDSTYLE
7946: }
7947: }
7948: return;
7949: }
7950:
7951: =pod
7952:
1.341 albertel 7953: =item * &xml_begin()
7954:
7955: Returns the needed doctype and <html>
7956:
7957: Inputs: none
7958:
7959: =cut
7960:
7961: sub xml_begin {
1.1168 raeburn 7962: my ($is_frameset) = @_;
1.341 albertel 7963: my $output='';
7964:
7965: if ($env{'browser.mathml'}) {
7966: $output='<?xml version="1.0"?>'
7967: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7968: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7969:
7970: # .'<!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">] >'
7971: .'<!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">'
7972: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7973: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 7974: } elsif ($is_frameset) {
7975: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7976: '<html>'."\n";
1.341 albertel 7977: } else {
1.1168 raeburn 7978: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7979: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7980: }
7981: return $output;
7982: }
1.340 albertel 7983:
7984: =pod
7985:
1.306 albertel 7986: =item * &start_page()
7987:
7988: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7989:
1.648 raeburn 7990: Inputs:
7991:
7992: =over 4
7993:
7994: $title - optional title for the page
7995:
7996: $head_extra - optional extra HTML to incude inside the <head>
7997:
7998: $args - additional optional args supported are:
7999:
8000: =over 8
8001:
8002: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8003: arg on
1.814 bisitz 8004: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8005: add_entries -> additional attributes to add to the <body>
8006: domain -> force to color decorate a page for a
1.317 albertel 8007: specific domain
1.648 raeburn 8008: function -> force usage of a specific rolish color
1.317 albertel 8009: scheme
1.648 raeburn 8010: redirect -> see &headtag()
8011: bgcolor -> override the default page bg color
8012: js_ready -> return a string ready for being used in
1.317 albertel 8013: a javascript writeln
1.648 raeburn 8014: html_encode -> return a string ready for being used in
1.320 albertel 8015: a html attribute
1.648 raeburn 8016: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8017: $forcereg arg
1.648 raeburn 8018: frameset -> if true will start with a <frameset>
1.330 albertel 8019: rather than <body>
1.648 raeburn 8020: skip_phases -> hash ref of
1.338 albertel 8021: head -> skip the <html><head> generation
8022: body -> skip all <body> generation
1.648 raeburn 8023: no_auto_mt_title -> prevent &mt()ing the title arg
8024: inherit_jsmath -> when creating popup window in a page,
8025: should it have jsmath forced on by the
8026: current page
1.867 kalberla 8027: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8028: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8029: group -> includes the current group, if page is for a
8030: specific group
1.361 albertel 8031:
1.648 raeburn 8032: =back
1.460 albertel 8033:
1.648 raeburn 8034: =back
1.562 albertel 8035:
1.306 albertel 8036: =cut
8037:
8038: sub start_page {
1.309 albertel 8039: my ($title,$head_extra,$args) = @_;
1.318 albertel 8040: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8041:
1.315 albertel 8042: $env{'internal.start_page'}++;
1.1096 raeburn 8043: my ($result,@advtools);
1.964 droeschl 8044:
1.338 albertel 8045: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8046: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8047: }
8048:
8049: if (! exists($args->{'skip_phases'}{'body'}) ) {
8050: if ($args->{'frameset'}) {
8051: my $attr_string = &make_attr_string($args->{'force_register'},
8052: $args->{'add_entries'});
8053: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8054: } else {
8055: $result .=
8056: &bodytag($title,
8057: $args->{'function'}, $args->{'add_entries'},
8058: $args->{'only_body'}, $args->{'domain'},
8059: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8060: $args->{'bgcolor'}, $args,
8061: \@advtools);
1.831 bisitz 8062: }
1.330 albertel 8063: }
1.338 albertel 8064:
1.315 albertel 8065: if ($args->{'js_ready'}) {
1.713 kaisler 8066: $result = &js_ready($result);
1.315 albertel 8067: }
1.320 albertel 8068: if ($args->{'html_encode'}) {
1.713 kaisler 8069: $result = &html_encode($result);
8070: }
8071:
1.813 bisitz 8072: # Preparation for new and consistent functionlist at top of screen
8073: # if ($args->{'functionlist'}) {
8074: # $result .= &build_functionlist();
8075: #}
8076:
1.964 droeschl 8077: # Don't add anything more if only_body wanted or in const space
8078: return $result if $args->{'only_body'}
8079: || $env{'request.state'} eq 'construct';
1.813 bisitz 8080:
8081: #Breadcrumbs
1.758 kaisler 8082: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8083: &Apache::lonhtmlcommon::clear_breadcrumbs();
8084: #if any br links exists, add them to the breadcrumbs
8085: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8086: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8087: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8088: }
8089: }
1.1096 raeburn 8090: # if @advtools array contains items add then to the breadcrumbs
8091: if (@advtools > 0) {
8092: &Apache::lonmenu::advtools_crumbs(@advtools);
8093: }
1.758 kaisler 8094:
8095: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8096: if(exists($args->{'bread_crumbs_component'})){
8097: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
8098: }else{
8099: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8100: }
1.320 albertel 8101: }
1.315 albertel 8102: return $result;
1.306 albertel 8103: }
8104:
8105: sub end_page {
1.315 albertel 8106: my ($args) = @_;
8107: $env{'internal.end_page'}++;
1.330 albertel 8108: my $result;
1.335 albertel 8109: if ($args->{'discussion'}) {
8110: my ($target,$parser);
8111: if (ref($args->{'discussion'})) {
8112: ($target,$parser) =($args->{'discussion'}{'target'},
8113: $args->{'discussion'}{'parser'});
8114: }
8115: $result .= &Apache::lonxml::xmlend($target,$parser);
8116: }
1.330 albertel 8117: if ($args->{'frameset'}) {
8118: $result .= '</frameset>';
8119: } else {
1.635 raeburn 8120: $result .= &endbodytag($args);
1.330 albertel 8121: }
1.1080 raeburn 8122: unless ($args->{'notbody'}) {
8123: $result .= "\n</html>";
8124: }
1.330 albertel 8125:
1.315 albertel 8126: if ($args->{'js_ready'}) {
1.317 albertel 8127: $result = &js_ready($result);
1.315 albertel 8128: }
1.335 albertel 8129:
1.320 albertel 8130: if ($args->{'html_encode'}) {
8131: $result = &html_encode($result);
8132: }
1.335 albertel 8133:
1.315 albertel 8134: return $result;
8135: }
8136:
1.1034 www 8137: sub wishlist_window {
8138: return(<<'ENDWISHLIST');
1.1046 raeburn 8139: <script type="text/javascript">
1.1034 www 8140: // <![CDATA[
8141: // <!-- BEGIN LON-CAPA Internal
8142: function set_wishlistlink(title, path) {
8143: if (!title) {
8144: title = document.title;
8145: title = title.replace(/^LON-CAPA /,'');
8146: }
1.1175 raeburn 8147: title = encodeURIComponent(title);
1.1203 raeburn 8148: title = title.replace("'","\\\'");
1.1034 www 8149: if (!path) {
8150: path = location.pathname;
8151: }
1.1175 raeburn 8152: path = encodeURIComponent(path);
1.1203 raeburn 8153: path = path.replace("'","\\\'");
1.1034 www 8154: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8155: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8156: }
8157: // END LON-CAPA Internal -->
8158: // ]]>
8159: </script>
8160: ENDWISHLIST
8161: }
8162:
1.1030 www 8163: sub modal_window {
8164: return(<<'ENDMODAL');
1.1046 raeburn 8165: <script type="text/javascript">
1.1030 www 8166: // <![CDATA[
8167: // <!-- BEGIN LON-CAPA Internal
8168: var modalWindow = {
8169: parent:"body",
8170: windowId:null,
8171: content:null,
8172: width:null,
8173: height:null,
8174: close:function()
8175: {
8176: $(".LCmodal-window").remove();
8177: $(".LCmodal-overlay").remove();
8178: },
8179: open:function()
8180: {
8181: var modal = "";
8182: modal += "<div class=\"LCmodal-overlay\"></div>";
8183: 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;\">";
8184: modal += this.content;
8185: modal += "</div>";
8186:
8187: $(this.parent).append(modal);
8188:
8189: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8190: $(".LCclose-window").click(function(){modalWindow.close();});
8191: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8192: }
8193: };
1.1140 raeburn 8194: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8195: {
1.1203 raeburn 8196: source = source.replace("'","'");
1.1030 www 8197: modalWindow.windowId = "myModal";
8198: modalWindow.width = width;
8199: modalWindow.height = height;
1.1196 raeburn 8200: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8201: modalWindow.open();
1.1208 raeburn 8202: };
1.1030 www 8203: // END LON-CAPA Internal -->
8204: // ]]>
8205: </script>
8206: ENDMODAL
8207: }
8208:
8209: sub modal_link {
1.1140 raeburn 8210: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8211: unless ($width) { $width=480; }
8212: unless ($height) { $height=400; }
1.1031 www 8213: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8214: unless ($transparency) { $transparency='true'; }
8215:
1.1074 raeburn 8216: my $target_attr;
8217: if (defined($target)) {
8218: $target_attr = 'target="'.$target.'"';
8219: }
8220: return <<"ENDLINK";
1.1140 raeburn 8221: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8222: $linktext</a>
8223: ENDLINK
1.1030 www 8224: }
8225:
1.1032 www 8226: sub modal_adhoc_script {
8227: my ($funcname,$width,$height,$content)=@_;
8228: return (<<ENDADHOC);
1.1046 raeburn 8229: <script type="text/javascript">
1.1032 www 8230: // <![CDATA[
8231: var $funcname = function()
8232: {
8233: modalWindow.windowId = "myModal";
8234: modalWindow.width = $width;
8235: modalWindow.height = $height;
8236: modalWindow.content = '$content';
8237: modalWindow.open();
8238: };
8239: // ]]>
8240: </script>
8241: ENDADHOC
8242: }
8243:
1.1041 www 8244: sub modal_adhoc_inner {
8245: my ($funcname,$width,$height,$content)=@_;
8246: my $innerwidth=$width-20;
8247: $content=&js_ready(
1.1140 raeburn 8248: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8249: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8250: $content.
1.1041 www 8251: &end_scrollbox().
1.1140 raeburn 8252: &end_page()
1.1041 www 8253: );
8254: return &modal_adhoc_script($funcname,$width,$height,$content);
8255: }
8256:
8257: sub modal_adhoc_window {
8258: my ($funcname,$width,$height,$content,$linktext)=@_;
8259: return &modal_adhoc_inner($funcname,$width,$height,$content).
8260: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8261: }
8262:
8263: sub modal_adhoc_launch {
8264: my ($funcname,$width,$height,$content)=@_;
8265: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8266: <script type="text/javascript">
8267: // <![CDATA[
8268: $funcname();
8269: // ]]>
8270: </script>
8271: ENDLAUNCH
8272: }
8273:
8274: sub modal_adhoc_close {
8275: return (<<ENDCLOSE);
8276: <script type="text/javascript">
8277: // <![CDATA[
8278: modalWindow.close();
8279: // ]]>
8280: </script>
8281: ENDCLOSE
8282: }
8283:
1.1038 www 8284: sub togglebox_script {
8285: return(<<ENDTOGGLE);
8286: <script type="text/javascript">
8287: // <![CDATA[
8288: function LCtoggleDisplay(id,hidetext,showtext) {
8289: link = document.getElementById(id + "link").childNodes[0];
8290: with (document.getElementById(id).style) {
8291: if (display == "none" ) {
8292: display = "inline";
8293: link.nodeValue = hidetext;
8294: } else {
8295: display = "none";
8296: link.nodeValue = showtext;
8297: }
8298: }
8299: }
8300: // ]]>
8301: </script>
8302: ENDTOGGLE
8303: }
8304:
1.1039 www 8305: sub start_togglebox {
8306: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8307: unless ($heading) { $heading=''; } else { $heading.=' '; }
8308: unless ($showtext) { $showtext=&mt('show'); }
8309: unless ($hidetext) { $hidetext=&mt('hide'); }
8310: unless ($headerbg) { $headerbg='#FFFFFF'; }
8311: return &start_data_table().
8312: &start_data_table_header_row().
8313: '<td bgcolor="'.$headerbg.'">'.$heading.
8314: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8315: $showtext.'\')">'.$showtext.'</a>]</td>'.
8316: &end_data_table_header_row().
8317: '<tr id="'.$id.'" style="display:none""><td>';
8318: }
8319:
8320: sub end_togglebox {
8321: return '</td></tr>'.&end_data_table();
8322: }
8323:
1.1041 www 8324: sub LCprogressbar_script {
1.1045 www 8325: my ($id)=@_;
1.1041 www 8326: return(<<ENDPROGRESS);
8327: <script type="text/javascript">
8328: // <![CDATA[
1.1045 www 8329: \$('#progressbar$id').progressbar({
1.1041 www 8330: value: 0,
8331: change: function(event, ui) {
8332: var newVal = \$(this).progressbar('option', 'value');
8333: \$('.pblabel', this).text(LCprogressTxt);
8334: }
8335: });
8336: // ]]>
8337: </script>
8338: ENDPROGRESS
8339: }
8340:
8341: sub LCprogressbarUpdate_script {
8342: return(<<ENDPROGRESSUPDATE);
8343: <style type="text/css">
8344: .ui-progressbar { position:relative; }
8345: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8346: </style>
8347: <script type="text/javascript">
8348: // <![CDATA[
1.1045 www 8349: var LCprogressTxt='---';
8350:
8351: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8352: LCprogressTxt=progresstext;
1.1045 www 8353: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8354: }
8355: // ]]>
8356: </script>
8357: ENDPROGRESSUPDATE
8358: }
8359:
1.1042 www 8360: my $LClastpercent;
1.1045 www 8361: my $LCidcnt;
8362: my $LCcurrentid;
1.1042 www 8363:
1.1041 www 8364: sub LCprogressbar {
1.1042 www 8365: my ($r)=(@_);
8366: $LClastpercent=0;
1.1045 www 8367: $LCidcnt++;
8368: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8369: my $starting=&mt('Starting');
8370: my $content=(<<ENDPROGBAR);
1.1045 www 8371: <div id="progressbar$LCcurrentid">
1.1041 www 8372: <span class="pblabel">$starting</span>
8373: </div>
8374: ENDPROGBAR
1.1045 www 8375: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8376: }
8377:
8378: sub LCprogressbarUpdate {
1.1042 www 8379: my ($r,$val,$text)=@_;
8380: unless ($val) {
8381: if ($LClastpercent) {
8382: $val=$LClastpercent;
8383: } else {
8384: $val=0;
8385: }
8386: }
1.1041 www 8387: if ($val<0) { $val=0; }
8388: if ($val>100) { $val=0; }
1.1042 www 8389: $LClastpercent=$val;
1.1041 www 8390: unless ($text) { $text=$val.'%'; }
8391: $text=&js_ready($text);
1.1044 www 8392: &r_print($r,<<ENDUPDATE);
1.1041 www 8393: <script type="text/javascript">
8394: // <![CDATA[
1.1045 www 8395: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8396: // ]]>
8397: </script>
8398: ENDUPDATE
1.1035 www 8399: }
8400:
1.1042 www 8401: sub LCprogressbarClose {
8402: my ($r)=@_;
8403: $LClastpercent=0;
1.1044 www 8404: &r_print($r,<<ENDCLOSE);
1.1042 www 8405: <script type="text/javascript">
8406: // <![CDATA[
1.1045 www 8407: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8408: // ]]>
8409: </script>
8410: ENDCLOSE
1.1044 www 8411: }
8412:
8413: sub r_print {
8414: my ($r,$to_print)=@_;
8415: if ($r) {
8416: $r->print($to_print);
8417: $r->rflush();
8418: } else {
8419: print($to_print);
8420: }
1.1042 www 8421: }
8422:
1.320 albertel 8423: sub html_encode {
8424: my ($result) = @_;
8425:
1.322 albertel 8426: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8427:
8428: return $result;
8429: }
1.1044 www 8430:
1.317 albertel 8431: sub js_ready {
8432: my ($result) = @_;
8433:
1.323 albertel 8434: $result =~ s/[\n\r]/ /xmsg;
8435: $result =~ s/\\/\\\\/xmsg;
8436: $result =~ s/'/\\'/xmsg;
1.372 albertel 8437: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8438:
8439: return $result;
8440: }
8441:
1.315 albertel 8442: sub validate_page {
8443: if ( exists($env{'internal.start_page'})
1.316 albertel 8444: && $env{'internal.start_page'} > 1) {
8445: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8446: $env{'internal.start_page'}.' '.
1.316 albertel 8447: $ENV{'request.filename'});
1.315 albertel 8448: }
8449: if ( exists($env{'internal.end_page'})
1.316 albertel 8450: && $env{'internal.end_page'} > 1) {
8451: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8452: $env{'internal.end_page'}.' '.
1.316 albertel 8453: $env{'request.filename'});
1.315 albertel 8454: }
8455: if ( exists($env{'internal.start_page'})
8456: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8457: &Apache::lonnet::logthis('start_page called without end_page '.
8458: $env{'request.filename'});
1.315 albertel 8459: }
8460: if ( ! exists($env{'internal.start_page'})
8461: && exists($env{'internal.end_page'})) {
1.316 albertel 8462: &Apache::lonnet::logthis('end_page called without start_page'.
8463: $env{'request.filename'});
1.315 albertel 8464: }
1.306 albertel 8465: }
1.315 albertel 8466:
1.996 www 8467:
8468: sub start_scrollbox {
1.1140 raeburn 8469: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8470: unless ($outerwidth) { $outerwidth='520px'; }
8471: unless ($width) { $width='500px'; }
8472: unless ($height) { $height='200px'; }
1.1075 raeburn 8473: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8474: if ($id ne '') {
1.1140 raeburn 8475: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8476: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8477: }
1.1075 raeburn 8478: if ($bgcolor ne '') {
8479: $tdcol = "background-color: $bgcolor;";
8480: }
1.1137 raeburn 8481: my $nicescroll_js;
8482: if ($env{'browser.mobile'}) {
1.1140 raeburn 8483: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8484: }
8485: return <<"END";
8486: $nicescroll_js
8487:
8488: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8489: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8490: END
8491: }
8492:
8493: sub end_scrollbox {
8494: return '</div></td></tr></table>';
8495: }
8496:
8497: sub nicescroll_javascript {
8498: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8499: my %options;
8500: if (ref($cursor) eq 'HASH') {
8501: %options = %{$cursor};
8502: }
8503: unless ($options{'railalign'} =~ /^left|right$/) {
8504: $options{'railalign'} = 'left';
8505: }
8506: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8507: my $function = &get_users_function();
8508: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8509: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8510: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8511: }
1.1140 raeburn 8512: }
8513: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8514: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8515: $options{'cursoropacity'}='1.0';
8516: }
1.1140 raeburn 8517: } else {
8518: $options{'cursoropacity'}='1.0';
8519: }
8520: if ($options{'cursorfixedheight'} eq 'none') {
8521: delete($options{'cursorfixedheight'});
8522: } else {
8523: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8524: }
8525: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8526: delete($options{'railoffset'});
8527: }
8528: my @niceoptions;
8529: while (my($key,$value) = each(%options)) {
8530: if ($value =~ /^\{.+\}$/) {
8531: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8532: } else {
1.1140 raeburn 8533: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8534: }
1.1140 raeburn 8535: }
8536: my $nicescroll_js = '
1.1137 raeburn 8537: $(document).ready(
1.1140 raeburn 8538: function() {
8539: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8540: }
1.1137 raeburn 8541: );
8542: ';
1.1140 raeburn 8543: if ($framecheck) {
8544: $nicescroll_js .= '
8545: function expand_div(caller) {
8546: if (top === self) {
8547: document.getElementById("'.$id.'").style.width = "auto";
8548: document.getElementById("'.$id.'").style.height = "auto";
8549: } else {
8550: try {
8551: if (parent.frames) {
8552: if (parent.frames.length > 1) {
8553: var framesrc = parent.frames[1].location.href;
8554: var currsrc = framesrc.replace(/\#.*$/,"");
8555: if ((caller == "search") || (currsrc == "'.$location.'")) {
8556: document.getElementById("'.$id.'").style.width = "auto";
8557: document.getElementById("'.$id.'").style.height = "auto";
8558: }
8559: }
8560: }
8561: } catch (e) {
8562: return;
8563: }
1.1137 raeburn 8564: }
1.1140 raeburn 8565: return;
1.996 www 8566: }
1.1140 raeburn 8567: ';
8568: }
8569: if ($needjsready) {
8570: $nicescroll_js = '
8571: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8572: } else {
8573: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8574: }
8575: return $nicescroll_js;
1.996 www 8576: }
8577:
1.318 albertel 8578: sub simple_error_page {
1.1150 bisitz 8579: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8580: if (ref($args) eq 'HASH') {
8581: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8582: } else {
8583: $msg = &mt($msg);
8584: }
1.1150 bisitz 8585:
1.318 albertel 8586: my $page =
8587: &Apache::loncommon::start_page($title).
1.1150 bisitz 8588: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8589: &Apache::loncommon::end_page();
8590: if (ref($r)) {
8591: $r->print($page);
1.327 albertel 8592: return;
1.318 albertel 8593: }
8594: return $page;
8595: }
1.347 albertel 8596:
8597: {
1.610 albertel 8598: my @row_count;
1.961 onken 8599:
8600: sub start_data_table_count {
8601: unshift(@row_count, 0);
8602: return;
8603: }
8604:
8605: sub end_data_table_count {
8606: shift(@row_count);
8607: return;
8608: }
8609:
1.347 albertel 8610: sub start_data_table {
1.1018 raeburn 8611: my ($add_class,$id) = @_;
1.422 albertel 8612: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8613: my $table_id;
8614: if (defined($id)) {
8615: $table_id = ' id="'.$id.'"';
8616: }
1.961 onken 8617: &start_data_table_count();
1.1018 raeburn 8618: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8619: }
8620:
8621: sub end_data_table {
1.961 onken 8622: &end_data_table_count();
1.389 albertel 8623: return '</table>'."\n";;
1.347 albertel 8624: }
8625:
8626: sub start_data_table_row {
1.974 wenzelju 8627: my ($add_class, $id) = @_;
1.610 albertel 8628: $row_count[0]++;
8629: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8630: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8631: $id = (' id="'.$id.'"') unless ($id eq '');
8632: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8633: }
1.471 banghart 8634:
8635: sub continue_data_table_row {
1.974 wenzelju 8636: my ($add_class, $id) = @_;
1.610 albertel 8637: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8638: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8639: $id = (' id="'.$id.'"') unless ($id eq '');
8640: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8641: }
1.347 albertel 8642:
8643: sub end_data_table_row {
1.389 albertel 8644: return '</tr>'."\n";;
1.347 albertel 8645: }
1.367 www 8646:
1.421 albertel 8647: sub start_data_table_empty_row {
1.707 bisitz 8648: # $row_count[0]++;
1.421 albertel 8649: return '<tr class="LC_empty_row" >'."\n";;
8650: }
8651:
8652: sub end_data_table_empty_row {
8653: return '</tr>'."\n";;
8654: }
8655:
1.367 www 8656: sub start_data_table_header_row {
1.389 albertel 8657: return '<tr class="LC_header_row">'."\n";;
1.367 www 8658: }
8659:
8660: sub end_data_table_header_row {
1.389 albertel 8661: return '</tr>'."\n";;
1.367 www 8662: }
1.890 droeschl 8663:
8664: sub data_table_caption {
8665: my $caption = shift;
8666: return "<caption class=\"LC_caption\">$caption</caption>";
8667: }
1.347 albertel 8668: }
8669:
1.548 albertel 8670: =pod
8671:
8672: =item * &inhibit_menu_check($arg)
8673:
8674: Checks for a inhibitmenu state and generates output to preserve it
8675:
8676: Inputs: $arg - can be any of
8677: - undef - in which case the return value is a string
8678: to add into arguments list of a uri
8679: - 'input' - in which case the return value is a HTML
8680: <form> <input> field of type hidden to
8681: preserve the value
8682: - a url - in which case the return value is the url with
8683: the neccesary cgi args added to preserve the
8684: inhibitmenu state
8685: - a ref to a url - no return value, but the string is
8686: updated to include the neccessary cgi
8687: args to preserve the inhibitmenu state
8688:
8689: =cut
8690:
8691: sub inhibit_menu_check {
8692: my ($arg) = @_;
8693: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8694: if ($arg eq 'input') {
8695: if ($env{'form.inhibitmenu'}) {
8696: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8697: } else {
8698: return
8699: }
8700: }
8701: if ($env{'form.inhibitmenu'}) {
8702: if (ref($arg)) {
8703: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8704: } elsif ($arg eq '') {
8705: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8706: } else {
8707: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8708: }
8709: }
8710: if (!ref($arg)) {
8711: return $arg;
8712: }
8713: }
8714:
1.251 albertel 8715: ###############################################
1.182 matthew 8716:
8717: =pod
8718:
1.549 albertel 8719: =back
8720:
8721: =head1 User Information Routines
8722:
8723: =over 4
8724:
1.405 albertel 8725: =item * &get_users_function()
1.182 matthew 8726:
8727: Used by &bodytag to determine the current users primary role.
8728: Returns either 'student','coordinator','admin', or 'author'.
8729:
8730: =cut
8731:
8732: ###############################################
8733: sub get_users_function {
1.815 tempelho 8734: my $function = 'norole';
1.818 tempelho 8735: if ($env{'request.role'}=~/^(st)/) {
8736: $function='student';
8737: }
1.907 raeburn 8738: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8739: $function='coordinator';
8740: }
1.258 albertel 8741: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8742: $function='admin';
8743: }
1.826 bisitz 8744: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8745: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8746: $function='author';
8747: }
8748: return $function;
1.54 www 8749: }
1.99 www 8750:
8751: ###############################################
8752:
1.233 raeburn 8753: =pod
8754:
1.821 raeburn 8755: =item * &show_course()
8756:
8757: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8758: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8759:
8760: Inputs:
8761: None
8762:
8763: Outputs:
8764: Scalar: 1 if 'Course' to be used, 0 otherwise.
8765:
8766: =cut
8767:
8768: ###############################################
8769: sub show_course {
8770: my $course = !$env{'user.adv'};
8771: if (!$env{'user.adv'}) {
8772: foreach my $env (keys(%env)) {
8773: next if ($env !~ m/^user\.priv\./);
8774: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8775: $course = 0;
8776: last;
8777: }
8778: }
8779: }
8780: return $course;
8781: }
8782:
8783: ###############################################
8784:
8785: =pod
8786:
1.542 raeburn 8787: =item * &check_user_status()
1.274 raeburn 8788:
8789: Determines current status of supplied role for a
8790: specific user. Roles can be active, previous or future.
8791:
8792: Inputs:
8793: user's domain, user's username, course's domain,
1.375 raeburn 8794: course's number, optional section ID.
1.274 raeburn 8795:
8796: Outputs:
8797: role status: active, previous or future.
8798:
8799: =cut
8800:
8801: sub check_user_status {
1.412 raeburn 8802: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8803: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 8804: my @uroles = keys(%userinfo);
1.274 raeburn 8805: my $srchstr;
8806: my $active_chk = 'none';
1.412 raeburn 8807: my $now = time;
1.274 raeburn 8808: if (@uroles > 0) {
1.908 raeburn 8809: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8810: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8811: } else {
1.412 raeburn 8812: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8813: }
8814: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8815: my $role_end = 0;
8816: my $role_start = 0;
8817: $active_chk = 'active';
1.412 raeburn 8818: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8819: $role_end = $1;
8820: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8821: $role_start = $1;
1.274 raeburn 8822: }
8823: }
8824: if ($role_start > 0) {
1.412 raeburn 8825: if ($now < $role_start) {
1.274 raeburn 8826: $active_chk = 'future';
8827: }
8828: }
8829: if ($role_end > 0) {
1.412 raeburn 8830: if ($now > $role_end) {
1.274 raeburn 8831: $active_chk = 'previous';
8832: }
8833: }
8834: }
8835: }
8836: return $active_chk;
8837: }
8838:
8839: ###############################################
8840:
8841: =pod
8842:
1.405 albertel 8843: =item * &get_sections()
1.233 raeburn 8844:
8845: Determines all the sections for a course including
8846: sections with students and sections containing other roles.
1.419 raeburn 8847: Incoming parameters:
8848:
8849: 1. domain
8850: 2. course number
8851: 3. reference to array containing roles for which sections should
8852: be gathered (optional).
8853: 4. reference to array containing status types for which sections
8854: should be gathered (optional).
8855:
8856: If the third argument is undefined, sections are gathered for any role.
8857: If the fourth argument is undefined, sections are gathered for any status.
8858: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8859:
1.374 raeburn 8860: Returns section hash (keys are section IDs, values are
8861: number of users in each section), subject to the
1.419 raeburn 8862: optional roles filter, optional status filter
1.233 raeburn 8863:
8864: =cut
8865:
8866: ###############################################
8867: sub get_sections {
1.419 raeburn 8868: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8869: if (!defined($cdom) || !defined($cnum)) {
8870: my $cid = $env{'request.course.id'};
8871:
8872: return if (!defined($cid));
8873:
8874: $cdom = $env{'course.'.$cid.'.domain'};
8875: $cnum = $env{'course.'.$cid.'.num'};
8876: }
8877:
8878: my %sectioncount;
1.419 raeburn 8879: my $now = time;
1.240 albertel 8880:
1.1118 raeburn 8881: my $check_students = 1;
8882: my $only_students = 0;
8883: if (ref($possible_roles) eq 'ARRAY') {
8884: if (grep(/^st$/,@{$possible_roles})) {
8885: if (@{$possible_roles} == 1) {
8886: $only_students = 1;
8887: }
8888: } else {
8889: $check_students = 0;
8890: }
8891: }
8892:
8893: if ($check_students) {
1.276 albertel 8894: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8895: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8896: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8897: my $start_index = &Apache::loncoursedata::CL_START();
8898: my $end_index = &Apache::loncoursedata::CL_END();
8899: my $status;
1.366 albertel 8900: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8901: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8902: $data->[$status_index],
8903: $data->[$start_index],
8904: $data->[$end_index]);
8905: if ($stu_status eq 'Active') {
8906: $status = 'active';
8907: } elsif ($end < $now) {
8908: $status = 'previous';
8909: } elsif ($start > $now) {
8910: $status = 'future';
8911: }
8912: if ($section ne '-1' && $section !~ /^\s*$/) {
8913: if ((!defined($possible_status)) || (($status ne '') &&
8914: (grep/^\Q$status\E$/,@{$possible_status}))) {
8915: $sectioncount{$section}++;
8916: }
1.240 albertel 8917: }
8918: }
8919: }
1.1118 raeburn 8920: if ($only_students) {
8921: return %sectioncount;
8922: }
1.240 albertel 8923: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8924: foreach my $user (sort(keys(%courseroles))) {
8925: if ($user !~ /^(\w{2})/) { next; }
8926: my ($role) = ($user =~ /^(\w{2})/);
8927: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8928: my ($section,$status);
1.240 albertel 8929: if ($role eq 'cr' &&
8930: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8931: $section=$1;
8932: }
8933: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8934: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8935: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8936: if ($end == -1 && $start == -1) {
8937: next; #deleted role
8938: }
8939: if (!defined($possible_status)) {
8940: $sectioncount{$section}++;
8941: } else {
8942: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8943: $status = 'active';
8944: } elsif ($end < $now) {
8945: $status = 'future';
8946: } elsif ($start > $now) {
8947: $status = 'previous';
8948: }
8949: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8950: $sectioncount{$section}++;
8951: }
8952: }
1.233 raeburn 8953: }
1.366 albertel 8954: return %sectioncount;
1.233 raeburn 8955: }
8956:
1.274 raeburn 8957: ###############################################
1.294 raeburn 8958:
8959: =pod
1.405 albertel 8960:
8961: =item * &get_course_users()
8962:
1.275 raeburn 8963: Retrieves usernames:domains for users in the specified course
8964: with specific role(s), and access status.
8965:
8966: Incoming parameters:
1.277 albertel 8967: 1. course domain
8968: 2. course number
8969: 3. access status: users must have - either active,
1.275 raeburn 8970: previous, future, or all.
1.277 albertel 8971: 4. reference to array of permissible roles
1.288 raeburn 8972: 5. reference to array of section restrictions (optional)
8973: 6. reference to results object (hash of hashes).
8974: 7. reference to optional userdata hash
1.609 raeburn 8975: 8. reference to optional statushash
1.630 raeburn 8976: 9. flag if privileged users (except those set to unhide in
8977: course settings) should be excluded
1.609 raeburn 8978: Keys of top level results hash are roles.
1.275 raeburn 8979: Keys of inner hashes are username:domain, with
8980: values set to access type.
1.288 raeburn 8981: Optional userdata hash returns an array with arguments in the
8982: same order as loncoursedata::get_classlist() for student data.
8983:
1.609 raeburn 8984: Optional statushash returns
8985:
1.288 raeburn 8986: Entries for end, start, section and status are blank because
8987: of the possibility of multiple values for non-student roles.
8988:
1.275 raeburn 8989: =cut
1.405 albertel 8990:
1.275 raeburn 8991: ###############################################
1.405 albertel 8992:
1.275 raeburn 8993: sub get_course_users {
1.630 raeburn 8994: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8995: my %idx = ();
1.419 raeburn 8996: my %seclists;
1.288 raeburn 8997:
8998: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8999: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9000: $idx{end} = &Apache::loncoursedata::CL_END();
9001: $idx{start} = &Apache::loncoursedata::CL_START();
9002: $idx{id} = &Apache::loncoursedata::CL_ID();
9003: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9004: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9005: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9006:
1.290 albertel 9007: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9008: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9009: my $now = time;
1.277 albertel 9010: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9011: my $match = 0;
1.412 raeburn 9012: my $secmatch = 0;
1.419 raeburn 9013: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9014: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9015: if ($section eq '') {
9016: $section = 'none';
9017: }
1.291 albertel 9018: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9019: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9020: $secmatch = 1;
9021: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9022: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9023: $secmatch = 1;
9024: }
9025: } else {
1.419 raeburn 9026: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9027: $secmatch = 1;
9028: }
1.290 albertel 9029: }
1.412 raeburn 9030: if (!$secmatch) {
9031: next;
9032: }
1.419 raeburn 9033: }
1.275 raeburn 9034: if (defined($$types{'active'})) {
1.288 raeburn 9035: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9036: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9037: $match = 1;
1.275 raeburn 9038: }
9039: }
9040: if (defined($$types{'previous'})) {
1.609 raeburn 9041: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9042: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9043: $match = 1;
1.275 raeburn 9044: }
9045: }
9046: if (defined($$types{'future'})) {
1.609 raeburn 9047: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9048: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9049: $match = 1;
1.275 raeburn 9050: }
9051: }
1.609 raeburn 9052: if ($match) {
9053: push(@{$seclists{$student}},$section);
9054: if (ref($userdata) eq 'HASH') {
9055: $$userdata{$student} = $$classlist{$student};
9056: }
9057: if (ref($statushash) eq 'HASH') {
9058: $statushash->{$student}{'st'}{$section} = $status;
9059: }
1.288 raeburn 9060: }
1.275 raeburn 9061: }
9062: }
1.412 raeburn 9063: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9064: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9065: my $now = time;
1.609 raeburn 9066: my %displaystatus = ( previous => 'Expired',
9067: active => 'Active',
9068: future => 'Future',
9069: );
1.1121 raeburn 9070: my (%nothide,@possdoms);
1.630 raeburn 9071: if ($hidepriv) {
9072: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9073: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9074: if ($user !~ /:/) {
9075: $nothide{join(':',split(/[\@]/,$user))}=1;
9076: } else {
9077: $nothide{$user} = 1;
9078: }
9079: }
1.1121 raeburn 9080: my @possdoms = ($cdom);
9081: if ($coursehash{'checkforpriv'}) {
9082: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9083: }
1.630 raeburn 9084: }
1.439 raeburn 9085: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9086: my $match = 0;
1.412 raeburn 9087: my $secmatch = 0;
1.439 raeburn 9088: my $status;
1.412 raeburn 9089: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9090: $user =~ s/:$//;
1.439 raeburn 9091: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9092: if ($end == -1 || $start == -1) {
9093: next;
9094: }
9095: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9096: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9097: my ($uname,$udom) = split(/:/,$user);
9098: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9099: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9100: $secmatch = 1;
9101: } elsif ($usec eq '') {
1.420 albertel 9102: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9103: $secmatch = 1;
9104: }
9105: } else {
9106: if (grep(/^\Q$usec\E$/,@{$sections})) {
9107: $secmatch = 1;
9108: }
9109: }
9110: if (!$secmatch) {
9111: next;
9112: }
1.288 raeburn 9113: }
1.419 raeburn 9114: if ($usec eq '') {
9115: $usec = 'none';
9116: }
1.275 raeburn 9117: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9118: if ($hidepriv) {
1.1121 raeburn 9119: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9120: (!$nothide{$uname.':'.$udom})) {
9121: next;
9122: }
9123: }
1.503 raeburn 9124: if ($end > 0 && $end < $now) {
1.439 raeburn 9125: $status = 'previous';
9126: } elsif ($start > $now) {
9127: $status = 'future';
9128: } else {
9129: $status = 'active';
9130: }
1.277 albertel 9131: foreach my $type (keys(%{$types})) {
1.275 raeburn 9132: if ($status eq $type) {
1.420 albertel 9133: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9134: push(@{$$users{$role}{$user}},$type);
9135: }
1.288 raeburn 9136: $match = 1;
9137: }
9138: }
1.419 raeburn 9139: if (($match) && (ref($userdata) eq 'HASH')) {
9140: if (!exists($$userdata{$uname.':'.$udom})) {
9141: &get_user_info($udom,$uname,\%idx,$userdata);
9142: }
1.420 albertel 9143: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9144: push(@{$seclists{$uname.':'.$udom}},$usec);
9145: }
1.609 raeburn 9146: if (ref($statushash) eq 'HASH') {
9147: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9148: }
1.275 raeburn 9149: }
9150: }
9151: }
9152: }
1.290 albertel 9153: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9154: if ((defined($cdom)) && (defined($cnum))) {
9155: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9156: if ( defined($csettings{'internal.courseowner'}) ) {
9157: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9158: next if ($owner eq '');
9159: my ($ownername,$ownerdom);
9160: if ($owner =~ /^([^:]+):([^:]+)$/) {
9161: $ownername = $1;
9162: $ownerdom = $2;
9163: } else {
9164: $ownername = $owner;
9165: $ownerdom = $cdom;
9166: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9167: }
9168: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9169: if (defined($userdata) &&
1.609 raeburn 9170: !exists($$userdata{$owner})) {
9171: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9172: if (!grep(/^none$/,@{$seclists{$owner}})) {
9173: push(@{$seclists{$owner}},'none');
9174: }
9175: if (ref($statushash) eq 'HASH') {
9176: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9177: }
1.290 albertel 9178: }
1.279 raeburn 9179: }
9180: }
9181: }
1.419 raeburn 9182: foreach my $user (keys(%seclists)) {
9183: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9184: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9185: }
1.275 raeburn 9186: }
9187: return;
9188: }
9189:
1.288 raeburn 9190: sub get_user_info {
9191: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9192: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9193: &plainname($uname,$udom,'lastname');
1.291 albertel 9194: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9195: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9196: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9197: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9198: return;
9199: }
1.275 raeburn 9200:
1.472 raeburn 9201: ###############################################
9202:
9203: =pod
9204:
9205: =item * &get_user_quota()
9206:
1.1134 raeburn 9207: Retrieves quota assigned for storage of user files.
9208: Default is to report quota for portfolio files.
1.472 raeburn 9209:
9210: Incoming parameters:
9211: 1. user's username
9212: 2. user's domain
1.1134 raeburn 9213: 3. quota name - portfolio, author, or course
1.1136 raeburn 9214: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 9215: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 9216: course
1.472 raeburn 9217:
9218: Returns:
1.1163 raeburn 9219: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9220: 2. (Optional) Type of setting: custom or default
9221: (individually assigned or default for user's
9222: institutional status).
9223: 3. (Optional) - User's institutional status (e.g., faculty, staff
9224: or student - types as defined in localenroll::inst_usertypes
9225: for user's domain, which determines default quota for user.
9226: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9227:
9228: If a value has been stored in the user's environment,
1.536 raeburn 9229: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9230: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9231:
9232: =cut
9233:
9234: ###############################################
9235:
9236:
9237: sub get_user_quota {
1.1136 raeburn 9238: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9239: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9240: if (!defined($udom)) {
9241: $udom = $env{'user.domain'};
9242: }
9243: if (!defined($uname)) {
9244: $uname = $env{'user.name'};
9245: }
9246: if (($udom eq '' || $uname eq '') ||
9247: ($udom eq 'public') && ($uname eq 'public')) {
9248: $quota = 0;
1.536 raeburn 9249: $quotatype = 'default';
9250: $defquota = 0;
1.472 raeburn 9251: } else {
1.536 raeburn 9252: my $inststatus;
1.1134 raeburn 9253: if ($quotaname eq 'course') {
9254: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9255: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9256: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9257: } else {
9258: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9259: $quota = $cenv{'internal.uploadquota'};
9260: }
1.536 raeburn 9261: } else {
1.1134 raeburn 9262: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9263: if ($quotaname eq 'author') {
9264: $quota = $env{'environment.authorquota'};
9265: } else {
9266: $quota = $env{'environment.portfolioquota'};
9267: }
9268: $inststatus = $env{'environment.inststatus'};
9269: } else {
9270: my %userenv =
9271: &Apache::lonnet::get('environment',['portfolioquota',
9272: 'authorquota','inststatus'],$udom,$uname);
9273: my ($tmp) = keys(%userenv);
9274: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9275: if ($quotaname eq 'author') {
9276: $quota = $userenv{'authorquota'};
9277: } else {
9278: $quota = $userenv{'portfolioquota'};
9279: }
9280: $inststatus = $userenv{'inststatus'};
9281: } else {
9282: undef(%userenv);
9283: }
9284: }
9285: }
9286: if ($quota eq '' || wantarray) {
9287: if ($quotaname eq 'course') {
9288: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9289: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
9290: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 9291: $defquota = $domdefs{$crstype.'quota'};
9292: }
9293: if ($defquota eq '') {
9294: $defquota = 500;
9295: }
1.1134 raeburn 9296: } else {
9297: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9298: }
9299: if ($quota eq '') {
9300: $quota = $defquota;
9301: $quotatype = 'default';
9302: } else {
9303: $quotatype = 'custom';
9304: }
1.472 raeburn 9305: }
9306: }
1.536 raeburn 9307: if (wantarray) {
9308: return ($quota,$quotatype,$settingstatus,$defquota);
9309: } else {
9310: return $quota;
9311: }
1.472 raeburn 9312: }
9313:
9314: ###############################################
9315:
9316: =pod
9317:
9318: =item * &default_quota()
9319:
1.536 raeburn 9320: Retrieves default quota assigned for storage of user portfolio files,
9321: given an (optional) user's institutional status.
1.472 raeburn 9322:
9323: Incoming parameters:
1.1142 raeburn 9324:
1.472 raeburn 9325: 1. domain
1.536 raeburn 9326: 2. (Optional) institutional status(es). This is a : separated list of
9327: status types (e.g., faculty, staff, student etc.)
9328: which apply to the user for whom the default is being retrieved.
9329: If the institutional status string in undefined, the domain
1.1134 raeburn 9330: default quota will be returned.
9331: 3. quota name - portfolio, author, or course
9332: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9333:
9334: Returns:
1.1142 raeburn 9335:
1.1163 raeburn 9336: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9337: 2. (Optional) institutional type which determined the value of the
9338: default quota.
1.472 raeburn 9339:
9340: If a value has been stored in the domain's configuration db,
9341: it will return that, otherwise it returns 20 (for backwards
9342: compatibility with domains which have not set up a configuration
1.1163 raeburn 9343: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9344:
1.536 raeburn 9345: If the user's status includes multiple types (e.g., staff and student),
9346: the largest default quota which applies to the user determines the
9347: default quota returned.
9348:
1.472 raeburn 9349: =cut
9350:
9351: ###############################################
9352:
9353:
9354: sub default_quota {
1.1134 raeburn 9355: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9356: my ($defquota,$settingstatus);
9357: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9358: ['quotas'],$udom);
1.1134 raeburn 9359: my $key = 'defaultquota';
9360: if ($quotaname eq 'author') {
9361: $key = 'authorquota';
9362: }
1.622 raeburn 9363: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9364: if ($inststatus ne '') {
1.765 raeburn 9365: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9366: foreach my $item (@statuses) {
1.1134 raeburn 9367: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9368: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9369: if ($defquota eq '') {
1.1134 raeburn 9370: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9371: $settingstatus = $item;
1.1134 raeburn 9372: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9373: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9374: $settingstatus = $item;
9375: }
9376: }
1.1134 raeburn 9377: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9378: if ($quotahash{'quotas'}{$item} ne '') {
9379: if ($defquota eq '') {
9380: $defquota = $quotahash{'quotas'}{$item};
9381: $settingstatus = $item;
9382: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9383: $defquota = $quotahash{'quotas'}{$item};
9384: $settingstatus = $item;
9385: }
1.536 raeburn 9386: }
9387: }
9388: }
9389: }
9390: if ($defquota eq '') {
1.1134 raeburn 9391: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9392: $defquota = $quotahash{'quotas'}{$key}{'default'};
9393: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9394: $defquota = $quotahash{'quotas'}{'default'};
9395: }
1.536 raeburn 9396: $settingstatus = 'default';
1.1139 raeburn 9397: if ($defquota eq '') {
9398: if ($quotaname eq 'author') {
9399: $defquota = 500;
9400: }
9401: }
1.536 raeburn 9402: }
9403: } else {
9404: $settingstatus = 'default';
1.1134 raeburn 9405: if ($quotaname eq 'author') {
9406: $defquota = 500;
9407: } else {
9408: $defquota = 20;
9409: }
1.536 raeburn 9410: }
9411: if (wantarray) {
9412: return ($defquota,$settingstatus);
1.472 raeburn 9413: } else {
1.536 raeburn 9414: return $defquota;
1.472 raeburn 9415: }
9416: }
9417:
1.1135 raeburn 9418: ###############################################
9419:
9420: =pod
9421:
1.1136 raeburn 9422: =item * &excess_filesize_warning()
1.1135 raeburn 9423:
9424: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9425: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9426: space to be exceeded.
1.1136 raeburn 9427:
9428: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9429: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9430:
1.1165 raeburn 9431: Inputs: 7
1.1136 raeburn 9432: 1. username or coursenum
1.1135 raeburn 9433: 2. domain
1.1136 raeburn 9434: 3. context ('author' or 'course')
1.1135 raeburn 9435: 4. filename of file for which action is being requested
9436: 5. filesize (kB) of file
9437: 6. action being taken: copy or upload.
1.1165 raeburn 9438: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 9439:
9440: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9441: otherwise return null.
9442:
9443: =back
1.1135 raeburn 9444:
9445: =cut
9446:
1.1136 raeburn 9447: sub excess_filesize_warning {
1.1165 raeburn 9448: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9449: my $current_disk_usage = 0;
1.1165 raeburn 9450: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9451: if ($context eq 'author') {
9452: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9453: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9454: } else {
9455: foreach my $subdir ('docs','supplemental') {
9456: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9457: }
9458: }
1.1135 raeburn 9459: $disk_quota = int($disk_quota * 1000);
9460: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9461: return '<p class="LC_warning">'.
1.1135 raeburn 9462: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9463: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9464: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9465: $disk_quota,$current_disk_usage).
9466: '</p>';
9467: }
9468: return;
9469: }
9470:
9471: ###############################################
9472:
9473:
1.1136 raeburn 9474:
9475:
1.384 raeburn 9476: sub get_secgrprole_info {
9477: my ($cdom,$cnum,$needroles,$type) = @_;
9478: my %sections_count = &get_sections($cdom,$cnum);
9479: my @sections = (sort {$a <=> $b} keys(%sections_count));
9480: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9481: my @groups = sort(keys(%curr_groups));
9482: my $allroles = [];
9483: my $rolehash;
9484: my $accesshash = {
9485: active => 'Currently has access',
9486: future => 'Will have future access',
9487: previous => 'Previously had access',
9488: };
9489: if ($needroles) {
9490: $rolehash = {'all' => 'all'};
1.385 albertel 9491: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9492: if (&Apache::lonnet::error(%user_roles)) {
9493: undef(%user_roles);
9494: }
9495: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9496: my ($role)=split(/\:/,$item,2);
9497: if ($role eq 'cr') { next; }
9498: if ($role =~ /^cr/) {
9499: $$rolehash{$role} = (split('/',$role))[3];
9500: } else {
9501: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9502: }
9503: }
9504: foreach my $key (sort(keys(%{$rolehash}))) {
9505: push(@{$allroles},$key);
9506: }
9507: push (@{$allroles},'st');
9508: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9509: }
9510: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9511: }
9512:
1.555 raeburn 9513: sub user_picker {
1.994 raeburn 9514: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9515: my $currdom = $dom;
9516: my %curr_selected = (
9517: srchin => 'dom',
1.580 raeburn 9518: srchby => 'lastname',
1.555 raeburn 9519: );
9520: my $srchterm;
1.625 raeburn 9521: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9522: if ($srch->{'srchby'} ne '') {
9523: $curr_selected{'srchby'} = $srch->{'srchby'};
9524: }
9525: if ($srch->{'srchin'} ne '') {
9526: $curr_selected{'srchin'} = $srch->{'srchin'};
9527: }
9528: if ($srch->{'srchtype'} ne '') {
9529: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9530: }
9531: if ($srch->{'srchdomain'} ne '') {
9532: $currdom = $srch->{'srchdomain'};
9533: }
9534: $srchterm = $srch->{'srchterm'};
9535: }
9536: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9537: 'usr' => 'Search criteria',
1.563 raeburn 9538: 'doma' => 'Domain/institution to search',
1.558 albertel 9539: 'uname' => 'username',
9540: 'lastname' => 'last name',
1.555 raeburn 9541: 'lastfirst' => 'last name, first name',
1.558 albertel 9542: 'crs' => 'in this course',
1.576 raeburn 9543: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9544: 'alc' => 'all LON-CAPA',
1.573 raeburn 9545: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9546: 'exact' => 'is',
9547: 'contains' => 'contains',
1.569 raeburn 9548: 'begins' => 'begins with',
1.571 raeburn 9549: 'youm' => "You must include some text to search for.",
9550: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9551: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9552: 'yomc' => "You must choose a domain when using an institutional directory search.",
9553: 'ymcd' => "You must choose a domain when using a domain search.",
9554: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9555: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9556: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9557: );
1.563 raeburn 9558: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9559: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9560:
9561: my @srchins = ('crs','dom','alc','instd');
9562:
9563: foreach my $option (@srchins) {
9564: # FIXME 'alc' option unavailable until
9565: # loncreateuser::print_user_query_page()
9566: # has been completed.
9567: next if ($option eq 'alc');
1.880 raeburn 9568: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9569: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9570: if ($curr_selected{'srchin'} eq $option) {
9571: $srchinsel .= '
9572: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9573: } else {
9574: $srchinsel .= '
9575: <option value="'.$option.'">'.$lt{$option}.'</option>';
9576: }
1.555 raeburn 9577: }
1.563 raeburn 9578: $srchinsel .= "\n </select>\n";
1.555 raeburn 9579:
9580: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9581: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9582: if ($curr_selected{'srchby'} eq $option) {
9583: $srchbysel .= '
9584: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9585: } else {
9586: $srchbysel .= '
9587: <option value="'.$option.'">'.$lt{$option}.'</option>';
9588: }
9589: }
9590: $srchbysel .= "\n </select>\n";
9591:
9592: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9593: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9594: if ($curr_selected{'srchtype'} eq $option) {
9595: $srchtypesel .= '
9596: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9597: } else {
9598: $srchtypesel .= '
9599: <option value="'.$option.'">'.$lt{$option}.'</option>';
9600: }
9601: }
9602: $srchtypesel .= "\n </select>\n";
9603:
1.558 albertel 9604: my ($newuserscript,$new_user_create);
1.994 raeburn 9605: my $context_dom = $env{'request.role.domain'};
9606: if ($context eq 'requestcrs') {
9607: if ($env{'form.coursedom'} ne '') {
9608: $context_dom = $env{'form.coursedom'};
9609: }
9610: }
1.556 raeburn 9611: if ($forcenewuser) {
1.576 raeburn 9612: if (ref($srch) eq 'HASH') {
1.994 raeburn 9613: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9614: if ($cancreate) {
9615: $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>';
9616: } else {
1.799 bisitz 9617: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9618: my %usertypetext = (
9619: official => 'institutional',
9620: unofficial => 'non-institutional',
9621: );
1.799 bisitz 9622: $new_user_create = '<p class="LC_warning">'
9623: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9624: .' '
9625: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9626: ,'<a href="'.$helplink.'">','</a>')
9627: .'</p><br />';
1.627 raeburn 9628: }
1.576 raeburn 9629: }
9630: }
9631:
1.556 raeburn 9632: $newuserscript = <<"ENDSCRIPT";
9633:
1.570 raeburn 9634: function setSearch(createnew,callingForm) {
1.556 raeburn 9635: if (createnew == 1) {
1.570 raeburn 9636: for (var i=0; i<callingForm.srchby.length; i++) {
9637: if (callingForm.srchby.options[i].value == 'uname') {
9638: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9639: }
9640: }
1.570 raeburn 9641: for (var i=0; i<callingForm.srchin.length; i++) {
9642: if ( callingForm.srchin.options[i].value == 'dom') {
9643: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9644: }
9645: }
1.570 raeburn 9646: for (var i=0; i<callingForm.srchtype.length; i++) {
9647: if (callingForm.srchtype.options[i].value == 'exact') {
9648: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9649: }
9650: }
1.570 raeburn 9651: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9652: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9653: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9654: }
9655: }
9656: }
9657: }
9658: ENDSCRIPT
1.558 albertel 9659:
1.556 raeburn 9660: }
9661:
1.555 raeburn 9662: my $output = <<"END_BLOCK";
1.556 raeburn 9663: <script type="text/javascript">
1.824 bisitz 9664: // <![CDATA[
1.570 raeburn 9665: function validateEntry(callingForm) {
1.558 albertel 9666:
1.556 raeburn 9667: var checkok = 1;
1.558 albertel 9668: var srchin;
1.570 raeburn 9669: for (var i=0; i<callingForm.srchin.length; i++) {
9670: if ( callingForm.srchin[i].checked ) {
9671: srchin = callingForm.srchin[i].value;
1.558 albertel 9672: }
9673: }
9674:
1.570 raeburn 9675: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9676: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9677: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9678: var srchterm = callingForm.srchterm.value;
9679: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9680: var msg = "";
9681:
9682: if (srchterm == "") {
9683: checkok = 0;
1.571 raeburn 9684: msg += "$lt{'youm'}\\n";
1.556 raeburn 9685: }
9686:
1.569 raeburn 9687: if (srchtype== 'begins') {
9688: if (srchterm.length < 2) {
9689: checkok = 0;
1.571 raeburn 9690: msg += "$lt{'thte'}\\n";
1.569 raeburn 9691: }
9692: }
9693:
1.556 raeburn 9694: if (srchtype== 'contains') {
9695: if (srchterm.length < 3) {
9696: checkok = 0;
1.571 raeburn 9697: msg += "$lt{'thet'}\\n";
1.556 raeburn 9698: }
9699: }
9700: if (srchin == 'instd') {
9701: if (srchdomain == '') {
9702: checkok = 0;
1.571 raeburn 9703: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9704: }
9705: }
9706: if (srchin == 'dom') {
9707: if (srchdomain == '') {
9708: checkok = 0;
1.571 raeburn 9709: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9710: }
9711: }
9712: if (srchby == 'lastfirst') {
9713: if (srchterm.indexOf(",") == -1) {
9714: checkok = 0;
1.571 raeburn 9715: msg += "$lt{'whus'}\\n";
1.556 raeburn 9716: }
9717: if (srchterm.indexOf(",") == srchterm.length -1) {
9718: checkok = 0;
1.571 raeburn 9719: msg += "$lt{'whse'}\\n";
1.556 raeburn 9720: }
9721: }
9722: if (checkok == 0) {
1.571 raeburn 9723: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9724: return;
9725: }
9726: if (checkok == 1) {
1.570 raeburn 9727: callingForm.submit();
1.556 raeburn 9728: }
9729: }
9730:
9731: $newuserscript
9732:
1.824 bisitz 9733: // ]]>
1.556 raeburn 9734: </script>
1.558 albertel 9735:
9736: $new_user_create
9737:
1.555 raeburn 9738: END_BLOCK
1.558 albertel 9739:
1.876 raeburn 9740: $output .= &Apache::lonhtmlcommon::start_pick_box().
9741: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9742: $domform.
9743: &Apache::lonhtmlcommon::row_closure().
9744: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9745: $srchbysel.
9746: $srchtypesel.
9747: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9748: $srchinsel.
9749: &Apache::lonhtmlcommon::row_closure(1).
9750: &Apache::lonhtmlcommon::end_pick_box().
9751: '<br />';
1.555 raeburn 9752: return $output;
9753: }
9754:
1.612 raeburn 9755: sub user_rule_check {
1.615 raeburn 9756: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9757: my $response;
9758: if (ref($usershash) eq 'HASH') {
9759: foreach my $user (keys(%{$usershash})) {
9760: my ($uname,$udom) = split(/:/,$user);
9761: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9762: my ($id,$newuser);
1.612 raeburn 9763: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9764: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9765: $id = $usershash->{$user}->{'id'};
9766: }
9767: my $inst_response;
9768: if (ref($checks) eq 'HASH') {
9769: if (defined($checks->{'username'})) {
1.615 raeburn 9770: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9771: &Apache::lonnet::get_instuser($udom,$uname);
9772: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9773: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9774: &Apache::lonnet::get_instuser($udom,undef,$id);
9775: }
1.615 raeburn 9776: } else {
9777: ($inst_response,%{$inst_results->{$user}}) =
9778: &Apache::lonnet::get_instuser($udom,$uname);
9779: return;
1.612 raeburn 9780: }
1.615 raeburn 9781: if (!$got_rules->{$udom}) {
1.612 raeburn 9782: my %domconfig = &Apache::lonnet::get_dom('configuration',
9783: ['usercreation'],$udom);
9784: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9785: foreach my $item ('username','id') {
1.612 raeburn 9786: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9787: $$curr_rules{$udom}{$item} =
9788: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9789: }
9790: }
9791: }
1.615 raeburn 9792: $got_rules->{$udom} = 1;
1.585 raeburn 9793: }
1.612 raeburn 9794: foreach my $item (keys(%{$checks})) {
9795: if (ref($$curr_rules{$udom}) eq 'HASH') {
9796: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9797: if (@{$$curr_rules{$udom}{$item}} > 0) {
9798: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9799: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9800: if ($rule_check{$rule}) {
9801: $$rulematch{$user}{$item} = $rule;
9802: if ($inst_response eq 'ok') {
1.615 raeburn 9803: if (ref($inst_results) eq 'HASH') {
9804: if (ref($inst_results->{$user}) eq 'HASH') {
9805: if (keys(%{$inst_results->{$user}}) == 0) {
9806: $$alerts{$item}{$udom}{$uname} = 1;
9807: }
1.612 raeburn 9808: }
9809: }
1.615 raeburn 9810: }
9811: last;
1.585 raeburn 9812: }
9813: }
9814: }
9815: }
9816: }
9817: }
9818: }
9819: }
1.612 raeburn 9820: return;
9821: }
9822:
9823: sub user_rule_formats {
9824: my ($domain,$domdesc,$curr_rules,$check) = @_;
9825: my %text = (
9826: 'username' => 'Usernames',
9827: 'id' => 'IDs',
9828: );
9829: my $output;
9830: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9831: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9832: if (@{$ruleorder} > 0) {
1.1102 raeburn 9833: $output = '<br />'.
9834: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9835: '<span class="LC_cusr_emph">','</span>',$domdesc).
9836: ' <ul>';
1.612 raeburn 9837: foreach my $rule (@{$ruleorder}) {
9838: if (ref($curr_rules) eq 'ARRAY') {
9839: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9840: if (ref($rules->{$rule}) eq 'HASH') {
9841: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9842: $rules->{$rule}{'desc'}.'</li>';
9843: }
9844: }
9845: }
9846: }
9847: $output .= '</ul>';
9848: }
9849: }
9850: return $output;
9851: }
9852:
9853: sub instrule_disallow_msg {
1.615 raeburn 9854: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9855: my $response;
9856: my %text = (
9857: item => 'username',
9858: items => 'usernames',
9859: match => 'matches',
9860: do => 'does',
9861: action => 'a username',
9862: one => 'one',
9863: );
9864: if ($count > 1) {
9865: $text{'item'} = 'usernames';
9866: $text{'match'} ='match';
9867: $text{'do'} = 'do';
9868: $text{'action'} = 'usernames',
9869: $text{'one'} = 'ones';
9870: }
9871: if ($checkitem eq 'id') {
9872: $text{'items'} = 'IDs';
9873: $text{'item'} = 'ID';
9874: $text{'action'} = 'an ID';
1.615 raeburn 9875: if ($count > 1) {
9876: $text{'item'} = 'IDs';
9877: $text{'action'} = 'IDs';
9878: }
1.612 raeburn 9879: }
1.674 bisitz 9880: $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 9881: if ($mode eq 'upload') {
9882: if ($checkitem eq 'username') {
9883: $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'}.");
9884: } elsif ($checkitem eq 'id') {
1.674 bisitz 9885: $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 9886: }
1.669 raeburn 9887: } elsif ($mode eq 'selfcreate') {
9888: if ($checkitem eq 'id') {
9889: $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.");
9890: }
1.615 raeburn 9891: } else {
9892: if ($checkitem eq 'username') {
9893: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9894: } elsif ($checkitem eq 'id') {
9895: $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.");
9896: }
1.612 raeburn 9897: }
9898: return $response;
1.585 raeburn 9899: }
9900:
1.624 raeburn 9901: sub personal_data_fieldtitles {
9902: my %fieldtitles = &Apache::lonlocal::texthash (
9903: id => 'Student/Employee ID',
9904: permanentemail => 'E-mail address',
9905: lastname => 'Last Name',
9906: firstname => 'First Name',
9907: middlename => 'Middle Name',
9908: generation => 'Generation',
9909: gen => 'Generation',
1.765 raeburn 9910: inststatus => 'Affiliation',
1.624 raeburn 9911: );
9912: return %fieldtitles;
9913: }
9914:
1.642 raeburn 9915: sub sorted_inst_types {
9916: my ($dom) = @_;
1.1185 raeburn 9917: my ($usertypes,$order);
9918: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9919: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9920: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9921: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9922: } else {
9923: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9924: }
1.642 raeburn 9925: my $othertitle = &mt('All users');
9926: if ($env{'request.course.id'}) {
1.668 raeburn 9927: $othertitle = &mt('Any users');
1.642 raeburn 9928: }
9929: my @types;
9930: if (ref($order) eq 'ARRAY') {
9931: @types = @{$order};
9932: }
9933: if (@types == 0) {
9934: if (ref($usertypes) eq 'HASH') {
9935: @types = sort(keys(%{$usertypes}));
9936: }
9937: }
9938: if (keys(%{$usertypes}) > 0) {
9939: $othertitle = &mt('Other users');
9940: }
9941: return ($othertitle,$usertypes,\@types);
9942: }
9943:
1.645 raeburn 9944: sub get_institutional_codes {
9945: my ($settings,$allcourses,$LC_code) = @_;
9946: # Get complete list of course sections to update
9947: my @currsections = ();
9948: my @currxlists = ();
9949: my $coursecode = $$settings{'internal.coursecode'};
9950:
9951: if ($$settings{'internal.sectionnums'} ne '') {
9952: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9953: }
9954:
9955: if ($$settings{'internal.crosslistings'} ne '') {
9956: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9957: }
9958:
9959: if (@currxlists > 0) {
9960: foreach (@currxlists) {
9961: if (m/^([^:]+):(\w*)$/) {
9962: unless (grep/^$1$/,@{$allcourses}) {
9963: push @{$allcourses},$1;
9964: $$LC_code{$1} = $2;
9965: }
9966: }
9967: }
9968: }
9969:
9970: if (@currsections > 0) {
9971: foreach (@currsections) {
9972: if (m/^(\w+):(\w*)$/) {
9973: my $sec = $coursecode.$1;
9974: my $lc_sec = $2;
9975: unless (grep/^$sec$/,@{$allcourses}) {
9976: push @{$allcourses},$sec;
9977: $$LC_code{$sec} = $lc_sec;
9978: }
9979: }
9980: }
9981: }
9982: return;
9983: }
9984:
1.971 raeburn 9985: sub get_standard_codeitems {
9986: return ('Year','Semester','Department','Number','Section');
9987: }
9988:
1.112 bowersj2 9989: =pod
9990:
1.780 raeburn 9991: =head1 Slot Helpers
9992:
9993: =over 4
9994:
9995: =item * sorted_slots()
9996:
1.1040 raeburn 9997: Sorts an array of slot names in order of an optional sort key,
9998: default sort is by slot start time (earliest first).
1.780 raeburn 9999:
10000: Inputs:
10001:
10002: =over 4
10003:
10004: slotsarr - Reference to array of unsorted slot names.
10005:
10006: slots - Reference to hash of hash, where outer hash keys are slot names.
10007:
1.1040 raeburn 10008: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10009:
1.549 albertel 10010: =back
10011:
1.780 raeburn 10012: Returns:
10013:
10014: =over 4
10015:
1.1040 raeburn 10016: sorted - An array of slot names sorted by a specified sort key
10017: (default sort key is start time of the slot).
1.780 raeburn 10018:
10019: =back
10020:
10021: =cut
10022:
10023:
10024: sub sorted_slots {
1.1040 raeburn 10025: my ($slotsarr,$slots,$sortkey) = @_;
10026: if ($sortkey eq '') {
10027: $sortkey = 'starttime';
10028: }
1.780 raeburn 10029: my @sorted;
10030: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10031: @sorted =
10032: sort {
10033: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10034: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10035: }
10036: if (ref($slots->{$a})) { return -1;}
10037: if (ref($slots->{$b})) { return 1;}
10038: return 0;
10039: } @{$slotsarr};
10040: }
10041: return @sorted;
10042: }
10043:
1.1040 raeburn 10044: =pod
10045:
10046: =item * get_future_slots()
10047:
10048: Inputs:
10049:
10050: =over 4
10051:
10052: cnum - course number
10053:
10054: cdom - course domain
10055:
10056: now - current UNIX time
10057:
10058: symb - optional symb
10059:
10060: =back
10061:
10062: Returns:
10063:
10064: =over 4
10065:
10066: sorted_reservable - ref to array of student_schedulable slots currently
10067: reservable, ordered by end date of reservation period.
10068:
10069: reservable_now - ref to hash of student_schedulable slots currently
10070: reservable.
10071:
10072: Keys in inner hash are:
10073: (a) symb: either blank or symb to which slot use is restricted.
10074: (b) endreserve: end date of reservation period.
10075:
10076: sorted_future - ref to array of student_schedulable slots reservable in
10077: the future, ordered by start date of reservation period.
10078:
10079: future_reservable - ref to hash of student_schedulable slots reservable
10080: in the future.
10081:
10082: Keys in inner hash are:
10083: (a) symb: either blank or symb to which slot use is restricted.
10084: (b) startreserve: start date of reservation period.
10085:
10086: =back
10087:
10088: =cut
10089:
10090: sub get_future_slots {
10091: my ($cnum,$cdom,$now,$symb) = @_;
10092: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10093: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10094: foreach my $slot (keys(%slots)) {
10095: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10096: if ($symb) {
10097: next if (($slots{$slot}->{'symb'} ne '') &&
10098: ($slots{$slot}->{'symb'} ne $symb));
10099: }
10100: if (($slots{$slot}->{'starttime'} > $now) &&
10101: ($slots{$slot}->{'endtime'} > $now)) {
10102: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10103: my $userallowed = 0;
10104: if ($slots{$slot}->{'allowedsections'}) {
10105: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10106: if (!defined($env{'request.role.sec'})
10107: && grep(/^No section assigned$/,@allowed_sec)) {
10108: $userallowed=1;
10109: } else {
10110: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10111: $userallowed=1;
10112: }
10113: }
10114: unless ($userallowed) {
10115: if (defined($env{'request.course.groups'})) {
10116: my @groups = split(/:/,$env{'request.course.groups'});
10117: foreach my $group (@groups) {
10118: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10119: $userallowed=1;
10120: last;
10121: }
10122: }
10123: }
10124: }
10125: }
10126: if ($slots{$slot}->{'allowedusers'}) {
10127: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10128: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10129: if (grep(/^\Q$user\E$/,@allowed_users)) {
10130: $userallowed = 1;
10131: }
10132: }
10133: next unless($userallowed);
10134: }
10135: my $startreserve = $slots{$slot}->{'startreserve'};
10136: my $endreserve = $slots{$slot}->{'endreserve'};
10137: my $symb = $slots{$slot}->{'symb'};
10138: if (($startreserve < $now) &&
10139: (!$endreserve || $endreserve > $now)) {
10140: my $lastres = $endreserve;
10141: if (!$lastres) {
10142: $lastres = $slots{$slot}->{'starttime'};
10143: }
10144: $reservable_now{$slot} = {
10145: symb => $symb,
10146: endreserve => $lastres
10147: };
10148: } elsif (($startreserve > $now) &&
10149: (!$endreserve || $endreserve > $startreserve)) {
10150: $future_reservable{$slot} = {
10151: symb => $symb,
10152: startreserve => $startreserve
10153: };
10154: }
10155: }
10156: }
10157: my @unsorted_reservable = keys(%reservable_now);
10158: if (@unsorted_reservable > 0) {
10159: @sorted_reservable =
10160: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10161: }
10162: my @unsorted_future = keys(%future_reservable);
10163: if (@unsorted_future > 0) {
10164: @sorted_future =
10165: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10166: }
10167: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10168: }
1.780 raeburn 10169:
10170: =pod
10171:
1.1057 foxr 10172: =back
10173:
1.549 albertel 10174: =head1 HTTP Helpers
10175:
10176: =over 4
10177:
1.648 raeburn 10178: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10179:
1.258 albertel 10180: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10181: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10182: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10183:
10184: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10185: $possible_names is an ref to an array of form element names. As an example:
10186: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10187: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10188:
10189: =cut
1.1 albertel 10190:
1.6 albertel 10191: sub get_unprocessed_cgi {
1.25 albertel 10192: my ($query,$possible_names)= @_;
1.26 matthew 10193: # $Apache::lonxml::debug=1;
1.356 albertel 10194: foreach my $pair (split(/&/,$query)) {
10195: my ($name, $value) = split(/=/,$pair);
1.369 www 10196: $name = &unescape($name);
1.25 albertel 10197: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10198: $value =~ tr/+/ /;
10199: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10200: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10201: }
1.16 harris41 10202: }
1.6 albertel 10203: }
10204:
1.112 bowersj2 10205: =pod
10206:
1.648 raeburn 10207: =item * &cacheheader()
1.112 bowersj2 10208:
10209: returns cache-controlling header code
10210:
10211: =cut
10212:
1.7 albertel 10213: sub cacheheader {
1.258 albertel 10214: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10215: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10216: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10217: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10218: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10219: return $output;
1.7 albertel 10220: }
10221:
1.112 bowersj2 10222: =pod
10223:
1.648 raeburn 10224: =item * &no_cache($r)
1.112 bowersj2 10225:
10226: specifies header code to not have cache
10227:
10228: =cut
10229:
1.9 albertel 10230: sub no_cache {
1.216 albertel 10231: my ($r) = @_;
10232: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10233: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10234: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10235: $r->no_cache(1);
10236: $r->header_out("Expires" => $date);
10237: $r->header_out("Pragma" => "no-cache");
1.123 www 10238: }
10239:
10240: sub content_type {
1.181 albertel 10241: my ($r,$type,$charset) = @_;
1.299 foxr 10242: if ($r) {
10243: # Note that printout.pl calls this with undef for $r.
10244: &no_cache($r);
10245: }
1.258 albertel 10246: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10247: unless ($charset) {
10248: $charset=&Apache::lonlocal::current_encoding;
10249: }
10250: if ($charset) { $type.='; charset='.$charset; }
10251: if ($r) {
10252: $r->content_type($type);
10253: } else {
10254: print("Content-type: $type\n\n");
10255: }
1.9 albertel 10256: }
1.25 albertel 10257:
1.112 bowersj2 10258: =pod
10259:
1.648 raeburn 10260: =item * &add_to_env($name,$value)
1.112 bowersj2 10261:
1.258 albertel 10262: adds $name to the %env hash with value
1.112 bowersj2 10263: $value, if $name already exists, the entry is converted to an array
10264: reference and $value is added to the array.
10265:
10266: =cut
10267:
1.25 albertel 10268: sub add_to_env {
10269: my ($name,$value)=@_;
1.258 albertel 10270: if (defined($env{$name})) {
10271: if (ref($env{$name})) {
1.25 albertel 10272: #already have multiple values
1.258 albertel 10273: push(@{ $env{$name} },$value);
1.25 albertel 10274: } else {
10275: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10276: my $first=$env{$name};
10277: undef($env{$name});
10278: push(@{ $env{$name} },$first,$value);
1.25 albertel 10279: }
10280: } else {
1.258 albertel 10281: $env{$name}=$value;
1.25 albertel 10282: }
1.31 albertel 10283: }
1.149 albertel 10284:
10285: =pod
10286:
1.648 raeburn 10287: =item * &get_env_multiple($name)
1.149 albertel 10288:
1.258 albertel 10289: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10290: values may be defined and end up as an array ref.
10291:
10292: returns an array of values
10293:
10294: =cut
10295:
10296: sub get_env_multiple {
10297: my ($name) = @_;
10298: my @values;
1.258 albertel 10299: if (defined($env{$name})) {
1.149 albertel 10300: # exists is it an array
1.258 albertel 10301: if (ref($env{$name})) {
10302: @values=@{ $env{$name} };
1.149 albertel 10303: } else {
1.258 albertel 10304: $values[0]=$env{$name};
1.149 albertel 10305: }
10306: }
10307: return(@values);
10308: }
10309:
1.660 raeburn 10310: sub ask_for_embedded_content {
10311: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10312: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10313: %currsubfile,%unused,$rem);
1.1071 raeburn 10314: my $counter = 0;
10315: my $numnew = 0;
1.987 raeburn 10316: my $numremref = 0;
10317: my $numinvalid = 0;
10318: my $numpathchg = 0;
10319: my $numexisting = 0;
1.1071 raeburn 10320: my $numunused = 0;
10321: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10322: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10323: my $heading = &mt('Upload embedded files');
10324: my $buttontext = &mt('Upload');
10325:
1.1085 raeburn 10326: if ($env{'request.course.id'}) {
1.1123 raeburn 10327: if ($actionurl eq '/adm/dependencies') {
10328: $navmap = Apache::lonnavmaps::navmap->new();
10329: }
10330: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10331: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10332: }
1.1123 raeburn 10333: if (($actionurl eq '/adm/portfolio') ||
10334: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10335: my $current_path='/';
10336: if ($env{'form.currentpath'}) {
10337: $current_path = $env{'form.currentpath'};
10338: }
10339: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10340: $udom = $cdom;
10341: $uname = $cnum;
1.984 raeburn 10342: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10343: } else {
10344: $udom = $env{'user.domain'};
10345: $uname = $env{'user.name'};
10346: $url = '/userfiles/portfolio';
10347: }
1.987 raeburn 10348: $toplevel = $url.'/';
1.984 raeburn 10349: $url .= $current_path;
10350: $getpropath = 1;
1.987 raeburn 10351: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10352: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10353: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10354: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10355: $toplevel = $url;
1.984 raeburn 10356: if ($rest ne '') {
1.987 raeburn 10357: $url .= $rest;
10358: }
10359: } elsif ($actionurl eq '/adm/coursedocs') {
10360: if (ref($args) eq 'HASH') {
1.1071 raeburn 10361: $url = $args->{'docs_url'};
10362: $toplevel = $url;
1.1084 raeburn 10363: if ($args->{'context'} eq 'paste') {
10364: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10365: ($path) =
10366: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10367: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10368: $fileloc =~ s{^/}{};
10369: }
1.1071 raeburn 10370: }
1.1084 raeburn 10371: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 10372: if ($env{'request.course.id'} ne '') {
10373: if (ref($args) eq 'HASH') {
10374: $url = $args->{'docs_url'};
10375: $title = $args->{'docs_title'};
1.1126 raeburn 10376: $toplevel = $url;
10377: unless ($toplevel =~ m{^/}) {
10378: $toplevel = "/$url";
10379: }
1.1085 raeburn 10380: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 10381: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10382: $path = $1;
10383: } else {
10384: ($path) =
10385: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10386: }
1.1195 raeburn 10387: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10388: $fileloc = $toplevel;
10389: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10390: my ($udom,$uname,$fname) =
10391: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10392: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10393: } else {
10394: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10395: }
1.1071 raeburn 10396: $fileloc =~ s{^/}{};
10397: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10398: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10399: }
1.987 raeburn 10400: }
1.1123 raeburn 10401: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10402: $udom = $cdom;
10403: $uname = $cnum;
10404: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10405: $toplevel = $url;
10406: $path = $url;
10407: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10408: $fileloc =~ s{^/}{};
1.987 raeburn 10409: }
1.1126 raeburn 10410: foreach my $file (keys(%{$allfiles})) {
10411: my $embed_file;
10412: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10413: $embed_file = $1;
10414: } else {
10415: $embed_file = $file;
10416: }
1.1158 raeburn 10417: my ($absolutepath,$cleaned_file);
10418: if ($embed_file =~ m{^\w+://}) {
10419: $cleaned_file = $embed_file;
1.1147 raeburn 10420: $newfiles{$cleaned_file} = 1;
10421: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10422: } else {
1.1158 raeburn 10423: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10424: if ($embed_file =~ m{^/}) {
10425: $absolutepath = $embed_file;
10426: }
1.1147 raeburn 10427: if ($cleaned_file =~ m{/}) {
10428: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10429: $path = &check_for_traversal($path,$url,$toplevel);
10430: my $item = $fname;
10431: if ($path ne '') {
10432: $item = $path.'/'.$fname;
10433: $subdependencies{$path}{$fname} = 1;
10434: } else {
10435: $dependencies{$item} = 1;
10436: }
10437: if ($absolutepath) {
10438: $mapping{$item} = $absolutepath;
10439: } else {
10440: $mapping{$item} = $embed_file;
10441: }
10442: } else {
10443: $dependencies{$embed_file} = 1;
10444: if ($absolutepath) {
1.1147 raeburn 10445: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10446: } else {
1.1147 raeburn 10447: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10448: }
10449: }
1.984 raeburn 10450: }
10451: }
1.1071 raeburn 10452: my $dirptr = 16384;
1.984 raeburn 10453: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10454: $currsubfile{$path} = {};
1.1123 raeburn 10455: if (($actionurl eq '/adm/portfolio') ||
10456: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10457: my ($sublistref,$listerror) =
10458: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10459: if (ref($sublistref) eq 'ARRAY') {
10460: foreach my $line (@{$sublistref}) {
10461: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10462: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10463: }
1.984 raeburn 10464: }
1.987 raeburn 10465: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10466: if (opendir(my $dir,$url.'/'.$path)) {
10467: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10468: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10469: }
1.1084 raeburn 10470: } elsif (($actionurl eq '/adm/dependencies') ||
10471: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10472: ($args->{'context'} eq 'paste')) ||
10473: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10474: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10475: my $dir;
10476: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10477: $dir = $fileloc;
10478: } else {
10479: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10480: }
1.1071 raeburn 10481: if ($dir ne '') {
10482: my ($sublistref,$listerror) =
10483: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10484: if (ref($sublistref) eq 'ARRAY') {
10485: foreach my $line (@{$sublistref}) {
10486: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10487: undef,$mtime)=split(/\&/,$line,12);
10488: unless (($testdir&$dirptr) ||
10489: ($file_name =~ /^\.\.?$/)) {
10490: $currsubfile{$path}{$file_name} = [$size,$mtime];
10491: }
10492: }
10493: }
10494: }
1.984 raeburn 10495: }
10496: }
10497: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10498: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10499: my $item = $path.'/'.$file;
10500: unless ($mapping{$item} eq $item) {
10501: $pathchanges{$item} = 1;
10502: }
10503: $existing{$item} = 1;
10504: $numexisting ++;
10505: } else {
10506: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10507: }
10508: }
1.1071 raeburn 10509: if ($actionurl eq '/adm/dependencies') {
10510: foreach my $path (keys(%currsubfile)) {
10511: if (ref($currsubfile{$path}) eq 'HASH') {
10512: foreach my $file (keys(%{$currsubfile{$path}})) {
10513: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10514: next if (($rem ne '') &&
10515: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10516: (ref($navmap) &&
10517: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10518: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10519: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10520: $unused{$path.'/'.$file} = 1;
10521: }
10522: }
10523: }
10524: }
10525: }
1.984 raeburn 10526: }
1.987 raeburn 10527: my %currfile;
1.1123 raeburn 10528: if (($actionurl eq '/adm/portfolio') ||
10529: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10530: my ($dirlistref,$listerror) =
10531: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10532: if (ref($dirlistref) eq 'ARRAY') {
10533: foreach my $line (@{$dirlistref}) {
10534: my ($file_name,$rest) = split(/\&/,$line,2);
10535: $currfile{$file_name} = 1;
10536: }
1.984 raeburn 10537: }
1.987 raeburn 10538: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10539: if (opendir(my $dir,$url)) {
1.987 raeburn 10540: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10541: map {$currfile{$_} = 1;} @dir_list;
10542: }
1.1084 raeburn 10543: } elsif (($actionurl eq '/adm/dependencies') ||
10544: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10545: ($args->{'context'} eq 'paste')) ||
10546: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10547: if ($env{'request.course.id'} ne '') {
10548: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10549: if ($dir ne '') {
10550: my ($dirlistref,$listerror) =
10551: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10552: if (ref($dirlistref) eq 'ARRAY') {
10553: foreach my $line (@{$dirlistref}) {
10554: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10555: $size,undef,$mtime)=split(/\&/,$line,12);
10556: unless (($testdir&$dirptr) ||
10557: ($file_name =~ /^\.\.?$/)) {
10558: $currfile{$file_name} = [$size,$mtime];
10559: }
10560: }
10561: }
10562: }
10563: }
1.984 raeburn 10564: }
10565: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10566: if (exists($currfile{$file})) {
1.987 raeburn 10567: unless ($mapping{$file} eq $file) {
10568: $pathchanges{$file} = 1;
10569: }
10570: $existing{$file} = 1;
10571: $numexisting ++;
10572: } else {
1.984 raeburn 10573: $newfiles{$file} = 1;
10574: }
10575: }
1.1071 raeburn 10576: foreach my $file (keys(%currfile)) {
10577: unless (($file eq $filename) ||
10578: ($file eq $filename.'.bak') ||
10579: ($dependencies{$file})) {
1.1085 raeburn 10580: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10581: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10582: next if (($rem ne '') &&
10583: (($env{"httpref.$rem".$file} ne '') ||
10584: (ref($navmap) &&
10585: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10586: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10587: ($navmap->getResourceByUrl($rem.$1)))))));
10588: }
1.1085 raeburn 10589: }
1.1071 raeburn 10590: $unused{$file} = 1;
10591: }
10592: }
1.1084 raeburn 10593: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10594: ($args->{'context'} eq 'paste')) {
10595: $counter = scalar(keys(%existing));
10596: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10597: return ($output,$counter,$numpathchg,\%existing);
10598: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10599: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10600: $counter = scalar(keys(%existing));
10601: $numpathchg = scalar(keys(%pathchanges));
10602: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10603: }
1.984 raeburn 10604: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10605: if ($actionurl eq '/adm/dependencies') {
10606: next if ($embed_file =~ m{^\w+://});
10607: }
1.660 raeburn 10608: $upload_output .= &start_data_table_row().
1.1123 raeburn 10609: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10610: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10611: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10612: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10613: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10614: }
1.1123 raeburn 10615: $upload_output .= '</td>';
1.1071 raeburn 10616: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10617: $upload_output.='<td align="right">'.
10618: '<span class="LC_info LC_fontsize_medium">'.
10619: &mt("URL points to web address").'</span>';
1.987 raeburn 10620: $numremref++;
1.660 raeburn 10621: } elsif ($args->{'error_on_invalid_names'}
10622: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10623: $upload_output.='<td align="right"><span class="LC_warning">'.
10624: &mt('Invalid characters').'</span>';
1.987 raeburn 10625: $numinvalid++;
1.660 raeburn 10626: } else {
1.1123 raeburn 10627: $upload_output .= '<td>'.
10628: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10629: $embed_file,\%mapping,
1.1071 raeburn 10630: $allfiles,$codebase,'upload');
10631: $counter ++;
10632: $numnew ++;
1.987 raeburn 10633: }
10634: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10635: }
10636: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10637: if ($actionurl eq '/adm/dependencies') {
10638: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10639: $modify_output .= &start_data_table_row().
10640: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10641: '<img src="'.&icon($embed_file).'" border="0" />'.
10642: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10643: '<td>'.$size.'</td>'.
10644: '<td>'.$mtime.'</td>'.
10645: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10646: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10647: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10648: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10649: &embedded_file_element('upload_embedded',$counter,
10650: $embed_file,\%mapping,
10651: $allfiles,$codebase,'modify').
10652: '</div></td>'.
10653: &end_data_table_row()."\n";
10654: $counter ++;
10655: } else {
10656: $upload_output .= &start_data_table_row().
1.1123 raeburn 10657: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10658: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10659: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10660: &Apache::loncommon::end_data_table_row()."\n";
10661: }
10662: }
10663: my $delidx = $counter;
10664: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10665: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10666: $delete_output .= &start_data_table_row().
10667: '<td><img src="'.&icon($oldfile).'" />'.
10668: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10669: '<td>'.$size.'</td>'.
10670: '<td>'.$mtime.'</td>'.
10671: '<td><label><input type="checkbox" name="del_upload_dep" '.
10672: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10673: &embedded_file_element('upload_embedded',$delidx,
10674: $oldfile,\%mapping,$allfiles,
10675: $codebase,'delete').'</td>'.
10676: &end_data_table_row()."\n";
10677: $numunused ++;
10678: $delidx ++;
1.987 raeburn 10679: }
10680: if ($upload_output) {
10681: $upload_output = &start_data_table().
10682: $upload_output.
10683: &end_data_table()."\n";
10684: }
1.1071 raeburn 10685: if ($modify_output) {
10686: $modify_output = &start_data_table().
10687: &start_data_table_header_row().
10688: '<th>'.&mt('File').'</th>'.
10689: '<th>'.&mt('Size (KB)').'</th>'.
10690: '<th>'.&mt('Modified').'</th>'.
10691: '<th>'.&mt('Upload replacement?').'</th>'.
10692: &end_data_table_header_row().
10693: $modify_output.
10694: &end_data_table()."\n";
10695: }
10696: if ($delete_output) {
10697: $delete_output = &start_data_table().
10698: &start_data_table_header_row().
10699: '<th>'.&mt('File').'</th>'.
10700: '<th>'.&mt('Size (KB)').'</th>'.
10701: '<th>'.&mt('Modified').'</th>'.
10702: '<th>'.&mt('Delete?').'</th>'.
10703: &end_data_table_header_row().
10704: $delete_output.
10705: &end_data_table()."\n";
10706: }
1.987 raeburn 10707: my $applies = 0;
10708: if ($numremref) {
10709: $applies ++;
10710: }
10711: if ($numinvalid) {
10712: $applies ++;
10713: }
10714: if ($numexisting) {
10715: $applies ++;
10716: }
1.1071 raeburn 10717: if ($counter || $numunused) {
1.987 raeburn 10718: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10719: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10720: $state.'<h3>'.$heading.'</h3>';
10721: if ($actionurl eq '/adm/dependencies') {
10722: if ($numnew) {
10723: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10724: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10725: $upload_output.'<br />'."\n";
10726: }
10727: if ($numexisting) {
10728: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10729: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10730: $modify_output.'<br />'."\n";
10731: $buttontext = &mt('Save changes');
10732: }
10733: if ($numunused) {
10734: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10735: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10736: $delete_output.'<br />'."\n";
10737: $buttontext = &mt('Save changes');
10738: }
10739: } else {
10740: $output .= $upload_output.'<br />'."\n";
10741: }
10742: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10743: $counter.'" />'."\n";
10744: if ($actionurl eq '/adm/dependencies') {
10745: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10746: $numnew.'" />'."\n";
10747: } elsif ($actionurl eq '') {
1.987 raeburn 10748: $output .= '<input type="hidden" name="phase" value="three" />';
10749: }
10750: } elsif ($applies) {
10751: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10752: if ($applies > 1) {
10753: $output .=
1.1123 raeburn 10754: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10755: if ($numremref) {
10756: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10757: }
10758: if ($numinvalid) {
10759: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10760: }
10761: if ($numexisting) {
10762: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10763: }
10764: $output .= '</ul><br />';
10765: } elsif ($numremref) {
10766: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10767: } elsif ($numinvalid) {
10768: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10769: } elsif ($numexisting) {
10770: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10771: }
10772: $output .= $upload_output.'<br />';
10773: }
10774: my ($pathchange_output,$chgcount);
1.1071 raeburn 10775: $chgcount = $counter;
1.987 raeburn 10776: if (keys(%pathchanges) > 0) {
10777: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10778: if ($counter) {
1.987 raeburn 10779: $output .= &embedded_file_element('pathchange',$chgcount,
10780: $embed_file,\%mapping,
1.1071 raeburn 10781: $allfiles,$codebase,'change');
1.987 raeburn 10782: } else {
10783: $pathchange_output .=
10784: &start_data_table_row().
10785: '<td><input type ="checkbox" name="namechange" value="'.
10786: $chgcount.'" checked="checked" /></td>'.
10787: '<td>'.$mapping{$embed_file}.'</td>'.
10788: '<td>'.$embed_file.
10789: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10790: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10791: '</td>'.&end_data_table_row();
1.660 raeburn 10792: }
1.987 raeburn 10793: $numpathchg ++;
10794: $chgcount ++;
1.660 raeburn 10795: }
10796: }
1.1127 raeburn 10797: if (($counter) || ($numunused)) {
1.987 raeburn 10798: if ($numpathchg) {
10799: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10800: $numpathchg.'" />'."\n";
10801: }
10802: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10803: ($actionurl eq '/adm/imsimport')) {
10804: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10805: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10806: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10807: } elsif ($actionurl eq '/adm/dependencies') {
10808: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10809: }
1.1123 raeburn 10810: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10811: } elsif ($numpathchg) {
10812: my %pathchange = ();
10813: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10814: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10815: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10816: }
1.987 raeburn 10817: }
1.1071 raeburn 10818: return ($output,$counter,$numpathchg);
1.987 raeburn 10819: }
10820:
1.1147 raeburn 10821: =pod
10822:
10823: =item * clean_path($name)
10824:
10825: Performs clean-up of directories, subdirectories and filename in an
10826: embedded object, referenced in an HTML file which is being uploaded
10827: to a course or portfolio, where
10828: "Upload embedded images/multimedia files if HTML file" checkbox was
10829: checked.
10830:
10831: Clean-up is similar to replacements in lonnet::clean_filename()
10832: except each / between sub-directory and next level is preserved.
10833:
10834: =cut
10835:
10836: sub clean_path {
10837: my ($embed_file) = @_;
10838: $embed_file =~s{^/+}{};
10839: my @contents;
10840: if ($embed_file =~ m{/}) {
10841: @contents = split(/\//,$embed_file);
10842: } else {
10843: @contents = ($embed_file);
10844: }
10845: my $lastidx = scalar(@contents)-1;
10846: for (my $i=0; $i<=$lastidx; $i++) {
10847: $contents[$i]=~s{\\}{/}g;
10848: $contents[$i]=~s/\s+/\_/g;
10849: $contents[$i]=~s{[^/\w\.\-]}{}g;
10850: if ($i == $lastidx) {
10851: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10852: }
10853: }
10854: if ($lastidx > 0) {
10855: return join('/',@contents);
10856: } else {
10857: return $contents[0];
10858: }
10859: }
10860:
1.987 raeburn 10861: sub embedded_file_element {
1.1071 raeburn 10862: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10863: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10864: (ref($codebase) eq 'HASH'));
10865: my $output;
1.1071 raeburn 10866: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10867: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10868: }
10869: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10870: &escape($embed_file).'" />';
10871: unless (($context eq 'upload_embedded') &&
10872: ($mapping->{$embed_file} eq $embed_file)) {
10873: $output .='
10874: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10875: }
10876: my $attrib;
10877: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10878: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10879: }
10880: $output .=
10881: "\n\t\t".
10882: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10883: $attrib.'" />';
10884: if (exists($codebase->{$mapping->{$embed_file}})) {
10885: $output .=
10886: "\n\t\t".
10887: '<input name="codebase_'.$num.'" type="hidden" value="'.
10888: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10889: }
1.987 raeburn 10890: return $output;
1.660 raeburn 10891: }
10892:
1.1071 raeburn 10893: sub get_dependency_details {
10894: my ($currfile,$currsubfile,$embed_file) = @_;
10895: my ($size,$mtime,$showsize,$showmtime);
10896: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10897: if ($embed_file =~ m{/}) {
10898: my ($path,$fname) = split(/\//,$embed_file);
10899: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10900: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10901: }
10902: } else {
10903: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10904: ($size,$mtime) = @{$currfile->{$embed_file}};
10905: }
10906: }
10907: $showsize = $size/1024.0;
10908: $showsize = sprintf("%.1f",$showsize);
10909: if ($mtime > 0) {
10910: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10911: }
10912: }
10913: return ($showsize,$showmtime);
10914: }
10915:
10916: sub ask_embedded_js {
10917: return <<"END";
10918: <script type="text/javascript"">
10919: // <![CDATA[
10920: function toggleBrowse(counter) {
10921: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10922: var fileid = document.getElementById('embedded_item_'+counter);
10923: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10924: if (chkboxid.checked == true) {
10925: uploaddivid.style.display='block';
10926: } else {
10927: uploaddivid.style.display='none';
10928: fileid.value = '';
10929: }
10930: }
10931: // ]]>
10932: </script>
10933:
10934: END
10935: }
10936:
1.661 raeburn 10937: sub upload_embedded {
10938: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10939: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10940: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10941: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10942: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10943: my $orig_uploaded_filename =
10944: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10945: foreach my $type ('orig','ref','attrib','codebase') {
10946: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10947: $env{'form.embedded_'.$type.'_'.$i} =
10948: &unescape($env{'form.embedded_'.$type.'_'.$i});
10949: }
10950: }
1.661 raeburn 10951: my ($path,$fname) =
10952: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10953: # no path, whole string is fname
10954: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10955: $fname = &Apache::lonnet::clean_filename($fname);
10956: # See if there is anything left
10957: next if ($fname eq '');
10958:
10959: # Check if file already exists as a file or directory.
10960: my ($state,$msg);
10961: if ($context eq 'portfolio') {
10962: my $port_path = $dirpath;
10963: if ($group ne '') {
10964: $port_path = "groups/$group/$port_path";
10965: }
1.987 raeburn 10966: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10967: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10968: $dir_root,$port_path,$disk_quota,
10969: $current_disk_usage,$uname,$udom);
10970: if ($state eq 'will_exceed_quota'
1.984 raeburn 10971: || $state eq 'file_locked') {
1.661 raeburn 10972: $output .= $msg;
10973: next;
10974: }
10975: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10976: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10977: if ($state eq 'exists') {
10978: $output .= $msg;
10979: next;
10980: }
10981: }
10982: # Check if extension is valid
10983: if (($fname =~ /\.(\w+)$/) &&
10984: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10985: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10986: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10987: next;
10988: } elsif (($fname =~ /\.(\w+)$/) &&
10989: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10990: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10991: next;
10992: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10993: $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661 raeburn 10994: next;
10995: }
10996: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10997: my $subdir = $path;
10998: $subdir =~ s{/+$}{};
1.661 raeburn 10999: if ($context eq 'portfolio') {
1.984 raeburn 11000: my $result;
11001: if ($state eq 'existingfile') {
11002: $result=
11003: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11004: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11005: } else {
1.984 raeburn 11006: $result=
11007: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11008: $dirpath.
1.1123 raeburn 11009: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11010: if ($result !~ m|^/uploaded/|) {
11011: $output .= '<span class="LC_error">'
11012: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11013: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11014: .'</span><br />';
11015: next;
11016: } else {
1.987 raeburn 11017: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11018: $path.$fname.'</span>').'<br />';
1.984 raeburn 11019: }
1.661 raeburn 11020: }
1.1123 raeburn 11021: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11022: my $extendedsubdir = $dirpath.'/'.$subdir;
11023: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11024: my $result =
1.1126 raeburn 11025: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11026: if ($result !~ m|^/uploaded/|) {
11027: $output .= '<span class="LC_error">'
11028: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11029: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11030: .'</span><br />';
11031: next;
11032: } else {
11033: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11034: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11035: if ($context eq 'syllabus') {
11036: &Apache::lonnet::make_public_indefinitely($result);
11037: }
1.987 raeburn 11038: }
1.661 raeburn 11039: } else {
11040: # Save the file
11041: my $target = $env{'form.embedded_item_'.$i};
11042: my $fullpath = $dir_root.$dirpath.'/'.$path;
11043: my $dest = $fullpath.$fname;
11044: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11045: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11046: my $count;
11047: my $filepath = $dir_root;
1.1027 raeburn 11048: foreach my $subdir (@parts) {
11049: $filepath .= "/$subdir";
11050: if (!-e $filepath) {
1.661 raeburn 11051: mkdir($filepath,0770);
11052: }
11053: }
11054: my $fh;
11055: if (!open($fh,'>'.$dest)) {
11056: &Apache::lonnet::logthis('Failed to create '.$dest);
11057: $output .= '<span class="LC_error">'.
1.1071 raeburn 11058: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11059: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11060: '</span><br />';
11061: } else {
11062: if (!print $fh $env{'form.embedded_item_'.$i}) {
11063: &Apache::lonnet::logthis('Failed to write to '.$dest);
11064: $output .= '<span class="LC_error">'.
1.1071 raeburn 11065: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11066: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11067: '</span><br />';
11068: } else {
1.987 raeburn 11069: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11070: $url.'</span>').'<br />';
11071: unless ($context eq 'testbank') {
11072: $footer .= &mt('View embedded file: [_1]',
11073: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11074: }
11075: }
11076: close($fh);
11077: }
11078: }
11079: if ($env{'form.embedded_ref_'.$i}) {
11080: $pathchange{$i} = 1;
11081: }
11082: }
11083: if ($output) {
11084: $output = '<p>'.$output.'</p>';
11085: }
11086: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11087: $returnflag = 'ok';
1.1071 raeburn 11088: my $numpathchgs = scalar(keys(%pathchange));
11089: if ($numpathchgs > 0) {
1.987 raeburn 11090: if ($context eq 'portfolio') {
11091: $output .= '<p>'.&mt('or').'</p>';
11092: } elsif ($context eq 'testbank') {
1.1071 raeburn 11093: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11094: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11095: $returnflag = 'modify_orightml';
11096: }
11097: }
1.1071 raeburn 11098: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11099: }
11100:
11101: sub modify_html_form {
11102: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11103: my $end = 0;
11104: my $modifyform;
11105: if ($context eq 'upload_embedded') {
11106: return unless (ref($pathchange) eq 'HASH');
11107: if ($env{'form.number_embedded_items'}) {
11108: $end += $env{'form.number_embedded_items'};
11109: }
11110: if ($env{'form.number_pathchange_items'}) {
11111: $end += $env{'form.number_pathchange_items'};
11112: }
11113: if ($end) {
11114: for (my $i=0; $i<$end; $i++) {
11115: if ($i < $env{'form.number_embedded_items'}) {
11116: next unless($pathchange->{$i});
11117: }
11118: $modifyform .=
11119: &start_data_table_row().
11120: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11121: 'checked="checked" /></td>'.
11122: '<td>'.$env{'form.embedded_ref_'.$i}.
11123: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11124: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11125: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11126: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11127: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11128: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11129: '<td>'.$env{'form.embedded_orig_'.$i}.
11130: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11131: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11132: &end_data_table_row();
1.1071 raeburn 11133: }
1.987 raeburn 11134: }
11135: } else {
11136: $modifyform = $pathchgtable;
11137: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11138: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11139: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11140: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11141: }
11142: }
11143: if ($modifyform) {
1.1071 raeburn 11144: if ($actionurl eq '/adm/dependencies') {
11145: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11146: }
1.987 raeburn 11147: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11148: '<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".
11149: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11150: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11151: '</ol></p>'."\n".'<p>'.
11152: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11153: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11154: &start_data_table()."\n".
11155: &start_data_table_header_row().
11156: '<th>'.&mt('Change?').'</th>'.
11157: '<th>'.&mt('Current reference').'</th>'.
11158: '<th>'.&mt('Required reference').'</th>'.
11159: &end_data_table_header_row()."\n".
11160: $modifyform.
11161: &end_data_table().'<br />'."\n".$hiddenstate.
11162: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11163: '</form>'."\n";
11164: }
11165: return;
11166: }
11167:
11168: sub modify_html_refs {
1.1123 raeburn 11169: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11170: my $container;
11171: if ($context eq 'portfolio') {
11172: $container = $env{'form.container'};
11173: } elsif ($context eq 'coursedoc') {
11174: $container = $env{'form.primaryurl'};
1.1071 raeburn 11175: } elsif ($context eq 'manage_dependencies') {
11176: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11177: $container = "/$container";
1.1123 raeburn 11178: } elsif ($context eq 'syllabus') {
11179: $container = $url;
1.987 raeburn 11180: } else {
1.1027 raeburn 11181: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11182: }
11183: my (%allfiles,%codebase,$output,$content);
11184: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11185: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11186: if (wantarray) {
11187: return ('',0,0);
11188: } else {
11189: return;
11190: }
11191: }
11192: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11193: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11194: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11195: if (wantarray) {
11196: return ('',0,0);
11197: } else {
11198: return;
11199: }
11200: }
1.987 raeburn 11201: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11202: if ($content eq '-1') {
11203: if (wantarray) {
11204: return ('',0,0);
11205: } else {
11206: return;
11207: }
11208: }
1.987 raeburn 11209: } else {
1.1071 raeburn 11210: unless ($container =~ /^\Q$dir_root\E/) {
11211: if (wantarray) {
11212: return ('',0,0);
11213: } else {
11214: return;
11215: }
11216: }
1.987 raeburn 11217: if (open(my $fh,"<$container")) {
11218: $content = join('', <$fh>);
11219: close($fh);
11220: } else {
1.1071 raeburn 11221: if (wantarray) {
11222: return ('',0,0);
11223: } else {
11224: return;
11225: }
1.987 raeburn 11226: }
11227: }
11228: my ($count,$codebasecount) = (0,0);
11229: my $mm = new File::MMagic;
11230: my $mime_type = $mm->checktype_contents($content);
11231: if ($mime_type eq 'text/html') {
11232: my $parse_result =
11233: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11234: \%codebase,\$content);
11235: if ($parse_result eq 'ok') {
11236: foreach my $i (@changes) {
11237: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11238: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11239: if ($allfiles{$ref}) {
11240: my $newname = $orig;
11241: my ($attrib_regexp,$codebase);
1.1006 raeburn 11242: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11243: if ($attrib_regexp =~ /:/) {
11244: $attrib_regexp =~ s/\:/|/g;
11245: }
11246: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11247: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11248: $count += $numchg;
1.1123 raeburn 11249: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11250: delete($allfiles{$ref});
1.987 raeburn 11251: }
11252: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11253: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11254: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11255: $codebasecount ++;
11256: }
11257: }
11258: }
1.1123 raeburn 11259: my $skiprewrites;
1.987 raeburn 11260: if ($count || $codebasecount) {
11261: my $saveresult;
1.1071 raeburn 11262: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11263: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11264: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11265: if ($url eq $container) {
11266: my ($fname) = ($container =~ m{/([^/]+)$});
11267: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11268: $count,'<span class="LC_filename">'.
1.1071 raeburn 11269: $fname.'</span>').'</p>';
1.987 raeburn 11270: } else {
11271: $output = '<p class="LC_error">'.
11272: &mt('Error: update failed for: [_1].',
11273: '<span class="LC_filename">'.
11274: $container.'</span>').'</p>';
11275: }
1.1123 raeburn 11276: if ($context eq 'syllabus') {
11277: unless ($saveresult eq 'ok') {
11278: $skiprewrites = 1;
11279: }
11280: }
1.987 raeburn 11281: } else {
11282: if (open(my $fh,">$container")) {
11283: print $fh $content;
11284: close($fh);
11285: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11286: $count,'<span class="LC_filename">'.
11287: $container.'</span>').'</p>';
1.661 raeburn 11288: } else {
1.987 raeburn 11289: $output = '<p class="LC_error">'.
11290: &mt('Error: could not update [_1].',
11291: '<span class="LC_filename">'.
11292: $container.'</span>').'</p>';
1.661 raeburn 11293: }
11294: }
11295: }
1.1123 raeburn 11296: if (($context eq 'syllabus') && (!$skiprewrites)) {
11297: my ($actionurl,$state);
11298: $actionurl = "/public/$udom/$uname/syllabus";
11299: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11300: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11301: \%codebase,
11302: {'context' => 'rewrites',
11303: 'ignore_remote_references' => 1,});
11304: if (ref($mapping) eq 'HASH') {
11305: my $rewrites = 0;
11306: foreach my $key (keys(%{$mapping})) {
11307: next if ($key =~ m{^https?://});
11308: my $ref = $mapping->{$key};
11309: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11310: my $attrib;
11311: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11312: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11313: }
11314: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11315: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11316: $rewrites += $numchg;
11317: }
11318: }
11319: if ($rewrites) {
11320: my $saveresult;
11321: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11322: if ($url eq $container) {
11323: my ($fname) = ($container =~ m{/([^/]+)$});
11324: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11325: $count,'<span class="LC_filename">'.
11326: $fname.'</span>').'</p>';
11327: } else {
11328: $output .= '<p class="LC_error">'.
11329: &mt('Error: could not update links in [_1].',
11330: '<span class="LC_filename">'.
11331: $container.'</span>').'</p>';
11332:
11333: }
11334: }
11335: }
11336: }
1.987 raeburn 11337: } else {
11338: &logthis('Failed to parse '.$container.
11339: ' to modify references: '.$parse_result);
1.661 raeburn 11340: }
11341: }
1.1071 raeburn 11342: if (wantarray) {
11343: return ($output,$count,$codebasecount);
11344: } else {
11345: return $output;
11346: }
1.661 raeburn 11347: }
11348:
11349: sub check_for_existing {
11350: my ($path,$fname,$element) = @_;
11351: my ($state,$msg);
11352: if (-d $path.'/'.$fname) {
11353: $state = 'exists';
11354: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11355: } elsif (-e $path.'/'.$fname) {
11356: $state = 'exists';
11357: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11358: }
11359: if ($state eq 'exists') {
11360: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11361: }
11362: return ($state,$msg);
11363: }
11364:
11365: sub check_for_upload {
11366: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11367: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11368: my $filesize = length($env{'form.'.$element});
11369: if (!$filesize) {
11370: my $msg = '<span class="LC_error">'.
11371: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11372: '<span class="LC_filename">'.$fname.'</span>',
11373: $filesize).'<br />'.
1.1007 raeburn 11374: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11375: '</span>';
11376: return ('zero_bytes',$msg);
11377: }
11378: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11379: my $getpropath = 1;
1.1021 raeburn 11380: my ($dirlistref,$listerror) =
11381: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11382: my $found_file = 0;
11383: my $locked_file = 0;
1.991 raeburn 11384: my @lockers;
11385: my $navmap;
11386: if ($env{'request.course.id'}) {
11387: $navmap = Apache::lonnavmaps::navmap->new();
11388: }
1.1021 raeburn 11389: if (ref($dirlistref) eq 'ARRAY') {
11390: foreach my $line (@{$dirlistref}) {
11391: my ($file_name,$rest)=split(/\&/,$line,2);
11392: if ($file_name eq $fname){
11393: $file_name = $path.$file_name;
11394: if ($group ne '') {
11395: $file_name = $group.$file_name;
11396: }
11397: $found_file = 1;
11398: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11399: foreach my $lock (@lockers) {
11400: if (ref($lock) eq 'ARRAY') {
11401: my ($symb,$crsid) = @{$lock};
11402: if ($crsid eq $env{'request.course.id'}) {
11403: if (ref($navmap)) {
11404: my $res = $navmap->getBySymb($symb);
11405: foreach my $part (@{$res->parts()}) {
11406: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11407: unless (($slot_status == $res->RESERVED) ||
11408: ($slot_status == $res->RESERVED_LOCATION)) {
11409: $locked_file = 1;
11410: }
1.991 raeburn 11411: }
1.1021 raeburn 11412: } else {
11413: $locked_file = 1;
1.991 raeburn 11414: }
11415: } else {
11416: $locked_file = 1;
11417: }
11418: }
1.1021 raeburn 11419: }
11420: } else {
11421: my @info = split(/\&/,$rest);
11422: my $currsize = $info[6]/1000;
11423: if ($currsize < $filesize) {
11424: my $extra = $filesize - $currsize;
11425: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11426: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11427: &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.',
1.1179 bisitz 11428: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11429: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11430: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11431: return ('will_exceed_quota',$msg);
11432: }
1.984 raeburn 11433: }
11434: }
1.661 raeburn 11435: }
11436: }
11437: }
11438: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11439: my $msg = '<p class="LC_warning">'.
11440: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11441: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11442: return ('will_exceed_quota',$msg);
11443: } elsif ($found_file) {
11444: if ($locked_file) {
1.1179 bisitz 11445: my $msg = '<p class="LC_warning">';
1.661 raeburn 11446: $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>');
1.1179 bisitz 11447: $msg .= '</p>';
1.661 raeburn 11448: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11449: return ('file_locked',$msg);
11450: } else {
1.1179 bisitz 11451: my $msg = '<p class="LC_error">';
1.984 raeburn 11452: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179 bisitz 11453: $msg .= '</p>';
1.984 raeburn 11454: return ('existingfile',$msg);
1.661 raeburn 11455: }
11456: }
11457: }
11458:
1.987 raeburn 11459: sub check_for_traversal {
11460: my ($path,$url,$toplevel) = @_;
11461: my @parts=split(/\//,$path);
11462: my $cleanpath;
11463: my $fullpath = $url;
11464: for (my $i=0;$i<@parts;$i++) {
11465: next if ($parts[$i] eq '.');
11466: if ($parts[$i] eq '..') {
11467: $fullpath =~ s{([^/]+/)$}{};
11468: } else {
11469: $fullpath .= $parts[$i].'/';
11470: }
11471: }
11472: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11473: $cleanpath = $1;
11474: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11475: my $curr_toprel = $1;
11476: my @parts = split(/\//,$curr_toprel);
11477: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11478: my @urlparts = split(/\//,$url_toprel);
11479: my $doubledots;
11480: my $startdiff = -1;
11481: for (my $i=0; $i<@urlparts; $i++) {
11482: if ($startdiff == -1) {
11483: unless ($urlparts[$i] eq $parts[$i]) {
11484: $startdiff = $i;
11485: $doubledots .= '../';
11486: }
11487: } else {
11488: $doubledots .= '../';
11489: }
11490: }
11491: if ($startdiff > -1) {
11492: $cleanpath = $doubledots;
11493: for (my $i=$startdiff; $i<@parts; $i++) {
11494: $cleanpath .= $parts[$i].'/';
11495: }
11496: }
11497: }
11498: $cleanpath =~ s{(/)$}{};
11499: return $cleanpath;
11500: }
1.31 albertel 11501:
1.1053 raeburn 11502: sub is_archive_file {
11503: my ($mimetype) = @_;
11504: if (($mimetype eq 'application/octet-stream') ||
11505: ($mimetype eq 'application/x-stuffit') ||
11506: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11507: return 1;
11508: }
11509: return;
11510: }
11511:
11512: sub decompress_form {
1.1065 raeburn 11513: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11514: my %lt = &Apache::lonlocal::texthash (
11515: this => 'This file is an archive file.',
1.1067 raeburn 11516: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11517: itsc => 'Its contents are as follows:',
1.1053 raeburn 11518: youm => 'You may wish to extract its contents.',
11519: extr => 'Extract contents',
1.1067 raeburn 11520: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11521: proa => 'Process automatically?',
1.1053 raeburn 11522: yes => 'Yes',
11523: no => 'No',
1.1067 raeburn 11524: fold => 'Title for folder containing movie',
11525: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11526: );
1.1065 raeburn 11527: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11528: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11529: my $info = &list_archive_contents($fileloc,\@paths);
11530: if (@paths) {
11531: foreach my $path (@paths) {
11532: $path =~ s{^/}{};
1.1067 raeburn 11533: if ($path =~ m{^([^/]+)/$}) {
11534: $topdir = $1;
11535: }
1.1065 raeburn 11536: if ($path =~ m{^([^/]+)/}) {
11537: $toplevel{$1} = $path;
11538: } else {
11539: $toplevel{$path} = $path;
11540: }
11541: }
11542: }
1.1067 raeburn 11543: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11544: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11545: "$topdir/media/",
11546: "$topdir/media/$topdir.mp4",
11547: "$topdir/media/FirstFrame.png",
11548: "$topdir/media/player.swf",
11549: "$topdir/media/swfobject.js",
11550: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11551: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11552: "$topdir/$topdir.mp4",
11553: "$topdir/$topdir\_config.xml",
11554: "$topdir/$topdir\_controller.swf",
11555: "$topdir/$topdir\_embed.css",
11556: "$topdir/$topdir\_First_Frame.png",
11557: "$topdir/$topdir\_player.html",
11558: "$topdir/$topdir\_Thumbnails.png",
11559: "$topdir/playerProductInstall.swf",
11560: "$topdir/scripts/",
11561: "$topdir/scripts/config_xml.js",
11562: "$topdir/scripts/handlebars.js",
11563: "$topdir/scripts/jquery-1.7.1.min.js",
11564: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11565: "$topdir/scripts/modernizr.js",
11566: "$topdir/scripts/player-min.js",
11567: "$topdir/scripts/swfobject.js",
11568: "$topdir/skins/",
11569: "$topdir/skins/configuration_express.xml",
11570: "$topdir/skins/express_show/",
11571: "$topdir/skins/express_show/player-min.css",
11572: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11573: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11574: "$topdir/$topdir.mp4",
11575: "$topdir/$topdir\_config.xml",
11576: "$topdir/$topdir\_controller.swf",
11577: "$topdir/$topdir\_embed.css",
11578: "$topdir/$topdir\_First_Frame.png",
11579: "$topdir/$topdir\_player.html",
11580: "$topdir/$topdir\_Thumbnails.png",
11581: "$topdir/playerProductInstall.swf",
11582: "$topdir/scripts/",
11583: "$topdir/scripts/config_xml.js",
11584: "$topdir/scripts/techsmith-smart-player.min.js",
11585: "$topdir/skins/",
11586: "$topdir/skins/configuration_express.xml",
11587: "$topdir/skins/express_show/",
11588: "$topdir/skins/express_show/spritesheet.min.css",
11589: "$topdir/skins/express_show/spritesheet.png",
11590: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11591: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11592: if (@diffs == 0) {
1.1164 raeburn 11593: $is_camtasia = 6;
11594: } else {
1.1197 raeburn 11595: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11596: if (@diffs == 0) {
11597: $is_camtasia = 8;
1.1197 raeburn 11598: } else {
11599: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11600: if (@diffs == 0) {
11601: $is_camtasia = 8;
11602: }
1.1164 raeburn 11603: }
1.1067 raeburn 11604: }
11605: }
11606: my $output;
11607: if ($is_camtasia) {
11608: $output = <<"ENDCAM";
11609: <script type="text/javascript" language="Javascript">
11610: // <![CDATA[
11611:
11612: function camtasiaToggle() {
11613: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11614: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11615: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11616: document.getElementById('camtasia_titles').style.display='block';
11617: } else {
11618: document.getElementById('camtasia_titles').style.display='none';
11619: }
11620: }
11621: }
11622: return;
11623: }
11624:
11625: // ]]>
11626: </script>
11627: <p>$lt{'camt'}</p>
11628: ENDCAM
1.1065 raeburn 11629: } else {
1.1067 raeburn 11630: $output = '<p>'.$lt{'this'};
11631: if ($info eq '') {
11632: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11633: } else {
11634: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11635: '<div><pre>'.$info.'</pre></div>';
11636: }
1.1065 raeburn 11637: }
1.1067 raeburn 11638: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11639: my $duplicates;
11640: my $num = 0;
11641: if (ref($dirlist) eq 'ARRAY') {
11642: foreach my $item (@{$dirlist}) {
11643: if (ref($item) eq 'ARRAY') {
11644: if (exists($toplevel{$item->[0]})) {
11645: $duplicates .=
11646: &start_data_table_row().
11647: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11648: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11649: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11650: 'value="1" />'.&mt('Yes').'</label>'.
11651: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11652: '<td>'.$item->[0].'</td>';
11653: if ($item->[2]) {
11654: $duplicates .= '<td>'.&mt('Directory').'</td>';
11655: } else {
11656: $duplicates .= '<td>'.&mt('File').'</td>';
11657: }
11658: $duplicates .= '<td>'.$item->[3].'</td>'.
11659: '<td>'.
11660: &Apache::lonlocal::locallocaltime($item->[4]).
11661: '</td>'.
11662: &end_data_table_row();
11663: $num ++;
11664: }
11665: }
11666: }
11667: }
11668: my $itemcount;
11669: if (@paths > 0) {
11670: $itemcount = scalar(@paths);
11671: } else {
11672: $itemcount = 1;
11673: }
1.1067 raeburn 11674: if ($is_camtasia) {
11675: $output .= $lt{'auto'}.'<br />'.
11676: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11677: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11678: $lt{'yes'}.'</label> <label>'.
11679: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11680: $lt{'no'}.'</label></span><br />'.
11681: '<div id="camtasia_titles" style="display:block">'.
11682: &Apache::lonhtmlcommon::start_pick_box().
11683: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11684: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11685: &Apache::lonhtmlcommon::row_closure().
11686: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11687: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11688: &Apache::lonhtmlcommon::row_closure(1).
11689: &Apache::lonhtmlcommon::end_pick_box().
11690: '</div>';
11691: }
1.1065 raeburn 11692: $output .=
11693: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11694: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11695: "\n";
1.1065 raeburn 11696: if ($duplicates ne '') {
11697: $output .= '<p><span class="LC_warning">'.
11698: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11699: &start_data_table().
11700: &start_data_table_header_row().
11701: '<th>'.&mt('Overwrite?').'</th>'.
11702: '<th>'.&mt('Name').'</th>'.
11703: '<th>'.&mt('Type').'</th>'.
11704: '<th>'.&mt('Size').'</th>'.
11705: '<th>'.&mt('Last modified').'</th>'.
11706: &end_data_table_header_row().
11707: $duplicates.
11708: &end_data_table().
11709: '</p>';
11710: }
1.1067 raeburn 11711: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11712: if (ref($hiddenelements) eq 'HASH') {
11713: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11714: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11715: }
11716: }
11717: $output .= <<"END";
1.1067 raeburn 11718: <br />
1.1053 raeburn 11719: <input type="submit" name="decompress" value="$lt{'extr'}" />
11720: </form>
11721: $noextract
11722: END
11723: return $output;
11724: }
11725:
1.1065 raeburn 11726: sub decompression_utility {
11727: my ($program) = @_;
11728: my @utilities = ('tar','gunzip','bunzip2','unzip');
11729: my $location;
11730: if (grep(/^\Q$program\E$/,@utilities)) {
11731: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11732: '/usr/sbin/') {
11733: if (-x $dir.$program) {
11734: $location = $dir.$program;
11735: last;
11736: }
11737: }
11738: }
11739: return $location;
11740: }
11741:
11742: sub list_archive_contents {
11743: my ($file,$pathsref) = @_;
11744: my (@cmd,$output);
11745: my $needsregexp;
11746: if ($file =~ /\.zip$/) {
11747: @cmd = (&decompression_utility('unzip'),"-l");
11748: $needsregexp = 1;
11749: } elsif (($file =~ m/\.tar\.gz$/) ||
11750: ($file =~ /\.tgz$/)) {
11751: @cmd = (&decompression_utility('tar'),"-ztf");
11752: } elsif ($file =~ /\.tar\.bz2$/) {
11753: @cmd = (&decompression_utility('tar'),"-jtf");
11754: } elsif ($file =~ m|\.tar$|) {
11755: @cmd = (&decompression_utility('tar'),"-tf");
11756: }
11757: if (@cmd) {
11758: undef($!);
11759: undef($@);
11760: if (open(my $fh,"-|", @cmd, $file)) {
11761: while (my $line = <$fh>) {
11762: $output .= $line;
11763: chomp($line);
11764: my $item;
11765: if ($needsregexp) {
11766: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11767: } else {
11768: $item = $line;
11769: }
11770: if ($item ne '') {
11771: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11772: push(@{$pathsref},$item);
11773: }
11774: }
11775: }
11776: close($fh);
11777: }
11778: }
11779: return $output;
11780: }
11781:
1.1053 raeburn 11782: sub decompress_uploaded_file {
11783: my ($file,$dir) = @_;
11784: &Apache::lonnet::appenv({'cgi.file' => $file});
11785: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11786: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11787: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11788: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11789: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11790: my $decompressed = $env{'cgi.decompressed'};
11791: &Apache::lonnet::delenv('cgi.file');
11792: &Apache::lonnet::delenv('cgi.dir');
11793: &Apache::lonnet::delenv('cgi.decompressed');
11794: return ($decompressed,$result);
11795: }
11796:
1.1055 raeburn 11797: sub process_decompression {
11798: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11799: my ($dir,$error,$warning,$output);
1.1180 raeburn 11800: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11801: $error = &mt('Filename not a supported archive file type.').
11802: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11803: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11804: } else {
11805: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11806: if ($docuhome eq 'no_host') {
11807: $error = &mt('Could not determine home server for course.');
11808: } else {
11809: my @ids=&Apache::lonnet::current_machine_ids();
11810: my $currdir = "$dir_root/$destination";
11811: if (grep(/^\Q$docuhome\E$/,@ids)) {
11812: $dir = &LONCAPA::propath($docudom,$docuname).
11813: "$dir_root/$destination";
11814: } else {
11815: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11816: "$dir_root/$docudom/$docuname/$destination";
11817: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11818: $error = &mt('Archive file not found.');
11819: }
11820: }
1.1065 raeburn 11821: my (@to_overwrite,@to_skip);
11822: if ($env{'form.archive_overwrite_total'} > 0) {
11823: my $total = $env{'form.archive_overwrite_total'};
11824: for (my $i=0; $i<$total; $i++) {
11825: if ($env{'form.archive_overwrite_'.$i} == 1) {
11826: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11827: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11828: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11829: }
11830: }
11831: }
11832: my $numskip = scalar(@to_skip);
11833: if (($numskip > 0) &&
11834: ($numskip == $env{'form.archive_itemcount'})) {
11835: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11836: } elsif ($dir eq '') {
1.1055 raeburn 11837: $error = &mt('Directory containing archive file unavailable.');
11838: } elsif (!$error) {
1.1065 raeburn 11839: my ($decompressed,$display);
11840: if ($numskip > 0) {
11841: my $tempdir = time.'_'.$$.int(rand(10000));
11842: mkdir("$dir/$tempdir",0755);
11843: system("mv $dir/$file $dir/$tempdir/$file");
11844: ($decompressed,$display) =
11845: &decompress_uploaded_file($file,"$dir/$tempdir");
11846: foreach my $item (@to_skip) {
11847: if (($item ne '') && ($item !~ /\.\./)) {
11848: if (-f "$dir/$tempdir/$item") {
11849: unlink("$dir/$tempdir/$item");
11850: } elsif (-d "$dir/$tempdir/$item") {
11851: system("rm -rf $dir/$tempdir/$item");
11852: }
11853: }
11854: }
11855: system("mv $dir/$tempdir/* $dir");
11856: rmdir("$dir/$tempdir");
11857: } else {
11858: ($decompressed,$display) =
11859: &decompress_uploaded_file($file,$dir);
11860: }
1.1055 raeburn 11861: if ($decompressed eq 'ok') {
1.1065 raeburn 11862: $output = '<p class="LC_info">'.
11863: &mt('Files extracted successfully from archive.').
11864: '</p>'."\n";
1.1055 raeburn 11865: my ($warning,$result,@contents);
11866: my ($newdirlistref,$newlisterror) =
11867: &Apache::lonnet::dirlist($currdir,$docudom,
11868: $docuname,1);
11869: my (%is_dir,%changes,@newitems);
11870: my $dirptr = 16384;
1.1065 raeburn 11871: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11872: foreach my $dir_line (@{$newdirlistref}) {
11873: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11874: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11875: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11876: push(@newitems,$item);
11877: if ($dirptr&$testdir) {
11878: $is_dir{$item} = 1;
11879: }
11880: $changes{$item} = 1;
11881: }
11882: }
11883: }
11884: if (keys(%changes) > 0) {
11885: foreach my $item (sort(@newitems)) {
11886: if ($changes{$item}) {
11887: push(@contents,$item);
11888: }
11889: }
11890: }
11891: if (@contents > 0) {
1.1067 raeburn 11892: my $wantform;
11893: unless ($env{'form.autoextract_camtasia'}) {
11894: $wantform = 1;
11895: }
1.1056 raeburn 11896: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11897: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11898: $currdir,\%is_dir,
11899: \%children,\%parent,
1.1056 raeburn 11900: \@contents,\%dirorder,
11901: \%titles,$wantform);
1.1055 raeburn 11902: if ($datatable ne '') {
11903: $output .= &archive_options_form('decompressed',$datatable,
11904: $count,$hiddenelem);
1.1065 raeburn 11905: my $startcount = 6;
1.1055 raeburn 11906: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11907: \%titles,\%children);
1.1055 raeburn 11908: }
1.1067 raeburn 11909: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11910: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11911: my %displayed;
11912: my $total = 1;
11913: $env{'form.archive_directory'} = [];
11914: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11915: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11916: $path =~ s{/$}{};
11917: my $item;
11918: if ($path ne '') {
11919: $item = "$path/$titles{$i}";
11920: } else {
11921: $item = $titles{$i};
11922: }
11923: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11924: if ($item eq $contents[0]) {
11925: push(@{$env{'form.archive_directory'}},$i);
11926: $env{'form.archive_'.$i} = 'display';
11927: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11928: $displayed{'folder'} = $i;
1.1164 raeburn 11929: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11930: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11931: $env{'form.archive_'.$i} = 'display';
11932: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11933: $displayed{'web'} = $i;
11934: } else {
1.1164 raeburn 11935: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11936: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11937: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11938: push(@{$env{'form.archive_directory'}},$i);
11939: }
11940: $env{'form.archive_'.$i} = 'dependency';
11941: }
11942: $total ++;
11943: }
11944: for (my $i=1; $i<$total; $i++) {
11945: next if ($i == $displayed{'web'});
11946: next if ($i == $displayed{'folder'});
11947: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11948: }
11949: $env{'form.phase'} = 'decompress_cleanup';
11950: $env{'form.archivedelete'} = 1;
11951: $env{'form.archive_count'} = $total-1;
11952: $output .=
11953: &process_extracted_files('coursedocs',$docudom,
11954: $docuname,$destination,
11955: $dir_root,$hiddenelem);
11956: }
1.1055 raeburn 11957: } else {
11958: $warning = &mt('No new items extracted from archive file.');
11959: }
11960: } else {
11961: $output = $display;
11962: $error = &mt('An error occurred during extraction from the archive file.');
11963: }
11964: }
11965: }
11966: }
11967: if ($error) {
11968: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11969: $error.'</p>'."\n";
11970: }
11971: if ($warning) {
11972: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11973: }
11974: return $output;
11975: }
11976:
11977: sub get_extracted {
1.1056 raeburn 11978: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11979: $titles,$wantform) = @_;
1.1055 raeburn 11980: my $count = 0;
11981: my $depth = 0;
11982: my $datatable;
1.1056 raeburn 11983: my @hierarchy;
1.1055 raeburn 11984: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11985: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11986: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11987: foreach my $item (@{$contents}) {
11988: $count ++;
1.1056 raeburn 11989: @{$dirorder->{$count}} = @hierarchy;
11990: $titles->{$count} = $item;
1.1055 raeburn 11991: &archive_hierarchy($depth,$count,$parent,$children);
11992: if ($wantform) {
11993: $datatable .= &archive_row($is_dir->{$item},$item,
11994: $currdir,$depth,$count);
11995: }
11996: if ($is_dir->{$item}) {
11997: $depth ++;
1.1056 raeburn 11998: push(@hierarchy,$count);
11999: $parent->{$depth} = $count;
1.1055 raeburn 12000: $datatable .=
12001: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12002: \$depth,\$count,\@hierarchy,$dirorder,
12003: $children,$parent,$titles,$wantform);
1.1055 raeburn 12004: $depth --;
1.1056 raeburn 12005: pop(@hierarchy);
1.1055 raeburn 12006: }
12007: }
12008: return ($count,$datatable);
12009: }
12010:
12011: sub recurse_extracted_archive {
1.1056 raeburn 12012: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12013: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12014: my $result='';
1.1056 raeburn 12015: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12016: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12017: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12018: return $result;
12019: }
12020: my $dirptr = 16384;
12021: my ($newdirlistref,$newlisterror) =
12022: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12023: if (ref($newdirlistref) eq 'ARRAY') {
12024: foreach my $dir_line (@{$newdirlistref}) {
12025: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12026: unless ($item =~ /^\.+$/) {
12027: $$count ++;
1.1056 raeburn 12028: @{$dirorder->{$$count}} = @{$hierarchy};
12029: $titles->{$$count} = $item;
1.1055 raeburn 12030: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12031:
1.1055 raeburn 12032: my $is_dir;
12033: if ($dirptr&$testdir) {
12034: $is_dir = 1;
12035: }
12036: if ($wantform) {
12037: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12038: }
12039: if ($is_dir) {
12040: $$depth ++;
1.1056 raeburn 12041: push(@{$hierarchy},$$count);
12042: $parent->{$$depth} = $$count;
1.1055 raeburn 12043: $result .=
12044: &recurse_extracted_archive("$currdir/$item",$docudom,
12045: $docuname,$depth,$count,
1.1056 raeburn 12046: $hierarchy,$dirorder,$children,
12047: $parent,$titles,$wantform);
1.1055 raeburn 12048: $$depth --;
1.1056 raeburn 12049: pop(@{$hierarchy});
1.1055 raeburn 12050: }
12051: }
12052: }
12053: }
12054: return $result;
12055: }
12056:
12057: sub archive_hierarchy {
12058: my ($depth,$count,$parent,$children) =@_;
12059: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12060: if (exists($parent->{$depth})) {
12061: $children->{$parent->{$depth}} .= $count.':';
12062: }
12063: }
12064: return;
12065: }
12066:
12067: sub archive_row {
12068: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12069: my ($name) = ($item =~ m{([^/]+)$});
12070: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12071: 'display' => 'Add as file',
1.1055 raeburn 12072: 'dependency' => 'Include as dependency',
12073: 'discard' => 'Discard',
12074: );
12075: if ($is_dir) {
1.1059 raeburn 12076: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12077: }
1.1056 raeburn 12078: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12079: my $offset = 0;
1.1055 raeburn 12080: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12081: $offset ++;
1.1065 raeburn 12082: if ($action ne 'display') {
12083: $offset ++;
12084: }
1.1055 raeburn 12085: $output .= '<td><span class="LC_nobreak">'.
12086: '<label><input type="radio" name="archive_'.$count.
12087: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12088: my $text = $choices{$action};
12089: if ($is_dir) {
12090: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12091: if ($action eq 'display') {
1.1059 raeburn 12092: $text = &mt('Add as folder');
1.1055 raeburn 12093: }
1.1056 raeburn 12094: } else {
12095: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12096:
12097: }
12098: $output .= ' /> '.$choices{$action}.'</label></span>';
12099: if ($action eq 'dependency') {
12100: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12101: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12102: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12103: '<option value=""></option>'."\n".
12104: '</select>'."\n".
12105: '</div>';
1.1059 raeburn 12106: } elsif ($action eq 'display') {
12107: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12108: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12109: '</div>';
1.1055 raeburn 12110: }
1.1056 raeburn 12111: $output .= '</td>';
1.1055 raeburn 12112: }
12113: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12114: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12115: for (my $i=0; $i<$depth; $i++) {
12116: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12117: }
12118: if ($is_dir) {
12119: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12120: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12121: } else {
12122: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12123: }
12124: $output .= ' '.$name.'</td>'."\n".
12125: &end_data_table_row();
12126: return $output;
12127: }
12128:
12129: sub archive_options_form {
1.1065 raeburn 12130: my ($form,$display,$count,$hiddenelem) = @_;
12131: my %lt = &Apache::lonlocal::texthash(
12132: perm => 'Permanently remove archive file?',
12133: hows => 'How should each extracted item be incorporated in the course?',
12134: cont => 'Content actions for all',
12135: addf => 'Add as folder/file',
12136: incd => 'Include as dependency for a displayed file',
12137: disc => 'Discard',
12138: no => 'No',
12139: yes => 'Yes',
12140: save => 'Save',
12141: );
12142: my $output = <<"END";
12143: <form name="$form" method="post" action="">
12144: <p><span class="LC_nobreak">$lt{'perm'}
12145: <label>
12146: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12147: </label>
12148:
12149: <label>
12150: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12151: </span>
12152: </p>
12153: <input type="hidden" name="phase" value="decompress_cleanup" />
12154: <br />$lt{'hows'}
12155: <div class="LC_columnSection">
12156: <fieldset>
12157: <legend>$lt{'cont'}</legend>
12158: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12159: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12160: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12161: </fieldset>
12162: </div>
12163: END
12164: return $output.
1.1055 raeburn 12165: &start_data_table()."\n".
1.1065 raeburn 12166: $display."\n".
1.1055 raeburn 12167: &end_data_table()."\n".
12168: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12169: $hiddenelem.
1.1065 raeburn 12170: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12171: '</form>';
12172: }
12173:
12174: sub archive_javascript {
1.1056 raeburn 12175: my ($startcount,$numitems,$titles,$children) = @_;
12176: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12177: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12178: my $scripttag = <<START;
12179: <script type="text/javascript">
12180: // <![CDATA[
12181:
12182: function checkAll(form,prefix) {
12183: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12184: for (var i=0; i < form.elements.length; i++) {
12185: var id = form.elements[i].id;
12186: if ((id != '') && (id != undefined)) {
12187: if (idstr.test(id)) {
12188: if (form.elements[i].type == 'radio') {
12189: form.elements[i].checked = true;
1.1056 raeburn 12190: var nostart = i-$startcount;
1.1059 raeburn 12191: var offset = nostart%7;
12192: var count = (nostart-offset)/7;
1.1056 raeburn 12193: dependencyCheck(form,count,offset);
1.1055 raeburn 12194: }
12195: }
12196: }
12197: }
12198: }
12199:
12200: function propagateCheck(form,count) {
12201: if (count > 0) {
1.1059 raeburn 12202: var startelement = $startcount + ((count-1) * 7);
12203: for (var j=1; j<6; j++) {
12204: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12205: var item = startelement + j;
12206: if (form.elements[item].type == 'radio') {
12207: if (form.elements[item].checked) {
12208: containerCheck(form,count,j);
12209: break;
12210: }
1.1055 raeburn 12211: }
12212: }
12213: }
12214: }
12215: }
12216:
12217: numitems = $numitems
1.1056 raeburn 12218: var titles = new Array(numitems);
12219: var parents = new Array(numitems);
1.1055 raeburn 12220: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12221: parents[i] = new Array;
1.1055 raeburn 12222: }
1.1059 raeburn 12223: var maintitle = '$maintitle';
1.1055 raeburn 12224:
12225: START
12226:
1.1056 raeburn 12227: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12228: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12229: for (my $i=0; $i<@contents; $i ++) {
12230: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12231: }
12232: }
12233:
1.1056 raeburn 12234: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12235: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12236: }
12237:
1.1055 raeburn 12238: $scripttag .= <<END;
12239:
12240: function containerCheck(form,count,offset) {
12241: if (count > 0) {
1.1056 raeburn 12242: dependencyCheck(form,count,offset);
1.1059 raeburn 12243: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12244: form.elements[item].checked = true;
12245: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12246: if (parents[count].length > 0) {
12247: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12248: containerCheck(form,parents[count][j],offset);
12249: }
12250: }
12251: }
12252: }
12253: }
12254:
12255: function dependencyCheck(form,count,offset) {
12256: if (count > 0) {
1.1059 raeburn 12257: var chosen = (offset+$startcount)+7*(count-1);
12258: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12259: var currtype = form.elements[depitem].type;
12260: if (form.elements[chosen].value == 'dependency') {
12261: document.getElementById('arc_depon_'+count).style.display='block';
12262: form.elements[depitem].options.length = 0;
12263: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12264: for (var i=1; i<=numitems; i++) {
12265: if (i == count) {
12266: continue;
12267: }
1.1059 raeburn 12268: var startelement = $startcount + (i-1) * 7;
12269: for (var j=1; j<6; j++) {
12270: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12271: var item = startelement + j;
12272: if (form.elements[item].type == 'radio') {
12273: if (form.elements[item].checked) {
12274: if (form.elements[item].value == 'display') {
12275: var n = form.elements[depitem].options.length;
12276: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12277: }
12278: }
12279: }
12280: }
12281: }
12282: }
12283: } else {
12284: document.getElementById('arc_depon_'+count).style.display='none';
12285: form.elements[depitem].options.length = 0;
12286: form.elements[depitem].options[0] = new Option('Select','',true,true);
12287: }
1.1059 raeburn 12288: titleCheck(form,count,offset);
1.1056 raeburn 12289: }
12290: }
12291:
12292: function propagateSelect(form,count,offset) {
12293: if (count > 0) {
1.1065 raeburn 12294: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12295: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12296: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12297: if (parents[count].length > 0) {
12298: for (var j=0; j<parents[count].length; j++) {
12299: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12300: }
12301: }
12302: }
12303: }
12304: }
1.1056 raeburn 12305:
12306: function containerSelect(form,count,offset,picked) {
12307: if (count > 0) {
1.1065 raeburn 12308: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12309: if (form.elements[item].type == 'radio') {
12310: if (form.elements[item].value == 'dependency') {
12311: if (form.elements[item+1].type == 'select-one') {
12312: for (var i=0; i<form.elements[item+1].options.length; i++) {
12313: if (form.elements[item+1].options[i].value == picked) {
12314: form.elements[item+1].selectedIndex = i;
12315: break;
12316: }
12317: }
12318: }
12319: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12320: if (parents[count].length > 0) {
12321: for (var j=0; j<parents[count].length; j++) {
12322: containerSelect(form,parents[count][j],offset,picked);
12323: }
12324: }
12325: }
12326: }
12327: }
12328: }
12329: }
12330:
1.1059 raeburn 12331: function titleCheck(form,count,offset) {
12332: if (count > 0) {
12333: var chosen = (offset+$startcount)+7*(count-1);
12334: var depitem = $startcount + ((count-1) * 7) + 2;
12335: var currtype = form.elements[depitem].type;
12336: if (form.elements[chosen].value == 'display') {
12337: document.getElementById('arc_title_'+count).style.display='block';
12338: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12339: document.getElementById('archive_title_'+count).value=maintitle;
12340: }
12341: } else {
12342: document.getElementById('arc_title_'+count).style.display='none';
12343: if (currtype == 'text') {
12344: document.getElementById('archive_title_'+count).value='';
12345: }
12346: }
12347: }
12348: return;
12349: }
12350:
1.1055 raeburn 12351: // ]]>
12352: </script>
12353: END
12354: return $scripttag;
12355: }
12356:
12357: sub process_extracted_files {
1.1067 raeburn 12358: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12359: my $numitems = $env{'form.archive_count'};
12360: return unless ($numitems);
12361: my @ids=&Apache::lonnet::current_machine_ids();
12362: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12363: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12364: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12365: if (grep(/^\Q$docuhome\E$/,@ids)) {
12366: $prefix = &LONCAPA::propath($docudom,$docuname);
12367: $pathtocheck = "$dir_root/$destination";
12368: $dir = $dir_root;
12369: $ishome = 1;
12370: } else {
12371: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12372: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12373: $dir = "$dir_root/$docudom/$docuname";
12374: }
12375: my $currdir = "$dir_root/$destination";
12376: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12377: if ($env{'form.folderpath'}) {
12378: my @items = split('&',$env{'form.folderpath'});
12379: $folders{'0'} = $items[-2];
1.1099 raeburn 12380: if ($env{'form.folderpath'} =~ /\:1$/) {
12381: $containers{'0'}='page';
12382: } else {
12383: $containers{'0'}='sequence';
12384: }
1.1055 raeburn 12385: }
12386: my @archdirs = &get_env_multiple('form.archive_directory');
12387: if ($numitems) {
12388: for (my $i=1; $i<=$numitems; $i++) {
12389: my $path = $env{'form.archive_content_'.$i};
12390: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12391: my $item = $1;
12392: $toplevelitems{$item} = $i;
12393: if (grep(/^\Q$i\E$/,@archdirs)) {
12394: $is_dir{$item} = 1;
12395: }
12396: }
12397: }
12398: }
1.1067 raeburn 12399: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12400: if (keys(%toplevelitems) > 0) {
12401: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12402: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12403: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12404: }
1.1066 raeburn 12405: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12406: if ($numitems) {
12407: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 12408: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12409: my $path = $env{'form.archive_content_'.$i};
12410: if ($path =~ /^\Q$pathtocheck\E/) {
12411: if ($env{'form.archive_'.$i} eq 'discard') {
12412: if ($prefix ne '' && $path ne '') {
12413: if (-e $prefix.$path) {
1.1066 raeburn 12414: if ((@archdirs > 0) &&
12415: (grep(/^\Q$i\E$/,@archdirs))) {
12416: $todeletedir{$prefix.$path} = 1;
12417: } else {
12418: $todelete{$prefix.$path} = 1;
12419: }
1.1055 raeburn 12420: }
12421: }
12422: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12423: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12424: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12425: $docstitle = $env{'form.archive_title_'.$i};
12426: if ($docstitle eq '') {
12427: $docstitle = $title;
12428: }
1.1055 raeburn 12429: $outer = 0;
1.1056 raeburn 12430: if (ref($dirorder{$i}) eq 'ARRAY') {
12431: if (@{$dirorder{$i}} > 0) {
12432: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12433: if ($env{'form.archive_'.$item} eq 'display') {
12434: $outer = $item;
12435: last;
12436: }
12437: }
12438: }
12439: }
12440: my ($errtext,$fatal) =
12441: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12442: '/'.$folders{$outer}.'.'.
12443: $containers{$outer});
12444: next if ($fatal);
12445: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12446: if ($context eq 'coursedocs') {
1.1056 raeburn 12447: $mapinner{$i} = time;
1.1055 raeburn 12448: $folders{$i} = 'default_'.$mapinner{$i};
12449: $containers{$i} = 'sequence';
12450: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12451: $folders{$i}.'.'.$containers{$i};
12452: my $newidx = &LONCAPA::map::getresidx();
12453: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12454: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12455: push(@LONCAPA::map::order,$newidx);
12456: my ($outtext,$errtext) =
12457: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12458: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12459: '.'.$containers{$outer},1,1);
1.1056 raeburn 12460: $newseqid{$i} = $newidx;
1.1067 raeburn 12461: unless ($errtext) {
12462: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12463: }
1.1055 raeburn 12464: }
12465: } else {
12466: if ($context eq 'coursedocs') {
12467: my $newidx=&LONCAPA::map::getresidx();
12468: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12469: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12470: $title;
12471: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12472: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12473: }
12474: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12475: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12476: }
12477: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12478: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12479: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12480: unless ($ishome) {
12481: my $fetch = "$newdest{$i}/$title";
12482: $fetch =~ s/^\Q$prefix$dir\E//;
12483: $prompttofetch{$fetch} = 1;
12484: }
1.1055 raeburn 12485: }
12486: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12487: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12488: push(@LONCAPA::map::order, $newidx);
12489: my ($outtext,$errtext)=
12490: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12491: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12492: '.'.$containers{$outer},1,1);
1.1067 raeburn 12493: unless ($errtext) {
12494: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12495: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12496: }
12497: }
1.1055 raeburn 12498: }
12499: }
1.1086 raeburn 12500: }
12501: } else {
12502: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12503: }
12504: }
12505: for (my $i=1; $i<=$numitems; $i++) {
12506: next unless ($env{'form.archive_'.$i} eq 'dependency');
12507: my $path = $env{'form.archive_content_'.$i};
12508: if ($path =~ /^\Q$pathtocheck\E/) {
12509: my ($title) = ($path =~ m{/([^/]+)$});
12510: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12511: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12512: if (ref($dirorder{$i}) eq 'ARRAY') {
12513: my ($itemidx,$fullpath,$relpath);
12514: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12515: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12516: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12517: if ($dirorder{$i}->[$j] eq $container) {
12518: $itemidx = $j;
1.1056 raeburn 12519: }
12520: }
1.1086 raeburn 12521: }
12522: if ($itemidx eq '') {
12523: $itemidx = 0;
12524: }
12525: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12526: if ($mapinner{$referrer{$i}}) {
12527: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12528: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12529: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12530: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12531: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12532: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12533: if (!-e $fullpath) {
12534: mkdir($fullpath,0755);
1.1056 raeburn 12535: }
12536: }
1.1086 raeburn 12537: } else {
12538: last;
1.1056 raeburn 12539: }
1.1086 raeburn 12540: }
12541: }
12542: } elsif ($newdest{$referrer{$i}}) {
12543: $fullpath = $newdest{$referrer{$i}};
12544: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12545: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12546: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12547: last;
12548: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12549: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12550: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12551: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12552: if (!-e $fullpath) {
12553: mkdir($fullpath,0755);
1.1056 raeburn 12554: }
12555: }
1.1086 raeburn 12556: } else {
12557: last;
1.1056 raeburn 12558: }
1.1055 raeburn 12559: }
12560: }
1.1086 raeburn 12561: if ($fullpath ne '') {
12562: if (-e "$prefix$path") {
12563: system("mv $prefix$path $fullpath/$title");
12564: }
12565: if (-e "$fullpath/$title") {
12566: my $showpath;
12567: if ($relpath ne '') {
12568: $showpath = "$relpath/$title";
12569: } else {
12570: $showpath = "/$title";
12571: }
12572: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12573: }
12574: unless ($ishome) {
12575: my $fetch = "$fullpath/$title";
12576: $fetch =~ s/^\Q$prefix$dir\E//;
12577: $prompttofetch{$fetch} = 1;
12578: }
12579: }
1.1055 raeburn 12580: }
1.1086 raeburn 12581: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12582: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12583: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12584: }
12585: } else {
12586: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12587: }
12588: }
12589: if (keys(%todelete)) {
12590: foreach my $key (keys(%todelete)) {
12591: unlink($key);
1.1066 raeburn 12592: }
12593: }
12594: if (keys(%todeletedir)) {
12595: foreach my $key (keys(%todeletedir)) {
12596: rmdir($key);
12597: }
12598: }
12599: foreach my $dir (sort(keys(%is_dir))) {
12600: if (($pathtocheck ne '') && ($dir ne '')) {
12601: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12602: }
12603: }
1.1067 raeburn 12604: if ($result ne '') {
12605: $output .= '<ul>'."\n".
12606: $result."\n".
12607: '</ul>';
12608: }
12609: unless ($ishome) {
12610: my $replicationfail;
12611: foreach my $item (keys(%prompttofetch)) {
12612: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12613: unless ($fetchresult eq 'ok') {
12614: $replicationfail .= '<li>'.$item.'</li>'."\n";
12615: }
12616: }
12617: if ($replicationfail) {
12618: $output .= '<p class="LC_error">'.
12619: &mt('Course home server failed to retrieve:').'<ul>'.
12620: $replicationfail.
12621: '</ul></p>';
12622: }
12623: }
1.1055 raeburn 12624: } else {
12625: $warning = &mt('No items found in archive.');
12626: }
12627: if ($error) {
12628: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12629: $error.'</p>'."\n";
12630: }
12631: if ($warning) {
12632: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12633: }
12634: return $output;
12635: }
12636:
1.1066 raeburn 12637: sub cleanup_empty_dirs {
12638: my ($path) = @_;
12639: if (($path ne '') && (-d $path)) {
12640: if (opendir(my $dirh,$path)) {
12641: my @dircontents = grep(!/^\./,readdir($dirh));
12642: my $numitems = 0;
12643: foreach my $item (@dircontents) {
12644: if (-d "$path/$item") {
1.1111 raeburn 12645: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12646: if (-e "$path/$item") {
12647: $numitems ++;
12648: }
12649: } else {
12650: $numitems ++;
12651: }
12652: }
12653: if ($numitems == 0) {
12654: rmdir($path);
12655: }
12656: closedir($dirh);
12657: }
12658: }
12659: return;
12660: }
12661:
1.41 ng 12662: =pod
1.45 matthew 12663:
1.1162 raeburn 12664: =item * &get_folder_hierarchy()
1.1068 raeburn 12665:
12666: Provides hierarchy of names of folders/sub-folders containing the current
12667: item,
12668:
12669: Inputs: 3
12670: - $navmap - navmaps object
12671:
12672: - $map - url for map (either the trigger itself, or map containing
12673: the resource, which is the trigger).
12674:
12675: - $showitem - 1 => show title for map itself; 0 => do not show.
12676:
12677: Outputs: 1 @pathitems - array of folder/subfolder names.
12678:
12679: =cut
12680:
12681: sub get_folder_hierarchy {
12682: my ($navmap,$map,$showitem) = @_;
12683: my @pathitems;
12684: if (ref($navmap)) {
12685: my $mapres = $navmap->getResourceByUrl($map);
12686: if (ref($mapres)) {
12687: my $pcslist = $mapres->map_hierarchy();
12688: if ($pcslist ne '') {
12689: my @pcs = split(/,/,$pcslist);
12690: foreach my $pc (@pcs) {
12691: if ($pc == 1) {
1.1129 raeburn 12692: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12693: } else {
12694: my $res = $navmap->getByMapPc($pc);
12695: if (ref($res)) {
12696: my $title = $res->compTitle();
12697: $title =~ s/\W+/_/g;
12698: if ($title ne '') {
12699: push(@pathitems,$title);
12700: }
12701: }
12702: }
12703: }
12704: }
1.1071 raeburn 12705: if ($showitem) {
12706: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12707: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12708: } else {
12709: my $maptitle = $mapres->compTitle();
12710: $maptitle =~ s/\W+/_/g;
12711: if ($maptitle ne '') {
12712: push(@pathitems,$maptitle);
12713: }
1.1068 raeburn 12714: }
12715: }
12716: }
12717: }
12718: return @pathitems;
12719: }
12720:
12721: =pod
12722:
1.1015 raeburn 12723: =item * &get_turnedin_filepath()
12724:
12725: Determines path in a user's portfolio file for storage of files uploaded
12726: to a specific essayresponse or dropbox item.
12727:
12728: Inputs: 3 required + 1 optional.
12729: $symb is symb for resource, $uname and $udom are for current user (required).
12730: $caller is optional (can be "submission", if routine is called when storing
12731: an upoaded file when "Submit Answer" button was pressed).
12732:
12733: Returns array containing $path and $multiresp.
12734: $path is path in portfolio. $multiresp is 1 if this resource contains more
12735: than one file upload item. Callers of routine should append partid as a
12736: subdirectory to $path in cases where $multiresp is 1.
12737:
12738: Called by: homework/essayresponse.pm and homework/structuretags.pm
12739:
12740: =cut
12741:
12742: sub get_turnedin_filepath {
12743: my ($symb,$uname,$udom,$caller) = @_;
12744: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12745: my $turnindir;
12746: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12747: $turnindir = $userhash{'turnindir'};
12748: my ($path,$multiresp);
12749: if ($turnindir eq '') {
12750: if ($caller eq 'submission') {
12751: $turnindir = &mt('turned in');
12752: $turnindir =~ s/\W+/_/g;
12753: my %newhash = (
12754: 'turnindir' => $turnindir,
12755: );
12756: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12757: }
12758: }
12759: if ($turnindir ne '') {
12760: $path = '/'.$turnindir.'/';
12761: my ($multipart,$turnin,@pathitems);
12762: my $navmap = Apache::lonnavmaps::navmap->new();
12763: if (defined($navmap)) {
12764: my $mapres = $navmap->getResourceByUrl($map);
12765: if (ref($mapres)) {
12766: my $pcslist = $mapres->map_hierarchy();
12767: if ($pcslist ne '') {
12768: foreach my $pc (split(/,/,$pcslist)) {
12769: my $res = $navmap->getByMapPc($pc);
12770: if (ref($res)) {
12771: my $title = $res->compTitle();
12772: $title =~ s/\W+/_/g;
12773: if ($title ne '') {
1.1149 raeburn 12774: if (($pc > 1) && (length($title) > 12)) {
12775: $title = substr($title,0,12);
12776: }
1.1015 raeburn 12777: push(@pathitems,$title);
12778: }
12779: }
12780: }
12781: }
12782: my $maptitle = $mapres->compTitle();
12783: $maptitle =~ s/\W+/_/g;
12784: if ($maptitle ne '') {
1.1149 raeburn 12785: if (length($maptitle) > 12) {
12786: $maptitle = substr($maptitle,0,12);
12787: }
1.1015 raeburn 12788: push(@pathitems,$maptitle);
12789: }
12790: unless ($env{'request.state'} eq 'construct') {
12791: my $res = $navmap->getBySymb($symb);
12792: if (ref($res)) {
12793: my $partlist = $res->parts();
12794: my $totaluploads = 0;
12795: if (ref($partlist) eq 'ARRAY') {
12796: foreach my $part (@{$partlist}) {
12797: my @types = $res->responseType($part);
12798: my @ids = $res->responseIds($part);
12799: for (my $i=0; $i < scalar(@ids); $i++) {
12800: if ($types[$i] eq 'essay') {
12801: my $partid = $part.'_'.$ids[$i];
12802: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12803: $totaluploads ++;
12804: }
12805: }
12806: }
12807: }
12808: if ($totaluploads > 1) {
12809: $multiresp = 1;
12810: }
12811: }
12812: }
12813: }
12814: } else {
12815: return;
12816: }
12817: } else {
12818: return;
12819: }
12820: my $restitle=&Apache::lonnet::gettitle($symb);
12821: $restitle =~ s/\W+/_/g;
12822: if ($restitle eq '') {
12823: $restitle = ($resurl =~ m{/[^/]+$});
12824: if ($restitle eq '') {
12825: $restitle = time;
12826: }
12827: }
1.1149 raeburn 12828: if (length($restitle) > 12) {
12829: $restitle = substr($restitle,0,12);
12830: }
1.1015 raeburn 12831: push(@pathitems,$restitle);
12832: $path .= join('/',@pathitems);
12833: }
12834: return ($path,$multiresp);
12835: }
12836:
12837: =pod
12838:
1.464 albertel 12839: =back
1.41 ng 12840:
1.112 bowersj2 12841: =head1 CSV Upload/Handling functions
1.38 albertel 12842:
1.41 ng 12843: =over 4
12844:
1.648 raeburn 12845: =item * &upfile_store($r)
1.41 ng 12846:
12847: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12848: needs $env{'form.upfile'}
1.41 ng 12849: returns $datatoken to be put into hidden field
12850:
12851: =cut
1.31 albertel 12852:
12853: sub upfile_store {
12854: my $r=shift;
1.258 albertel 12855: $env{'form.upfile'}=~s/\r/\n/gs;
12856: $env{'form.upfile'}=~s/\f/\n/gs;
12857: $env{'form.upfile'}=~s/\n+/\n/gs;
12858: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12859:
1.258 albertel 12860: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12861: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12862: {
1.158 raeburn 12863: my $datafile = $r->dir_config('lonDaemons').
12864: '/tmp/'.$datatoken.'.tmp';
12865: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12866: print $fh $env{'form.upfile'};
1.158 raeburn 12867: close($fh);
12868: }
1.31 albertel 12869: }
12870: return $datatoken;
12871: }
12872:
1.56 matthew 12873: =pod
12874:
1.648 raeburn 12875: =item * &load_tmp_file($r)
1.41 ng 12876:
12877: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12878: needs $env{'form.datatoken'},
12879: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12880:
12881: =cut
1.31 albertel 12882:
12883: sub load_tmp_file {
12884: my $r=shift;
12885: my @studentdata=();
12886: {
1.158 raeburn 12887: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12888: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12889: if ( open(my $fh,"<$studentfile") ) {
12890: @studentdata=<$fh>;
12891: close($fh);
12892: }
1.31 albertel 12893: }
1.258 albertel 12894: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12895: }
12896:
1.56 matthew 12897: =pod
12898:
1.648 raeburn 12899: =item * &upfile_record_sep()
1.41 ng 12900:
12901: Separate uploaded file into records
12902: returns array of records,
1.258 albertel 12903: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12904:
12905: =cut
1.31 albertel 12906:
12907: sub upfile_record_sep {
1.258 albertel 12908: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12909: } else {
1.248 albertel 12910: my @records;
1.258 albertel 12911: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12912: if ($line=~/^\s*$/) { next; }
12913: push(@records,$line);
12914: }
12915: return @records;
1.31 albertel 12916: }
12917: }
12918:
1.56 matthew 12919: =pod
12920:
1.648 raeburn 12921: =item * &record_sep($record)
1.41 ng 12922:
1.258 albertel 12923: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12924:
12925: =cut
12926:
1.263 www 12927: sub takeleft {
12928: my $index=shift;
12929: return substr('0000'.$index,-4,4);
12930: }
12931:
1.31 albertel 12932: sub record_sep {
12933: my $record=shift;
12934: my %components=();
1.258 albertel 12935: if ($env{'form.upfiletype'} eq 'xml') {
12936: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12937: my $i=0;
1.356 albertel 12938: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12939: $field=~s/^(\"|\')//;
12940: $field=~s/(\"|\')$//;
1.263 www 12941: $components{&takeleft($i)}=$field;
1.31 albertel 12942: $i++;
12943: }
1.258 albertel 12944: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12945: my $i=0;
1.356 albertel 12946: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12947: $field=~s/^(\"|\')//;
12948: $field=~s/(\"|\')$//;
1.263 www 12949: $components{&takeleft($i)}=$field;
1.31 albertel 12950: $i++;
12951: }
12952: } else {
1.561 www 12953: my $separator=',';
1.480 banghart 12954: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12955: $separator=';';
1.480 banghart 12956: }
1.31 albertel 12957: my $i=0;
1.561 www 12958: # the character we are looking for to indicate the end of a quote or a record
12959: my $looking_for=$separator;
12960: # do not add the characters to the fields
12961: my $ignore=0;
12962: # we just encountered a separator (or the beginning of the record)
12963: my $just_found_separator=1;
12964: # store the field we are working on here
12965: my $field='';
12966: # work our way through all characters in record
12967: foreach my $character ($record=~/(.)/g) {
12968: if ($character eq $looking_for) {
12969: if ($character ne $separator) {
12970: # Found the end of a quote, again looking for separator
12971: $looking_for=$separator;
12972: $ignore=1;
12973: } else {
12974: # Found a separator, store away what we got
12975: $components{&takeleft($i)}=$field;
12976: $i++;
12977: $just_found_separator=1;
12978: $ignore=0;
12979: $field='';
12980: }
12981: next;
12982: }
12983: # single or double quotation marks after a separator indicate beginning of a quote
12984: # we are now looking for the end of the quote and need to ignore separators
12985: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12986: $looking_for=$character;
12987: next;
12988: }
12989: # ignore would be true after we reached the end of a quote
12990: if ($ignore) { next; }
12991: if (($just_found_separator) && ($character=~/\s/)) { next; }
12992: $field.=$character;
12993: $just_found_separator=0;
1.31 albertel 12994: }
1.561 www 12995: # catch the very last entry, since we never encountered the separator
12996: $components{&takeleft($i)}=$field;
1.31 albertel 12997: }
12998: return %components;
12999: }
13000:
1.144 matthew 13001: ######################################################
13002: ######################################################
13003:
1.56 matthew 13004: =pod
13005:
1.648 raeburn 13006: =item * &upfile_select_html()
1.41 ng 13007:
1.144 matthew 13008: Return HTML code to select a file from the users machine and specify
13009: the file type.
1.41 ng 13010:
13011: =cut
13012:
1.144 matthew 13013: ######################################################
13014: ######################################################
1.31 albertel 13015: sub upfile_select_html {
1.144 matthew 13016: my %Types = (
13017: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13018: semisv => &mt('Semicolon separated values'),
1.144 matthew 13019: space => &mt('Space separated'),
13020: tab => &mt('Tabulator separated'),
13021: # xml => &mt('HTML/XML'),
13022: );
13023: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13024: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13025: foreach my $type (sort(keys(%Types))) {
13026: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13027: }
13028: $Str .= "</select>\n";
13029: return $Str;
1.31 albertel 13030: }
13031:
1.301 albertel 13032: sub get_samples {
13033: my ($records,$toget) = @_;
13034: my @samples=({});
13035: my $got=0;
13036: foreach my $rec (@$records) {
13037: my %temp = &record_sep($rec);
13038: if (! grep(/\S/, values(%temp))) { next; }
13039: if (%temp) {
13040: $samples[$got]=\%temp;
13041: $got++;
13042: if ($got == $toget) { last; }
13043: }
13044: }
13045: return \@samples;
13046: }
13047:
1.144 matthew 13048: ######################################################
13049: ######################################################
13050:
1.56 matthew 13051: =pod
13052:
1.648 raeburn 13053: =item * &csv_print_samples($r,$records)
1.41 ng 13054:
13055: Prints a table of sample values from each column uploaded $r is an
13056: Apache Request ref, $records is an arrayref from
13057: &Apache::loncommon::upfile_record_sep
13058:
13059: =cut
13060:
1.144 matthew 13061: ######################################################
13062: ######################################################
1.31 albertel 13063: sub csv_print_samples {
13064: my ($r,$records) = @_;
1.662 bisitz 13065: my $samples = &get_samples($records,5);
1.301 albertel 13066:
1.594 raeburn 13067: $r->print(&mt('Samples').'<br />'.&start_data_table().
13068: &start_data_table_header_row());
1.356 albertel 13069: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13070: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13071: $r->print(&end_data_table_header_row());
1.301 albertel 13072: foreach my $hash (@$samples) {
1.594 raeburn 13073: $r->print(&start_data_table_row());
1.356 albertel 13074: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13075: $r->print('<td>');
1.356 albertel 13076: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13077: $r->print('</td>');
13078: }
1.594 raeburn 13079: $r->print(&end_data_table_row());
1.31 albertel 13080: }
1.594 raeburn 13081: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13082: }
13083:
1.144 matthew 13084: ######################################################
13085: ######################################################
13086:
1.56 matthew 13087: =pod
13088:
1.648 raeburn 13089: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13090:
13091: Prints a table to create associations between values and table columns.
1.144 matthew 13092:
1.41 ng 13093: $r is an Apache Request ref,
13094: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13095: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13096:
13097: =cut
13098:
1.144 matthew 13099: ######################################################
13100: ######################################################
1.31 albertel 13101: sub csv_print_select_table {
13102: my ($r,$records,$d) = @_;
1.301 albertel 13103: my $i=0;
13104: my $samples = &get_samples($records,1);
1.144 matthew 13105: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13106: &start_data_table().&start_data_table_header_row().
1.144 matthew 13107: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13108: '<th>'.&mt('Column').'</th>'.
13109: &end_data_table_header_row()."\n");
1.356 albertel 13110: foreach my $array_ref (@$d) {
13111: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13112: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13113:
1.875 bisitz 13114: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13115: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13116: $r->print('<option value="none"></option>');
1.356 albertel 13117: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13118: $r->print('<option value="'.$sample.'"'.
13119: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13120: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13121: }
1.594 raeburn 13122: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13123: $i++;
13124: }
1.594 raeburn 13125: $r->print(&end_data_table());
1.31 albertel 13126: $i--;
13127: return $i;
13128: }
1.56 matthew 13129:
1.144 matthew 13130: ######################################################
13131: ######################################################
13132:
1.56 matthew 13133: =pod
1.31 albertel 13134:
1.648 raeburn 13135: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13136:
13137: Prints a table of sample values from the upload and can make associate samples to internal names.
13138:
13139: $r is an Apache Request ref,
13140: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13141: $d is an array of 2 element arrays (internal name, displayed name)
13142:
13143: =cut
13144:
1.144 matthew 13145: ######################################################
13146: ######################################################
1.31 albertel 13147: sub csv_samples_select_table {
13148: my ($r,$records,$d) = @_;
13149: my $i=0;
1.144 matthew 13150: #
1.662 bisitz 13151: my $max_samples = 5;
13152: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13153: $r->print(&start_data_table().
13154: &start_data_table_header_row().'<th>'.
13155: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13156: &end_data_table_header_row());
1.301 albertel 13157:
13158: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13159: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13160: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13161: foreach my $option (@$d) {
13162: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13163: $r->print('<option value="'.$value.'"'.
1.253 albertel 13164: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13165: $display.'</option>');
1.31 albertel 13166: }
13167: $r->print('</select></td><td>');
1.662 bisitz 13168: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13169: if (defined($samples->[$line]{$key})) {
13170: $r->print($samples->[$line]{$key}."<br />\n");
13171: }
13172: }
1.594 raeburn 13173: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13174: $i++;
13175: }
1.594 raeburn 13176: $r->print(&end_data_table());
1.31 albertel 13177: $i--;
13178: return($i);
1.115 matthew 13179: }
13180:
1.144 matthew 13181: ######################################################
13182: ######################################################
13183:
1.115 matthew 13184: =pod
13185:
1.648 raeburn 13186: =item * &clean_excel_name($name)
1.115 matthew 13187:
13188: Returns a replacement for $name which does not contain any illegal characters.
13189:
13190: =cut
13191:
1.144 matthew 13192: ######################################################
13193: ######################################################
1.115 matthew 13194: sub clean_excel_name {
13195: my ($name) = @_;
13196: $name =~ s/[:\*\?\/\\]//g;
13197: if (length($name) > 31) {
13198: $name = substr($name,0,31);
13199: }
13200: return $name;
1.25 albertel 13201: }
1.84 albertel 13202:
1.85 albertel 13203: =pod
13204:
1.648 raeburn 13205: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13206:
13207: Returns either 1 or undef
13208:
13209: 1 if the part is to be hidden, undef if it is to be shown
13210:
13211: Arguments are:
13212:
13213: $id the id of the part to be checked
13214: $symb, optional the symb of the resource to check
13215: $udom, optional the domain of the user to check for
13216: $uname, optional the username of the user to check for
13217:
13218: =cut
1.84 albertel 13219:
13220: sub check_if_partid_hidden {
13221: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13222: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13223: $symb,$udom,$uname);
1.141 albertel 13224: my $truth=1;
13225: #if the string starts with !, then the list is the list to show not hide
13226: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13227: my @hiddenlist=split(/,/,$hiddenparts);
13228: foreach my $checkid (@hiddenlist) {
1.141 albertel 13229: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13230: }
1.141 albertel 13231: return !$truth;
1.84 albertel 13232: }
1.127 matthew 13233:
1.138 matthew 13234:
13235: ############################################################
13236: ############################################################
13237:
13238: =pod
13239:
1.157 matthew 13240: =back
13241:
1.138 matthew 13242: =head1 cgi-bin script and graphing routines
13243:
1.157 matthew 13244: =over 4
13245:
1.648 raeburn 13246: =item * &get_cgi_id()
1.138 matthew 13247:
13248: Inputs: none
13249:
13250: Returns an id which can be used to pass environment variables
13251: to various cgi-bin scripts. These environment variables will
13252: be removed from the users environment after a given time by
13253: the routine &Apache::lonnet::transfer_profile_to_env.
13254:
13255: =cut
13256:
13257: ############################################################
13258: ############################################################
1.152 albertel 13259: my $uniq=0;
1.136 matthew 13260: sub get_cgi_id {
1.154 albertel 13261: $uniq=($uniq+1)%100000;
1.280 albertel 13262: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13263: }
13264:
1.127 matthew 13265: ############################################################
13266: ############################################################
13267:
13268: =pod
13269:
1.648 raeburn 13270: =item * &DrawBarGraph()
1.127 matthew 13271:
1.138 matthew 13272: Facilitates the plotting of data in a (stacked) bar graph.
13273: Puts plot definition data into the users environment in order for
13274: graph.png to plot it. Returns an <img> tag for the plot.
13275: The bars on the plot are labeled '1','2',...,'n'.
13276:
13277: Inputs:
13278:
13279: =over 4
13280:
13281: =item $Title: string, the title of the plot
13282:
13283: =item $xlabel: string, text describing the X-axis of the plot
13284:
13285: =item $ylabel: string, text describing the Y-axis of the plot
13286:
13287: =item $Max: scalar, the maximum Y value to use in the plot
13288: If $Max is < any data point, the graph will not be rendered.
13289:
1.140 matthew 13290: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13291: they are plotted. If undefined, default values will be used.
13292:
1.178 matthew 13293: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13294:
1.138 matthew 13295: =item @Values: An array of array references. Each array reference holds data
13296: to be plotted in a stacked bar chart.
13297:
1.239 matthew 13298: =item If the final element of @Values is a hash reference the key/value
13299: pairs will be added to the graph definition.
13300:
1.138 matthew 13301: =back
13302:
13303: Returns:
13304:
13305: An <img> tag which references graph.png and the appropriate identifying
13306: information for the plot.
13307:
1.127 matthew 13308: =cut
13309:
13310: ############################################################
13311: ############################################################
1.134 matthew 13312: sub DrawBarGraph {
1.178 matthew 13313: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13314: #
13315: if (! defined($colors)) {
13316: $colors = ['#33ff00',
13317: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13318: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13319: ];
13320: }
1.228 matthew 13321: my $extra_settings = {};
13322: if (ref($Values[-1]) eq 'HASH') {
13323: $extra_settings = pop(@Values);
13324: }
1.127 matthew 13325: #
1.136 matthew 13326: my $identifier = &get_cgi_id();
13327: my $id = 'cgi.'.$identifier;
1.129 matthew 13328: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13329: return '';
13330: }
1.225 matthew 13331: #
13332: my @Labels;
13333: if (defined($labels)) {
13334: @Labels = @$labels;
13335: } else {
13336: for (my $i=0;$i<@{$Values[0]};$i++) {
13337: push (@Labels,$i+1);
13338: }
13339: }
13340: #
1.129 matthew 13341: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13342: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13343: my %ValuesHash;
13344: my $NumSets=1;
13345: foreach my $array (@Values) {
13346: next if (! ref($array));
1.136 matthew 13347: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13348: join(',',@$array);
1.129 matthew 13349: }
1.127 matthew 13350: #
1.136 matthew 13351: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13352: if ($NumBars < 3) {
13353: $width = 120+$NumBars*32;
1.220 matthew 13354: $xskip = 1;
1.225 matthew 13355: $bar_width = 30;
13356: } elsif ($NumBars < 5) {
13357: $width = 120+$NumBars*20;
13358: $xskip = 1;
13359: $bar_width = 20;
1.220 matthew 13360: } elsif ($NumBars < 10) {
1.136 matthew 13361: $width = 120+$NumBars*15;
13362: $xskip = 1;
13363: $bar_width = 15;
13364: } elsif ($NumBars <= 25) {
13365: $width = 120+$NumBars*11;
13366: $xskip = 5;
13367: $bar_width = 8;
13368: } elsif ($NumBars <= 50) {
13369: $width = 120+$NumBars*8;
13370: $xskip = 5;
13371: $bar_width = 4;
13372: } else {
13373: $width = 120+$NumBars*8;
13374: $xskip = 5;
13375: $bar_width = 4;
13376: }
13377: #
1.137 matthew 13378: $Max = 1 if ($Max < 1);
13379: if ( int($Max) < $Max ) {
13380: $Max++;
13381: $Max = int($Max);
13382: }
1.127 matthew 13383: $Title = '' if (! defined($Title));
13384: $xlabel = '' if (! defined($xlabel));
13385: $ylabel = '' if (! defined($ylabel));
1.369 www 13386: $ValuesHash{$id.'.title'} = &escape($Title);
13387: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13388: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13389: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13390: $ValuesHash{$id.'.NumBars'} = $NumBars;
13391: $ValuesHash{$id.'.NumSets'} = $NumSets;
13392: $ValuesHash{$id.'.PlotType'} = 'bar';
13393: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13394: $ValuesHash{$id.'.height'} = $height;
13395: $ValuesHash{$id.'.width'} = $width;
13396: $ValuesHash{$id.'.xskip'} = $xskip;
13397: $ValuesHash{$id.'.bar_width'} = $bar_width;
13398: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13399: #
1.228 matthew 13400: # Deal with other parameters
13401: while (my ($key,$value) = each(%$extra_settings)) {
13402: $ValuesHash{$id.'.'.$key} = $value;
13403: }
13404: #
1.646 raeburn 13405: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13406: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13407: }
13408:
13409: ############################################################
13410: ############################################################
13411:
13412: =pod
13413:
1.648 raeburn 13414: =item * &DrawXYGraph()
1.137 matthew 13415:
1.138 matthew 13416: Facilitates the plotting of data in an XY graph.
13417: Puts plot definition data into the users environment in order for
13418: graph.png to plot it. Returns an <img> tag for the plot.
13419:
13420: Inputs:
13421:
13422: =over 4
13423:
13424: =item $Title: string, the title of the plot
13425:
13426: =item $xlabel: string, text describing the X-axis of the plot
13427:
13428: =item $ylabel: string, text describing the Y-axis of the plot
13429:
13430: =item $Max: scalar, the maximum Y value to use in the plot
13431: If $Max is < any data point, the graph will not be rendered.
13432:
13433: =item $colors: Array ref containing the hex color codes for the data to be
13434: plotted in. If undefined, default values will be used.
13435:
13436: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13437:
13438: =item $Ydata: Array ref containing Array refs.
1.185 www 13439: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13440:
13441: =item %Values: hash indicating or overriding any default values which are
13442: passed to graph.png.
13443: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13444:
13445: =back
13446:
13447: Returns:
13448:
13449: An <img> tag which references graph.png and the appropriate identifying
13450: information for the plot.
13451:
1.137 matthew 13452: =cut
13453:
13454: ############################################################
13455: ############################################################
13456: sub DrawXYGraph {
13457: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13458: #
13459: # Create the identifier for the graph
13460: my $identifier = &get_cgi_id();
13461: my $id = 'cgi.'.$identifier;
13462: #
13463: $Title = '' if (! defined($Title));
13464: $xlabel = '' if (! defined($xlabel));
13465: $ylabel = '' if (! defined($ylabel));
13466: my %ValuesHash =
13467: (
1.369 www 13468: $id.'.title' => &escape($Title),
13469: $id.'.xlabel' => &escape($xlabel),
13470: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13471: $id.'.y_max_value'=> $Max,
13472: $id.'.labels' => join(',',@$Xlabels),
13473: $id.'.PlotType' => 'XY',
13474: );
13475: #
13476: if (defined($colors) && ref($colors) eq 'ARRAY') {
13477: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13478: }
13479: #
13480: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13481: return '';
13482: }
13483: my $NumSets=1;
1.138 matthew 13484: foreach my $array (@{$Ydata}){
1.137 matthew 13485: next if (! ref($array));
13486: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13487: }
1.138 matthew 13488: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13489: #
13490: # Deal with other parameters
13491: while (my ($key,$value) = each(%Values)) {
13492: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13493: }
13494: #
1.646 raeburn 13495: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13496: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13497: }
13498:
13499: ############################################################
13500: ############################################################
13501:
13502: =pod
13503:
1.648 raeburn 13504: =item * &DrawXYYGraph()
1.138 matthew 13505:
13506: Facilitates the plotting of data in an XY graph with two Y axes.
13507: Puts plot definition data into the users environment in order for
13508: graph.png to plot it. Returns an <img> tag for the plot.
13509:
13510: Inputs:
13511:
13512: =over 4
13513:
13514: =item $Title: string, the title of the plot
13515:
13516: =item $xlabel: string, text describing the X-axis of the plot
13517:
13518: =item $ylabel: string, text describing the Y-axis of the plot
13519:
13520: =item $colors: Array ref containing the hex color codes for the data to be
13521: plotted in. If undefined, default values will be used.
13522:
13523: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13524:
13525: =item $Ydata1: The first data set
13526:
13527: =item $Min1: The minimum value of the left Y-axis
13528:
13529: =item $Max1: The maximum value of the left Y-axis
13530:
13531: =item $Ydata2: The second data set
13532:
13533: =item $Min2: The minimum value of the right Y-axis
13534:
13535: =item $Max2: The maximum value of the left Y-axis
13536:
13537: =item %Values: hash indicating or overriding any default values which are
13538: passed to graph.png.
13539: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13540:
13541: =back
13542:
13543: Returns:
13544:
13545: An <img> tag which references graph.png and the appropriate identifying
13546: information for the plot.
1.136 matthew 13547:
13548: =cut
13549:
13550: ############################################################
13551: ############################################################
1.137 matthew 13552: sub DrawXYYGraph {
13553: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13554: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13555: #
13556: # Create the identifier for the graph
13557: my $identifier = &get_cgi_id();
13558: my $id = 'cgi.'.$identifier;
13559: #
13560: $Title = '' if (! defined($Title));
13561: $xlabel = '' if (! defined($xlabel));
13562: $ylabel = '' if (! defined($ylabel));
13563: my %ValuesHash =
13564: (
1.369 www 13565: $id.'.title' => &escape($Title),
13566: $id.'.xlabel' => &escape($xlabel),
13567: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13568: $id.'.labels' => join(',',@$Xlabels),
13569: $id.'.PlotType' => 'XY',
13570: $id.'.NumSets' => 2,
1.137 matthew 13571: $id.'.two_axes' => 1,
13572: $id.'.y1_max_value' => $Max1,
13573: $id.'.y1_min_value' => $Min1,
13574: $id.'.y2_max_value' => $Max2,
13575: $id.'.y2_min_value' => $Min2,
1.136 matthew 13576: );
13577: #
1.137 matthew 13578: if (defined($colors) && ref($colors) eq 'ARRAY') {
13579: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13580: }
13581: #
13582: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13583: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13584: return '';
13585: }
13586: my $NumSets=1;
1.137 matthew 13587: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13588: next if (! ref($array));
13589: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13590: }
13591: #
13592: # Deal with other parameters
13593: while (my ($key,$value) = each(%Values)) {
13594: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13595: }
13596: #
1.646 raeburn 13597: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13598: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13599: }
13600:
13601: ############################################################
13602: ############################################################
13603:
13604: =pod
13605:
1.157 matthew 13606: =back
13607:
1.139 matthew 13608: =head1 Statistics helper routines?
13609:
13610: Bad place for them but what the hell.
13611:
1.157 matthew 13612: =over 4
13613:
1.648 raeburn 13614: =item * &chartlink()
1.139 matthew 13615:
13616: Returns a link to the chart for a specific student.
13617:
13618: Inputs:
13619:
13620: =over 4
13621:
13622: =item $linktext: The text of the link
13623:
13624: =item $sname: The students username
13625:
13626: =item $sdomain: The students domain
13627:
13628: =back
13629:
1.157 matthew 13630: =back
13631:
1.139 matthew 13632: =cut
13633:
13634: ############################################################
13635: ############################################################
13636: sub chartlink {
13637: my ($linktext, $sname, $sdomain) = @_;
13638: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13639: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13640: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13641: '">'.$linktext.'</a>';
1.153 matthew 13642: }
13643:
13644: #######################################################
13645: #######################################################
13646:
13647: =pod
13648:
13649: =head1 Course Environment Routines
1.157 matthew 13650:
13651: =over 4
1.153 matthew 13652:
1.648 raeburn 13653: =item * &restore_course_settings()
1.153 matthew 13654:
1.648 raeburn 13655: =item * &store_course_settings()
1.153 matthew 13656:
13657: Restores/Store indicated form parameters from the course environment.
13658: Will not overwrite existing values of the form parameters.
13659:
13660: Inputs:
13661: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13662:
13663: a hash ref describing the data to be stored. For example:
13664:
13665: %Save_Parameters = ('Status' => 'scalar',
13666: 'chartoutputmode' => 'scalar',
13667: 'chartoutputdata' => 'scalar',
13668: 'Section' => 'array',
1.373 raeburn 13669: 'Group' => 'array',
1.153 matthew 13670: 'StudentData' => 'array',
13671: 'Maps' => 'array');
13672:
13673: Returns: both routines return nothing
13674:
1.631 raeburn 13675: =back
13676:
1.153 matthew 13677: =cut
13678:
13679: #######################################################
13680: #######################################################
13681: sub store_course_settings {
1.496 albertel 13682: return &store_settings($env{'request.course.id'},@_);
13683: }
13684:
13685: sub store_settings {
1.153 matthew 13686: # save to the environment
13687: # appenv the same items, just to be safe
1.300 albertel 13688: my $udom = $env{'user.domain'};
13689: my $uname = $env{'user.name'};
1.496 albertel 13690: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13691: my %SaveHash;
13692: my %AppHash;
13693: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13694: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13695: my $envname = 'environment.'.$basename;
1.258 albertel 13696: if (exists($env{'form.'.$setting})) {
1.153 matthew 13697: # Save this value away
13698: if ($type eq 'scalar' &&
1.258 albertel 13699: (! exists($env{$envname}) ||
13700: $env{$envname} ne $env{'form.'.$setting})) {
13701: $SaveHash{$basename} = $env{'form.'.$setting};
13702: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13703: } elsif ($type eq 'array') {
13704: my $stored_form;
1.258 albertel 13705: if (ref($env{'form.'.$setting})) {
1.153 matthew 13706: $stored_form = join(',',
13707: map {
1.369 www 13708: &escape($_);
1.258 albertel 13709: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13710: } else {
13711: $stored_form =
1.369 www 13712: &escape($env{'form.'.$setting});
1.153 matthew 13713: }
13714: # Determine if the array contents are the same.
1.258 albertel 13715: if ($stored_form ne $env{$envname}) {
1.153 matthew 13716: $SaveHash{$basename} = $stored_form;
13717: $AppHash{$envname} = $stored_form;
13718: }
13719: }
13720: }
13721: }
13722: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13723: $udom,$uname);
1.153 matthew 13724: if ($put_result !~ /^(ok|delayed)/) {
13725: &Apache::lonnet::logthis('unable to save form parameters, '.
13726: 'got error:'.$put_result);
13727: }
13728: # Make sure these settings stick around in this session, too
1.646 raeburn 13729: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13730: return;
13731: }
13732:
13733: sub restore_course_settings {
1.499 albertel 13734: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13735: }
13736:
13737: sub restore_settings {
13738: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13739: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13740: next if (exists($env{'form.'.$setting}));
1.496 albertel 13741: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13742: '.'.$setting;
1.258 albertel 13743: if (exists($env{$envname})) {
1.153 matthew 13744: if ($type eq 'scalar') {
1.258 albertel 13745: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13746: } elsif ($type eq 'array') {
1.258 albertel 13747: $env{'form.'.$setting} = [
1.153 matthew 13748: map {
1.369 www 13749: &unescape($_);
1.258 albertel 13750: } split(',',$env{$envname})
1.153 matthew 13751: ];
13752: }
13753: }
13754: }
1.127 matthew 13755: }
13756:
1.618 raeburn 13757: #######################################################
13758: #######################################################
13759:
13760: =pod
13761:
13762: =head1 Domain E-mail Routines
13763:
13764: =over 4
13765:
1.648 raeburn 13766: =item * &build_recipient_list()
1.618 raeburn 13767:
1.1144 raeburn 13768: Build recipient lists for following types of e-mail:
1.766 raeburn 13769: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13770: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13771: module change checking, student/employee ID conflict checks, as
13772: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13773: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13774:
13775: Inputs:
1.619 raeburn 13776: defmail (scalar - email address of default recipient),
1.1144 raeburn 13777: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13778: requestsmail, updatesmail, or idconflictsmail).
13779:
1.619 raeburn 13780: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13781:
1.619 raeburn 13782: origmail (scalar - email address of recipient from loncapa.conf,
13783: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13784:
1.655 raeburn 13785: Returns: comma separated list of addresses to which to send e-mail.
13786:
13787: =back
1.618 raeburn 13788:
13789: =cut
13790:
13791: ############################################################
13792: ############################################################
13793: sub build_recipient_list {
1.619 raeburn 13794: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13795: my @recipients;
13796: my $otheremails;
13797: my %domconfig =
13798: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13799: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13800: if (exists($domconfig{'contacts'}{$mailing})) {
13801: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13802: my @contacts = ('adminemail','supportemail');
13803: foreach my $item (@contacts) {
13804: if ($domconfig{'contacts'}{$mailing}{$item}) {
13805: my $addr = $domconfig{'contacts'}{$item};
13806: if (!grep(/^\Q$addr\E$/,@recipients)) {
13807: push(@recipients,$addr);
13808: }
1.619 raeburn 13809: }
1.766 raeburn 13810: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13811: }
13812: }
1.766 raeburn 13813: } elsif ($origmail ne '') {
13814: push(@recipients,$origmail);
1.618 raeburn 13815: }
1.619 raeburn 13816: } elsif ($origmail ne '') {
13817: push(@recipients,$origmail);
1.618 raeburn 13818: }
1.688 raeburn 13819: if (defined($defmail)) {
13820: if ($defmail ne '') {
13821: push(@recipients,$defmail);
13822: }
1.618 raeburn 13823: }
13824: if ($otheremails) {
1.619 raeburn 13825: my @others;
13826: if ($otheremails =~ /,/) {
13827: @others = split(/,/,$otheremails);
1.618 raeburn 13828: } else {
1.619 raeburn 13829: push(@others,$otheremails);
13830: }
13831: foreach my $addr (@others) {
13832: if (!grep(/^\Q$addr\E$/,@recipients)) {
13833: push(@recipients,$addr);
13834: }
1.618 raeburn 13835: }
13836: }
1.619 raeburn 13837: my $recipientlist = join(',',@recipients);
1.618 raeburn 13838: return $recipientlist;
13839: }
13840:
1.127 matthew 13841: ############################################################
13842: ############################################################
1.154 albertel 13843:
1.655 raeburn 13844: =pod
13845:
13846: =head1 Course Catalog Routines
13847:
13848: =over 4
13849:
13850: =item * &gather_categories()
13851:
13852: Converts category definitions - keys of categories hash stored in
13853: coursecategories in configuration.db on the primary library server in a
13854: domain - to an array. Also generates javascript and idx hash used to
13855: generate Domain Coordinator interface for editing Course Categories.
13856:
13857: Inputs:
1.663 raeburn 13858:
1.655 raeburn 13859: categories (reference to hash of category definitions).
1.663 raeburn 13860:
1.655 raeburn 13861: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13862: categories and subcategories).
1.663 raeburn 13863:
1.655 raeburn 13864: idx (reference to hash of counters used in Domain Coordinator interface for
13865: editing Course Categories).
1.663 raeburn 13866:
1.655 raeburn 13867: jsarray (reference to array of categories used to create Javascript arrays for
13868: Domain Coordinator interface for editing Course Categories).
13869:
13870: Returns: nothing
13871:
13872: Side effects: populates cats, idx and jsarray.
13873:
13874: =cut
13875:
13876: sub gather_categories {
13877: my ($categories,$cats,$idx,$jsarray) = @_;
13878: my %counters;
13879: my $num = 0;
13880: foreach my $item (keys(%{$categories})) {
13881: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13882: if ($container eq '' && $depth == 0) {
13883: $cats->[$depth][$categories->{$item}] = $cat;
13884: } else {
13885: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13886: }
13887: my ($escitem,$tail) = split(/:/,$item,2);
13888: if ($counters{$tail} eq '') {
13889: $counters{$tail} = $num;
13890: $num ++;
13891: }
13892: if (ref($idx) eq 'HASH') {
13893: $idx->{$item} = $counters{$tail};
13894: }
13895: if (ref($jsarray) eq 'ARRAY') {
13896: push(@{$jsarray->[$counters{$tail}]},$item);
13897: }
13898: }
13899: return;
13900: }
13901:
13902: =pod
13903:
13904: =item * &extract_categories()
13905:
13906: Used to generate breadcrumb trails for course categories.
13907:
13908: Inputs:
1.663 raeburn 13909:
1.655 raeburn 13910: categories (reference to hash of category definitions).
1.663 raeburn 13911:
1.655 raeburn 13912: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13913: categories and subcategories).
1.663 raeburn 13914:
1.655 raeburn 13915: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13916:
1.655 raeburn 13917: allitems (reference to hash - key is category key
13918: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13919:
1.655 raeburn 13920: idx (reference to hash of counters used in Domain Coordinator interface for
13921: editing Course Categories).
1.663 raeburn 13922:
1.655 raeburn 13923: jsarray (reference to array of categories used to create Javascript arrays for
13924: Domain Coordinator interface for editing Course Categories).
13925:
1.665 raeburn 13926: subcats (reference to hash of arrays containing all subcategories within each
13927: category, -recursive)
13928:
1.655 raeburn 13929: Returns: nothing
13930:
13931: Side effects: populates trails and allitems hash references.
13932:
13933: =cut
13934:
13935: sub extract_categories {
1.665 raeburn 13936: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13937: if (ref($categories) eq 'HASH') {
13938: &gather_categories($categories,$cats,$idx,$jsarray);
13939: if (ref($cats->[0]) eq 'ARRAY') {
13940: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13941: my $name = $cats->[0][$i];
13942: my $item = &escape($name).'::0';
13943: my $trailstr;
13944: if ($name eq 'instcode') {
13945: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13946: } elsif ($name eq 'communities') {
13947: $trailstr = &mt('Communities');
1.655 raeburn 13948: } else {
13949: $trailstr = $name;
13950: }
13951: if ($allitems->{$item} eq '') {
13952: push(@{$trails},$trailstr);
13953: $allitems->{$item} = scalar(@{$trails})-1;
13954: }
13955: my @parents = ($name);
13956: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13957: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13958: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13959: if (ref($subcats) eq 'HASH') {
13960: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13961: }
13962: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13963: }
13964: } else {
13965: if (ref($subcats) eq 'HASH') {
13966: $subcats->{$item} = [];
1.655 raeburn 13967: }
13968: }
13969: }
13970: }
13971: }
13972: return;
13973: }
13974:
13975: =pod
13976:
1.1162 raeburn 13977: =item * &recurse_categories()
1.655 raeburn 13978:
13979: Recursively used to generate breadcrumb trails for course categories.
13980:
13981: Inputs:
1.663 raeburn 13982:
1.655 raeburn 13983: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13984: categories and subcategories).
1.663 raeburn 13985:
1.655 raeburn 13986: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13987:
13988: category (current course category, for which breadcrumb trail is being generated).
13989:
13990: trails (reference to array of breadcrumb trails for each category).
13991:
1.655 raeburn 13992: allitems (reference to hash - key is category key
13993: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13994:
1.655 raeburn 13995: parents (array containing containers directories for current category,
13996: back to top level).
13997:
13998: Returns: nothing
13999:
14000: Side effects: populates trails and allitems hash references
14001:
14002: =cut
14003:
14004: sub recurse_categories {
1.665 raeburn 14005: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14006: my $shallower = $depth - 1;
14007: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14008: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14009: my $name = $cats->[$depth]{$category}[$k];
14010: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14011: my $trailstr = join(' -> ',(@{$parents},$category));
14012: if ($allitems->{$item} eq '') {
14013: push(@{$trails},$trailstr);
14014: $allitems->{$item} = scalar(@{$trails})-1;
14015: }
14016: my $deeper = $depth+1;
14017: push(@{$parents},$category);
1.665 raeburn 14018: if (ref($subcats) eq 'HASH') {
14019: my $subcat = &escape($name).':'.$category.':'.$depth;
14020: for (my $j=@{$parents}; $j>=0; $j--) {
14021: my $higher;
14022: if ($j > 0) {
14023: $higher = &escape($parents->[$j]).':'.
14024: &escape($parents->[$j-1]).':'.$j;
14025: } else {
14026: $higher = &escape($parents->[$j]).'::'.$j;
14027: }
14028: push(@{$subcats->{$higher}},$subcat);
14029: }
14030: }
14031: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14032: $subcats);
1.655 raeburn 14033: pop(@{$parents});
14034: }
14035: } else {
14036: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14037: my $trailstr = join(' -> ',(@{$parents},$category));
14038: if ($allitems->{$item} eq '') {
14039: push(@{$trails},$trailstr);
14040: $allitems->{$item} = scalar(@{$trails})-1;
14041: }
14042: }
14043: return;
14044: }
14045:
1.663 raeburn 14046: =pod
14047:
1.1162 raeburn 14048: =item * &assign_categories_table()
1.663 raeburn 14049:
14050: Create a datatable for display of hierarchical categories in a domain,
14051: with checkboxes to allow a course to be categorized.
14052:
14053: Inputs:
14054:
14055: cathash - reference to hash of categories defined for the domain (from
14056: configuration.db)
14057:
14058: currcat - scalar with an & separated list of categories assigned to a course.
14059:
1.919 raeburn 14060: type - scalar contains course type (Course or Community).
14061:
1.663 raeburn 14062: Returns: $output (markup to be displayed)
14063:
14064: =cut
14065:
14066: sub assign_categories_table {
1.919 raeburn 14067: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14068: my $output;
14069: if (ref($cathash) eq 'HASH') {
14070: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14071: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14072: $maxdepth = scalar(@cats);
14073: if (@cats > 0) {
14074: my $itemcount = 0;
14075: if (ref($cats[0]) eq 'ARRAY') {
14076: my @currcategories;
14077: if ($currcat ne '') {
14078: @currcategories = split('&',$currcat);
14079: }
1.919 raeburn 14080: my $table;
1.663 raeburn 14081: for (my $i=0; $i<@{$cats[0]}; $i++) {
14082: my $parent = $cats[0][$i];
1.919 raeburn 14083: next if ($parent eq 'instcode');
14084: if ($type eq 'Community') {
14085: next unless ($parent eq 'communities');
14086: } else {
14087: next if ($parent eq 'communities');
14088: }
1.663 raeburn 14089: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14090: my $item = &escape($parent).'::0';
14091: my $checked = '';
14092: if (@currcategories > 0) {
14093: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14094: $checked = ' checked="checked"';
1.663 raeburn 14095: }
14096: }
1.919 raeburn 14097: my $parent_title = $parent;
14098: if ($parent eq 'communities') {
14099: $parent_title = &mt('Communities');
14100: }
14101: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14102: '<input type="checkbox" name="usecategory" value="'.
14103: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14104: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14105: my $depth = 1;
14106: push(@path,$parent);
1.919 raeburn 14107: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14108: pop(@path);
1.919 raeburn 14109: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14110: $itemcount ++;
14111: }
1.919 raeburn 14112: if ($itemcount) {
14113: $output = &Apache::loncommon::start_data_table().
14114: $table.
14115: &Apache::loncommon::end_data_table();
14116: }
1.663 raeburn 14117: }
14118: }
14119: }
14120: return $output;
14121: }
14122:
14123: =pod
14124:
1.1162 raeburn 14125: =item * &assign_category_rows()
1.663 raeburn 14126:
14127: Create a datatable row for display of nested categories in a domain,
14128: with checkboxes to allow a course to be categorized,called recursively.
14129:
14130: Inputs:
14131:
14132: itemcount - track row number for alternating colors
14133:
14134: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14135: categories and subcategories.
14136:
14137: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14138:
14139: parent - parent of current category item
14140:
14141: path - Array containing all categories back up through the hierarchy from the
14142: current category to the top level.
14143:
14144: currcategories - reference to array of current categories assigned to the course
14145:
14146: Returns: $output (markup to be displayed).
14147:
14148: =cut
14149:
14150: sub assign_category_rows {
14151: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14152: my ($text,$name,$item,$chgstr);
14153: if (ref($cats) eq 'ARRAY') {
14154: my $maxdepth = scalar(@{$cats});
14155: if (ref($cats->[$depth]) eq 'HASH') {
14156: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14157: my $numchildren = @{$cats->[$depth]{$parent}};
14158: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14159: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14160: for (my $j=0; $j<$numchildren; $j++) {
14161: $name = $cats->[$depth]{$parent}[$j];
14162: $item = &escape($name).':'.&escape($parent).':'.$depth;
14163: my $deeper = $depth+1;
14164: my $checked = '';
14165: if (ref($currcategories) eq 'ARRAY') {
14166: if (@{$currcategories} > 0) {
14167: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14168: $checked = ' checked="checked"';
1.663 raeburn 14169: }
14170: }
14171: }
1.664 raeburn 14172: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14173: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14174: $item.'"'.$checked.' />'.$name.'</label></span>'.
14175: '<input type="hidden" name="catname" value="'.$name.'" />'.
14176: '</td><td>';
1.663 raeburn 14177: if (ref($path) eq 'ARRAY') {
14178: push(@{$path},$name);
14179: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14180: pop(@{$path});
14181: }
14182: $text .= '</td></tr>';
14183: }
14184: $text .= '</table></td>';
14185: }
14186: }
14187: }
14188: return $text;
14189: }
14190:
1.1181 raeburn 14191: =pod
14192:
14193: =back
14194:
14195: =cut
14196:
1.655 raeburn 14197: ############################################################
14198: ############################################################
14199:
14200:
1.443 albertel 14201: sub commit_customrole {
1.664 raeburn 14202: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14203: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14204: ($start?', '.&mt('starting').' '.localtime($start):'').
14205: ($end?', ending '.localtime($end):'').': <b>'.
14206: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14207: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14208: '</b><br />';
14209: return $output;
14210: }
14211:
14212: sub commit_standardrole {
1.1116 raeburn 14213: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14214: my ($output,$logmsg,$linefeed);
14215: if ($context eq 'auto') {
14216: $linefeed = "\n";
14217: } else {
14218: $linefeed = "<br />\n";
14219: }
1.443 albertel 14220: if ($three eq 'st') {
1.541 raeburn 14221: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14222: $one,$two,$sec,$context,$credits);
1.541 raeburn 14223: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14224: ($result eq 'unknown_course') || ($result eq 'refused')) {
14225: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14226: } else {
1.541 raeburn 14227: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14228: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14229: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14230: if ($context eq 'auto') {
14231: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14232: } else {
14233: $output .= '<b>'.$result.'</b>'.$linefeed.
14234: &mt('Add to classlist').': <b>ok</b>';
14235: }
14236: $output .= $linefeed;
1.443 albertel 14237: }
14238: } else {
14239: $output = &mt('Assigning').' '.$three.' in '.$url.
14240: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14241: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14242: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14243: if ($context eq 'auto') {
14244: $output .= $result.$linefeed;
14245: } else {
14246: $output .= '<b>'.$result.'</b>'.$linefeed;
14247: }
1.443 albertel 14248: }
14249: return $output;
14250: }
14251:
14252: sub commit_studentrole {
1.1116 raeburn 14253: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14254: $credits) = @_;
1.626 raeburn 14255: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14256: if ($context eq 'auto') {
14257: $linefeed = "\n";
14258: } else {
14259: $linefeed = '<br />'."\n";
14260: }
1.443 albertel 14261: if (defined($one) && defined($two)) {
14262: my $cid=$one.'_'.$two;
14263: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14264: my $secchange = 0;
14265: my $expire_role_result;
14266: my $modify_section_result;
1.628 raeburn 14267: if ($oldsec ne '-1') {
14268: if ($oldsec ne $sec) {
1.443 albertel 14269: $secchange = 1;
1.628 raeburn 14270: my $now = time;
1.443 albertel 14271: my $uurl='/'.$cid;
14272: $uurl=~s/\_/\//g;
14273: if ($oldsec) {
14274: $uurl.='/'.$oldsec;
14275: }
1.626 raeburn 14276: $oldsecurl = $uurl;
1.628 raeburn 14277: $expire_role_result =
1.652 raeburn 14278: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14279: if ($env{'request.course.sec'} ne '') {
14280: if ($expire_role_result eq 'refused') {
14281: my @roles = ('st');
14282: my @statuses = ('previous');
14283: my @roledoms = ($one);
14284: my $withsec = 1;
14285: my %roleshash =
14286: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14287: \@statuses,\@roles,\@roledoms,$withsec);
14288: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14289: my ($oldstart,$oldend) =
14290: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14291: if ($oldend > 0 && $oldend <= $now) {
14292: $expire_role_result = 'ok';
14293: }
14294: }
14295: }
14296: }
1.443 albertel 14297: $result = $expire_role_result;
14298: }
14299: }
14300: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 14301: $modify_section_result =
14302: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14303: undef,undef,undef,$sec,
14304: $end,$start,'','',$cid,
14305: '',$context,$credits);
1.443 albertel 14306: if ($modify_section_result =~ /^ok/) {
14307: if ($secchange == 1) {
1.628 raeburn 14308: if ($sec eq '') {
14309: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14310: } else {
14311: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14312: }
1.443 albertel 14313: } elsif ($oldsec eq '-1') {
1.628 raeburn 14314: if ($sec eq '') {
14315: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14316: } else {
14317: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14318: }
1.443 albertel 14319: } else {
1.628 raeburn 14320: if ($sec eq '') {
14321: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14322: } else {
14323: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14324: }
1.443 albertel 14325: }
14326: } else {
1.1115 raeburn 14327: if ($secchange) {
1.628 raeburn 14328: $$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;
14329: } else {
14330: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14331: }
1.443 albertel 14332: }
14333: $result = $modify_section_result;
14334: } elsif ($secchange == 1) {
1.628 raeburn 14335: if ($oldsec eq '') {
1.1103 raeburn 14336: $$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 14337: } else {
14338: $$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;
14339: }
1.626 raeburn 14340: if ($expire_role_result eq 'refused') {
14341: my $newsecurl = '/'.$cid;
14342: $newsecurl =~ s/\_/\//g;
14343: if ($sec ne '') {
14344: $newsecurl.='/'.$sec;
14345: }
14346: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14347: if ($sec eq '') {
14348: $$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;
14349: } else {
14350: $$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;
14351: }
14352: }
14353: }
1.443 albertel 14354: }
14355: } else {
1.626 raeburn 14356: $$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 14357: $result = "error: incomplete course id\n";
14358: }
14359: return $result;
14360: }
14361:
1.1108 raeburn 14362: sub show_role_extent {
14363: my ($scope,$context,$role) = @_;
14364: $scope =~ s{^/}{};
14365: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14366: push(@courseroles,'co');
14367: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14368: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14369: $scope =~ s{/}{_};
14370: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14371: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14372: my ($audom,$auname) = split(/\//,$scope);
14373: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14374: &Apache::loncommon::plainname($auname,$audom).'</span>');
14375: } else {
14376: $scope =~ s{/$}{};
14377: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14378: &Apache::lonnet::domain($scope,'description').'</span>');
14379: }
14380: }
14381:
1.443 albertel 14382: ############################################################
14383: ############################################################
14384:
1.566 albertel 14385: sub check_clone {
1.578 raeburn 14386: my ($args,$linefeed) = @_;
1.566 albertel 14387: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14388: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14389: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14390: my $clonemsg;
14391: my $can_clone = 0;
1.944 raeburn 14392: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14393: if ($lctype ne 'community') {
14394: $lctype = 'course';
14395: }
1.566 albertel 14396: if ($clonehome eq 'no_host') {
1.944 raeburn 14397: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14398: $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'});
14399: } else {
14400: $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'});
14401: }
1.566 albertel 14402: } else {
14403: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14404: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14405: if ($clonedesc{'type'} ne 'Community') {
14406: $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'});
14407: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14408: }
14409: }
1.882 raeburn 14410: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14411: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14412: $can_clone = 1;
14413: } else {
14414: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14415: $args->{'clonedomain'},$args->{'clonecourse'});
14416: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14417: if (grep(/^\*$/,@cloners)) {
14418: $can_clone = 1;
14419: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14420: $can_clone = 1;
14421: } else {
1.908 raeburn 14422: my $ccrole = 'cc';
1.944 raeburn 14423: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14424: $ccrole = 'co';
14425: }
1.578 raeburn 14426: my %roleshash =
14427: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14428: $args->{'ccdomain'},
1.908 raeburn 14429: 'userroles',['active'],[$ccrole],
1.578 raeburn 14430: [$args->{'clonedomain'}]);
1.908 raeburn 14431: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14432: $can_clone = 1;
14433: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14434: $can_clone = 1;
14435: } else {
1.944 raeburn 14436: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14437: $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'});
14438: } else {
14439: $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'});
14440: }
1.578 raeburn 14441: }
1.566 albertel 14442: }
1.578 raeburn 14443: }
1.566 albertel 14444: }
14445: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14446: }
14447:
1.444 albertel 14448: sub construct_course {
1.1166 raeburn 14449: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14450: my $outcome;
1.541 raeburn 14451: my $linefeed = '<br />'."\n";
14452: if ($context eq 'auto') {
14453: $linefeed = "\n";
14454: }
1.566 albertel 14455:
14456: #
14457: # Are we cloning?
14458: #
14459: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14460: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14461: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14462: if ($context ne 'auto') {
1.578 raeburn 14463: if ($clonemsg ne '') {
14464: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14465: }
1.566 albertel 14466: }
14467: $outcome .= $clonemsg.$linefeed;
14468:
14469: if (!$can_clone) {
14470: return (0,$outcome);
14471: }
14472: }
14473:
1.444 albertel 14474: #
14475: # Open course
14476: #
14477: my $crstype = lc($args->{'crstype'});
14478: my %cenv=();
14479: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14480: $args->{'cdescr'},
14481: $args->{'curl'},
14482: $args->{'course_home'},
14483: $args->{'nonstandard'},
14484: $args->{'crscode'},
14485: $args->{'ccuname'}.':'.
14486: $args->{'ccdomain'},
1.882 raeburn 14487: $args->{'crstype'},
1.885 raeburn 14488: $cnum,$context,$category);
1.444 albertel 14489:
14490: # Note: The testing routines depend on this being output; see
14491: # Utils::Course. This needs to at least be output as a comment
14492: # if anyone ever decides to not show this, and Utils::Course::new
14493: # will need to be suitably modified.
1.541 raeburn 14494: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14495: if ($$courseid =~ /^error:/) {
14496: return (0,$outcome);
14497: }
14498:
1.444 albertel 14499: #
14500: # Check if created correctly
14501: #
1.479 albertel 14502: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14503: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14504: if ($crsuhome eq 'no_host') {
14505: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14506: return (0,$outcome);
14507: }
1.541 raeburn 14508: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14509:
1.444 albertel 14510: #
1.566 albertel 14511: # Do the cloning
14512: #
14513: if ($can_clone && $cloneid) {
14514: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14515: if ($context ne 'auto') {
14516: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14517: }
14518: $outcome .= $clonemsg.$linefeed;
14519: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14520: # Copy all files
1.637 www 14521: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14522: # Restore URL
1.566 albertel 14523: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14524: # Restore title
1.566 albertel 14525: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14526: # Restore creation date, creator and creation context.
14527: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14528: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14529: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14530: # Mark as cloned
1.566 albertel 14531: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14532: # Need to clone grading mode
14533: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14534: $cenv{'grading'}=$newenv{'grading'};
14535: # Do not clone these environment entries
14536: &Apache::lonnet::del('environment',
14537: ['default_enrollment_start_date',
14538: 'default_enrollment_end_date',
14539: 'question.email',
14540: 'policy.email',
14541: 'comment.email',
14542: 'pch.users.denied',
1.725 raeburn 14543: 'plc.users.denied',
14544: 'hidefromcat',
1.1121 raeburn 14545: 'checkforpriv',
1.1166 raeburn 14546: 'categories',
14547: 'internal.uniquecode'],
1.638 www 14548: $$crsudom,$$crsunum);
1.1170 raeburn 14549: if ($args->{'textbook'}) {
14550: $cenv{'internal.textbook'} = $args->{'textbook'};
14551: }
1.444 albertel 14552: }
1.566 albertel 14553:
1.444 albertel 14554: #
14555: # Set environment (will override cloned, if existing)
14556: #
14557: my @sections = ();
14558: my @xlists = ();
14559: if ($args->{'crstype'}) {
14560: $cenv{'type'}=$args->{'crstype'};
14561: }
14562: if ($args->{'crsid'}) {
14563: $cenv{'courseid'}=$args->{'crsid'};
14564: }
14565: if ($args->{'crscode'}) {
14566: $cenv{'internal.coursecode'}=$args->{'crscode'};
14567: }
14568: if ($args->{'crsquota'} ne '') {
14569: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14570: } else {
14571: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14572: }
14573: if ($args->{'ccuname'}) {
14574: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14575: ':'.$args->{'ccdomain'};
14576: } else {
14577: $cenv{'internal.courseowner'} = $args->{'curruser'};
14578: }
1.1116 raeburn 14579: if ($args->{'defaultcredits'}) {
14580: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14581: }
1.444 albertel 14582: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14583: if ($args->{'crssections'}) {
14584: $cenv{'internal.sectionnums'} = '';
14585: if ($args->{'crssections'} =~ m/,/) {
14586: @sections = split/,/,$args->{'crssections'};
14587: } else {
14588: $sections[0] = $args->{'crssections'};
14589: }
14590: if (@sections > 0) {
14591: foreach my $item (@sections) {
14592: my ($sec,$gp) = split/:/,$item;
14593: my $class = $args->{'crscode'}.$sec;
14594: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14595: $cenv{'internal.sectionnums'} .= $item.',';
14596: unless ($addcheck eq 'ok') {
14597: push @badclasses, $class;
14598: }
14599: }
14600: $cenv{'internal.sectionnums'} =~ s/,$//;
14601: }
14602: }
14603: # do not hide course coordinator from staff listing,
14604: # even if privileged
14605: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14606: # add course coordinator's domain to domains to check for privileged users
14607: # if different to course domain
14608: if ($$crsudom ne $args->{'ccdomain'}) {
14609: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14610: }
1.444 albertel 14611: # add crosslistings
14612: if ($args->{'crsxlist'}) {
14613: $cenv{'internal.crosslistings'}='';
14614: if ($args->{'crsxlist'} =~ m/,/) {
14615: @xlists = split/,/,$args->{'crsxlist'};
14616: } else {
14617: $xlists[0] = $args->{'crsxlist'};
14618: }
14619: if (@xlists > 0) {
14620: foreach my $item (@xlists) {
14621: my ($xl,$gp) = split/:/,$item;
14622: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14623: $cenv{'internal.crosslistings'} .= $item.',';
14624: unless ($addcheck eq 'ok') {
14625: push @badclasses, $xl;
14626: }
14627: }
14628: $cenv{'internal.crosslistings'} =~ s/,$//;
14629: }
14630: }
14631: if ($args->{'autoadds'}) {
14632: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14633: }
14634: if ($args->{'autodrops'}) {
14635: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14636: }
14637: # check for notification of enrollment changes
14638: my @notified = ();
14639: if ($args->{'notify_owner'}) {
14640: if ($args->{'ccuname'} ne '') {
14641: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14642: }
14643: }
14644: if ($args->{'notify_dc'}) {
14645: if ($uname ne '') {
1.630 raeburn 14646: push(@notified,$uname.':'.$udom);
1.444 albertel 14647: }
14648: }
14649: if (@notified > 0) {
14650: my $notifylist;
14651: if (@notified > 1) {
14652: $notifylist = join(',',@notified);
14653: } else {
14654: $notifylist = $notified[0];
14655: }
14656: $cenv{'internal.notifylist'} = $notifylist;
14657: }
14658: if (@badclasses > 0) {
14659: my %lt=&Apache::lonlocal::texthash(
14660: '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',
14661: 'dnhr' => 'does not have rights to access enrollment in these classes',
14662: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14663: );
1.541 raeburn 14664: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14665: ' ('.$lt{'adby'}.')';
14666: if ($context eq 'auto') {
14667: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14668: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14669: foreach my $item (@badclasses) {
14670: if ($context eq 'auto') {
14671: $outcome .= " - $item\n";
14672: } else {
14673: $outcome .= "<li>$item</li>\n";
14674: }
14675: }
14676: if ($context eq 'auto') {
14677: $outcome .= $linefeed;
14678: } else {
1.566 albertel 14679: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14680: }
14681: }
1.444 albertel 14682: }
14683: if ($args->{'no_end_date'}) {
14684: $args->{'endaccess'} = 0;
14685: }
14686: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14687: $cenv{'internal.autoend'}=$args->{'enrollend'};
14688: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14689: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14690: if ($args->{'showphotos'}) {
14691: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14692: }
14693: $cenv{'internal.authtype'} = $args->{'authtype'};
14694: $cenv{'internal.autharg'} = $args->{'autharg'};
14695: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14696: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14697: 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');
14698: if ($context eq 'auto') {
14699: $outcome .= $krb_msg;
14700: } else {
1.566 albertel 14701: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14702: }
14703: $outcome .= $linefeed;
1.444 albertel 14704: }
14705: }
14706: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14707: if ($args->{'setpolicy'}) {
14708: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14709: }
14710: if ($args->{'setcontent'}) {
14711: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14712: }
14713: }
14714: if ($args->{'reshome'}) {
14715: $cenv{'reshome'}=$args->{'reshome'}.'/';
14716: $cenv{'reshome'}=~s/\/+$/\//;
14717: }
14718: #
14719: # course has keyed access
14720: #
14721: if ($args->{'setkeys'}) {
14722: $cenv{'keyaccess'}='yes';
14723: }
14724: # if specified, key authority is not course, but user
14725: # only active if keyaccess is yes
14726: if ($args->{'keyauth'}) {
1.487 albertel 14727: my ($user,$domain) = split(':',$args->{'keyauth'});
14728: $user = &LONCAPA::clean_username($user);
14729: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14730: if ($user ne '' && $domain ne '') {
1.487 albertel 14731: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14732: }
14733: }
14734:
1.1166 raeburn 14735: #
1.1167 raeburn 14736: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14737: #
14738: if ($args->{'uniquecode'}) {
14739: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14740: if ($code) {
14741: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14742: my %crsinfo =
14743: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14744: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14745: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14746: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14747: }
1.1166 raeburn 14748: if (ref($coderef)) {
14749: $$coderef = $code;
14750: }
14751: }
14752: }
14753:
1.444 albertel 14754: if ($args->{'disresdis'}) {
14755: $cenv{'pch.roles.denied'}='st';
14756: }
14757: if ($args->{'disablechat'}) {
14758: $cenv{'plc.roles.denied'}='st';
14759: }
14760:
14761: # Record we've not yet viewed the Course Initialization Helper for this
14762: # course
14763: $cenv{'course.helper.not.run'} = 1;
14764: #
14765: # Use new Randomseed
14766: #
14767: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14768: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14769: #
14770: # The encryption code and receipt prefix for this course
14771: #
14772: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14773: $cenv{'internal.encpref'}=100+int(9*rand(99));
14774: #
14775: # By default, use standard grading
14776: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14777:
1.541 raeburn 14778: $outcome .= $linefeed.&mt('Setting environment').': '.
14779: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14780: #
14781: # Open all assignments
14782: #
14783: if ($args->{'openall'}) {
14784: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14785: my %storecontent = ($storeunder => time,
14786: $storeunder.'.type' => 'date_start');
14787:
14788: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14789: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14790: }
14791: #
14792: # Set first page
14793: #
14794: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14795: || ($cloneid)) {
1.445 albertel 14796: use LONCAPA::map;
1.444 albertel 14797: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14798:
14799: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14800: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14801:
1.444 albertel 14802: $outcome .= ($fatal?$errtext:'read ok').' - ';
14803: my $title; my $url;
14804: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14805: $title=&mt('Syllabus');
1.444 albertel 14806: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14807: } else {
1.963 raeburn 14808: $title=&mt('Table of Contents');
1.444 albertel 14809: $url='/adm/navmaps';
14810: }
1.445 albertel 14811:
14812: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14813: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14814:
14815: if ($errtext) { $fatal=2; }
1.541 raeburn 14816: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14817: }
1.566 albertel 14818:
14819: return (1,$outcome);
1.444 albertel 14820: }
14821:
1.1166 raeburn 14822: sub make_unique_code {
14823: my ($cdom,$cnum) = @_;
14824: # get lock on uniquecodes db
14825: my $lockhash = {
14826: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14827: ':'.$env{'user.domain'},
14828: };
14829: my $tries = 0;
14830: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14831: my ($code,$error);
14832:
14833: while (($gotlock ne 'ok') && ($tries<3)) {
14834: $tries ++;
14835: sleep 1;
14836: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14837: }
14838: if ($gotlock eq 'ok') {
14839: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14840: my $gotcode;
14841: my $attempts = 0;
14842: while ((!$gotcode) && ($attempts < 100)) {
14843: $code = &generate_code();
14844: if (!exists($currcodes{$code})) {
14845: $gotcode = 1;
14846: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14847: $error = 'nostore';
14848: }
14849: }
14850: $attempts ++;
14851: }
14852: my @del_lock = ($cnum."\0".'uniquecodes');
14853: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14854: } else {
14855: $error = 'nolock';
14856: }
14857: return ($code,$error);
14858: }
14859:
14860: sub generate_code {
14861: my $code;
14862: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14863: for (my $i=0; $i<6; $i++) {
14864: my $lettnum = int (rand 2);
14865: my $item = '';
14866: if ($lettnum) {
14867: $item = $letts[int( rand(18) )];
14868: } else {
14869: $item = 1+int( rand(8) );
14870: }
14871: $code .= $item;
14872: }
14873: return $code;
14874: }
14875:
1.444 albertel 14876: ############################################################
14877: ############################################################
14878:
1.953 droeschl 14879: #SD
14880: # only Community and Course, or anything else?
1.378 raeburn 14881: sub course_type {
14882: my ($cid) = @_;
14883: if (!defined($cid)) {
14884: $cid = $env{'request.course.id'};
14885: }
1.404 albertel 14886: if (defined($env{'course.'.$cid.'.type'})) {
14887: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14888: } else {
14889: return 'Course';
1.377 raeburn 14890: }
14891: }
1.156 albertel 14892:
1.406 raeburn 14893: sub group_term {
14894: my $crstype = &course_type();
14895: my %names = (
14896: 'Course' => 'group',
1.865 raeburn 14897: 'Community' => 'group',
1.406 raeburn 14898: );
14899: return $names{$crstype};
14900: }
14901:
1.902 raeburn 14902: sub course_types {
1.1165 raeburn 14903: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14904: my %typename = (
14905: official => 'Official course',
14906: unofficial => 'Unofficial course',
14907: community => 'Community',
1.1165 raeburn 14908: textbook => 'Textbook course',
1.902 raeburn 14909: );
14910: return (\@types,\%typename);
14911: }
14912:
1.156 albertel 14913: sub icon {
14914: my ($file)=@_;
1.505 albertel 14915: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14916: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14917: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14918: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14919: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14920: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14921: $curfext.".gif") {
14922: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14923: $curfext.".gif";
14924: }
14925: }
1.249 albertel 14926: return &lonhttpdurl($iconname);
1.154 albertel 14927: }
1.84 albertel 14928:
1.575 albertel 14929: sub lonhttpdurl {
1.692 www 14930: #
14931: # Had been used for "small fry" static images on separate port 8080.
14932: # Modify here if lightweight http functionality desired again.
14933: # Currently eliminated due to increasing firewall issues.
14934: #
1.575 albertel 14935: my ($url)=@_;
1.692 www 14936: return $url;
1.215 albertel 14937: }
14938:
1.213 albertel 14939: sub connection_aborted {
14940: my ($r)=@_;
14941: $r->print(" ");$r->rflush();
14942: my $c = $r->connection;
14943: return $c->aborted();
14944: }
14945:
1.221 foxr 14946: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14947: # strings as 'strings'.
14948: sub escape_single {
1.221 foxr 14949: my ($input) = @_;
1.223 albertel 14950: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14951: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14952: return $input;
14953: }
1.223 albertel 14954:
1.222 foxr 14955: # Same as escape_single, but escape's "'s This
14956: # can be used for "strings"
14957: sub escape_double {
14958: my ($input) = @_;
14959: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14960: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14961: return $input;
14962: }
1.223 albertel 14963:
1.222 foxr 14964: # Escapes the last element of a full URL.
14965: sub escape_url {
14966: my ($url) = @_;
1.238 raeburn 14967: my @urlslices = split(/\//, $url,-1);
1.369 www 14968: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 14969: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14970: }
1.462 albertel 14971:
1.820 raeburn 14972: sub compare_arrays {
14973: my ($arrayref1,$arrayref2) = @_;
14974: my (@difference,%count);
14975: @difference = ();
14976: %count = ();
14977: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14978: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14979: foreach my $element (keys(%count)) {
14980: if ($count{$element} == 1) {
14981: push(@difference,$element);
14982: }
14983: }
14984: }
14985: return @difference;
14986: }
14987:
1.817 bisitz 14988: # -------------------------------------------------------- Initialize user login
1.462 albertel 14989: sub init_user_environment {
1.463 albertel 14990: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14991: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14992:
14993: my $public=($username eq 'public' && $domain eq 'public');
14994:
14995: # See if old ID present, if so, remove
14996:
1.1062 raeburn 14997: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14998: my $now=time;
14999:
15000: if ($public) {
15001: my $max_public=100;
15002: my $oldest;
15003: my $oldest_time=0;
15004: for(my $next=1;$next<=$max_public;$next++) {
15005: if (-e $lonids."/publicuser_$next.id") {
15006: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15007: if ($mtime<$oldest_time || !$oldest_time) {
15008: $oldest_time=$mtime;
15009: $oldest=$next;
15010: }
15011: } else {
15012: $cookie="publicuser_$next";
15013: last;
15014: }
15015: }
15016: if (!$cookie) { $cookie="publicuser_$oldest"; }
15017: } else {
1.463 albertel 15018: # if this isn't a robot, kill any existing non-robot sessions
15019: if (!$args->{'robot'}) {
15020: opendir(DIR,$lonids);
15021: while ($filename=readdir(DIR)) {
15022: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15023: unlink($lonids.'/'.$filename);
15024: }
1.462 albertel 15025: }
1.463 albertel 15026: closedir(DIR);
1.1204 raeburn 15027: # If there is a undeleted lockfile for the user's paste buffer remove it.
15028: my $namespace = 'nohist_courseeditor';
15029: my $lockingkey = 'paste'."\0".'locked_num';
15030: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15031: $domain,$username);
15032: if (exists($lockhash{$lockingkey})) {
15033: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15034: unless ($delresult eq 'ok') {
15035: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15036: }
15037: }
1.462 albertel 15038: }
15039: # Give them a new cookie
1.463 albertel 15040: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15041: : $now.$$.int(rand(10000)));
1.463 albertel 15042: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15043:
15044: # Initialize roles
15045:
1.1062 raeburn 15046: ($userroles,$firstaccenv,$timerintenv) =
15047: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15048: }
15049: # ------------------------------------ Check browser type and MathML capability
15050:
1.1194 raeburn 15051: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15052: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15053:
15054: # ------------------------------------------------------------- Get environment
15055:
15056: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15057: my ($tmp) = keys(%userenv);
15058: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15059: } else {
15060: undef(%userenv);
15061: }
15062: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15063: $form->{'interface'}=$userenv{'interface'};
15064: }
15065: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15066:
15067: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15068: foreach my $option ('interface','localpath','localres') {
15069: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15070: }
15071: # --------------------------------------------------------- Write first profile
15072:
15073: {
15074: my %initial_env =
15075: ("user.name" => $username,
15076: "user.domain" => $domain,
15077: "user.home" => $authhost,
15078: "browser.type" => $clientbrowser,
15079: "browser.version" => $clientversion,
15080: "browser.mathml" => $clientmathml,
15081: "browser.unicode" => $clientunicode,
15082: "browser.os" => $clientos,
1.1137 raeburn 15083: "browser.mobile" => $clientmobile,
1.1141 raeburn 15084: "browser.info" => $clientinfo,
1.1194 raeburn 15085: "browser.osversion" => $clientosversion,
1.462 albertel 15086: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15087: "request.course.fn" => '',
15088: "request.course.uri" => '',
15089: "request.course.sec" => '',
15090: "request.role" => 'cm',
15091: "request.role.adv" => $env{'user.adv'},
15092: "request.host" => $ENV{'REMOTE_ADDR'},);
15093:
15094: if ($form->{'localpath'}) {
15095: $initial_env{"browser.localpath"} = $form->{'localpath'};
15096: $initial_env{"browser.localres"} = $form->{'localres'};
15097: }
15098:
15099: if ($form->{'interface'}) {
15100: $form->{'interface'}=~s/\W//gs;
15101: $initial_env{"browser.interface"} = $form->{'interface'};
15102: $env{'browser.interface'}=$form->{'interface'};
15103: }
15104:
1.1157 raeburn 15105: if ($form->{'iptoken'}) {
15106: my $lonhost = $r->dir_config('lonHostID');
15107: $initial_env{"user.noloadbalance"} = $lonhost;
15108: $env{'user.noloadbalance'} = $lonhost;
15109: }
15110:
1.981 raeburn 15111: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15112: my %domdef;
15113: unless ($domain eq 'public') {
15114: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15115: }
1.980 raeburn 15116:
1.1081 raeburn 15117: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15118: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15119: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15120: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15121: }
15122:
1.1165 raeburn 15123: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 15124: $userenv{'canrequest.'.$crstype} =
15125: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15126: 'reload','requestcourses',
15127: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15128: }
15129:
1.1092 raeburn 15130: $userenv{'canrequest.author'} =
15131: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15132: 'reload','requestauthor',
15133: \%userenv,\%domdef,\%is_adv);
15134: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15135: $domain,$username);
15136: my $reqstatus = $reqauthor{'author_status'};
15137: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15138: if (ref($reqauthor{'author'}) eq 'HASH') {
15139: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15140: $reqauthor{'author'}{'timestamp'};
15141: }
15142: }
15143:
1.462 albertel 15144: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15145:
1.462 albertel 15146: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15147: &GDBM_WRCREAT(),0640)) {
15148: &_add_to_env(\%disk_env,\%initial_env);
15149: &_add_to_env(\%disk_env,\%userenv,'environment.');
15150: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15151: if (ref($firstaccenv) eq 'HASH') {
15152: &_add_to_env(\%disk_env,$firstaccenv);
15153: }
15154: if (ref($timerintenv) eq 'HASH') {
15155: &_add_to_env(\%disk_env,$timerintenv);
15156: }
1.463 albertel 15157: if (ref($args->{'extra_env'})) {
15158: &_add_to_env(\%disk_env,$args->{'extra_env'});
15159: }
1.462 albertel 15160: untie(%disk_env);
15161: } else {
1.705 tempelho 15162: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15163: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15164: return 'error: '.$!;
15165: }
15166: }
15167: $env{'request.role'}='cm';
15168: $env{'request.role.adv'}=$env{'user.adv'};
15169: $env{'browser.type'}=$clientbrowser;
15170:
15171: return $cookie;
15172:
15173: }
15174:
15175: sub _add_to_env {
15176: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15177: if (ref($env_data) eq 'HASH') {
15178: while (my ($key,$value) = each(%$env_data)) {
15179: $idf->{$prefix.$key} = $value;
15180: $env{$prefix.$key} = $value;
15181: }
1.462 albertel 15182: }
15183: }
15184:
1.685 tempelho 15185: # --- Get the symbolic name of a problem and the url
15186: sub get_symb {
15187: my ($request,$silent) = @_;
1.726 raeburn 15188: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15189: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15190: if ($symb eq '') {
15191: if (!$silent) {
1.1071 raeburn 15192: if (ref($request)) {
15193: $request->print("Unable to handle ambiguous references:$url:.");
15194: }
1.685 tempelho 15195: return ();
15196: }
15197: }
15198: &Apache::lonenc::check_decrypt(\$symb);
15199: return ($symb);
15200: }
15201:
15202: # --------------------------------------------------------------Get annotation
15203:
15204: sub get_annotation {
15205: my ($symb,$enc) = @_;
15206:
15207: my $key = $symb;
15208: if (!$enc) {
15209: $key =
15210: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15211: }
15212: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15213: return $annotation{$key};
15214: }
15215:
15216: sub clean_symb {
1.731 raeburn 15217: my ($symb,$delete_enc) = @_;
1.685 tempelho 15218:
15219: &Apache::lonenc::check_decrypt(\$symb);
15220: my $enc = $env{'request.enc'};
1.731 raeburn 15221: if ($delete_enc) {
1.730 raeburn 15222: delete($env{'request.enc'});
15223: }
1.685 tempelho 15224:
15225: return ($symb,$enc);
15226: }
1.462 albertel 15227:
1.1181 raeburn 15228: ############################################################
15229: ############################################################
15230:
15231: =pod
15232:
15233: =head1 Routines for building display used to search for courses
15234:
15235:
15236: =over 4
15237:
15238: =item * &build_filters()
15239:
15240: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 15241: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15242: and quotacheck.pl
15243:
1.1181 raeburn 15244:
15245: Inputs:
15246:
15247: filterlist - anonymous array of fields to include as potential filters
15248:
15249: crstype - course type
15250:
15251: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15252: to pop-open a course selector (will contain "extra element").
15253:
15254: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15255:
15256: filter - anonymous hash of criteria and their values
15257:
15258: action - form action
15259:
15260: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15261:
1.1182 raeburn 15262: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 15263:
15264: cloneruname - username of owner of new course who wants to clone
15265:
15266: clonerudom - domain of owner of new course who wants to clone
15267:
15268: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15269:
15270: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15271:
15272: codedom - domain
15273:
15274: formname - value of form element named "form".
15275:
15276: fixeddom - domain, if fixed.
15277:
15278: prevphase - value to assign to form element named "phase" when going back to the previous screen
15279:
15280: cnameelement - name of form element in form on opener page which will receive title of selected course
15281:
15282: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15283:
15284: cdomelement - name of form element in form on opener page which will receive domain of selected course
15285:
15286: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15287:
15288: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15289:
15290: clonewarning - warning message about missing information for intended course owner when DC creates a course
15291:
1.1182 raeburn 15292:
1.1181 raeburn 15293: Returns: $output - HTML for display of search criteria, and hidden form elements.
15294:
1.1182 raeburn 15295:
1.1181 raeburn 15296: Side Effects: None
15297:
15298: =cut
15299:
15300: # ---------------------------------------------- search for courses based on last activity etc.
15301:
15302: sub build_filters {
15303: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15304: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15305: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15306: $cnameelement,$cnumelement,$cdomelement,$setroles,
15307: $clonetext,$clonewarning) = @_;
1.1182 raeburn 15308: my ($list,$jscript);
1.1181 raeburn 15309: my $onchange = 'javascript:updateFilters(this)';
15310: my ($domainselectform,$sincefilterform,$createdfilterform,
15311: $ownerdomselectform,$persondomselectform,$instcodeform,
15312: $typeselectform,$instcodetitle);
15313: if ($formname eq '') {
15314: $formname = $caller;
15315: }
15316: foreach my $item (@{$filterlist}) {
15317: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15318: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15319: if ($item eq 'domainfilter') {
15320: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15321: } elsif ($item eq 'coursefilter') {
15322: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15323: } elsif ($item eq 'ownerfilter') {
15324: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15325: } elsif ($item eq 'ownerdomfilter') {
15326: $filter->{'ownerdomfilter'} =
15327: &LONCAPA::clean_domain($filter->{$item});
15328: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15329: 'ownerdomfilter',1);
15330: } elsif ($item eq 'personfilter') {
15331: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15332: } elsif ($item eq 'persondomfilter') {
15333: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15334: 'persondomfilter',1);
15335: } else {
15336: $filter->{$item} =~ s/\W//g;
15337: }
15338: if (!$filter->{$item}) {
15339: $filter->{$item} = '';
15340: }
15341: }
15342: if ($item eq 'domainfilter') {
15343: my $allow_blank = 1;
15344: if ($formname eq 'portform') {
15345: $allow_blank=0;
15346: } elsif ($formname eq 'studentform') {
15347: $allow_blank=0;
15348: }
15349: if ($fixeddom) {
15350: $domainselectform = '<input type="hidden" name="domainfilter"'.
15351: ' value="'.$codedom.'" />'.
15352: &Apache::lonnet::domain($codedom,'description');
15353: } else {
15354: $domainselectform = &select_dom_form($filter->{$item},
15355: 'domainfilter',
15356: $allow_blank,'',$onchange);
15357: }
15358: } else {
15359: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15360: }
15361: }
15362:
15363: # last course activity filter and selection
15364: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15365:
15366: # course created filter and selection
15367: if (exists($filter->{'createdfilter'})) {
15368: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15369: }
15370:
15371: my %lt = &Apache::lonlocal::texthash(
15372: 'cac' => "$crstype Activity",
15373: 'ccr' => "$crstype Created",
15374: 'cde' => "$crstype Title",
15375: 'cdo' => "$crstype Domain",
15376: 'ins' => 'Institutional Code',
15377: 'inc' => 'Institutional Categorization',
15378: 'cow' => "$crstype Owner/Co-owner",
15379: 'cop' => "$crstype Personnel Includes",
15380: 'cog' => 'Type',
15381: );
15382:
15383: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15384: my $typeval = 'Course';
15385: if ($crstype eq 'Community') {
15386: $typeval = 'Community';
15387: }
15388: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15389: } else {
15390: $typeselectform = '<select name="type" size="1"';
15391: if ($onchange) {
15392: $typeselectform .= ' onchange="'.$onchange.'"';
15393: }
15394: $typeselectform .= '>'."\n";
15395: foreach my $posstype ('Course','Community') {
15396: $typeselectform.='<option value="'.$posstype.'"'.
15397: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15398: }
15399: $typeselectform.="</select>";
15400: }
15401:
15402: my ($cloneableonlyform,$cloneabletitle);
15403: if (exists($filter->{'cloneableonly'})) {
15404: my $cloneableon = '';
15405: my $cloneableoff = ' checked="checked"';
15406: if ($filter->{'cloneableonly'}) {
15407: $cloneableon = $cloneableoff;
15408: $cloneableoff = '';
15409: }
15410: $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/> '.&mt('Required').'</label>'.(' 'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' /> '.&mt('No restriction').'</label></span>';
15411: if ($formname eq 'ccrs') {
1.1187 bisitz 15412: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 15413: } else {
15414: $cloneabletitle = &mt('Cloneable by you');
15415: }
15416: }
15417: my $officialjs;
15418: if ($crstype eq 'Course') {
15419: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 15420: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15421: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15422: if ($codedom) {
1.1181 raeburn 15423: $officialjs = 1;
15424: ($instcodeform,$jscript,$$numtitlesref) =
15425: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15426: $officialjs,$codetitlesref);
15427: if ($jscript) {
1.1182 raeburn 15428: $jscript = '<script type="text/javascript">'."\n".
15429: '// <![CDATA['."\n".
15430: $jscript."\n".
15431: '// ]]>'."\n".
15432: '</script>'."\n";
1.1181 raeburn 15433: }
15434: }
15435: if ($instcodeform eq '') {
15436: $instcodeform =
15437: '<input type="text" name="instcodefilter" size="10" value="'.
15438: $list->{'instcodefilter'}.'" />';
15439: $instcodetitle = $lt{'ins'};
15440: } else {
15441: $instcodetitle = $lt{'inc'};
15442: }
15443: if ($fixeddom) {
15444: $instcodetitle .= '<br />('.$codedom.')';
15445: }
15446: }
15447: }
15448: my $output = qq|
15449: <form method="post" name="filterpicker" action="$action">
15450: <input type="hidden" name="form" value="$formname" />
15451: |;
15452: if ($formname eq 'modifycourse') {
15453: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15454: '<input type="hidden" name="prevphase" value="'.
15455: $prevphase.'" />'."\n";
1.1198 musolffc 15456: } elsif ($formname eq 'quotacheck') {
15457: $output .= qq|
15458: <input type="hidden" name="sortby" value="" />
15459: <input type="hidden" name="sortorder" value="" />
15460: |;
15461: } else {
1.1181 raeburn 15462: my $name_input;
15463: if ($cnameelement ne '') {
15464: $name_input = '<input type="hidden" name="cnameelement" value="'.
15465: $cnameelement.'" />';
15466: }
15467: $output .= qq|
1.1182 raeburn 15468: <input type="hidden" name="cnumelement" value="$cnumelement" />
15469: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15470: $name_input
15471: $roleelement
15472: $multelement
15473: $typeelement
15474: |;
15475: if ($formname eq 'portform') {
15476: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15477: }
15478: }
15479: if ($fixeddom) {
15480: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15481: }
15482: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15483: if ($sincefilterform) {
15484: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15485: .$sincefilterform
15486: .&Apache::lonhtmlcommon::row_closure();
15487: }
15488: if ($createdfilterform) {
15489: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15490: .$createdfilterform
15491: .&Apache::lonhtmlcommon::row_closure();
15492: }
15493: if ($domainselectform) {
15494: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15495: .$domainselectform
15496: .&Apache::lonhtmlcommon::row_closure();
15497: }
15498: if ($typeselectform) {
15499: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15500: $output .= $typeselectform;
15501: } else {
15502: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15503: .$typeselectform
15504: .&Apache::lonhtmlcommon::row_closure();
15505: }
15506: }
15507: if ($instcodeform) {
15508: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15509: .$instcodeform
15510: .&Apache::lonhtmlcommon::row_closure();
15511: }
15512: if (exists($filter->{'ownerfilter'})) {
15513: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15514: '<table><tr><td>'.&mt('Username').'<br />'.
15515: '<input type="text" name="ownerfilter" size="20" value="'.
15516: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15517: $ownerdomselectform.'</td></tr></table>'.
15518: &Apache::lonhtmlcommon::row_closure();
15519: }
15520: if (exists($filter->{'personfilter'})) {
15521: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15522: '<table><tr><td>'.&mt('Username').'<br />'.
15523: '<input type="text" name="personfilter" size="20" value="'.
15524: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15525: $persondomselectform.'</td></tr></table>'.
15526: &Apache::lonhtmlcommon::row_closure();
15527: }
15528: if (exists($filter->{'coursefilter'})) {
15529: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15530: .'<input type="text" name="coursefilter" size="25" value="'
15531: .$list->{'coursefilter'}.'" />'
15532: .&Apache::lonhtmlcommon::row_closure();
15533: }
15534: if ($cloneableonlyform) {
15535: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15536: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15537: }
15538: if (exists($filter->{'descriptfilter'})) {
15539: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15540: .'<input type="text" name="descriptfilter" size="40" value="'
15541: .$list->{'descriptfilter'}.'" />'
15542: .&Apache::lonhtmlcommon::row_closure(1);
15543: }
15544: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15545: '<input type="hidden" name="updater" value="" />'."\n".
15546: '<input type="submit" name="gosearch" value="'.
15547: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15548: return $jscript.$clonewarning.$output;
15549: }
15550:
15551: =pod
15552:
15553: =item * &timebased_select_form()
15554:
1.1182 raeburn 15555: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15556: filter e.g., Course Activity, Course Created, when searching for courses
15557: or communities
15558:
15559: Inputs:
15560:
15561: item - name of form element (sincefilter or createdfilter)
15562:
15563: filter - anonymous hash of criteria and their values
15564:
15565: Returns: HTML for a select box contained a blank, then six time selections,
15566: with value set in incoming form variables currently selected.
15567:
15568: Side Effects: None
15569:
15570: =cut
15571:
15572: sub timebased_select_form {
15573: my ($item,$filter) = @_;
15574: if (ref($filter) eq 'HASH') {
15575: $filter->{$item} =~ s/[^\d-]//g;
15576: if (!$filter->{$item}) { $filter->{$item}=-1; }
15577: return &select_form(
15578: $filter->{$item},
15579: $item,
15580: { '-1' => '',
15581: '86400' => &mt('today'),
15582: '604800' => &mt('last week'),
15583: '2592000' => &mt('last month'),
15584: '7776000' => &mt('last three months'),
15585: '15552000' => &mt('last six months'),
15586: '31104000' => &mt('last year'),
15587: 'select_form_order' =>
15588: ['-1','86400','604800','2592000','7776000',
15589: '15552000','31104000']});
15590: }
15591: }
15592:
15593: =pod
15594:
15595: =item * &js_changer()
15596:
15597: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15598: when course type or domain is changed, and also to hide 'Searching ...' on
15599: page load completion for page showing search result.
1.1181 raeburn 15600:
15601: Inputs: None
15602:
1.1183 raeburn 15603: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15604:
15605: Side Effects: None
15606:
15607: =cut
15608:
15609: sub js_changer {
15610: return <<ENDJS;
15611: <script type="text/javascript">
15612: // <![CDATA[
15613: function updateFilters(caller) {
15614: if (typeof(caller) != "undefined") {
15615: document.filterpicker.updater.value = caller.name;
15616: }
15617: document.filterpicker.submit();
15618: }
1.1183 raeburn 15619:
15620: function hideSearching() {
15621: if (document.getElementById('searching')) {
15622: document.getElementById('searching').style.display = 'none';
15623: }
15624: return;
15625: }
15626:
1.1181 raeburn 15627: // ]]>
15628: </script>
15629:
15630: ENDJS
15631: }
15632:
15633: =pod
15634:
1.1182 raeburn 15635: =item * &search_courses()
15636:
15637: Process selected filters form course search form and pass to lonnet::courseiddump
15638: to retrieve a hash for which keys are courseIDs which match the selected filters.
15639:
15640: Inputs:
15641:
15642: dom - domain being searched
15643:
15644: type - course type ('Course' or 'Community' or '.' if any).
15645:
15646: filter - anonymous hash of criteria and their values
15647:
15648: numtitles - for institutional codes - number of categories
15649:
15650: cloneruname - optional username of new course owner
15651:
15652: clonerudom - optional domain of new course owner
15653:
15654: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15655: (used when DC is using course creation form)
15656:
15657: codetitles - reference to array of titles of components in institutional codes (official courses).
15658:
15659:
15660: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15661:
15662:
15663: Side Effects: None
15664:
15665: =cut
15666:
15667:
15668: sub search_courses {
15669: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15670: my (%courses,%showcourses,$cloner);
15671: if (($filter->{'ownerfilter'} ne '') ||
15672: ($filter->{'ownerdomfilter'} ne '')) {
15673: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15674: $filter->{'ownerdomfilter'};
15675: }
15676: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15677: if (!$filter->{$item}) {
15678: $filter->{$item}='.';
15679: }
15680: }
15681: my $now = time;
15682: my $timefilter =
15683: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15684: my ($createdbefore,$createdafter);
15685: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15686: $createdbefore = $now;
15687: $createdafter = $now-$filter->{'createdfilter'};
15688: }
15689: my ($instcodefilter,$regexpok);
15690: if ($numtitles) {
15691: if ($env{'form.official'} eq 'on') {
15692: $instcodefilter =
15693: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15694: $regexpok = 1;
15695: } elsif ($env{'form.official'} eq 'off') {
15696: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15697: unless ($instcodefilter eq '') {
15698: $regexpok = -1;
15699: }
15700: }
15701: } else {
15702: $instcodefilter = $filter->{'instcodefilter'};
15703: }
15704: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15705: if ($type eq '') { $type = '.'; }
15706:
15707: if (($clonerudom ne '') && ($cloneruname ne '')) {
15708: $cloner = $cloneruname.':'.$clonerudom;
15709: }
15710: %courses = &Apache::lonnet::courseiddump($dom,
15711: $filter->{'descriptfilter'},
15712: $timefilter,
15713: $instcodefilter,
15714: $filter->{'combownerfilter'},
15715: $filter->{'coursefilter'},
15716: undef,undef,$type,$regexpok,undef,undef,
15717: undef,undef,$cloner,$env{'form.cc_clone'},
15718: $filter->{'cloneableonly'},
15719: $createdbefore,$createdafter,undef,
15720: $domcloner);
15721: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15722: my $ccrole;
15723: if ($type eq 'Community') {
15724: $ccrole = 'co';
15725: } else {
15726: $ccrole = 'cc';
15727: }
15728: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15729: $filter->{'persondomfilter'},
15730: 'userroles',undef,
15731: [$ccrole,'in','ad','ep','ta','cr'],
15732: $dom);
15733: foreach my $role (keys(%rolehash)) {
15734: my ($cnum,$cdom,$courserole) = split(':',$role);
15735: my $cid = $cdom.'_'.$cnum;
15736: if (exists($courses{$cid})) {
15737: if (ref($courses{$cid}) eq 'HASH') {
15738: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15739: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15740: push (@{$courses{$cid}{roles}},$courserole);
15741: }
15742: } else {
15743: $courses{$cid}{roles} = [$courserole];
15744: }
15745: $showcourses{$cid} = $courses{$cid};
15746: }
15747: }
15748: }
15749: %courses = %showcourses;
15750: }
15751: return %courses;
15752: }
15753:
15754: =pod
15755:
1.1181 raeburn 15756: =back
15757:
1.1207 raeburn 15758: =head1 Routines for version requirements for current course.
15759:
15760: =over 4
15761:
15762: =item * &check_release_required()
15763:
15764: Compares required LON-CAPA version with version on server, and
15765: if required version is newer looks for a server with the required version.
15766:
15767: Looks first at servers in user's owen domain; if none suitable, looks at
15768: servers in course's domain are permitted to host sessions for user's domain.
15769:
15770: Inputs:
15771:
15772: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15773:
15774: $courseid - Course ID of current course
15775:
15776: $rolecode - User's current role in course (for switchserver query string).
15777:
15778: $required - LON-CAPA version needed by course (format: Major.Minor).
15779:
15780:
15781: Returns:
15782:
15783: $switchserver - query string tp append to /adm/switchserver call (if
15784: current server's LON-CAPA version is too old.
15785:
15786: $warning - Message is displayed if no suitable server could be found.
15787:
15788: =cut
15789:
15790: sub check_release_required {
15791: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15792: my ($switchserver,$warning);
15793: if ($required ne '') {
15794: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15795: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15796: if ($reqdmajor ne '' && $reqdminor ne '') {
15797: my $otherserver;
15798: if (($major eq '' && $minor eq '') ||
15799: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15800: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15801: my $switchlcrev =
15802: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15803: $userdomserver);
15804: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15805: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15806: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15807: my $cdom = $env{'course.'.$courseid.'.domain'};
15808: if ($cdom ne $env{'user.domain'}) {
15809: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15810: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15811: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15812: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15813: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15814: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15815: my $canhost =
15816: &Apache::lonnet::can_host_session($env{'user.domain'},
15817: $coursedomserver,
15818: $remoterev,
15819: $udomdefaults{'remotesessions'},
15820: $defdomdefaults{'hostedsessions'});
15821:
15822: if ($canhost) {
15823: $otherserver = $coursedomserver;
15824: } else {
15825: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
15826: }
15827: } else {
15828: $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
15829: }
15830: } else {
15831: $otherserver = $userdomserver;
15832: }
15833: }
15834: if ($otherserver ne '') {
15835: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15836: }
15837: }
15838: }
15839: return ($switchserver,$warning);
15840: }
15841:
15842: =pod
15843:
15844: =item * &check_release_result()
15845:
15846: Inputs:
15847:
15848: $switchwarning - Warning message if no suitable server found to host session.
15849:
15850: $switchserver - query string to append to /adm/switchserver containing lonHostID
15851: and current role.
15852:
15853: Returns: HTML to display with information about requirement to switch server.
15854: Either displaying warning with link to Roles/Courses screen or
15855: display link to switchserver.
15856:
1.1181 raeburn 15857: =cut
15858:
1.1207 raeburn 15859: sub check_release_result {
15860: my ($switchwarning,$switchserver) = @_;
15861: my $output = &start_page('Selected course unavailable on this server').
15862: '<p class="LC_warning">';
15863: if ($switchwarning) {
15864: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15865: if (&show_course()) {
15866: $output .= &mt('Display courses');
15867: } else {
15868: $output .= &mt('Display roles');
15869: }
15870: $output .= '</a>';
15871: } elsif ($switchserver) {
15872: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15873: '<br />'.
15874: '<a href="/adm/switchserver?'.$switchserver.'">'.
15875: &mt('Switch Server').
15876: '</a>';
15877: }
15878: $output .= '</p>'.&end_page();
15879: return $output;
15880: }
15881:
15882: =pod
15883:
15884: =item * &needs_coursereinit()
15885:
15886: Determine if course contents stored for user's session needs to be
15887: refreshed, because content has changed since "Big Hash" last tied.
15888:
15889: Check for change is made if time last checked is more than 10 minutes ago
15890: (by default).
15891:
15892: Inputs:
15893:
15894: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15895:
15896: $interval (optional) - Time which may elapse (in s) between last check for content
15897: change in current course. (default: 600 s).
15898:
15899: Returns: an array; first element is:
15900:
15901: =over 4
15902:
15903: 'switch' - if content updates mean user's session
15904: needs to be switched to a server running a newer LON-CAPA version
15905:
15906: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15907: on current server hosting user's session
15908:
15909: '' - if no action required.
15910:
15911: =back
15912:
15913: If first item element is 'switch':
15914:
15915: second item is $switchwarning - Warning message if no suitable server found to host session.
15916:
15917: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15918: and current role.
15919:
15920: otherwise: no other elements returned.
15921:
15922: =back
15923:
15924: =cut
15925:
15926: sub needs_coursereinit {
15927: my ($loncaparev,$interval) = @_;
15928: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15929: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15930: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15931: my $now = time;
15932: if ($interval eq '') {
15933: $interval = 600;
15934: }
15935: if (($now-$env{'request.course.timechecked'})>$interval) {
15936: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15937: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15938: if ($lastchange > $env{'request.course.tied'}) {
15939: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15940: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15941: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15942: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15943: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15944: $curr_reqd_hash{'internal.releaserequired'}});
15945: my ($switchserver,$switchwarning) =
15946: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15947: $curr_reqd_hash{'internal.releaserequired'});
15948: if ($switchwarning ne '' || $switchserver ne '') {
15949: return ('switch',$switchwarning,$switchserver);
15950: }
15951: }
15952: }
15953: return ('update');
15954: }
15955: }
15956: return ();
15957: }
1.1181 raeburn 15958:
1.1083 raeburn 15959: sub update_content_constraints {
15960: my ($cdom,$cnum,$chome,$cid) = @_;
15961: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15962: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15963: my %checkresponsetypes;
15964: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1219 raeburn 15965: my ($item,$name,$value,$valmatch) = split(/:/,$key);
1.1083 raeburn 15966: if ($item eq 'resourcetag') {
15967: if ($name eq 'responsetype') {
15968: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15969: }
15970: }
15971: }
15972: my $navmap = Apache::lonnavmaps::navmap->new();
15973: if (defined($navmap)) {
15974: my %allresponses;
15975: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15976: my %responses = $res->responseTypes();
15977: foreach my $key (keys(%responses)) {
15978: next unless(exists($checkresponsetypes{$key}));
15979: $allresponses{$key} += $responses{$key};
15980: }
15981: }
15982: foreach my $key (keys(%allresponses)) {
15983: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15984: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15985: ($reqdmajor,$reqdminor) = ($major,$minor);
15986: }
15987: }
15988: undef($navmap);
15989: }
15990: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15991: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15992: }
15993: return;
15994: }
15995:
1.1110 raeburn 15996: sub allmaps_incourse {
15997: my ($cdom,$cnum,$chome,$cid) = @_;
15998: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15999: $cid = $env{'request.course.id'};
16000: $cdom = $env{'course.'.$cid.'.domain'};
16001: $cnum = $env{'course.'.$cid.'.num'};
16002: $chome = $env{'course.'.$cid.'.home'};
16003: }
16004: my %allmaps = ();
16005: my $lastchange =
16006: &Apache::lonnet::get_coursechange($cdom,$cnum);
16007: if ($lastchange > $env{'request.course.tied'}) {
16008: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16009: unless ($ferr) {
16010: &update_content_constraints($cdom,$cnum,$chome,$cid);
16011: }
16012: }
16013: my $navmap = Apache::lonnavmaps::navmap->new();
16014: if (defined($navmap)) {
16015: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16016: $allmaps{$res->src()} = 1;
16017: }
16018: }
16019: return \%allmaps;
16020: }
16021:
1.1083 raeburn 16022: sub parse_supplemental_title {
16023: my ($title) = @_;
16024:
16025: my ($foldertitle,$renametitle);
16026: if ($title =~ /&&&/) {
16027: $title = &HTML::Entites::decode($title);
16028: }
16029: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16030: $renametitle=$4;
16031: my ($time,$uname,$udom) = ($1,$2,$3);
16032: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16033: my $name = &plainname($uname,$udom);
16034: $name = &HTML::Entities::encode($name,'"<>&\'');
16035: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16036: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16037: $name.': <br />'.$foldertitle;
16038: }
16039: if (wantarray) {
16040: return ($title,$foldertitle,$renametitle);
16041: }
16042: return $title;
16043: }
16044:
1.1143 raeburn 16045: sub recurse_supplemental {
16046: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16047: if ($suppmap) {
16048: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16049: if ($fatal) {
16050: $errors ++;
16051: } else {
16052: if ($#LONCAPA::map::resources > 0) {
16053: foreach my $res (@LONCAPA::map::resources) {
16054: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16055: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16056: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16057: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16058: } else {
16059: $numfiles ++;
16060: }
16061: }
16062: }
16063: }
16064: }
16065: }
16066: return ($numfiles,$errors);
16067: }
16068:
1.1101 raeburn 16069: sub symb_to_docspath {
16070: my ($symb) = @_;
16071: return unless ($symb);
16072: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16073: if ($resurl=~/\.(sequence|page)$/) {
16074: $mapurl=$resurl;
16075: } elsif ($resurl eq 'adm/navmaps') {
16076: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16077: }
16078: my $mapresobj;
16079: my $navmap = Apache::lonnavmaps::navmap->new();
16080: if (ref($navmap)) {
16081: $mapresobj = $navmap->getResourceByUrl($mapurl);
16082: }
16083: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16084: my $type=$2;
16085: my $path;
16086: if (ref($mapresobj)) {
16087: my $pcslist = $mapresobj->map_hierarchy();
16088: if ($pcslist ne '') {
16089: foreach my $pc (split(/,/,$pcslist)) {
16090: next if ($pc <= 1);
16091: my $res = $navmap->getByMapPc($pc);
16092: if (ref($res)) {
16093: my $thisurl = $res->src();
16094: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16095: my $thistitle = $res->title();
16096: $path .= '&'.
16097: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16098: &escape($thistitle).
1.1101 raeburn 16099: ':'.$res->randompick().
16100: ':'.$res->randomout().
16101: ':'.$res->encrypted().
16102: ':'.$res->randomorder().
16103: ':'.$res->is_page();
16104: }
16105: }
16106: }
16107: $path =~ s/^\&//;
16108: my $maptitle = $mapresobj->title();
16109: if ($mapurl eq 'default') {
1.1129 raeburn 16110: $maptitle = 'Main Content';
1.1101 raeburn 16111: }
16112: $path .= (($path ne '')? '&' : '').
16113: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16114: &escape($maptitle).
1.1101 raeburn 16115: ':'.$mapresobj->randompick().
16116: ':'.$mapresobj->randomout().
16117: ':'.$mapresobj->encrypted().
16118: ':'.$mapresobj->randomorder().
16119: ':'.$mapresobj->is_page();
16120: } else {
16121: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16122: my $ispage = (($type eq 'page')? 1 : '');
16123: if ($mapurl eq 'default') {
1.1129 raeburn 16124: $maptitle = 'Main Content';
1.1101 raeburn 16125: }
16126: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16127: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16128: }
16129: unless ($mapurl eq 'default') {
16130: $path = 'default&'.
1.1146 raeburn 16131: &escape('Main Content').
1.1101 raeburn 16132: ':::::&'.$path;
16133: }
16134: return $path;
16135: }
16136:
1.1094 raeburn 16137: sub captcha_display {
16138: my ($context,$lonhost) = @_;
16139: my ($output,$error);
16140: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16141: if ($captcha eq 'original') {
1.1094 raeburn 16142: $output = &create_captcha();
16143: unless ($output) {
1.1172 raeburn 16144: $error = 'captcha';
1.1094 raeburn 16145: }
16146: } elsif ($captcha eq 'recaptcha') {
16147: $output = &create_recaptcha($pubkey);
16148: unless ($output) {
1.1172 raeburn 16149: $error = 'recaptcha';
1.1094 raeburn 16150: }
16151: }
1.1176 raeburn 16152: return ($output,$error,$captcha);
1.1094 raeburn 16153: }
16154:
16155: sub captcha_response {
16156: my ($context,$lonhost) = @_;
16157: my ($captcha_chk,$captcha_error);
16158: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16159: if ($captcha eq 'original') {
1.1094 raeburn 16160: ($captcha_chk,$captcha_error) = &check_captcha();
16161: } elsif ($captcha eq 'recaptcha') {
16162: $captcha_chk = &check_recaptcha($privkey);
16163: } else {
16164: $captcha_chk = 1;
16165: }
16166: return ($captcha_chk,$captcha_error);
16167: }
16168:
16169: sub get_captcha_config {
16170: my ($context,$lonhost) = @_;
1.1095 raeburn 16171: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 16172: my $hostname = &Apache::lonnet::hostname($lonhost);
16173: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16174: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 16175: if ($context eq 'usercreation') {
16176: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16177: if (ref($domconfig{$context}) eq 'HASH') {
16178: $hashtocheck = $domconfig{$context}{'cancreate'};
16179: if (ref($hashtocheck) eq 'HASH') {
16180: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16181: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16182: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16183: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16184: }
16185: if ($privkey && $pubkey) {
16186: $captcha = 'recaptcha';
16187: } else {
16188: $captcha = 'original';
16189: }
16190: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16191: $captcha = 'original';
16192: }
1.1094 raeburn 16193: }
1.1095 raeburn 16194: } else {
16195: $captcha = 'captcha';
16196: }
16197: } elsif ($context eq 'login') {
16198: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16199: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16200: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16201: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 16202: if ($privkey && $pubkey) {
16203: $captcha = 'recaptcha';
1.1095 raeburn 16204: } else {
16205: $captcha = 'original';
1.1094 raeburn 16206: }
1.1095 raeburn 16207: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16208: $captcha = 'original';
1.1094 raeburn 16209: }
16210: }
16211: return ($captcha,$pubkey,$privkey);
16212: }
16213:
16214: sub create_captcha {
16215: my %captcha_params = &captcha_settings();
16216: my ($output,$maxtries,$tries) = ('',10,0);
16217: while ($tries < $maxtries) {
16218: $tries ++;
16219: my $captcha = Authen::Captcha->new (
16220: output_folder => $captcha_params{'output_dir'},
16221: data_folder => $captcha_params{'db_dir'},
16222: );
16223: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16224:
16225: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16226: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16227: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 16228: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16229: '<br />'.
16230: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 16231: last;
16232: }
16233: }
16234: return $output;
16235: }
16236:
16237: sub captcha_settings {
16238: my %captcha_params = (
16239: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16240: www_output_dir => "/captchaspool",
16241: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16242: numchars => '5',
16243: );
16244: return %captcha_params;
16245: }
16246:
16247: sub check_captcha {
16248: my ($captcha_chk,$captcha_error);
16249: my $code = $env{'form.code'};
16250: my $md5sum = $env{'form.crypt'};
16251: my %captcha_params = &captcha_settings();
16252: my $captcha = Authen::Captcha->new(
16253: output_folder => $captcha_params{'output_dir'},
16254: data_folder => $captcha_params{'db_dir'},
16255: );
1.1109 raeburn 16256: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 16257: my %captcha_hash = (
16258: 0 => 'Code not checked (file error)',
16259: -1 => 'Failed: code expired',
16260: -2 => 'Failed: invalid code (not in database)',
16261: -3 => 'Failed: invalid code (code does not match crypt)',
16262: );
16263: if ($captcha_chk != 1) {
16264: $captcha_error = $captcha_hash{$captcha_chk}
16265: }
16266: return ($captcha_chk,$captcha_error);
16267: }
16268:
16269: sub create_recaptcha {
16270: my ($pubkey) = @_;
1.1153 raeburn 16271: my $use_ssl;
16272: if ($ENV{'SERVER_PORT'} == 443) {
16273: $use_ssl = 1;
16274: }
1.1094 raeburn 16275: my $captcha = Captcha::reCAPTCHA->new;
16276: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 16277: $captcha->get_html($pubkey,undef,$use_ssl).
1.1213 raeburn 16278: &mt('If the text is hard to read, [_1] will replace them.',
1.1133 raeburn 16279: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 16280: '<br /><br />';
16281: }
16282:
16283: sub check_recaptcha {
16284: my ($privkey) = @_;
16285: my $captcha_chk;
16286: my $captcha = Captcha::reCAPTCHA->new;
16287: my $captcha_result =
16288: $captcha->check_answer(
16289: $privkey,
16290: $ENV{'REMOTE_ADDR'},
16291: $env{'form.recaptcha_challenge_field'},
16292: $env{'form.recaptcha_response_field'},
16293: );
16294: if ($captcha_result->{is_valid}) {
16295: $captcha_chk = 1;
16296: }
16297: return $captcha_chk;
16298: }
16299:
1.1174 raeburn 16300: sub emailusername_info {
1.1177 raeburn 16301: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 16302: my %titles = &Apache::lonlocal::texthash (
16303: lastname => 'Last Name',
16304: firstname => 'First Name',
16305: institution => 'School/college/university',
16306: location => "School's city, state/province, country",
16307: web => "School's web address",
16308: officialemail => 'E-mail address at institution (if different)',
16309: );
16310: return (\@fields,\%titles);
16311: }
16312:
1.1161 raeburn 16313: sub cleanup_html {
16314: my ($incoming) = @_;
16315: my $outgoing;
16316: if ($incoming ne '') {
16317: $outgoing = $incoming;
16318: $outgoing =~ s/;/;/g;
16319: $outgoing =~ s/\#/#/g;
16320: $outgoing =~ s/\&/&/g;
16321: $outgoing =~ s/</</g;
16322: $outgoing =~ s/>/>/g;
16323: $outgoing =~ s/\(/(/g;
16324: $outgoing =~ s/\)/)/g;
16325: $outgoing =~ s/"/"/g;
16326: $outgoing =~ s/'/'/g;
16327: $outgoing =~ s/\$/$/g;
16328: $outgoing =~ s{/}{/}g;
16329: $outgoing =~ s/=/=/g;
16330: $outgoing =~ s/\\/\/g
16331: }
16332: return $outgoing;
16333: }
16334:
1.1190 musolffc 16335: # Checks for critical messages and returns a redirect url if one exists.
16336: # $interval indicates how often to check for messages.
16337: sub critical_redirect {
16338: my ($interval) = @_;
16339: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16340: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16341: $env{'user.name'});
16342: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 16343: my $redirecturl;
1.1190 musolffc 16344: if ($what[0]) {
16345: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16346: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 16347: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16348: return (1, $url);
1.1190 musolffc 16349: }
1.1191 raeburn 16350: }
16351: }
16352: return ();
1.1190 musolffc 16353: }
16354:
1.1174 raeburn 16355: # Use:
16356: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16357: #
16358: ##################################################
16359: # password associated functions #
16360: ##################################################
16361: sub des_keys {
16362: # Make a new key for DES encryption.
16363: # Each key has two parts which are returned separately.
16364: # Please note: Each key must be passed through the &hex function
16365: # before it is output to the web browser. The hex versions cannot
16366: # be used to decrypt.
16367: my @hexstr=('0','1','2','3','4','5','6','7',
16368: '8','9','a','b','c','d','e','f');
16369: my $lkey='';
16370: for (0..7) {
16371: $lkey.=$hexstr[rand(15)];
16372: }
16373: my $ukey='';
16374: for (0..7) {
16375: $ukey.=$hexstr[rand(15)];
16376: }
16377: return ($lkey,$ukey);
16378: }
16379:
16380: sub des_decrypt {
16381: my ($key,$cyphertext) = @_;
16382: my $keybin=pack("H16",$key);
16383: my $cypher;
16384: if ($Crypt::DES::VERSION>=2.03) {
16385: $cypher=new Crypt::DES $keybin;
16386: } else {
16387: $cypher=new DES $keybin;
16388: }
16389: my $plaintext=
16390: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16391: $plaintext.=
16392: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16393: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16394: return $plaintext;
16395: }
16396:
1.112 bowersj2 16397: 1;
16398: __END__;
1.41 ng 16399:
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