Annotation of loncom/interface/loncommon.pm, revision 1.1255
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1255 ! raeburn 4: # $Id: loncommon.pm,v 1.1254 2016/10/03 19:40:17 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.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.1241 raeburn 75: use DateTime::Locale;
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.1234 raeburn 80: use JSON::DWIW;
81: use LWP::UserAgent;
1.1174 raeburn 82: use Crypt::DES;
83: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 84: use MIME::Lite;
85: use MIME::Types;
1.117 www 86:
1.517 raeburn 87: # ---------------------------------------------- Designs
88: use vars qw(%defaultdesign);
89:
1.22 www 90: my $readit;
91:
1.517 raeburn 92:
1.157 matthew 93: ##
94: ## Global Variables
95: ##
1.46 matthew 96:
1.643 foxr 97:
98: # ----------------------------------------------- SSI with retries:
99: #
100:
101: =pod
102:
1.648 raeburn 103: =head1 Server Side include with retries:
1.643 foxr 104:
105: =over 4
106:
1.648 raeburn 107: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 108:
109: Performs an ssi with some number of retries. Retries continue either
110: until the result is ok or until the retry count supplied by the
111: caller is exhausted.
112:
113: Inputs:
1.648 raeburn 114:
115: =over 4
116:
1.643 foxr 117: resource - Identifies the resource to insert.
1.648 raeburn 118:
1.643 foxr 119: retries - Count of the number of retries allowed.
1.648 raeburn 120:
1.643 foxr 121: form - Hash that identifies the rendering options.
122:
1.648 raeburn 123: =back
124:
125: Returns:
126:
127: =over 4
128:
1.643 foxr 129: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 130:
1.643 foxr 131: response - The response from the last attempt (which may or may not have been successful.
132:
1.648 raeburn 133: =back
134:
135: =back
136:
1.643 foxr 137: =cut
138:
139: sub ssi_with_retries {
140: my ($resource, $retries, %form) = @_;
141:
142:
143: my $ok = 0; # True if we got a good response.
144: my $content;
145: my $response;
146:
147: # Try to get the ssi done. within the retries count:
148:
149: do {
150: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
151: $ok = $response->is_success;
1.650 www 152: if (!$ok) {
153: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
154: }
1.643 foxr 155: $retries--;
156: } while (!$ok && ($retries > 0));
157:
158: if (!$ok) {
159: $content = ''; # On error return an empty content.
160: }
161: return ($content, $response);
162:
163: }
164:
165:
166:
1.20 www 167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 168: my %language;
1.124 www 169: my %supported_language;
1.1088 foxr 170: my %supported_codes;
1.1048 foxr 171: my %latex_language; # For choosing hyphenation in <transl..>
172: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 173: my %cprtag;
1.192 taceyjo1 174: my %scprtag;
1.351 www 175: my %fe; my %fd; my %fm;
1.41 ng 176: my %category_extensions;
1.12 harris41 177:
1.46 matthew 178: # ---------------------------------------------- Thesaurus variables
1.144 matthew 179: #
180: # %Keywords:
181: # A hash used by &keyword to determine if a word is considered a keyword.
182: # $thesaurus_db_file
183: # Scalar containing the full path to the thesaurus database.
1.46 matthew 184:
185: my %Keywords;
186: my $thesaurus_db_file;
187:
1.144 matthew 188: #
189: # Initialize values from language.tab, copyright.tab, filetypes.tab,
190: # thesaurus.tab, and filecategories.tab.
191: #
1.18 www 192: BEGIN {
1.46 matthew 193: # Variable initialization
194: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
195: #
1.22 www 196: unless ($readit) {
1.12 harris41 197: # ------------------------------------------------------------------- languages
198: {
1.158 raeburn 199: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
200: '/language.tab';
201: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 202: while (my $line = <$fh>) {
203: next if ($line=~/^\#/);
204: chomp($line);
1.1088 foxr 205: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 206: $language{$key}=$val.' - '.$enc;
207: if ($sup) {
208: $supported_language{$key}=$sup;
1.1088 foxr 209: $supported_codes{$key} = $code;
1.158 raeburn 210: }
1.1048 foxr 211: if ($latex) {
212: $latex_language_bykey{$key} = $latex;
1.1088 foxr 213: $latex_language{$code} = $latex;
1.1048 foxr 214: }
1.158 raeburn 215: }
216: close($fh);
217: }
1.12 harris41 218: }
219: # ------------------------------------------------------------------ copyrights
220: {
1.158 raeburn 221: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
222: '/copyright.tab';
223: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line=~/^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 228: $cprtag{$key}=$val;
229: }
230: close($fh);
231: }
1.12 harris41 232: }
1.351 www 233: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 234: {
235: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
236: '/source_copyright.tab';
237: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 242: $scprtag{$key}=$val;
243: }
244: close($fh);
245: }
246: }
1.63 www 247:
1.517 raeburn 248: # -------------------------------------------------------------- default domain designs
1.63 www 249: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 250: my $designfile = $designdir.'/default.tab';
251: if ( open (my $fh,"<$designfile") ) {
252: while (my $line = <$fh>) {
253: next if ($line =~ /^\#/);
254: chomp($line);
255: my ($key,$val)=(split(/\=/,$line));
256: if ($val) { $defaultdesign{$key}=$val; }
257: }
258: close($fh);
1.63 www 259: }
260:
1.15 harris41 261: # ------------------------------------------------------------- file categories
262: {
1.158 raeburn 263: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
264: '/filecategories.tab';
265: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 266: while (my $line = <$fh>) {
267: next if ($line =~ /^\#/);
268: chomp($line);
269: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 270: push @{$category_extensions{lc($category)}},$extension;
271: }
272: close($fh);
273: }
274:
1.15 harris41 275: }
1.12 harris41 276: # ------------------------------------------------------------------ file types
277: {
1.158 raeburn 278: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
279: '/filetypes.tab';
280: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 281: while (my $line = <$fh>) {
282: next if ($line =~ /^\#/);
283: chomp($line);
284: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 285: if ($descr ne '') {
286: $fe{$ending}=lc($emb);
287: $fd{$ending}=$descr;
1.351 www 288: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 289: }
290: }
291: close($fh);
292: }
1.12 harris41 293: }
1.22 www 294: &Apache::lonnet::logthis(
1.705 tempelho 295: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 296: $readit=1;
1.46 matthew 297: } # end of unless($readit)
1.32 matthew 298:
299: }
1.112 bowersj2 300:
1.42 matthew 301: ###############################################################
302: ## HTML and Javascript Helper Functions ##
303: ###############################################################
304:
305: =pod
306:
1.112 bowersj2 307: =head1 HTML and Javascript Functions
1.42 matthew 308:
1.112 bowersj2 309: =over 4
310:
1.648 raeburn 311: =item * &browser_and_searcher_javascript()
1.112 bowersj2 312:
313: X<browsing, javascript>X<searching, javascript>Returns a string
314: containing javascript with two functions, C<openbrowser> and
315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
316: tags.
1.42 matthew 317:
1.648 raeburn 318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 319:
320: inputs: formname, elementname, only, omit
321:
322: formname and elementname indicate the name of the html form and name of
323: the element that the results of the browsing selection are to be placed in.
324:
325: Specifying 'only' will restrict the browser to displaying only files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 329: with the given extension. Can be a comma separated list.
1.42 matthew 330:
1.648 raeburn 331: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 332:
333: Inputs: formname, elementname
334:
335: formname and elementname specify the name of the html form and the name
336: of the element the selection from the search results will be placed in.
1.542 raeburn 337:
1.42 matthew 338: =cut
339:
340: sub browser_and_searcher_javascript {
1.199 albertel 341: my ($mode)=@_;
342: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 343: my $resurl=&escape_single(&lastresurl());
1.42 matthew 344: return <<END;
1.219 albertel 345: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 346: var editbrowser = null;
1.135 albertel 347: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 348: var url = '$resurl/?';
1.42 matthew 349: if (editbrowser == null) {
350: url += 'launch=1&';
351: }
352: url += 'catalogmode=interactive&';
1.199 albertel 353: url += 'mode=$mode&';
1.611 albertel 354: url += 'inhibitmenu=yes&';
1.42 matthew 355: url += 'form=' + formname + '&';
356: if (only != null) {
357: url += 'only=' + only + '&';
1.217 albertel 358: } else {
359: url += 'only=&';
360: }
1.42 matthew 361: if (omit != null) {
362: url += 'omit=' + omit + '&';
1.217 albertel 363: } else {
364: url += 'omit=&';
365: }
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Browser';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editbrowser = open(url,title,options,'1');
376: editbrowser.focus();
377: }
378: var editsearcher;
1.135 albertel 379: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 380: var url = '/adm/searchcat?';
381: if (editsearcher == null) {
382: url += 'launch=1&';
383: }
384: url += 'catalogmode=interactive&';
1.199 albertel 385: url += 'mode=$mode&';
1.42 matthew 386: url += 'form=' + formname + '&';
1.135 albertel 387: if (titleelement != null) {
388: url += 'titleelement=' + titleelement + '&';
1.217 albertel 389: } else {
390: url += 'titleelement=&';
391: }
1.42 matthew 392: url += 'element=' + elementname + '';
393: var title = 'Search';
1.435 albertel 394: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 395: options += ',width=700,height=600';
396: editsearcher = open(url,title,options,'1');
397: editsearcher.focus();
398: }
1.219 albertel 399: // END LON-CAPA Internal -->
1.42 matthew 400: END
1.170 www 401: }
402:
403: sub lastresurl {
1.258 albertel 404: if ($env{'environment.lastresurl'}) {
405: return $env{'environment.lastresurl'}
1.170 www 406: } else {
407: return '/res';
408: }
409: }
410:
411: sub storeresurl {
412: my $resurl=&Apache::lonnet::clutter(shift);
413: unless ($resurl=~/^\/res/) { return 0; }
414: $resurl=~s/\/$//;
415: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 416: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 417: return 1;
1.42 matthew 418: }
419:
1.74 www 420: sub studentbrowser_javascript {
1.111 www 421: unless (
1.258 albertel 422: (($env{'request.course.id'}) &&
1.302 albertel 423: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
424: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
425: '/'.$env{'request.course.sec'})
426: ))
1.258 albertel 427: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 428: ) { return ''; }
1.74 www 429: return (<<'ENDSTDBRW');
1.776 bisitz 430: <script type="text/javascript" language="Javascript">
1.824 bisitz 431: // <![CDATA[
1.74 www 432: var stdeditbrowser;
1.999 www 433: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 434: var url = '/adm/pickstudent?';
435: var filter;
1.558 albertel 436: if (!ignorefilter) {
437: eval('filter=document.'+formname+'.'+uname+'.value;');
438: }
1.74 www 439: if (filter != null) {
440: if (filter != '') {
441: url += 'filter='+filter+'&';
442: }
443: }
444: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 445: '&udomelement='+udom+
446: '&clicker='+clicker;
1.111 www 447: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 448: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 449: var title = 'Student_Browser';
1.74 www 450: var options = 'scrollbars=1,resizable=1,menubar=0';
451: options += ',width=700,height=600';
452: stdeditbrowser = open(url,title,options,'1');
453: stdeditbrowser.focus();
454: }
1.824 bisitz 455: // ]]>
1.74 www 456: </script>
457: ENDSTDBRW
458: }
1.42 matthew 459:
1.1003 www 460: sub resourcebrowser_javascript {
461: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 462: return (<<'ENDRESBRW');
1.1003 www 463: <script type="text/javascript" language="Javascript">
464: // <![CDATA[
465: var reseditbrowser;
1.1004 www 466: function openresbrowser(formname,reslink) {
1.1005 www 467: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 468: var title = 'Resource_Browser';
469: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 470: options += ',width=700,height=500';
1.1004 www 471: reseditbrowser = open(url,title,options,'1');
472: reseditbrowser.focus();
1.1003 www 473: }
474: // ]]>
475: </script>
1.1004 www 476: ENDRESBRW
1.1003 www 477: }
478:
1.74 www 479: sub selectstudent_link {
1.999 www 480: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
481: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
482: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
483: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 484: if ($env{'request.course.id'}) {
1.302 albertel 485: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
486: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
487: '/'.$env{'request.course.sec'})) {
1.111 www 488: return '';
489: }
1.999 www 490: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 491: if ($courseadvonly) {
492: $callargs .= ",'',1,1";
493: }
494: return '<span class="LC_nobreak">'.
495: '<a href="javascript:openstdbrowser('.$callargs.');">'.
496: &mt('Select User').'</a></span>';
1.74 www 497: }
1.258 albertel 498: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 499: $callargs .= ",'',1";
1.793 raeburn 500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openstdbrowser('.$callargs.');">'.
502: &mt('Select User').'</a></span>';
1.111 www 503: }
504: return '';
1.91 www 505: }
506:
1.1004 www 507: sub selectresource_link {
508: my ($form,$reslink,$arg)=@_;
509:
510: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
511: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
512: unless ($env{'request.course.id'}) { return $arg; }
513: return '<span class="LC_nobreak">'.
514: '<a href="javascript:openresbrowser('.$callargs.');">'.
515: $arg.'</a></span>';
516: }
517:
518:
519:
1.653 raeburn 520: sub authorbrowser_javascript {
521: return <<"ENDAUTHORBRW";
1.776 bisitz 522: <script type="text/javascript" language="JavaScript">
1.824 bisitz 523: // <![CDATA[
1.653 raeburn 524: var stdeditbrowser;
525:
526: function openauthorbrowser(formname,udom) {
527: var url = '/adm/pickauthor?';
528: url += 'form='+formname+'&roledom='+udom;
529: var title = 'Author_Browser';
530: var options = 'scrollbars=1,resizable=1,menubar=0';
531: options += ',width=700,height=600';
532: stdeditbrowser = open(url,title,options,'1');
533: stdeditbrowser.focus();
534: }
535:
1.824 bisitz 536: // ]]>
1.653 raeburn 537: </script>
538: ENDAUTHORBRW
539: }
540:
1.91 www 541: sub coursebrowser_javascript {
1.1116 raeburn 542: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 543: $credits_element,$instcode) = @_;
1.932 raeburn 544: my $wintitle = 'Course_Browser';
1.931 raeburn 545: if ($crstype eq 'Community') {
1.932 raeburn 546: $wintitle = 'Community_Browser';
1.909 raeburn 547: }
1.876 raeburn 548: my $id_functions = &javascript_index_functions();
549: my $output = '
1.776 bisitz 550: <script type="text/javascript" language="JavaScript">
1.824 bisitz 551: // <![CDATA[
1.468 raeburn 552: var stdeditbrowser;'."\n";
1.876 raeburn 553:
554: $output .= <<"ENDSTDBRW";
1.909 raeburn 555: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 556: var url = '/adm/pickcourse?';
1.895 raeburn 557: var formid = getFormIdByName(formname);
1.876 raeburn 558: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 559: if (domainfilter != null) {
560: if (domainfilter != '') {
561: url += 'domainfilter='+domainfilter+'&';
562: }
563: }
1.91 www 564: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 565: '&cdomelement='+udom+
566: '&cnameelement='+desc;
1.468 raeburn 567: if (extra_element !=null && extra_element != '') {
1.594 raeburn 568: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 569: url += '&roleelement='+extra_element;
570: if (domainfilter == null || domainfilter == '') {
571: url += '&domainfilter='+extra_element;
572: }
1.234 raeburn 573: }
1.468 raeburn 574: else {
575: if (formname == 'portform') {
576: url += '&setroles='+extra_element;
1.800 raeburn 577: } else {
578: if (formname == 'rules') {
579: url += '&fixeddom='+extra_element;
580: }
1.468 raeburn 581: }
582: }
1.230 raeburn 583: }
1.909 raeburn 584: if (type != null && type != '') {
585: url += '&type='+type;
586: }
587: if (type_elem != null && type_elem != '') {
588: url += '&typeelement='+type_elem;
589: }
1.872 raeburn 590: if (formname == 'ccrs') {
591: var ownername = document.forms[formid].ccuname.value;
592: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 593: url += '&cloner='+ownername+':'+ownerdom;
594: if (type == 'Course') {
595: url += '&crscode='+document.forms[formid].crscode.value;
596: }
1.1221 raeburn 597: }
598: if (formname == 'requestcrs') {
599: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 600: }
1.293 raeburn 601: if (multflag !=null && multflag != '') {
602: url += '&multiple='+multflag;
603: }
1.909 raeburn 604: var title = '$wintitle';
1.91 www 605: var options = 'scrollbars=1,resizable=1,menubar=0';
606: options += ',width=700,height=600';
607: stdeditbrowser = open(url,title,options,'1');
608: stdeditbrowser.focus();
609: }
1.876 raeburn 610: $id_functions
611: ENDSTDBRW
1.1116 raeburn 612: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
613: $output .= &setsec_javascript($sec_element,$formname,$role_element,
614: $credits_element);
1.876 raeburn 615: }
616: $output .= '
617: // ]]>
618: </script>';
619: return $output;
620: }
621:
622: sub javascript_index_functions {
623: return <<"ENDJS";
624:
625: function getFormIdByName(formname) {
626: for (var i=0;i<document.forms.length;i++) {
627: if (document.forms[i].name == formname) {
628: return i;
629: }
630: }
631: return -1;
632: }
633:
634: function getIndexByName(formid,item) {
635: for (var i=0;i<document.forms[formid].elements.length;i++) {
636: if (document.forms[formid].elements[i].name == item) {
637: return i;
638: }
639: }
640: return -1;
641: }
1.468 raeburn 642:
1.876 raeburn 643: function getDomainFromSelectbox(formname,udom) {
644: var userdom;
645: var formid = getFormIdByName(formname);
646: if (formid > -1) {
647: var domid = getIndexByName(formid,udom);
648: if (domid > -1) {
649: if (document.forms[formid].elements[domid].type == 'select-one') {
650: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
651: }
652: if (document.forms[formid].elements[domid].type == 'hidden') {
653: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 654: }
655: }
656: }
1.876 raeburn 657: return userdom;
658: }
659:
660: ENDJS
1.468 raeburn 661:
1.876 raeburn 662: }
663:
1.1017 raeburn 664: sub javascript_array_indexof {
1.1018 raeburn 665: return <<ENDJS;
1.1017 raeburn 666: <script type="text/javascript" language="JavaScript">
667: // <![CDATA[
668:
669: if (!Array.prototype.indexOf) {
670: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
671: "use strict";
672: if (this === void 0 || this === null) {
673: throw new TypeError();
674: }
675: var t = Object(this);
676: var len = t.length >>> 0;
677: if (len === 0) {
678: return -1;
679: }
680: var n = 0;
681: if (arguments.length > 0) {
682: n = Number(arguments[1]);
1.1088 foxr 683: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 684: n = 0;
685: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
686: n = (n > 0 || -1) * Math.floor(Math.abs(n));
687: }
688: }
689: if (n >= len) {
690: return -1;
691: }
692: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
693: for (; k < len; k++) {
694: if (k in t && t[k] === searchElement) {
695: return k;
696: }
697: }
698: return -1;
699: }
700: }
701:
702: // ]]>
703: </script>
704:
705: ENDJS
706:
707: }
708:
1.876 raeburn 709: sub userbrowser_javascript {
710: my $id_functions = &javascript_index_functions();
711: return <<"ENDUSERBRW";
712:
1.888 raeburn 713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 714: var url = '/adm/pickuser?';
715: var userdom = getDomainFromSelectbox(formname,udom);
716: if (userdom != null) {
717: if (userdom != '') {
718: url += 'srchdom='+userdom+'&';
719: }
720: }
721: url += 'form=' + formname + '&unameelement='+uname+
722: '&udomelement='+udom+
723: '&ulastelement='+ulast+
724: '&ufirstelement='+ufirst+
725: '&uemailelement='+uemail+
1.881 raeburn 726: '&hideudomelement='+hideudom+
727: '&coursedom='+crsdom;
1.888 raeburn 728: if ((caller != null) && (caller != undefined)) {
729: url += '&caller='+caller;
730: }
1.876 raeburn 731: var title = 'User_Browser';
732: var options = 'scrollbars=1,resizable=1,menubar=0';
733: options += ',width=700,height=600';
734: var stdeditbrowser = open(url,title,options,'1');
735: stdeditbrowser.focus();
736: }
737:
1.888 raeburn 738: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 739: var formid = getFormIdByName(formname);
740: if (formid > -1) {
1.888 raeburn 741: var unameid = getIndexByName(formid,uname);
1.876 raeburn 742: var domid = getIndexByName(formid,udom);
743: var hidedomid = getIndexByName(formid,origdom);
744: if (hidedomid > -1) {
745: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 746: var unameval = document.forms[formid].elements[unameid].value;
747: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
748: if (domid > -1) {
749: var slct = document.forms[formid].elements[domid];
750: if (slct.type == 'select-one') {
751: var i;
752: for (i=0;i<slct.length;i++) {
753: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
754: }
755: }
756: if (slct.type == 'hidden') {
757: slct.value = fixeddom;
1.876 raeburn 758: }
759: }
1.468 raeburn 760: }
761: }
762: }
1.876 raeburn 763: return;
764: }
765:
766: $id_functions
767: ENDUSERBRW
1.468 raeburn 768: }
769:
770: sub setsec_javascript {
1.1116 raeburn 771: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 772: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
773: $communityrolestr);
774: if ($role_element ne '') {
775: my @allroles = ('st','ta','ep','in','ad');
776: foreach my $crstype ('Course','Community') {
777: if ($crstype eq 'Community') {
778: foreach my $role (@allroles) {
779: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
780: }
781: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
782: } else {
783: foreach my $role (@allroles) {
784: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
785: }
786: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
787: }
788: }
789: $rolestr = '"'.join('","',@allroles).'"';
790: $courserolestr = '"'.join('","',@courserolenames).'"';
791: $communityrolestr = '"'.join('","',@communityrolenames).'"';
792: }
1.468 raeburn 793: my $setsections = qq|
794: function setSect(sectionlist) {
1.629 raeburn 795: var sectionsArray = new Array();
796: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
797: sectionsArray = sectionlist.split(",");
798: }
1.468 raeburn 799: var numSections = sectionsArray.length;
800: document.$formname.$sec_element.length = 0;
801: if (numSections == 0) {
802: document.$formname.$sec_element.multiple=false;
803: document.$formname.$sec_element.size=1;
804: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
805: } else {
806: if (numSections == 1) {
807: document.$formname.$sec_element.multiple=false;
808: document.$formname.$sec_element.size=1;
809: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
810: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
811: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
812: } else {
813: for (var i=0; i<numSections; i++) {
814: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
815: }
816: document.$formname.$sec_element.multiple=true
817: if (numSections < 3) {
818: document.$formname.$sec_element.size=numSections;
819: } else {
820: document.$formname.$sec_element.size=3;
821: }
822: document.$formname.$sec_element.options[0].selected = false
823: }
824: }
1.91 www 825: }
1.905 raeburn 826:
827: function setRole(crstype) {
1.468 raeburn 828: |;
1.905 raeburn 829: if ($role_element eq '') {
830: $setsections .= ' return;
831: }
832: ';
833: } else {
834: $setsections .= qq|
835: var elementLength = document.$formname.$role_element.length;
836: var allroles = Array($rolestr);
837: var courserolenames = Array($courserolestr);
838: var communityrolenames = Array($communityrolestr);
839: if (elementLength != undefined) {
840: if (document.$formname.$role_element.options[5].value == 'cc') {
841: if (crstype == 'Course') {
842: return;
843: } else {
844: allroles[5] = 'co';
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 = communityrolenames[i];
848: }
849: }
850: } else {
851: if (crstype == 'Community') {
852: return;
853: } else {
854: allroles[5] = 'cc';
855: for (var i=0; i<6; i++) {
856: document.$formname.$role_element.options[i].value = allroles[i];
857: document.$formname.$role_element.options[i].text = courserolenames[i];
858: }
859: }
860: }
861: }
862: return;
863: }
864: |;
865: }
1.1116 raeburn 866: if ($credits_element) {
867: $setsections .= qq|
868: function setCredits(defaultcredits) {
869: document.$formname.$credits_element.value = defaultcredits;
870: return;
871: }
872: |;
873: }
1.468 raeburn 874: return $setsections;
875: }
876:
1.91 www 877: sub selectcourse_link {
1.909 raeburn 878: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
879: $typeelement) = @_;
880: my $type = $selecttype;
1.871 raeburn 881: my $linktext = &mt('Select Course');
882: if ($selecttype eq 'Community') {
1.909 raeburn 883: $linktext = &mt('Select Community');
1.1239 raeburn 884: } elsif ($selecttype eq 'Placement') {
885: $linktext = &mt('Select Placement Test');
1.906 raeburn 886: } elsif ($selecttype eq 'Course/Community') {
887: $linktext = &mt('Select Course/Community');
1.909 raeburn 888: $type = '';
1.1019 raeburn 889: } elsif ($selecttype eq 'Select') {
890: $linktext = &mt('Select');
891: $type = '';
1.871 raeburn 892: }
1.787 bisitz 893: return '<span class="LC_nobreak">'
894: ."<a href='"
895: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
896: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 897: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 898: ."'>".$linktext.'</a>'
1.787 bisitz 899: .'</span>';
1.74 www 900: }
1.42 matthew 901:
1.653 raeburn 902: sub selectauthor_link {
903: my ($form,$udom)=@_;
904: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
905: &mt('Select Author').'</a>';
906: }
907:
1.876 raeburn 908: sub selectuser_link {
1.881 raeburn 909: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 910: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 911: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 912: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 913: ');">'.$linktext.'</a>';
1.876 raeburn 914: }
915:
1.273 raeburn 916: sub check_uncheck_jscript {
917: my $jscript = <<"ENDSCRT";
918: function checkAll(field) {
919: if (field.length > 0) {
920: for (i = 0; i < field.length; i++) {
1.1093 raeburn 921: if (!field[i].disabled) {
922: field[i].checked = true;
923: }
1.273 raeburn 924: }
925: } else {
1.1093 raeburn 926: if (!field.disabled) {
927: field.checked = true;
928: }
1.273 raeburn 929: }
930: }
931:
932: function uncheckAll(field) {
933: if (field.length > 0) {
934: for (i = 0; i < field.length; i++) {
935: field[i].checked = false ;
1.543 albertel 936: }
937: } else {
1.273 raeburn 938: field.checked = false ;
939: }
940: }
941: ENDSCRT
942: return $jscript;
943: }
944:
1.656 www 945: sub select_timezone {
1.659 raeburn 946: my ($name,$selected,$onchange,$includeempty)=@_;
947: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
948: if ($includeempty) {
949: $output .= '<option value=""';
950: if (($selected eq '') || ($selected eq 'local')) {
951: $output .= ' selected="selected" ';
952: }
953: $output .= '> </option>';
954: }
1.657 raeburn 955: my @timezones = DateTime::TimeZone->all_names;
956: foreach my $tzone (@timezones) {
957: $output.= '<option value="'.$tzone.'"';
958: if ($tzone eq $selected) {
959: $output.=' selected="selected"';
960: }
961: $output.=">$tzone</option>\n";
1.656 www 962: }
963: $output.="</select>";
964: return $output;
965: }
1.273 raeburn 966:
1.687 raeburn 967: sub select_datelocale {
968: my ($name,$selected,$onchange,$includeempty)=@_;
969: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
970: if ($includeempty) {
971: $output .= '<option value=""';
972: if ($selected eq '') {
973: $output .= ' selected="selected" ';
974: }
975: $output .= '> </option>';
976: }
1.1241 raeburn 977: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 978: my (@possibles,%locale_names);
1.1241 raeburn 979: my @locales = DateTime::Locale->ids();
980: foreach my $id (@locales) {
981: if ($id ne '') {
982: my ($en_terr,$native_terr);
983: my $loc = DateTime::Locale->load($id);
984: if (ref($loc)) {
985: $en_terr = $loc->name();
986: $native_terr = $loc->native_name();
1.687 raeburn 987: if (grep(/^en$/,@languages) || !@languages) {
988: if ($en_terr ne '') {
989: $locale_names{$id} = '('.$en_terr.')';
990: } elsif ($native_terr ne '') {
991: $locale_names{$id} = $native_terr;
992: }
993: } else {
994: if ($native_terr ne '') {
995: $locale_names{$id} = $native_terr.' ';
996: } elsif ($en_terr ne '') {
997: $locale_names{$id} = '('.$en_terr.')';
998: }
999: }
1.1220 raeburn 1000: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1001: push(@possibles,$id);
1002: }
1.687 raeburn 1003: }
1004: }
1005: foreach my $item (sort(@possibles)) {
1006: $output.= '<option value="'.$item.'"';
1007: if ($item eq $selected) {
1008: $output.=' selected="selected"';
1009: }
1010: $output.=">$item";
1011: if ($locale_names{$item} ne '') {
1.1220 raeburn 1012: $output.=' '.$locale_names{$item};
1.687 raeburn 1013: }
1014: $output.="</option>\n";
1015: }
1016: $output.="</select>";
1017: return $output;
1018: }
1019:
1.792 raeburn 1020: sub select_language {
1021: my ($name,$selected,$includeempty) = @_;
1022: my %langchoices;
1023: if ($includeempty) {
1.1117 raeburn 1024: %langchoices = ('' => 'No language preference');
1.792 raeburn 1025: }
1026: foreach my $id (&languageids()) {
1027: my $code = &supportedlanguagecode($id);
1028: if ($code) {
1029: $langchoices{$code} = &plainlanguagedescription($id);
1030: }
1031: }
1.1117 raeburn 1032: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1033: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1034: }
1035:
1.42 matthew 1036: =pod
1.36 matthew 1037:
1.1088 foxr 1038:
1039: =item * &list_languages()
1040:
1041: Returns an array reference that is suitable for use in language prompters.
1042: Each array element is itself a two element array. The first element
1043: is the language code. The second element a descsriptiuon of the
1044: language itself. This is suitable for use in e.g.
1045: &Apache::edit::select_arg (once dereferenced that is).
1046:
1047: =cut
1048:
1049: sub list_languages {
1050: my @lang_choices;
1051:
1052: foreach my $id (&languageids()) {
1053: my $code = &supportedlanguagecode($id);
1054: if ($code) {
1055: my $selector = $supported_codes{$id};
1056: my $description = &plainlanguagedescription($id);
1057: push (@lang_choices, [$selector, $description]);
1058: }
1059: }
1060: return \@lang_choices;
1061: }
1062:
1063: =pod
1064:
1.648 raeburn 1065: =item * &linked_select_forms(...)
1.36 matthew 1066:
1067: linked_select_forms returns a string containing a <script></script> block
1068: and html for two <select> menus. The select menus will be linked in that
1069: changing the value of the first menu will result in new values being placed
1070: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1071: order unless a defined order is provided.
1.36 matthew 1072:
1073: linked_select_forms takes the following ordered inputs:
1074:
1075: =over 4
1076:
1.112 bowersj2 1077: =item * $formname, the name of the <form> tag
1.36 matthew 1078:
1.112 bowersj2 1079: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1080:
1.112 bowersj2 1081: =item * $firstdefault, the default value for the first menu
1.36 matthew 1082:
1.112 bowersj2 1083: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1084:
1.112 bowersj2 1085: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1086:
1.112 bowersj2 1087: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1088:
1.609 raeburn 1089: =item * $menuorder, the order of values in the first menu
1090:
1.1115 raeburn 1091: =item * $onchangefirst, additional javascript call to execute for an onchange
1092: event for the first <select> tag
1093:
1094: =item * $onchangesecond, additional javascript call to execute for an onchange
1095: event for the second <select> tag
1096:
1.1245 raeburn 1097: =item * $suffix, to differentiate separate uses of select2data javascript
1098: objects in a page.
1099:
1.41 ng 1100: =back
1101:
1.36 matthew 1102: Below is an example of such a hash. Only the 'text', 'default', and
1103: 'select2' keys must appear as stated. keys(%menu) are the possible
1104: values for the first select menu. The text that coincides with the
1.41 ng 1105: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1106: and text for the second menu are given in the hash pointed to by
1107: $menu{$choice1}->{'select2'}.
1108:
1.112 bowersj2 1109: my %menu = ( A1 => { text =>"Choice A1" ,
1110: default => "B3",
1111: select2 => {
1112: B1 => "Choice B1",
1113: B2 => "Choice B2",
1114: B3 => "Choice B3",
1115: B4 => "Choice B4"
1.609 raeburn 1116: },
1117: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1118: },
1119: A2 => { text =>"Choice A2" ,
1120: default => "C2",
1121: select2 => {
1122: C1 => "Choice C1",
1123: C2 => "Choice C2",
1124: C3 => "Choice C3"
1.609 raeburn 1125: },
1126: order => ['C2','C1','C3'],
1.112 bowersj2 1127: },
1128: A3 => { text =>"Choice A3" ,
1129: default => "D6",
1130: select2 => {
1131: D1 => "Choice D1",
1132: D2 => "Choice D2",
1133: D3 => "Choice D3",
1134: D4 => "Choice D4",
1135: D5 => "Choice D5",
1136: D6 => "Choice D6",
1137: D7 => "Choice D7"
1.609 raeburn 1138: },
1139: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1140: }
1141: );
1.36 matthew 1142:
1143: =cut
1144:
1145: sub linked_select_forms {
1146: my ($formname,
1147: $middletext,
1148: $firstdefault,
1149: $firstselectname,
1150: $secondselectname,
1.609 raeburn 1151: $hashref,
1152: $menuorder,
1.1115 raeburn 1153: $onchangefirst,
1.1245 raeburn 1154: $onchangesecond,
1155: $suffix
1.36 matthew 1156: ) = @_;
1157: my $second = "document.$formname.$secondselectname";
1158: my $first = "document.$formname.$firstselectname";
1159: # output the javascript to do the changing
1160: my $result = '';
1.776 bisitz 1161: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1162: $result.="// <![CDATA[\n";
1.1245 raeburn 1163: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1164: $" = '","';
1165: my $debug = '';
1166: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1167: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1168: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1169: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1170: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1171: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1172: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1173: @s2values = @{$hashref->{$s1}->{'order'}};
1174: }
1.36 matthew 1175: $result.="\"@s2values\");\n";
1.1245 raeburn 1176: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1177: my @s2texts;
1178: foreach my $value (@s2values) {
1179: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1180: }
1181: $result.="\"@s2texts\");\n";
1182: }
1183: $"=' ';
1184: $result.= <<"END";
1185:
1.1245 raeburn 1186: function select1${suffix}_changed() {
1.36 matthew 1187: // Determine new choice
1.1245 raeburn 1188: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1189: // update select2
1.1245 raeburn 1190: var values = select2data${suffix}[newvalue].values;
1191: var texts = select2data${suffix}[newvalue].texts;
1192: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1193: var i;
1194: // out with the old
1.1245 raeburn 1195: $second.options.length = 0;
1196: // in with the new
1.36 matthew 1197: for (i=0;i<values.length; i++) {
1198: $second.options[i] = new Option(values[i]);
1.143 matthew 1199: $second.options[i].value = values[i];
1.36 matthew 1200: $second.options[i].text = texts[i];
1201: if (values[i] == select2def) {
1202: $second.options[i].selected = true;
1203: }
1204: }
1205: }
1.824 bisitz 1206: // ]]>
1.36 matthew 1207: </script>
1208: END
1209: # output the initial values for the selection lists
1.1245 raeburn 1210: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1211: my @order = sort(keys(%{$hashref}));
1212: if (ref($menuorder) eq 'ARRAY') {
1213: @order = @{$menuorder};
1214: }
1215: foreach my $value (@order) {
1.36 matthew 1216: $result.=" <option value=\"$value\" ";
1.253 albertel 1217: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1218: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1219: }
1220: $result .= "</select>\n";
1221: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1222: $result .= $middletext;
1.1115 raeburn 1223: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1224: if ($onchangesecond) {
1225: $result .= ' onchange="'.$onchangesecond.'"';
1226: }
1227: $result .= ">\n";
1.36 matthew 1228: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1229:
1230: my @secondorder = sort(keys(%select2));
1231: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1232: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1233: }
1234: foreach my $value (@secondorder) {
1.36 matthew 1235: $result.=" <option value=\"$value\" ";
1.253 albertel 1236: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1237: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1238: }
1239: $result .= "</select>\n";
1240: # return $debug;
1241: return $result;
1242: } # end of sub linked_select_forms {
1243:
1.45 matthew 1244: =pod
1.44 bowersj2 1245:
1.973 raeburn 1246: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1247:
1.112 bowersj2 1248: Returns a string corresponding to an HTML link to the given help
1249: $topic, where $topic corresponds to the name of a .tex file in
1250: /home/httpd/html/adm/help/tex, with underscores replaced by
1251: spaces.
1252:
1253: $text will optionally be linked to the same topic, allowing you to
1254: link text in addition to the graphic. If you do not want to link
1255: text, but wish to specify one of the later parameters, pass an
1256: empty string.
1257:
1258: $stayOnPage is a value that will be interpreted as a boolean. If true,
1259: the link will not open a new window. If false, the link will open
1260: a new window using Javascript. (Default is false.)
1261:
1262: $width and $height are optional numerical parameters that will
1263: override the width and height of the popped up window, which may
1.973 raeburn 1264: be useful for certain help topics with big pictures included.
1265:
1266: $imgid is the id of the img tag used for the help icon. This may be
1267: used in a javascript call to switch the image src. See
1268: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1269:
1270: =cut
1271:
1272: sub help_open_topic {
1.973 raeburn 1273: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1274: $text = "" if (not defined $text);
1.44 bowersj2 1275: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1276: $width = 500 if (not defined $width);
1.44 bowersj2 1277: $height = 400 if (not defined $height);
1278: my $filename = $topic;
1279: $filename =~ s/ /_/g;
1280:
1.48 bowersj2 1281: my $template = "";
1282: my $link;
1.572 banghart 1283:
1.159 www 1284: $topic=~s/\W/\_/g;
1.44 bowersj2 1285:
1.572 banghart 1286: if (!$stayOnPage) {
1.1033 www 1287: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1288: } elsif ($stayOnPage eq 'popup') {
1289: $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 1290: } else {
1.48 bowersj2 1291: $link = "/adm/help/${filename}.hlp";
1292: }
1293:
1294: # Add the text
1.755 neumanie 1295: if ($text ne "") {
1.763 bisitz 1296: $template.='<span class="LC_help_open_topic">'
1297: .'<a target="_top" href="'.$link.'">'
1298: .$text.'</a>';
1.48 bowersj2 1299: }
1300:
1.763 bisitz 1301: # (Always) Add the graphic
1.179 matthew 1302: my $title = &mt('Online Help');
1.667 raeburn 1303: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1304: if ($imgid ne '') {
1305: $imgid = ' id="'.$imgid.'"';
1306: }
1.763 bisitz 1307: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1308: .'<img src="'.$helpicon.'" border="0"'
1309: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1310: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1311: .' /></a>';
1312: if ($text ne "") {
1313: $template.='</span>';
1314: }
1.44 bowersj2 1315: return $template;
1316:
1.106 bowersj2 1317: }
1318:
1319: # This is a quicky function for Latex cheatsheet editing, since it
1320: # appears in at least four places
1321: sub helpLatexCheatsheet {
1.1037 www 1322: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1323: my $out;
1.106 bowersj2 1324: my $addOther = '';
1.732 raeburn 1325: if ($topic) {
1.1037 www 1326: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1327: }
1328: $out = '<span>' # Start cheatsheet
1329: .$addOther
1330: .'<span>'
1.1037 www 1331: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1332: .'</span> <span>'
1.1037 www 1333: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1334: .'</span>';
1.732 raeburn 1335: unless ($not_author) {
1.1186 kruse 1336: $out .= '<span>'
1337: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1338: .'</span> <span>'
1339: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1340: .'</span>';
1.732 raeburn 1341: }
1.763 bisitz 1342: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1343: return $out;
1.172 www 1344: }
1345:
1.430 albertel 1346: sub general_help {
1347: my $helptopic='Student_Intro';
1348: if ($env{'request.role'}=~/^(ca|au)/) {
1349: $helptopic='Authoring_Intro';
1.907 raeburn 1350: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1351: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1352: } elsif ($env{'request.role'}=~/^dc/) {
1353: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1354: }
1355: return $helptopic;
1356: }
1357:
1358: sub update_help_link {
1359: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1360: my $origurl = $ENV{'REQUEST_URI'};
1361: $origurl=~s|^/~|/priv/|;
1362: my $timestamp = time;
1363: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1364: $$datum = &escape($$datum);
1365: }
1366:
1367: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1368: my $output .= <<"ENDOUTPUT";
1369: <script type="text/javascript">
1.824 bisitz 1370: // <![CDATA[
1.430 albertel 1371: banner_link = '$banner_link';
1.824 bisitz 1372: // ]]>
1.430 albertel 1373: </script>
1374: ENDOUTPUT
1375: return $output;
1376: }
1377:
1378: # now just updates the help link and generates a blue icon
1.193 raeburn 1379: sub help_open_menu {
1.430 albertel 1380: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1381: = @_;
1.949 droeschl 1382: $stayOnPage = 1;
1.430 albertel 1383: my $output;
1384: if ($component_help) {
1385: if (!$text) {
1386: $output=&help_open_topic($component_help,undef,$stayOnPage,
1387: $width,$height);
1388: } else {
1389: my $help_text;
1390: $help_text=&unescape($topic);
1391: $output='<table><tr><td>'.
1392: &help_open_topic($component_help,$help_text,$stayOnPage,
1393: $width,$height).'</td></tr></table>';
1394: }
1395: }
1396: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1397: return $output.$banner_link;
1398: }
1399:
1400: sub top_nav_help {
1401: my ($text) = @_;
1.436 albertel 1402: $text = &mt($text);
1.949 droeschl 1403: my $stay_on_page = 1;
1404:
1.1168 raeburn 1405: my ($link,$banner_link);
1406: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1407: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1408: : "javascript:helpMenu('open')";
1409: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1410: }
1.201 raeburn 1411: my $title = &mt('Get help');
1.1168 raeburn 1412: if ($link) {
1413: return <<"END";
1.436 albertel 1414: $banner_link
1.1159 raeburn 1415: <a href="$link" title="$title">$text</a>
1.436 albertel 1416: END
1.1168 raeburn 1417: } else {
1418: return ' '.$text.' ';
1419: }
1.436 albertel 1420: }
1421:
1422: sub help_menu_js {
1.1154 raeburn 1423: my ($httphost) = @_;
1.949 droeschl 1424: my $stayOnPage = 1;
1.436 albertel 1425: my $width = 620;
1426: my $height = 600;
1.430 albertel 1427: my $helptopic=&general_help();
1.1154 raeburn 1428: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1429: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1430: my $start_page =
1431: &Apache::loncommon::start_page('Help Menu', undef,
1432: {'frameset' => 1,
1433: 'js_ready' => 1,
1.1154 raeburn 1434: 'use_absolute' => $httphost,
1.331 albertel 1435: 'add_entries' => {
1.1168 raeburn 1436: 'border' => '0',
1.579 raeburn 1437: 'rows' => "110,*",},});
1.331 albertel 1438: my $end_page =
1439: &Apache::loncommon::end_page({'frameset' => 1,
1440: 'js_ready' => 1,});
1441:
1.436 albertel 1442: my $template .= <<"ENDTEMPLATE";
1443: <script type="text/javascript">
1.877 bisitz 1444: // <![CDATA[
1.253 albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1446: var banner_link = '';
1.243 raeburn 1447: function helpMenu(target) {
1448: var caller = this;
1449: if (target == 'open') {
1450: var newWindow = null;
1451: try {
1.262 albertel 1452: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1453: }
1454: catch(error) {
1455: writeHelp(caller);
1456: return;
1457: }
1458: if (newWindow) {
1459: caller = newWindow;
1460: }
1.193 raeburn 1461: }
1.243 raeburn 1462: writeHelp(caller);
1463: return;
1464: }
1465: function writeHelp(caller) {
1.1168 raeburn 1466: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1467: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1468: caller.document.close();
1469: caller.focus();
1.193 raeburn 1470: }
1.877 bisitz 1471: // END LON-CAPA Internal -->
1.253 albertel 1472: // ]]>
1.436 albertel 1473: </script>
1.193 raeburn 1474: ENDTEMPLATE
1475: return $template;
1476: }
1477:
1.172 www 1478: sub help_open_bug {
1479: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1480: unless ($env{'user.adv'}) { return ''; }
1.172 www 1481: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1482: $text = "" if (not defined $text);
1483: $stayOnPage=1;
1.184 albertel 1484: $width = 600 if (not defined $width);
1485: $height = 600 if (not defined $height);
1.172 www 1486:
1487: $topic=~s/\W+/\+/g;
1488: my $link='';
1489: my $template='';
1.379 albertel 1490: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1491: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1492: if (!$stayOnPage)
1493: {
1494: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1495: }
1496: else
1497: {
1498: $link = $url;
1499: }
1500: # Add the text
1501: if ($text ne "")
1502: {
1503: $template .=
1504: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1505: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1506: }
1507:
1508: # Add the graphic
1.179 matthew 1509: my $title = &mt('Report a Bug');
1.215 albertel 1510: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1511: $template .= <<"ENDTEMPLATE";
1.436 albertel 1512: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1513: ENDTEMPLATE
1514: if ($text ne '') { $template.='</td></tr></table>' };
1515: return $template;
1516:
1517: }
1518:
1519: sub help_open_faq {
1520: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1521: unless ($env{'user.adv'}) { return ''; }
1.172 www 1522: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1523: $text = "" if (not defined $text);
1524: $stayOnPage=1;
1525: $width = 350 if (not defined $width);
1526: $height = 400 if (not defined $height);
1527:
1528: $topic=~s/\W+/\+/g;
1529: my $link='';
1530: my $template='';
1531: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1532: if (!$stayOnPage)
1533: {
1534: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1535: }
1536: else
1537: {
1538: $link = $url;
1539: }
1540:
1541: # Add the text
1542: if ($text ne "")
1543: {
1544: $template .=
1.173 www 1545: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1546: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1547: }
1548:
1549: # Add the graphic
1.179 matthew 1550: my $title = &mt('View the FAQ');
1.215 albertel 1551: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1552: $template .= <<"ENDTEMPLATE";
1.436 albertel 1553: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1554: ENDTEMPLATE
1555: if ($text ne '') { $template.='</td></tr></table>' };
1556: return $template;
1557:
1.44 bowersj2 1558: }
1.37 matthew 1559:
1.180 matthew 1560: ###############################################################
1561: ###############################################################
1562:
1.45 matthew 1563: =pod
1564:
1.648 raeburn 1565: =item * &change_content_javascript():
1.256 matthew 1566:
1567: This and the next function allow you to create small sections of an
1568: otherwise static HTML page that you can update on the fly with
1569: Javascript, even in Netscape 4.
1570:
1571: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1572: must be written to the HTML page once. It will prove the Javascript
1573: function "change(name, content)". Calling the change function with the
1574: name of the section
1575: you want to update, matching the name passed to C<changable_area>, and
1576: the new content you want to put in there, will put the content into
1577: that area.
1578:
1579: B<Note>: Netscape 4 only reserves enough space for the changable area
1580: to contain room for the original contents. You need to "make space"
1581: for whatever changes you wish to make, and be B<sure> to check your
1582: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1583: it's adequate for updating a one-line status display, but little more.
1584: This script will set the space to 100% width, so you only need to
1585: worry about height in Netscape 4.
1586:
1587: Modern browsers are much less limiting, and if you can commit to the
1588: user not using Netscape 4, this feature may be used freely with
1589: pretty much any HTML.
1590:
1591: =cut
1592:
1593: sub change_content_javascript {
1594: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1595: if ($env{'browser.type'} eq 'netscape' &&
1596: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1597: return (<<NETSCAPE4);
1598: function change(name, content) {
1599: doc = document.layers[name+"___escape"].layers[0].document;
1600: doc.open();
1601: doc.write(content);
1602: doc.close();
1603: }
1604: NETSCAPE4
1605: } else {
1606: # Otherwise, we need to use semi-standards-compliant code
1607: # (technically, "innerHTML" isn't standard but the equivalent
1608: # is really scary, and every useful browser supports it
1609: return (<<DOMBASED);
1610: function change(name, content) {
1611: element = document.getElementById(name);
1612: element.innerHTML = content;
1613: }
1614: DOMBASED
1615: }
1616: }
1617:
1618: =pod
1619:
1.648 raeburn 1620: =item * &changable_area($name,$origContent):
1.256 matthew 1621:
1622: This provides a "changable area" that can be modified on the fly via
1623: the Javascript code provided in C<change_content_javascript>. $name is
1624: the name you will use to reference the area later; do not repeat the
1625: same name on a given HTML page more then once. $origContent is what
1626: the area will originally contain, which can be left blank.
1627:
1628: =cut
1629:
1630: sub changable_area {
1631: my ($name, $origContent) = @_;
1632:
1.258 albertel 1633: if ($env{'browser.type'} eq 'netscape' &&
1634: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1635: # If this is netscape 4, we need to use the Layer tag
1636: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1637: } else {
1638: return "<span id='$name'>$origContent</span>";
1639: }
1640: }
1641:
1642: =pod
1643:
1.648 raeburn 1644: =item * &viewport_geometry_js
1.590 raeburn 1645:
1646: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1647:
1648: =cut
1649:
1650:
1651: sub viewport_geometry_js {
1652: return <<"GEOMETRY";
1653: var Geometry = {};
1654: function init_geometry() {
1655: if (Geometry.init) { return };
1656: Geometry.init=1;
1657: if (window.innerHeight) {
1658: Geometry.getViewportHeight = function() { return window.innerHeight; };
1659: Geometry.getViewportWidth = function() { return window.innerWidth; };
1660: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1661: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1662: }
1663: else if (document.documentElement && document.documentElement.clientHeight) {
1664: Geometry.getViewportHeight =
1665: function() { return document.documentElement.clientHeight; };
1666: Geometry.getViewportWidth =
1667: function() { return document.documentElement.clientWidth; };
1668:
1669: Geometry.getHorizontalScroll =
1670: function() { return document.documentElement.scrollLeft; };
1671: Geometry.getVerticalScroll =
1672: function() { return document.documentElement.scrollTop; };
1673: }
1674: else if (document.body.clientHeight) {
1675: Geometry.getViewportHeight =
1676: function() { return document.body.clientHeight; };
1677: Geometry.getViewportWidth =
1678: function() { return document.body.clientWidth; };
1679: Geometry.getHorizontalScroll =
1680: function() { return document.body.scrollLeft; };
1681: Geometry.getVerticalScroll =
1682: function() { return document.body.scrollTop; };
1683: }
1684: }
1685:
1686: GEOMETRY
1687: }
1688:
1689: =pod
1690:
1.648 raeburn 1691: =item * &viewport_size_js()
1.590 raeburn 1692:
1693: 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.
1694:
1695: =cut
1696:
1697: sub viewport_size_js {
1698: my $geometry = &viewport_geometry_js();
1699: return <<"DIMS";
1700:
1701: $geometry
1702:
1703: function getViewportDims(width,height) {
1704: init_geometry();
1705: width.value = Geometry.getViewportWidth();
1706: height.value = Geometry.getViewportHeight();
1707: return;
1708: }
1709:
1710: DIMS
1711: }
1712:
1713: =pod
1714:
1.648 raeburn 1715: =item * &resize_textarea_js()
1.565 albertel 1716:
1717: emits the needed javascript to resize a textarea to be as big as possible
1718:
1719: creates a function resize_textrea that takes two IDs first should be
1720: the id of the element to resize, second should be the id of a div that
1721: surrounds everything that comes after the textarea, this routine needs
1722: to be attached to the <body> for the onload and onresize events.
1723:
1.648 raeburn 1724: =back
1.565 albertel 1725:
1726: =cut
1727:
1728: sub resize_textarea_js {
1.590 raeburn 1729: my $geometry = &viewport_geometry_js();
1.565 albertel 1730: return <<"RESIZE";
1731: <script type="text/javascript">
1.824 bisitz 1732: // <![CDATA[
1.590 raeburn 1733: $geometry
1.565 albertel 1734:
1.588 albertel 1735: function getX(element) {
1736: var x = 0;
1737: while (element) {
1738: x += element.offsetLeft;
1739: element = element.offsetParent;
1740: }
1741: return x;
1742: }
1743: function getY(element) {
1744: var y = 0;
1745: while (element) {
1746: y += element.offsetTop;
1747: element = element.offsetParent;
1748: }
1749: return y;
1750: }
1751:
1752:
1.565 albertel 1753: function resize_textarea(textarea_id,bottom_id) {
1754: init_geometry();
1755: var textarea = document.getElementById(textarea_id);
1756: //alert(textarea);
1757:
1.588 albertel 1758: var textarea_top = getY(textarea);
1.565 albertel 1759: var textarea_height = textarea.offsetHeight;
1760: var bottom = document.getElementById(bottom_id);
1.588 albertel 1761: var bottom_top = getY(bottom);
1.565 albertel 1762: var bottom_height = bottom.offsetHeight;
1763: var window_height = Geometry.getViewportHeight();
1.588 albertel 1764: var fudge = 23;
1.565 albertel 1765: var new_height = window_height-fudge-textarea_top-bottom_height;
1766: if (new_height < 300) {
1767: new_height = 300;
1768: }
1769: textarea.style.height=new_height+'px';
1770: }
1.824 bisitz 1771: // ]]>
1.565 albertel 1772: </script>
1773: RESIZE
1774:
1775: }
1776:
1.1205 golterma 1777: sub colorfuleditor_js {
1.1248 raeburn 1778: my $browse_or_search;
1779: my $respath;
1780: my ($cnum,$cdom) = &crsauthor_url();
1781: if ($cnum) {
1782: $respath = "/res/$cdom/$cnum/";
1783: my %js_lt = &Apache::lonlocal::texthash(
1784: sunm => 'Sub-directory name',
1785: save => 'Save page to make this permanent',
1786: );
1787: &js_escape(\%js_lt);
1788: $browse_or_search = <<"END";
1789:
1790: function toggleChooser(form,element,titleid,only,search) {
1791: var disp = 'none';
1792: if (document.getElementById('chooser_'+element)) {
1793: var curr = document.getElementById('chooser_'+element).style.display;
1794: if (curr == 'none') {
1795: disp='inline';
1796: if (form.elements['chooser_'+element].length) {
1797: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1798: form.elements['chooser_'+element][i].checked = false;
1799: }
1800: }
1801: toggleResImport(form,element);
1802: }
1803: document.getElementById('chooser_'+element).style.display = disp;
1804: }
1805: }
1806:
1807: function toggleCrsFile(form,element,numdirs) {
1808: if (document.getElementById('chooser_'+element+'_crsres')) {
1809: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1810: if (curr == 'none') {
1811: if (numdirs) {
1812: form.elements['coursepath_'+element].selectedIndex = 0;
1813: if (numdirs > 1) {
1814: window['select1'+element+'_changed']();
1815: }
1816: }
1817: }
1818: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1819:
1820: }
1821: if (document.getElementById('chooser_'+element+'_upload')) {
1822: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1823: if (document.getElementById('uploadcrsres_'+element)) {
1824: document.getElementById('uploadcrsres_'+element).value = '';
1825: }
1826: }
1827: return;
1828: }
1829:
1830: function toggleCrsUpload(form,element,numcrsdirs) {
1831: if (document.getElementById('chooser_'+element+'_crsres')) {
1832: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1833: }
1834: if (document.getElementById('chooser_'+element+'_upload')) {
1835: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1836: if (curr == 'none') {
1837: if (numcrsdirs) {
1838: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1839: form.elements['newsubdir_'+element][0].checked = true;
1840: toggleNewsubdir(form,element);
1841: }
1842: }
1843: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1844: }
1845: return;
1846: }
1847:
1848: function toggleResImport(form,element) {
1849: var choices = new Array('crsres','upload');
1850: for (var i=0; i<choices.length; i++) {
1851: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1852: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1853: }
1854: }
1855: }
1856:
1857: function toggleNewsubdir(form,element) {
1858: var newsub = form.elements['newsubdir_'+element];
1859: if (newsub) {
1860: if (newsub.length) {
1861: for (var j=0; j<newsub.length; j++) {
1862: if (newsub[j].checked) {
1863: if (document.getElementById('newsubdirname_'+element)) {
1864: if (newsub[j].value == '1') {
1865: document.getElementById('newsubdirname_'+element).type = "text";
1866: if (document.getElementById('newsubdir_'+element)) {
1867: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1868: }
1869: } else {
1870: document.getElementById('newsubdirname_'+element).type = "hidden";
1871: document.getElementById('newsubdirname_'+element).value = "";
1872: document.getElementById('newsubdir_'+element).innerHTML = "";
1873: }
1874: }
1875: break;
1876: }
1877: }
1878: }
1879: }
1880: }
1881:
1882: function updateCrsFile(form,element) {
1883: var directory = form.elements['coursepath_'+element];
1884: var filename = form.elements['coursefile_'+element];
1885: var path = directory.options[directory.selectedIndex].value;
1886: var file = filename.options[filename.selectedIndex].value;
1887: form.elements[element].value = '$respath';
1888: if (path == '/') {
1889: form.elements[element].value += file;
1890: } else {
1891: form.elements[element].value += path+'/'+file;
1892: }
1893: unClean();
1894: if (document.getElementById('previewimg_'+element)) {
1895: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1896: var newsrc = document.getElementById('previewimg_'+element).src;
1897: }
1898: if (document.getElementById('showimg_'+element)) {
1899: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1900: }
1901: toggleChooser(form,element);
1902: return;
1903: }
1904:
1905: function uploadDone(suffix,name) {
1906: if (name) {
1907: document.forms["lonhomework"].elements[suffix].value = name;
1908: unClean();
1909: toggleChooser(document.forms["lonhomework"],suffix);
1910: }
1911: }
1912:
1913: \$(document).ready(function(){
1914:
1915: \$(document).delegate('form :submit', 'click', function( event ) {
1916: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1917: var buttonId = this.id;
1918: var suffix = buttonId.toString();
1919: suffix = suffix.replace(/^crsupload_/,'');
1920: event.preventDefault();
1921: document.lonhomework.target = 'crsupload_target_'+suffix;
1922: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1923: \$(this.form).submit();
1924: document.lonhomework.target = '';
1925: if (document.getElementById('crsuploadto_'+suffix)) {
1926: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1927: }
1928: return false;
1929: }
1930: });
1931: });
1932: END
1933: }
1.1205 golterma 1934: return <<"COLORFULEDIT"
1935: <script type="text/javascript">
1936: // <![CDATA[>
1937: function fold_box(curDepth, lastresource){
1938:
1939: // we need a list because there can be several blocks you need to fold in one tag
1940: var block = document.getElementsByName('foldblock_'+curDepth);
1941: // but there is only one folding button per tag
1942: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1943:
1944: if(block.item(0).style.display == 'none'){
1945:
1946: foldbutton.value = '@{[&mt("Hide")]}';
1947: for (i = 0; i < block.length; i++){
1948: block.item(i).style.display = '';
1949: }
1950: }else{
1951:
1952: foldbutton.value = '@{[&mt("Show")]}';
1953: for (i = 0; i < block.length; i++){
1954: // block.item(i).style.visibility = 'collapse';
1955: block.item(i).style.display = 'none';
1956: }
1957: };
1958: saveState(lastresource);
1959: }
1960:
1961: function saveState (lastresource) {
1962:
1963: var tag_list = getTagList();
1964: if(tag_list != null){
1965: var timestamp = new Date().getTime();
1966: var key = lastresource;
1967:
1968: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1969: // starting with timestamp
1970: var value = timestamp+';';
1971:
1972: // building the list of key-value pairs
1973: for(var i = 0; i < tag_list.length; i++){
1974: value += tag_list[i]+',';
1975: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1976: }
1977:
1978: // only iterate whole storage if nothing to override
1979: if(localStorage.getItem(key) == null){
1980:
1981: // prevent storage from growing large
1982: if(localStorage.length > 50){
1983: var regex_getTimestamp = /^(?:\d)+;/;
1984: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1985: var oldest_key;
1986:
1987: for(var i = 1; i < localStorage.length; i++){
1988: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1989: oldest_key = localStorage.key(i);
1990: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1991: }
1992: }
1993: localStorage.removeItem(oldest_key);
1994: }
1995: }
1996: localStorage.setItem(key,value);
1997: }
1998: }
1999:
2000: // restore folding status of blocks (on page load)
2001: function restoreState (lastresource) {
2002: if(localStorage.getItem(lastresource) != null){
2003: var key = lastresource;
2004: var value = localStorage.getItem(key);
2005: var regex_delTimestamp = /^\d+;/;
2006:
2007: value.replace(regex_delTimestamp, '');
2008:
2009: var valueArr = value.split(';');
2010: var pairs;
2011: var elements;
2012: for (var i = 0; i < valueArr.length; i++){
2013: pairs = valueArr[i].split(',');
2014: elements = document.getElementsByName(pairs[0]);
2015:
2016: for (var j = 0; j < elements.length; j++){
2017: elements[j].style.display = pairs[1];
2018: if (pairs[1] == "none"){
2019: var regex_id = /([_\\d]+)\$/;
2020: regex_id.exec(pairs[0]);
2021: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2022: }
2023: }
2024: }
2025: }
2026: }
2027:
2028: function getTagList () {
2029:
2030: var stringToSearch = document.lonhomework.innerHTML;
2031:
2032: var ret = new Array();
2033: var regex_findBlock = /(foldblock_.*?)"/g;
2034: var tag_list = stringToSearch.match(regex_findBlock);
2035:
2036: if(tag_list != null){
2037: for(var i = 0; i < tag_list.length; i++){
2038: ret.push(tag_list[i].replace(/"/, ''));
2039: }
2040: }
2041: return ret;
2042: }
2043:
2044: function saveScrollPosition (resource) {
2045: var tag_list = getTagList();
2046:
2047: // we dont always want to jump to the first block
2048: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2049: if(\$(window).scrollTop() > 170){
2050: if(tag_list != null){
2051: var result;
2052: for(var i = 0; i < tag_list.length; i++){
2053: if(isElementInViewport(tag_list[i])){
2054: result += tag_list[i]+';';
2055: }
2056: }
2057: sessionStorage.setItem('anchor_'+resource, result);
2058: }
2059: } else {
2060: // we dont need to save zero, just delete the item to leave everything tidy
2061: sessionStorage.removeItem('anchor_'+resource);
2062: }
2063: }
2064:
2065: function restoreScrollPosition(resource){
2066:
2067: var elem = sessionStorage.getItem('anchor_'+resource);
2068: if(elem != null){
2069: var tag_list = elem.split(';');
2070: var elem_list;
2071:
2072: for(var i = 0; i < tag_list.length; i++){
2073: elem_list = document.getElementsByName(tag_list[i]);
2074:
2075: if(elem_list.length > 0){
2076: elem = elem_list[0];
2077: break;
2078: }
2079: }
2080: elem.scrollIntoView();
2081: }
2082: }
2083:
2084: function isElementInViewport(el) {
2085:
2086: // change to last element instead of first
2087: var elem = document.getElementsByName(el);
2088: var rect = elem[0].getBoundingClientRect();
2089:
2090: return (
2091: rect.top >= 0 &&
2092: rect.left >= 0 &&
2093: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2094: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2095: );
2096: }
2097:
2098: function autosize(depth){
2099: var cmInst = window['cm'+depth];
2100: var fitsizeButton = document.getElementById('fitsize'+depth);
2101:
2102: // is fixed size, switching to dynamic
2103: if (sessionStorage.getItem("autosized_"+depth) == null) {
2104: cmInst.setSize("","auto");
2105: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2106: sessionStorage.setItem("autosized_"+depth, "yes");
2107:
2108: // is dynamic size, switching to fixed
2109: } else {
2110: cmInst.setSize("","300px");
2111: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2112: sessionStorage.removeItem("autosized_"+depth);
2113: }
2114: }
2115:
1.1248 raeburn 2116: $browse_or_search
1.1205 golterma 2117:
2118: // ]]>
2119: </script>
2120: COLORFULEDIT
2121: }
2122:
2123: sub xmleditor_js {
2124: return <<XMLEDIT
2125: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2126: <script type="text/javascript">
2127: // <![CDATA[>
2128:
2129: function saveScrollPosition (resource) {
2130:
2131: var scrollPos = \$(window).scrollTop();
2132: sessionStorage.setItem(resource,scrollPos);
2133: }
2134:
2135: function restoreScrollPosition(resource){
2136:
2137: var scrollPos = sessionStorage.getItem(resource);
2138: \$(window).scrollTop(scrollPos);
2139: }
2140:
2141: // unless internet explorer
2142: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2143:
2144: \$(document).ready(function() {
2145: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2146: });
2147: }
2148:
2149: // inserts text at cursor position into codemirror (xml editor only)
2150: function insertText(text){
2151: cm.focus();
2152: var curPos = cm.getCursor();
2153: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2154: }
2155: // ]]>
2156: </script>
2157: XMLEDIT
2158: }
2159:
2160: sub insert_folding_button {
2161: my $curDepth = $Apache::lonxml::curdepth;
2162: my $lastresource = $env{'request.ambiguous'};
2163:
2164: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2165: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2166: }
2167:
1.1248 raeburn 2168: sub crsauthor_url {
2169: my ($url) = @_;
2170: if ($url eq '') {
2171: $url = $ENV{'REQUEST_URI'};
2172: }
2173: my ($cnum,$cdom);
2174: if ($env{'request.course.id'}) {
2175: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2176: if ($audom ne '' && $auname ne '') {
2177: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2178: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2179: $cnum = $auname;
2180: $cdom = $audom;
2181: }
2182: }
2183: }
2184: return ($cnum,$cdom);
2185: }
2186:
2187: sub import_crsauthor_form {
2188: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix) = @_;
2189: return (0) unless ($env{'request.course.id'});
2190: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2191: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2192: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2193: return (0) unless (($cnum ne '') && ($cdom ne ''));
2194: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2195: my @ids=&Apache::lonnet::current_machine_ids();
2196: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2197:
2198: if (grep(/^\Q$crshome\E$/,@ids)) {
2199: $is_home = 1;
2200: }
2201: $relpath = "/priv/$cdom/$cnum";
2202: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2203: my %lt = &Apache::lonlocal::texthash (
2204: fnam => 'Filename',
2205: dire => 'Directory',
2206: );
2207: my $numdirs = scalar(keys(%files));
2208: my (%possexts,$singledir,@singledirfiles);
2209: if ($only) {
2210: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2211: }
2212: my (%nonemptydirs,$possdirs);
2213: if ($numdirs > 1) {
2214: my @order;
2215: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2216: if (ref($files{$key}) eq 'HASH') {
2217: my $shown = $key;
2218: if ($key eq '') {
2219: $shown = '/';
2220: }
2221: my @ordered = ();
2222: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
2223: if ($only) {
2224: my ($ext) = ($file =~ /\.([^.]+)$/);
2225: unless ($possexts{lc($ext)}) {
2226: next;
2227: }
2228: }
2229: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2230: push(@ordered,$file);
2231: }
2232: if (@ordered) {
2233: push(@order,$key);
2234: $nonemptydirs{$key} = 1;
2235: $selimport_menus{$key}->{'text'} = $shown;
2236: $selimport_menus{$key}->{'default'} = '';
2237: $selimport_menus{$key}->{'select2'}->{''} = '';
2238: $selimport_menus{$key}->{'order'} = \@ordered;
2239: }
2240: }
2241: }
2242: $possdirs = scalar(keys(%nonemptydirs));
2243: if ($possdirs > 1) {
2244: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2245: $output = $lt{'dire'}.
2246: &linked_select_forms($form,'<br />'.
2247: $lt{'fnam'},'',
2248: $firstselectname,$secondselectname,
2249: \%selimport_menus,\@order,
2250: $onchangefirst,'',$suffix).'<br />';
2251: } elsif ($possdirs == 1) {
2252: $singledir = (keys(%nonemptydirs))[0];
2253: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2254: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2255: }
2256: delete($selimport_menus{$singledir});
2257: }
2258: } elsif ($numdirs == 1) {
2259: $singledir = (keys(%files))[0];
2260: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2261: if ($only) {
2262: my ($ext) = ($file =~ /\.([^.]+)$/);
2263: unless ($possexts{lc($ext)}) {
2264: next;
2265: }
2266: }
2267: push(@singledirfiles,$file);
2268: }
2269: if (@singledirfiles) {
2270: $possdirs == 1;
2271: }
2272: }
2273: if (($possdirs == 1) && (@singledirfiles)) {
2274: my $showdir = $singledir;
2275: if ($singledir eq '') {
2276: $showdir = '/';
2277: }
2278: $output = $lt{'dire'}.
2279: '<select name="'.$firstselectname.'">'.
2280: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2281: '</select><br />'.
2282: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2283: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2284: foreach my $file (@singledirfiles) {
2285: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2286: }
2287: $output .= '</select><br />'."\n";
2288: }
2289: return ($possdirs,$output);
2290: }
2291:
1.565 albertel 2292: =pod
2293:
1.256 matthew 2294: =head1 Excel and CSV file utility routines
2295:
2296: =cut
2297:
2298: ###############################################################
2299: ###############################################################
2300:
2301: =pod
2302:
1.1162 raeburn 2303: =over 4
2304:
1.648 raeburn 2305: =item * &csv_translate($text)
1.37 matthew 2306:
1.185 www 2307: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2308: format.
2309:
2310: =cut
2311:
1.180 matthew 2312: ###############################################################
2313: ###############################################################
1.37 matthew 2314: sub csv_translate {
2315: my $text = shift;
2316: $text =~ s/\"/\"\"/g;
1.209 albertel 2317: $text =~ s/\n/ /g;
1.37 matthew 2318: return $text;
2319: }
1.180 matthew 2320:
2321: ###############################################################
2322: ###############################################################
2323:
2324: =pod
2325:
1.648 raeburn 2326: =item * &define_excel_formats()
1.180 matthew 2327:
2328: Define some commonly used Excel cell formats.
2329:
2330: Currently supported formats:
2331:
2332: =over 4
2333:
2334: =item header
2335:
2336: =item bold
2337:
2338: =item h1
2339:
2340: =item h2
2341:
2342: =item h3
2343:
1.256 matthew 2344: =item h4
2345:
2346: =item i
2347:
1.180 matthew 2348: =item date
2349:
2350: =back
2351:
2352: Inputs: $workbook
2353:
2354: Returns: $format, a hash reference.
2355:
1.1057 foxr 2356:
1.180 matthew 2357: =cut
2358:
2359: ###############################################################
2360: ###############################################################
2361: sub define_excel_formats {
2362: my ($workbook) = @_;
2363: my $format;
2364: $format->{'header'} = $workbook->add_format(bold => 1,
2365: bottom => 1,
2366: align => 'center');
2367: $format->{'bold'} = $workbook->add_format(bold=>1);
2368: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2369: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2370: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2371: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2372: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2373: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2374: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2375: return $format;
2376: }
2377:
2378: ###############################################################
2379: ###############################################################
1.113 bowersj2 2380:
2381: =pod
2382:
1.648 raeburn 2383: =item * &create_workbook()
1.255 matthew 2384:
2385: Create an Excel worksheet. If it fails, output message on the
2386: request object and return undefs.
2387:
2388: Inputs: Apache request object
2389:
2390: Returns (undef) on failure,
2391: Excel worksheet object, scalar with filename, and formats
2392: from &Apache::loncommon::define_excel_formats on success
2393:
2394: =cut
2395:
2396: ###############################################################
2397: ###############################################################
2398: sub create_workbook {
2399: my ($r) = @_;
2400: #
2401: # Create the excel spreadsheet
2402: my $filename = '/prtspool/'.
1.258 albertel 2403: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2404: time.'_'.rand(1000000000).'.xls';
2405: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2406: if (! defined($workbook)) {
2407: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2408: $r->print(
2409: '<p class="LC_error">'
2410: .&mt('Problems occurred in creating the new Excel file.')
2411: .' '.&mt('This error has been logged.')
2412: .' '.&mt('Please alert your LON-CAPA administrator.')
2413: .'</p>'
2414: );
1.255 matthew 2415: return (undef);
2416: }
2417: #
1.1014 foxr 2418: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2419: #
2420: my $format = &Apache::loncommon::define_excel_formats($workbook);
2421: return ($workbook,$filename,$format);
2422: }
2423:
2424: ###############################################################
2425: ###############################################################
2426:
2427: =pod
2428:
1.648 raeburn 2429: =item * &create_text_file()
1.113 bowersj2 2430:
1.542 raeburn 2431: Create a file to write to and eventually make available to the user.
1.256 matthew 2432: If file creation fails, outputs an error message on the request object and
2433: return undefs.
1.113 bowersj2 2434:
1.256 matthew 2435: Inputs: Apache request object, and file suffix
1.113 bowersj2 2436:
1.256 matthew 2437: Returns (undef) on failure,
2438: Filehandle and filename on success.
1.113 bowersj2 2439:
2440: =cut
2441:
1.256 matthew 2442: ###############################################################
2443: ###############################################################
2444: sub create_text_file {
2445: my ($r,$suffix) = @_;
2446: if (! defined($suffix)) { $suffix = 'txt'; };
2447: my $fh;
2448: my $filename = '/prtspool/'.
1.258 albertel 2449: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2450: time.'_'.rand(1000000000).'.'.$suffix;
2451: $fh = Apache::File->new('>/home/httpd'.$filename);
2452: if (! defined($fh)) {
2453: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2454: $r->print(
2455: '<p class="LC_error">'
2456: .&mt('Problems occurred in creating the output file.')
2457: .' '.&mt('This error has been logged.')
2458: .' '.&mt('Please alert your LON-CAPA administrator.')
2459: .'</p>'
2460: );
1.113 bowersj2 2461: }
1.256 matthew 2462: return ($fh,$filename)
1.113 bowersj2 2463: }
2464:
2465:
1.256 matthew 2466: =pod
1.113 bowersj2 2467:
2468: =back
2469:
2470: =cut
1.37 matthew 2471:
2472: ###############################################################
1.33 matthew 2473: ## Home server <option> list generating code ##
2474: ###############################################################
1.35 matthew 2475:
1.169 www 2476: # ------------------------------------------
2477:
2478: sub domain_select {
2479: my ($name,$value,$multiple)=@_;
2480: my %domains=map {
1.514 albertel 2481: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2482: } &Apache::lonnet::all_domains();
1.169 www 2483: if ($multiple) {
2484: $domains{''}=&mt('Any domain');
1.550 albertel 2485: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2486: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2487: } else {
1.550 albertel 2488: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2489: return &select_form($name,$value,\%domains);
1.169 www 2490: }
2491: }
2492:
1.282 albertel 2493: #-------------------------------------------
2494:
2495: =pod
2496:
1.519 raeburn 2497: =head1 Routines for form select boxes
2498:
2499: =over 4
2500:
1.648 raeburn 2501: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2502:
2503: Returns a string containing a <select> element int multiple mode
2504:
2505:
2506: Args:
2507: $name - name of the <select> element
1.506 raeburn 2508: $value - scalar or array ref of values that should already be selected
1.282 albertel 2509: $size - number of rows long the select element is
1.283 albertel 2510: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2511: (shown text should already have been &mt())
1.506 raeburn 2512: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2513:
1.282 albertel 2514: =cut
2515:
2516: #-------------------------------------------
1.169 www 2517: sub multiple_select_form {
1.284 albertel 2518: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2519: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2520: my $output='';
1.191 matthew 2521: if (! defined($size)) {
2522: $size = 4;
1.283 albertel 2523: if (scalar(keys(%$hash))<4) {
2524: $size = scalar(keys(%$hash));
1.191 matthew 2525: }
2526: }
1.734 bisitz 2527: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2528: my @order;
1.506 raeburn 2529: if (ref($order) eq 'ARRAY') {
2530: @order = @{$order};
2531: } else {
2532: @order = sort(keys(%$hash));
1.501 banghart 2533: }
2534: if (exists($$hash{'select_form_order'})) {
2535: @order = @{$$hash{'select_form_order'}};
2536: }
2537:
1.284 albertel 2538: foreach my $key (@order) {
1.356 albertel 2539: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2540: $output.='selected="selected" ' if ($selected{$key});
2541: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2542: }
2543: $output.="</select>\n";
2544: return $output;
2545: }
2546:
1.88 www 2547: #-------------------------------------------
2548:
2549: =pod
2550:
1.1254 raeburn 2551: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2552:
2553: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2554: allow a user to select options from a ref to a hash containing:
2555: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2556: a javascript onchange item, e.g., onchange="this.form.submit();".
2557: An optional arg -- $readonly -- if true will cause the select form
2558: to be disabled, e.g., for the case where an instructor has a section-
2559: specific role, and is viewing/modifying parameters.
1.970 raeburn 2560:
1.88 www 2561: See lonrights.pm for an example invocation and use.
2562:
2563: =cut
2564:
2565: #-------------------------------------------
2566: sub select_form {
1.1228 raeburn 2567: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2568: return unless (ref($hashref) eq 'HASH');
2569: if ($onchange) {
2570: $onchange = ' onchange="'.$onchange.'"';
2571: }
1.1228 raeburn 2572: my $disabled;
2573: if ($readonly) {
2574: $disabled = ' disabled="disabled"';
2575: }
2576: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2577: my @keys;
1.970 raeburn 2578: if (exists($hashref->{'select_form_order'})) {
2579: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2580: } else {
1.970 raeburn 2581: @keys=sort(keys(%{$hashref}));
1.128 albertel 2582: }
1.356 albertel 2583: foreach my $key (@keys) {
2584: $selectform.=
2585: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2586: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2587: ">".$hashref->{$key}."</option>\n";
1.88 www 2588: }
2589: $selectform.="</select>";
2590: return $selectform;
2591: }
2592:
1.475 www 2593: # For display filters
2594:
2595: sub display_filter {
1.1074 raeburn 2596: my ($context) = @_;
1.475 www 2597: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2598: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2599: my $phraseinput = 'hidden';
2600: my $includeinput = 'hidden';
2601: my ($checked,$includetypestext);
2602: if ($env{'form.displayfilter'} eq 'containing') {
2603: $phraseinput = 'text';
2604: if ($context eq 'parmslog') {
2605: $includeinput = 'checkbox';
2606: if ($env{'form.includetypes'}) {
2607: $checked = ' checked="checked"';
2608: }
2609: $includetypestext = &mt('Include parameter types');
2610: }
2611: } else {
2612: $includetypestext = ' ';
2613: }
2614: my ($additional,$secondid,$thirdid);
2615: if ($context eq 'parmslog') {
2616: $additional =
2617: '<label><input type="'.$includeinput.'" name="includetypes"'.
2618: $checked.' name="includetypes" value="1" id="includetypes" />'.
2619: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2620: '</label>';
2621: $secondid = 'includetypes';
2622: $thirdid = 'includetypestext';
2623: }
2624: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2625: '$secondid','$thirdid')";
2626: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2627: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2628: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2629: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2630: &mt('Filter: [_1]',
1.477 www 2631: &select_form($env{'form.displayfilter'},
2632: 'displayfilter',
1.970 raeburn 2633: {'currentfolder' => 'Current folder/page',
1.477 www 2634: 'containing' => 'Containing phrase',
1.1074 raeburn 2635: 'none' => 'None'},$onchange)).' '.
2636: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2637: &HTML::Entities::encode($env{'form.containingphrase'}).
2638: '" />'.$additional;
2639: }
2640:
2641: sub display_filter_js {
2642: my $includetext = &mt('Include parameter types');
2643: return <<"ENDJS";
2644:
2645: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2646: var firstType = 'hidden';
2647: if (setter.options[setter.selectedIndex].value == 'containing') {
2648: firstType = 'text';
2649: }
2650: firstObject = document.getElementById(firstid);
2651: if (typeof(firstObject) == 'object') {
2652: if (firstObject.type != firstType) {
2653: changeInputType(firstObject,firstType);
2654: }
2655: }
2656: if (context == 'parmslog') {
2657: var secondType = 'hidden';
2658: if (firstType == 'text') {
2659: secondType = 'checkbox';
2660: }
2661: secondObject = document.getElementById(secondid);
2662: if (typeof(secondObject) == 'object') {
2663: if (secondObject.type != secondType) {
2664: changeInputType(secondObject,secondType);
2665: }
2666: }
2667: var textItem = document.getElementById(thirdid);
2668: var currtext = textItem.innerHTML;
2669: var newtext;
2670: if (firstType == 'text') {
2671: newtext = '$includetext';
2672: } else {
2673: newtext = ' ';
2674: }
2675: if (currtext != newtext) {
2676: textItem.innerHTML = newtext;
2677: }
2678: }
2679: return;
2680: }
2681:
2682: function changeInputType(oldObject,newType) {
2683: var newObject = document.createElement('input');
2684: newObject.type = newType;
2685: if (oldObject.size) {
2686: newObject.size = oldObject.size;
2687: }
2688: if (oldObject.value) {
2689: newObject.value = oldObject.value;
2690: }
2691: if (oldObject.name) {
2692: newObject.name = oldObject.name;
2693: }
2694: if (oldObject.id) {
2695: newObject.id = oldObject.id;
2696: }
2697: oldObject.parentNode.replaceChild(newObject,oldObject);
2698: return;
2699: }
2700:
2701: ENDJS
1.475 www 2702: }
2703:
1.167 www 2704: sub gradeleveldescription {
2705: my $gradelevel=shift;
2706: my %gradelevels=(0 => 'Not specified',
2707: 1 => 'Grade 1',
2708: 2 => 'Grade 2',
2709: 3 => 'Grade 3',
2710: 4 => 'Grade 4',
2711: 5 => 'Grade 5',
2712: 6 => 'Grade 6',
2713: 7 => 'Grade 7',
2714: 8 => 'Grade 8',
2715: 9 => 'Grade 9',
2716: 10 => 'Grade 10',
2717: 11 => 'Grade 11',
2718: 12 => 'Grade 12',
2719: 13 => 'Grade 13',
2720: 14 => '100 Level',
2721: 15 => '200 Level',
2722: 16 => '300 Level',
2723: 17 => '400 Level',
2724: 18 => 'Graduate Level');
2725: return &mt($gradelevels{$gradelevel});
2726: }
2727:
1.163 www 2728: sub select_level_form {
2729: my ($deflevel,$name)=@_;
2730: unless ($deflevel) { $deflevel=0; }
1.167 www 2731: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2732: for (my $i=0; $i<=18; $i++) {
2733: $selectform.="<option value=\"$i\" ".
1.253 albertel 2734: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2735: ">".&gradeleveldescription($i)."</option>\n";
2736: }
2737: $selectform.="</select>";
2738: return $selectform;
1.163 www 2739: }
1.167 www 2740:
1.35 matthew 2741: #-------------------------------------------
2742:
1.45 matthew 2743: =pod
2744:
1.1121 raeburn 2745: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2746:
2747: Returns a string containing a <select name='$name' size='1'> form to
2748: allow a user to select the domain to preform an operation in.
2749: See loncreateuser.pm for an example invocation and use.
2750:
1.90 www 2751: If the $includeempty flag is set, it also includes an empty choice ("no domain
2752: selected");
2753:
1.743 raeburn 2754: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2755:
1.910 raeburn 2756: 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.
2757:
1.1121 raeburn 2758: The optional $incdoms is a reference to an array of domains which will be the only available options.
2759:
2760: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2761:
1.35 matthew 2762: =cut
2763:
2764: #-------------------------------------------
1.34 matthew 2765: sub select_dom_form {
1.1121 raeburn 2766: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2767: if ($onchange) {
1.874 raeburn 2768: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2769: }
1.1121 raeburn 2770: my (@domains,%exclude);
1.910 raeburn 2771: if (ref($incdoms) eq 'ARRAY') {
2772: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2773: } else {
2774: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2775: }
1.90 www 2776: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2777: if (ref($excdoms) eq 'ARRAY') {
2778: map { $exclude{$_} = 1; } @{$excdoms};
2779: }
1.743 raeburn 2780: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2781: foreach my $dom (@domains) {
1.1121 raeburn 2782: next if ($exclude{$dom});
1.356 albertel 2783: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2784: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2785: if ($showdomdesc) {
2786: if ($dom ne '') {
2787: my $domdesc = &Apache::lonnet::domain($dom,'description');
2788: if ($domdesc ne '') {
2789: $selectdomain .= ' ('.$domdesc.')';
2790: }
2791: }
2792: }
2793: $selectdomain .= "</option>\n";
1.34 matthew 2794: }
2795: $selectdomain.="</select>";
2796: return $selectdomain;
2797: }
2798:
1.35 matthew 2799: #-------------------------------------------
2800:
1.45 matthew 2801: =pod
2802:
1.648 raeburn 2803: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2804:
1.586 raeburn 2805: input: 4 arguments (two required, two optional) -
2806: $domain - domain of new user
2807: $name - name of form element
2808: $default - Value of 'default' causes a default item to be first
2809: option, and selected by default.
2810: $hide - Value of 'hide' causes hiding of the name of the server,
2811: if 1 server found, or default, if 0 found.
1.594 raeburn 2812: output: returns 2 items:
1.586 raeburn 2813: (a) form element which contains either:
2814: (i) <select name="$name">
2815: <option value="$hostid1">$hostid $servers{$hostid}</option>
2816: <option value="$hostid2">$hostid $servers{$hostid}</option>
2817: </select>
2818: form item if there are multiple library servers in $domain, or
2819: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2820: if there is only one library server in $domain.
2821:
2822: (b) number of library servers found.
2823:
2824: See loncreateuser.pm for example of use.
1.35 matthew 2825:
2826: =cut
2827:
2828: #-------------------------------------------
1.586 raeburn 2829: sub home_server_form_item {
2830: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2831: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2832: my $result;
2833: my $numlib = keys(%servers);
2834: if ($numlib > 1) {
2835: $result .= '<select name="'.$name.'" />'."\n";
2836: if ($default) {
1.804 bisitz 2837: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2838: '</option>'."\n";
2839: }
2840: foreach my $hostid (sort(keys(%servers))) {
2841: $result.= '<option value="'.$hostid.'">'.
2842: $hostid.' '.$servers{$hostid}."</option>\n";
2843: }
2844: $result .= '</select>'."\n";
2845: } elsif ($numlib == 1) {
2846: my $hostid;
2847: foreach my $item (keys(%servers)) {
2848: $hostid = $item;
2849: }
2850: $result .= '<input type="hidden" name="'.$name.'" value="'.
2851: $hostid.'" />';
2852: if (!$hide) {
2853: $result .= $hostid.' '.$servers{$hostid};
2854: }
2855: $result .= "\n";
2856: } elsif ($default) {
2857: $result .= '<input type="hidden" name="'.$name.
2858: '" value="default" />';
2859: if (!$hide) {
2860: $result .= &mt('default');
2861: }
2862: $result .= "\n";
1.33 matthew 2863: }
1.586 raeburn 2864: return ($result,$numlib);
1.33 matthew 2865: }
1.112 bowersj2 2866:
2867: =pod
2868:
1.534 albertel 2869: =back
2870:
1.112 bowersj2 2871: =cut
1.87 matthew 2872:
2873: ###############################################################
1.112 bowersj2 2874: ## Decoding User Agent ##
1.87 matthew 2875: ###############################################################
2876:
2877: =pod
2878:
1.112 bowersj2 2879: =head1 Decoding the User Agent
2880:
2881: =over 4
2882:
2883: =item * &decode_user_agent()
1.87 matthew 2884:
2885: Inputs: $r
2886:
2887: Outputs:
2888:
2889: =over 4
2890:
1.112 bowersj2 2891: =item * $httpbrowser
1.87 matthew 2892:
1.112 bowersj2 2893: =item * $clientbrowser
1.87 matthew 2894:
1.112 bowersj2 2895: =item * $clientversion
1.87 matthew 2896:
1.112 bowersj2 2897: =item * $clientmathml
1.87 matthew 2898:
1.112 bowersj2 2899: =item * $clientunicode
1.87 matthew 2900:
1.112 bowersj2 2901: =item * $clientos
1.87 matthew 2902:
1.1137 raeburn 2903: =item * $clientmobile
2904:
1.1141 raeburn 2905: =item * $clientinfo
2906:
1.1194 raeburn 2907: =item * $clientosversion
2908:
1.87 matthew 2909: =back
2910:
1.157 matthew 2911: =back
2912:
1.87 matthew 2913: =cut
2914:
2915: ###############################################################
2916: ###############################################################
2917: sub decode_user_agent {
1.247 albertel 2918: my ($r)=@_;
1.87 matthew 2919: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2920: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2921: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2922: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2923: my $clientbrowser='unknown';
2924: my $clientversion='0';
2925: my $clientmathml='';
2926: my $clientunicode='0';
1.1137 raeburn 2927: my $clientmobile=0;
1.1194 raeburn 2928: my $clientosversion='';
1.87 matthew 2929: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2930: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2931: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2932: $clientbrowser=$bname;
2933: $httpbrowser=~/$vreg/i;
2934: $clientversion=$1;
2935: $clientmathml=($clientversion>=$minv);
2936: $clientunicode=($clientversion>=$univ);
2937: }
2938: }
2939: my $clientos='unknown';
1.1141 raeburn 2940: my $clientinfo;
1.87 matthew 2941: if (($httpbrowser=~/linux/i) ||
2942: ($httpbrowser=~/unix/i) ||
2943: ($httpbrowser=~/ux/i) ||
2944: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2945: if (($httpbrowser=~/vax/i) ||
2946: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2947: if ($httpbrowser=~/next/i) { $clientos='next'; }
2948: if (($httpbrowser=~/mac/i) ||
2949: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2950: if ($httpbrowser=~/win/i) {
2951: $clientos='win';
2952: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2953: $clientosversion = $1;
2954: }
2955: }
1.87 matthew 2956: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2957: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2958: $clientmobile=lc($1);
2959: }
1.1141 raeburn 2960: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2961: $clientinfo = 'firefox-'.$1;
2962: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2963: $clientinfo = 'chromeframe-'.$1;
2964: }
1.87 matthew 2965: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2966: $clientunicode,$clientos,$clientmobile,$clientinfo,
2967: $clientosversion);
1.87 matthew 2968: }
2969:
1.32 matthew 2970: ###############################################################
2971: ## Authentication changing form generation subroutines ##
2972: ###############################################################
2973: ##
2974: ## All of the authform_xxxxxxx subroutines take their inputs in a
2975: ## hash, and have reasonable default values.
2976: ##
2977: ## formname = the name given in the <form> tag.
1.35 matthew 2978: #-------------------------------------------
2979:
1.45 matthew 2980: =pod
2981:
1.112 bowersj2 2982: =head1 Authentication Routines
2983:
2984: =over 4
2985:
1.648 raeburn 2986: =item * &authform_xxxxxx()
1.35 matthew 2987:
2988: The authform_xxxxxx subroutines provide javascript and html forms which
2989: handle some of the conveniences required for authentication forms.
2990: This is not an optimal method, but it works.
2991:
2992: =over 4
2993:
1.112 bowersj2 2994: =item * authform_header
1.35 matthew 2995:
1.112 bowersj2 2996: =item * authform_authorwarning
1.35 matthew 2997:
1.112 bowersj2 2998: =item * authform_nochange
1.35 matthew 2999:
1.112 bowersj2 3000: =item * authform_kerberos
1.35 matthew 3001:
1.112 bowersj2 3002: =item * authform_internal
1.35 matthew 3003:
1.112 bowersj2 3004: =item * authform_filesystem
1.35 matthew 3005:
3006: =back
3007:
1.648 raeburn 3008: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3009:
1.35 matthew 3010: =cut
3011:
3012: #-------------------------------------------
1.32 matthew 3013: sub authform_header{
3014: my %in = (
3015: formname => 'cu',
1.80 albertel 3016: kerb_def_dom => '',
1.32 matthew 3017: @_,
3018: );
3019: $in{'formname'} = 'document.' . $in{'formname'};
3020: my $result='';
1.80 albertel 3021:
3022: #---------------------------------------------- Code for upper case translation
3023: my $Javascript_toUpperCase;
3024: unless ($in{kerb_def_dom}) {
3025: $Javascript_toUpperCase =<<"END";
3026: switch (choice) {
3027: case 'krb': currentform.elements[choicearg].value =
3028: currentform.elements[choicearg].value.toUpperCase();
3029: break;
3030: default:
3031: }
3032: END
3033: } else {
3034: $Javascript_toUpperCase = "";
3035: }
3036:
1.165 raeburn 3037: my $radioval = "'nochange'";
1.591 raeburn 3038: if (defined($in{'curr_authtype'})) {
3039: if ($in{'curr_authtype'} ne '') {
3040: $radioval = "'".$in{'curr_authtype'}."arg'";
3041: }
1.174 matthew 3042: }
1.165 raeburn 3043: my $argfield = 'null';
1.591 raeburn 3044: if (defined($in{'mode'})) {
1.165 raeburn 3045: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3046: if (defined($in{'curr_autharg'})) {
3047: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3048: $argfield = "'$in{'curr_autharg'}'";
3049: }
3050: }
3051: }
3052: }
3053:
1.32 matthew 3054: $result.=<<"END";
3055: var current = new Object();
1.165 raeburn 3056: current.radiovalue = $radioval;
3057: current.argfield = $argfield;
1.32 matthew 3058:
3059: function changed_radio(choice,currentform) {
3060: var choicearg = choice + 'arg';
3061: // If a radio button in changed, we need to change the argfield
3062: if (current.radiovalue != choice) {
3063: current.radiovalue = choice;
3064: if (current.argfield != null) {
3065: currentform.elements[current.argfield].value = '';
3066: }
3067: if (choice == 'nochange') {
3068: current.argfield = null;
3069: } else {
3070: current.argfield = choicearg;
3071: switch(choice) {
3072: case 'krb':
3073: currentform.elements[current.argfield].value =
3074: "$in{'kerb_def_dom'}";
3075: break;
3076: default:
3077: break;
3078: }
3079: }
3080: }
3081: return;
3082: }
1.22 www 3083:
1.32 matthew 3084: function changed_text(choice,currentform) {
3085: var choicearg = choice + 'arg';
3086: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3087: $Javascript_toUpperCase
1.32 matthew 3088: // clear old field
3089: if ((current.argfield != choicearg) && (current.argfield != null)) {
3090: currentform.elements[current.argfield].value = '';
3091: }
3092: current.argfield = choicearg;
3093: }
3094: set_auth_radio_buttons(choice,currentform);
3095: return;
1.20 www 3096: }
1.32 matthew 3097:
3098: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3099: var numauthchoices = currentform.login.length;
3100: if (typeof numauthchoices == "undefined") {
3101: return;
3102: }
1.32 matthew 3103: var i=0;
1.986 raeburn 3104: while (i < numauthchoices) {
1.32 matthew 3105: if (currentform.login[i].value == newvalue) { break; }
3106: i++;
3107: }
1.986 raeburn 3108: if (i == numauthchoices) {
1.32 matthew 3109: return;
3110: }
3111: current.radiovalue = newvalue;
3112: currentform.login[i].checked = true;
3113: return;
3114: }
3115: END
3116: return $result;
3117: }
3118:
1.1106 raeburn 3119: sub authform_authorwarning {
1.32 matthew 3120: my $result='';
1.144 matthew 3121: $result='<i>'.
3122: &mt('As a general rule, only authors or co-authors should be '.
3123: 'filesystem authenticated '.
3124: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3125: return $result;
3126: }
3127:
1.1106 raeburn 3128: sub authform_nochange {
1.32 matthew 3129: my %in = (
3130: formname => 'document.cu',
3131: kerb_def_dom => 'MSU.EDU',
3132: @_,
3133: );
1.1106 raeburn 3134: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3135: my $result;
1.1104 raeburn 3136: if (!$authnum) {
1.1105 raeburn 3137: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3138: } else {
3139: $result = '<label>'.&mt('[_1] Do not change login data',
3140: '<input type="radio" name="login" value="nochange" '.
3141: 'checked="checked" onclick="'.
1.281 albertel 3142: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3143: '</label>';
1.586 raeburn 3144: }
1.32 matthew 3145: return $result;
3146: }
3147:
1.591 raeburn 3148: sub authform_kerberos {
1.32 matthew 3149: my %in = (
3150: formname => 'document.cu',
3151: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3152: kerb_def_auth => 'krb4',
1.32 matthew 3153: @_,
3154: );
1.586 raeburn 3155: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
3156: $autharg,$jscall);
1.1106 raeburn 3157: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3158: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3159: $check5 = ' checked="checked"';
1.80 albertel 3160: } else {
1.772 bisitz 3161: $check4 = ' checked="checked"';
1.80 albertel 3162: }
1.165 raeburn 3163: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3164: if (defined($in{'curr_authtype'})) {
3165: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3166: $krbcheck = ' checked="checked"';
1.623 raeburn 3167: if (defined($in{'mode'})) {
3168: if ($in{'mode'} eq 'modifyuser') {
3169: $krbcheck = '';
3170: }
3171: }
1.591 raeburn 3172: if (defined($in{'curr_kerb_ver'})) {
3173: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3174: $check5 = ' checked="checked"';
1.591 raeburn 3175: $check4 = '';
3176: } else {
1.772 bisitz 3177: $check4 = ' checked="checked"';
1.591 raeburn 3178: $check5 = '';
3179: }
1.586 raeburn 3180: }
1.591 raeburn 3181: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3182: $krbarg = $in{'curr_autharg'};
3183: }
1.586 raeburn 3184: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3185: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3186: $result =
3187: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3188: $in{'curr_autharg'},$krbver);
3189: } else {
3190: $result =
3191: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3192: }
3193: return $result;
3194: }
3195: }
3196: } else {
3197: if ($authnum == 1) {
1.784 bisitz 3198: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3199: }
3200: }
1.586 raeburn 3201: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3202: return;
1.587 raeburn 3203: } elsif ($authtype eq '') {
1.591 raeburn 3204: if (defined($in{'mode'})) {
1.587 raeburn 3205: if ($in{'mode'} eq 'modifycourse') {
3206: if ($authnum == 1) {
1.1104 raeburn 3207: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 3208: }
3209: }
3210: }
1.586 raeburn 3211: }
3212: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3213: if ($authtype eq '') {
3214: $authtype = '<input type="radio" name="login" value="krb" '.
3215: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
3216: $krbcheck.' />';
3217: }
3218: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3219: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3220: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3221: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3222: $in{'curr_authtype'} eq 'krb4')) {
3223: $result .= &mt
1.144 matthew 3224: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3225: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3226: '<label>'.$authtype,
1.281 albertel 3227: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3228: 'value="'.$krbarg.'" '.
1.144 matthew 3229: 'onchange="'.$jscall.'" />',
1.281 albertel 3230: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
3231: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
3232: '</label>');
1.586 raeburn 3233: } elsif ($can_assign{'krb4'}) {
3234: $result .= &mt
3235: ('[_1] Kerberos authenticated with domain [_2] '.
3236: '[_3] Version 4 [_4]',
3237: '<label>'.$authtype,
3238: '</label><input type="text" size="10" name="krbarg" '.
3239: 'value="'.$krbarg.'" '.
3240: 'onchange="'.$jscall.'" />',
3241: '<label><input type="hidden" name="krbver" value="4" />',
3242: '</label>');
3243: } elsif ($can_assign{'krb5'}) {
3244: $result .= &mt
3245: ('[_1] Kerberos authenticated with domain [_2] '.
3246: '[_3] Version 5 [_4]',
3247: '<label>'.$authtype,
3248: '</label><input type="text" size="10" name="krbarg" '.
3249: 'value="'.$krbarg.'" '.
3250: 'onchange="'.$jscall.'" />',
3251: '<label><input type="hidden" name="krbver" value="5" />',
3252: '</label>');
3253: }
1.32 matthew 3254: return $result;
3255: }
3256:
1.1106 raeburn 3257: sub authform_internal {
1.586 raeburn 3258: my %in = (
1.32 matthew 3259: formname => 'document.cu',
3260: kerb_def_dom => 'MSU.EDU',
3261: @_,
3262: );
1.586 raeburn 3263: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3264: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3265: if (defined($in{'curr_authtype'})) {
3266: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3267: if ($can_assign{'int'}) {
1.772 bisitz 3268: $intcheck = 'checked="checked" ';
1.623 raeburn 3269: if (defined($in{'mode'})) {
3270: if ($in{'mode'} eq 'modifyuser') {
3271: $intcheck = '';
3272: }
3273: }
1.591 raeburn 3274: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3275: $intarg = $in{'curr_autharg'};
3276: }
3277: } else {
3278: $result = &mt('Currently internally authenticated.');
3279: return $result;
1.165 raeburn 3280: }
3281: }
1.586 raeburn 3282: } else {
3283: if ($authnum == 1) {
1.784 bisitz 3284: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3285: }
3286: }
3287: if (!$can_assign{'int'}) {
3288: return;
1.587 raeburn 3289: } elsif ($authtype eq '') {
1.591 raeburn 3290: if (defined($in{'mode'})) {
1.587 raeburn 3291: if ($in{'mode'} eq 'modifycourse') {
3292: if ($authnum == 1) {
1.1104 raeburn 3293: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 3294: }
3295: }
3296: }
1.165 raeburn 3297: }
1.586 raeburn 3298: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3299: if ($authtype eq '') {
3300: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
3301: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
3302: }
1.605 bisitz 3303: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3304: $intarg.'" onchange="'.$jscall.'" />';
3305: $result = &mt
1.144 matthew 3306: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3307: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3308: $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 3309: return $result;
3310: }
3311:
1.1104 raeburn 3312: sub authform_local {
1.32 matthew 3313: my %in = (
3314: formname => 'document.cu',
3315: kerb_def_dom => 'MSU.EDU',
3316: @_,
3317: );
1.586 raeburn 3318: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3319: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3320: if (defined($in{'curr_authtype'})) {
3321: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3322: if ($can_assign{'loc'}) {
1.772 bisitz 3323: $loccheck = 'checked="checked" ';
1.623 raeburn 3324: if (defined($in{'mode'})) {
3325: if ($in{'mode'} eq 'modifyuser') {
3326: $loccheck = '';
3327: }
3328: }
1.591 raeburn 3329: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3330: $locarg = $in{'curr_autharg'};
3331: }
3332: } else {
3333: $result = &mt('Currently using local (institutional) authentication.');
3334: return $result;
1.165 raeburn 3335: }
3336: }
1.586 raeburn 3337: } else {
3338: if ($authnum == 1) {
1.784 bisitz 3339: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3340: }
3341: }
3342: if (!$can_assign{'loc'}) {
3343: return;
1.587 raeburn 3344: } elsif ($authtype eq '') {
1.591 raeburn 3345: if (defined($in{'mode'})) {
1.587 raeburn 3346: if ($in{'mode'} eq 'modifycourse') {
3347: if ($authnum == 1) {
1.1104 raeburn 3348: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3349: }
3350: }
3351: }
1.165 raeburn 3352: }
1.586 raeburn 3353: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3354: if ($authtype eq '') {
3355: $authtype = '<input type="radio" name="login" value="loc" '.
3356: $loccheck.' onchange="'.$jscall.'" onclick="'.
3357: $jscall.'" />';
3358: }
3359: $autharg = '<input type="text" size="10" name="locarg" value="'.
3360: $locarg.'" onchange="'.$jscall.'" />';
3361: $result = &mt('[_1] Local Authentication with argument [_2]',
3362: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3363: return $result;
3364: }
3365:
1.1106 raeburn 3366: sub authform_filesystem {
1.32 matthew 3367: my %in = (
3368: formname => 'document.cu',
3369: kerb_def_dom => 'MSU.EDU',
3370: @_,
3371: );
1.586 raeburn 3372: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3373: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3374: if (defined($in{'curr_authtype'})) {
3375: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3376: if ($can_assign{'fsys'}) {
1.772 bisitz 3377: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3378: if (defined($in{'mode'})) {
3379: if ($in{'mode'} eq 'modifyuser') {
3380: $fsyscheck = '';
3381: }
3382: }
1.586 raeburn 3383: } else {
3384: $result = &mt('Currently Filesystem Authenticated.');
3385: return $result;
3386: }
3387: }
3388: } else {
3389: if ($authnum == 1) {
1.784 bisitz 3390: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3391: }
3392: }
3393: if (!$can_assign{'fsys'}) {
3394: return;
1.587 raeburn 3395: } elsif ($authtype eq '') {
1.591 raeburn 3396: if (defined($in{'mode'})) {
1.587 raeburn 3397: if ($in{'mode'} eq 'modifycourse') {
3398: if ($authnum == 1) {
1.1104 raeburn 3399: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3400: }
3401: }
3402: }
1.586 raeburn 3403: }
3404: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3405: if ($authtype eq '') {
3406: $authtype = '<input type="radio" name="login" value="fsys" '.
3407: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3408: $jscall.'" />';
3409: }
3410: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3411: ' onchange="'.$jscall.'" />';
3412: $result = &mt
1.144 matthew 3413: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3414: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3415: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3416: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3417: 'onchange="'.$jscall.'" />');
1.32 matthew 3418: return $result;
3419: }
3420:
1.586 raeburn 3421: sub get_assignable_auth {
3422: my ($dom) = @_;
3423: if ($dom eq '') {
3424: $dom = $env{'request.role.domain'};
3425: }
3426: my %can_assign = (
3427: krb4 => 1,
3428: krb5 => 1,
3429: int => 1,
3430: loc => 1,
3431: );
3432: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3433: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3434: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3435: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3436: my $context;
3437: if ($env{'request.role'} =~ /^au/) {
3438: $context = 'author';
3439: } elsif ($env{'request.role'} =~ /^dc/) {
3440: $context = 'domain';
3441: } elsif ($env{'request.course.id'}) {
3442: $context = 'course';
3443: }
3444: if ($context) {
3445: if (ref($authhash->{$context}) eq 'HASH') {
3446: %can_assign = %{$authhash->{$context}};
3447: }
3448: }
3449: }
3450: }
3451: my $authnum = 0;
3452: foreach my $key (keys(%can_assign)) {
3453: if ($can_assign{$key}) {
3454: $authnum ++;
3455: }
3456: }
3457: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3458: $authnum --;
3459: }
3460: return ($authnum,%can_assign);
3461: }
3462:
1.80 albertel 3463: ###############################################################
3464: ## Get Kerberos Defaults for Domain ##
3465: ###############################################################
3466: ##
3467: ## Returns default kerberos version and an associated argument
3468: ## as listed in file domain.tab. If not listed, provides
3469: ## appropriate default domain and kerberos version.
3470: ##
3471: #-------------------------------------------
3472:
3473: =pod
3474:
1.648 raeburn 3475: =item * &get_kerberos_defaults()
1.80 albertel 3476:
3477: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3478: version and domain. If not found, it defaults to version 4 and the
3479: domain of the server.
1.80 albertel 3480:
1.648 raeburn 3481: =over 4
3482:
1.80 albertel 3483: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3484:
1.648 raeburn 3485: =back
3486:
3487: =back
3488:
1.80 albertel 3489: =cut
3490:
3491: #-------------------------------------------
3492: sub get_kerberos_defaults {
3493: my $domain=shift;
1.641 raeburn 3494: my ($krbdef,$krbdefdom);
3495: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3496: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3497: $krbdef = $domdefaults{'auth_def'};
3498: $krbdefdom = $domdefaults{'auth_arg_def'};
3499: } else {
1.80 albertel 3500: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3501: my $krbdefdom=$1;
3502: $krbdefdom=~tr/a-z/A-Z/;
3503: $krbdef = "krb4";
3504: }
3505: return ($krbdef,$krbdefdom);
3506: }
1.112 bowersj2 3507:
1.32 matthew 3508:
1.46 matthew 3509: ###############################################################
3510: ## Thesaurus Functions ##
3511: ###############################################################
1.20 www 3512:
1.46 matthew 3513: =pod
1.20 www 3514:
1.112 bowersj2 3515: =head1 Thesaurus Functions
3516:
3517: =over 4
3518:
1.648 raeburn 3519: =item * &initialize_keywords()
1.46 matthew 3520:
3521: Initializes the package variable %Keywords if it is empty. Uses the
3522: package variable $thesaurus_db_file.
3523:
3524: =cut
3525:
3526: ###################################################
3527:
3528: sub initialize_keywords {
3529: return 1 if (scalar keys(%Keywords));
3530: # If we are here, %Keywords is empty, so fill it up
3531: # Make sure the file we need exists...
3532: if (! -e $thesaurus_db_file) {
3533: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3534: " failed because it does not exist");
3535: return 0;
3536: }
3537: # Set up the hash as a database
3538: my %thesaurus_db;
3539: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3540: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3541: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3542: $thesaurus_db_file);
3543: return 0;
3544: }
3545: # Get the average number of appearances of a word.
3546: my $avecount = $thesaurus_db{'average.count'};
3547: # Put keywords (those that appear > average) into %Keywords
3548: while (my ($word,$data)=each (%thesaurus_db)) {
3549: my ($count,undef) = split /:/,$data;
3550: $Keywords{$word}++ if ($count > $avecount);
3551: }
3552: untie %thesaurus_db;
3553: # Remove special values from %Keywords.
1.356 albertel 3554: foreach my $value ('total.count','average.count') {
3555: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3556: }
1.46 matthew 3557: return 1;
3558: }
3559:
3560: ###################################################
3561:
3562: =pod
3563:
1.648 raeburn 3564: =item * &keyword($word)
1.46 matthew 3565:
3566: Returns true if $word is a keyword. A keyword is a word that appears more
3567: than the average number of times in the thesaurus database. Calls
3568: &initialize_keywords
3569:
3570: =cut
3571:
3572: ###################################################
1.20 www 3573:
3574: sub keyword {
1.46 matthew 3575: return if (!&initialize_keywords());
3576: my $word=lc(shift());
3577: $word=~s/\W//g;
3578: return exists($Keywords{$word});
1.20 www 3579: }
1.46 matthew 3580:
3581: ###############################################################
3582:
3583: =pod
1.20 www 3584:
1.648 raeburn 3585: =item * &get_related_words()
1.46 matthew 3586:
1.160 matthew 3587: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3588: an array of words. If the keyword is not in the thesaurus, an empty array
3589: will be returned. The order of the words returned is determined by the
3590: database which holds them.
3591:
3592: Uses global $thesaurus_db_file.
3593:
1.1057 foxr 3594:
1.46 matthew 3595: =cut
3596:
3597: ###############################################################
3598: sub get_related_words {
3599: my $keyword = shift;
3600: my %thesaurus_db;
3601: if (! -e $thesaurus_db_file) {
3602: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3603: "failed because the file does not exist");
3604: return ();
3605: }
3606: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3607: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3608: return ();
3609: }
3610: my @Words=();
1.429 www 3611: my $count=0;
1.46 matthew 3612: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3613: # The first element is the number of times
3614: # the word appears. We do not need it now.
1.429 www 3615: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3616: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3617: my $threshold=$mostfrequentcount/10;
3618: foreach my $possibleword (@RelatedWords) {
3619: my ($word,$wordcount)=split(/\,/,$possibleword);
3620: if ($wordcount>$threshold) {
3621: push(@Words,$word);
3622: $count++;
3623: if ($count>10) { last; }
3624: }
1.20 www 3625: }
3626: }
1.46 matthew 3627: untie %thesaurus_db;
3628: return @Words;
1.14 harris41 3629: }
1.1090 foxr 3630: ###############################################################
3631: #
3632: # Spell checking
3633: #
3634:
3635: =pod
3636:
1.1142 raeburn 3637: =back
3638:
1.1090 foxr 3639: =head1 Spell checking
3640:
3641: =over 4
3642:
3643: =item * &check_spelling($wordlist $language)
3644:
3645: Takes a string containing words and feeds it to an external
3646: spellcheck program via a pipeline. Returns a string containing
3647: them mis-spelled words.
3648:
3649: Parameters:
3650:
3651: =over 4
3652:
3653: =item - $wordlist
3654:
3655: String that will be fed into the spellcheck program.
3656:
3657: =item - $language
3658:
3659: Language string that specifies the language for which the spell
3660: check will be performed.
3661:
3662: =back
3663:
3664: =back
3665:
3666: Note: This sub assumes that aspell is installed.
3667:
3668:
3669: =cut
3670:
1.46 matthew 3671:
1.1090 foxr 3672: sub check_spelling {
3673: my ($wordlist, $language) = @_;
1.1091 foxr 3674: my @misspellings;
3675:
3676: # Generate the speller and set the langauge.
3677: # if explicitly selected:
1.1090 foxr 3678:
1.1091 foxr 3679: my $speller = Text::Aspell->new;
1.1090 foxr 3680: if ($language) {
1.1091 foxr 3681: $speller->set_option('lang', $language);
1.1090 foxr 3682: }
3683:
1.1091 foxr 3684: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3685:
1.1091 foxr 3686: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3687:
1.1091 foxr 3688: foreach my $word (@words) {
3689: if(! $speller->check($word)) {
3690: push(@misspellings, $word);
1.1090 foxr 3691: }
3692: }
1.1091 foxr 3693: return join(' ', @misspellings);
3694:
1.1090 foxr 3695: }
3696:
1.61 www 3697: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3698: =pod
3699:
1.112 bowersj2 3700: =head1 User Name Functions
3701:
3702: =over 4
3703:
1.648 raeburn 3704: =item * &plainname($uname,$udom,$first)
1.81 albertel 3705:
1.112 bowersj2 3706: Takes a users logon name and returns it as a string in
1.226 albertel 3707: "first middle last generation" form
3708: if $first is set to 'lastname' then it returns it as
3709: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3710:
3711: =cut
1.61 www 3712:
1.295 www 3713:
1.81 albertel 3714: ###############################################################
1.61 www 3715: sub plainname {
1.226 albertel 3716: my ($uname,$udom,$first)=@_;
1.537 albertel 3717: return if (!defined($uname) || !defined($udom));
1.295 www 3718: my %names=&getnames($uname,$udom);
1.226 albertel 3719: my $name=&Apache::lonnet::format_name($names{'firstname'},
3720: $names{'middlename'},
3721: $names{'lastname'},
3722: $names{'generation'},$first);
3723: $name=~s/^\s+//;
1.62 www 3724: $name=~s/\s+$//;
3725: $name=~s/\s+/ /g;
1.353 albertel 3726: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3727: return $name;
1.61 www 3728: }
1.66 www 3729:
3730: # -------------------------------------------------------------------- Nickname
1.81 albertel 3731: =pod
3732:
1.648 raeburn 3733: =item * &nickname($uname,$udom)
1.81 albertel 3734:
3735: Gets a users name and returns it as a string as
3736:
3737: ""nickname""
1.66 www 3738:
1.81 albertel 3739: if the user has a nickname or
3740:
3741: "first middle last generation"
3742:
3743: if the user does not
3744:
3745: =cut
1.66 www 3746:
3747: sub nickname {
3748: my ($uname,$udom)=@_;
1.537 albertel 3749: return if (!defined($uname) || !defined($udom));
1.295 www 3750: my %names=&getnames($uname,$udom);
1.68 albertel 3751: my $name=$names{'nickname'};
1.66 www 3752: if ($name) {
3753: $name='"'.$name.'"';
3754: } else {
3755: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3756: $names{'lastname'}.' '.$names{'generation'};
3757: $name=~s/\s+$//;
3758: $name=~s/\s+/ /g;
3759: }
3760: return $name;
3761: }
3762:
1.295 www 3763: sub getnames {
3764: my ($uname,$udom)=@_;
1.537 albertel 3765: return if (!defined($uname) || !defined($udom));
1.433 albertel 3766: if ($udom eq 'public' && $uname eq 'public') {
3767: return ('lastname' => &mt('Public'));
3768: }
1.295 www 3769: my $id=$uname.':'.$udom;
3770: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3771: if ($cached) {
3772: return %{$names};
3773: } else {
3774: my %loadnames=&Apache::lonnet::get('environment',
3775: ['firstname','middlename','lastname','generation','nickname'],
3776: $udom,$uname);
3777: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3778: return %loadnames;
3779: }
3780: }
1.61 www 3781:
1.542 raeburn 3782: # -------------------------------------------------------------------- getemails
1.648 raeburn 3783:
1.542 raeburn 3784: =pod
3785:
1.648 raeburn 3786: =item * &getemails($uname,$udom)
1.542 raeburn 3787:
3788: Gets a user's email information and returns it as a hash with keys:
3789: notification, critnotification, permanentemail
3790:
3791: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3792: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3793:
1.648 raeburn 3794:
1.542 raeburn 3795: =cut
3796:
1.648 raeburn 3797:
1.466 albertel 3798: sub getemails {
3799: my ($uname,$udom)=@_;
3800: if ($udom eq 'public' && $uname eq 'public') {
3801: return;
3802: }
1.467 www 3803: if (!$udom) { $udom=$env{'user.domain'}; }
3804: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3805: my $id=$uname.':'.$udom;
3806: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3807: if ($cached) {
3808: return %{$names};
3809: } else {
3810: my %loadnames=&Apache::lonnet::get('environment',
3811: ['notification','critnotification',
3812: 'permanentemail'],
3813: $udom,$uname);
3814: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3815: return %loadnames;
3816: }
3817: }
3818:
1.551 albertel 3819: sub flush_email_cache {
3820: my ($uname,$udom)=@_;
3821: if (!$udom) { $udom =$env{'user.domain'}; }
3822: if (!$uname) { $uname=$env{'user.name'}; }
3823: return if ($udom eq 'public' && $uname eq 'public');
3824: my $id=$uname.':'.$udom;
3825: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3826: }
3827:
1.728 raeburn 3828: # -------------------------------------------------------------------- getlangs
3829:
3830: =pod
3831:
3832: =item * &getlangs($uname,$udom)
3833:
3834: Gets a user's language preference and returns it as a hash with key:
3835: language.
3836:
3837: =cut
3838:
3839:
3840: sub getlangs {
3841: my ($uname,$udom) = @_;
3842: if (!$udom) { $udom =$env{'user.domain'}; }
3843: if (!$uname) { $uname=$env{'user.name'}; }
3844: my $id=$uname.':'.$udom;
3845: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3846: if ($cached) {
3847: return %{$langs};
3848: } else {
3849: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3850: $udom,$uname);
3851: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3852: return %loadlangs;
3853: }
3854: }
3855:
3856: sub flush_langs_cache {
3857: my ($uname,$udom)=@_;
3858: if (!$udom) { $udom =$env{'user.domain'}; }
3859: if (!$uname) { $uname=$env{'user.name'}; }
3860: return if ($udom eq 'public' && $uname eq 'public');
3861: my $id=$uname.':'.$udom;
3862: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3863: }
3864:
1.61 www 3865: # ------------------------------------------------------------------ Screenname
1.81 albertel 3866:
3867: =pod
3868:
1.648 raeburn 3869: =item * &screenname($uname,$udom)
1.81 albertel 3870:
3871: Gets a users screenname and returns it as a string
3872:
3873: =cut
1.61 www 3874:
3875: sub screenname {
3876: my ($uname,$udom)=@_;
1.258 albertel 3877: if ($uname eq $env{'user.name'} &&
3878: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3879: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3880: return $names{'screenname'};
1.62 www 3881: }
3882:
1.212 albertel 3883:
1.802 bisitz 3884: # ------------------------------------------------------------- Confirm Wrapper
3885: =pod
3886:
1.1142 raeburn 3887: =item * &confirmwrapper($message)
1.802 bisitz 3888:
3889: Wrap messages about completion of operation in box
3890:
3891: =cut
3892:
3893: sub confirmwrapper {
3894: my ($message)=@_;
3895: if ($message) {
3896: return "\n".'<div class="LC_confirm_box">'."\n"
3897: .$message."\n"
3898: .'</div>'."\n";
3899: } else {
3900: return $message;
3901: }
3902: }
3903:
1.62 www 3904: # ------------------------------------------------------------- Message Wrapper
3905:
3906: sub messagewrapper {
1.369 www 3907: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3908: return
1.441 albertel 3909: '<a href="/adm/email?compose=individual&'.
3910: 'recname='.$username.'&recdom='.$domain.
3911: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3912: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3913: }
1.802 bisitz 3914:
1.74 www 3915: # --------------------------------------------------------------- Notes Wrapper
3916:
3917: sub noteswrapper {
3918: my ($link,$un,$do)=@_;
3919: return
1.896 amueller 3920: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3921: }
1.802 bisitz 3922:
1.62 www 3923: # ------------------------------------------------------------- Aboutme Wrapper
3924:
3925: sub aboutmewrapper {
1.1070 raeburn 3926: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3927: if (!defined($username) && !defined($domain)) {
3928: return;
3929: }
1.1096 raeburn 3930: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3931: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3932: }
3933:
3934: # ------------------------------------------------------------ Syllabus Wrapper
3935:
3936: sub syllabuswrapper {
1.707 bisitz 3937: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3938: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3939: }
1.14 harris41 3940:
1.802 bisitz 3941: # -----------------------------------------------------------------------------
3942:
1.208 matthew 3943: sub track_student_link {
1.887 raeburn 3944: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3945: my $link ="/adm/trackstudent?";
1.208 matthew 3946: my $title = 'View recent activity';
3947: if (defined($sname) && $sname !~ /^\s*$/ &&
3948: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3949: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3950: $title .= ' of this student';
1.268 albertel 3951: }
1.208 matthew 3952: if (defined($target) && $target !~ /^\s*$/) {
3953: $target = qq{target="$target"};
3954: } else {
3955: $target = '';
3956: }
1.268 albertel 3957: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3958: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3959: $title = &mt($title);
3960: $linktext = &mt($linktext);
1.448 albertel 3961: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3962: &help_open_topic('View_recent_activity');
1.208 matthew 3963: }
3964:
1.781 raeburn 3965: sub slot_reservations_link {
3966: my ($linktext,$sname,$sdom,$target) = @_;
3967: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3968: my $title = 'View slot reservation history';
3969: if (defined($sname) && $sname !~ /^\s*$/ &&
3970: defined($sdom) && $sdom !~ /^\s*$/) {
3971: $link .= "&uname=$sname&udom=$sdom";
3972: $title .= ' of this student';
3973: }
3974: if (defined($target) && $target !~ /^\s*$/) {
3975: $target = qq{target="$target"};
3976: } else {
3977: $target = '';
3978: }
3979: $title = &mt($title);
3980: $linktext = &mt($linktext);
3981: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3982: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3983:
3984: }
3985:
1.508 www 3986: # ===================================================== Display a student photo
3987:
3988:
1.509 albertel 3989: sub student_image_tag {
1.508 www 3990: my ($domain,$user)=@_;
3991: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3992: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3993: return '<img src="'.$imgsrc.'" align="right" />';
3994: } else {
3995: return '';
3996: }
3997: }
3998:
1.112 bowersj2 3999: =pod
4000:
4001: =back
4002:
4003: =head1 Access .tab File Data
4004:
4005: =over 4
4006:
1.648 raeburn 4007: =item * &languageids()
1.112 bowersj2 4008:
4009: returns list of all language ids
4010:
4011: =cut
4012:
1.14 harris41 4013: sub languageids {
1.16 harris41 4014: return sort(keys(%language));
1.14 harris41 4015: }
4016:
1.112 bowersj2 4017: =pod
4018:
1.648 raeburn 4019: =item * &languagedescription()
1.112 bowersj2 4020:
4021: returns description of a specified language id
4022:
4023: =cut
4024:
1.14 harris41 4025: sub languagedescription {
1.125 www 4026: my $code=shift;
4027: return ($supported_language{$code}?'* ':'').
4028: $language{$code}.
1.126 www 4029: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4030: }
4031:
1.1048 foxr 4032: =pod
4033:
4034: =item * &plainlanguagedescription
4035:
4036: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4037: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4038:
4039: =cut
4040:
1.145 www 4041: sub plainlanguagedescription {
4042: my $code=shift;
4043: return $language{$code};
4044: }
4045:
1.1048 foxr 4046: =pod
4047:
4048: =item * &supportedlanguagecode
4049:
4050: Returns the supported language code (e.g. sptutf maps to pt) given a language
4051: code.
4052:
4053: =cut
4054:
1.145 www 4055: sub supportedlanguagecode {
4056: my $code=shift;
4057: return $supported_language{$code};
1.97 www 4058: }
4059:
1.112 bowersj2 4060: =pod
4061:
1.1048 foxr 4062: =item * &latexlanguage()
4063:
4064: Given a language key code returns the correspondnig language to use
4065: to select the correct hyphenation on LaTeX printouts. This is undef if there
4066: is no supported hyphenation for the language code.
4067:
4068: =cut
4069:
4070: sub latexlanguage {
4071: my $code = shift;
4072: return $latex_language{$code};
4073: }
4074:
4075: =pod
4076:
4077: =item * &latexhyphenation()
4078:
4079: Same as above but what's supplied is the language as it might be stored
4080: in the metadata.
4081:
4082: =cut
4083:
4084: sub latexhyphenation {
4085: my $key = shift;
4086: return $latex_language_bykey{$key};
4087: }
4088:
4089: =pod
4090:
1.648 raeburn 4091: =item * ©rightids()
1.112 bowersj2 4092:
4093: returns list of all copyrights
4094:
4095: =cut
4096:
4097: sub copyrightids {
4098: return sort(keys(%cprtag));
4099: }
4100:
4101: =pod
4102:
1.648 raeburn 4103: =item * ©rightdescription()
1.112 bowersj2 4104:
4105: returns description of a specified copyright id
4106:
4107: =cut
4108:
4109: sub copyrightdescription {
1.166 www 4110: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4111: }
1.197 matthew 4112:
4113: =pod
4114:
1.648 raeburn 4115: =item * &source_copyrightids()
1.192 taceyjo1 4116:
4117: returns list of all source copyrights
4118:
4119: =cut
4120:
4121: sub source_copyrightids {
4122: return sort(keys(%scprtag));
4123: }
4124:
4125: =pod
4126:
1.648 raeburn 4127: =item * &source_copyrightdescription()
1.192 taceyjo1 4128:
4129: returns description of a specified source copyright id
4130:
4131: =cut
4132:
4133: sub source_copyrightdescription {
4134: return &mt($scprtag{shift(@_)});
4135: }
1.112 bowersj2 4136:
4137: =pod
4138:
1.648 raeburn 4139: =item * &filecategories()
1.112 bowersj2 4140:
4141: returns list of all file categories
4142:
4143: =cut
4144:
4145: sub filecategories {
4146: return sort(keys(%category_extensions));
4147: }
4148:
4149: =pod
4150:
1.648 raeburn 4151: =item * &filecategorytypes()
1.112 bowersj2 4152:
4153: returns list of file types belonging to a given file
4154: category
4155:
4156: =cut
4157:
4158: sub filecategorytypes {
1.356 albertel 4159: my ($cat) = @_;
1.1248 raeburn 4160: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4161: return @{$category_extensions{lc($cat)}};
4162: } else {
4163: return ();
4164: }
1.112 bowersj2 4165: }
4166:
4167: =pod
4168:
1.648 raeburn 4169: =item * &fileembstyle()
1.112 bowersj2 4170:
4171: returns embedding style for a specified file type
4172:
4173: =cut
4174:
4175: sub fileembstyle {
4176: return $fe{lc(shift(@_))};
1.169 www 4177: }
4178:
1.351 www 4179: sub filemimetype {
4180: return $fm{lc(shift(@_))};
4181: }
4182:
1.169 www 4183:
4184: sub filecategoryselect {
4185: my ($name,$value)=@_;
1.189 matthew 4186: return &select_form($value,$name,
1.970 raeburn 4187: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4188: }
4189:
4190: =pod
4191:
1.648 raeburn 4192: =item * &filedescription()
1.112 bowersj2 4193:
4194: returns description for a specified file type
4195:
4196: =cut
4197:
4198: sub filedescription {
1.188 matthew 4199: my $file_description = $fd{lc(shift())};
4200: $file_description =~ s:([\[\]]):~$1:g;
4201: return &mt($file_description);
1.112 bowersj2 4202: }
4203:
4204: =pod
4205:
1.648 raeburn 4206: =item * &filedescriptionex()
1.112 bowersj2 4207:
4208: returns description for a specified file type with
4209: extra formatting
4210:
4211: =cut
4212:
4213: sub filedescriptionex {
4214: my $ex=shift;
1.188 matthew 4215: my $file_description = $fd{lc($ex)};
4216: $file_description =~ s:([\[\]]):~$1:g;
4217: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4218: }
4219:
4220: # End of .tab access
4221: =pod
4222:
4223: =back
4224:
4225: =cut
4226:
4227: # ------------------------------------------------------------------ File Types
4228: sub fileextensions {
4229: return sort(keys(%fe));
4230: }
4231:
1.97 www 4232: # ----------------------------------------------------------- Display Languages
4233: # returns a hash with all desired display languages
4234: #
4235:
4236: sub display_languages {
4237: my %languages=();
1.695 raeburn 4238: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4239: $languages{$lang}=1;
1.97 www 4240: }
4241: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4242: if ($env{'form.displaylanguage'}) {
1.356 albertel 4243: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4244: $languages{$lang}=1;
1.97 www 4245: }
4246: }
4247: return %languages;
1.14 harris41 4248: }
4249:
1.582 albertel 4250: sub languages {
4251: my ($possible_langs) = @_;
1.695 raeburn 4252: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4253: if (!ref($possible_langs)) {
4254: if( wantarray ) {
4255: return @preferred_langs;
4256: } else {
4257: return $preferred_langs[0];
4258: }
4259: }
4260: my %possibilities = map { $_ => 1 } (@$possible_langs);
4261: my @preferred_possibilities;
4262: foreach my $preferred_lang (@preferred_langs) {
4263: if (exists($possibilities{$preferred_lang})) {
4264: push(@preferred_possibilities, $preferred_lang);
4265: }
4266: }
4267: if( wantarray ) {
4268: return @preferred_possibilities;
4269: }
4270: return $preferred_possibilities[0];
4271: }
4272:
1.742 raeburn 4273: sub user_lang {
4274: my ($touname,$toudom,$fromcid) = @_;
4275: my @userlangs;
4276: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4277: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4278: $env{'course.'.$fromcid.'.languages'}));
4279: } else {
4280: my %langhash = &getlangs($touname,$toudom);
4281: if ($langhash{'languages'} ne '') {
4282: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4283: } else {
4284: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4285: if ($domdefs{'lang_def'} ne '') {
4286: @userlangs = ($domdefs{'lang_def'});
4287: }
4288: }
4289: }
4290: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4291: my $user_lh = Apache::localize->get_handle(@languages);
4292: return $user_lh;
4293: }
4294:
4295:
1.112 bowersj2 4296: ###############################################################
4297: ## Student Answer Attempts ##
4298: ###############################################################
4299:
4300: =pod
4301:
4302: =head1 Alternate Problem Views
4303:
4304: =over 4
4305:
1.648 raeburn 4306: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4307: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4308:
4309: Return string with previous attempt on problem. Arguments:
4310:
4311: =over 4
4312:
4313: =item * $symb: Problem, including path
4314:
4315: =item * $username: username of the desired student
4316:
4317: =item * $domain: domain of the desired student
1.14 harris41 4318:
1.112 bowersj2 4319: =item * $course: Course ID
1.14 harris41 4320:
1.112 bowersj2 4321: =item * $getattempt: Leave blank for all attempts, otherwise put
4322: something
1.14 harris41 4323:
1.112 bowersj2 4324: =item * $regexp: if string matches this regexp, the string will be
4325: sent to $gradesub
1.14 harris41 4326:
1.112 bowersj2 4327: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4328:
1.1199 raeburn 4329: =item * $usec: section of the desired student
4330:
4331: =item * $identifier: counter for student (multiple students one problem) or
4332: problem (one student; whole sequence).
4333:
1.112 bowersj2 4334: =back
1.14 harris41 4335:
1.112 bowersj2 4336: The output string is a table containing all desired attempts, if any.
1.16 harris41 4337:
1.112 bowersj2 4338: =cut
1.1 albertel 4339:
4340: sub get_previous_attempt {
1.1199 raeburn 4341: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4342: my $prevattempts='';
1.43 ng 4343: no strict 'refs';
1.1 albertel 4344: if ($symb) {
1.3 albertel 4345: my (%returnhash)=
4346: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4347: if ($returnhash{'version'}) {
4348: my %lasthash=();
4349: my $version;
4350: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4351: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4352: if ($key =~ /\.rawrndseed$/) {
4353: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4354: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4355: } else {
4356: $lasthash{$key}=$returnhash{$version.':'.$key};
4357: }
1.19 harris41 4358: }
1.1 albertel 4359: }
1.596 albertel 4360: $prevattempts=&start_data_table().&start_data_table_header_row();
4361: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4362: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4363: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4364: foreach my $key (sort(keys(%lasthash))) {
4365: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4366: if ($#parts > 0) {
1.31 albertel 4367: my $data=$parts[-1];
1.989 raeburn 4368: next if ($data eq 'foilorder');
1.31 albertel 4369: pop(@parts);
1.1010 www 4370: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4371: if ($data eq 'type') {
4372: unless ($showsurv) {
4373: my $id = join(',',@parts);
4374: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4375: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4376: $lasthidden{$ign.'.'.$id} = 1;
4377: }
1.945 raeburn 4378: }
1.1199 raeburn 4379: if ($identifier ne '') {
4380: my $id = join(',',@parts);
4381: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4382: $domain,$username,$usec,undef,$course) =~ /^no/) {
4383: $hidestatus{$ign.'.'.$id} = 1;
4384: }
4385: }
4386: } elsif ($data eq 'regrader') {
4387: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4388: my $id = join(',',@parts);
4389: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4390: }
1.1010 www 4391: }
1.31 albertel 4392: } else {
1.41 ng 4393: if ($#parts == 0) {
4394: $prevattempts.='<th>'.$parts[0].'</th>';
4395: } else {
4396: $prevattempts.='<th>'.$ign.'</th>';
4397: }
1.31 albertel 4398: }
1.16 harris41 4399: }
1.596 albertel 4400: $prevattempts.=&end_data_table_header_row();
1.40 ng 4401: if ($getattempt eq '') {
1.1199 raeburn 4402: my (%solved,%resets,%probstatus);
1.1200 raeburn 4403: if (($identifier ne '') && (keys(%regraded) > 0)) {
4404: for ($version=1;$version<=$returnhash{'version'};$version++) {
4405: foreach my $id (keys(%regraded)) {
4406: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4407: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4408: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4409: push(@{$resets{$id}},$version);
1.1199 raeburn 4410: }
4411: }
4412: }
1.1200 raeburn 4413: }
4414: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4415: my (@hidden,@unsolved);
1.945 raeburn 4416: if (%typeparts) {
4417: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4418: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4419: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4420: push(@hidden,$id);
1.1199 raeburn 4421: } elsif ($identifier ne '') {
4422: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4423: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4424: ($hidestatus{$id})) {
1.1200 raeburn 4425: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4426: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4427: push(@{$solved{$id}},$version);
4428: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4429: (ref($solved{$id}) eq 'ARRAY')) {
4430: my $skip;
4431: if (ref($resets{$id}) eq 'ARRAY') {
4432: foreach my $reset (@{$resets{$id}}) {
4433: if ($reset > $solved{$id}[-1]) {
4434: $skip=1;
4435: last;
4436: }
4437: }
4438: }
4439: unless ($skip) {
4440: my ($ign,$partslist) = split(/\./,$id,2);
4441: push(@unsolved,$partslist);
4442: }
4443: }
4444: }
1.945 raeburn 4445: }
4446: }
4447: }
4448: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4449: '<td>'.&mt('Transaction [_1]',$version);
4450: if (@unsolved) {
4451: $prevattempts .= '<span class="LC_nobreak"><label>'.
4452: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4453: &mt('Hide').'</label></span>';
4454: }
4455: $prevattempts .= '</td>';
1.945 raeburn 4456: if (@hidden) {
4457: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4458: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4459: my $hide;
4460: foreach my $id (@hidden) {
4461: if ($key =~ /^\Q$id\E/) {
4462: $hide = 1;
4463: last;
4464: }
4465: }
4466: if ($hide) {
4467: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4468: if (($data eq 'award') || ($data eq 'awarddetail')) {
4469: my $value = &format_previous_attempt_value($key,
4470: $returnhash{$version.':'.$key});
1.1173 kruse 4471: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4472: } else {
4473: $prevattempts.='<td> </td>';
4474: }
4475: } else {
4476: if ($key =~ /\./) {
1.1212 raeburn 4477: my $value = $returnhash{$version.':'.$key};
4478: if ($key =~ /\.rndseed$/) {
4479: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4480: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4481: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4482: }
4483: }
4484: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4485: ' </td>';
1.945 raeburn 4486: } else {
4487: $prevattempts.='<td> </td>';
4488: }
4489: }
4490: }
4491: } else {
4492: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4493: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4494: my $value = $returnhash{$version.':'.$key};
4495: if ($key =~ /\.rndseed$/) {
4496: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4497: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4498: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4499: }
4500: }
4501: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4502: ' </td>';
1.945 raeburn 4503: }
4504: }
4505: $prevattempts.=&end_data_table_row();
1.40 ng 4506: }
1.1 albertel 4507: }
1.945 raeburn 4508: my @currhidden = keys(%lasthidden);
1.596 albertel 4509: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4510: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4511: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4512: if (%typeparts) {
4513: my $hidden;
4514: foreach my $id (@currhidden) {
4515: if ($key =~ /^\Q$id\E/) {
4516: $hidden = 1;
4517: last;
4518: }
4519: }
4520: if ($hidden) {
4521: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4522: if (($data eq 'award') || ($data eq 'awarddetail')) {
4523: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4524: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4525: $value = &$gradesub($value);
4526: }
1.1173 kruse 4527: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4528: } else {
4529: $prevattempts.='<td> </td>';
4530: }
4531: } else {
4532: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4533: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4534: $value = &$gradesub($value);
4535: }
1.1173 kruse 4536: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4537: }
4538: } else {
4539: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4540: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4541: $value = &$gradesub($value);
4542: }
1.1173 kruse 4543: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4544: }
1.16 harris41 4545: }
1.596 albertel 4546: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4547: } else {
1.596 albertel 4548: $prevattempts=
4549: &start_data_table().&start_data_table_row().
4550: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4551: &end_data_table_row().&end_data_table();
1.1 albertel 4552: }
4553: } else {
1.596 albertel 4554: $prevattempts=
4555: &start_data_table().&start_data_table_row().
4556: '<td>'.&mt('No data.').'</td>'.
4557: &end_data_table_row().&end_data_table();
1.1 albertel 4558: }
1.10 albertel 4559: }
4560:
1.581 albertel 4561: sub format_previous_attempt_value {
4562: my ($key,$value) = @_;
1.1011 www 4563: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4564: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4565: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4566: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4567: } elsif ($key =~ /answerstring$/) {
4568: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4569: my @answer = %answers;
4570: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4571: my @anskeys = sort(keys(%answers));
4572: if (@anskeys == 1) {
4573: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4574: if ($answer =~ m{\0}) {
4575: $answer =~ s{\0}{,}g;
1.988 raeburn 4576: }
4577: my $tag_internal_answer_name = 'INTERNAL';
4578: if ($anskeys[0] eq $tag_internal_answer_name) {
4579: $value = $answer;
4580: } else {
4581: $value = $anskeys[0].'='.$answer;
4582: }
4583: } else {
4584: foreach my $ans (@anskeys) {
4585: my $answer = $answers{$ans};
1.1001 raeburn 4586: if ($answer =~ m{\0}) {
4587: $answer =~ s{\0}{,}g;
1.988 raeburn 4588: }
4589: $value .= $ans.'='.$answer.'<br />';;
4590: }
4591: }
1.581 albertel 4592: } else {
1.1173 kruse 4593: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4594: }
4595: return $value;
4596: }
4597:
4598:
1.107 albertel 4599: sub relative_to_absolute {
4600: my ($url,$output)=@_;
4601: my $parser=HTML::TokeParser->new(\$output);
4602: my $token;
4603: my $thisdir=$url;
4604: my @rlinks=();
4605: while ($token=$parser->get_token) {
4606: if ($token->[0] eq 'S') {
4607: if ($token->[1] eq 'a') {
4608: if ($token->[2]->{'href'}) {
4609: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4610: }
4611: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4612: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4613: } elsif ($token->[1] eq 'base') {
4614: $thisdir=$token->[2]->{'href'};
4615: }
4616: }
4617: }
4618: $thisdir=~s-/[^/]*$--;
1.356 albertel 4619: foreach my $link (@rlinks) {
1.726 raeburn 4620: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4621: ($link=~/^\//) ||
4622: ($link=~/^javascript:/i) ||
4623: ($link=~/^mailto:/i) ||
4624: ($link=~/^\#/)) {
4625: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4626: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4627: }
4628: }
4629: # -------------------------------------------------- Deal with Applet codebases
4630: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4631: return $output;
4632: }
4633:
1.112 bowersj2 4634: =pod
4635:
1.648 raeburn 4636: =item * &get_student_view()
1.112 bowersj2 4637:
4638: show a snapshot of what student was looking at
4639:
4640: =cut
4641:
1.10 albertel 4642: sub get_student_view {
1.186 albertel 4643: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4644: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4645: my (%form);
1.10 albertel 4646: my @elements=('symb','courseid','domain','username');
4647: foreach my $element (@elements) {
1.186 albertel 4648: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4649: }
1.186 albertel 4650: if (defined($moreenv)) {
4651: %form=(%form,%{$moreenv});
4652: }
1.236 albertel 4653: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4654: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4655: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4656: $userview=~s/\<body[^\>]*\>//gi;
4657: $userview=~s/\<\/body\>//gi;
4658: $userview=~s/\<html\>//gi;
4659: $userview=~s/\<\/html\>//gi;
4660: $userview=~s/\<head\>//gi;
4661: $userview=~s/\<\/head\>//gi;
4662: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4663: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4664: if (wantarray) {
4665: return ($userview,$response);
4666: } else {
4667: return $userview;
4668: }
4669: }
4670:
4671: sub get_student_view_with_retries {
4672: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4673:
4674: my $ok = 0; # True if we got a good response.
4675: my $content;
4676: my $response;
4677:
4678: # Try to get the student_view done. within the retries count:
4679:
4680: do {
4681: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4682: $ok = $response->is_success;
4683: if (!$ok) {
4684: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4685: }
4686: $retries--;
4687: } while (!$ok && ($retries > 0));
4688:
4689: if (!$ok) {
4690: $content = ''; # On error return an empty content.
4691: }
1.651 www 4692: if (wantarray) {
4693: return ($content, $response);
4694: } else {
4695: return $content;
4696: }
1.11 albertel 4697: }
4698:
1.112 bowersj2 4699: =pod
4700:
1.648 raeburn 4701: =item * &get_student_answers()
1.112 bowersj2 4702:
4703: show a snapshot of how student was answering problem
4704:
4705: =cut
4706:
1.11 albertel 4707: sub get_student_answers {
1.100 sakharuk 4708: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4709: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4710: my (%moreenv);
1.11 albertel 4711: my @elements=('symb','courseid','domain','username');
4712: foreach my $element (@elements) {
1.186 albertel 4713: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4714: }
1.186 albertel 4715: $moreenv{'grade_target'}='answer';
4716: %moreenv=(%form,%moreenv);
1.497 raeburn 4717: $feedurl = &Apache::lonnet::clutter($feedurl);
4718: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4719: return $userview;
1.1 albertel 4720: }
1.116 albertel 4721:
4722: =pod
4723:
4724: =item * &submlink()
4725:
1.242 albertel 4726: Inputs: $text $uname $udom $symb $target
1.116 albertel 4727:
4728: Returns: A link to grades.pm such as to see the SUBM view of a student
4729:
4730: =cut
4731:
4732: ###############################################
4733: sub submlink {
1.242 albertel 4734: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4735: if (!($uname && $udom)) {
4736: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4737: &Apache::lonnet::whichuser($symb);
1.116 albertel 4738: if (!$symb) { $symb=$cursymb; }
4739: }
1.254 matthew 4740: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4741: $symb=&escape($symb);
1.960 bisitz 4742: if ($target) { $target=" target=\"$target\""; }
4743: return
4744: '<a href="/adm/grades?command=submission'.
4745: '&symb='.$symb.
4746: '&student='.$uname.
4747: '&userdom='.$udom.'"'.
4748: $target.'>'.$text.'</a>';
1.242 albertel 4749: }
4750: ##############################################
4751:
4752: =pod
4753:
4754: =item * &pgrdlink()
4755:
4756: Inputs: $text $uname $udom $symb $target
4757:
4758: Returns: A link to grades.pm such as to see the PGRD view of a student
4759:
4760: =cut
4761:
4762: ###############################################
4763: sub pgrdlink {
4764: my $link=&submlink(@_);
4765: $link=~s/(&command=submission)/$1&showgrading=yes/;
4766: return $link;
4767: }
4768: ##############################################
4769:
4770: =pod
4771:
4772: =item * &pprmlink()
4773:
4774: Inputs: $text $uname $udom $symb $target
4775:
4776: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4777: student and a specific resource
1.242 albertel 4778:
4779: =cut
4780:
4781: ###############################################
4782: sub pprmlink {
4783: my ($text,$uname,$udom,$symb,$target)=@_;
4784: if (!($uname && $udom)) {
4785: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4786: &Apache::lonnet::whichuser($symb);
1.242 albertel 4787: if (!$symb) { $symb=$cursymb; }
4788: }
1.254 matthew 4789: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4790: $symb=&escape($symb);
1.242 albertel 4791: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4792: return '<a href="/adm/parmset?command=set&'.
4793: 'symb='.$symb.'&uname='.$uname.
4794: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4795: }
4796: ##############################################
1.37 matthew 4797:
1.112 bowersj2 4798: =pod
4799:
4800: =back
4801:
4802: =cut
4803:
1.37 matthew 4804: ###############################################
1.51 www 4805:
4806:
4807: sub timehash {
1.687 raeburn 4808: my ($thistime) = @_;
4809: my $timezone = &Apache::lonlocal::gettimezone();
4810: my $dt = DateTime->from_epoch(epoch => $thistime)
4811: ->set_time_zone($timezone);
4812: my $wday = $dt->day_of_week();
4813: if ($wday == 7) { $wday = 0; }
4814: return ( 'second' => $dt->second(),
4815: 'minute' => $dt->minute(),
4816: 'hour' => $dt->hour(),
4817: 'day' => $dt->day_of_month(),
4818: 'month' => $dt->month(),
4819: 'year' => $dt->year(),
4820: 'weekday' => $wday,
4821: 'dayyear' => $dt->day_of_year(),
4822: 'dlsav' => $dt->is_dst() );
1.51 www 4823: }
4824:
1.370 www 4825: sub utc_string {
4826: my ($date)=@_;
1.371 www 4827: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4828: }
4829:
1.51 www 4830: sub maketime {
4831: my %th=@_;
1.687 raeburn 4832: my ($epoch_time,$timezone,$dt);
4833: $timezone = &Apache::lonlocal::gettimezone();
4834: eval {
4835: $dt = DateTime->new( year => $th{'year'},
4836: month => $th{'month'},
4837: day => $th{'day'},
4838: hour => $th{'hour'},
4839: minute => $th{'minute'},
4840: second => $th{'second'},
4841: time_zone => $timezone,
4842: );
4843: };
4844: if (!$@) {
4845: $epoch_time = $dt->epoch;
4846: if ($epoch_time) {
4847: return $epoch_time;
4848: }
4849: }
1.51 www 4850: return POSIX::mktime(
4851: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4852: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4853: }
4854:
4855: #########################################
1.51 www 4856:
4857: sub findallcourses {
1.482 raeburn 4858: my ($roles,$uname,$udom) = @_;
1.355 albertel 4859: my %roles;
4860: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4861: my %courses;
1.51 www 4862: my $now=time;
1.482 raeburn 4863: if (!defined($uname)) {
4864: $uname = $env{'user.name'};
4865: }
4866: if (!defined($udom)) {
4867: $udom = $env{'user.domain'};
4868: }
4869: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4870: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4871: if (!%roles) {
4872: %roles = (
4873: cc => 1,
1.907 raeburn 4874: co => 1,
1.482 raeburn 4875: in => 1,
4876: ep => 1,
4877: ta => 1,
4878: cr => 1,
4879: st => 1,
4880: );
4881: }
4882: foreach my $entry (keys(%roleshash)) {
4883: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4884: if ($trole =~ /^cr/) {
4885: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4886: } else {
4887: next if (!exists($roles{$trole}));
4888: }
4889: if ($tend) {
4890: next if ($tend < $now);
4891: }
4892: if ($tstart) {
4893: next if ($tstart > $now);
4894: }
1.1058 raeburn 4895: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4896: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4897: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4898: if ($secpart eq '') {
4899: ($cnum,$role) = split(/_/,$cnumpart);
4900: $sec = 'none';
1.1058 raeburn 4901: $value .= $cnum.'/';
1.482 raeburn 4902: } else {
4903: $cnum = $cnumpart;
4904: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4905: $value .= $cnum.'/'.$sec;
4906: }
4907: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4908: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4909: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4910: }
4911: } else {
4912: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4913: }
1.482 raeburn 4914: }
4915: } else {
4916: foreach my $key (keys(%env)) {
1.483 albertel 4917: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4918: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4919: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4920: next if ($role eq 'ca' || $role eq 'aa');
4921: next if (%roles && !exists($roles{$role}));
4922: my ($starttime,$endtime)=split(/\./,$env{$key});
4923: my $active=1;
4924: if ($starttime) {
4925: if ($now<$starttime) { $active=0; }
4926: }
4927: if ($endtime) {
4928: if ($now>$endtime) { $active=0; }
4929: }
4930: if ($active) {
1.1058 raeburn 4931: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4932: if ($sec eq '') {
4933: $sec = 'none';
1.1058 raeburn 4934: } else {
4935: $value .= $sec;
4936: }
4937: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4938: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4939: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4940: }
4941: } else {
4942: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4943: }
1.474 raeburn 4944: }
4945: }
1.51 www 4946: }
4947: }
1.474 raeburn 4948: return %courses;
1.51 www 4949: }
1.37 matthew 4950:
1.54 www 4951: ###############################################
1.474 raeburn 4952:
4953: sub blockcheck {
1.1189 raeburn 4954: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4955:
1.1189 raeburn 4956: if (defined($udom) && defined($uname)) {
4957: # If uname and udom are for a course, check for blocks in the course.
4958: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4959: my ($startblock,$endblock,$triggerblock) =
4960: &get_blocks($setters,$activity,$udom,$uname,$url);
4961: return ($startblock,$endblock,$triggerblock);
4962: }
4963: } else {
1.490 raeburn 4964: $udom = $env{'user.domain'};
4965: $uname = $env{'user.name'};
4966: }
4967:
1.502 raeburn 4968: my $startblock = 0;
4969: my $endblock = 0;
1.1062 raeburn 4970: my $triggerblock = '';
1.482 raeburn 4971: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4972:
1.490 raeburn 4973: # If uname is for a user, and activity is course-specific, i.e.,
4974: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4975:
1.490 raeburn 4976: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4977: $activity eq 'groups' || $activity eq 'printout') &&
4978: ($env{'request.course.id'})) {
1.490 raeburn 4979: foreach my $key (keys(%live_courses)) {
4980: if ($key ne $env{'request.course.id'}) {
4981: delete($live_courses{$key});
4982: }
4983: }
4984: }
4985:
4986: my $otheruser = 0;
4987: my %own_courses;
4988: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4989: # Resource belongs to user other than current user.
4990: $otheruser = 1;
4991: # Gather courses for current user
4992: %own_courses =
4993: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4994: }
4995:
4996: # Gather active course roles - course coordinator, instructor,
4997: # exam proctor, ta, student, or custom role.
1.474 raeburn 4998:
4999: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5000: my ($cdom,$cnum);
5001: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5002: $cdom = $env{'course.'.$course.'.domain'};
5003: $cnum = $env{'course.'.$course.'.num'};
5004: } else {
1.490 raeburn 5005: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5006: }
5007: my $no_ownblock = 0;
5008: my $no_userblock = 0;
1.533 raeburn 5009: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5010: # Check if current user has 'evb' priv for this
5011: if (defined($own_courses{$course})) {
5012: foreach my $sec (keys(%{$own_courses{$course}})) {
5013: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5014: if ($sec ne 'none') {
5015: $checkrole .= '/'.$sec;
5016: }
5017: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5018: $no_ownblock = 1;
5019: last;
5020: }
5021: }
5022: }
5023: # if they have 'evb' priv and are currently not playing student
5024: next if (($no_ownblock) &&
5025: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5026: }
1.474 raeburn 5027: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5028: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5029: if ($sec ne 'none') {
1.482 raeburn 5030: $checkrole .= '/'.$sec;
1.474 raeburn 5031: }
1.490 raeburn 5032: if ($otheruser) {
5033: # Resource belongs to user other than current user.
5034: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5035: my (%allroles,%userroles);
5036: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5037: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5038: my ($trole,$tdom,$tnum,$tsec);
5039: if ($entry =~ /^cr/) {
5040: ($trole,$tdom,$tnum,$tsec) =
5041: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5042: } else {
5043: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5044: }
5045: my ($spec,$area,$trest);
5046: $area = '/'.$tdom.'/'.$tnum;
5047: $trest = $tnum;
5048: if ($tsec ne '') {
5049: $area .= '/'.$tsec;
5050: $trest .= '/'.$tsec;
5051: }
5052: $spec = $trole.'.'.$area;
5053: if ($trole =~ /^cr/) {
5054: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5055: $tdom,$spec,$trest,$area);
5056: } else {
5057: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5058: $tdom,$spec,$trest,$area);
5059: }
5060: }
5061: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
5062: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5063: if ($1) {
5064: $no_userblock = 1;
5065: last;
5066: }
1.486 raeburn 5067: }
5068: }
1.490 raeburn 5069: } else {
5070: # Resource belongs to current user
5071: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5072: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5073: $no_ownblock = 1;
5074: last;
5075: }
1.474 raeburn 5076: }
5077: }
5078: # if they have the evb priv and are currently not playing student
1.482 raeburn 5079: next if (($no_ownblock) &&
1.491 albertel 5080: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5081: next if ($no_userblock);
1.474 raeburn 5082:
1.866 kalberla 5083: # Retrieve blocking times and identity of locker for course
1.490 raeburn 5084: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 5085:
1.1062 raeburn 5086: my ($start,$end,$trigger) =
5087: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5088: if (($start != 0) &&
5089: (($startblock == 0) || ($startblock > $start))) {
5090: $startblock = $start;
1.1062 raeburn 5091: if ($trigger ne '') {
5092: $triggerblock = $trigger;
5093: }
1.502 raeburn 5094: }
5095: if (($end != 0) &&
5096: (($endblock == 0) || ($endblock < $end))) {
5097: $endblock = $end;
1.1062 raeburn 5098: if ($trigger ne '') {
5099: $triggerblock = $trigger;
5100: }
1.502 raeburn 5101: }
1.490 raeburn 5102: }
1.1062 raeburn 5103: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5104: }
5105:
5106: sub get_blocks {
1.1062 raeburn 5107: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5108: my $startblock = 0;
5109: my $endblock = 0;
1.1062 raeburn 5110: my $triggerblock = '';
1.490 raeburn 5111: my $course = $cdom.'_'.$cnum;
5112: $setters->{$course} = {};
5113: $setters->{$course}{'staff'} = [];
5114: $setters->{$course}{'times'} = [];
1.1062 raeburn 5115: $setters->{$course}{'triggers'} = [];
5116: my (@blockers,%triggered);
5117: my $now = time;
5118: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5119: if ($activity eq 'docs') {
5120: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5121: foreach my $block (@blockers) {
5122: if ($block =~ /^firstaccess____(.+)$/) {
5123: my $item = $1;
5124: my $type = 'map';
5125: my $timersymb = $item;
5126: if ($item eq 'course') {
5127: $type = 'course';
5128: } elsif ($item =~ /___\d+___/) {
5129: $type = 'resource';
5130: } else {
5131: $timersymb = &Apache::lonnet::symbread($item);
5132: }
5133: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5134: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5135: $triggered{$block} = {
5136: start => $start,
5137: end => $end,
5138: type => $type,
5139: };
5140: }
5141: }
5142: } else {
5143: foreach my $block (keys(%commblocks)) {
5144: if ($block =~ m/^(\d+)____(\d+)$/) {
5145: my ($start,$end) = ($1,$2);
5146: if ($start <= time && $end >= time) {
5147: if (ref($commblocks{$block}) eq 'HASH') {
5148: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5149: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5150: unless(grep(/^\Q$block\E$/,@blockers)) {
5151: push(@blockers,$block);
5152: }
5153: }
5154: }
5155: }
5156: }
5157: } elsif ($block =~ /^firstaccess____(.+)$/) {
5158: my $item = $1;
5159: my $timersymb = $item;
5160: my $type = 'map';
5161: if ($item eq 'course') {
5162: $type = 'course';
5163: } elsif ($item =~ /___\d+___/) {
5164: $type = 'resource';
5165: } else {
5166: $timersymb = &Apache::lonnet::symbread($item);
5167: }
5168: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5169: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5170: if ($start && $end) {
5171: if (($start <= time) && ($end >= time)) {
5172: unless (grep(/^\Q$block\E$/,@blockers)) {
5173: push(@blockers,$block);
5174: $triggered{$block} = {
5175: start => $start,
5176: end => $end,
5177: type => $type,
5178: };
5179: }
5180: }
1.490 raeburn 5181: }
1.1062 raeburn 5182: }
5183: }
5184: }
5185: foreach my $blocker (@blockers) {
5186: my ($staff_name,$staff_dom,$title,$blocks) =
5187: &parse_block_record($commblocks{$blocker});
5188: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5189: my ($start,$end,$triggertype);
5190: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5191: ($start,$end) = ($1,$2);
5192: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5193: $start = $triggered{$blocker}{'start'};
5194: $end = $triggered{$blocker}{'end'};
5195: $triggertype = $triggered{$blocker}{'type'};
5196: }
5197: if ($start) {
5198: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5199: if ($triggertype) {
5200: push(@{$$setters{$course}{'triggers'}},$triggertype);
5201: } else {
5202: push(@{$$setters{$course}{'triggers'}},0);
5203: }
5204: if ( ($startblock == 0) || ($startblock > $start) ) {
5205: $startblock = $start;
5206: if ($triggertype) {
5207: $triggerblock = $blocker;
1.474 raeburn 5208: }
5209: }
1.1062 raeburn 5210: if ( ($endblock == 0) || ($endblock < $end) ) {
5211: $endblock = $end;
5212: if ($triggertype) {
5213: $triggerblock = $blocker;
5214: }
5215: }
1.474 raeburn 5216: }
5217: }
1.1062 raeburn 5218: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5219: }
5220:
5221: sub parse_block_record {
5222: my ($record) = @_;
5223: my ($setuname,$setudom,$title,$blocks);
5224: if (ref($record) eq 'HASH') {
5225: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5226: $title = &unescape($record->{'event'});
5227: $blocks = $record->{'blocks'};
5228: } else {
5229: my @data = split(/:/,$record,3);
5230: if (scalar(@data) eq 2) {
5231: $title = $data[1];
5232: ($setuname,$setudom) = split(/@/,$data[0]);
5233: } else {
5234: ($setuname,$setudom,$title) = @data;
5235: }
5236: $blocks = { 'com' => 'on' };
5237: }
5238: return ($setuname,$setudom,$title,$blocks);
5239: }
5240:
1.854 kalberla 5241: sub blocking_status {
1.1189 raeburn 5242: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5243: my %setters;
1.890 droeschl 5244:
1.1061 raeburn 5245: # check for active blocking
1.1062 raeburn 5246: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5247: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5248: my $blocked = 0;
5249: if ($startblock && $endblock) {
5250: $blocked = 1;
5251: }
1.890 droeschl 5252:
1.1061 raeburn 5253: # caller just wants to know whether a block is active
5254: if (!wantarray) { return $blocked; }
5255:
5256: # build a link to a popup window containing the details
5257: my $querystring = "?activity=$activity";
5258: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5259: if (($activity eq 'port') || ($activity eq 'passwd')) {
5260: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5261: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5262: } elsif ($activity eq 'docs') {
5263: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5264: }
1.1061 raeburn 5265:
5266: my $output .= <<'END_MYBLOCK';
5267: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5268: var options = "width=" + w + ",height=" + h + ",";
5269: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5270: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5271: var newWin = window.open(url, wdwName, options);
5272: newWin.focus();
5273: }
1.890 droeschl 5274: END_MYBLOCK
1.854 kalberla 5275:
1.1061 raeburn 5276: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5277:
1.1061 raeburn 5278: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5279: my $text = &mt('Communication Blocked');
1.1217 raeburn 5280: my $class = 'LC_comblock';
1.1062 raeburn 5281: if ($activity eq 'docs') {
5282: $text = &mt('Content Access Blocked');
1.1217 raeburn 5283: $class = '';
1.1063 raeburn 5284: } elsif ($activity eq 'printout') {
5285: $text = &mt('Printing Blocked');
1.1232 raeburn 5286: } elsif ($activity eq 'passwd') {
5287: $text = &mt('Password Changing Blocked');
1.1062 raeburn 5288: }
1.1061 raeburn 5289: $output .= <<"END_BLOCK";
1.1217 raeburn 5290: <div class='$class'>
1.869 kalberla 5291: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5292: title='$text'>
5293: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5294: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5295: title='$text'>$text</a>
1.867 kalberla 5296: </div>
5297:
5298: END_BLOCK
1.474 raeburn 5299:
1.1061 raeburn 5300: return ($blocked, $output);
1.854 kalberla 5301: }
1.490 raeburn 5302:
1.60 matthew 5303: ###############################################
5304:
1.682 raeburn 5305: sub check_ip_acc {
1.1201 raeburn 5306: my ($acc,$clientip)=@_;
1.682 raeburn 5307: &Apache::lonxml::debug("acc is $acc");
5308: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5309: return 1;
5310: }
1.1219 raeburn 5311: my $allowed;
1.1252 raeburn 5312: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5313:
5314: my $name;
1.1219 raeburn 5315: my %access = (
5316: allowfrom => 1,
5317: denyfrom => 0,
5318: );
5319: my @allows;
5320: my @denies;
5321: foreach my $item (split(',',$acc)) {
5322: $item =~ s/^\s*//;
5323: $item =~ s/\s*$//;
5324: my $pattern;
5325: if ($item =~ /^\!(.+)$/) {
5326: push(@denies,$1);
5327: } else {
5328: push(@allows,$item);
5329: }
5330: }
5331: my $numdenies = scalar(@denies);
5332: my $numallows = scalar(@allows);
5333: my $count = 0;
5334: foreach my $pattern (@denies,@allows) {
5335: $count ++;
5336: my $acctype = 'allowfrom';
5337: if ($count <= $numdenies) {
5338: $acctype = 'denyfrom';
5339: }
1.682 raeburn 5340: if ($pattern =~ /\*$/) {
5341: #35.8.*
5342: $pattern=~s/\*//;
1.1219 raeburn 5343: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5344: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5345: #35.8.3.[34-56]
5346: my $low=$2;
5347: my $high=$3;
5348: $pattern=$1;
5349: if ($ip =~ /^\Q$pattern\E/) {
5350: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5351: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5352: }
5353: } elsif ($pattern =~ /^\*/) {
5354: #*.msu.edu
5355: $pattern=~s/\*//;
5356: if (!defined($name)) {
5357: use Socket;
5358: my $netaddr=inet_aton($ip);
5359: ($name)=gethostbyaddr($netaddr,AF_INET);
5360: }
1.1219 raeburn 5361: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5362: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5363: #127.0.0.1
1.1219 raeburn 5364: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5365: } else {
5366: #some.name.com
5367: if (!defined($name)) {
5368: use Socket;
5369: my $netaddr=inet_aton($ip);
5370: ($name)=gethostbyaddr($netaddr,AF_INET);
5371: }
1.1219 raeburn 5372: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5373: }
5374: if ($allowed =~ /^(0|1)$/) { last; }
5375: }
5376: if ($allowed eq '') {
5377: if ($numdenies && !$numallows) {
5378: $allowed = 1;
5379: } else {
5380: $allowed = 0;
1.682 raeburn 5381: }
5382: }
5383: return $allowed;
5384: }
5385:
5386: ###############################################
5387:
1.60 matthew 5388: =pod
5389:
1.112 bowersj2 5390: =head1 Domain Template Functions
5391:
5392: =over 4
5393:
5394: =item * &determinedomain()
1.60 matthew 5395:
5396: Inputs: $domain (usually will be undef)
5397:
1.63 www 5398: Returns: Determines which domain should be used for designs
1.60 matthew 5399:
5400: =cut
1.54 www 5401:
1.60 matthew 5402: ###############################################
1.63 www 5403: sub determinedomain {
5404: my $domain=shift;
1.531 albertel 5405: if (! $domain) {
1.60 matthew 5406: # Determine domain if we have not been given one
1.893 raeburn 5407: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5408: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5409: if ($env{'request.role.domain'}) {
5410: $domain=$env{'request.role.domain'};
1.60 matthew 5411: }
5412: }
1.63 www 5413: return $domain;
5414: }
5415: ###############################################
1.517 raeburn 5416:
1.518 albertel 5417: sub devalidate_domconfig_cache {
5418: my ($udom)=@_;
5419: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5420: }
5421:
5422: # ---------------------- Get domain configuration for a domain
5423: sub get_domainconf {
5424: my ($udom) = @_;
5425: my $cachetime=1800;
5426: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5427: if (defined($cached)) { return %{$result}; }
5428:
5429: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5430: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5431: my (%designhash,%legacy);
1.518 albertel 5432: if (keys(%domconfig) > 0) {
5433: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5434: if (keys(%{$domconfig{'login'}})) {
5435: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5436: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5437: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5438: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5439: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5440: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5441: if ($key eq 'loginvia') {
5442: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5443: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5444: $designhash{$udom.'.login.loginvia'} = $server;
5445: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5446:
5447: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5448: } else {
5449: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5450: }
1.948 raeburn 5451: }
1.1208 raeburn 5452: } elsif ($key eq 'headtag') {
5453: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5454: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5455: }
1.946 raeburn 5456: }
1.1208 raeburn 5457: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5458: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5459: }
1.946 raeburn 5460: }
5461: }
5462: }
5463: } else {
5464: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5465: $designhash{$udom.'.login.'.$key.'_'.$img} =
5466: $domconfig{'login'}{$key}{$img};
5467: }
1.699 raeburn 5468: }
5469: } else {
5470: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5471: }
1.632 raeburn 5472: }
5473: } else {
5474: $legacy{'login'} = 1;
1.518 albertel 5475: }
1.632 raeburn 5476: } else {
5477: $legacy{'login'} = 1;
1.518 albertel 5478: }
5479: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5480: if (keys(%{$domconfig{'rolecolors'}})) {
5481: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5482: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5483: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5484: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5485: }
1.518 albertel 5486: }
5487: }
1.632 raeburn 5488: } else {
5489: $legacy{'rolecolors'} = 1;
1.518 albertel 5490: }
1.632 raeburn 5491: } else {
5492: $legacy{'rolecolors'} = 1;
1.518 albertel 5493: }
1.948 raeburn 5494: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5495: if ($domconfig{'autoenroll'}{'co-owners'}) {
5496: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5497: }
5498: }
1.632 raeburn 5499: if (keys(%legacy) > 0) {
5500: my %legacyhash = &get_legacy_domconf($udom);
5501: foreach my $item (keys(%legacyhash)) {
5502: if ($item =~ /^\Q$udom\E\.login/) {
5503: if ($legacy{'login'}) {
5504: $designhash{$item} = $legacyhash{$item};
5505: }
5506: } else {
5507: if ($legacy{'rolecolors'}) {
5508: $designhash{$item} = $legacyhash{$item};
5509: }
1.518 albertel 5510: }
5511: }
5512: }
1.632 raeburn 5513: } else {
5514: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5515: }
5516: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5517: $cachetime);
5518: return %designhash;
5519: }
5520:
1.632 raeburn 5521: sub get_legacy_domconf {
5522: my ($udom) = @_;
5523: my %legacyhash;
5524: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5525: my $designfile = $designdir.'/'.$udom.'.tab';
5526: if (-e $designfile) {
5527: if ( open (my $fh,"<$designfile") ) {
5528: while (my $line = <$fh>) {
5529: next if ($line =~ /^\#/);
5530: chomp($line);
5531: my ($key,$val)=(split(/\=/,$line));
5532: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5533: }
5534: close($fh);
5535: }
5536: }
1.1026 raeburn 5537: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5538: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5539: }
5540: return %legacyhash;
5541: }
5542:
1.63 www 5543: =pod
5544:
1.112 bowersj2 5545: =item * &domainlogo()
1.63 www 5546:
5547: Inputs: $domain (usually will be undef)
5548:
5549: Returns: A link to a domain logo, if the domain logo exists.
5550: If the domain logo does not exist, a description of the domain.
5551:
5552: =cut
1.112 bowersj2 5553:
1.63 www 5554: ###############################################
5555: sub domainlogo {
1.517 raeburn 5556: my $domain = &determinedomain(shift);
1.518 albertel 5557: my %designhash = &get_domainconf($domain);
1.517 raeburn 5558: # See if there is a logo
5559: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5560: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5561: if ($imgsrc =~ m{^/(adm|res)/}) {
5562: if ($imgsrc =~ m{^/res/}) {
5563: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5564: &Apache::lonnet::repcopy($local_name);
5565: }
5566: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5567: }
5568: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5569: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5570: return &Apache::lonnet::domain($domain,'description');
1.59 www 5571: } else {
1.60 matthew 5572: return '';
1.59 www 5573: }
5574: }
1.63 www 5575: ##############################################
5576:
5577: =pod
5578:
1.112 bowersj2 5579: =item * &designparm()
1.63 www 5580:
5581: Inputs: $which parameter; $domain (usually will be undef)
5582:
5583: Returns: value of designparamter $which
5584:
5585: =cut
1.112 bowersj2 5586:
1.397 albertel 5587:
1.400 albertel 5588: ##############################################
1.397 albertel 5589: sub designparm {
5590: my ($which,$domain)=@_;
5591: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5592: return $env{'environment.color.'.$which};
1.96 www 5593: }
1.63 www 5594: $domain=&determinedomain($domain);
1.1016 raeburn 5595: my %domdesign;
5596: unless ($domain eq 'public') {
5597: %domdesign = &get_domainconf($domain);
5598: }
1.520 raeburn 5599: my $output;
1.517 raeburn 5600: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5601: $output = $domdesign{$domain.'.'.$which};
1.63 www 5602: } else {
1.520 raeburn 5603: $output = $defaultdesign{$which};
5604: }
5605: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5606: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5607: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5608: if ($output =~ m{^/res/}) {
5609: my $local_name = &Apache::lonnet::filelocation('',$output);
5610: &Apache::lonnet::repcopy($local_name);
5611: }
1.520 raeburn 5612: $output = &lonhttpdurl($output);
5613: }
1.63 www 5614: }
1.520 raeburn 5615: return $output;
1.63 www 5616: }
1.59 www 5617:
1.822 bisitz 5618: ##############################################
5619: =pod
5620:
1.832 bisitz 5621: =item * &authorspace()
5622:
1.1028 raeburn 5623: Inputs: $url (usually will be undef).
1.832 bisitz 5624:
1.1132 raeburn 5625: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5626: directory being viewed (or for which action is being taken).
5627: If $url is provided, and begins /priv/<domain>/<uname>
5628: the path will be that portion of the $context argument.
5629: Otherwise the path will be for the author space of the current
5630: user when the current role is author, or for that of the
5631: co-author/assistant co-author space when the current role
5632: is co-author or assistant co-author.
1.832 bisitz 5633:
5634: =cut
5635:
5636: sub authorspace {
1.1028 raeburn 5637: my ($url) = @_;
5638: if ($url ne '') {
5639: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5640: return $1;
5641: }
5642: }
1.832 bisitz 5643: my $caname = '';
1.1024 www 5644: my $cadom = '';
1.1028 raeburn 5645: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5646: ($cadom,$caname) =
1.832 bisitz 5647: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5648: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5649: $caname = $env{'user.name'};
1.1024 www 5650: $cadom = $env{'user.domain'};
1.832 bisitz 5651: }
1.1028 raeburn 5652: if (($caname ne '') && ($cadom ne '')) {
5653: return "/priv/$cadom/$caname/";
5654: }
5655: return;
1.832 bisitz 5656: }
5657:
5658: ##############################################
5659: =pod
5660:
1.822 bisitz 5661: =item * &head_subbox()
5662:
5663: Inputs: $content (contains HTML code with page functions, etc.)
5664:
5665: Returns: HTML div with $content
5666: To be included in page header
5667:
5668: =cut
5669:
5670: sub head_subbox {
5671: my ($content)=@_;
5672: my $output =
1.993 raeburn 5673: '<div class="LC_head_subbox">'
1.822 bisitz 5674: .$content
5675: .'</div>'
5676: }
5677:
5678: ##############################################
5679: =pod
5680:
5681: =item * &CSTR_pageheader()
5682:
1.1026 raeburn 5683: Input: (optional) filename from which breadcrumb trail is built.
5684: In most cases no input as needed, as $env{'request.filename'}
5685: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5686:
5687: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5688: To be included on Authoring Space pages
1.822 bisitz 5689:
5690: =cut
5691:
5692: sub CSTR_pageheader {
1.1026 raeburn 5693: my ($trailfile) = @_;
5694: if ($trailfile eq '') {
5695: $trailfile = $env{'request.filename'};
5696: }
5697:
5698: # this is for resources; directories have customtitle, and crumbs
5699: # and select recent are created in lonpubdir.pm
5700:
5701: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5702: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5703: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5704: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5705: $formaction =~ s{/+}{/}g;
1.822 bisitz 5706:
5707: my $parentpath = '';
5708: my $lastitem = '';
5709: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5710: $parentpath = $1;
5711: $lastitem = $2;
5712: } else {
5713: $lastitem = $thisdisfn;
5714: }
1.921 bisitz 5715:
1.1246 raeburn 5716: my ($crsauthor,$title);
5717: if (($env{'request.course.id'}) &&
5718: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5719: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5720: $crsauthor = 1;
5721: $title = &mt('Course Authoring Space');
5722: } else {
5723: $title = &mt('Authoring Space');
5724: }
5725:
1.921 bisitz 5726: my $output =
1.822 bisitz 5727: '<div>'
5728: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5729: .'<b>'.$title.'</b> '
1.822 bisitz 5730: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5731: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5732: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5733:
5734: if ($lastitem) {
5735: $output .=
5736: '<span class="LC_filename">'
5737: .$lastitem
5738: .'</span>';
5739: }
1.1245 raeburn 5740:
1.1246 raeburn 5741: if ($crsauthor) {
5742: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5743: } else {
5744: $output .=
5745: '<br />'
5746: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5747: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5748: .'</form>'
5749: .&Apache::lonmenu::constspaceform();
5750: }
5751: $output .= '</div>';
1.921 bisitz 5752:
5753: return $output;
1.822 bisitz 5754: }
5755:
1.60 matthew 5756: ###############################################
5757: ###############################################
5758:
5759: =pod
5760:
1.112 bowersj2 5761: =back
5762:
1.549 albertel 5763: =head1 HTML Helpers
1.112 bowersj2 5764:
5765: =over 4
5766:
5767: =item * &bodytag()
1.60 matthew 5768:
5769: Returns a uniform header for LON-CAPA web pages.
5770:
5771: Inputs:
5772:
1.112 bowersj2 5773: =over 4
5774:
5775: =item * $title, A title to be displayed on the page.
5776:
5777: =item * $function, the current role (can be undef).
5778:
5779: =item * $addentries, extra parameters for the <body> tag.
5780:
5781: =item * $bodyonly, if defined, only return the <body> tag.
5782:
5783: =item * $domain, if defined, force a given domain.
5784:
5785: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5786: text interface only)
1.60 matthew 5787:
1.814 bisitz 5788: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5789: navigational links
1.317 albertel 5790:
1.338 albertel 5791: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5792:
1.460 albertel 5793: =item * $args, optional argument valid values are
5794: no_auto_mt_title -> prevents &mt()ing the title arg
5795:
1.1096 raeburn 5796: =item * $advtoolsref, optional argument, ref to an array containing
5797: inlineremote items to be added in "Functions" menu below
5798: breadcrumbs.
5799:
1.112 bowersj2 5800: =back
5801:
1.60 matthew 5802: Returns: A uniform header for LON-CAPA web pages.
5803: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5804: If $bodyonly is undef or zero, an html string containing a <body> tag and
5805: other decorations will be returned.
5806:
5807: =cut
5808:
1.54 www 5809: sub bodytag {
1.831 bisitz 5810: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5811: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5812:
1.954 raeburn 5813: my $public;
5814: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5815: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5816: $public = 1;
5817: }
1.460 albertel 5818: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5819: my $httphost = $args->{'use_absolute'};
1.339 albertel 5820:
1.183 matthew 5821: $function = &get_users_function() if (!$function);
1.339 albertel 5822: my $img = &designparm($function.'.img',$domain);
5823: my $font = &designparm($function.'.font',$domain);
5824: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5825:
1.803 bisitz 5826: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5827: 'bgcolor' => $pgbg,
1.339 albertel 5828: 'text' => $font,
5829: 'alink' => &designparm($function.'.alink',$domain),
5830: 'vlink' => &designparm($function.'.vlink',$domain),
5831: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5832: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5833:
1.63 www 5834: # role and realm
1.1178 raeburn 5835: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5836: if ($realm) {
5837: $realm = '/'.$realm;
5838: }
1.378 raeburn 5839: if ($role eq 'ca') {
1.479 albertel 5840: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5841: $realm = &plainname($rname,$rdom);
1.378 raeburn 5842: }
1.55 www 5843: # realm
1.258 albertel 5844: if ($env{'request.course.id'}) {
1.378 raeburn 5845: if ($env{'request.role'} !~ /^cr/) {
5846: $role = &Apache::lonnet::plaintext($role,&course_type());
5847: }
1.898 raeburn 5848: if ($env{'request.course.sec'}) {
5849: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5850: }
1.359 albertel 5851: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5852: } else {
5853: $role = &Apache::lonnet::plaintext($role);
1.54 www 5854: }
1.433 albertel 5855:
1.359 albertel 5856: if (!$realm) { $realm=' '; }
1.330 albertel 5857:
1.438 albertel 5858: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5859:
1.101 www 5860: # construct main body tag
1.359 albertel 5861: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5862: &Apache::lontexconvert::init_math_support();
1.252 albertel 5863:
1.1131 raeburn 5864: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5865:
1.1130 raeburn 5866: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5867: return $bodytag;
1.1130 raeburn 5868: }
1.359 albertel 5869:
1.954 raeburn 5870: if ($public) {
1.433 albertel 5871: undef($role);
5872: }
1.359 albertel 5873:
1.762 bisitz 5874: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5875: #
5876: # Extra info if you are the DC
5877: my $dc_info = '';
5878: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5879: $env{'course.'.$env{'request.course.id'}.
5880: '.domain'}.'/'})) {
5881: my $cid = $env{'request.course.id'};
1.917 raeburn 5882: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5883: $dc_info =~ s/\s+$//;
1.359 albertel 5884: }
5885:
1.1237 raeburn 5886: my $crstype;
5887: if ($env{'request.course.id'}) {
5888: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5889: } elsif ($args->{'crstype'}) {
5890: $crstype = $args->{'crstype'};
5891: }
5892: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5893: undef($role);
5894: } else {
1.1242 raeburn 5895: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 5896: }
1.853 droeschl 5897:
1.903 droeschl 5898: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5899:
5900: # if ($env{'request.state'} eq 'construct') {
5901: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5902: # }
5903:
1.1130 raeburn 5904: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5905: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5906:
1.1237 raeburn 5907: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5908:
1.916 droeschl 5909: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5910: if ($dc_info) {
5911: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5912: }
1.1130 raeburn 5913: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5914: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5915: return $bodytag;
5916: }
1.894 droeschl 5917:
1.927 raeburn 5918: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5919: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5920: }
1.916 droeschl 5921:
1.1130 raeburn 5922: $bodytag .= $right;
1.852 droeschl 5923:
1.917 raeburn 5924: if ($dc_info) {
5925: $dc_info = &dc_courseid_toggle($dc_info);
5926: }
5927: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5928:
1.1169 raeburn 5929: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5930: if ($args->{'no_secondary_menu'}) {
5931: return $bodytag;
5932: }
1.1169 raeburn 5933: #don't show menus for public users
1.954 raeburn 5934: if (!$public){
1.1154 raeburn 5935: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5936: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5937: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5938: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5939: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5940: $args->{'bread_crumbs'});
1.1096 raeburn 5941: } elsif ($forcereg) {
5942: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5943: $args->{'group'});
5944: } else {
5945: $bodytag .=
5946: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5947: $forcereg,$args->{'group'},
5948: $args->{'bread_crumbs'},
5949: $advtoolsref);
1.920 raeburn 5950: }
1.903 droeschl 5951: }else{
5952: # this is to seperate menu from content when there's no secondary
5953: # menu. Especially needed for public accessible ressources.
5954: $bodytag .= '<hr style="clear:both" />';
5955: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5956: }
1.903 droeschl 5957:
1.235 raeburn 5958: return $bodytag;
1.182 matthew 5959: }
5960:
1.917 raeburn 5961: sub dc_courseid_toggle {
5962: my ($dc_info) = @_;
1.980 raeburn 5963: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5964: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5965: &mt('(More ...)').'</a></span>'.
5966: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5967: }
5968:
1.330 albertel 5969: sub make_attr_string {
5970: my ($register,$attr_ref) = @_;
5971:
5972: if ($attr_ref && !ref($attr_ref)) {
5973: die("addentries Must be a hash ref ".
5974: join(':',caller(1))." ".
5975: join(':',caller(0))." ");
5976: }
5977:
5978: if ($register) {
1.339 albertel 5979: my ($on_load,$on_unload);
5980: foreach my $key (keys(%{$attr_ref})) {
5981: if (lc($key) eq 'onload') {
5982: $on_load.=$attr_ref->{$key}.';';
5983: delete($attr_ref->{$key});
5984:
5985: } elsif (lc($key) eq 'onunload') {
5986: $on_unload.=$attr_ref->{$key}.';';
5987: delete($attr_ref->{$key});
5988: }
5989: }
1.953 droeschl 5990: $attr_ref->{'onload'} = $on_load;
5991: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5992: }
1.339 albertel 5993:
1.330 albertel 5994: my $attr_string;
1.1159 raeburn 5995: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5996: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5997: }
5998: return $attr_string;
5999: }
6000:
6001:
1.182 matthew 6002: ###############################################
1.251 albertel 6003: ###############################################
6004:
6005: =pod
6006:
6007: =item * &endbodytag()
6008:
6009: Returns a uniform footer for LON-CAPA web pages.
6010:
1.635 raeburn 6011: Inputs: 1 - optional reference to an args hash
6012: If in the hash, key for noredirectlink has a value which evaluates to true,
6013: a 'Continue' link is not displayed if the page contains an
6014: internal redirect in the <head></head> section,
6015: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6016:
6017: =cut
6018:
6019: sub endbodytag {
1.635 raeburn 6020: my ($args) = @_;
1.1080 raeburn 6021: my $endbodytag;
6022: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6023: $endbodytag='</body>';
6024: }
1.315 albertel 6025: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6026: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6027: $endbodytag=
6028: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6029: &mt('Continue').'</a>'.
6030: $endbodytag;
6031: }
1.315 albertel 6032: }
1.251 albertel 6033: return $endbodytag;
6034: }
6035:
1.352 albertel 6036: =pod
6037:
6038: =item * &standard_css()
6039:
6040: Returns a style sheet
6041:
6042: Inputs: (all optional)
6043: domain -> force to color decorate a page for a specific
6044: domain
6045: function -> force usage of a specific rolish color scheme
6046: bgcolor -> override the default page bgcolor
6047:
6048: =cut
6049:
1.343 albertel 6050: sub standard_css {
1.345 albertel 6051: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6052: $function = &get_users_function() if (!$function);
6053: my $img = &designparm($function.'.img', $domain);
6054: my $tabbg = &designparm($function.'.tabbg', $domain);
6055: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6056: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6057: #second colour for later usage
1.345 albertel 6058: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6059: my $pgbg_or_bgcolor =
6060: $bgcolor ||
1.352 albertel 6061: &designparm($function.'.pgbg', $domain);
1.382 albertel 6062: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6063: my $alink = &designparm($function.'.alink', $domain);
6064: my $vlink = &designparm($function.'.vlink', $domain);
6065: my $link = &designparm($function.'.link', $domain);
6066:
1.602 albertel 6067: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6068: my $mono = 'monospace';
1.850 bisitz 6069: my $data_table_head = $sidebg;
6070: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6071: my $data_table_dark = '#E0E0E0';
1.470 banghart 6072: my $data_table_darker = '#CCCCCC';
1.349 albertel 6073: my $data_table_highlight = '#FFFF00';
1.352 albertel 6074: my $mail_new = '#FFBB77';
6075: my $mail_new_hover = '#DD9955';
6076: my $mail_read = '#BBBB77';
6077: my $mail_read_hover = '#999944';
6078: my $mail_replied = '#AAAA88';
6079: my $mail_replied_hover = '#888855';
6080: my $mail_other = '#99BBBB';
6081: my $mail_other_hover = '#669999';
1.391 albertel 6082: my $table_header = '#DDDDDD';
1.489 raeburn 6083: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6084: my $lg_border_color = '#C8C8C8';
1.952 onken 6085: my $button_hover = '#BF2317';
1.392 albertel 6086:
1.608 albertel 6087: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6088: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6089: : '0 3px 0 4px';
1.448 albertel 6090:
1.523 albertel 6091:
1.343 albertel 6092: return <<END;
1.947 droeschl 6093:
6094: /* needed for iframe to allow 100% height in FF */
6095: body, html {
6096: margin: 0;
6097: padding: 0 0.5%;
6098: height: 99%; /* to avoid scrollbars */
6099: }
6100:
1.795 www 6101: body {
1.911 bisitz 6102: font-family: $sans;
6103: line-height:130%;
6104: font-size:0.83em;
6105: color:$font;
1.795 www 6106: }
6107:
1.959 onken 6108: a:focus,
6109: a:focus img {
1.795 www 6110: color: red;
6111: }
1.698 harmsja 6112:
1.911 bisitz 6113: form, .inline {
6114: display: inline;
1.795 www 6115: }
1.721 harmsja 6116:
1.795 www 6117: .LC_right {
1.911 bisitz 6118: text-align:right;
1.795 www 6119: }
6120:
6121: .LC_middle {
1.911 bisitz 6122: vertical-align:middle;
1.795 www 6123: }
1.721 harmsja 6124:
1.1130 raeburn 6125: .LC_floatleft {
6126: float: left;
6127: }
6128:
6129: .LC_floatright {
6130: float: right;
6131: }
6132:
1.911 bisitz 6133: .LC_400Box {
6134: width:400px;
6135: }
1.721 harmsja 6136:
1.947 droeschl 6137: .LC_iframecontainer {
6138: width: 98%;
6139: margin: 0;
6140: position: fixed;
6141: top: 8.5em;
6142: bottom: 0;
6143: }
6144:
6145: .LC_iframecontainer iframe{
6146: border: none;
6147: width: 100%;
6148: height: 100%;
6149: }
6150:
1.778 bisitz 6151: .LC_filename {
6152: font-family: $mono;
6153: white-space:pre;
1.921 bisitz 6154: font-size: 120%;
1.778 bisitz 6155: }
6156:
6157: .LC_fileicon {
6158: border: none;
6159: height: 1.3em;
6160: vertical-align: text-bottom;
6161: margin-right: 0.3em;
6162: text-decoration:none;
6163: }
6164:
1.1008 www 6165: .LC_setting {
6166: text-decoration:underline;
6167: }
6168:
1.350 albertel 6169: .LC_error {
6170: color: red;
6171: }
1.795 www 6172:
1.1097 bisitz 6173: .LC_warning {
6174: color: darkorange;
6175: }
6176:
1.457 albertel 6177: .LC_diff_removed {
1.733 bisitz 6178: color: red;
1.394 albertel 6179: }
1.532 albertel 6180:
6181: .LC_info,
1.457 albertel 6182: .LC_success,
6183: .LC_diff_added {
1.350 albertel 6184: color: green;
6185: }
1.795 www 6186:
1.802 bisitz 6187: div.LC_confirm_box {
6188: background-color: #FAFAFA;
6189: border: 1px solid $lg_border_color;
6190: margin-right: 0;
6191: padding: 5px;
6192: }
6193:
6194: div.LC_confirm_box .LC_error img,
6195: div.LC_confirm_box .LC_success img {
6196: vertical-align: middle;
6197: }
6198:
1.1242 raeburn 6199: .LC_maxwidth {
6200: max-width: 100%;
6201: height: auto;
6202: }
6203:
1.1243 raeburn 6204: .LC_textsize_mobile {
6205: \@media only screen and (max-device-width: 480px) {
6206: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6207: }
6208: }
6209:
1.440 albertel 6210: .LC_icon {
1.771 droeschl 6211: border: none;
1.790 droeschl 6212: vertical-align: middle;
1.771 droeschl 6213: }
6214:
1.543 albertel 6215: .LC_docs_spacer {
6216: width: 25px;
6217: height: 1px;
1.771 droeschl 6218: border: none;
1.543 albertel 6219: }
1.346 albertel 6220:
1.532 albertel 6221: .LC_internal_info {
1.735 bisitz 6222: color: #999999;
1.532 albertel 6223: }
6224:
1.794 www 6225: .LC_discussion {
1.1050 www 6226: background: $data_table_dark;
1.911 bisitz 6227: border: 1px solid black;
6228: margin: 2px;
1.794 www 6229: }
6230:
6231: .LC_disc_action_left {
1.1050 www 6232: background: $sidebg;
1.911 bisitz 6233: text-align: left;
1.1050 www 6234: padding: 4px;
6235: margin: 2px;
1.794 www 6236: }
6237:
6238: .LC_disc_action_right {
1.1050 www 6239: background: $sidebg;
1.911 bisitz 6240: text-align: right;
1.1050 www 6241: padding: 4px;
6242: margin: 2px;
1.794 www 6243: }
6244:
6245: .LC_disc_new_item {
1.911 bisitz 6246: background: white;
6247: border: 2px solid red;
1.1050 www 6248: margin: 4px;
6249: padding: 4px;
1.794 www 6250: }
6251:
6252: .LC_disc_old_item {
1.911 bisitz 6253: background: white;
1.1050 www 6254: margin: 4px;
6255: padding: 4px;
1.794 www 6256: }
6257:
1.458 albertel 6258: table.LC_pastsubmission {
6259: border: 1px solid black;
6260: margin: 2px;
6261: }
6262:
1.924 bisitz 6263: table#LC_menubuttons {
1.345 albertel 6264: width: 100%;
6265: background: $pgbg;
1.392 albertel 6266: border: 2px;
1.402 albertel 6267: border-collapse: separate;
1.803 bisitz 6268: padding: 0;
1.345 albertel 6269: }
1.392 albertel 6270:
1.801 tempelho 6271: table#LC_title_bar a {
6272: color: $fontmenu;
6273: }
1.836 bisitz 6274:
1.807 droeschl 6275: table#LC_title_bar {
1.819 tempelho 6276: clear: both;
1.836 bisitz 6277: display: none;
1.807 droeschl 6278: }
6279:
1.795 www 6280: table#LC_title_bar,
1.933 droeschl 6281: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6282: table#LC_title_bar.LC_with_remote {
1.359 albertel 6283: width: 100%;
1.392 albertel 6284: border-color: $pgbg;
6285: border-style: solid;
6286: border-width: $border;
1.379 albertel 6287: background: $pgbg;
1.801 tempelho 6288: color: $fontmenu;
1.392 albertel 6289: border-collapse: collapse;
1.803 bisitz 6290: padding: 0;
1.819 tempelho 6291: margin: 0;
1.359 albertel 6292: }
1.795 www 6293:
1.933 droeschl 6294: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6295: margin: 0;
6296: padding: 0;
1.933 droeschl 6297: position: relative;
6298: list-style: none;
1.913 droeschl 6299: }
1.933 droeschl 6300: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6301: display: inline;
6302: }
1.933 droeschl 6303:
6304: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6305: padding: 0;
1.933 droeschl 6306: margin: 0;
6307: float: left;
1.913 droeschl 6308: }
1.933 droeschl 6309: .LC_breadcrumb_tools_tools {
6310: padding: 0;
6311: margin: 0;
1.913 droeschl 6312: float: right;
6313: }
6314:
1.1240 raeburn 6315: .LC_placement_prog {
6316: padding-right: 20px;
6317: font-weight: bold;
6318: font-size: 90%;
6319: }
6320:
1.359 albertel 6321: table#LC_title_bar td {
6322: background: $tabbg;
6323: }
1.795 www 6324:
1.911 bisitz 6325: table#LC_menubuttons img {
1.803 bisitz 6326: border: none;
1.346 albertel 6327: }
1.795 www 6328:
1.842 droeschl 6329: .LC_breadcrumbs_component {
1.911 bisitz 6330: float: right;
6331: margin: 0 1em;
1.357 albertel 6332: }
1.842 droeschl 6333: .LC_breadcrumbs_component img {
1.911 bisitz 6334: vertical-align: middle;
1.777 tempelho 6335: }
1.795 www 6336:
1.1243 raeburn 6337: .LC_breadcrumbs_hoverable {
6338: background: $sidebg;
6339: }
6340:
1.383 albertel 6341: td.LC_table_cell_checkbox {
6342: text-align: center;
6343: }
1.795 www 6344:
6345: .LC_fontsize_small {
1.911 bisitz 6346: font-size: 70%;
1.705 tempelho 6347: }
6348:
1.844 bisitz 6349: #LC_breadcrumbs {
1.911 bisitz 6350: clear:both;
6351: background: $sidebg;
6352: border-bottom: 1px solid $lg_border_color;
6353: line-height: 2.5em;
1.933 droeschl 6354: overflow: hidden;
1.911 bisitz 6355: margin: 0;
6356: padding: 0;
1.995 raeburn 6357: text-align: left;
1.819 tempelho 6358: }
1.862 bisitz 6359:
1.1098 bisitz 6360: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6361: clear:both;
6362: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6363: border: 1px solid $sidebg;
1.1098 bisitz 6364: margin: 0 0 10px 0;
1.966 bisitz 6365: padding: 3px;
1.995 raeburn 6366: text-align: left;
1.822 bisitz 6367: }
6368:
1.795 www 6369: .LC_fontsize_medium {
1.911 bisitz 6370: font-size: 85%;
1.705 tempelho 6371: }
6372:
1.795 www 6373: .LC_fontsize_large {
1.911 bisitz 6374: font-size: 120%;
1.705 tempelho 6375: }
6376:
1.346 albertel 6377: .LC_menubuttons_inline_text {
6378: color: $font;
1.698 harmsja 6379: font-size: 90%;
1.701 harmsja 6380: padding-left:3px;
1.346 albertel 6381: }
6382:
1.934 droeschl 6383: .LC_menubuttons_inline_text img{
6384: vertical-align: middle;
6385: }
6386:
1.1051 www 6387: li.LC_menubuttons_inline_text img {
1.951 onken 6388: cursor:pointer;
1.1002 droeschl 6389: text-decoration: none;
1.951 onken 6390: }
6391:
1.526 www 6392: .LC_menubuttons_link {
6393: text-decoration: none;
6394: }
1.795 www 6395:
1.522 albertel 6396: .LC_menubuttons_category {
1.521 www 6397: color: $font;
1.526 www 6398: background: $pgbg;
1.521 www 6399: font-size: larger;
6400: font-weight: bold;
6401: }
6402:
1.346 albertel 6403: td.LC_menubuttons_text {
1.911 bisitz 6404: color: $font;
1.346 albertel 6405: }
1.706 harmsja 6406:
1.346 albertel 6407: .LC_current_location {
6408: background: $tabbg;
6409: }
1.795 www 6410:
1.938 bisitz 6411: table.LC_data_table {
1.347 albertel 6412: border: 1px solid #000000;
1.402 albertel 6413: border-collapse: separate;
1.426 albertel 6414: border-spacing: 1px;
1.610 albertel 6415: background: $pgbg;
1.347 albertel 6416: }
1.795 www 6417:
1.422 albertel 6418: .LC_data_table_dense {
6419: font-size: small;
6420: }
1.795 www 6421:
1.507 raeburn 6422: table.LC_nested_outer {
6423: border: 1px solid #000000;
1.589 raeburn 6424: border-collapse: collapse;
1.803 bisitz 6425: border-spacing: 0;
1.507 raeburn 6426: width: 100%;
6427: }
1.795 www 6428:
1.879 raeburn 6429: table.LC_innerpickbox,
1.507 raeburn 6430: table.LC_nested {
1.803 bisitz 6431: border: none;
1.589 raeburn 6432: border-collapse: collapse;
1.803 bisitz 6433: border-spacing: 0;
1.507 raeburn 6434: width: 100%;
6435: }
1.795 www 6436:
1.911 bisitz 6437: table.LC_data_table tr th,
6438: table.LC_calendar tr th,
1.879 raeburn 6439: table.LC_prior_tries tr th,
6440: table.LC_innerpickbox tr th {
1.349 albertel 6441: font-weight: bold;
6442: background-color: $data_table_head;
1.801 tempelho 6443: color:$fontmenu;
1.701 harmsja 6444: font-size:90%;
1.347 albertel 6445: }
1.795 www 6446:
1.879 raeburn 6447: table.LC_innerpickbox tr th,
6448: table.LC_innerpickbox tr td {
6449: vertical-align: top;
6450: }
6451:
1.711 raeburn 6452: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6453: background-color: #CCCCCC;
1.711 raeburn 6454: font-weight: bold;
6455: text-align: left;
6456: }
1.795 www 6457:
1.912 bisitz 6458: table.LC_data_table tr.LC_odd_row > td {
6459: background-color: $data_table_light;
6460: padding: 2px;
6461: vertical-align: top;
6462: }
6463:
1.809 bisitz 6464: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6465: background-color: $data_table_light;
1.912 bisitz 6466: vertical-align: top;
6467: }
6468:
6469: table.LC_data_table tr.LC_even_row > td {
6470: background-color: $data_table_dark;
1.425 albertel 6471: padding: 2px;
1.900 bisitz 6472: vertical-align: top;
1.347 albertel 6473: }
1.795 www 6474:
1.809 bisitz 6475: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6476: background-color: $data_table_dark;
1.900 bisitz 6477: vertical-align: top;
1.347 albertel 6478: }
1.795 www 6479:
1.425 albertel 6480: table.LC_data_table tr.LC_data_table_highlight td {
6481: background-color: $data_table_darker;
6482: }
1.795 www 6483:
1.639 raeburn 6484: table.LC_data_table tr td.LC_leftcol_header {
6485: background-color: $data_table_head;
6486: font-weight: bold;
6487: }
1.795 www 6488:
1.451 albertel 6489: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6490: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6491: font-weight: bold;
6492: font-style: italic;
6493: text-align: center;
6494: padding: 8px;
1.347 albertel 6495: }
1.795 www 6496:
1.1114 raeburn 6497: table.LC_data_table tr.LC_empty_row td,
6498: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6499: background-color: $sidebg;
6500: }
6501:
6502: table.LC_nested tr.LC_empty_row td {
6503: background-color: #FFFFFF;
6504: }
6505:
1.890 droeschl 6506: table.LC_caption {
6507: }
6508:
1.507 raeburn 6509: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6510: padding: 4ex
6511: }
1.795 www 6512:
1.507 raeburn 6513: table.LC_nested_outer tr th {
6514: font-weight: bold;
1.801 tempelho 6515: color:$fontmenu;
1.507 raeburn 6516: background-color: $data_table_head;
1.701 harmsja 6517: font-size: small;
1.507 raeburn 6518: border-bottom: 1px solid #000000;
6519: }
1.795 www 6520:
1.507 raeburn 6521: table.LC_nested_outer tr td.LC_subheader {
6522: background-color: $data_table_head;
6523: font-weight: bold;
6524: font-size: small;
6525: border-bottom: 1px solid #000000;
6526: text-align: right;
1.451 albertel 6527: }
1.795 www 6528:
1.507 raeburn 6529: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6530: background-color: #CCCCCC;
1.451 albertel 6531: font-weight: bold;
6532: font-size: small;
1.507 raeburn 6533: text-align: center;
6534: }
1.795 www 6535:
1.589 raeburn 6536: table.LC_nested tr.LC_info_row td.LC_left_item,
6537: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6538: text-align: left;
1.451 albertel 6539: }
1.795 www 6540:
1.507 raeburn 6541: table.LC_nested td {
1.735 bisitz 6542: background-color: #FFFFFF;
1.451 albertel 6543: font-size: small;
1.507 raeburn 6544: }
1.795 www 6545:
1.507 raeburn 6546: table.LC_nested_outer tr th.LC_right_item,
6547: table.LC_nested tr.LC_info_row td.LC_right_item,
6548: table.LC_nested tr.LC_odd_row td.LC_right_item,
6549: table.LC_nested tr td.LC_right_item {
1.451 albertel 6550: text-align: right;
6551: }
6552:
1.507 raeburn 6553: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6554: background-color: #EEEEEE;
1.451 albertel 6555: }
6556:
1.473 raeburn 6557: table.LC_createuser {
6558: }
6559:
6560: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6561: font-size: small;
1.473 raeburn 6562: }
6563:
6564: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6565: background-color: #CCCCCC;
1.473 raeburn 6566: font-weight: bold;
6567: text-align: center;
6568: }
6569:
1.349 albertel 6570: table.LC_calendar {
6571: border: 1px solid #000000;
6572: border-collapse: collapse;
1.917 raeburn 6573: width: 98%;
1.349 albertel 6574: }
1.795 www 6575:
1.349 albertel 6576: table.LC_calendar_pickdate {
6577: font-size: xx-small;
6578: }
1.795 www 6579:
1.349 albertel 6580: table.LC_calendar tr td {
6581: border: 1px solid #000000;
6582: vertical-align: top;
1.917 raeburn 6583: width: 14%;
1.349 albertel 6584: }
1.795 www 6585:
1.349 albertel 6586: table.LC_calendar tr td.LC_calendar_day_empty {
6587: background-color: $data_table_dark;
6588: }
1.795 www 6589:
1.779 bisitz 6590: table.LC_calendar tr td.LC_calendar_day_current {
6591: background-color: $data_table_highlight;
1.777 tempelho 6592: }
1.795 www 6593:
1.938 bisitz 6594: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6595: background-color: $mail_new;
6596: }
1.795 www 6597:
1.938 bisitz 6598: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6599: background-color: $mail_new_hover;
6600: }
1.795 www 6601:
1.938 bisitz 6602: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6603: background-color: $mail_read;
6604: }
1.795 www 6605:
1.938 bisitz 6606: /*
6607: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6608: background-color: $mail_read_hover;
6609: }
1.938 bisitz 6610: */
1.795 www 6611:
1.938 bisitz 6612: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6613: background-color: $mail_replied;
6614: }
1.795 www 6615:
1.938 bisitz 6616: /*
6617: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6618: background-color: $mail_replied_hover;
6619: }
1.938 bisitz 6620: */
1.795 www 6621:
1.938 bisitz 6622: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6623: background-color: $mail_other;
6624: }
1.795 www 6625:
1.938 bisitz 6626: /*
6627: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6628: background-color: $mail_other_hover;
6629: }
1.938 bisitz 6630: */
1.494 raeburn 6631:
1.777 tempelho 6632: table.LC_data_table tr > td.LC_browser_file,
6633: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6634: background: #AAEE77;
1.389 albertel 6635: }
1.795 www 6636:
1.777 tempelho 6637: table.LC_data_table tr > td.LC_browser_file_locked,
6638: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6639: background: #FFAA99;
1.387 albertel 6640: }
1.795 www 6641:
1.777 tempelho 6642: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6643: background: #888888;
1.779 bisitz 6644: }
1.795 www 6645:
1.777 tempelho 6646: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6647: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6648: background: #F8F866;
1.777 tempelho 6649: }
1.795 www 6650:
1.696 bisitz 6651: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6652: background: #E0E8FF;
1.387 albertel 6653: }
1.696 bisitz 6654:
1.707 bisitz 6655: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6656: /* background: #77FF77; */
1.707 bisitz 6657: }
1.795 www 6658:
1.707 bisitz 6659: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6660: border-right: 8px solid #FFFF77;
1.707 bisitz 6661: }
1.795 www 6662:
1.707 bisitz 6663: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6664: border-right: 8px solid #FFAA77;
1.707 bisitz 6665: }
1.795 www 6666:
1.707 bisitz 6667: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6668: border-right: 8px solid #FF7777;
1.707 bisitz 6669: }
1.795 www 6670:
1.707 bisitz 6671: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6672: border-right: 8px solid #AAFF77;
1.707 bisitz 6673: }
1.795 www 6674:
1.707 bisitz 6675: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6676: border-right: 8px solid #11CC55;
1.707 bisitz 6677: }
6678:
1.388 albertel 6679: span.LC_current_location {
1.701 harmsja 6680: font-size:larger;
1.388 albertel 6681: background: $pgbg;
6682: }
1.387 albertel 6683:
1.1029 www 6684: span.LC_current_nav_location {
6685: font-weight:bold;
6686: background: $sidebg;
6687: }
6688:
1.395 albertel 6689: span.LC_parm_menu_item {
6690: font-size: larger;
6691: }
1.795 www 6692:
1.395 albertel 6693: span.LC_parm_scope_all {
6694: color: red;
6695: }
1.795 www 6696:
1.395 albertel 6697: span.LC_parm_scope_folder {
6698: color: green;
6699: }
1.795 www 6700:
1.395 albertel 6701: span.LC_parm_scope_resource {
6702: color: orange;
6703: }
1.795 www 6704:
1.395 albertel 6705: span.LC_parm_part {
6706: color: blue;
6707: }
1.795 www 6708:
1.911 bisitz 6709: span.LC_parm_folder,
6710: span.LC_parm_symb {
1.395 albertel 6711: font-size: x-small;
6712: font-family: $mono;
6713: color: #AAAAAA;
6714: }
6715:
1.977 bisitz 6716: ul.LC_parm_parmlist li {
6717: display: inline-block;
6718: padding: 0.3em 0.8em;
6719: vertical-align: top;
6720: width: 150px;
6721: border-top:1px solid $lg_border_color;
6722: }
6723:
1.795 www 6724: td.LC_parm_overview_level_menu,
6725: td.LC_parm_overview_map_menu,
6726: td.LC_parm_overview_parm_selectors,
6727: td.LC_parm_overview_restrictions {
1.396 albertel 6728: border: 1px solid black;
6729: border-collapse: collapse;
6730: }
1.795 www 6731:
1.396 albertel 6732: table.LC_parm_overview_restrictions td {
6733: border-width: 1px 4px 1px 4px;
6734: border-style: solid;
6735: border-color: $pgbg;
6736: text-align: center;
6737: }
1.795 www 6738:
1.396 albertel 6739: table.LC_parm_overview_restrictions th {
6740: background: $tabbg;
6741: border-width: 1px 4px 1px 4px;
6742: border-style: solid;
6743: border-color: $pgbg;
6744: }
1.795 www 6745:
1.398 albertel 6746: table#LC_helpmenu {
1.803 bisitz 6747: border: none;
1.398 albertel 6748: height: 55px;
1.803 bisitz 6749: border-spacing: 0;
1.398 albertel 6750: }
6751:
6752: table#LC_helpmenu fieldset legend {
6753: font-size: larger;
6754: }
1.795 www 6755:
1.397 albertel 6756: table#LC_helpmenu_links {
6757: width: 100%;
6758: border: 1px solid black;
6759: background: $pgbg;
1.803 bisitz 6760: padding: 0;
1.397 albertel 6761: border-spacing: 1px;
6762: }
1.795 www 6763:
1.397 albertel 6764: table#LC_helpmenu_links tr td {
6765: padding: 1px;
6766: background: $tabbg;
1.399 albertel 6767: text-align: center;
6768: font-weight: bold;
1.397 albertel 6769: }
1.396 albertel 6770:
1.795 www 6771: table#LC_helpmenu_links a:link,
6772: table#LC_helpmenu_links a:visited,
1.397 albertel 6773: table#LC_helpmenu_links a:active {
6774: text-decoration: none;
6775: color: $font;
6776: }
1.795 www 6777:
1.397 albertel 6778: table#LC_helpmenu_links a:hover {
6779: text-decoration: underline;
6780: color: $vlink;
6781: }
1.396 albertel 6782:
1.417 albertel 6783: .LC_chrt_popup_exists {
6784: border: 1px solid #339933;
6785: margin: -1px;
6786: }
1.795 www 6787:
1.417 albertel 6788: .LC_chrt_popup_up {
6789: border: 1px solid yellow;
6790: margin: -1px;
6791: }
1.795 www 6792:
1.417 albertel 6793: .LC_chrt_popup {
6794: border: 1px solid #8888FF;
6795: background: #CCCCFF;
6796: }
1.795 www 6797:
1.421 albertel 6798: table.LC_pick_box {
6799: border-collapse: separate;
6800: background: white;
6801: border: 1px solid black;
6802: border-spacing: 1px;
6803: }
1.795 www 6804:
1.421 albertel 6805: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6806: background: $sidebg;
1.421 albertel 6807: font-weight: bold;
1.900 bisitz 6808: text-align: left;
1.740 bisitz 6809: vertical-align: top;
1.421 albertel 6810: width: 184px;
6811: padding: 8px;
6812: }
1.795 www 6813:
1.579 raeburn 6814: table.LC_pick_box td.LC_pick_box_value {
6815: text-align: left;
6816: padding: 8px;
6817: }
1.795 www 6818:
1.579 raeburn 6819: table.LC_pick_box td.LC_pick_box_select {
6820: text-align: left;
6821: padding: 8px;
6822: }
1.795 www 6823:
1.424 albertel 6824: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6825: padding: 0;
1.421 albertel 6826: height: 1px;
6827: background: black;
6828: }
1.795 www 6829:
1.421 albertel 6830: table.LC_pick_box td.LC_pick_box_submit {
6831: text-align: right;
6832: }
1.795 www 6833:
1.579 raeburn 6834: table.LC_pick_box td.LC_evenrow_value {
6835: text-align: left;
6836: padding: 8px;
6837: background-color: $data_table_light;
6838: }
1.795 www 6839:
1.579 raeburn 6840: table.LC_pick_box td.LC_oddrow_value {
6841: text-align: left;
6842: padding: 8px;
6843: background-color: $data_table_light;
6844: }
1.795 www 6845:
1.579 raeburn 6846: span.LC_helpform_receipt_cat {
6847: font-weight: bold;
6848: }
1.795 www 6849:
1.424 albertel 6850: table.LC_group_priv_box {
6851: background: white;
6852: border: 1px solid black;
6853: border-spacing: 1px;
6854: }
1.795 www 6855:
1.424 albertel 6856: table.LC_group_priv_box td.LC_pick_box_title {
6857: background: $tabbg;
6858: font-weight: bold;
6859: text-align: right;
6860: width: 184px;
6861: }
1.795 www 6862:
1.424 albertel 6863: table.LC_group_priv_box td.LC_groups_fixed {
6864: background: $data_table_light;
6865: text-align: center;
6866: }
1.795 www 6867:
1.424 albertel 6868: table.LC_group_priv_box td.LC_groups_optional {
6869: background: $data_table_dark;
6870: text-align: center;
6871: }
1.795 www 6872:
1.424 albertel 6873: table.LC_group_priv_box td.LC_groups_functionality {
6874: background: $data_table_darker;
6875: text-align: center;
6876: font-weight: bold;
6877: }
1.795 www 6878:
1.424 albertel 6879: table.LC_group_priv td {
6880: text-align: left;
1.803 bisitz 6881: padding: 0;
1.424 albertel 6882: }
6883:
6884: .LC_navbuttons {
6885: margin: 2ex 0ex 2ex 0ex;
6886: }
1.795 www 6887:
1.423 albertel 6888: .LC_topic_bar {
6889: font-weight: bold;
6890: background: $tabbg;
1.918 wenzelju 6891: margin: 1em 0em 1em 2em;
1.805 bisitz 6892: padding: 3px;
1.918 wenzelju 6893: font-size: 1.2em;
1.423 albertel 6894: }
1.795 www 6895:
1.423 albertel 6896: .LC_topic_bar span {
1.918 wenzelju 6897: left: 0.5em;
6898: position: absolute;
1.423 albertel 6899: vertical-align: middle;
1.918 wenzelju 6900: font-size: 1.2em;
1.423 albertel 6901: }
1.795 www 6902:
1.423 albertel 6903: table.LC_course_group_status {
6904: margin: 20px;
6905: }
1.795 www 6906:
1.423 albertel 6907: table.LC_status_selector td {
6908: vertical-align: top;
6909: text-align: center;
1.424 albertel 6910: padding: 4px;
6911: }
1.795 www 6912:
1.599 albertel 6913: div.LC_feedback_link {
1.616 albertel 6914: clear: both;
1.829 kalberla 6915: background: $sidebg;
1.779 bisitz 6916: width: 100%;
1.829 kalberla 6917: padding-bottom: 10px;
6918: border: 1px $tabbg solid;
1.833 kalberla 6919: height: 22px;
6920: line-height: 22px;
6921: padding-top: 5px;
6922: }
6923:
6924: div.LC_feedback_link img {
6925: height: 22px;
1.867 kalberla 6926: vertical-align:middle;
1.829 kalberla 6927: }
6928:
1.911 bisitz 6929: div.LC_feedback_link a {
1.829 kalberla 6930: text-decoration: none;
1.489 raeburn 6931: }
1.795 www 6932:
1.867 kalberla 6933: div.LC_comblock {
1.911 bisitz 6934: display:inline;
1.867 kalberla 6935: color:$font;
6936: font-size:90%;
6937: }
6938:
6939: div.LC_feedback_link div.LC_comblock {
6940: padding-left:5px;
6941: }
6942:
6943: div.LC_feedback_link div.LC_comblock a {
6944: color:$font;
6945: }
6946:
1.489 raeburn 6947: span.LC_feedback_link {
1.858 bisitz 6948: /* background: $feedback_link_bg; */
1.599 albertel 6949: font-size: larger;
6950: }
1.795 www 6951:
1.599 albertel 6952: span.LC_message_link {
1.858 bisitz 6953: /* background: $feedback_link_bg; */
1.599 albertel 6954: font-size: larger;
6955: position: absolute;
6956: right: 1em;
1.489 raeburn 6957: }
1.421 albertel 6958:
1.515 albertel 6959: table.LC_prior_tries {
1.524 albertel 6960: border: 1px solid #000000;
6961: border-collapse: separate;
6962: border-spacing: 1px;
1.515 albertel 6963: }
1.523 albertel 6964:
1.515 albertel 6965: table.LC_prior_tries td {
1.524 albertel 6966: padding: 2px;
1.515 albertel 6967: }
1.523 albertel 6968:
6969: .LC_answer_correct {
1.795 www 6970: background: lightgreen;
6971: color: darkgreen;
6972: padding: 6px;
1.523 albertel 6973: }
1.795 www 6974:
1.523 albertel 6975: .LC_answer_charged_try {
1.797 www 6976: background: #FFAAAA;
1.795 www 6977: color: darkred;
6978: padding: 6px;
1.523 albertel 6979: }
1.795 www 6980:
1.779 bisitz 6981: .LC_answer_not_charged_try,
1.523 albertel 6982: .LC_answer_no_grade,
6983: .LC_answer_late {
1.795 www 6984: background: lightyellow;
1.523 albertel 6985: color: black;
1.795 www 6986: padding: 6px;
1.523 albertel 6987: }
1.795 www 6988:
1.523 albertel 6989: .LC_answer_previous {
1.795 www 6990: background: lightblue;
6991: color: darkblue;
6992: padding: 6px;
1.523 albertel 6993: }
1.795 www 6994:
1.779 bisitz 6995: .LC_answer_no_message {
1.777 tempelho 6996: background: #FFFFFF;
6997: color: black;
1.795 www 6998: padding: 6px;
1.779 bisitz 6999: }
1.795 www 7000:
1.779 bisitz 7001: .LC_answer_unknown {
7002: background: orange;
7003: color: black;
1.795 www 7004: padding: 6px;
1.777 tempelho 7005: }
1.795 www 7006:
1.529 albertel 7007: span.LC_prior_numerical,
7008: span.LC_prior_string,
7009: span.LC_prior_custom,
7010: span.LC_prior_reaction,
7011: span.LC_prior_math {
1.925 bisitz 7012: font-family: $mono;
1.523 albertel 7013: white-space: pre;
7014: }
7015:
1.525 albertel 7016: span.LC_prior_string {
1.925 bisitz 7017: font-family: $mono;
1.525 albertel 7018: white-space: pre;
7019: }
7020:
1.523 albertel 7021: table.LC_prior_option {
7022: width: 100%;
7023: border-collapse: collapse;
7024: }
1.795 www 7025:
1.911 bisitz 7026: table.LC_prior_rank,
1.795 www 7027: table.LC_prior_match {
1.528 albertel 7028: border-collapse: collapse;
7029: }
1.795 www 7030:
1.528 albertel 7031: table.LC_prior_option tr td,
7032: table.LC_prior_rank tr td,
7033: table.LC_prior_match tr td {
1.524 albertel 7034: border: 1px solid #000000;
1.515 albertel 7035: }
7036:
1.855 bisitz 7037: .LC_nobreak {
1.544 albertel 7038: white-space: nowrap;
1.519 raeburn 7039: }
7040:
1.576 raeburn 7041: span.LC_cusr_emph {
7042: font-style: italic;
7043: }
7044:
1.633 raeburn 7045: span.LC_cusr_subheading {
7046: font-weight: normal;
7047: font-size: 85%;
7048: }
7049:
1.861 bisitz 7050: div.LC_docs_entry_move {
1.859 bisitz 7051: border: 1px solid #BBBBBB;
1.545 albertel 7052: background: #DDDDDD;
1.861 bisitz 7053: width: 22px;
1.859 bisitz 7054: padding: 1px;
7055: margin: 0;
1.545 albertel 7056: }
7057:
1.861 bisitz 7058: table.LC_data_table tr > td.LC_docs_entry_commands,
7059: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7060: font-size: x-small;
7061: }
1.795 www 7062:
1.861 bisitz 7063: .LC_docs_entry_parameter {
7064: white-space: nowrap;
7065: }
7066:
1.544 albertel 7067: .LC_docs_copy {
1.545 albertel 7068: color: #000099;
1.544 albertel 7069: }
1.795 www 7070:
1.544 albertel 7071: .LC_docs_cut {
1.545 albertel 7072: color: #550044;
1.544 albertel 7073: }
1.795 www 7074:
1.544 albertel 7075: .LC_docs_rename {
1.545 albertel 7076: color: #009900;
1.544 albertel 7077: }
1.795 www 7078:
1.544 albertel 7079: .LC_docs_remove {
1.545 albertel 7080: color: #990000;
7081: }
7082:
1.547 albertel 7083: .LC_docs_reinit_warn,
7084: .LC_docs_ext_edit {
7085: font-size: x-small;
7086: }
7087:
1.545 albertel 7088: table.LC_docs_adddocs td,
7089: table.LC_docs_adddocs th {
7090: border: 1px solid #BBBBBB;
7091: padding: 4px;
7092: background: #DDDDDD;
1.543 albertel 7093: }
7094:
1.584 albertel 7095: table.LC_sty_begin {
7096: background: #BBFFBB;
7097: }
1.795 www 7098:
1.584 albertel 7099: table.LC_sty_end {
7100: background: #FFBBBB;
7101: }
7102:
1.589 raeburn 7103: table.LC_double_column {
1.803 bisitz 7104: border-width: 0;
1.589 raeburn 7105: border-collapse: collapse;
7106: width: 100%;
7107: padding: 2px;
7108: }
7109:
7110: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7111: top: 2px;
1.589 raeburn 7112: left: 2px;
7113: width: 47%;
7114: vertical-align: top;
7115: }
7116:
7117: table.LC_double_column tr td.LC_right_col {
7118: top: 2px;
1.779 bisitz 7119: right: 2px;
1.589 raeburn 7120: width: 47%;
7121: vertical-align: top;
7122: }
7123:
1.591 raeburn 7124: div.LC_left_float {
7125: float: left;
7126: padding-right: 5%;
1.597 albertel 7127: padding-bottom: 4px;
1.591 raeburn 7128: }
7129:
7130: div.LC_clear_float_header {
1.597 albertel 7131: padding-bottom: 2px;
1.591 raeburn 7132: }
7133:
7134: div.LC_clear_float_footer {
1.597 albertel 7135: padding-top: 10px;
1.591 raeburn 7136: clear: both;
7137: }
7138:
1.597 albertel 7139: div.LC_grade_show_user {
1.941 bisitz 7140: /* border-left: 5px solid $sidebg; */
7141: border-top: 5px solid #000000;
7142: margin: 50px 0 0 0;
1.936 bisitz 7143: padding: 15px 0 5px 10px;
1.597 albertel 7144: }
1.795 www 7145:
1.936 bisitz 7146: div.LC_grade_show_user_odd_row {
1.941 bisitz 7147: /* border-left: 5px solid #000000; */
7148: }
7149:
7150: div.LC_grade_show_user div.LC_Box {
7151: margin-right: 50px;
1.597 albertel 7152: }
7153:
7154: div.LC_grade_submissions,
7155: div.LC_grade_message_center,
1.936 bisitz 7156: div.LC_grade_info_links {
1.597 albertel 7157: margin: 5px;
7158: width: 99%;
7159: background: #FFFFFF;
7160: }
1.795 www 7161:
1.597 albertel 7162: div.LC_grade_submissions_header,
1.936 bisitz 7163: div.LC_grade_message_center_header {
1.705 tempelho 7164: font-weight: bold;
7165: font-size: large;
1.597 albertel 7166: }
1.795 www 7167:
1.597 albertel 7168: div.LC_grade_submissions_body,
1.936 bisitz 7169: div.LC_grade_message_center_body {
1.597 albertel 7170: border: 1px solid black;
7171: width: 99%;
7172: background: #FFFFFF;
7173: }
1.795 www 7174:
1.613 albertel 7175: table.LC_scantron_action {
7176: width: 100%;
7177: }
1.795 www 7178:
1.613 albertel 7179: table.LC_scantron_action tr th {
1.698 harmsja 7180: font-weight:bold;
7181: font-style:normal;
1.613 albertel 7182: }
1.795 www 7183:
1.779 bisitz 7184: .LC_edit_problem_header,
1.614 albertel 7185: div.LC_edit_problem_footer {
1.705 tempelho 7186: font-weight: normal;
7187: font-size: medium;
1.602 albertel 7188: margin: 2px;
1.1060 bisitz 7189: background-color: $sidebg;
1.600 albertel 7190: }
1.795 www 7191:
1.600 albertel 7192: div.LC_edit_problem_header,
1.602 albertel 7193: div.LC_edit_problem_header div,
1.614 albertel 7194: div.LC_edit_problem_footer,
7195: div.LC_edit_problem_footer div,
1.602 albertel 7196: div.LC_edit_problem_editxml_header,
7197: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7198: z-index: 100;
1.600 albertel 7199: }
1.795 www 7200:
1.600 albertel 7201: div.LC_edit_problem_header_title {
1.705 tempelho 7202: font-weight: bold;
7203: font-size: larger;
1.602 albertel 7204: background: $tabbg;
7205: padding: 3px;
1.1060 bisitz 7206: margin: 0 0 5px 0;
1.602 albertel 7207: }
1.795 www 7208:
1.602 albertel 7209: table.LC_edit_problem_header_title {
7210: width: 100%;
1.600 albertel 7211: background: $tabbg;
1.602 albertel 7212: }
7213:
1.1205 golterma 7214: div.LC_edit_actionbar {
7215: background-color: $sidebg;
1.1218 droeschl 7216: margin: 0;
7217: padding: 0;
7218: line-height: 200%;
1.602 albertel 7219: }
1.795 www 7220:
1.1218 droeschl 7221: div.LC_edit_actionbar div{
7222: padding: 0;
7223: margin: 0;
7224: display: inline-block;
1.600 albertel 7225: }
1.795 www 7226:
1.1124 bisitz 7227: .LC_edit_opt {
7228: padding-left: 1em;
7229: white-space: nowrap;
7230: }
7231:
1.1152 golterma 7232: .LC_edit_problem_latexhelper{
7233: text-align: right;
7234: }
7235:
7236: #LC_edit_problem_colorful div{
7237: margin-left: 40px;
7238: }
7239:
1.1205 golterma 7240: #LC_edit_problem_codemirror div{
7241: margin-left: 0px;
7242: }
7243:
1.911 bisitz 7244: img.stift {
1.803 bisitz 7245: border-width: 0;
7246: vertical-align: middle;
1.677 riegler 7247: }
1.680 riegler 7248:
1.923 bisitz 7249: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7250: vertical-align: top;
1.777 tempelho 7251: }
1.795 www 7252:
1.716 raeburn 7253: div.LC_createcourse {
1.911 bisitz 7254: margin: 10px 10px 10px 10px;
1.716 raeburn 7255: }
7256:
1.917 raeburn 7257: .LC_dccid {
1.1130 raeburn 7258: float: right;
1.917 raeburn 7259: margin: 0.2em 0 0 0;
7260: padding: 0;
7261: font-size: 90%;
7262: display:none;
7263: }
7264:
1.897 wenzelju 7265: ol.LC_primary_menu a:hover,
1.721 harmsja 7266: ol#LC_MenuBreadcrumbs a:hover,
7267: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7268: ul#LC_secondary_menu a:hover,
1.721 harmsja 7269: .LC_FormSectionClearButton input:hover
1.795 www 7270: ul.LC_TabContent li:hover a {
1.952 onken 7271: color:$button_hover;
1.911 bisitz 7272: text-decoration:none;
1.693 droeschl 7273: }
7274:
1.779 bisitz 7275: h1 {
1.911 bisitz 7276: padding: 0;
7277: line-height:130%;
1.693 droeschl 7278: }
1.698 harmsja 7279:
1.911 bisitz 7280: h2,
7281: h3,
7282: h4,
7283: h5,
7284: h6 {
7285: margin: 5px 0 5px 0;
7286: padding: 0;
7287: line-height:130%;
1.693 droeschl 7288: }
1.795 www 7289:
7290: .LC_hcell {
1.911 bisitz 7291: padding:3px 15px 3px 15px;
7292: margin: 0;
7293: background-color:$tabbg;
7294: color:$fontmenu;
7295: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7296: }
1.795 www 7297:
1.840 bisitz 7298: .LC_Box > .LC_hcell {
1.911 bisitz 7299: margin: 0 -10px 10px -10px;
1.835 bisitz 7300: }
7301:
1.721 harmsja 7302: .LC_noBorder {
1.911 bisitz 7303: border: 0;
1.698 harmsja 7304: }
1.693 droeschl 7305:
1.721 harmsja 7306: .LC_FormSectionClearButton input {
1.911 bisitz 7307: background-color:transparent;
7308: border: none;
7309: cursor:pointer;
7310: text-decoration:underline;
1.693 droeschl 7311: }
1.763 bisitz 7312:
7313: .LC_help_open_topic {
1.911 bisitz 7314: color: #FFFFFF;
7315: background-color: #EEEEFF;
7316: margin: 1px;
7317: padding: 4px;
7318: border: 1px solid #000033;
7319: white-space: nowrap;
7320: /* vertical-align: middle; */
1.759 neumanie 7321: }
1.693 droeschl 7322:
1.911 bisitz 7323: dl,
7324: ul,
7325: div,
7326: fieldset {
7327: margin: 10px 10px 10px 0;
7328: /* overflow: hidden; */
1.693 droeschl 7329: }
1.795 www 7330:
1.1211 raeburn 7331: article.geogebraweb div {
7332: margin: 0;
7333: }
7334:
1.838 bisitz 7335: fieldset > legend {
1.911 bisitz 7336: font-weight: bold;
7337: padding: 0 5px 0 5px;
1.838 bisitz 7338: }
7339:
1.813 bisitz 7340: #LC_nav_bar {
1.911 bisitz 7341: float: left;
1.995 raeburn 7342: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7343: margin: 0 0 2px 0;
1.807 droeschl 7344: }
7345:
1.916 droeschl 7346: #LC_realm {
7347: margin: 0.2em 0 0 0;
7348: padding: 0;
7349: font-weight: bold;
7350: text-align: center;
1.995 raeburn 7351: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7352: }
7353:
1.911 bisitz 7354: #LC_nav_bar em {
7355: font-weight: bold;
7356: font-style: normal;
1.807 droeschl 7357: }
7358:
1.897 wenzelju 7359: ol.LC_primary_menu {
1.934 droeschl 7360: margin: 0;
1.1076 raeburn 7361: padding: 0;
1.807 droeschl 7362: }
7363:
1.852 droeschl 7364: ol#LC_PathBreadcrumbs {
1.911 bisitz 7365: margin: 0;
1.693 droeschl 7366: }
7367:
1.897 wenzelju 7368: ol.LC_primary_menu li {
1.1076 raeburn 7369: color: RGB(80, 80, 80);
7370: vertical-align: middle;
7371: text-align: left;
7372: list-style: none;
1.1205 golterma 7373: position: relative;
1.1076 raeburn 7374: float: left;
1.1205 golterma 7375: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7376: line-height: 1.5em;
1.1076 raeburn 7377: }
7378:
1.1205 golterma 7379: ol.LC_primary_menu li a,
7380: ol.LC_primary_menu li p {
1.1076 raeburn 7381: display: block;
7382: margin: 0;
7383: padding: 0 5px 0 10px;
7384: text-decoration: none;
7385: }
7386:
1.1205 golterma 7387: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7388: display: inline-block;
7389: width: 95%;
7390: text-align: left;
7391: }
7392:
7393: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7394: display: inline-block;
7395: width: 5%;
7396: float: right;
7397: text-align: right;
7398: font-size: 70%;
7399: }
7400:
7401: ol.LC_primary_menu ul {
1.1076 raeburn 7402: display: none;
1.1205 golterma 7403: width: 15em;
1.1076 raeburn 7404: background-color: $data_table_light;
1.1205 golterma 7405: position: absolute;
7406: top: 100%;
1.1076 raeburn 7407: }
7408:
1.1205 golterma 7409: ol.LC_primary_menu ul ul {
7410: left: 100%;
7411: top: 0;
7412: }
7413:
7414: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7415: display: block;
7416: position: absolute;
7417: margin: 0;
7418: padding: 0;
1.1078 raeburn 7419: z-index: 2;
1.1076 raeburn 7420: }
7421:
7422: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7423: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7424: font-size: 90%;
1.911 bisitz 7425: vertical-align: top;
1.1076 raeburn 7426: float: none;
1.1079 raeburn 7427: border-left: 1px solid black;
7428: border-right: 1px solid black;
1.1205 golterma 7429: /* A dark bottom border to visualize different menu options;
7430: overwritten in the create_submenu routine for the last border-bottom of the menu */
7431: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7432: }
7433:
1.1205 golterma 7434: ol.LC_primary_menu li li p:hover {
7435: color:$button_hover;
7436: text-decoration:none;
7437: background-color:$data_table_dark;
1.1076 raeburn 7438: }
7439:
7440: ol.LC_primary_menu li li a:hover {
7441: color:$button_hover;
7442: background-color:$data_table_dark;
1.693 droeschl 7443: }
7444:
1.1205 golterma 7445: /* Font-size equal to the size of the predecessors*/
7446: ol.LC_primary_menu li:hover li li {
7447: font-size: 100%;
7448: }
7449:
1.897 wenzelju 7450: ol.LC_primary_menu li img {
1.911 bisitz 7451: vertical-align: bottom;
1.934 droeschl 7452: height: 1.1em;
1.1077 raeburn 7453: margin: 0.2em 0 0 0;
1.693 droeschl 7454: }
7455:
1.897 wenzelju 7456: ol.LC_primary_menu a {
1.911 bisitz 7457: color: RGB(80, 80, 80);
7458: text-decoration: none;
1.693 droeschl 7459: }
1.795 www 7460:
1.949 droeschl 7461: ol.LC_primary_menu a.LC_new_message {
7462: font-weight:bold;
7463: color: darkred;
7464: }
7465:
1.975 raeburn 7466: ol.LC_docs_parameters {
7467: margin-left: 0;
7468: padding: 0;
7469: list-style: none;
7470: }
7471:
7472: ol.LC_docs_parameters li {
7473: margin: 0;
7474: padding-right: 20px;
7475: display: inline;
7476: }
7477:
1.976 raeburn 7478: ol.LC_docs_parameters li:before {
7479: content: "\\002022 \\0020";
7480: }
7481:
7482: li.LC_docs_parameters_title {
7483: font-weight: bold;
7484: }
7485:
7486: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7487: content: "";
7488: }
7489:
1.897 wenzelju 7490: ul#LC_secondary_menu {
1.1107 raeburn 7491: clear: right;
1.911 bisitz 7492: color: $fontmenu;
7493: background: $tabbg;
7494: list-style: none;
7495: padding: 0;
7496: margin: 0;
7497: width: 100%;
1.995 raeburn 7498: text-align: left;
1.1107 raeburn 7499: float: left;
1.808 droeschl 7500: }
7501:
1.897 wenzelju 7502: ul#LC_secondary_menu li {
1.911 bisitz 7503: font-weight: bold;
7504: line-height: 1.8em;
1.1107 raeburn 7505: border-right: 1px solid black;
7506: float: left;
7507: }
7508:
7509: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7510: background-color: $data_table_light;
7511: }
7512:
7513: ul#LC_secondary_menu li a {
1.911 bisitz 7514: padding: 0 0.8em;
1.1107 raeburn 7515: }
7516:
7517: ul#LC_secondary_menu li ul {
7518: display: none;
7519: }
7520:
7521: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7522: display: block;
7523: position: absolute;
7524: margin: 0;
7525: padding: 0;
7526: list-style:none;
7527: float: none;
7528: background-color: $data_table_light;
7529: z-index: 2;
7530: margin-left: -1px;
7531: }
7532:
7533: ul#LC_secondary_menu li ul li {
7534: font-size: 90%;
7535: vertical-align: top;
7536: border-left: 1px solid black;
1.911 bisitz 7537: border-right: 1px solid black;
1.1119 raeburn 7538: background-color: $data_table_light;
1.1107 raeburn 7539: list-style:none;
7540: float: none;
7541: }
7542:
7543: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7544: background-color: $data_table_dark;
1.807 droeschl 7545: }
7546:
1.847 tempelho 7547: ul.LC_TabContent {
1.911 bisitz 7548: display:block;
7549: background: $sidebg;
7550: border-bottom: solid 1px $lg_border_color;
7551: list-style:none;
1.1020 raeburn 7552: margin: -1px -10px 0 -10px;
1.911 bisitz 7553: padding: 0;
1.693 droeschl 7554: }
7555:
1.795 www 7556: ul.LC_TabContent li,
7557: ul.LC_TabContentBigger li {
1.911 bisitz 7558: float:left;
1.741 harmsja 7559: }
1.795 www 7560:
1.897 wenzelju 7561: ul#LC_secondary_menu li a {
1.911 bisitz 7562: color: $fontmenu;
7563: text-decoration: none;
1.693 droeschl 7564: }
1.795 www 7565:
1.721 harmsja 7566: ul.LC_TabContent {
1.952 onken 7567: min-height:20px;
1.721 harmsja 7568: }
1.795 www 7569:
7570: ul.LC_TabContent li {
1.911 bisitz 7571: vertical-align:middle;
1.959 onken 7572: padding: 0 16px 0 10px;
1.911 bisitz 7573: background-color:$tabbg;
7574: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7575: border-left: solid 1px $font;
1.721 harmsja 7576: }
1.795 www 7577:
1.847 tempelho 7578: ul.LC_TabContent .right {
1.911 bisitz 7579: float:right;
1.847 tempelho 7580: }
7581:
1.911 bisitz 7582: ul.LC_TabContent li a,
7583: ul.LC_TabContent li {
7584: color:rgb(47,47,47);
7585: text-decoration:none;
7586: font-size:95%;
7587: font-weight:bold;
1.952 onken 7588: min-height:20px;
7589: }
7590:
1.959 onken 7591: ul.LC_TabContent li a:hover,
7592: ul.LC_TabContent li a:focus {
1.952 onken 7593: color: $button_hover;
1.959 onken 7594: background:none;
7595: outline:none;
1.952 onken 7596: }
7597:
7598: ul.LC_TabContent li:hover {
7599: color: $button_hover;
7600: cursor:pointer;
1.721 harmsja 7601: }
1.795 www 7602:
1.911 bisitz 7603: ul.LC_TabContent li.active {
1.952 onken 7604: color: $font;
1.911 bisitz 7605: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7606: border-bottom:solid 1px #FFFFFF;
7607: cursor: default;
1.744 ehlerst 7608: }
1.795 www 7609:
1.959 onken 7610: ul.LC_TabContent li.active a {
7611: color:$font;
7612: background:#FFFFFF;
7613: outline: none;
7614: }
1.1047 raeburn 7615:
7616: ul.LC_TabContent li.goback {
7617: float: left;
7618: border-left: none;
7619: }
7620:
1.870 tempelho 7621: #maincoursedoc {
1.911 bisitz 7622: clear:both;
1.870 tempelho 7623: }
7624:
7625: ul.LC_TabContentBigger {
1.911 bisitz 7626: display:block;
7627: list-style:none;
7628: padding: 0;
1.870 tempelho 7629: }
7630:
1.795 www 7631: ul.LC_TabContentBigger li {
1.911 bisitz 7632: vertical-align:bottom;
7633: height: 30px;
7634: font-size:110%;
7635: font-weight:bold;
7636: color: #737373;
1.841 tempelho 7637: }
7638:
1.957 onken 7639: ul.LC_TabContentBigger li.active {
7640: position: relative;
7641: top: 1px;
7642: }
7643:
1.870 tempelho 7644: ul.LC_TabContentBigger li a {
1.911 bisitz 7645: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7646: height: 30px;
7647: line-height: 30px;
7648: text-align: center;
7649: display: block;
7650: text-decoration: none;
1.958 onken 7651: outline: none;
1.741 harmsja 7652: }
1.795 www 7653:
1.870 tempelho 7654: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7655: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7656: color:$font;
1.744 ehlerst 7657: }
1.795 www 7658:
1.870 tempelho 7659: ul.LC_TabContentBigger li b {
1.911 bisitz 7660: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7661: display: block;
7662: float: left;
7663: padding: 0 30px;
1.957 onken 7664: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7665: }
7666:
1.956 onken 7667: ul.LC_TabContentBigger li:hover b {
7668: color:$button_hover;
7669: }
7670:
1.870 tempelho 7671: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7672: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7673: color:$font;
1.957 onken 7674: border: 0;
1.741 harmsja 7675: }
1.693 droeschl 7676:
1.870 tempelho 7677:
1.862 bisitz 7678: ul.LC_CourseBreadcrumbs {
7679: background: $sidebg;
1.1020 raeburn 7680: height: 2em;
1.862 bisitz 7681: padding-left: 10px;
1.1020 raeburn 7682: margin: 0;
1.862 bisitz 7683: list-style-position: inside;
7684: }
7685:
1.911 bisitz 7686: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7687: ol#LC_PathBreadcrumbs {
1.911 bisitz 7688: padding-left: 10px;
7689: margin: 0;
1.933 droeschl 7690: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7691: }
7692:
1.911 bisitz 7693: ol#LC_MenuBreadcrumbs li,
7694: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7695: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7696: display: inline;
1.933 droeschl 7697: white-space: normal;
1.693 droeschl 7698: }
7699:
1.823 bisitz 7700: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7701: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7702: text-decoration: none;
7703: font-size:90%;
1.693 droeschl 7704: }
1.795 www 7705:
1.969 droeschl 7706: ol#LC_MenuBreadcrumbs h1 {
7707: display: inline;
7708: font-size: 90%;
7709: line-height: 2.5em;
7710: margin: 0;
7711: padding: 0;
7712: }
7713:
1.795 www 7714: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7715: text-decoration:none;
7716: font-size:100%;
7717: font-weight:bold;
1.693 droeschl 7718: }
1.795 www 7719:
1.840 bisitz 7720: .LC_Box {
1.911 bisitz 7721: border: solid 1px $lg_border_color;
7722: padding: 0 10px 10px 10px;
1.746 neumanie 7723: }
1.795 www 7724:
1.1020 raeburn 7725: .LC_DocsBox {
7726: border: solid 1px $lg_border_color;
7727: padding: 0 0 10px 10px;
7728: }
7729:
1.795 www 7730: .LC_AboutMe_Image {
1.911 bisitz 7731: float:left;
7732: margin-right:10px;
1.747 neumanie 7733: }
1.795 www 7734:
7735: .LC_Clear_AboutMe_Image {
1.911 bisitz 7736: clear:left;
1.747 neumanie 7737: }
1.795 www 7738:
1.721 harmsja 7739: dl.LC_ListStyleClean dt {
1.911 bisitz 7740: padding-right: 5px;
7741: display: table-header-group;
1.693 droeschl 7742: }
7743:
1.721 harmsja 7744: dl.LC_ListStyleClean dd {
1.911 bisitz 7745: display: table-row;
1.693 droeschl 7746: }
7747:
1.721 harmsja 7748: .LC_ListStyleClean,
7749: .LC_ListStyleSimple,
7750: .LC_ListStyleNormal,
1.795 www 7751: .LC_ListStyleSpecial {
1.911 bisitz 7752: /* display:block; */
7753: list-style-position: inside;
7754: list-style-type: none;
7755: overflow: hidden;
7756: padding: 0;
1.693 droeschl 7757: }
7758:
1.721 harmsja 7759: .LC_ListStyleSimple li,
7760: .LC_ListStyleSimple dd,
7761: .LC_ListStyleNormal li,
7762: .LC_ListStyleNormal dd,
7763: .LC_ListStyleSpecial li,
1.795 www 7764: .LC_ListStyleSpecial dd {
1.911 bisitz 7765: margin: 0;
7766: padding: 5px 5px 5px 10px;
7767: clear: both;
1.693 droeschl 7768: }
7769:
1.721 harmsja 7770: .LC_ListStyleClean li,
7771: .LC_ListStyleClean dd {
1.911 bisitz 7772: padding-top: 0;
7773: padding-bottom: 0;
1.693 droeschl 7774: }
7775:
1.721 harmsja 7776: .LC_ListStyleSimple dd,
1.795 www 7777: .LC_ListStyleSimple li {
1.911 bisitz 7778: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7779: }
7780:
1.721 harmsja 7781: .LC_ListStyleSpecial li,
7782: .LC_ListStyleSpecial dd {
1.911 bisitz 7783: list-style-type: none;
7784: background-color: RGB(220, 220, 220);
7785: margin-bottom: 4px;
1.693 droeschl 7786: }
7787:
1.721 harmsja 7788: table.LC_SimpleTable {
1.911 bisitz 7789: margin:5px;
7790: border:solid 1px $lg_border_color;
1.795 www 7791: }
1.693 droeschl 7792:
1.721 harmsja 7793: table.LC_SimpleTable tr {
1.911 bisitz 7794: padding: 0;
7795: border:solid 1px $lg_border_color;
1.693 droeschl 7796: }
1.795 www 7797:
7798: table.LC_SimpleTable thead {
1.911 bisitz 7799: background:rgb(220,220,220);
1.693 droeschl 7800: }
7801:
1.721 harmsja 7802: div.LC_columnSection {
1.911 bisitz 7803: display: block;
7804: clear: both;
7805: overflow: hidden;
7806: margin: 0;
1.693 droeschl 7807: }
7808:
1.721 harmsja 7809: div.LC_columnSection>* {
1.911 bisitz 7810: float: left;
7811: margin: 10px 20px 10px 0;
7812: overflow:hidden;
1.693 droeschl 7813: }
1.721 harmsja 7814:
1.795 www 7815: table em {
1.911 bisitz 7816: font-weight: bold;
7817: font-style: normal;
1.748 schulted 7818: }
1.795 www 7819:
1.779 bisitz 7820: table.LC_tableBrowseRes,
1.795 www 7821: table.LC_tableOfContent {
1.911 bisitz 7822: border:none;
7823: border-spacing: 1px;
7824: padding: 3px;
7825: background-color: #FFFFFF;
7826: font-size: 90%;
1.753 droeschl 7827: }
1.789 droeschl 7828:
1.911 bisitz 7829: table.LC_tableOfContent {
7830: border-collapse: collapse;
1.789 droeschl 7831: }
7832:
1.771 droeschl 7833: table.LC_tableBrowseRes a,
1.768 schulted 7834: table.LC_tableOfContent a {
1.911 bisitz 7835: background-color: transparent;
7836: text-decoration: none;
1.753 droeschl 7837: }
7838:
1.795 www 7839: table.LC_tableOfContent img {
1.911 bisitz 7840: border: none;
7841: height: 1.3em;
7842: vertical-align: text-bottom;
7843: margin-right: 0.3em;
1.753 droeschl 7844: }
1.757 schulted 7845:
1.795 www 7846: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7847: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7848: }
7849:
1.795 www 7850: a#LC_content_toolbar_everything {
1.911 bisitz 7851: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7852: }
7853:
1.795 www 7854: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7855: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7856: }
7857:
1.795 www 7858: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7859: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7860: }
7861:
1.795 www 7862: a#LC_content_toolbar_changefolder {
1.911 bisitz 7863: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7864: }
7865:
1.795 www 7866: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7867: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7868: }
7869:
1.1043 raeburn 7870: a#LC_content_toolbar_edittoplevel {
7871: background-image:url(/res/adm/pages/edittoplevel.gif);
7872: }
7873:
1.795 www 7874: ul#LC_toolbar li a:hover {
1.911 bisitz 7875: background-position: bottom center;
1.757 schulted 7876: }
7877:
1.795 www 7878: ul#LC_toolbar {
1.911 bisitz 7879: padding: 0;
7880: margin: 2px;
7881: list-style:none;
7882: position:relative;
7883: background-color:white;
1.1082 raeburn 7884: overflow: auto;
1.757 schulted 7885: }
7886:
1.795 www 7887: ul#LC_toolbar li {
1.911 bisitz 7888: border:1px solid white;
7889: padding: 0;
7890: margin: 0;
7891: float: left;
7892: display:inline;
7893: vertical-align:middle;
1.1082 raeburn 7894: white-space: nowrap;
1.911 bisitz 7895: }
1.757 schulted 7896:
1.783 amueller 7897:
1.795 www 7898: a.LC_toolbarItem {
1.911 bisitz 7899: display:block;
7900: padding: 0;
7901: margin: 0;
7902: height: 32px;
7903: width: 32px;
7904: color:white;
7905: border: none;
7906: background-repeat:no-repeat;
7907: background-color:transparent;
1.757 schulted 7908: }
7909:
1.915 droeschl 7910: ul.LC_funclist {
7911: margin: 0;
7912: padding: 0.5em 1em 0.5em 0;
7913: }
7914:
1.933 droeschl 7915: ul.LC_funclist > li:first-child {
7916: font-weight:bold;
7917: margin-left:0.8em;
7918: }
7919:
1.915 droeschl 7920: ul.LC_funclist + ul.LC_funclist {
7921: /*
7922: left border as a seperator if we have more than
7923: one list
7924: */
7925: border-left: 1px solid $sidebg;
7926: /*
7927: this hides the left border behind the border of the
7928: outer box if element is wrapped to the next 'line'
7929: */
7930: margin-left: -1px;
7931: }
7932:
1.843 bisitz 7933: ul.LC_funclist li {
1.915 droeschl 7934: display: inline;
1.782 bisitz 7935: white-space: nowrap;
1.915 droeschl 7936: margin: 0 0 0 25px;
7937: line-height: 150%;
1.782 bisitz 7938: }
7939:
1.974 wenzelju 7940: .LC_hidden {
7941: display: none;
7942: }
7943:
1.1030 www 7944: .LCmodal-overlay {
7945: position:fixed;
7946: top:0;
7947: right:0;
7948: bottom:0;
7949: left:0;
7950: height:100%;
7951: width:100%;
7952: margin:0;
7953: padding:0;
7954: background:#999;
7955: opacity:.75;
7956: filter: alpha(opacity=75);
7957: -moz-opacity: 0.75;
7958: z-index:101;
7959: }
7960:
7961: * html .LCmodal-overlay {
7962: position: absolute;
7963: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7964: }
7965:
7966: .LCmodal-window {
7967: position:fixed;
7968: top:50%;
7969: left:50%;
7970: margin:0;
7971: padding:0;
7972: z-index:102;
7973: }
7974:
7975: * html .LCmodal-window {
7976: position:absolute;
7977: }
7978:
7979: .LCclose-window {
7980: position:absolute;
7981: width:32px;
7982: height:32px;
7983: right:8px;
7984: top:8px;
7985: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7986: text-indent:-99999px;
7987: overflow:hidden;
7988: cursor:pointer;
7989: }
7990:
1.1100 raeburn 7991: /*
1.1231 damieng 7992: styles used for response display
7993: */
7994: div.LC_radiofoil, div.LC_rankfoil {
7995: margin: .5em 0em .5em 0em;
7996: }
7997: table.LC_itemgroup {
7998: margin-top: 1em;
7999: }
8000:
8001: /*
1.1100 raeburn 8002: styles used by TTH when "Default set of options to pass to tth/m
8003: when converting TeX" in course settings has been set
8004:
8005: option passed: -t
8006:
8007: */
8008:
8009: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8010: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8011: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8012: td div.norm {line-height:normal;}
8013:
8014: /*
8015: option passed -y3
8016: */
8017:
8018: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8019: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8020: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8021:
1.1230 damieng 8022: /*
8023: sections with roles, for content only
8024: */
8025: section[class^="role-"] {
8026: padding-left: 10px;
8027: padding-right: 5px;
8028: margin-top: 8px;
8029: margin-bottom: 8px;
8030: border: 1px solid #2A4;
8031: border-radius: 5px;
8032: box-shadow: 0px 1px 1px #BBB;
8033: }
8034: section[class^="role-"]>h1 {
8035: position: relative;
8036: margin: 0px;
8037: padding-top: 10px;
8038: padding-left: 40px;
8039: }
8040: section[class^="role-"]>h1:before {
8041: position: absolute;
8042: left: -5px;
8043: top: 5px;
8044: }
8045: section.role-activity>h1:before {
8046: content:url('/adm/daxe/images/section_icons/activity.png');
8047: }
8048: section.role-advice>h1:before {
8049: content:url('/adm/daxe/images/section_icons/advice.png');
8050: }
8051: section.role-bibliography>h1:before {
8052: content:url('/adm/daxe/images/section_icons/bibliography.png');
8053: }
8054: section.role-citation>h1:before {
8055: content:url('/adm/daxe/images/section_icons/citation.png');
8056: }
8057: section.role-conclusion>h1:before {
8058: content:url('/adm/daxe/images/section_icons/conclusion.png');
8059: }
8060: section.role-definition>h1:before {
8061: content:url('/adm/daxe/images/section_icons/definition.png');
8062: }
8063: section.role-demonstration>h1:before {
8064: content:url('/adm/daxe/images/section_icons/demonstration.png');
8065: }
8066: section.role-example>h1:before {
8067: content:url('/adm/daxe/images/section_icons/example.png');
8068: }
8069: section.role-explanation>h1:before {
8070: content:url('/adm/daxe/images/section_icons/explanation.png');
8071: }
8072: section.role-introduction>h1:before {
8073: content:url('/adm/daxe/images/section_icons/introduction.png');
8074: }
8075: section.role-method>h1:before {
8076: content:url('/adm/daxe/images/section_icons/method.png');
8077: }
8078: section.role-more_information>h1:before {
8079: content:url('/adm/daxe/images/section_icons/more_information.png');
8080: }
8081: section.role-objectives>h1:before {
8082: content:url('/adm/daxe/images/section_icons/objectives.png');
8083: }
8084: section.role-prerequisites>h1:before {
8085: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8086: }
8087: section.role-remark>h1:before {
8088: content:url('/adm/daxe/images/section_icons/remark.png');
8089: }
8090: section.role-reminder>h1:before {
8091: content:url('/adm/daxe/images/section_icons/reminder.png');
8092: }
8093: section.role-summary>h1:before {
8094: content:url('/adm/daxe/images/section_icons/summary.png');
8095: }
8096: section.role-syntax>h1:before {
8097: content:url('/adm/daxe/images/section_icons/syntax.png');
8098: }
8099: section.role-warning>h1:before {
8100: content:url('/adm/daxe/images/section_icons/warning.png');
8101: }
8102:
1.343 albertel 8103: END
8104: }
8105:
1.306 albertel 8106: =pod
8107:
8108: =item * &headtag()
8109:
8110: Returns a uniform footer for LON-CAPA web pages.
8111:
1.307 albertel 8112: Inputs: $title - optional title for the head
8113: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8114: $args - optional arguments
1.319 albertel 8115: force_register - if is true call registerurl so the remote is
8116: informed
1.415 albertel 8117: redirect -> array ref of
8118: 1- seconds before redirect occurs
8119: 2- url to redirect to
8120: 3- whether the side effect should occur
1.315 albertel 8121: (side effect of setting
8122: $env{'internal.head.redirect'} to the url
8123: redirected too)
1.352 albertel 8124: domain -> force to color decorate a page for a specific
8125: domain
8126: function -> force usage of a specific rolish color scheme
8127: bgcolor -> override the default page bgcolor
1.460 albertel 8128: no_auto_mt_title
8129: -> prevent &mt()ing the title arg
1.464 albertel 8130:
1.306 albertel 8131: =cut
8132:
8133: sub headtag {
1.313 albertel 8134: my ($title,$head_extra,$args) = @_;
1.306 albertel 8135:
1.363 albertel 8136: my $function = $args->{'function'} || &get_users_function();
8137: my $domain = $args->{'domain'} || &determinedomain();
8138: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8139: my $httphost = $args->{'use_absolute'};
1.418 albertel 8140: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8141: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8142: #time(),
1.418 albertel 8143: $env{'environment.color.timestamp'},
1.363 albertel 8144: $function,$domain,$bgcolor);
8145:
1.369 www 8146: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8147:
1.308 albertel 8148: my $result =
8149: '<head>'.
1.1160 raeburn 8150: &font_settings($args);
1.319 albertel 8151:
1.1188 raeburn 8152: my $inhibitprint;
8153: if ($args->{'print_suppress'}) {
8154: $inhibitprint = &print_suppression();
8155: }
1.1064 raeburn 8156:
1.461 albertel 8157: if (!$args->{'frameset'}) {
8158: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8159: }
1.962 droeschl 8160: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8161: $result .= Apache::lonxml::display_title();
1.319 albertel 8162: }
1.436 albertel 8163: if (!$args->{'no_nav_bar'}
8164: && !$args->{'only_body'}
8165: && !$args->{'frameset'}) {
1.1154 raeburn 8166: $result .= &help_menu_js($httphost);
1.1032 www 8167: $result.=&modal_window();
1.1038 www 8168: $result.=&togglebox_script();
1.1034 www 8169: $result.=&wishlist_window();
1.1041 www 8170: $result.=&LCprogressbarUpdate_script();
1.1034 www 8171: } else {
8172: if ($args->{'add_modal'}) {
8173: $result.=&modal_window();
8174: }
8175: if ($args->{'add_wishlist'}) {
8176: $result.=&wishlist_window();
8177: }
1.1038 www 8178: if ($args->{'add_togglebox'}) {
8179: $result.=&togglebox_script();
8180: }
1.1041 www 8181: if ($args->{'add_progressbar'}) {
8182: $result.=&LCprogressbarUpdate_script();
8183: }
1.436 albertel 8184: }
1.314 albertel 8185: if (ref($args->{'redirect'})) {
1.414 albertel 8186: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8187: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8188: if (!$inhibit_continue) {
8189: $env{'internal.head.redirect'} = $url;
8190: }
1.313 albertel 8191: $result.=<<ADDMETA
8192: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8193: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8194: ADDMETA
1.1210 raeburn 8195: } else {
8196: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8197: my $requrl = $env{'request.uri'};
8198: if ($requrl eq '') {
8199: $requrl = $ENV{'REQUEST_URI'};
8200: $requrl =~ s/\?.+$//;
8201: }
8202: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8203: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8204: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8205: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8206: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8207: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
8208: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8209: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8210: if ($domdefs{'offloadnow'}{$lonhost}) {
8211: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8212: if (($newserver) && ($newserver ne $lonhost)) {
8213: my $numsec = 5;
8214: my $timeout = $numsec * 1000;
8215: my ($newurl,$locknum,%locks,$msg);
8216: if ($env{'request.role.adv'}) {
8217: ($locknum,%locks) = &Apache::lonnet::get_locks();
8218: }
8219: my $disable_submit = 0;
8220: if ($requrl =~ /$LONCAPA::assess_re/) {
8221: $disable_submit = 1;
8222: }
8223: if ($locknum) {
8224: my @lockinfo = sort(values(%locks));
8225: $msg = &mt('Once the following tasks are complete: ')."\\n".
8226: join(", ",sort(values(%locks)))."\\n".
8227: &mt('your session will be transferred to a different server, after you click "Roles".');
8228: } else {
8229: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8230: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
8231: }
8232: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8233: $newurl = '/adm/switchserver?otherserver='.$newserver;
8234: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8235: $newurl .= '&role='.$env{'request.role'};
8236: }
8237: if ($env{'request.symb'}) {
8238: $newurl .= '&symb='.$env{'request.symb'};
8239: } else {
8240: $newurl .= '&origurl='.$requrl;
8241: }
8242: }
1.1222 damieng 8243: &js_escape(\$msg);
1.1210 raeburn 8244: $result.=<<OFFLOAD
8245: <meta http-equiv="pragma" content="no-cache" />
8246: <script type="text/javascript">
1.1215 raeburn 8247: // <![CDATA[
1.1210 raeburn 8248: function LC_Offload_Now() {
8249: var dest = "$newurl";
8250: if (dest != '') {
8251: window.location.href="$newurl";
8252: }
8253: }
1.1214 raeburn 8254: \$(document).ready(function () {
8255: window.alert('$msg');
8256: if ($disable_submit) {
1.1210 raeburn 8257: \$(".LC_hwk_submit").prop("disabled", true);
8258: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8259: }
8260: setTimeout('LC_Offload_Now()', $timeout);
8261: });
1.1215 raeburn 8262: // ]]>
1.1210 raeburn 8263: </script>
8264: OFFLOAD
8265: }
8266: }
8267: }
8268: }
8269: }
8270: }
1.313 albertel 8271: }
1.306 albertel 8272: if (!defined($title)) {
8273: $title = 'The LearningOnline Network with CAPA';
8274: }
1.460 albertel 8275: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8276: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8277: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8278: if (!$args->{'frameset'}) {
8279: $result .= ' /';
8280: }
8281: $result .= '>'
1.1064 raeburn 8282: .$inhibitprint
1.414 albertel 8283: .$head_extra;
1.1242 raeburn 8284: my $clientmobile;
8285: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8286: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8287: } else {
8288: $clientmobile = $env{'browser.mobile'};
8289: }
8290: if ($clientmobile) {
1.1137 raeburn 8291: $result .= '
8292: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8293: <meta name="apple-mobile-web-app-capable" content="yes" />';
8294: }
1.962 droeschl 8295: return $result.'</head>';
1.306 albertel 8296: }
8297:
8298: =pod
8299:
1.340 albertel 8300: =item * &font_settings()
8301:
8302: Returns neccessary <meta> to set the proper encoding
8303:
1.1160 raeburn 8304: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8305:
8306: =cut
8307:
8308: sub font_settings {
1.1160 raeburn 8309: my ($args) = @_;
1.340 albertel 8310: my $headerstring='';
1.1160 raeburn 8311: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8312: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8313: $headerstring.=
8314: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8315: if (!$args->{'frameset'}) {
8316: $headerstring.= ' /';
8317: }
8318: $headerstring .= '>'."\n";
1.340 albertel 8319: }
8320: return $headerstring;
8321: }
8322:
1.341 albertel 8323: =pod
8324:
1.1064 raeburn 8325: =item * &print_suppression()
8326:
8327: In course context returns css which causes the body to be blank when media="print",
8328: if printout generation is unavailable for the current resource.
8329:
8330: This could be because:
8331:
8332: (a) printstartdate is in the future
8333:
8334: (b) printenddate is in the past
8335:
8336: (c) there is an active exam block with "printout"
8337: functionality blocked
8338:
8339: Users with pav, pfo or evb privileges are exempt.
8340:
8341: Inputs: none
8342:
8343: =cut
8344:
8345:
8346: sub print_suppression {
8347: my $noprint;
8348: if ($env{'request.course.id'}) {
8349: my $scope = $env{'request.course.id'};
8350: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8351: (&Apache::lonnet::allowed('pfo',$scope))) {
8352: return;
8353: }
8354: if ($env{'request.course.sec'} ne '') {
8355: $scope .= "/$env{'request.course.sec'}";
8356: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8357: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8358: return;
1.1064 raeburn 8359: }
8360: }
8361: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8362: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8363: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8364: if ($blocked) {
8365: my $checkrole = "cm./$cdom/$cnum";
8366: if ($env{'request.course.sec'} ne '') {
8367: $checkrole .= "/$env{'request.course.sec'}";
8368: }
8369: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8370: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8371: $noprint = 1;
8372: }
8373: }
8374: unless ($noprint) {
8375: my $symb = &Apache::lonnet::symbread();
8376: if ($symb ne '') {
8377: my $navmap = Apache::lonnavmaps::navmap->new();
8378: if (ref($navmap)) {
8379: my $res = $navmap->getBySymb($symb);
8380: if (ref($res)) {
8381: if (!$res->resprintable()) {
8382: $noprint = 1;
8383: }
8384: }
8385: }
8386: }
8387: }
8388: if ($noprint) {
8389: return <<"ENDSTYLE";
8390: <style type="text/css" media="print">
8391: body { display:none }
8392: </style>
8393: ENDSTYLE
8394: }
8395: }
8396: return;
8397: }
8398:
8399: =pod
8400:
1.341 albertel 8401: =item * &xml_begin()
8402:
8403: Returns the needed doctype and <html>
8404:
8405: Inputs: none
8406:
8407: =cut
8408:
8409: sub xml_begin {
1.1168 raeburn 8410: my ($is_frameset) = @_;
1.341 albertel 8411: my $output='';
8412:
8413: if ($env{'browser.mathml'}) {
8414: $output='<?xml version="1.0"?>'
8415: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8416: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8417:
8418: # .'<!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">] >'
8419: .'<!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">'
8420: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8421: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8422: } elsif ($is_frameset) {
8423: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8424: '<html>'."\n";
1.341 albertel 8425: } else {
1.1168 raeburn 8426: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8427: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8428: }
8429: return $output;
8430: }
1.340 albertel 8431:
8432: =pod
8433:
1.306 albertel 8434: =item * &start_page()
8435:
8436: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8437:
1.648 raeburn 8438: Inputs:
8439:
8440: =over 4
8441:
8442: $title - optional title for the page
8443:
8444: $head_extra - optional extra HTML to incude inside the <head>
8445:
8446: $args - additional optional args supported are:
8447:
8448: =over 8
8449:
8450: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8451: arg on
1.814 bisitz 8452: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8453: add_entries -> additional attributes to add to the <body>
8454: domain -> force to color decorate a page for a
1.317 albertel 8455: specific domain
1.648 raeburn 8456: function -> force usage of a specific rolish color
1.317 albertel 8457: scheme
1.648 raeburn 8458: redirect -> see &headtag()
8459: bgcolor -> override the default page bg color
8460: js_ready -> return a string ready for being used in
1.317 albertel 8461: a javascript writeln
1.648 raeburn 8462: html_encode -> return a string ready for being used in
1.320 albertel 8463: a html attribute
1.648 raeburn 8464: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8465: $forcereg arg
1.648 raeburn 8466: frameset -> if true will start with a <frameset>
1.330 albertel 8467: rather than <body>
1.648 raeburn 8468: skip_phases -> hash ref of
1.338 albertel 8469: head -> skip the <html><head> generation
8470: body -> skip all <body> generation
1.648 raeburn 8471: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8472: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8473: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8474: group -> includes the current group, if page is for a
8475: specific group
1.361 albertel 8476:
1.648 raeburn 8477: =back
1.460 albertel 8478:
1.648 raeburn 8479: =back
1.562 albertel 8480:
1.306 albertel 8481: =cut
8482:
8483: sub start_page {
1.309 albertel 8484: my ($title,$head_extra,$args) = @_;
1.318 albertel 8485: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8486:
1.315 albertel 8487: $env{'internal.start_page'}++;
1.1096 raeburn 8488: my ($result,@advtools);
1.964 droeschl 8489:
1.338 albertel 8490: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8491: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8492: }
8493:
8494: if (! exists($args->{'skip_phases'}{'body'}) ) {
8495: if ($args->{'frameset'}) {
8496: my $attr_string = &make_attr_string($args->{'force_register'},
8497: $args->{'add_entries'});
8498: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8499: } else {
8500: $result .=
8501: &bodytag($title,
8502: $args->{'function'}, $args->{'add_entries'},
8503: $args->{'only_body'}, $args->{'domain'},
8504: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8505: $args->{'bgcolor'}, $args,
8506: \@advtools);
1.831 bisitz 8507: }
1.330 albertel 8508: }
1.338 albertel 8509:
1.315 albertel 8510: if ($args->{'js_ready'}) {
1.713 kaisler 8511: $result = &js_ready($result);
1.315 albertel 8512: }
1.320 albertel 8513: if ($args->{'html_encode'}) {
1.713 kaisler 8514: $result = &html_encode($result);
8515: }
8516:
1.813 bisitz 8517: # Preparation for new and consistent functionlist at top of screen
8518: # if ($args->{'functionlist'}) {
8519: # $result .= &build_functionlist();
8520: #}
8521:
1.964 droeschl 8522: # Don't add anything more if only_body wanted or in const space
8523: return $result if $args->{'only_body'}
8524: || $env{'request.state'} eq 'construct';
1.813 bisitz 8525:
8526: #Breadcrumbs
1.758 kaisler 8527: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8528: &Apache::lonhtmlcommon::clear_breadcrumbs();
8529: #if any br links exists, add them to the breadcrumbs
8530: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8531: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8532: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8533: }
8534: }
1.1096 raeburn 8535: # if @advtools array contains items add then to the breadcrumbs
8536: if (@advtools > 0) {
8537: &Apache::lonmenu::advtools_crumbs(@advtools);
8538: }
1.758 kaisler 8539:
8540: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8541: if(exists($args->{'bread_crumbs_component'})){
8542: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237 raeburn 8543: } elsif ($args->{'crstype'} eq 'Placement') {
8544: $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
8545: $args->{'crstype'});
8546: } else {
1.758 kaisler 8547: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8548: }
1.320 albertel 8549: }
1.315 albertel 8550: return $result;
1.306 albertel 8551: }
8552:
8553: sub end_page {
1.315 albertel 8554: my ($args) = @_;
8555: $env{'internal.end_page'}++;
1.330 albertel 8556: my $result;
1.335 albertel 8557: if ($args->{'discussion'}) {
8558: my ($target,$parser);
8559: if (ref($args->{'discussion'})) {
8560: ($target,$parser) =($args->{'discussion'}{'target'},
8561: $args->{'discussion'}{'parser'});
8562: }
8563: $result .= &Apache::lonxml::xmlend($target,$parser);
8564: }
1.330 albertel 8565: if ($args->{'frameset'}) {
8566: $result .= '</frameset>';
8567: } else {
1.635 raeburn 8568: $result .= &endbodytag($args);
1.330 albertel 8569: }
1.1080 raeburn 8570: unless ($args->{'notbody'}) {
8571: $result .= "\n</html>";
8572: }
1.330 albertel 8573:
1.315 albertel 8574: if ($args->{'js_ready'}) {
1.317 albertel 8575: $result = &js_ready($result);
1.315 albertel 8576: }
1.335 albertel 8577:
1.320 albertel 8578: if ($args->{'html_encode'}) {
8579: $result = &html_encode($result);
8580: }
1.335 albertel 8581:
1.315 albertel 8582: return $result;
8583: }
8584:
1.1034 www 8585: sub wishlist_window {
8586: return(<<'ENDWISHLIST');
1.1046 raeburn 8587: <script type="text/javascript">
1.1034 www 8588: // <![CDATA[
8589: // <!-- BEGIN LON-CAPA Internal
8590: function set_wishlistlink(title, path) {
8591: if (!title) {
8592: title = document.title;
8593: title = title.replace(/^LON-CAPA /,'');
8594: }
1.1175 raeburn 8595: title = encodeURIComponent(title);
1.1203 raeburn 8596: title = title.replace("'","\\\'");
1.1034 www 8597: if (!path) {
8598: path = location.pathname;
8599: }
1.1175 raeburn 8600: path = encodeURIComponent(path);
1.1203 raeburn 8601: path = path.replace("'","\\\'");
1.1034 www 8602: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8603: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8604: }
8605: // END LON-CAPA Internal -->
8606: // ]]>
8607: </script>
8608: ENDWISHLIST
8609: }
8610:
1.1030 www 8611: sub modal_window {
8612: return(<<'ENDMODAL');
1.1046 raeburn 8613: <script type="text/javascript">
1.1030 www 8614: // <![CDATA[
8615: // <!-- BEGIN LON-CAPA Internal
8616: var modalWindow = {
8617: parent:"body",
8618: windowId:null,
8619: content:null,
8620: width:null,
8621: height:null,
8622: close:function()
8623: {
8624: $(".LCmodal-window").remove();
8625: $(".LCmodal-overlay").remove();
8626: },
8627: open:function()
8628: {
8629: var modal = "";
8630: modal += "<div class=\"LCmodal-overlay\"></div>";
8631: 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;\">";
8632: modal += this.content;
8633: modal += "</div>";
8634:
8635: $(this.parent).append(modal);
8636:
8637: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8638: $(".LCclose-window").click(function(){modalWindow.close();});
8639: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8640: }
8641: };
1.1140 raeburn 8642: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8643: {
1.1203 raeburn 8644: source = source.replace("'","'");
1.1030 www 8645: modalWindow.windowId = "myModal";
8646: modalWindow.width = width;
8647: modalWindow.height = height;
1.1196 raeburn 8648: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8649: modalWindow.open();
1.1208 raeburn 8650: };
1.1030 www 8651: // END LON-CAPA Internal -->
8652: // ]]>
8653: </script>
8654: ENDMODAL
8655: }
8656:
8657: sub modal_link {
1.1140 raeburn 8658: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8659: unless ($width) { $width=480; }
8660: unless ($height) { $height=400; }
1.1031 www 8661: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8662: unless ($transparency) { $transparency='true'; }
8663:
1.1074 raeburn 8664: my $target_attr;
8665: if (defined($target)) {
8666: $target_attr = 'target="'.$target.'"';
8667: }
8668: return <<"ENDLINK";
1.1140 raeburn 8669: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8670: $linktext</a>
8671: ENDLINK
1.1030 www 8672: }
8673:
1.1032 www 8674: sub modal_adhoc_script {
8675: my ($funcname,$width,$height,$content)=@_;
8676: return (<<ENDADHOC);
1.1046 raeburn 8677: <script type="text/javascript">
1.1032 www 8678: // <![CDATA[
8679: var $funcname = function()
8680: {
8681: modalWindow.windowId = "myModal";
8682: modalWindow.width = $width;
8683: modalWindow.height = $height;
8684: modalWindow.content = '$content';
8685: modalWindow.open();
8686: };
8687: // ]]>
8688: </script>
8689: ENDADHOC
8690: }
8691:
1.1041 www 8692: sub modal_adhoc_inner {
8693: my ($funcname,$width,$height,$content)=@_;
8694: my $innerwidth=$width-20;
8695: $content=&js_ready(
1.1140 raeburn 8696: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8697: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8698: $content.
1.1041 www 8699: &end_scrollbox().
1.1140 raeburn 8700: &end_page()
1.1041 www 8701: );
8702: return &modal_adhoc_script($funcname,$width,$height,$content);
8703: }
8704:
8705: sub modal_adhoc_window {
8706: my ($funcname,$width,$height,$content,$linktext)=@_;
8707: return &modal_adhoc_inner($funcname,$width,$height,$content).
8708: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8709: }
8710:
8711: sub modal_adhoc_launch {
8712: my ($funcname,$width,$height,$content)=@_;
8713: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8714: <script type="text/javascript">
8715: // <![CDATA[
8716: $funcname();
8717: // ]]>
8718: </script>
8719: ENDLAUNCH
8720: }
8721:
8722: sub modal_adhoc_close {
8723: return (<<ENDCLOSE);
8724: <script type="text/javascript">
8725: // <![CDATA[
8726: modalWindow.close();
8727: // ]]>
8728: </script>
8729: ENDCLOSE
8730: }
8731:
1.1038 www 8732: sub togglebox_script {
8733: return(<<ENDTOGGLE);
8734: <script type="text/javascript">
8735: // <![CDATA[
8736: function LCtoggleDisplay(id,hidetext,showtext) {
8737: link = document.getElementById(id + "link").childNodes[0];
8738: with (document.getElementById(id).style) {
8739: if (display == "none" ) {
8740: display = "inline";
8741: link.nodeValue = hidetext;
8742: } else {
8743: display = "none";
8744: link.nodeValue = showtext;
8745: }
8746: }
8747: }
8748: // ]]>
8749: </script>
8750: ENDTOGGLE
8751: }
8752:
1.1039 www 8753: sub start_togglebox {
8754: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8755: unless ($heading) { $heading=''; } else { $heading.=' '; }
8756: unless ($showtext) { $showtext=&mt('show'); }
8757: unless ($hidetext) { $hidetext=&mt('hide'); }
8758: unless ($headerbg) { $headerbg='#FFFFFF'; }
8759: return &start_data_table().
8760: &start_data_table_header_row().
8761: '<td bgcolor="'.$headerbg.'">'.$heading.
8762: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8763: $showtext.'\')">'.$showtext.'</a>]</td>'.
8764: &end_data_table_header_row().
8765: '<tr id="'.$id.'" style="display:none""><td>';
8766: }
8767:
8768: sub end_togglebox {
8769: return '</td></tr>'.&end_data_table();
8770: }
8771:
1.1041 www 8772: sub LCprogressbar_script {
1.1045 www 8773: my ($id)=@_;
1.1041 www 8774: return(<<ENDPROGRESS);
8775: <script type="text/javascript">
8776: // <![CDATA[
1.1045 www 8777: \$('#progressbar$id').progressbar({
1.1041 www 8778: value: 0,
8779: change: function(event, ui) {
8780: var newVal = \$(this).progressbar('option', 'value');
8781: \$('.pblabel', this).text(LCprogressTxt);
8782: }
8783: });
8784: // ]]>
8785: </script>
8786: ENDPROGRESS
8787: }
8788:
8789: sub LCprogressbarUpdate_script {
8790: return(<<ENDPROGRESSUPDATE);
8791: <style type="text/css">
8792: .ui-progressbar { position:relative; }
8793: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8794: </style>
8795: <script type="text/javascript">
8796: // <![CDATA[
1.1045 www 8797: var LCprogressTxt='---';
8798:
8799: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8800: LCprogressTxt=progresstext;
1.1045 www 8801: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8802: }
8803: // ]]>
8804: </script>
8805: ENDPROGRESSUPDATE
8806: }
8807:
1.1042 www 8808: my $LClastpercent;
1.1045 www 8809: my $LCidcnt;
8810: my $LCcurrentid;
1.1042 www 8811:
1.1041 www 8812: sub LCprogressbar {
1.1042 www 8813: my ($r)=(@_);
8814: $LClastpercent=0;
1.1045 www 8815: $LCidcnt++;
8816: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8817: my $starting=&mt('Starting');
8818: my $content=(<<ENDPROGBAR);
1.1045 www 8819: <div id="progressbar$LCcurrentid">
1.1041 www 8820: <span class="pblabel">$starting</span>
8821: </div>
8822: ENDPROGBAR
1.1045 www 8823: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8824: }
8825:
8826: sub LCprogressbarUpdate {
1.1042 www 8827: my ($r,$val,$text)=@_;
8828: unless ($val) {
8829: if ($LClastpercent) {
8830: $val=$LClastpercent;
8831: } else {
8832: $val=0;
8833: }
8834: }
1.1041 www 8835: if ($val<0) { $val=0; }
8836: if ($val>100) { $val=0; }
1.1042 www 8837: $LClastpercent=$val;
1.1041 www 8838: unless ($text) { $text=$val.'%'; }
8839: $text=&js_ready($text);
1.1044 www 8840: &r_print($r,<<ENDUPDATE);
1.1041 www 8841: <script type="text/javascript">
8842: // <![CDATA[
1.1045 www 8843: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8844: // ]]>
8845: </script>
8846: ENDUPDATE
1.1035 www 8847: }
8848:
1.1042 www 8849: sub LCprogressbarClose {
8850: my ($r)=@_;
8851: $LClastpercent=0;
1.1044 www 8852: &r_print($r,<<ENDCLOSE);
1.1042 www 8853: <script type="text/javascript">
8854: // <![CDATA[
1.1045 www 8855: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8856: // ]]>
8857: </script>
8858: ENDCLOSE
1.1044 www 8859: }
8860:
8861: sub r_print {
8862: my ($r,$to_print)=@_;
8863: if ($r) {
8864: $r->print($to_print);
8865: $r->rflush();
8866: } else {
8867: print($to_print);
8868: }
1.1042 www 8869: }
8870:
1.320 albertel 8871: sub html_encode {
8872: my ($result) = @_;
8873:
1.322 albertel 8874: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8875:
8876: return $result;
8877: }
1.1044 www 8878:
1.317 albertel 8879: sub js_ready {
8880: my ($result) = @_;
8881:
1.323 albertel 8882: $result =~ s/[\n\r]/ /xmsg;
8883: $result =~ s/\\/\\\\/xmsg;
8884: $result =~ s/'/\\'/xmsg;
1.372 albertel 8885: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8886:
8887: return $result;
8888: }
8889:
1.315 albertel 8890: sub validate_page {
8891: if ( exists($env{'internal.start_page'})
1.316 albertel 8892: && $env{'internal.start_page'} > 1) {
8893: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8894: $env{'internal.start_page'}.' '.
1.316 albertel 8895: $ENV{'request.filename'});
1.315 albertel 8896: }
8897: if ( exists($env{'internal.end_page'})
1.316 albertel 8898: && $env{'internal.end_page'} > 1) {
8899: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8900: $env{'internal.end_page'}.' '.
1.316 albertel 8901: $env{'request.filename'});
1.315 albertel 8902: }
8903: if ( exists($env{'internal.start_page'})
8904: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8905: &Apache::lonnet::logthis('start_page called without end_page '.
8906: $env{'request.filename'});
1.315 albertel 8907: }
8908: if ( ! exists($env{'internal.start_page'})
8909: && exists($env{'internal.end_page'})) {
1.316 albertel 8910: &Apache::lonnet::logthis('end_page called without start_page'.
8911: $env{'request.filename'});
1.315 albertel 8912: }
1.306 albertel 8913: }
1.315 albertel 8914:
1.996 www 8915:
8916: sub start_scrollbox {
1.1140 raeburn 8917: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8918: unless ($outerwidth) { $outerwidth='520px'; }
8919: unless ($width) { $width='500px'; }
8920: unless ($height) { $height='200px'; }
1.1075 raeburn 8921: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8922: if ($id ne '') {
1.1140 raeburn 8923: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8924: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8925: }
1.1075 raeburn 8926: if ($bgcolor ne '') {
8927: $tdcol = "background-color: $bgcolor;";
8928: }
1.1137 raeburn 8929: my $nicescroll_js;
8930: if ($env{'browser.mobile'}) {
1.1140 raeburn 8931: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8932: }
8933: return <<"END";
8934: $nicescroll_js
8935:
8936: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8937: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8938: END
8939: }
8940:
8941: sub end_scrollbox {
8942: return '</div></td></tr></table>';
8943: }
8944:
8945: sub nicescroll_javascript {
8946: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8947: my %options;
8948: if (ref($cursor) eq 'HASH') {
8949: %options = %{$cursor};
8950: }
8951: unless ($options{'railalign'} =~ /^left|right$/) {
8952: $options{'railalign'} = 'left';
8953: }
8954: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8955: my $function = &get_users_function();
8956: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8957: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8958: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8959: }
1.1140 raeburn 8960: }
8961: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8962: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8963: $options{'cursoropacity'}='1.0';
8964: }
1.1140 raeburn 8965: } else {
8966: $options{'cursoropacity'}='1.0';
8967: }
8968: if ($options{'cursorfixedheight'} eq 'none') {
8969: delete($options{'cursorfixedheight'});
8970: } else {
8971: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8972: }
8973: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8974: delete($options{'railoffset'});
8975: }
8976: my @niceoptions;
8977: while (my($key,$value) = each(%options)) {
8978: if ($value =~ /^\{.+\}$/) {
8979: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8980: } else {
1.1140 raeburn 8981: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8982: }
1.1140 raeburn 8983: }
8984: my $nicescroll_js = '
1.1137 raeburn 8985: $(document).ready(
1.1140 raeburn 8986: function() {
8987: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8988: }
1.1137 raeburn 8989: );
8990: ';
1.1140 raeburn 8991: if ($framecheck) {
8992: $nicescroll_js .= '
8993: function expand_div(caller) {
8994: if (top === self) {
8995: document.getElementById("'.$id.'").style.width = "auto";
8996: document.getElementById("'.$id.'").style.height = "auto";
8997: } else {
8998: try {
8999: if (parent.frames) {
9000: if (parent.frames.length > 1) {
9001: var framesrc = parent.frames[1].location.href;
9002: var currsrc = framesrc.replace(/\#.*$/,"");
9003: if ((caller == "search") || (currsrc == "'.$location.'")) {
9004: document.getElementById("'.$id.'").style.width = "auto";
9005: document.getElementById("'.$id.'").style.height = "auto";
9006: }
9007: }
9008: }
9009: } catch (e) {
9010: return;
9011: }
1.1137 raeburn 9012: }
1.1140 raeburn 9013: return;
1.996 www 9014: }
1.1140 raeburn 9015: ';
9016: }
9017: if ($needjsready) {
9018: $nicescroll_js = '
9019: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9020: } else {
9021: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9022: }
9023: return $nicescroll_js;
1.996 www 9024: }
9025:
1.318 albertel 9026: sub simple_error_page {
1.1150 bisitz 9027: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 9028: if (ref($args) eq 'HASH') {
9029: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
9030: } else {
9031: $msg = &mt($msg);
9032: }
1.1150 bisitz 9033:
1.318 albertel 9034: my $page =
9035: &Apache::loncommon::start_page($title).
1.1150 bisitz 9036: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9037: &Apache::loncommon::end_page();
9038: if (ref($r)) {
9039: $r->print($page);
1.327 albertel 9040: return;
1.318 albertel 9041: }
9042: return $page;
9043: }
1.347 albertel 9044:
9045: {
1.610 albertel 9046: my @row_count;
1.961 onken 9047:
9048: sub start_data_table_count {
9049: unshift(@row_count, 0);
9050: return;
9051: }
9052:
9053: sub end_data_table_count {
9054: shift(@row_count);
9055: return;
9056: }
9057:
1.347 albertel 9058: sub start_data_table {
1.1018 raeburn 9059: my ($add_class,$id) = @_;
1.422 albertel 9060: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9061: my $table_id;
9062: if (defined($id)) {
9063: $table_id = ' id="'.$id.'"';
9064: }
1.961 onken 9065: &start_data_table_count();
1.1018 raeburn 9066: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9067: }
9068:
9069: sub end_data_table {
1.961 onken 9070: &end_data_table_count();
1.389 albertel 9071: return '</table>'."\n";;
1.347 albertel 9072: }
9073:
9074: sub start_data_table_row {
1.974 wenzelju 9075: my ($add_class, $id) = @_;
1.610 albertel 9076: $row_count[0]++;
9077: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9078: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9079: $id = (' id="'.$id.'"') unless ($id eq '');
9080: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9081: }
1.471 banghart 9082:
9083: sub continue_data_table_row {
1.974 wenzelju 9084: my ($add_class, $id) = @_;
1.610 albertel 9085: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9086: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9087: $id = (' id="'.$id.'"') unless ($id eq '');
9088: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9089: }
1.347 albertel 9090:
9091: sub end_data_table_row {
1.389 albertel 9092: return '</tr>'."\n";;
1.347 albertel 9093: }
1.367 www 9094:
1.421 albertel 9095: sub start_data_table_empty_row {
1.707 bisitz 9096: # $row_count[0]++;
1.421 albertel 9097: return '<tr class="LC_empty_row" >'."\n";;
9098: }
9099:
9100: sub end_data_table_empty_row {
9101: return '</tr>'."\n";;
9102: }
9103:
1.367 www 9104: sub start_data_table_header_row {
1.389 albertel 9105: return '<tr class="LC_header_row">'."\n";;
1.367 www 9106: }
9107:
9108: sub end_data_table_header_row {
1.389 albertel 9109: return '</tr>'."\n";;
1.367 www 9110: }
1.890 droeschl 9111:
9112: sub data_table_caption {
9113: my $caption = shift;
9114: return "<caption class=\"LC_caption\">$caption</caption>";
9115: }
1.347 albertel 9116: }
9117:
1.548 albertel 9118: =pod
9119:
9120: =item * &inhibit_menu_check($arg)
9121:
9122: Checks for a inhibitmenu state and generates output to preserve it
9123:
9124: Inputs: $arg - can be any of
9125: - undef - in which case the return value is a string
9126: to add into arguments list of a uri
9127: - 'input' - in which case the return value is a HTML
9128: <form> <input> field of type hidden to
9129: preserve the value
9130: - a url - in which case the return value is the url with
9131: the neccesary cgi args added to preserve the
9132: inhibitmenu state
9133: - a ref to a url - no return value, but the string is
9134: updated to include the neccessary cgi
9135: args to preserve the inhibitmenu state
9136:
9137: =cut
9138:
9139: sub inhibit_menu_check {
9140: my ($arg) = @_;
9141: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9142: if ($arg eq 'input') {
9143: if ($env{'form.inhibitmenu'}) {
9144: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9145: } else {
9146: return
9147: }
9148: }
9149: if ($env{'form.inhibitmenu'}) {
9150: if (ref($arg)) {
9151: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9152: } elsif ($arg eq '') {
9153: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9154: } else {
9155: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9156: }
9157: }
9158: if (!ref($arg)) {
9159: return $arg;
9160: }
9161: }
9162:
1.251 albertel 9163: ###############################################
1.182 matthew 9164:
9165: =pod
9166:
1.549 albertel 9167: =back
9168:
9169: =head1 User Information Routines
9170:
9171: =over 4
9172:
1.405 albertel 9173: =item * &get_users_function()
1.182 matthew 9174:
9175: Used by &bodytag to determine the current users primary role.
9176: Returns either 'student','coordinator','admin', or 'author'.
9177:
9178: =cut
9179:
9180: ###############################################
9181: sub get_users_function {
1.815 tempelho 9182: my $function = 'norole';
1.818 tempelho 9183: if ($env{'request.role'}=~/^(st)/) {
9184: $function='student';
9185: }
1.907 raeburn 9186: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9187: $function='coordinator';
9188: }
1.258 albertel 9189: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9190: $function='admin';
9191: }
1.826 bisitz 9192: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9193: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9194: $function='author';
9195: }
9196: return $function;
1.54 www 9197: }
1.99 www 9198:
9199: ###############################################
9200:
1.233 raeburn 9201: =pod
9202:
1.821 raeburn 9203: =item * &show_course()
9204:
9205: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9206: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9207:
9208: Inputs:
9209: None
9210:
9211: Outputs:
9212: Scalar: 1 if 'Course' to be used, 0 otherwise.
9213:
9214: =cut
9215:
9216: ###############################################
9217: sub show_course {
9218: my $course = !$env{'user.adv'};
9219: if (!$env{'user.adv'}) {
9220: foreach my $env (keys(%env)) {
9221: next if ($env !~ m/^user\.priv\./);
9222: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9223: $course = 0;
9224: last;
9225: }
9226: }
9227: }
9228: return $course;
9229: }
9230:
9231: ###############################################
9232:
9233: =pod
9234:
1.542 raeburn 9235: =item * &check_user_status()
1.274 raeburn 9236:
9237: Determines current status of supplied role for a
9238: specific user. Roles can be active, previous or future.
9239:
9240: Inputs:
9241: user's domain, user's username, course's domain,
1.375 raeburn 9242: course's number, optional section ID.
1.274 raeburn 9243:
9244: Outputs:
9245: role status: active, previous or future.
9246:
9247: =cut
9248:
9249: sub check_user_status {
1.412 raeburn 9250: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9251: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9252: my @uroles = keys(%userinfo);
1.274 raeburn 9253: my $srchstr;
9254: my $active_chk = 'none';
1.412 raeburn 9255: my $now = time;
1.274 raeburn 9256: if (@uroles > 0) {
1.908 raeburn 9257: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9258: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9259: } else {
1.412 raeburn 9260: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9261: }
9262: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9263: my $role_end = 0;
9264: my $role_start = 0;
9265: $active_chk = 'active';
1.412 raeburn 9266: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9267: $role_end = $1;
9268: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9269: $role_start = $1;
1.274 raeburn 9270: }
9271: }
9272: if ($role_start > 0) {
1.412 raeburn 9273: if ($now < $role_start) {
1.274 raeburn 9274: $active_chk = 'future';
9275: }
9276: }
9277: if ($role_end > 0) {
1.412 raeburn 9278: if ($now > $role_end) {
1.274 raeburn 9279: $active_chk = 'previous';
9280: }
9281: }
9282: }
9283: }
9284: return $active_chk;
9285: }
9286:
9287: ###############################################
9288:
9289: =pod
9290:
1.405 albertel 9291: =item * &get_sections()
1.233 raeburn 9292:
9293: Determines all the sections for a course including
9294: sections with students and sections containing other roles.
1.419 raeburn 9295: Incoming parameters:
9296:
9297: 1. domain
9298: 2. course number
9299: 3. reference to array containing roles for which sections should
9300: be gathered (optional).
9301: 4. reference to array containing status types for which sections
9302: should be gathered (optional).
9303:
9304: If the third argument is undefined, sections are gathered for any role.
9305: If the fourth argument is undefined, sections are gathered for any status.
9306: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9307:
1.374 raeburn 9308: Returns section hash (keys are section IDs, values are
9309: number of users in each section), subject to the
1.419 raeburn 9310: optional roles filter, optional status filter
1.233 raeburn 9311:
9312: =cut
9313:
9314: ###############################################
9315: sub get_sections {
1.419 raeburn 9316: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9317: if (!defined($cdom) || !defined($cnum)) {
9318: my $cid = $env{'request.course.id'};
9319:
9320: return if (!defined($cid));
9321:
9322: $cdom = $env{'course.'.$cid.'.domain'};
9323: $cnum = $env{'course.'.$cid.'.num'};
9324: }
9325:
9326: my %sectioncount;
1.419 raeburn 9327: my $now = time;
1.240 albertel 9328:
1.1118 raeburn 9329: my $check_students = 1;
9330: my $only_students = 0;
9331: if (ref($possible_roles) eq 'ARRAY') {
9332: if (grep(/^st$/,@{$possible_roles})) {
9333: if (@{$possible_roles} == 1) {
9334: $only_students = 1;
9335: }
9336: } else {
9337: $check_students = 0;
9338: }
9339: }
9340:
9341: if ($check_students) {
1.276 albertel 9342: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9343: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9344: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9345: my $start_index = &Apache::loncoursedata::CL_START();
9346: my $end_index = &Apache::loncoursedata::CL_END();
9347: my $status;
1.366 albertel 9348: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9349: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9350: $data->[$status_index],
9351: $data->[$start_index],
9352: $data->[$end_index]);
9353: if ($stu_status eq 'Active') {
9354: $status = 'active';
9355: } elsif ($end < $now) {
9356: $status = 'previous';
9357: } elsif ($start > $now) {
9358: $status = 'future';
9359: }
9360: if ($section ne '-1' && $section !~ /^\s*$/) {
9361: if ((!defined($possible_status)) || (($status ne '') &&
9362: (grep/^\Q$status\E$/,@{$possible_status}))) {
9363: $sectioncount{$section}++;
9364: }
1.240 albertel 9365: }
9366: }
9367: }
1.1118 raeburn 9368: if ($only_students) {
9369: return %sectioncount;
9370: }
1.240 albertel 9371: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9372: foreach my $user (sort(keys(%courseroles))) {
9373: if ($user !~ /^(\w{2})/) { next; }
9374: my ($role) = ($user =~ /^(\w{2})/);
9375: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9376: my ($section,$status);
1.240 albertel 9377: if ($role eq 'cr' &&
9378: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9379: $section=$1;
9380: }
9381: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9382: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9383: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9384: if ($end == -1 && $start == -1) {
9385: next; #deleted role
9386: }
9387: if (!defined($possible_status)) {
9388: $sectioncount{$section}++;
9389: } else {
9390: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9391: $status = 'active';
9392: } elsif ($end < $now) {
9393: $status = 'future';
9394: } elsif ($start > $now) {
9395: $status = 'previous';
9396: }
9397: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9398: $sectioncount{$section}++;
9399: }
9400: }
1.233 raeburn 9401: }
1.366 albertel 9402: return %sectioncount;
1.233 raeburn 9403: }
9404:
1.274 raeburn 9405: ###############################################
1.294 raeburn 9406:
9407: =pod
1.405 albertel 9408:
9409: =item * &get_course_users()
9410:
1.275 raeburn 9411: Retrieves usernames:domains for users in the specified course
9412: with specific role(s), and access status.
9413:
9414: Incoming parameters:
1.277 albertel 9415: 1. course domain
9416: 2. course number
9417: 3. access status: users must have - either active,
1.275 raeburn 9418: previous, future, or all.
1.277 albertel 9419: 4. reference to array of permissible roles
1.288 raeburn 9420: 5. reference to array of section restrictions (optional)
9421: 6. reference to results object (hash of hashes).
9422: 7. reference to optional userdata hash
1.609 raeburn 9423: 8. reference to optional statushash
1.630 raeburn 9424: 9. flag if privileged users (except those set to unhide in
9425: course settings) should be excluded
1.609 raeburn 9426: Keys of top level results hash are roles.
1.275 raeburn 9427: Keys of inner hashes are username:domain, with
9428: values set to access type.
1.288 raeburn 9429: Optional userdata hash returns an array with arguments in the
9430: same order as loncoursedata::get_classlist() for student data.
9431:
1.609 raeburn 9432: Optional statushash returns
9433:
1.288 raeburn 9434: Entries for end, start, section and status are blank because
9435: of the possibility of multiple values for non-student roles.
9436:
1.275 raeburn 9437: =cut
1.405 albertel 9438:
1.275 raeburn 9439: ###############################################
1.405 albertel 9440:
1.275 raeburn 9441: sub get_course_users {
1.630 raeburn 9442: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9443: my %idx = ();
1.419 raeburn 9444: my %seclists;
1.288 raeburn 9445:
9446: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9447: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9448: $idx{end} = &Apache::loncoursedata::CL_END();
9449: $idx{start} = &Apache::loncoursedata::CL_START();
9450: $idx{id} = &Apache::loncoursedata::CL_ID();
9451: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9452: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9453: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9454:
1.290 albertel 9455: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9456: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9457: my $now = time;
1.277 albertel 9458: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9459: my $match = 0;
1.412 raeburn 9460: my $secmatch = 0;
1.419 raeburn 9461: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9462: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9463: if ($section eq '') {
9464: $section = 'none';
9465: }
1.291 albertel 9466: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9467: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9468: $secmatch = 1;
9469: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9470: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9471: $secmatch = 1;
9472: }
9473: } else {
1.419 raeburn 9474: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9475: $secmatch = 1;
9476: }
1.290 albertel 9477: }
1.412 raeburn 9478: if (!$secmatch) {
9479: next;
9480: }
1.419 raeburn 9481: }
1.275 raeburn 9482: if (defined($$types{'active'})) {
1.288 raeburn 9483: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9484: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9485: $match = 1;
1.275 raeburn 9486: }
9487: }
9488: if (defined($$types{'previous'})) {
1.609 raeburn 9489: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9490: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9491: $match = 1;
1.275 raeburn 9492: }
9493: }
9494: if (defined($$types{'future'})) {
1.609 raeburn 9495: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9496: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9497: $match = 1;
1.275 raeburn 9498: }
9499: }
1.609 raeburn 9500: if ($match) {
9501: push(@{$seclists{$student}},$section);
9502: if (ref($userdata) eq 'HASH') {
9503: $$userdata{$student} = $$classlist{$student};
9504: }
9505: if (ref($statushash) eq 'HASH') {
9506: $statushash->{$student}{'st'}{$section} = $status;
9507: }
1.288 raeburn 9508: }
1.275 raeburn 9509: }
9510: }
1.412 raeburn 9511: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9512: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9513: my $now = time;
1.609 raeburn 9514: my %displaystatus = ( previous => 'Expired',
9515: active => 'Active',
9516: future => 'Future',
9517: );
1.1121 raeburn 9518: my (%nothide,@possdoms);
1.630 raeburn 9519: if ($hidepriv) {
9520: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9521: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9522: if ($user !~ /:/) {
9523: $nothide{join(':',split(/[\@]/,$user))}=1;
9524: } else {
9525: $nothide{$user} = 1;
9526: }
9527: }
1.1121 raeburn 9528: my @possdoms = ($cdom);
9529: if ($coursehash{'checkforpriv'}) {
9530: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9531: }
1.630 raeburn 9532: }
1.439 raeburn 9533: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9534: my $match = 0;
1.412 raeburn 9535: my $secmatch = 0;
1.439 raeburn 9536: my $status;
1.412 raeburn 9537: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9538: $user =~ s/:$//;
1.439 raeburn 9539: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9540: if ($end == -1 || $start == -1) {
9541: next;
9542: }
9543: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9544: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9545: my ($uname,$udom) = split(/:/,$user);
9546: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9547: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9548: $secmatch = 1;
9549: } elsif ($usec eq '') {
1.420 albertel 9550: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9551: $secmatch = 1;
9552: }
9553: } else {
9554: if (grep(/^\Q$usec\E$/,@{$sections})) {
9555: $secmatch = 1;
9556: }
9557: }
9558: if (!$secmatch) {
9559: next;
9560: }
1.288 raeburn 9561: }
1.419 raeburn 9562: if ($usec eq '') {
9563: $usec = 'none';
9564: }
1.275 raeburn 9565: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9566: if ($hidepriv) {
1.1121 raeburn 9567: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9568: (!$nothide{$uname.':'.$udom})) {
9569: next;
9570: }
9571: }
1.503 raeburn 9572: if ($end > 0 && $end < $now) {
1.439 raeburn 9573: $status = 'previous';
9574: } elsif ($start > $now) {
9575: $status = 'future';
9576: } else {
9577: $status = 'active';
9578: }
1.277 albertel 9579: foreach my $type (keys(%{$types})) {
1.275 raeburn 9580: if ($status eq $type) {
1.420 albertel 9581: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9582: push(@{$$users{$role}{$user}},$type);
9583: }
1.288 raeburn 9584: $match = 1;
9585: }
9586: }
1.419 raeburn 9587: if (($match) && (ref($userdata) eq 'HASH')) {
9588: if (!exists($$userdata{$uname.':'.$udom})) {
9589: &get_user_info($udom,$uname,\%idx,$userdata);
9590: }
1.420 albertel 9591: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9592: push(@{$seclists{$uname.':'.$udom}},$usec);
9593: }
1.609 raeburn 9594: if (ref($statushash) eq 'HASH') {
9595: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9596: }
1.275 raeburn 9597: }
9598: }
9599: }
9600: }
1.290 albertel 9601: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9602: if ((defined($cdom)) && (defined($cnum))) {
9603: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9604: if ( defined($csettings{'internal.courseowner'}) ) {
9605: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9606: next if ($owner eq '');
9607: my ($ownername,$ownerdom);
9608: if ($owner =~ /^([^:]+):([^:]+)$/) {
9609: $ownername = $1;
9610: $ownerdom = $2;
9611: } else {
9612: $ownername = $owner;
9613: $ownerdom = $cdom;
9614: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9615: }
9616: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9617: if (defined($userdata) &&
1.609 raeburn 9618: !exists($$userdata{$owner})) {
9619: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9620: if (!grep(/^none$/,@{$seclists{$owner}})) {
9621: push(@{$seclists{$owner}},'none');
9622: }
9623: if (ref($statushash) eq 'HASH') {
9624: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9625: }
1.290 albertel 9626: }
1.279 raeburn 9627: }
9628: }
9629: }
1.419 raeburn 9630: foreach my $user (keys(%seclists)) {
9631: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9632: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9633: }
1.275 raeburn 9634: }
9635: return;
9636: }
9637:
1.288 raeburn 9638: sub get_user_info {
9639: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9640: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9641: &plainname($uname,$udom,'lastname');
1.291 albertel 9642: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9643: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9644: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9645: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9646: return;
9647: }
1.275 raeburn 9648:
1.472 raeburn 9649: ###############################################
9650:
9651: =pod
9652:
9653: =item * &get_user_quota()
9654:
1.1134 raeburn 9655: Retrieves quota assigned for storage of user files.
9656: Default is to report quota for portfolio files.
1.472 raeburn 9657:
9658: Incoming parameters:
9659: 1. user's username
9660: 2. user's domain
1.1134 raeburn 9661: 3. quota name - portfolio, author, or course
1.1136 raeburn 9662: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9663: 4. crstype - official, unofficial, textbook, placement or community,
9664: if quota name is course
1.472 raeburn 9665:
9666: Returns:
1.1163 raeburn 9667: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9668: 2. (Optional) Type of setting: custom or default
9669: (individually assigned or default for user's
9670: institutional status).
9671: 3. (Optional) - User's institutional status (e.g., faculty, staff
9672: or student - types as defined in localenroll::inst_usertypes
9673: for user's domain, which determines default quota for user.
9674: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9675:
9676: If a value has been stored in the user's environment,
1.536 raeburn 9677: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9678: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9679:
9680: =cut
9681:
9682: ###############################################
9683:
9684:
9685: sub get_user_quota {
1.1136 raeburn 9686: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9687: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9688: if (!defined($udom)) {
9689: $udom = $env{'user.domain'};
9690: }
9691: if (!defined($uname)) {
9692: $uname = $env{'user.name'};
9693: }
9694: if (($udom eq '' || $uname eq '') ||
9695: ($udom eq 'public') && ($uname eq 'public')) {
9696: $quota = 0;
1.536 raeburn 9697: $quotatype = 'default';
9698: $defquota = 0;
1.472 raeburn 9699: } else {
1.536 raeburn 9700: my $inststatus;
1.1134 raeburn 9701: if ($quotaname eq 'course') {
9702: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9703: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9704: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9705: } else {
9706: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9707: $quota = $cenv{'internal.uploadquota'};
9708: }
1.536 raeburn 9709: } else {
1.1134 raeburn 9710: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9711: if ($quotaname eq 'author') {
9712: $quota = $env{'environment.authorquota'};
9713: } else {
9714: $quota = $env{'environment.portfolioquota'};
9715: }
9716: $inststatus = $env{'environment.inststatus'};
9717: } else {
9718: my %userenv =
9719: &Apache::lonnet::get('environment',['portfolioquota',
9720: 'authorquota','inststatus'],$udom,$uname);
9721: my ($tmp) = keys(%userenv);
9722: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9723: if ($quotaname eq 'author') {
9724: $quota = $userenv{'authorquota'};
9725: } else {
9726: $quota = $userenv{'portfolioquota'};
9727: }
9728: $inststatus = $userenv{'inststatus'};
9729: } else {
9730: undef(%userenv);
9731: }
9732: }
9733: }
9734: if ($quota eq '' || wantarray) {
9735: if ($quotaname eq 'course') {
9736: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9737: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9738: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9739: ($crstype eq 'placement')) {
1.1136 raeburn 9740: $defquota = $domdefs{$crstype.'quota'};
9741: }
9742: if ($defquota eq '') {
9743: $defquota = 500;
9744: }
1.1134 raeburn 9745: } else {
9746: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9747: }
9748: if ($quota eq '') {
9749: $quota = $defquota;
9750: $quotatype = 'default';
9751: } else {
9752: $quotatype = 'custom';
9753: }
1.472 raeburn 9754: }
9755: }
1.536 raeburn 9756: if (wantarray) {
9757: return ($quota,$quotatype,$settingstatus,$defquota);
9758: } else {
9759: return $quota;
9760: }
1.472 raeburn 9761: }
9762:
9763: ###############################################
9764:
9765: =pod
9766:
9767: =item * &default_quota()
9768:
1.536 raeburn 9769: Retrieves default quota assigned for storage of user portfolio files,
9770: given an (optional) user's institutional status.
1.472 raeburn 9771:
9772: Incoming parameters:
1.1142 raeburn 9773:
1.472 raeburn 9774: 1. domain
1.536 raeburn 9775: 2. (Optional) institutional status(es). This is a : separated list of
9776: status types (e.g., faculty, staff, student etc.)
9777: which apply to the user for whom the default is being retrieved.
9778: If the institutional status string in undefined, the domain
1.1134 raeburn 9779: default quota will be returned.
9780: 3. quota name - portfolio, author, or course
9781: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9782:
9783: Returns:
1.1142 raeburn 9784:
1.1163 raeburn 9785: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9786: 2. (Optional) institutional type which determined the value of the
9787: default quota.
1.472 raeburn 9788:
9789: If a value has been stored in the domain's configuration db,
9790: it will return that, otherwise it returns 20 (for backwards
9791: compatibility with domains which have not set up a configuration
1.1163 raeburn 9792: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9793:
1.536 raeburn 9794: If the user's status includes multiple types (e.g., staff and student),
9795: the largest default quota which applies to the user determines the
9796: default quota returned.
9797:
1.472 raeburn 9798: =cut
9799:
9800: ###############################################
9801:
9802:
9803: sub default_quota {
1.1134 raeburn 9804: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9805: my ($defquota,$settingstatus);
9806: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9807: ['quotas'],$udom);
1.1134 raeburn 9808: my $key = 'defaultquota';
9809: if ($quotaname eq 'author') {
9810: $key = 'authorquota';
9811: }
1.622 raeburn 9812: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9813: if ($inststatus ne '') {
1.765 raeburn 9814: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9815: foreach my $item (@statuses) {
1.1134 raeburn 9816: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9817: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9818: if ($defquota eq '') {
1.1134 raeburn 9819: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9820: $settingstatus = $item;
1.1134 raeburn 9821: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9822: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9823: $settingstatus = $item;
9824: }
9825: }
1.1134 raeburn 9826: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9827: if ($quotahash{'quotas'}{$item} ne '') {
9828: if ($defquota eq '') {
9829: $defquota = $quotahash{'quotas'}{$item};
9830: $settingstatus = $item;
9831: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9832: $defquota = $quotahash{'quotas'}{$item};
9833: $settingstatus = $item;
9834: }
1.536 raeburn 9835: }
9836: }
9837: }
9838: }
9839: if ($defquota eq '') {
1.1134 raeburn 9840: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9841: $defquota = $quotahash{'quotas'}{$key}{'default'};
9842: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9843: $defquota = $quotahash{'quotas'}{'default'};
9844: }
1.536 raeburn 9845: $settingstatus = 'default';
1.1139 raeburn 9846: if ($defquota eq '') {
9847: if ($quotaname eq 'author') {
9848: $defquota = 500;
9849: }
9850: }
1.536 raeburn 9851: }
9852: } else {
9853: $settingstatus = 'default';
1.1134 raeburn 9854: if ($quotaname eq 'author') {
9855: $defquota = 500;
9856: } else {
9857: $defquota = 20;
9858: }
1.536 raeburn 9859: }
9860: if (wantarray) {
9861: return ($defquota,$settingstatus);
1.472 raeburn 9862: } else {
1.536 raeburn 9863: return $defquota;
1.472 raeburn 9864: }
9865: }
9866:
1.1135 raeburn 9867: ###############################################
9868:
9869: =pod
9870:
1.1136 raeburn 9871: =item * &excess_filesize_warning()
1.1135 raeburn 9872:
9873: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9874: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9875: space to be exceeded.
1.1136 raeburn 9876:
9877: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9878: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9879:
1.1165 raeburn 9880: Inputs: 7
1.1136 raeburn 9881: 1. username or coursenum
1.1135 raeburn 9882: 2. domain
1.1136 raeburn 9883: 3. context ('author' or 'course')
1.1135 raeburn 9884: 4. filename of file for which action is being requested
9885: 5. filesize (kB) of file
9886: 6. action being taken: copy or upload.
1.1237 raeburn 9887: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 9888:
9889: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9890: otherwise return null.
9891:
9892: =back
1.1135 raeburn 9893:
9894: =cut
9895:
1.1136 raeburn 9896: sub excess_filesize_warning {
1.1165 raeburn 9897: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9898: my $current_disk_usage = 0;
1.1165 raeburn 9899: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9900: if ($context eq 'author') {
9901: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9902: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9903: } else {
9904: foreach my $subdir ('docs','supplemental') {
9905: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9906: }
9907: }
1.1135 raeburn 9908: $disk_quota = int($disk_quota * 1000);
9909: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9910: return '<p class="LC_warning">'.
1.1135 raeburn 9911: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9912: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9913: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9914: $disk_quota,$current_disk_usage).
9915: '</p>';
9916: }
9917: return;
9918: }
9919:
9920: ###############################################
9921:
9922:
1.1136 raeburn 9923:
9924:
1.384 raeburn 9925: sub get_secgrprole_info {
9926: my ($cdom,$cnum,$needroles,$type) = @_;
9927: my %sections_count = &get_sections($cdom,$cnum);
9928: my @sections = (sort {$a <=> $b} keys(%sections_count));
9929: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9930: my @groups = sort(keys(%curr_groups));
9931: my $allroles = [];
9932: my $rolehash;
9933: my $accesshash = {
9934: active => 'Currently has access',
9935: future => 'Will have future access',
9936: previous => 'Previously had access',
9937: };
9938: if ($needroles) {
9939: $rolehash = {'all' => 'all'};
1.385 albertel 9940: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9941: if (&Apache::lonnet::error(%user_roles)) {
9942: undef(%user_roles);
9943: }
9944: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9945: my ($role)=split(/\:/,$item,2);
9946: if ($role eq 'cr') { next; }
9947: if ($role =~ /^cr/) {
9948: $$rolehash{$role} = (split('/',$role))[3];
9949: } else {
9950: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9951: }
9952: }
9953: foreach my $key (sort(keys(%{$rolehash}))) {
9954: push(@{$allroles},$key);
9955: }
9956: push (@{$allroles},'st');
9957: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9958: }
9959: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9960: }
9961:
1.555 raeburn 9962: sub user_picker {
1.1255 ! raeburn 9963: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom) = @_;
1.555 raeburn 9964: my $currdom = $dom;
1.1253 raeburn 9965: my @alldoms = &Apache::lonnet::all_domains();
9966: if (@alldoms == 1) {
9967: my %domsrch = &Apache::lonnet::get_dom('configuration',
9968: ['directorysrch'],$alldoms[0]);
9969: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
9970: my $showdom = $domdesc;
9971: if ($showdom eq '') {
9972: $showdom = $dom;
9973: }
9974: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
9975: if ((!$domsrch{'directorysrch'}{'available'}) &&
9976: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
9977: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
9978: }
9979: }
9980: }
1.555 raeburn 9981: my %curr_selected = (
9982: srchin => 'dom',
1.580 raeburn 9983: srchby => 'lastname',
1.555 raeburn 9984: );
9985: my $srchterm;
1.625 raeburn 9986: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9987: if ($srch->{'srchby'} ne '') {
9988: $curr_selected{'srchby'} = $srch->{'srchby'};
9989: }
9990: if ($srch->{'srchin'} ne '') {
9991: $curr_selected{'srchin'} = $srch->{'srchin'};
9992: }
9993: if ($srch->{'srchtype'} ne '') {
9994: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9995: }
9996: if ($srch->{'srchdomain'} ne '') {
9997: $currdom = $srch->{'srchdomain'};
9998: }
9999: $srchterm = $srch->{'srchterm'};
10000: }
1.1222 damieng 10001: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10002: 'usr' => 'Search criteria',
1.563 raeburn 10003: 'doma' => 'Domain/institution to search',
1.558 albertel 10004: 'uname' => 'username',
10005: 'lastname' => 'last name',
1.555 raeburn 10006: 'lastfirst' => 'last name, first name',
1.558 albertel 10007: 'crs' => 'in this course',
1.576 raeburn 10008: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10009: 'alc' => 'all LON-CAPA',
1.573 raeburn 10010: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10011: 'exact' => 'is',
10012: 'contains' => 'contains',
1.569 raeburn 10013: 'begins' => 'begins with',
1.1222 damieng 10014: );
10015: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10016: 'youm' => "You must include some text to search for.",
10017: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10018: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10019: 'yomc' => "You must choose a domain when using an institutional directory search.",
10020: 'ymcd' => "You must choose a domain when using a domain search.",
10021: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10022: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10023: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10024: );
1.1222 damieng 10025: &html_escape(\%html_lt);
10026: &js_escape(\%js_lt);
1.1255 ! raeburn 10027: my $domform;
! 10028: if ($fixeddom) {
! 10029: $domform = &select_dom_form($currdom,'srchdomain',1,1,undef,[$currdom]);
! 10030: } else {
! 10031: $domform = &select_dom_form($currdom,'srchdomain',1,1);
! 10032: }
1.563 raeburn 10033: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10034:
10035: my @srchins = ('crs','dom','alc','instd');
10036:
10037: foreach my $option (@srchins) {
10038: # FIXME 'alc' option unavailable until
10039: # loncreateuser::print_user_query_page()
10040: # has been completed.
10041: next if ($option eq 'alc');
1.880 raeburn 10042: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10043: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 10044: if ($curr_selected{'srchin'} eq $option) {
10045: $srchinsel .= '
1.1222 damieng 10046: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10047: } else {
10048: $srchinsel .= '
1.1222 damieng 10049: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10050: }
1.555 raeburn 10051: }
1.563 raeburn 10052: $srchinsel .= "\n </select>\n";
1.555 raeburn 10053:
10054: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10055: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10056: if ($curr_selected{'srchby'} eq $option) {
10057: $srchbysel .= '
1.1222 damieng 10058: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10059: } else {
10060: $srchbysel .= '
1.1222 damieng 10061: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10062: }
10063: }
10064: $srchbysel .= "\n </select>\n";
10065:
10066: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10067: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10068: if ($curr_selected{'srchtype'} eq $option) {
10069: $srchtypesel .= '
1.1222 damieng 10070: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10071: } else {
10072: $srchtypesel .= '
1.1222 damieng 10073: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10074: }
10075: }
10076: $srchtypesel .= "\n </select>\n";
10077:
1.558 albertel 10078: my ($newuserscript,$new_user_create);
1.994 raeburn 10079: my $context_dom = $env{'request.role.domain'};
10080: if ($context eq 'requestcrs') {
10081: if ($env{'form.coursedom'} ne '') {
10082: $context_dom = $env{'form.coursedom'};
10083: }
10084: }
1.556 raeburn 10085: if ($forcenewuser) {
1.576 raeburn 10086: if (ref($srch) eq 'HASH') {
1.994 raeburn 10087: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10088: if ($cancreate) {
10089: $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>';
10090: } else {
1.799 bisitz 10091: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10092: my %usertypetext = (
10093: official => 'institutional',
10094: unofficial => 'non-institutional',
10095: );
1.799 bisitz 10096: $new_user_create = '<p class="LC_warning">'
10097: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10098: .' '
10099: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10100: ,'<a href="'.$helplink.'">','</a>')
10101: .'</p><br />';
1.627 raeburn 10102: }
1.576 raeburn 10103: }
10104: }
10105:
1.556 raeburn 10106: $newuserscript = <<"ENDSCRIPT";
10107:
1.570 raeburn 10108: function setSearch(createnew,callingForm) {
1.556 raeburn 10109: if (createnew == 1) {
1.570 raeburn 10110: for (var i=0; i<callingForm.srchby.length; i++) {
10111: if (callingForm.srchby.options[i].value == 'uname') {
10112: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10113: }
10114: }
1.570 raeburn 10115: for (var i=0; i<callingForm.srchin.length; i++) {
10116: if ( callingForm.srchin.options[i].value == 'dom') {
10117: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10118: }
10119: }
1.570 raeburn 10120: for (var i=0; i<callingForm.srchtype.length; i++) {
10121: if (callingForm.srchtype.options[i].value == 'exact') {
10122: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10123: }
10124: }
1.570 raeburn 10125: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10126: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10127: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10128: }
10129: }
10130: }
10131: }
10132: ENDSCRIPT
1.558 albertel 10133:
1.556 raeburn 10134: }
10135:
1.555 raeburn 10136: my $output = <<"END_BLOCK";
1.556 raeburn 10137: <script type="text/javascript">
1.824 bisitz 10138: // <![CDATA[
1.570 raeburn 10139: function validateEntry(callingForm) {
1.558 albertel 10140:
1.556 raeburn 10141: var checkok = 1;
1.558 albertel 10142: var srchin;
1.570 raeburn 10143: for (var i=0; i<callingForm.srchin.length; i++) {
10144: if ( callingForm.srchin[i].checked ) {
10145: srchin = callingForm.srchin[i].value;
1.558 albertel 10146: }
10147: }
10148:
1.570 raeburn 10149: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10150: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10151: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10152: var srchterm = callingForm.srchterm.value;
10153: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10154: var msg = "";
10155:
10156: if (srchterm == "") {
10157: checkok = 0;
1.1222 damieng 10158: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10159: }
10160:
1.569 raeburn 10161: if (srchtype== 'begins') {
10162: if (srchterm.length < 2) {
10163: checkok = 0;
1.1222 damieng 10164: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10165: }
10166: }
10167:
1.556 raeburn 10168: if (srchtype== 'contains') {
10169: if (srchterm.length < 3) {
10170: checkok = 0;
1.1222 damieng 10171: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10172: }
10173: }
10174: if (srchin == 'instd') {
10175: if (srchdomain == '') {
10176: checkok = 0;
1.1222 damieng 10177: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10178: }
10179: }
10180: if (srchin == 'dom') {
10181: if (srchdomain == '') {
10182: checkok = 0;
1.1222 damieng 10183: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10184: }
10185: }
10186: if (srchby == 'lastfirst') {
10187: if (srchterm.indexOf(",") == -1) {
10188: checkok = 0;
1.1222 damieng 10189: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10190: }
10191: if (srchterm.indexOf(",") == srchterm.length -1) {
10192: checkok = 0;
1.1222 damieng 10193: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10194: }
10195: }
10196: if (checkok == 0) {
1.1222 damieng 10197: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10198: return;
10199: }
10200: if (checkok == 1) {
1.570 raeburn 10201: callingForm.submit();
1.556 raeburn 10202: }
10203: }
10204:
10205: $newuserscript
10206:
1.824 bisitz 10207: // ]]>
1.556 raeburn 10208: </script>
1.558 albertel 10209:
10210: $new_user_create
10211:
1.555 raeburn 10212: END_BLOCK
1.558 albertel 10213:
1.876 raeburn 10214: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10215: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10216: $domform.
10217: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10218: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10219: $srchbysel.
10220: $srchtypesel.
10221: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10222: $srchinsel.
10223: &Apache::lonhtmlcommon::row_closure(1).
10224: &Apache::lonhtmlcommon::end_pick_box().
10225: '<br />';
1.1253 raeburn 10226: return ($output,1);
1.555 raeburn 10227: }
10228:
1.612 raeburn 10229: sub user_rule_check {
1.615 raeburn 10230: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10231: my ($response,%inst_response);
1.612 raeburn 10232: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10233: if (keys(%{$usershash}) > 1) {
10234: my (%by_username,%by_id,%userdoms);
10235: my $checkid;
10236: if (ref($checks) eq 'HASH') {
10237: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10238: $checkid = 1;
10239: }
10240: }
10241: foreach my $user (keys(%{$usershash})) {
10242: my ($uname,$udom) = split(/:/,$user);
10243: if ($checkid) {
10244: if (ref($usershash->{$user}) eq 'HASH') {
10245: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10246: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10247: $userdoms{$udom} = 1;
1.1227 raeburn 10248: if (ref($inst_results) eq 'HASH') {
10249: $inst_results->{$uname.':'.$udom} = {};
10250: }
1.1226 raeburn 10251: }
10252: }
10253: } else {
10254: $by_username{$udom}{$uname} = 1;
10255: $userdoms{$udom} = 1;
1.1227 raeburn 10256: if (ref($inst_results) eq 'HASH') {
10257: $inst_results->{$uname.':'.$udom} = {};
10258: }
1.1226 raeburn 10259: }
10260: }
10261: foreach my $udom (keys(%userdoms)) {
10262: if (!$got_rules->{$udom}) {
10263: my %domconfig = &Apache::lonnet::get_dom('configuration',
10264: ['usercreation'],$udom);
10265: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10266: foreach my $item ('username','id') {
10267: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10268: $$curr_rules{$udom}{$item} =
10269: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10270: }
10271: }
10272: }
10273: $got_rules->{$udom} = 1;
10274: }
1.612 raeburn 10275: }
1.1226 raeburn 10276: if ($checkid) {
10277: foreach my $udom (keys(%by_id)) {
10278: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10279: if ($outcome eq 'ok') {
1.1227 raeburn 10280: foreach my $id (keys(%{$by_id{$udom}})) {
10281: my $uname = $by_id{$udom}{$id};
10282: $inst_response{$uname.':'.$udom} = $outcome;
10283: }
1.1226 raeburn 10284: if (ref($results) eq 'HASH') {
10285: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10286: if (exists($inst_response{$uname.':'.$udom})) {
10287: $inst_response{$uname.':'.$udom} = $outcome;
10288: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10289: }
1.1226 raeburn 10290: }
10291: }
10292: }
1.612 raeburn 10293: }
1.615 raeburn 10294: } else {
1.1226 raeburn 10295: foreach my $udom (keys(%by_username)) {
10296: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10297: if ($outcome eq 'ok') {
1.1227 raeburn 10298: foreach my $uname (keys(%{$by_username{$udom}})) {
10299: $inst_response{$uname.':'.$udom} = $outcome;
10300: }
1.1226 raeburn 10301: if (ref($results) eq 'HASH') {
10302: foreach my $uname (keys(%{$results})) {
10303: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10304: }
10305: }
10306: }
10307: }
1.612 raeburn 10308: }
1.1226 raeburn 10309: } elsif (keys(%{$usershash}) == 1) {
10310: my $user = (keys(%{$usershash}))[0];
10311: my ($uname,$udom) = split(/:/,$user);
10312: if (($udom ne '') && ($uname ne '')) {
10313: if (ref($usershash->{$user}) eq 'HASH') {
10314: if (ref($checks) eq 'HASH') {
10315: if (defined($checks->{'username'})) {
10316: ($inst_response{$user},%{$inst_results->{$user}}) =
10317: &Apache::lonnet::get_instuser($udom,$uname);
10318: } elsif (defined($checks->{'id'})) {
10319: if ($usershash->{$user}->{'id'} ne '') {
10320: ($inst_response{$user},%{$inst_results->{$user}}) =
10321: &Apache::lonnet::get_instuser($udom,undef,
10322: $usershash->{$user}->{'id'});
10323: } else {
10324: ($inst_response{$user},%{$inst_results->{$user}}) =
10325: &Apache::lonnet::get_instuser($udom,$uname);
10326: }
1.585 raeburn 10327: }
1.1226 raeburn 10328: } else {
10329: ($inst_response{$user},%{$inst_results->{$user}}) =
10330: &Apache::lonnet::get_instuser($udom,$uname);
10331: return;
10332: }
10333: if (!$got_rules->{$udom}) {
10334: my %domconfig = &Apache::lonnet::get_dom('configuration',
10335: ['usercreation'],$udom);
10336: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10337: foreach my $item ('username','id') {
10338: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10339: $$curr_rules{$udom}{$item} =
10340: $domconfig{'usercreation'}{$item.'_rule'};
10341: }
10342: }
10343: }
10344: $got_rules->{$udom} = 1;
1.585 raeburn 10345: }
10346: }
1.1226 raeburn 10347: } else {
10348: return;
10349: }
10350: } else {
10351: return;
10352: }
10353: foreach my $user (keys(%{$usershash})) {
10354: my ($uname,$udom) = split(/:/,$user);
10355: next if (($udom eq '') || ($uname eq ''));
10356: my $id;
1.1227 raeburn 10357: if (ref($inst_results) eq 'HASH') {
10358: if (ref($inst_results->{$user}) eq 'HASH') {
10359: $id = $inst_results->{$user}->{'id'};
10360: }
10361: }
10362: if ($id eq '') {
10363: if (ref($usershash->{$user})) {
10364: $id = $usershash->{$user}->{'id'};
10365: }
1.585 raeburn 10366: }
1.612 raeburn 10367: foreach my $item (keys(%{$checks})) {
10368: if (ref($$curr_rules{$udom}) eq 'HASH') {
10369: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10370: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10371: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10372: $$curr_rules{$udom}{$item});
1.612 raeburn 10373: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10374: if ($rule_check{$rule}) {
10375: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10376: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10377: if (ref($inst_results) eq 'HASH') {
10378: if (ref($inst_results->{$user}) eq 'HASH') {
10379: if (keys(%{$inst_results->{$user}}) == 0) {
10380: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10381: } elsif ($item eq 'id') {
10382: if ($inst_results->{$user}->{'id'} eq '') {
10383: $$alerts{$item}{$udom}{$uname} = 1;
10384: }
1.615 raeburn 10385: }
1.612 raeburn 10386: }
10387: }
1.615 raeburn 10388: }
10389: last;
1.585 raeburn 10390: }
10391: }
10392: }
10393: }
10394: }
10395: }
10396: }
10397: }
1.612 raeburn 10398: return;
10399: }
10400:
10401: sub user_rule_formats {
10402: my ($domain,$domdesc,$curr_rules,$check) = @_;
10403: my %text = (
10404: 'username' => 'Usernames',
10405: 'id' => 'IDs',
10406: );
10407: my $output;
10408: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10409: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10410: if (@{$ruleorder} > 0) {
1.1102 raeburn 10411: $output = '<br />'.
10412: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10413: '<span class="LC_cusr_emph">','</span>',$domdesc).
10414: ' <ul>';
1.612 raeburn 10415: foreach my $rule (@{$ruleorder}) {
10416: if (ref($curr_rules) eq 'ARRAY') {
10417: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10418: if (ref($rules->{$rule}) eq 'HASH') {
10419: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10420: $rules->{$rule}{'desc'}.'</li>';
10421: }
10422: }
10423: }
10424: }
10425: $output .= '</ul>';
10426: }
10427: }
10428: return $output;
10429: }
10430:
10431: sub instrule_disallow_msg {
1.615 raeburn 10432: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10433: my $response;
10434: my %text = (
10435: item => 'username',
10436: items => 'usernames',
10437: match => 'matches',
10438: do => 'does',
10439: action => 'a username',
10440: one => 'one',
10441: );
10442: if ($count > 1) {
10443: $text{'item'} = 'usernames';
10444: $text{'match'} ='match';
10445: $text{'do'} = 'do';
10446: $text{'action'} = 'usernames',
10447: $text{'one'} = 'ones';
10448: }
10449: if ($checkitem eq 'id') {
10450: $text{'items'} = 'IDs';
10451: $text{'item'} = 'ID';
10452: $text{'action'} = 'an ID';
1.615 raeburn 10453: if ($count > 1) {
10454: $text{'item'} = 'IDs';
10455: $text{'action'} = 'IDs';
10456: }
1.612 raeburn 10457: }
1.674 bisitz 10458: $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 10459: if ($mode eq 'upload') {
10460: if ($checkitem eq 'username') {
10461: $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'}.");
10462: } elsif ($checkitem eq 'id') {
1.674 bisitz 10463: $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 10464: }
1.669 raeburn 10465: } elsif ($mode eq 'selfcreate') {
10466: if ($checkitem eq 'id') {
10467: $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.");
10468: }
1.615 raeburn 10469: } else {
10470: if ($checkitem eq 'username') {
10471: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10472: } elsif ($checkitem eq 'id') {
10473: $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.");
10474: }
1.612 raeburn 10475: }
10476: return $response;
1.585 raeburn 10477: }
10478:
1.624 raeburn 10479: sub personal_data_fieldtitles {
10480: my %fieldtitles = &Apache::lonlocal::texthash (
10481: id => 'Student/Employee ID',
10482: permanentemail => 'E-mail address',
10483: lastname => 'Last Name',
10484: firstname => 'First Name',
10485: middlename => 'Middle Name',
10486: generation => 'Generation',
10487: gen => 'Generation',
1.765 raeburn 10488: inststatus => 'Affiliation',
1.624 raeburn 10489: );
10490: return %fieldtitles;
10491: }
10492:
1.642 raeburn 10493: sub sorted_inst_types {
10494: my ($dom) = @_;
1.1185 raeburn 10495: my ($usertypes,$order);
10496: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10497: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10498: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10499: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10500: } else {
10501: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10502: }
1.642 raeburn 10503: my $othertitle = &mt('All users');
10504: if ($env{'request.course.id'}) {
1.668 raeburn 10505: $othertitle = &mt('Any users');
1.642 raeburn 10506: }
10507: my @types;
10508: if (ref($order) eq 'ARRAY') {
10509: @types = @{$order};
10510: }
10511: if (@types == 0) {
10512: if (ref($usertypes) eq 'HASH') {
10513: @types = sort(keys(%{$usertypes}));
10514: }
10515: }
10516: if (keys(%{$usertypes}) > 0) {
10517: $othertitle = &mt('Other users');
10518: }
10519: return ($othertitle,$usertypes,\@types);
10520: }
10521:
1.645 raeburn 10522: sub get_institutional_codes {
10523: my ($settings,$allcourses,$LC_code) = @_;
10524: # Get complete list of course sections to update
10525: my @currsections = ();
10526: my @currxlists = ();
10527: my $coursecode = $$settings{'internal.coursecode'};
10528:
10529: if ($$settings{'internal.sectionnums'} ne '') {
10530: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10531: }
10532:
10533: if ($$settings{'internal.crosslistings'} ne '') {
10534: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10535: }
10536:
10537: if (@currxlists > 0) {
10538: foreach (@currxlists) {
10539: if (m/^([^:]+):(\w*)$/) {
10540: unless (grep/^$1$/,@{$allcourses}) {
10541: push @{$allcourses},$1;
10542: $$LC_code{$1} = $2;
10543: }
10544: }
10545: }
10546: }
10547:
10548: if (@currsections > 0) {
10549: foreach (@currsections) {
10550: if (m/^(\w+):(\w*)$/) {
10551: my $sec = $coursecode.$1;
10552: my $lc_sec = $2;
10553: unless (grep/^$sec$/,@{$allcourses}) {
10554: push @{$allcourses},$sec;
10555: $$LC_code{$sec} = $lc_sec;
10556: }
10557: }
10558: }
10559: }
10560: return;
10561: }
10562:
1.971 raeburn 10563: sub get_standard_codeitems {
10564: return ('Year','Semester','Department','Number','Section');
10565: }
10566:
1.112 bowersj2 10567: =pod
10568:
1.780 raeburn 10569: =head1 Slot Helpers
10570:
10571: =over 4
10572:
10573: =item * sorted_slots()
10574:
1.1040 raeburn 10575: Sorts an array of slot names in order of an optional sort key,
10576: default sort is by slot start time (earliest first).
1.780 raeburn 10577:
10578: Inputs:
10579:
10580: =over 4
10581:
10582: slotsarr - Reference to array of unsorted slot names.
10583:
10584: slots - Reference to hash of hash, where outer hash keys are slot names.
10585:
1.1040 raeburn 10586: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10587:
1.549 albertel 10588: =back
10589:
1.780 raeburn 10590: Returns:
10591:
10592: =over 4
10593:
1.1040 raeburn 10594: sorted - An array of slot names sorted by a specified sort key
10595: (default sort key is start time of the slot).
1.780 raeburn 10596:
10597: =back
10598:
10599: =cut
10600:
10601:
10602: sub sorted_slots {
1.1040 raeburn 10603: my ($slotsarr,$slots,$sortkey) = @_;
10604: if ($sortkey eq '') {
10605: $sortkey = 'starttime';
10606: }
1.780 raeburn 10607: my @sorted;
10608: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10609: @sorted =
10610: sort {
10611: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10612: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10613: }
10614: if (ref($slots->{$a})) { return -1;}
10615: if (ref($slots->{$b})) { return 1;}
10616: return 0;
10617: } @{$slotsarr};
10618: }
10619: return @sorted;
10620: }
10621:
1.1040 raeburn 10622: =pod
10623:
10624: =item * get_future_slots()
10625:
10626: Inputs:
10627:
10628: =over 4
10629:
10630: cnum - course number
10631:
10632: cdom - course domain
10633:
10634: now - current UNIX time
10635:
10636: symb - optional symb
10637:
10638: =back
10639:
10640: Returns:
10641:
10642: =over 4
10643:
10644: sorted_reservable - ref to array of student_schedulable slots currently
10645: reservable, ordered by end date of reservation period.
10646:
10647: reservable_now - ref to hash of student_schedulable slots currently
10648: reservable.
10649:
10650: Keys in inner hash are:
10651: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10652: (b) endreserve: end date of reservation period.
10653: (c) uniqueperiod: start,end dates when slot is to be uniquely
10654: selected.
1.1040 raeburn 10655:
10656: sorted_future - ref to array of student_schedulable slots reservable in
10657: the future, ordered by start date of reservation period.
10658:
10659: future_reservable - ref to hash of student_schedulable slots reservable
10660: in the future.
10661:
10662: Keys in inner hash are:
10663: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10664: (b) startreserve: start date of reservation period.
10665: (c) uniqueperiod: start,end dates when slot is to be uniquely
10666: selected.
1.1040 raeburn 10667:
10668: =back
10669:
10670: =cut
10671:
10672: sub get_future_slots {
10673: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10674: my $map;
10675: if ($symb) {
10676: ($map) = &Apache::lonnet::decode_symb($symb);
10677: }
1.1040 raeburn 10678: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10679: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10680: foreach my $slot (keys(%slots)) {
10681: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10682: if ($symb) {
1.1229 raeburn 10683: if ($slots{$slot}->{'symb'} ne '') {
10684: my $canuse;
10685: my %oksymbs;
10686: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10687: map { $oksymbs{$_} = 1; } @slotsymbs;
10688: if ($oksymbs{$symb}) {
10689: $canuse = 1;
10690: } else {
10691: foreach my $item (@slotsymbs) {
10692: if ($item =~ /\.(page|sequence)$/) {
10693: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10694: if (($map ne '') && ($map eq $sloturl)) {
10695: $canuse = 1;
10696: last;
10697: }
10698: }
10699: }
10700: }
10701: next unless ($canuse);
10702: }
1.1040 raeburn 10703: }
10704: if (($slots{$slot}->{'starttime'} > $now) &&
10705: ($slots{$slot}->{'endtime'} > $now)) {
10706: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10707: my $userallowed = 0;
10708: if ($slots{$slot}->{'allowedsections'}) {
10709: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10710: if (!defined($env{'request.role.sec'})
10711: && grep(/^No section assigned$/,@allowed_sec)) {
10712: $userallowed=1;
10713: } else {
10714: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10715: $userallowed=1;
10716: }
10717: }
10718: unless ($userallowed) {
10719: if (defined($env{'request.course.groups'})) {
10720: my @groups = split(/:/,$env{'request.course.groups'});
10721: foreach my $group (@groups) {
10722: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10723: $userallowed=1;
10724: last;
10725: }
10726: }
10727: }
10728: }
10729: }
10730: if ($slots{$slot}->{'allowedusers'}) {
10731: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10732: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10733: if (grep(/^\Q$user\E$/,@allowed_users)) {
10734: $userallowed = 1;
10735: }
10736: }
10737: next unless($userallowed);
10738: }
10739: my $startreserve = $slots{$slot}->{'startreserve'};
10740: my $endreserve = $slots{$slot}->{'endreserve'};
10741: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 10742: my $uniqueperiod;
10743: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10744: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10745: }
1.1040 raeburn 10746: if (($startreserve < $now) &&
10747: (!$endreserve || $endreserve > $now)) {
10748: my $lastres = $endreserve;
10749: if (!$lastres) {
10750: $lastres = $slots{$slot}->{'starttime'};
10751: }
10752: $reservable_now{$slot} = {
10753: symb => $symb,
1.1250 raeburn 10754: endreserve => $lastres,
10755: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10756: };
10757: } elsif (($startreserve > $now) &&
10758: (!$endreserve || $endreserve > $startreserve)) {
10759: $future_reservable{$slot} = {
10760: symb => $symb,
1.1250 raeburn 10761: startreserve => $startreserve,
10762: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10763: };
10764: }
10765: }
10766: }
10767: my @unsorted_reservable = keys(%reservable_now);
10768: if (@unsorted_reservable > 0) {
10769: @sorted_reservable =
10770: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10771: }
10772: my @unsorted_future = keys(%future_reservable);
10773: if (@unsorted_future > 0) {
10774: @sorted_future =
10775: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10776: }
10777: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10778: }
1.780 raeburn 10779:
10780: =pod
10781:
1.1057 foxr 10782: =back
10783:
1.549 albertel 10784: =head1 HTTP Helpers
10785:
10786: =over 4
10787:
1.648 raeburn 10788: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10789:
1.258 albertel 10790: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10791: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10792: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10793:
10794: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10795: $possible_names is an ref to an array of form element names. As an example:
10796: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10797: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10798:
10799: =cut
1.1 albertel 10800:
1.6 albertel 10801: sub get_unprocessed_cgi {
1.25 albertel 10802: my ($query,$possible_names)= @_;
1.26 matthew 10803: # $Apache::lonxml::debug=1;
1.356 albertel 10804: foreach my $pair (split(/&/,$query)) {
10805: my ($name, $value) = split(/=/,$pair);
1.369 www 10806: $name = &unescape($name);
1.25 albertel 10807: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10808: $value =~ tr/+/ /;
10809: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10810: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10811: }
1.16 harris41 10812: }
1.6 albertel 10813: }
10814:
1.112 bowersj2 10815: =pod
10816:
1.648 raeburn 10817: =item * &cacheheader()
1.112 bowersj2 10818:
10819: returns cache-controlling header code
10820:
10821: =cut
10822:
1.7 albertel 10823: sub cacheheader {
1.258 albertel 10824: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10825: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10826: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10827: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10828: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10829: return $output;
1.7 albertel 10830: }
10831:
1.112 bowersj2 10832: =pod
10833:
1.648 raeburn 10834: =item * &no_cache($r)
1.112 bowersj2 10835:
10836: specifies header code to not have cache
10837:
10838: =cut
10839:
1.9 albertel 10840: sub no_cache {
1.216 albertel 10841: my ($r) = @_;
10842: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10843: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10844: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10845: $r->no_cache(1);
10846: $r->header_out("Expires" => $date);
10847: $r->header_out("Pragma" => "no-cache");
1.123 www 10848: }
10849:
10850: sub content_type {
1.181 albertel 10851: my ($r,$type,$charset) = @_;
1.299 foxr 10852: if ($r) {
10853: # Note that printout.pl calls this with undef for $r.
10854: &no_cache($r);
10855: }
1.258 albertel 10856: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10857: unless ($charset) {
10858: $charset=&Apache::lonlocal::current_encoding;
10859: }
10860: if ($charset) { $type.='; charset='.$charset; }
10861: if ($r) {
10862: $r->content_type($type);
10863: } else {
10864: print("Content-type: $type\n\n");
10865: }
1.9 albertel 10866: }
1.25 albertel 10867:
1.112 bowersj2 10868: =pod
10869:
1.648 raeburn 10870: =item * &add_to_env($name,$value)
1.112 bowersj2 10871:
1.258 albertel 10872: adds $name to the %env hash with value
1.112 bowersj2 10873: $value, if $name already exists, the entry is converted to an array
10874: reference and $value is added to the array.
10875:
10876: =cut
10877:
1.25 albertel 10878: sub add_to_env {
10879: my ($name,$value)=@_;
1.258 albertel 10880: if (defined($env{$name})) {
10881: if (ref($env{$name})) {
1.25 albertel 10882: #already have multiple values
1.258 albertel 10883: push(@{ $env{$name} },$value);
1.25 albertel 10884: } else {
10885: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10886: my $first=$env{$name};
10887: undef($env{$name});
10888: push(@{ $env{$name} },$first,$value);
1.25 albertel 10889: }
10890: } else {
1.258 albertel 10891: $env{$name}=$value;
1.25 albertel 10892: }
1.31 albertel 10893: }
1.149 albertel 10894:
10895: =pod
10896:
1.648 raeburn 10897: =item * &get_env_multiple($name)
1.149 albertel 10898:
1.258 albertel 10899: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10900: values may be defined and end up as an array ref.
10901:
10902: returns an array of values
10903:
10904: =cut
10905:
10906: sub get_env_multiple {
10907: my ($name) = @_;
10908: my @values;
1.258 albertel 10909: if (defined($env{$name})) {
1.149 albertel 10910: # exists is it an array
1.258 albertel 10911: if (ref($env{$name})) {
10912: @values=@{ $env{$name} };
1.149 albertel 10913: } else {
1.258 albertel 10914: $values[0]=$env{$name};
1.149 albertel 10915: }
10916: }
10917: return(@values);
10918: }
10919:
1.1249 damieng 10920: # Looks at given dependencies, and returns something depending on the context.
10921: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
10922: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
10923: # For all other contexts, returns ($output, $counter, $numpathchg).
10924: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
10925: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
10926: # $numpathchg: integer with the number of cleaned up dependency paths.
10927: # \%existing: hash reference clean path -> 1 only for existing dependencies.
10928: # \%mapping: hash reference clean path -> original path for all dependencies.
10929: # @param {string} actionurl - The path to the handler, indicative of the context.
10930: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
10931: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
10932: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
10933: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
10934: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 10935: sub ask_for_embedded_content {
1.1249 damieng 10936: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 10937: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10938: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10939: %currsubfile,%unused,$rem);
1.1071 raeburn 10940: my $counter = 0;
10941: my $numnew = 0;
1.987 raeburn 10942: my $numremref = 0;
10943: my $numinvalid = 0;
10944: my $numpathchg = 0;
10945: my $numexisting = 0;
1.1071 raeburn 10946: my $numunused = 0;
10947: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10948: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10949: my $heading = &mt('Upload embedded files');
10950: my $buttontext = &mt('Upload');
10951:
1.1249 damieng 10952: # fills these variables based on the context:
10953: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
10954: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 10955: if ($env{'request.course.id'}) {
1.1123 raeburn 10956: if ($actionurl eq '/adm/dependencies') {
10957: $navmap = Apache::lonnavmaps::navmap->new();
10958: }
10959: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10960: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10961: }
1.1123 raeburn 10962: if (($actionurl eq '/adm/portfolio') ||
10963: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10964: my $current_path='/';
10965: if ($env{'form.currentpath'}) {
10966: $current_path = $env{'form.currentpath'};
10967: }
10968: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10969: $udom = $cdom;
10970: $uname = $cnum;
1.984 raeburn 10971: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10972: } else {
10973: $udom = $env{'user.domain'};
10974: $uname = $env{'user.name'};
10975: $url = '/userfiles/portfolio';
10976: }
1.987 raeburn 10977: $toplevel = $url.'/';
1.984 raeburn 10978: $url .= $current_path;
10979: $getpropath = 1;
1.987 raeburn 10980: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10981: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10982: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10983: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10984: $toplevel = $url;
1.984 raeburn 10985: if ($rest ne '') {
1.987 raeburn 10986: $url .= $rest;
10987: }
10988: } elsif ($actionurl eq '/adm/coursedocs') {
10989: if (ref($args) eq 'HASH') {
1.1071 raeburn 10990: $url = $args->{'docs_url'};
10991: $toplevel = $url;
1.1084 raeburn 10992: if ($args->{'context'} eq 'paste') {
10993: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10994: ($path) =
10995: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10996: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10997: $fileloc =~ s{^/}{};
10998: }
1.1071 raeburn 10999: }
1.1084 raeburn 11000: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 11001: if ($env{'request.course.id'} ne '') {
11002: if (ref($args) eq 'HASH') {
11003: $url = $args->{'docs_url'};
11004: $title = $args->{'docs_title'};
1.1126 raeburn 11005: $toplevel = $url;
11006: unless ($toplevel =~ m{^/}) {
11007: $toplevel = "/$url";
11008: }
1.1085 raeburn 11009: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11010: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11011: $path = $1;
11012: } else {
11013: ($path) =
11014: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11015: }
1.1195 raeburn 11016: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11017: $fileloc = $toplevel;
11018: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11019: my ($udom,$uname,$fname) =
11020: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11021: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11022: } else {
11023: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11024: }
1.1071 raeburn 11025: $fileloc =~ s{^/}{};
11026: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11027: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11028: }
1.987 raeburn 11029: }
1.1123 raeburn 11030: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11031: $udom = $cdom;
11032: $uname = $cnum;
11033: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11034: $toplevel = $url;
11035: $path = $url;
11036: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11037: $fileloc =~ s{^/}{};
1.987 raeburn 11038: }
1.1249 damieng 11039:
11040: # parses the dependency paths to get some info
11041: # fills $newfiles, $mapping, $subdependencies, $dependencies
11042: # $newfiles: hash URL -> 1 for new files or external URLs
11043: # (will be completed later)
11044: # $mapping:
11045: # for external URLs: external URL -> external URL
11046: # for relative paths: clean path -> original path
11047: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11048: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11049: foreach my $file (keys(%{$allfiles})) {
11050: my $embed_file;
11051: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11052: $embed_file = $1;
11053: } else {
11054: $embed_file = $file;
11055: }
1.1158 raeburn 11056: my ($absolutepath,$cleaned_file);
11057: if ($embed_file =~ m{^\w+://}) {
11058: $cleaned_file = $embed_file;
1.1147 raeburn 11059: $newfiles{$cleaned_file} = 1;
11060: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11061: } else {
1.1158 raeburn 11062: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11063: if ($embed_file =~ m{^/}) {
11064: $absolutepath = $embed_file;
11065: }
1.1147 raeburn 11066: if ($cleaned_file =~ m{/}) {
11067: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11068: $path = &check_for_traversal($path,$url,$toplevel);
11069: my $item = $fname;
11070: if ($path ne '') {
11071: $item = $path.'/'.$fname;
11072: $subdependencies{$path}{$fname} = 1;
11073: } else {
11074: $dependencies{$item} = 1;
11075: }
11076: if ($absolutepath) {
11077: $mapping{$item} = $absolutepath;
11078: } else {
11079: $mapping{$item} = $embed_file;
11080: }
11081: } else {
11082: $dependencies{$embed_file} = 1;
11083: if ($absolutepath) {
1.1147 raeburn 11084: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11085: } else {
1.1147 raeburn 11086: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11087: }
11088: }
1.984 raeburn 11089: }
11090: }
1.1249 damieng 11091:
11092: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11093: # and lists
11094: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11095: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11096: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11097: # the path had to be cleaned up
11098: # $existing: hash clean path -> 1 if the file exists
11099: # $numexisting: number of keys in $existing
11100: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11101: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11102: # dependency subdirectories that are
11103: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11104: my $dirptr = 16384;
1.984 raeburn 11105: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11106: $currsubfile{$path} = {};
1.1123 raeburn 11107: if (($actionurl eq '/adm/portfolio') ||
11108: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11109: my ($sublistref,$listerror) =
11110: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11111: if (ref($sublistref) eq 'ARRAY') {
11112: foreach my $line (@{$sublistref}) {
11113: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11114: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11115: }
1.984 raeburn 11116: }
1.987 raeburn 11117: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11118: if (opendir(my $dir,$url.'/'.$path)) {
11119: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11120: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11121: }
1.1084 raeburn 11122: } elsif (($actionurl eq '/adm/dependencies') ||
11123: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11124: ($args->{'context'} eq 'paste')) ||
11125: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11126: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11127: my $dir;
11128: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11129: $dir = $fileloc;
11130: } else {
11131: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11132: }
1.1071 raeburn 11133: if ($dir ne '') {
11134: my ($sublistref,$listerror) =
11135: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11136: if (ref($sublistref) eq 'ARRAY') {
11137: foreach my $line (@{$sublistref}) {
11138: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11139: undef,$mtime)=split(/\&/,$line,12);
11140: unless (($testdir&$dirptr) ||
11141: ($file_name =~ /^\.\.?$/)) {
11142: $currsubfile{$path}{$file_name} = [$size,$mtime];
11143: }
11144: }
11145: }
11146: }
1.984 raeburn 11147: }
11148: }
11149: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11150: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11151: my $item = $path.'/'.$file;
11152: unless ($mapping{$item} eq $item) {
11153: $pathchanges{$item} = 1;
11154: }
11155: $existing{$item} = 1;
11156: $numexisting ++;
11157: } else {
11158: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11159: }
11160: }
1.1071 raeburn 11161: if ($actionurl eq '/adm/dependencies') {
11162: foreach my $path (keys(%currsubfile)) {
11163: if (ref($currsubfile{$path}) eq 'HASH') {
11164: foreach my $file (keys(%{$currsubfile{$path}})) {
11165: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11166: next if (($rem ne '') &&
11167: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11168: (ref($navmap) &&
11169: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11170: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11171: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11172: $unused{$path.'/'.$file} = 1;
11173: }
11174: }
11175: }
11176: }
11177: }
1.984 raeburn 11178: }
1.1249 damieng 11179:
11180: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11181: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11182: my %currfile;
1.1123 raeburn 11183: if (($actionurl eq '/adm/portfolio') ||
11184: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11185: my ($dirlistref,$listerror) =
11186: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11187: if (ref($dirlistref) eq 'ARRAY') {
11188: foreach my $line (@{$dirlistref}) {
11189: my ($file_name,$rest) = split(/\&/,$line,2);
11190: $currfile{$file_name} = 1;
11191: }
1.984 raeburn 11192: }
1.987 raeburn 11193: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11194: if (opendir(my $dir,$url)) {
1.987 raeburn 11195: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11196: map {$currfile{$_} = 1;} @dir_list;
11197: }
1.1084 raeburn 11198: } elsif (($actionurl eq '/adm/dependencies') ||
11199: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11200: ($args->{'context'} eq 'paste')) ||
11201: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11202: if ($env{'request.course.id'} ne '') {
11203: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11204: if ($dir ne '') {
11205: my ($dirlistref,$listerror) =
11206: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11207: if (ref($dirlistref) eq 'ARRAY') {
11208: foreach my $line (@{$dirlistref}) {
11209: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11210: $size,undef,$mtime)=split(/\&/,$line,12);
11211: unless (($testdir&$dirptr) ||
11212: ($file_name =~ /^\.\.?$/)) {
11213: $currfile{$file_name} = [$size,$mtime];
11214: }
11215: }
11216: }
11217: }
11218: }
1.984 raeburn 11219: }
1.1249 damieng 11220: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11221: # are not in subdirectories, using $currfile
1.984 raeburn 11222: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11223: if (exists($currfile{$file})) {
1.987 raeburn 11224: unless ($mapping{$file} eq $file) {
11225: $pathchanges{$file} = 1;
11226: }
11227: $existing{$file} = 1;
11228: $numexisting ++;
11229: } else {
1.984 raeburn 11230: $newfiles{$file} = 1;
11231: }
11232: }
1.1071 raeburn 11233: foreach my $file (keys(%currfile)) {
11234: unless (($file eq $filename) ||
11235: ($file eq $filename.'.bak') ||
11236: ($dependencies{$file})) {
1.1085 raeburn 11237: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11238: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11239: next if (($rem ne '') &&
11240: (($env{"httpref.$rem".$file} ne '') ||
11241: (ref($navmap) &&
11242: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11243: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11244: ($navmap->getResourceByUrl($rem.$1)))))));
11245: }
1.1085 raeburn 11246: }
1.1071 raeburn 11247: $unused{$file} = 1;
11248: }
11249: }
1.1249 damieng 11250:
11251: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11252: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11253: ($args->{'context'} eq 'paste')) {
11254: $counter = scalar(keys(%existing));
11255: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11256: return ($output,$counter,$numpathchg,\%existing);
11257: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11258: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11259: $counter = scalar(keys(%existing));
11260: $numpathchg = scalar(keys(%pathchanges));
11261: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11262: }
1.1249 damieng 11263:
11264: # returns HTML otherwise, with dependency results and to ask for more uploads
11265:
11266: # $upload_output: missing dependencies (with upload form)
11267: # $modify_output: uploaded dependencies (in use)
11268: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11269: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11270: if ($actionurl eq '/adm/dependencies') {
11271: next if ($embed_file =~ m{^\w+://});
11272: }
1.660 raeburn 11273: $upload_output .= &start_data_table_row().
1.1123 raeburn 11274: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11275: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11276: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11277: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11278: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11279: }
1.1123 raeburn 11280: $upload_output .= '</td>';
1.1071 raeburn 11281: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11282: $upload_output.='<td align="right">'.
11283: '<span class="LC_info LC_fontsize_medium">'.
11284: &mt("URL points to web address").'</span>';
1.987 raeburn 11285: $numremref++;
1.660 raeburn 11286: } elsif ($args->{'error_on_invalid_names'}
11287: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11288: $upload_output.='<td align="right"><span class="LC_warning">'.
11289: &mt('Invalid characters').'</span>';
1.987 raeburn 11290: $numinvalid++;
1.660 raeburn 11291: } else {
1.1123 raeburn 11292: $upload_output .= '<td>'.
11293: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11294: $embed_file,\%mapping,
1.1071 raeburn 11295: $allfiles,$codebase,'upload');
11296: $counter ++;
11297: $numnew ++;
1.987 raeburn 11298: }
11299: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11300: }
11301: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11302: if ($actionurl eq '/adm/dependencies') {
11303: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11304: $modify_output .= &start_data_table_row().
11305: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11306: '<img src="'.&icon($embed_file).'" border="0" />'.
11307: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11308: '<td>'.$size.'</td>'.
11309: '<td>'.$mtime.'</td>'.
11310: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11311: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11312: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11313: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11314: &embedded_file_element('upload_embedded',$counter,
11315: $embed_file,\%mapping,
11316: $allfiles,$codebase,'modify').
11317: '</div></td>'.
11318: &end_data_table_row()."\n";
11319: $counter ++;
11320: } else {
11321: $upload_output .= &start_data_table_row().
1.1123 raeburn 11322: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11323: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11324: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11325: &Apache::loncommon::end_data_table_row()."\n";
11326: }
11327: }
11328: my $delidx = $counter;
11329: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11330: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11331: $delete_output .= &start_data_table_row().
11332: '<td><img src="'.&icon($oldfile).'" />'.
11333: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11334: '<td>'.$size.'</td>'.
11335: '<td>'.$mtime.'</td>'.
11336: '<td><label><input type="checkbox" name="del_upload_dep" '.
11337: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11338: &embedded_file_element('upload_embedded',$delidx,
11339: $oldfile,\%mapping,$allfiles,
11340: $codebase,'delete').'</td>'.
11341: &end_data_table_row()."\n";
11342: $numunused ++;
11343: $delidx ++;
1.987 raeburn 11344: }
11345: if ($upload_output) {
11346: $upload_output = &start_data_table().
11347: $upload_output.
11348: &end_data_table()."\n";
11349: }
1.1071 raeburn 11350: if ($modify_output) {
11351: $modify_output = &start_data_table().
11352: &start_data_table_header_row().
11353: '<th>'.&mt('File').'</th>'.
11354: '<th>'.&mt('Size (KB)').'</th>'.
11355: '<th>'.&mt('Modified').'</th>'.
11356: '<th>'.&mt('Upload replacement?').'</th>'.
11357: &end_data_table_header_row().
11358: $modify_output.
11359: &end_data_table()."\n";
11360: }
11361: if ($delete_output) {
11362: $delete_output = &start_data_table().
11363: &start_data_table_header_row().
11364: '<th>'.&mt('File').'</th>'.
11365: '<th>'.&mt('Size (KB)').'</th>'.
11366: '<th>'.&mt('Modified').'</th>'.
11367: '<th>'.&mt('Delete?').'</th>'.
11368: &end_data_table_header_row().
11369: $delete_output.
11370: &end_data_table()."\n";
11371: }
1.987 raeburn 11372: my $applies = 0;
11373: if ($numremref) {
11374: $applies ++;
11375: }
11376: if ($numinvalid) {
11377: $applies ++;
11378: }
11379: if ($numexisting) {
11380: $applies ++;
11381: }
1.1071 raeburn 11382: if ($counter || $numunused) {
1.987 raeburn 11383: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11384: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11385: $state.'<h3>'.$heading.'</h3>';
11386: if ($actionurl eq '/adm/dependencies') {
11387: if ($numnew) {
11388: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11389: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11390: $upload_output.'<br />'."\n";
11391: }
11392: if ($numexisting) {
11393: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11394: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11395: $modify_output.'<br />'."\n";
11396: $buttontext = &mt('Save changes');
11397: }
11398: if ($numunused) {
11399: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11400: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11401: $delete_output.'<br />'."\n";
11402: $buttontext = &mt('Save changes');
11403: }
11404: } else {
11405: $output .= $upload_output.'<br />'."\n";
11406: }
11407: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11408: $counter.'" />'."\n";
11409: if ($actionurl eq '/adm/dependencies') {
11410: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11411: $numnew.'" />'."\n";
11412: } elsif ($actionurl eq '') {
1.987 raeburn 11413: $output .= '<input type="hidden" name="phase" value="three" />';
11414: }
11415: } elsif ($applies) {
11416: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11417: if ($applies > 1) {
11418: $output .=
1.1123 raeburn 11419: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11420: if ($numremref) {
11421: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11422: }
11423: if ($numinvalid) {
11424: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11425: }
11426: if ($numexisting) {
11427: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11428: }
11429: $output .= '</ul><br />';
11430: } elsif ($numremref) {
11431: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11432: } elsif ($numinvalid) {
11433: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11434: } elsif ($numexisting) {
11435: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11436: }
11437: $output .= $upload_output.'<br />';
11438: }
11439: my ($pathchange_output,$chgcount);
1.1071 raeburn 11440: $chgcount = $counter;
1.987 raeburn 11441: if (keys(%pathchanges) > 0) {
11442: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11443: if ($counter) {
1.987 raeburn 11444: $output .= &embedded_file_element('pathchange',$chgcount,
11445: $embed_file,\%mapping,
1.1071 raeburn 11446: $allfiles,$codebase,'change');
1.987 raeburn 11447: } else {
11448: $pathchange_output .=
11449: &start_data_table_row().
11450: '<td><input type ="checkbox" name="namechange" value="'.
11451: $chgcount.'" checked="checked" /></td>'.
11452: '<td>'.$mapping{$embed_file}.'</td>'.
11453: '<td>'.$embed_file.
11454: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11455: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11456: '</td>'.&end_data_table_row();
1.660 raeburn 11457: }
1.987 raeburn 11458: $numpathchg ++;
11459: $chgcount ++;
1.660 raeburn 11460: }
11461: }
1.1127 raeburn 11462: if (($counter) || ($numunused)) {
1.987 raeburn 11463: if ($numpathchg) {
11464: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11465: $numpathchg.'" />'."\n";
11466: }
11467: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11468: ($actionurl eq '/adm/imsimport')) {
11469: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11470: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11471: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11472: } elsif ($actionurl eq '/adm/dependencies') {
11473: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11474: }
1.1123 raeburn 11475: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11476: } elsif ($numpathchg) {
11477: my %pathchange = ();
11478: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11479: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11480: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11481: }
1.987 raeburn 11482: }
1.1071 raeburn 11483: return ($output,$counter,$numpathchg);
1.987 raeburn 11484: }
11485:
1.1147 raeburn 11486: =pod
11487:
11488: =item * clean_path($name)
11489:
11490: Performs clean-up of directories, subdirectories and filename in an
11491: embedded object, referenced in an HTML file which is being uploaded
11492: to a course or portfolio, where
11493: "Upload embedded images/multimedia files if HTML file" checkbox was
11494: checked.
11495:
11496: Clean-up is similar to replacements in lonnet::clean_filename()
11497: except each / between sub-directory and next level is preserved.
11498:
11499: =cut
11500:
11501: sub clean_path {
11502: my ($embed_file) = @_;
11503: $embed_file =~s{^/+}{};
11504: my @contents;
11505: if ($embed_file =~ m{/}) {
11506: @contents = split(/\//,$embed_file);
11507: } else {
11508: @contents = ($embed_file);
11509: }
11510: my $lastidx = scalar(@contents)-1;
11511: for (my $i=0; $i<=$lastidx; $i++) {
11512: $contents[$i]=~s{\\}{/}g;
11513: $contents[$i]=~s/\s+/\_/g;
11514: $contents[$i]=~s{[^/\w\.\-]}{}g;
11515: if ($i == $lastidx) {
11516: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11517: }
11518: }
11519: if ($lastidx > 0) {
11520: return join('/',@contents);
11521: } else {
11522: return $contents[0];
11523: }
11524: }
11525:
1.987 raeburn 11526: sub embedded_file_element {
1.1071 raeburn 11527: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11528: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11529: (ref($codebase) eq 'HASH'));
11530: my $output;
1.1071 raeburn 11531: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11532: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11533: }
11534: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11535: &escape($embed_file).'" />';
11536: unless (($context eq 'upload_embedded') &&
11537: ($mapping->{$embed_file} eq $embed_file)) {
11538: $output .='
11539: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11540: }
11541: my $attrib;
11542: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11543: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11544: }
11545: $output .=
11546: "\n\t\t".
11547: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11548: $attrib.'" />';
11549: if (exists($codebase->{$mapping->{$embed_file}})) {
11550: $output .=
11551: "\n\t\t".
11552: '<input name="codebase_'.$num.'" type="hidden" value="'.
11553: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11554: }
1.987 raeburn 11555: return $output;
1.660 raeburn 11556: }
11557:
1.1071 raeburn 11558: sub get_dependency_details {
11559: my ($currfile,$currsubfile,$embed_file) = @_;
11560: my ($size,$mtime,$showsize,$showmtime);
11561: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11562: if ($embed_file =~ m{/}) {
11563: my ($path,$fname) = split(/\//,$embed_file);
11564: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11565: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11566: }
11567: } else {
11568: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11569: ($size,$mtime) = @{$currfile->{$embed_file}};
11570: }
11571: }
11572: $showsize = $size/1024.0;
11573: $showsize = sprintf("%.1f",$showsize);
11574: if ($mtime > 0) {
11575: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11576: }
11577: }
11578: return ($showsize,$showmtime);
11579: }
11580:
11581: sub ask_embedded_js {
11582: return <<"END";
11583: <script type="text/javascript"">
11584: // <![CDATA[
11585: function toggleBrowse(counter) {
11586: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11587: var fileid = document.getElementById('embedded_item_'+counter);
11588: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11589: if (chkboxid.checked == true) {
11590: uploaddivid.style.display='block';
11591: } else {
11592: uploaddivid.style.display='none';
11593: fileid.value = '';
11594: }
11595: }
11596: // ]]>
11597: </script>
11598:
11599: END
11600: }
11601:
1.661 raeburn 11602: sub upload_embedded {
11603: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11604: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11605: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11606: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11607: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11608: my $orig_uploaded_filename =
11609: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11610: foreach my $type ('orig','ref','attrib','codebase') {
11611: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11612: $env{'form.embedded_'.$type.'_'.$i} =
11613: &unescape($env{'form.embedded_'.$type.'_'.$i});
11614: }
11615: }
1.661 raeburn 11616: my ($path,$fname) =
11617: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11618: # no path, whole string is fname
11619: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11620: $fname = &Apache::lonnet::clean_filename($fname);
11621: # See if there is anything left
11622: next if ($fname eq '');
11623:
11624: # Check if file already exists as a file or directory.
11625: my ($state,$msg);
11626: if ($context eq 'portfolio') {
11627: my $port_path = $dirpath;
11628: if ($group ne '') {
11629: $port_path = "groups/$group/$port_path";
11630: }
1.987 raeburn 11631: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11632: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11633: $dir_root,$port_path,$disk_quota,
11634: $current_disk_usage,$uname,$udom);
11635: if ($state eq 'will_exceed_quota'
1.984 raeburn 11636: || $state eq 'file_locked') {
1.661 raeburn 11637: $output .= $msg;
11638: next;
11639: }
11640: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11641: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11642: if ($state eq 'exists') {
11643: $output .= $msg;
11644: next;
11645: }
11646: }
11647: # Check if extension is valid
11648: if (($fname =~ /\.(\w+)$/) &&
11649: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11650: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11651: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11652: next;
11653: } elsif (($fname =~ /\.(\w+)$/) &&
11654: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11655: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11656: next;
11657: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11658: $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 11659: next;
11660: }
11661: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11662: my $subdir = $path;
11663: $subdir =~ s{/+$}{};
1.661 raeburn 11664: if ($context eq 'portfolio') {
1.984 raeburn 11665: my $result;
11666: if ($state eq 'existingfile') {
11667: $result=
11668: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11669: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11670: } else {
1.984 raeburn 11671: $result=
11672: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11673: $dirpath.
1.1123 raeburn 11674: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11675: if ($result !~ m|^/uploaded/|) {
11676: $output .= '<span class="LC_error">'
11677: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11678: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11679: .'</span><br />';
11680: next;
11681: } else {
1.987 raeburn 11682: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11683: $path.$fname.'</span>').'<br />';
1.984 raeburn 11684: }
1.661 raeburn 11685: }
1.1123 raeburn 11686: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11687: my $extendedsubdir = $dirpath.'/'.$subdir;
11688: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11689: my $result =
1.1126 raeburn 11690: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11691: if ($result !~ m|^/uploaded/|) {
11692: $output .= '<span class="LC_error">'
11693: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11694: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11695: .'</span><br />';
11696: next;
11697: } else {
11698: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11699: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11700: if ($context eq 'syllabus') {
11701: &Apache::lonnet::make_public_indefinitely($result);
11702: }
1.987 raeburn 11703: }
1.661 raeburn 11704: } else {
11705: # Save the file
11706: my $target = $env{'form.embedded_item_'.$i};
11707: my $fullpath = $dir_root.$dirpath.'/'.$path;
11708: my $dest = $fullpath.$fname;
11709: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11710: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11711: my $count;
11712: my $filepath = $dir_root;
1.1027 raeburn 11713: foreach my $subdir (@parts) {
11714: $filepath .= "/$subdir";
11715: if (!-e $filepath) {
1.661 raeburn 11716: mkdir($filepath,0770);
11717: }
11718: }
11719: my $fh;
11720: if (!open($fh,'>'.$dest)) {
11721: &Apache::lonnet::logthis('Failed to create '.$dest);
11722: $output .= '<span class="LC_error">'.
1.1071 raeburn 11723: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11724: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11725: '</span><br />';
11726: } else {
11727: if (!print $fh $env{'form.embedded_item_'.$i}) {
11728: &Apache::lonnet::logthis('Failed to write to '.$dest);
11729: $output .= '<span class="LC_error">'.
1.1071 raeburn 11730: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11731: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11732: '</span><br />';
11733: } else {
1.987 raeburn 11734: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11735: $url.'</span>').'<br />';
11736: unless ($context eq 'testbank') {
11737: $footer .= &mt('View embedded file: [_1]',
11738: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11739: }
11740: }
11741: close($fh);
11742: }
11743: }
11744: if ($env{'form.embedded_ref_'.$i}) {
11745: $pathchange{$i} = 1;
11746: }
11747: }
11748: if ($output) {
11749: $output = '<p>'.$output.'</p>';
11750: }
11751: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11752: $returnflag = 'ok';
1.1071 raeburn 11753: my $numpathchgs = scalar(keys(%pathchange));
11754: if ($numpathchgs > 0) {
1.987 raeburn 11755: if ($context eq 'portfolio') {
11756: $output .= '<p>'.&mt('or').'</p>';
11757: } elsif ($context eq 'testbank') {
1.1071 raeburn 11758: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11759: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11760: $returnflag = 'modify_orightml';
11761: }
11762: }
1.1071 raeburn 11763: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11764: }
11765:
11766: sub modify_html_form {
11767: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11768: my $end = 0;
11769: my $modifyform;
11770: if ($context eq 'upload_embedded') {
11771: return unless (ref($pathchange) eq 'HASH');
11772: if ($env{'form.number_embedded_items'}) {
11773: $end += $env{'form.number_embedded_items'};
11774: }
11775: if ($env{'form.number_pathchange_items'}) {
11776: $end += $env{'form.number_pathchange_items'};
11777: }
11778: if ($end) {
11779: for (my $i=0; $i<$end; $i++) {
11780: if ($i < $env{'form.number_embedded_items'}) {
11781: next unless($pathchange->{$i});
11782: }
11783: $modifyform .=
11784: &start_data_table_row().
11785: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11786: 'checked="checked" /></td>'.
11787: '<td>'.$env{'form.embedded_ref_'.$i}.
11788: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11789: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11790: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11791: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11792: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11793: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11794: '<td>'.$env{'form.embedded_orig_'.$i}.
11795: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11796: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11797: &end_data_table_row();
1.1071 raeburn 11798: }
1.987 raeburn 11799: }
11800: } else {
11801: $modifyform = $pathchgtable;
11802: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11803: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11804: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11805: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11806: }
11807: }
11808: if ($modifyform) {
1.1071 raeburn 11809: if ($actionurl eq '/adm/dependencies') {
11810: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11811: }
1.987 raeburn 11812: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11813: '<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".
11814: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11815: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11816: '</ol></p>'."\n".'<p>'.
11817: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11818: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11819: &start_data_table()."\n".
11820: &start_data_table_header_row().
11821: '<th>'.&mt('Change?').'</th>'.
11822: '<th>'.&mt('Current reference').'</th>'.
11823: '<th>'.&mt('Required reference').'</th>'.
11824: &end_data_table_header_row()."\n".
11825: $modifyform.
11826: &end_data_table().'<br />'."\n".$hiddenstate.
11827: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11828: '</form>'."\n";
11829: }
11830: return;
11831: }
11832:
11833: sub modify_html_refs {
1.1123 raeburn 11834: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11835: my $container;
11836: if ($context eq 'portfolio') {
11837: $container = $env{'form.container'};
11838: } elsif ($context eq 'coursedoc') {
11839: $container = $env{'form.primaryurl'};
1.1071 raeburn 11840: } elsif ($context eq 'manage_dependencies') {
11841: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11842: $container = "/$container";
1.1123 raeburn 11843: } elsif ($context eq 'syllabus') {
11844: $container = $url;
1.987 raeburn 11845: } else {
1.1027 raeburn 11846: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11847: }
11848: my (%allfiles,%codebase,$output,$content);
11849: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11850: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11851: if (wantarray) {
11852: return ('',0,0);
11853: } else {
11854: return;
11855: }
11856: }
11857: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11858: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11859: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11860: if (wantarray) {
11861: return ('',0,0);
11862: } else {
11863: return;
11864: }
11865: }
1.987 raeburn 11866: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11867: if ($content eq '-1') {
11868: if (wantarray) {
11869: return ('',0,0);
11870: } else {
11871: return;
11872: }
11873: }
1.987 raeburn 11874: } else {
1.1071 raeburn 11875: unless ($container =~ /^\Q$dir_root\E/) {
11876: if (wantarray) {
11877: return ('',0,0);
11878: } else {
11879: return;
11880: }
11881: }
1.987 raeburn 11882: if (open(my $fh,"<$container")) {
11883: $content = join('', <$fh>);
11884: close($fh);
11885: } else {
1.1071 raeburn 11886: if (wantarray) {
11887: return ('',0,0);
11888: } else {
11889: return;
11890: }
1.987 raeburn 11891: }
11892: }
11893: my ($count,$codebasecount) = (0,0);
11894: my $mm = new File::MMagic;
11895: my $mime_type = $mm->checktype_contents($content);
11896: if ($mime_type eq 'text/html') {
11897: my $parse_result =
11898: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11899: \%codebase,\$content);
11900: if ($parse_result eq 'ok') {
11901: foreach my $i (@changes) {
11902: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11903: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11904: if ($allfiles{$ref}) {
11905: my $newname = $orig;
11906: my ($attrib_regexp,$codebase);
1.1006 raeburn 11907: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11908: if ($attrib_regexp =~ /:/) {
11909: $attrib_regexp =~ s/\:/|/g;
11910: }
11911: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11912: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11913: $count += $numchg;
1.1123 raeburn 11914: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11915: delete($allfiles{$ref});
1.987 raeburn 11916: }
11917: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11918: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11919: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11920: $codebasecount ++;
11921: }
11922: }
11923: }
1.1123 raeburn 11924: my $skiprewrites;
1.987 raeburn 11925: if ($count || $codebasecount) {
11926: my $saveresult;
1.1071 raeburn 11927: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11928: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11929: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11930: if ($url eq $container) {
11931: my ($fname) = ($container =~ m{/([^/]+)$});
11932: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11933: $count,'<span class="LC_filename">'.
1.1071 raeburn 11934: $fname.'</span>').'</p>';
1.987 raeburn 11935: } else {
11936: $output = '<p class="LC_error">'.
11937: &mt('Error: update failed for: [_1].',
11938: '<span class="LC_filename">'.
11939: $container.'</span>').'</p>';
11940: }
1.1123 raeburn 11941: if ($context eq 'syllabus') {
11942: unless ($saveresult eq 'ok') {
11943: $skiprewrites = 1;
11944: }
11945: }
1.987 raeburn 11946: } else {
11947: if (open(my $fh,">$container")) {
11948: print $fh $content;
11949: close($fh);
11950: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11951: $count,'<span class="LC_filename">'.
11952: $container.'</span>').'</p>';
1.661 raeburn 11953: } else {
1.987 raeburn 11954: $output = '<p class="LC_error">'.
11955: &mt('Error: could not update [_1].',
11956: '<span class="LC_filename">'.
11957: $container.'</span>').'</p>';
1.661 raeburn 11958: }
11959: }
11960: }
1.1123 raeburn 11961: if (($context eq 'syllabus') && (!$skiprewrites)) {
11962: my ($actionurl,$state);
11963: $actionurl = "/public/$udom/$uname/syllabus";
11964: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11965: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11966: \%codebase,
11967: {'context' => 'rewrites',
11968: 'ignore_remote_references' => 1,});
11969: if (ref($mapping) eq 'HASH') {
11970: my $rewrites = 0;
11971: foreach my $key (keys(%{$mapping})) {
11972: next if ($key =~ m{^https?://});
11973: my $ref = $mapping->{$key};
11974: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11975: my $attrib;
11976: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11977: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11978: }
11979: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11980: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11981: $rewrites += $numchg;
11982: }
11983: }
11984: if ($rewrites) {
11985: my $saveresult;
11986: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11987: if ($url eq $container) {
11988: my ($fname) = ($container =~ m{/([^/]+)$});
11989: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11990: $count,'<span class="LC_filename">'.
11991: $fname.'</span>').'</p>';
11992: } else {
11993: $output .= '<p class="LC_error">'.
11994: &mt('Error: could not update links in [_1].',
11995: '<span class="LC_filename">'.
11996: $container.'</span>').'</p>';
11997:
11998: }
11999: }
12000: }
12001: }
1.987 raeburn 12002: } else {
12003: &logthis('Failed to parse '.$container.
12004: ' to modify references: '.$parse_result);
1.661 raeburn 12005: }
12006: }
1.1071 raeburn 12007: if (wantarray) {
12008: return ($output,$count,$codebasecount);
12009: } else {
12010: return $output;
12011: }
1.661 raeburn 12012: }
12013:
12014: sub check_for_existing {
12015: my ($path,$fname,$element) = @_;
12016: my ($state,$msg);
12017: if (-d $path.'/'.$fname) {
12018: $state = 'exists';
12019: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12020: } elsif (-e $path.'/'.$fname) {
12021: $state = 'exists';
12022: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12023: }
12024: if ($state eq 'exists') {
12025: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12026: }
12027: return ($state,$msg);
12028: }
12029:
12030: sub check_for_upload {
12031: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12032: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12033: my $filesize = length($env{'form.'.$element});
12034: if (!$filesize) {
12035: my $msg = '<span class="LC_error">'.
12036: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12037: '<span class="LC_filename">'.$fname.'</span>',
12038: $filesize).'<br />'.
1.1007 raeburn 12039: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12040: '</span>';
12041: return ('zero_bytes',$msg);
12042: }
12043: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12044: my $getpropath = 1;
1.1021 raeburn 12045: my ($dirlistref,$listerror) =
12046: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12047: my $found_file = 0;
12048: my $locked_file = 0;
1.991 raeburn 12049: my @lockers;
12050: my $navmap;
12051: if ($env{'request.course.id'}) {
12052: $navmap = Apache::lonnavmaps::navmap->new();
12053: }
1.1021 raeburn 12054: if (ref($dirlistref) eq 'ARRAY') {
12055: foreach my $line (@{$dirlistref}) {
12056: my ($file_name,$rest)=split(/\&/,$line,2);
12057: if ($file_name eq $fname){
12058: $file_name = $path.$file_name;
12059: if ($group ne '') {
12060: $file_name = $group.$file_name;
12061: }
12062: $found_file = 1;
12063: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12064: foreach my $lock (@lockers) {
12065: if (ref($lock) eq 'ARRAY') {
12066: my ($symb,$crsid) = @{$lock};
12067: if ($crsid eq $env{'request.course.id'}) {
12068: if (ref($navmap)) {
12069: my $res = $navmap->getBySymb($symb);
12070: foreach my $part (@{$res->parts()}) {
12071: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12072: unless (($slot_status == $res->RESERVED) ||
12073: ($slot_status == $res->RESERVED_LOCATION)) {
12074: $locked_file = 1;
12075: }
1.991 raeburn 12076: }
1.1021 raeburn 12077: } else {
12078: $locked_file = 1;
1.991 raeburn 12079: }
12080: } else {
12081: $locked_file = 1;
12082: }
12083: }
1.1021 raeburn 12084: }
12085: } else {
12086: my @info = split(/\&/,$rest);
12087: my $currsize = $info[6]/1000;
12088: if ($currsize < $filesize) {
12089: my $extra = $filesize - $currsize;
12090: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12091: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12092: &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 12093: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12094: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12095: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12096: return ('will_exceed_quota',$msg);
12097: }
1.984 raeburn 12098: }
12099: }
1.661 raeburn 12100: }
12101: }
12102: }
12103: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12104: my $msg = '<p class="LC_warning">'.
12105: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12106: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12107: return ('will_exceed_quota',$msg);
12108: } elsif ($found_file) {
12109: if ($locked_file) {
1.1179 bisitz 12110: my $msg = '<p class="LC_warning">';
1.661 raeburn 12111: $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 12112: $msg .= '</p>';
1.661 raeburn 12113: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12114: return ('file_locked',$msg);
12115: } else {
1.1179 bisitz 12116: my $msg = '<p class="LC_error">';
1.984 raeburn 12117: $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 12118: $msg .= '</p>';
1.984 raeburn 12119: return ('existingfile',$msg);
1.661 raeburn 12120: }
12121: }
12122: }
12123:
1.987 raeburn 12124: sub check_for_traversal {
12125: my ($path,$url,$toplevel) = @_;
12126: my @parts=split(/\//,$path);
12127: my $cleanpath;
12128: my $fullpath = $url;
12129: for (my $i=0;$i<@parts;$i++) {
12130: next if ($parts[$i] eq '.');
12131: if ($parts[$i] eq '..') {
12132: $fullpath =~ s{([^/]+/)$}{};
12133: } else {
12134: $fullpath .= $parts[$i].'/';
12135: }
12136: }
12137: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12138: $cleanpath = $1;
12139: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12140: my $curr_toprel = $1;
12141: my @parts = split(/\//,$curr_toprel);
12142: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12143: my @urlparts = split(/\//,$url_toprel);
12144: my $doubledots;
12145: my $startdiff = -1;
12146: for (my $i=0; $i<@urlparts; $i++) {
12147: if ($startdiff == -1) {
12148: unless ($urlparts[$i] eq $parts[$i]) {
12149: $startdiff = $i;
12150: $doubledots .= '../';
12151: }
12152: } else {
12153: $doubledots .= '../';
12154: }
12155: }
12156: if ($startdiff > -1) {
12157: $cleanpath = $doubledots;
12158: for (my $i=$startdiff; $i<@parts; $i++) {
12159: $cleanpath .= $parts[$i].'/';
12160: }
12161: }
12162: }
12163: $cleanpath =~ s{(/)$}{};
12164: return $cleanpath;
12165: }
1.31 albertel 12166:
1.1053 raeburn 12167: sub is_archive_file {
12168: my ($mimetype) = @_;
12169: if (($mimetype eq 'application/octet-stream') ||
12170: ($mimetype eq 'application/x-stuffit') ||
12171: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12172: return 1;
12173: }
12174: return;
12175: }
12176:
12177: sub decompress_form {
1.1065 raeburn 12178: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12179: my %lt = &Apache::lonlocal::texthash (
12180: this => 'This file is an archive file.',
1.1067 raeburn 12181: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12182: itsc => 'Its contents are as follows:',
1.1053 raeburn 12183: youm => 'You may wish to extract its contents.',
12184: extr => 'Extract contents',
1.1067 raeburn 12185: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12186: proa => 'Process automatically?',
1.1053 raeburn 12187: yes => 'Yes',
12188: no => 'No',
1.1067 raeburn 12189: fold => 'Title for folder containing movie',
12190: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12191: );
1.1065 raeburn 12192: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12193: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12194: my $info = &list_archive_contents($fileloc,\@paths);
12195: if (@paths) {
12196: foreach my $path (@paths) {
12197: $path =~ s{^/}{};
1.1067 raeburn 12198: if ($path =~ m{^([^/]+)/$}) {
12199: $topdir = $1;
12200: }
1.1065 raeburn 12201: if ($path =~ m{^([^/]+)/}) {
12202: $toplevel{$1} = $path;
12203: } else {
12204: $toplevel{$path} = $path;
12205: }
12206: }
12207: }
1.1067 raeburn 12208: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12209: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12210: "$topdir/media/",
12211: "$topdir/media/$topdir.mp4",
12212: "$topdir/media/FirstFrame.png",
12213: "$topdir/media/player.swf",
12214: "$topdir/media/swfobject.js",
12215: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12216: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12217: "$topdir/$topdir.mp4",
12218: "$topdir/$topdir\_config.xml",
12219: "$topdir/$topdir\_controller.swf",
12220: "$topdir/$topdir\_embed.css",
12221: "$topdir/$topdir\_First_Frame.png",
12222: "$topdir/$topdir\_player.html",
12223: "$topdir/$topdir\_Thumbnails.png",
12224: "$topdir/playerProductInstall.swf",
12225: "$topdir/scripts/",
12226: "$topdir/scripts/config_xml.js",
12227: "$topdir/scripts/handlebars.js",
12228: "$topdir/scripts/jquery-1.7.1.min.js",
12229: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12230: "$topdir/scripts/modernizr.js",
12231: "$topdir/scripts/player-min.js",
12232: "$topdir/scripts/swfobject.js",
12233: "$topdir/skins/",
12234: "$topdir/skins/configuration_express.xml",
12235: "$topdir/skins/express_show/",
12236: "$topdir/skins/express_show/player-min.css",
12237: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12238: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12239: "$topdir/$topdir.mp4",
12240: "$topdir/$topdir\_config.xml",
12241: "$topdir/$topdir\_controller.swf",
12242: "$topdir/$topdir\_embed.css",
12243: "$topdir/$topdir\_First_Frame.png",
12244: "$topdir/$topdir\_player.html",
12245: "$topdir/$topdir\_Thumbnails.png",
12246: "$topdir/playerProductInstall.swf",
12247: "$topdir/scripts/",
12248: "$topdir/scripts/config_xml.js",
12249: "$topdir/scripts/techsmith-smart-player.min.js",
12250: "$topdir/skins/",
12251: "$topdir/skins/configuration_express.xml",
12252: "$topdir/skins/express_show/",
12253: "$topdir/skins/express_show/spritesheet.min.css",
12254: "$topdir/skins/express_show/spritesheet.png",
12255: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12256: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12257: if (@diffs == 0) {
1.1164 raeburn 12258: $is_camtasia = 6;
12259: } else {
1.1197 raeburn 12260: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12261: if (@diffs == 0) {
12262: $is_camtasia = 8;
1.1197 raeburn 12263: } else {
12264: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12265: if (@diffs == 0) {
12266: $is_camtasia = 8;
12267: }
1.1164 raeburn 12268: }
1.1067 raeburn 12269: }
12270: }
12271: my $output;
12272: if ($is_camtasia) {
12273: $output = <<"ENDCAM";
12274: <script type="text/javascript" language="Javascript">
12275: // <![CDATA[
12276:
12277: function camtasiaToggle() {
12278: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12279: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12280: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12281: document.getElementById('camtasia_titles').style.display='block';
12282: } else {
12283: document.getElementById('camtasia_titles').style.display='none';
12284: }
12285: }
12286: }
12287: return;
12288: }
12289:
12290: // ]]>
12291: </script>
12292: <p>$lt{'camt'}</p>
12293: ENDCAM
1.1065 raeburn 12294: } else {
1.1067 raeburn 12295: $output = '<p>'.$lt{'this'};
12296: if ($info eq '') {
12297: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12298: } else {
12299: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12300: '<div><pre>'.$info.'</pre></div>';
12301: }
1.1065 raeburn 12302: }
1.1067 raeburn 12303: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12304: my $duplicates;
12305: my $num = 0;
12306: if (ref($dirlist) eq 'ARRAY') {
12307: foreach my $item (@{$dirlist}) {
12308: if (ref($item) eq 'ARRAY') {
12309: if (exists($toplevel{$item->[0]})) {
12310: $duplicates .=
12311: &start_data_table_row().
12312: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12313: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12314: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12315: 'value="1" />'.&mt('Yes').'</label>'.
12316: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12317: '<td>'.$item->[0].'</td>';
12318: if ($item->[2]) {
12319: $duplicates .= '<td>'.&mt('Directory').'</td>';
12320: } else {
12321: $duplicates .= '<td>'.&mt('File').'</td>';
12322: }
12323: $duplicates .= '<td>'.$item->[3].'</td>'.
12324: '<td>'.
12325: &Apache::lonlocal::locallocaltime($item->[4]).
12326: '</td>'.
12327: &end_data_table_row();
12328: $num ++;
12329: }
12330: }
12331: }
12332: }
12333: my $itemcount;
12334: if (@paths > 0) {
12335: $itemcount = scalar(@paths);
12336: } else {
12337: $itemcount = 1;
12338: }
1.1067 raeburn 12339: if ($is_camtasia) {
12340: $output .= $lt{'auto'}.'<br />'.
12341: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12342: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12343: $lt{'yes'}.'</label> <label>'.
12344: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12345: $lt{'no'}.'</label></span><br />'.
12346: '<div id="camtasia_titles" style="display:block">'.
12347: &Apache::lonhtmlcommon::start_pick_box().
12348: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12349: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12350: &Apache::lonhtmlcommon::row_closure().
12351: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12352: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12353: &Apache::lonhtmlcommon::row_closure(1).
12354: &Apache::lonhtmlcommon::end_pick_box().
12355: '</div>';
12356: }
1.1065 raeburn 12357: $output .=
12358: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12359: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12360: "\n";
1.1065 raeburn 12361: if ($duplicates ne '') {
12362: $output .= '<p><span class="LC_warning">'.
12363: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12364: &start_data_table().
12365: &start_data_table_header_row().
12366: '<th>'.&mt('Overwrite?').'</th>'.
12367: '<th>'.&mt('Name').'</th>'.
12368: '<th>'.&mt('Type').'</th>'.
12369: '<th>'.&mt('Size').'</th>'.
12370: '<th>'.&mt('Last modified').'</th>'.
12371: &end_data_table_header_row().
12372: $duplicates.
12373: &end_data_table().
12374: '</p>';
12375: }
1.1067 raeburn 12376: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12377: if (ref($hiddenelements) eq 'HASH') {
12378: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12379: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12380: }
12381: }
12382: $output .= <<"END";
1.1067 raeburn 12383: <br />
1.1053 raeburn 12384: <input type="submit" name="decompress" value="$lt{'extr'}" />
12385: </form>
12386: $noextract
12387: END
12388: return $output;
12389: }
12390:
1.1065 raeburn 12391: sub decompression_utility {
12392: my ($program) = @_;
12393: my @utilities = ('tar','gunzip','bunzip2','unzip');
12394: my $location;
12395: if (grep(/^\Q$program\E$/,@utilities)) {
12396: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12397: '/usr/sbin/') {
12398: if (-x $dir.$program) {
12399: $location = $dir.$program;
12400: last;
12401: }
12402: }
12403: }
12404: return $location;
12405: }
12406:
12407: sub list_archive_contents {
12408: my ($file,$pathsref) = @_;
12409: my (@cmd,$output);
12410: my $needsregexp;
12411: if ($file =~ /\.zip$/) {
12412: @cmd = (&decompression_utility('unzip'),"-l");
12413: $needsregexp = 1;
12414: } elsif (($file =~ m/\.tar\.gz$/) ||
12415: ($file =~ /\.tgz$/)) {
12416: @cmd = (&decompression_utility('tar'),"-ztf");
12417: } elsif ($file =~ /\.tar\.bz2$/) {
12418: @cmd = (&decompression_utility('tar'),"-jtf");
12419: } elsif ($file =~ m|\.tar$|) {
12420: @cmd = (&decompression_utility('tar'),"-tf");
12421: }
12422: if (@cmd) {
12423: undef($!);
12424: undef($@);
12425: if (open(my $fh,"-|", @cmd, $file)) {
12426: while (my $line = <$fh>) {
12427: $output .= $line;
12428: chomp($line);
12429: my $item;
12430: if ($needsregexp) {
12431: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12432: } else {
12433: $item = $line;
12434: }
12435: if ($item ne '') {
12436: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12437: push(@{$pathsref},$item);
12438: }
12439: }
12440: }
12441: close($fh);
12442: }
12443: }
12444: return $output;
12445: }
12446:
1.1053 raeburn 12447: sub decompress_uploaded_file {
12448: my ($file,$dir) = @_;
12449: &Apache::lonnet::appenv({'cgi.file' => $file});
12450: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12451: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12452: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12453: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12454: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12455: my $decompressed = $env{'cgi.decompressed'};
12456: &Apache::lonnet::delenv('cgi.file');
12457: &Apache::lonnet::delenv('cgi.dir');
12458: &Apache::lonnet::delenv('cgi.decompressed');
12459: return ($decompressed,$result);
12460: }
12461:
1.1055 raeburn 12462: sub process_decompression {
12463: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
12464: my ($dir,$error,$warning,$output);
1.1180 raeburn 12465: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12466: $error = &mt('Filename not a supported archive file type.').
12467: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12468: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12469: } else {
12470: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12471: if ($docuhome eq 'no_host') {
12472: $error = &mt('Could not determine home server for course.');
12473: } else {
12474: my @ids=&Apache::lonnet::current_machine_ids();
12475: my $currdir = "$dir_root/$destination";
12476: if (grep(/^\Q$docuhome\E$/,@ids)) {
12477: $dir = &LONCAPA::propath($docudom,$docuname).
12478: "$dir_root/$destination";
12479: } else {
12480: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12481: "$dir_root/$docudom/$docuname/$destination";
12482: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12483: $error = &mt('Archive file not found.');
12484: }
12485: }
1.1065 raeburn 12486: my (@to_overwrite,@to_skip);
12487: if ($env{'form.archive_overwrite_total'} > 0) {
12488: my $total = $env{'form.archive_overwrite_total'};
12489: for (my $i=0; $i<$total; $i++) {
12490: if ($env{'form.archive_overwrite_'.$i} == 1) {
12491: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12492: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12493: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12494: }
12495: }
12496: }
12497: my $numskip = scalar(@to_skip);
12498: if (($numskip > 0) &&
12499: ($numskip == $env{'form.archive_itemcount'})) {
12500: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12501: } elsif ($dir eq '') {
1.1055 raeburn 12502: $error = &mt('Directory containing archive file unavailable.');
12503: } elsif (!$error) {
1.1065 raeburn 12504: my ($decompressed,$display);
12505: if ($numskip > 0) {
12506: my $tempdir = time.'_'.$$.int(rand(10000));
12507: mkdir("$dir/$tempdir",0755);
12508: system("mv $dir/$file $dir/$tempdir/$file");
12509: ($decompressed,$display) =
12510: &decompress_uploaded_file($file,"$dir/$tempdir");
12511: foreach my $item (@to_skip) {
12512: if (($item ne '') && ($item !~ /\.\./)) {
12513: if (-f "$dir/$tempdir/$item") {
12514: unlink("$dir/$tempdir/$item");
12515: } elsif (-d "$dir/$tempdir/$item") {
12516: system("rm -rf $dir/$tempdir/$item");
12517: }
12518: }
12519: }
12520: system("mv $dir/$tempdir/* $dir");
12521: rmdir("$dir/$tempdir");
12522: } else {
12523: ($decompressed,$display) =
12524: &decompress_uploaded_file($file,$dir);
12525: }
1.1055 raeburn 12526: if ($decompressed eq 'ok') {
1.1065 raeburn 12527: $output = '<p class="LC_info">'.
12528: &mt('Files extracted successfully from archive.').
12529: '</p>'."\n";
1.1055 raeburn 12530: my ($warning,$result,@contents);
12531: my ($newdirlistref,$newlisterror) =
12532: &Apache::lonnet::dirlist($currdir,$docudom,
12533: $docuname,1);
12534: my (%is_dir,%changes,@newitems);
12535: my $dirptr = 16384;
1.1065 raeburn 12536: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12537: foreach my $dir_line (@{$newdirlistref}) {
12538: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 12539: unless (($item =~ /^\.+$/) || ($item eq $file) ||
12540: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 12541: push(@newitems,$item);
12542: if ($dirptr&$testdir) {
12543: $is_dir{$item} = 1;
12544: }
12545: $changes{$item} = 1;
12546: }
12547: }
12548: }
12549: if (keys(%changes) > 0) {
12550: foreach my $item (sort(@newitems)) {
12551: if ($changes{$item}) {
12552: push(@contents,$item);
12553: }
12554: }
12555: }
12556: if (@contents > 0) {
1.1067 raeburn 12557: my $wantform;
12558: unless ($env{'form.autoextract_camtasia'}) {
12559: $wantform = 1;
12560: }
1.1056 raeburn 12561: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12562: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12563: $currdir,\%is_dir,
12564: \%children,\%parent,
1.1056 raeburn 12565: \@contents,\%dirorder,
12566: \%titles,$wantform);
1.1055 raeburn 12567: if ($datatable ne '') {
12568: $output .= &archive_options_form('decompressed',$datatable,
12569: $count,$hiddenelem);
1.1065 raeburn 12570: my $startcount = 6;
1.1055 raeburn 12571: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12572: \%titles,\%children);
1.1055 raeburn 12573: }
1.1067 raeburn 12574: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12575: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12576: my %displayed;
12577: my $total = 1;
12578: $env{'form.archive_directory'} = [];
12579: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12580: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12581: $path =~ s{/$}{};
12582: my $item;
12583: if ($path ne '') {
12584: $item = "$path/$titles{$i}";
12585: } else {
12586: $item = $titles{$i};
12587: }
12588: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12589: if ($item eq $contents[0]) {
12590: push(@{$env{'form.archive_directory'}},$i);
12591: $env{'form.archive_'.$i} = 'display';
12592: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12593: $displayed{'folder'} = $i;
1.1164 raeburn 12594: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12595: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12596: $env{'form.archive_'.$i} = 'display';
12597: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12598: $displayed{'web'} = $i;
12599: } else {
1.1164 raeburn 12600: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12601: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12602: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12603: push(@{$env{'form.archive_directory'}},$i);
12604: }
12605: $env{'form.archive_'.$i} = 'dependency';
12606: }
12607: $total ++;
12608: }
12609: for (my $i=1; $i<$total; $i++) {
12610: next if ($i == $displayed{'web'});
12611: next if ($i == $displayed{'folder'});
12612: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12613: }
12614: $env{'form.phase'} = 'decompress_cleanup';
12615: $env{'form.archivedelete'} = 1;
12616: $env{'form.archive_count'} = $total-1;
12617: $output .=
12618: &process_extracted_files('coursedocs',$docudom,
12619: $docuname,$destination,
12620: $dir_root,$hiddenelem);
12621: }
1.1055 raeburn 12622: } else {
12623: $warning = &mt('No new items extracted from archive file.');
12624: }
12625: } else {
12626: $output = $display;
12627: $error = &mt('An error occurred during extraction from the archive file.');
12628: }
12629: }
12630: }
12631: }
12632: if ($error) {
12633: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12634: $error.'</p>'."\n";
12635: }
12636: if ($warning) {
12637: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12638: }
12639: return $output;
12640: }
12641:
12642: sub get_extracted {
1.1056 raeburn 12643: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12644: $titles,$wantform) = @_;
1.1055 raeburn 12645: my $count = 0;
12646: my $depth = 0;
12647: my $datatable;
1.1056 raeburn 12648: my @hierarchy;
1.1055 raeburn 12649: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12650: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12651: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12652: foreach my $item (@{$contents}) {
12653: $count ++;
1.1056 raeburn 12654: @{$dirorder->{$count}} = @hierarchy;
12655: $titles->{$count} = $item;
1.1055 raeburn 12656: &archive_hierarchy($depth,$count,$parent,$children);
12657: if ($wantform) {
12658: $datatable .= &archive_row($is_dir->{$item},$item,
12659: $currdir,$depth,$count);
12660: }
12661: if ($is_dir->{$item}) {
12662: $depth ++;
1.1056 raeburn 12663: push(@hierarchy,$count);
12664: $parent->{$depth} = $count;
1.1055 raeburn 12665: $datatable .=
12666: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12667: \$depth,\$count,\@hierarchy,$dirorder,
12668: $children,$parent,$titles,$wantform);
1.1055 raeburn 12669: $depth --;
1.1056 raeburn 12670: pop(@hierarchy);
1.1055 raeburn 12671: }
12672: }
12673: return ($count,$datatable);
12674: }
12675:
12676: sub recurse_extracted_archive {
1.1056 raeburn 12677: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12678: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12679: my $result='';
1.1056 raeburn 12680: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12681: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12682: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12683: return $result;
12684: }
12685: my $dirptr = 16384;
12686: my ($newdirlistref,$newlisterror) =
12687: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12688: if (ref($newdirlistref) eq 'ARRAY') {
12689: foreach my $dir_line (@{$newdirlistref}) {
12690: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12691: unless ($item =~ /^\.+$/) {
12692: $$count ++;
1.1056 raeburn 12693: @{$dirorder->{$$count}} = @{$hierarchy};
12694: $titles->{$$count} = $item;
1.1055 raeburn 12695: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12696:
1.1055 raeburn 12697: my $is_dir;
12698: if ($dirptr&$testdir) {
12699: $is_dir = 1;
12700: }
12701: if ($wantform) {
12702: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12703: }
12704: if ($is_dir) {
12705: $$depth ++;
1.1056 raeburn 12706: push(@{$hierarchy},$$count);
12707: $parent->{$$depth} = $$count;
1.1055 raeburn 12708: $result .=
12709: &recurse_extracted_archive("$currdir/$item",$docudom,
12710: $docuname,$depth,$count,
1.1056 raeburn 12711: $hierarchy,$dirorder,$children,
12712: $parent,$titles,$wantform);
1.1055 raeburn 12713: $$depth --;
1.1056 raeburn 12714: pop(@{$hierarchy});
1.1055 raeburn 12715: }
12716: }
12717: }
12718: }
12719: return $result;
12720: }
12721:
12722: sub archive_hierarchy {
12723: my ($depth,$count,$parent,$children) =@_;
12724: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12725: if (exists($parent->{$depth})) {
12726: $children->{$parent->{$depth}} .= $count.':';
12727: }
12728: }
12729: return;
12730: }
12731:
12732: sub archive_row {
12733: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12734: my ($name) = ($item =~ m{([^/]+)$});
12735: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12736: 'display' => 'Add as file',
1.1055 raeburn 12737: 'dependency' => 'Include as dependency',
12738: 'discard' => 'Discard',
12739: );
12740: if ($is_dir) {
1.1059 raeburn 12741: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12742: }
1.1056 raeburn 12743: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12744: my $offset = 0;
1.1055 raeburn 12745: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12746: $offset ++;
1.1065 raeburn 12747: if ($action ne 'display') {
12748: $offset ++;
12749: }
1.1055 raeburn 12750: $output .= '<td><span class="LC_nobreak">'.
12751: '<label><input type="radio" name="archive_'.$count.
12752: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12753: my $text = $choices{$action};
12754: if ($is_dir) {
12755: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12756: if ($action eq 'display') {
1.1059 raeburn 12757: $text = &mt('Add as folder');
1.1055 raeburn 12758: }
1.1056 raeburn 12759: } else {
12760: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12761:
12762: }
12763: $output .= ' /> '.$choices{$action}.'</label></span>';
12764: if ($action eq 'dependency') {
12765: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12766: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12767: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12768: '<option value=""></option>'."\n".
12769: '</select>'."\n".
12770: '</div>';
1.1059 raeburn 12771: } elsif ($action eq 'display') {
12772: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12773: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12774: '</div>';
1.1055 raeburn 12775: }
1.1056 raeburn 12776: $output .= '</td>';
1.1055 raeburn 12777: }
12778: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12779: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12780: for (my $i=0; $i<$depth; $i++) {
12781: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12782: }
12783: if ($is_dir) {
12784: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12785: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12786: } else {
12787: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12788: }
12789: $output .= ' '.$name.'</td>'."\n".
12790: &end_data_table_row();
12791: return $output;
12792: }
12793:
12794: sub archive_options_form {
1.1065 raeburn 12795: my ($form,$display,$count,$hiddenelem) = @_;
12796: my %lt = &Apache::lonlocal::texthash(
12797: perm => 'Permanently remove archive file?',
12798: hows => 'How should each extracted item be incorporated in the course?',
12799: cont => 'Content actions for all',
12800: addf => 'Add as folder/file',
12801: incd => 'Include as dependency for a displayed file',
12802: disc => 'Discard',
12803: no => 'No',
12804: yes => 'Yes',
12805: save => 'Save',
12806: );
12807: my $output = <<"END";
12808: <form name="$form" method="post" action="">
12809: <p><span class="LC_nobreak">$lt{'perm'}
12810: <label>
12811: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12812: </label>
12813:
12814: <label>
12815: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12816: </span>
12817: </p>
12818: <input type="hidden" name="phase" value="decompress_cleanup" />
12819: <br />$lt{'hows'}
12820: <div class="LC_columnSection">
12821: <fieldset>
12822: <legend>$lt{'cont'}</legend>
12823: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12824: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12825: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12826: </fieldset>
12827: </div>
12828: END
12829: return $output.
1.1055 raeburn 12830: &start_data_table()."\n".
1.1065 raeburn 12831: $display."\n".
1.1055 raeburn 12832: &end_data_table()."\n".
12833: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12834: $hiddenelem.
1.1065 raeburn 12835: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12836: '</form>';
12837: }
12838:
12839: sub archive_javascript {
1.1056 raeburn 12840: my ($startcount,$numitems,$titles,$children) = @_;
12841: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12842: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12843: my $scripttag = <<START;
12844: <script type="text/javascript">
12845: // <![CDATA[
12846:
12847: function checkAll(form,prefix) {
12848: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12849: for (var i=0; i < form.elements.length; i++) {
12850: var id = form.elements[i].id;
12851: if ((id != '') && (id != undefined)) {
12852: if (idstr.test(id)) {
12853: if (form.elements[i].type == 'radio') {
12854: form.elements[i].checked = true;
1.1056 raeburn 12855: var nostart = i-$startcount;
1.1059 raeburn 12856: var offset = nostart%7;
12857: var count = (nostart-offset)/7;
1.1056 raeburn 12858: dependencyCheck(form,count,offset);
1.1055 raeburn 12859: }
12860: }
12861: }
12862: }
12863: }
12864:
12865: function propagateCheck(form,count) {
12866: if (count > 0) {
1.1059 raeburn 12867: var startelement = $startcount + ((count-1) * 7);
12868: for (var j=1; j<6; j++) {
12869: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12870: var item = startelement + j;
12871: if (form.elements[item].type == 'radio') {
12872: if (form.elements[item].checked) {
12873: containerCheck(form,count,j);
12874: break;
12875: }
1.1055 raeburn 12876: }
12877: }
12878: }
12879: }
12880: }
12881:
12882: numitems = $numitems
1.1056 raeburn 12883: var titles = new Array(numitems);
12884: var parents = new Array(numitems);
1.1055 raeburn 12885: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12886: parents[i] = new Array;
1.1055 raeburn 12887: }
1.1059 raeburn 12888: var maintitle = '$maintitle';
1.1055 raeburn 12889:
12890: START
12891:
1.1056 raeburn 12892: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12893: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12894: for (my $i=0; $i<@contents; $i ++) {
12895: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12896: }
12897: }
12898:
1.1056 raeburn 12899: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12900: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12901: }
12902:
1.1055 raeburn 12903: $scripttag .= <<END;
12904:
12905: function containerCheck(form,count,offset) {
12906: if (count > 0) {
1.1056 raeburn 12907: dependencyCheck(form,count,offset);
1.1059 raeburn 12908: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12909: form.elements[item].checked = true;
12910: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12911: if (parents[count].length > 0) {
12912: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12913: containerCheck(form,parents[count][j],offset);
12914: }
12915: }
12916: }
12917: }
12918: }
12919:
12920: function dependencyCheck(form,count,offset) {
12921: if (count > 0) {
1.1059 raeburn 12922: var chosen = (offset+$startcount)+7*(count-1);
12923: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12924: var currtype = form.elements[depitem].type;
12925: if (form.elements[chosen].value == 'dependency') {
12926: document.getElementById('arc_depon_'+count).style.display='block';
12927: form.elements[depitem].options.length = 0;
12928: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12929: for (var i=1; i<=numitems; i++) {
12930: if (i == count) {
12931: continue;
12932: }
1.1059 raeburn 12933: var startelement = $startcount + (i-1) * 7;
12934: for (var j=1; j<6; j++) {
12935: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12936: var item = startelement + j;
12937: if (form.elements[item].type == 'radio') {
12938: if (form.elements[item].checked) {
12939: if (form.elements[item].value == 'display') {
12940: var n = form.elements[depitem].options.length;
12941: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12942: }
12943: }
12944: }
12945: }
12946: }
12947: }
12948: } else {
12949: document.getElementById('arc_depon_'+count).style.display='none';
12950: form.elements[depitem].options.length = 0;
12951: form.elements[depitem].options[0] = new Option('Select','',true,true);
12952: }
1.1059 raeburn 12953: titleCheck(form,count,offset);
1.1056 raeburn 12954: }
12955: }
12956:
12957: function propagateSelect(form,count,offset) {
12958: if (count > 0) {
1.1065 raeburn 12959: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12960: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12961: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12962: if (parents[count].length > 0) {
12963: for (var j=0; j<parents[count].length; j++) {
12964: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12965: }
12966: }
12967: }
12968: }
12969: }
1.1056 raeburn 12970:
12971: function containerSelect(form,count,offset,picked) {
12972: if (count > 0) {
1.1065 raeburn 12973: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12974: if (form.elements[item].type == 'radio') {
12975: if (form.elements[item].value == 'dependency') {
12976: if (form.elements[item+1].type == 'select-one') {
12977: for (var i=0; i<form.elements[item+1].options.length; i++) {
12978: if (form.elements[item+1].options[i].value == picked) {
12979: form.elements[item+1].selectedIndex = i;
12980: break;
12981: }
12982: }
12983: }
12984: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12985: if (parents[count].length > 0) {
12986: for (var j=0; j<parents[count].length; j++) {
12987: containerSelect(form,parents[count][j],offset,picked);
12988: }
12989: }
12990: }
12991: }
12992: }
12993: }
12994: }
12995:
1.1059 raeburn 12996: function titleCheck(form,count,offset) {
12997: if (count > 0) {
12998: var chosen = (offset+$startcount)+7*(count-1);
12999: var depitem = $startcount + ((count-1) * 7) + 2;
13000: var currtype = form.elements[depitem].type;
13001: if (form.elements[chosen].value == 'display') {
13002: document.getElementById('arc_title_'+count).style.display='block';
13003: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13004: document.getElementById('archive_title_'+count).value=maintitle;
13005: }
13006: } else {
13007: document.getElementById('arc_title_'+count).style.display='none';
13008: if (currtype == 'text') {
13009: document.getElementById('archive_title_'+count).value='';
13010: }
13011: }
13012: }
13013: return;
13014: }
13015:
1.1055 raeburn 13016: // ]]>
13017: </script>
13018: END
13019: return $scripttag;
13020: }
13021:
13022: sub process_extracted_files {
1.1067 raeburn 13023: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13024: my $numitems = $env{'form.archive_count'};
13025: return unless ($numitems);
13026: my @ids=&Apache::lonnet::current_machine_ids();
13027: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13028: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13029: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13030: if (grep(/^\Q$docuhome\E$/,@ids)) {
13031: $prefix = &LONCAPA::propath($docudom,$docuname);
13032: $pathtocheck = "$dir_root/$destination";
13033: $dir = $dir_root;
13034: $ishome = 1;
13035: } else {
13036: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13037: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
13038: $dir = "$dir_root/$docudom/$docuname";
13039: }
13040: my $currdir = "$dir_root/$destination";
13041: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13042: if ($env{'form.folderpath'}) {
13043: my @items = split('&',$env{'form.folderpath'});
13044: $folders{'0'} = $items[-2];
1.1099 raeburn 13045: if ($env{'form.folderpath'} =~ /\:1$/) {
13046: $containers{'0'}='page';
13047: } else {
13048: $containers{'0'}='sequence';
13049: }
1.1055 raeburn 13050: }
13051: my @archdirs = &get_env_multiple('form.archive_directory');
13052: if ($numitems) {
13053: for (my $i=1; $i<=$numitems; $i++) {
13054: my $path = $env{'form.archive_content_'.$i};
13055: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13056: my $item = $1;
13057: $toplevelitems{$item} = $i;
13058: if (grep(/^\Q$i\E$/,@archdirs)) {
13059: $is_dir{$item} = 1;
13060: }
13061: }
13062: }
13063: }
1.1067 raeburn 13064: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13065: if (keys(%toplevelitems) > 0) {
13066: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13067: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13068: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13069: }
1.1066 raeburn 13070: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13071: if ($numitems) {
13072: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13073: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13074: my $path = $env{'form.archive_content_'.$i};
13075: if ($path =~ /^\Q$pathtocheck\E/) {
13076: if ($env{'form.archive_'.$i} eq 'discard') {
13077: if ($prefix ne '' && $path ne '') {
13078: if (-e $prefix.$path) {
1.1066 raeburn 13079: if ((@archdirs > 0) &&
13080: (grep(/^\Q$i\E$/,@archdirs))) {
13081: $todeletedir{$prefix.$path} = 1;
13082: } else {
13083: $todelete{$prefix.$path} = 1;
13084: }
1.1055 raeburn 13085: }
13086: }
13087: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13088: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13089: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13090: $docstitle = $env{'form.archive_title_'.$i};
13091: if ($docstitle eq '') {
13092: $docstitle = $title;
13093: }
1.1055 raeburn 13094: $outer = 0;
1.1056 raeburn 13095: if (ref($dirorder{$i}) eq 'ARRAY') {
13096: if (@{$dirorder{$i}} > 0) {
13097: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13098: if ($env{'form.archive_'.$item} eq 'display') {
13099: $outer = $item;
13100: last;
13101: }
13102: }
13103: }
13104: }
13105: my ($errtext,$fatal) =
13106: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13107: '/'.$folders{$outer}.'.'.
13108: $containers{$outer});
13109: next if ($fatal);
13110: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13111: if ($context eq 'coursedocs') {
1.1056 raeburn 13112: $mapinner{$i} = time;
1.1055 raeburn 13113: $folders{$i} = 'default_'.$mapinner{$i};
13114: $containers{$i} = 'sequence';
13115: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13116: $folders{$i}.'.'.$containers{$i};
13117: my $newidx = &LONCAPA::map::getresidx();
13118: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13119: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13120: push(@LONCAPA::map::order,$newidx);
13121: my ($outtext,$errtext) =
13122: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13123: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13124: '.'.$containers{$outer},1,1);
1.1056 raeburn 13125: $newseqid{$i} = $newidx;
1.1067 raeburn 13126: unless ($errtext) {
13127: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
13128: }
1.1055 raeburn 13129: }
13130: } else {
13131: if ($context eq 'coursedocs') {
13132: my $newidx=&LONCAPA::map::getresidx();
13133: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13134: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13135: $title;
13136: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13137: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13138: }
13139: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13140: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13141: }
13142: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13143: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 13144: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 13145: unless ($ishome) {
13146: my $fetch = "$newdest{$i}/$title";
13147: $fetch =~ s/^\Q$prefix$dir\E//;
13148: $prompttofetch{$fetch} = 1;
13149: }
1.1055 raeburn 13150: }
13151: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13152: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13153: push(@LONCAPA::map::order, $newidx);
13154: my ($outtext,$errtext)=
13155: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13156: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13157: '.'.$containers{$outer},1,1);
1.1067 raeburn 13158: unless ($errtext) {
13159: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13160: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
13161: }
13162: }
1.1055 raeburn 13163: }
13164: }
1.1086 raeburn 13165: }
13166: } else {
13167: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13168: }
13169: }
13170: for (my $i=1; $i<=$numitems; $i++) {
13171: next unless ($env{'form.archive_'.$i} eq 'dependency');
13172: my $path = $env{'form.archive_content_'.$i};
13173: if ($path =~ /^\Q$pathtocheck\E/) {
13174: my ($title) = ($path =~ m{/([^/]+)$});
13175: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13176: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13177: if (ref($dirorder{$i}) eq 'ARRAY') {
13178: my ($itemidx,$fullpath,$relpath);
13179: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13180: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13181: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13182: if ($dirorder{$i}->[$j] eq $container) {
13183: $itemidx = $j;
1.1056 raeburn 13184: }
13185: }
1.1086 raeburn 13186: }
13187: if ($itemidx eq '') {
13188: $itemidx = 0;
13189: }
13190: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13191: if ($mapinner{$referrer{$i}}) {
13192: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13193: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13194: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13195: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13196: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13197: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13198: if (!-e $fullpath) {
13199: mkdir($fullpath,0755);
1.1056 raeburn 13200: }
13201: }
1.1086 raeburn 13202: } else {
13203: last;
1.1056 raeburn 13204: }
1.1086 raeburn 13205: }
13206: }
13207: } elsif ($newdest{$referrer{$i}}) {
13208: $fullpath = $newdest{$referrer{$i}};
13209: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13210: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13211: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13212: last;
13213: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13214: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13215: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13216: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13217: if (!-e $fullpath) {
13218: mkdir($fullpath,0755);
1.1056 raeburn 13219: }
13220: }
1.1086 raeburn 13221: } else {
13222: last;
1.1056 raeburn 13223: }
1.1055 raeburn 13224: }
13225: }
1.1086 raeburn 13226: if ($fullpath ne '') {
13227: if (-e "$prefix$path") {
13228: system("mv $prefix$path $fullpath/$title");
13229: }
13230: if (-e "$fullpath/$title") {
13231: my $showpath;
13232: if ($relpath ne '') {
13233: $showpath = "$relpath/$title";
13234: } else {
13235: $showpath = "/$title";
13236: }
13237: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
13238: }
13239: unless ($ishome) {
13240: my $fetch = "$fullpath/$title";
13241: $fetch =~ s/^\Q$prefix$dir\E//;
13242: $prompttofetch{$fetch} = 1;
13243: }
13244: }
1.1055 raeburn 13245: }
1.1086 raeburn 13246: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13247: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
13248: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 13249: }
13250: } else {
13251: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13252: }
13253: }
13254: if (keys(%todelete)) {
13255: foreach my $key (keys(%todelete)) {
13256: unlink($key);
1.1066 raeburn 13257: }
13258: }
13259: if (keys(%todeletedir)) {
13260: foreach my $key (keys(%todeletedir)) {
13261: rmdir($key);
13262: }
13263: }
13264: foreach my $dir (sort(keys(%is_dir))) {
13265: if (($pathtocheck ne '') && ($dir ne '')) {
13266: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13267: }
13268: }
1.1067 raeburn 13269: if ($result ne '') {
13270: $output .= '<ul>'."\n".
13271: $result."\n".
13272: '</ul>';
13273: }
13274: unless ($ishome) {
13275: my $replicationfail;
13276: foreach my $item (keys(%prompttofetch)) {
13277: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13278: unless ($fetchresult eq 'ok') {
13279: $replicationfail .= '<li>'.$item.'</li>'."\n";
13280: }
13281: }
13282: if ($replicationfail) {
13283: $output .= '<p class="LC_error">'.
13284: &mt('Course home server failed to retrieve:').'<ul>'.
13285: $replicationfail.
13286: '</ul></p>';
13287: }
13288: }
1.1055 raeburn 13289: } else {
13290: $warning = &mt('No items found in archive.');
13291: }
13292: if ($error) {
13293: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13294: $error.'</p>'."\n";
13295: }
13296: if ($warning) {
13297: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13298: }
13299: return $output;
13300: }
13301:
1.1066 raeburn 13302: sub cleanup_empty_dirs {
13303: my ($path) = @_;
13304: if (($path ne '') && (-d $path)) {
13305: if (opendir(my $dirh,$path)) {
13306: my @dircontents = grep(!/^\./,readdir($dirh));
13307: my $numitems = 0;
13308: foreach my $item (@dircontents) {
13309: if (-d "$path/$item") {
1.1111 raeburn 13310: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13311: if (-e "$path/$item") {
13312: $numitems ++;
13313: }
13314: } else {
13315: $numitems ++;
13316: }
13317: }
13318: if ($numitems == 0) {
13319: rmdir($path);
13320: }
13321: closedir($dirh);
13322: }
13323: }
13324: return;
13325: }
13326:
1.41 ng 13327: =pod
1.45 matthew 13328:
1.1162 raeburn 13329: =item * &get_folder_hierarchy()
1.1068 raeburn 13330:
13331: Provides hierarchy of names of folders/sub-folders containing the current
13332: item,
13333:
13334: Inputs: 3
13335: - $navmap - navmaps object
13336:
13337: - $map - url for map (either the trigger itself, or map containing
13338: the resource, which is the trigger).
13339:
13340: - $showitem - 1 => show title for map itself; 0 => do not show.
13341:
13342: Outputs: 1 @pathitems - array of folder/subfolder names.
13343:
13344: =cut
13345:
13346: sub get_folder_hierarchy {
13347: my ($navmap,$map,$showitem) = @_;
13348: my @pathitems;
13349: if (ref($navmap)) {
13350: my $mapres = $navmap->getResourceByUrl($map);
13351: if (ref($mapres)) {
13352: my $pcslist = $mapres->map_hierarchy();
13353: if ($pcslist ne '') {
13354: my @pcs = split(/,/,$pcslist);
13355: foreach my $pc (@pcs) {
13356: if ($pc == 1) {
1.1129 raeburn 13357: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13358: } else {
13359: my $res = $navmap->getByMapPc($pc);
13360: if (ref($res)) {
13361: my $title = $res->compTitle();
13362: $title =~ s/\W+/_/g;
13363: if ($title ne '') {
13364: push(@pathitems,$title);
13365: }
13366: }
13367: }
13368: }
13369: }
1.1071 raeburn 13370: if ($showitem) {
13371: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13372: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13373: } else {
13374: my $maptitle = $mapres->compTitle();
13375: $maptitle =~ s/\W+/_/g;
13376: if ($maptitle ne '') {
13377: push(@pathitems,$maptitle);
13378: }
1.1068 raeburn 13379: }
13380: }
13381: }
13382: }
13383: return @pathitems;
13384: }
13385:
13386: =pod
13387:
1.1015 raeburn 13388: =item * &get_turnedin_filepath()
13389:
13390: Determines path in a user's portfolio file for storage of files uploaded
13391: to a specific essayresponse or dropbox item.
13392:
13393: Inputs: 3 required + 1 optional.
13394: $symb is symb for resource, $uname and $udom are for current user (required).
13395: $caller is optional (can be "submission", if routine is called when storing
13396: an upoaded file when "Submit Answer" button was pressed).
13397:
13398: Returns array containing $path and $multiresp.
13399: $path is path in portfolio. $multiresp is 1 if this resource contains more
13400: than one file upload item. Callers of routine should append partid as a
13401: subdirectory to $path in cases where $multiresp is 1.
13402:
13403: Called by: homework/essayresponse.pm and homework/structuretags.pm
13404:
13405: =cut
13406:
13407: sub get_turnedin_filepath {
13408: my ($symb,$uname,$udom,$caller) = @_;
13409: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13410: my $turnindir;
13411: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13412: $turnindir = $userhash{'turnindir'};
13413: my ($path,$multiresp);
13414: if ($turnindir eq '') {
13415: if ($caller eq 'submission') {
13416: $turnindir = &mt('turned in');
13417: $turnindir =~ s/\W+/_/g;
13418: my %newhash = (
13419: 'turnindir' => $turnindir,
13420: );
13421: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13422: }
13423: }
13424: if ($turnindir ne '') {
13425: $path = '/'.$turnindir.'/';
13426: my ($multipart,$turnin,@pathitems);
13427: my $navmap = Apache::lonnavmaps::navmap->new();
13428: if (defined($navmap)) {
13429: my $mapres = $navmap->getResourceByUrl($map);
13430: if (ref($mapres)) {
13431: my $pcslist = $mapres->map_hierarchy();
13432: if ($pcslist ne '') {
13433: foreach my $pc (split(/,/,$pcslist)) {
13434: my $res = $navmap->getByMapPc($pc);
13435: if (ref($res)) {
13436: my $title = $res->compTitle();
13437: $title =~ s/\W+/_/g;
13438: if ($title ne '') {
1.1149 raeburn 13439: if (($pc > 1) && (length($title) > 12)) {
13440: $title = substr($title,0,12);
13441: }
1.1015 raeburn 13442: push(@pathitems,$title);
13443: }
13444: }
13445: }
13446: }
13447: my $maptitle = $mapres->compTitle();
13448: $maptitle =~ s/\W+/_/g;
13449: if ($maptitle ne '') {
1.1149 raeburn 13450: if (length($maptitle) > 12) {
13451: $maptitle = substr($maptitle,0,12);
13452: }
1.1015 raeburn 13453: push(@pathitems,$maptitle);
13454: }
13455: unless ($env{'request.state'} eq 'construct') {
13456: my $res = $navmap->getBySymb($symb);
13457: if (ref($res)) {
13458: my $partlist = $res->parts();
13459: my $totaluploads = 0;
13460: if (ref($partlist) eq 'ARRAY') {
13461: foreach my $part (@{$partlist}) {
13462: my @types = $res->responseType($part);
13463: my @ids = $res->responseIds($part);
13464: for (my $i=0; $i < scalar(@ids); $i++) {
13465: if ($types[$i] eq 'essay') {
13466: my $partid = $part.'_'.$ids[$i];
13467: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13468: $totaluploads ++;
13469: }
13470: }
13471: }
13472: }
13473: if ($totaluploads > 1) {
13474: $multiresp = 1;
13475: }
13476: }
13477: }
13478: }
13479: } else {
13480: return;
13481: }
13482: } else {
13483: return;
13484: }
13485: my $restitle=&Apache::lonnet::gettitle($symb);
13486: $restitle =~ s/\W+/_/g;
13487: if ($restitle eq '') {
13488: $restitle = ($resurl =~ m{/[^/]+$});
13489: if ($restitle eq '') {
13490: $restitle = time;
13491: }
13492: }
1.1149 raeburn 13493: if (length($restitle) > 12) {
13494: $restitle = substr($restitle,0,12);
13495: }
1.1015 raeburn 13496: push(@pathitems,$restitle);
13497: $path .= join('/',@pathitems);
13498: }
13499: return ($path,$multiresp);
13500: }
13501:
13502: =pod
13503:
1.464 albertel 13504: =back
1.41 ng 13505:
1.112 bowersj2 13506: =head1 CSV Upload/Handling functions
1.38 albertel 13507:
1.41 ng 13508: =over 4
13509:
1.648 raeburn 13510: =item * &upfile_store($r)
1.41 ng 13511:
13512: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13513: needs $env{'form.upfile'}
1.41 ng 13514: returns $datatoken to be put into hidden field
13515:
13516: =cut
1.31 albertel 13517:
13518: sub upfile_store {
13519: my $r=shift;
1.258 albertel 13520: $env{'form.upfile'}=~s/\r/\n/gs;
13521: $env{'form.upfile'}=~s/\f/\n/gs;
13522: $env{'form.upfile'}=~s/\n+/\n/gs;
13523: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13524:
1.258 albertel 13525: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
13526: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 13527: {
1.158 raeburn 13528: my $datafile = $r->dir_config('lonDaemons').
13529: '/tmp/'.$datatoken.'.tmp';
13530: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13531: print $fh $env{'form.upfile'};
1.158 raeburn 13532: close($fh);
13533: }
1.31 albertel 13534: }
13535: return $datatoken;
13536: }
13537:
1.56 matthew 13538: =pod
13539:
1.648 raeburn 13540: =item * &load_tmp_file($r)
1.41 ng 13541:
13542: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 13543: needs $env{'form.datatoken'},
13544: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13545:
13546: =cut
1.31 albertel 13547:
13548: sub load_tmp_file {
13549: my $r=shift;
13550: my @studentdata=();
13551: {
1.158 raeburn 13552: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 13553: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 13554: if ( open(my $fh,"<$studentfile") ) {
13555: @studentdata=<$fh>;
13556: close($fh);
13557: }
1.31 albertel 13558: }
1.258 albertel 13559: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13560: }
13561:
1.56 matthew 13562: =pod
13563:
1.648 raeburn 13564: =item * &upfile_record_sep()
1.41 ng 13565:
13566: Separate uploaded file into records
13567: returns array of records,
1.258 albertel 13568: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13569:
13570: =cut
1.31 albertel 13571:
13572: sub upfile_record_sep {
1.258 albertel 13573: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13574: } else {
1.248 albertel 13575: my @records;
1.258 albertel 13576: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13577: if ($line=~/^\s*$/) { next; }
13578: push(@records,$line);
13579: }
13580: return @records;
1.31 albertel 13581: }
13582: }
13583:
1.56 matthew 13584: =pod
13585:
1.648 raeburn 13586: =item * &record_sep($record)
1.41 ng 13587:
1.258 albertel 13588: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13589:
13590: =cut
13591:
1.263 www 13592: sub takeleft {
13593: my $index=shift;
13594: return substr('0000'.$index,-4,4);
13595: }
13596:
1.31 albertel 13597: sub record_sep {
13598: my $record=shift;
13599: my %components=();
1.258 albertel 13600: if ($env{'form.upfiletype'} eq 'xml') {
13601: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13602: my $i=0;
1.356 albertel 13603: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13604: $field=~s/^(\"|\')//;
13605: $field=~s/(\"|\')$//;
1.263 www 13606: $components{&takeleft($i)}=$field;
1.31 albertel 13607: $i++;
13608: }
1.258 albertel 13609: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13610: my $i=0;
1.356 albertel 13611: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13612: $field=~s/^(\"|\')//;
13613: $field=~s/(\"|\')$//;
1.263 www 13614: $components{&takeleft($i)}=$field;
1.31 albertel 13615: $i++;
13616: }
13617: } else {
1.561 www 13618: my $separator=',';
1.480 banghart 13619: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13620: $separator=';';
1.480 banghart 13621: }
1.31 albertel 13622: my $i=0;
1.561 www 13623: # the character we are looking for to indicate the end of a quote or a record
13624: my $looking_for=$separator;
13625: # do not add the characters to the fields
13626: my $ignore=0;
13627: # we just encountered a separator (or the beginning of the record)
13628: my $just_found_separator=1;
13629: # store the field we are working on here
13630: my $field='';
13631: # work our way through all characters in record
13632: foreach my $character ($record=~/(.)/g) {
13633: if ($character eq $looking_for) {
13634: if ($character ne $separator) {
13635: # Found the end of a quote, again looking for separator
13636: $looking_for=$separator;
13637: $ignore=1;
13638: } else {
13639: # Found a separator, store away what we got
13640: $components{&takeleft($i)}=$field;
13641: $i++;
13642: $just_found_separator=1;
13643: $ignore=0;
13644: $field='';
13645: }
13646: next;
13647: }
13648: # single or double quotation marks after a separator indicate beginning of a quote
13649: # we are now looking for the end of the quote and need to ignore separators
13650: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13651: $looking_for=$character;
13652: next;
13653: }
13654: # ignore would be true after we reached the end of a quote
13655: if ($ignore) { next; }
13656: if (($just_found_separator) && ($character=~/\s/)) { next; }
13657: $field.=$character;
13658: $just_found_separator=0;
1.31 albertel 13659: }
1.561 www 13660: # catch the very last entry, since we never encountered the separator
13661: $components{&takeleft($i)}=$field;
1.31 albertel 13662: }
13663: return %components;
13664: }
13665:
1.144 matthew 13666: ######################################################
13667: ######################################################
13668:
1.56 matthew 13669: =pod
13670:
1.648 raeburn 13671: =item * &upfile_select_html()
1.41 ng 13672:
1.144 matthew 13673: Return HTML code to select a file from the users machine and specify
13674: the file type.
1.41 ng 13675:
13676: =cut
13677:
1.144 matthew 13678: ######################################################
13679: ######################################################
1.31 albertel 13680: sub upfile_select_html {
1.144 matthew 13681: my %Types = (
13682: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13683: semisv => &mt('Semicolon separated values'),
1.144 matthew 13684: space => &mt('Space separated'),
13685: tab => &mt('Tabulator separated'),
13686: # xml => &mt('HTML/XML'),
13687: );
13688: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13689: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13690: foreach my $type (sort(keys(%Types))) {
13691: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13692: }
13693: $Str .= "</select>\n";
13694: return $Str;
1.31 albertel 13695: }
13696:
1.301 albertel 13697: sub get_samples {
13698: my ($records,$toget) = @_;
13699: my @samples=({});
13700: my $got=0;
13701: foreach my $rec (@$records) {
13702: my %temp = &record_sep($rec);
13703: if (! grep(/\S/, values(%temp))) { next; }
13704: if (%temp) {
13705: $samples[$got]=\%temp;
13706: $got++;
13707: if ($got == $toget) { last; }
13708: }
13709: }
13710: return \@samples;
13711: }
13712:
1.144 matthew 13713: ######################################################
13714: ######################################################
13715:
1.56 matthew 13716: =pod
13717:
1.648 raeburn 13718: =item * &csv_print_samples($r,$records)
1.41 ng 13719:
13720: Prints a table of sample values from each column uploaded $r is an
13721: Apache Request ref, $records is an arrayref from
13722: &Apache::loncommon::upfile_record_sep
13723:
13724: =cut
13725:
1.144 matthew 13726: ######################################################
13727: ######################################################
1.31 albertel 13728: sub csv_print_samples {
13729: my ($r,$records) = @_;
1.662 bisitz 13730: my $samples = &get_samples($records,5);
1.301 albertel 13731:
1.594 raeburn 13732: $r->print(&mt('Samples').'<br />'.&start_data_table().
13733: &start_data_table_header_row());
1.356 albertel 13734: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13735: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13736: $r->print(&end_data_table_header_row());
1.301 albertel 13737: foreach my $hash (@$samples) {
1.594 raeburn 13738: $r->print(&start_data_table_row());
1.356 albertel 13739: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13740: $r->print('<td>');
1.356 albertel 13741: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13742: $r->print('</td>');
13743: }
1.594 raeburn 13744: $r->print(&end_data_table_row());
1.31 albertel 13745: }
1.594 raeburn 13746: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13747: }
13748:
1.144 matthew 13749: ######################################################
13750: ######################################################
13751:
1.56 matthew 13752: =pod
13753:
1.648 raeburn 13754: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13755:
13756: Prints a table to create associations between values and table columns.
1.144 matthew 13757:
1.41 ng 13758: $r is an Apache Request ref,
13759: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13760: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13761:
13762: =cut
13763:
1.144 matthew 13764: ######################################################
13765: ######################################################
1.31 albertel 13766: sub csv_print_select_table {
13767: my ($r,$records,$d) = @_;
1.301 albertel 13768: my $i=0;
13769: my $samples = &get_samples($records,1);
1.144 matthew 13770: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13771: &start_data_table().&start_data_table_header_row().
1.144 matthew 13772: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13773: '<th>'.&mt('Column').'</th>'.
13774: &end_data_table_header_row()."\n");
1.356 albertel 13775: foreach my $array_ref (@$d) {
13776: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13777: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13778:
1.875 bisitz 13779: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13780: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13781: $r->print('<option value="none"></option>');
1.356 albertel 13782: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13783: $r->print('<option value="'.$sample.'"'.
13784: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13785: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13786: }
1.594 raeburn 13787: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13788: $i++;
13789: }
1.594 raeburn 13790: $r->print(&end_data_table());
1.31 albertel 13791: $i--;
13792: return $i;
13793: }
1.56 matthew 13794:
1.144 matthew 13795: ######################################################
13796: ######################################################
13797:
1.56 matthew 13798: =pod
1.31 albertel 13799:
1.648 raeburn 13800: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13801:
13802: Prints a table of sample values from the upload and can make associate samples to internal names.
13803:
13804: $r is an Apache Request ref,
13805: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13806: $d is an array of 2 element arrays (internal name, displayed name)
13807:
13808: =cut
13809:
1.144 matthew 13810: ######################################################
13811: ######################################################
1.31 albertel 13812: sub csv_samples_select_table {
13813: my ($r,$records,$d) = @_;
13814: my $i=0;
1.144 matthew 13815: #
1.662 bisitz 13816: my $max_samples = 5;
13817: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13818: $r->print(&start_data_table().
13819: &start_data_table_header_row().'<th>'.
13820: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13821: &end_data_table_header_row());
1.301 albertel 13822:
13823: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13824: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13825: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13826: foreach my $option (@$d) {
13827: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13828: $r->print('<option value="'.$value.'"'.
1.253 albertel 13829: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13830: $display.'</option>');
1.31 albertel 13831: }
13832: $r->print('</select></td><td>');
1.662 bisitz 13833: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13834: if (defined($samples->[$line]{$key})) {
13835: $r->print($samples->[$line]{$key}."<br />\n");
13836: }
13837: }
1.594 raeburn 13838: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13839: $i++;
13840: }
1.594 raeburn 13841: $r->print(&end_data_table());
1.31 albertel 13842: $i--;
13843: return($i);
1.115 matthew 13844: }
13845:
1.144 matthew 13846: ######################################################
13847: ######################################################
13848:
1.115 matthew 13849: =pod
13850:
1.648 raeburn 13851: =item * &clean_excel_name($name)
1.115 matthew 13852:
13853: Returns a replacement for $name which does not contain any illegal characters.
13854:
13855: =cut
13856:
1.144 matthew 13857: ######################################################
13858: ######################################################
1.115 matthew 13859: sub clean_excel_name {
13860: my ($name) = @_;
13861: $name =~ s/[:\*\?\/\\]//g;
13862: if (length($name) > 31) {
13863: $name = substr($name,0,31);
13864: }
13865: return $name;
1.25 albertel 13866: }
1.84 albertel 13867:
1.85 albertel 13868: =pod
13869:
1.648 raeburn 13870: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13871:
13872: Returns either 1 or undef
13873:
13874: 1 if the part is to be hidden, undef if it is to be shown
13875:
13876: Arguments are:
13877:
13878: $id the id of the part to be checked
13879: $symb, optional the symb of the resource to check
13880: $udom, optional the domain of the user to check for
13881: $uname, optional the username of the user to check for
13882:
13883: =cut
1.84 albertel 13884:
13885: sub check_if_partid_hidden {
13886: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13887: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13888: $symb,$udom,$uname);
1.141 albertel 13889: my $truth=1;
13890: #if the string starts with !, then the list is the list to show not hide
13891: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13892: my @hiddenlist=split(/,/,$hiddenparts);
13893: foreach my $checkid (@hiddenlist) {
1.141 albertel 13894: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13895: }
1.141 albertel 13896: return !$truth;
1.84 albertel 13897: }
1.127 matthew 13898:
1.138 matthew 13899:
13900: ############################################################
13901: ############################################################
13902:
13903: =pod
13904:
1.157 matthew 13905: =back
13906:
1.138 matthew 13907: =head1 cgi-bin script and graphing routines
13908:
1.157 matthew 13909: =over 4
13910:
1.648 raeburn 13911: =item * &get_cgi_id()
1.138 matthew 13912:
13913: Inputs: none
13914:
13915: Returns an id which can be used to pass environment variables
13916: to various cgi-bin scripts. These environment variables will
13917: be removed from the users environment after a given time by
13918: the routine &Apache::lonnet::transfer_profile_to_env.
13919:
13920: =cut
13921:
13922: ############################################################
13923: ############################################################
1.152 albertel 13924: my $uniq=0;
1.136 matthew 13925: sub get_cgi_id {
1.154 albertel 13926: $uniq=($uniq+1)%100000;
1.280 albertel 13927: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13928: }
13929:
1.127 matthew 13930: ############################################################
13931: ############################################################
13932:
13933: =pod
13934:
1.648 raeburn 13935: =item * &DrawBarGraph()
1.127 matthew 13936:
1.138 matthew 13937: Facilitates the plotting of data in a (stacked) bar graph.
13938: Puts plot definition data into the users environment in order for
13939: graph.png to plot it. Returns an <img> tag for the plot.
13940: The bars on the plot are labeled '1','2',...,'n'.
13941:
13942: Inputs:
13943:
13944: =over 4
13945:
13946: =item $Title: string, the title of the plot
13947:
13948: =item $xlabel: string, text describing the X-axis of the plot
13949:
13950: =item $ylabel: string, text describing the Y-axis of the plot
13951:
13952: =item $Max: scalar, the maximum Y value to use in the plot
13953: If $Max is < any data point, the graph will not be rendered.
13954:
1.140 matthew 13955: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13956: they are plotted. If undefined, default values will be used.
13957:
1.178 matthew 13958: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13959:
1.138 matthew 13960: =item @Values: An array of array references. Each array reference holds data
13961: to be plotted in a stacked bar chart.
13962:
1.239 matthew 13963: =item If the final element of @Values is a hash reference the key/value
13964: pairs will be added to the graph definition.
13965:
1.138 matthew 13966: =back
13967:
13968: Returns:
13969:
13970: An <img> tag which references graph.png and the appropriate identifying
13971: information for the plot.
13972:
1.127 matthew 13973: =cut
13974:
13975: ############################################################
13976: ############################################################
1.134 matthew 13977: sub DrawBarGraph {
1.178 matthew 13978: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13979: #
13980: if (! defined($colors)) {
13981: $colors = ['#33ff00',
13982: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13983: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13984: ];
13985: }
1.228 matthew 13986: my $extra_settings = {};
13987: if (ref($Values[-1]) eq 'HASH') {
13988: $extra_settings = pop(@Values);
13989: }
1.127 matthew 13990: #
1.136 matthew 13991: my $identifier = &get_cgi_id();
13992: my $id = 'cgi.'.$identifier;
1.129 matthew 13993: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13994: return '';
13995: }
1.225 matthew 13996: #
13997: my @Labels;
13998: if (defined($labels)) {
13999: @Labels = @$labels;
14000: } else {
14001: for (my $i=0;$i<@{$Values[0]};$i++) {
14002: push (@Labels,$i+1);
14003: }
14004: }
14005: #
1.129 matthew 14006: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14007: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14008: my %ValuesHash;
14009: my $NumSets=1;
14010: foreach my $array (@Values) {
14011: next if (! ref($array));
1.136 matthew 14012: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14013: join(',',@$array);
1.129 matthew 14014: }
1.127 matthew 14015: #
1.136 matthew 14016: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14017: if ($NumBars < 3) {
14018: $width = 120+$NumBars*32;
1.220 matthew 14019: $xskip = 1;
1.225 matthew 14020: $bar_width = 30;
14021: } elsif ($NumBars < 5) {
14022: $width = 120+$NumBars*20;
14023: $xskip = 1;
14024: $bar_width = 20;
1.220 matthew 14025: } elsif ($NumBars < 10) {
1.136 matthew 14026: $width = 120+$NumBars*15;
14027: $xskip = 1;
14028: $bar_width = 15;
14029: } elsif ($NumBars <= 25) {
14030: $width = 120+$NumBars*11;
14031: $xskip = 5;
14032: $bar_width = 8;
14033: } elsif ($NumBars <= 50) {
14034: $width = 120+$NumBars*8;
14035: $xskip = 5;
14036: $bar_width = 4;
14037: } else {
14038: $width = 120+$NumBars*8;
14039: $xskip = 5;
14040: $bar_width = 4;
14041: }
14042: #
1.137 matthew 14043: $Max = 1 if ($Max < 1);
14044: if ( int($Max) < $Max ) {
14045: $Max++;
14046: $Max = int($Max);
14047: }
1.127 matthew 14048: $Title = '' if (! defined($Title));
14049: $xlabel = '' if (! defined($xlabel));
14050: $ylabel = '' if (! defined($ylabel));
1.369 www 14051: $ValuesHash{$id.'.title'} = &escape($Title);
14052: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14053: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14054: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14055: $ValuesHash{$id.'.NumBars'} = $NumBars;
14056: $ValuesHash{$id.'.NumSets'} = $NumSets;
14057: $ValuesHash{$id.'.PlotType'} = 'bar';
14058: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14059: $ValuesHash{$id.'.height'} = $height;
14060: $ValuesHash{$id.'.width'} = $width;
14061: $ValuesHash{$id.'.xskip'} = $xskip;
14062: $ValuesHash{$id.'.bar_width'} = $bar_width;
14063: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14064: #
1.228 matthew 14065: # Deal with other parameters
14066: while (my ($key,$value) = each(%$extra_settings)) {
14067: $ValuesHash{$id.'.'.$key} = $value;
14068: }
14069: #
1.646 raeburn 14070: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14071: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14072: }
14073:
14074: ############################################################
14075: ############################################################
14076:
14077: =pod
14078:
1.648 raeburn 14079: =item * &DrawXYGraph()
1.137 matthew 14080:
1.138 matthew 14081: Facilitates the plotting of data in an XY graph.
14082: Puts plot definition data into the users environment in order for
14083: graph.png to plot it. Returns an <img> tag for the plot.
14084:
14085: Inputs:
14086:
14087: =over 4
14088:
14089: =item $Title: string, the title of the plot
14090:
14091: =item $xlabel: string, text describing the X-axis of the plot
14092:
14093: =item $ylabel: string, text describing the Y-axis of the plot
14094:
14095: =item $Max: scalar, the maximum Y value to use in the plot
14096: If $Max is < any data point, the graph will not be rendered.
14097:
14098: =item $colors: Array ref containing the hex color codes for the data to be
14099: plotted in. If undefined, default values will be used.
14100:
14101: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14102:
14103: =item $Ydata: Array ref containing Array refs.
1.185 www 14104: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14105:
14106: =item %Values: hash indicating or overriding any default values which are
14107: passed to graph.png.
14108: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14109:
14110: =back
14111:
14112: Returns:
14113:
14114: An <img> tag which references graph.png and the appropriate identifying
14115: information for the plot.
14116:
1.137 matthew 14117: =cut
14118:
14119: ############################################################
14120: ############################################################
14121: sub DrawXYGraph {
14122: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14123: #
14124: # Create the identifier for the graph
14125: my $identifier = &get_cgi_id();
14126: my $id = 'cgi.'.$identifier;
14127: #
14128: $Title = '' if (! defined($Title));
14129: $xlabel = '' if (! defined($xlabel));
14130: $ylabel = '' if (! defined($ylabel));
14131: my %ValuesHash =
14132: (
1.369 www 14133: $id.'.title' => &escape($Title),
14134: $id.'.xlabel' => &escape($xlabel),
14135: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14136: $id.'.y_max_value'=> $Max,
14137: $id.'.labels' => join(',',@$Xlabels),
14138: $id.'.PlotType' => 'XY',
14139: );
14140: #
14141: if (defined($colors) && ref($colors) eq 'ARRAY') {
14142: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14143: }
14144: #
14145: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14146: return '';
14147: }
14148: my $NumSets=1;
1.138 matthew 14149: foreach my $array (@{$Ydata}){
1.137 matthew 14150: next if (! ref($array));
14151: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14152: }
1.138 matthew 14153: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14154: #
14155: # Deal with other parameters
14156: while (my ($key,$value) = each(%Values)) {
14157: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14158: }
14159: #
1.646 raeburn 14160: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14161: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14162: }
14163:
14164: ############################################################
14165: ############################################################
14166:
14167: =pod
14168:
1.648 raeburn 14169: =item * &DrawXYYGraph()
1.138 matthew 14170:
14171: Facilitates the plotting of data in an XY graph with two Y axes.
14172: Puts plot definition data into the users environment in order for
14173: graph.png to plot it. Returns an <img> tag for the plot.
14174:
14175: Inputs:
14176:
14177: =over 4
14178:
14179: =item $Title: string, the title of the plot
14180:
14181: =item $xlabel: string, text describing the X-axis of the plot
14182:
14183: =item $ylabel: string, text describing the Y-axis of the plot
14184:
14185: =item $colors: Array ref containing the hex color codes for the data to be
14186: plotted in. If undefined, default values will be used.
14187:
14188: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14189:
14190: =item $Ydata1: The first data set
14191:
14192: =item $Min1: The minimum value of the left Y-axis
14193:
14194: =item $Max1: The maximum value of the left Y-axis
14195:
14196: =item $Ydata2: The second data set
14197:
14198: =item $Min2: The minimum value of the right Y-axis
14199:
14200: =item $Max2: The maximum value of the left Y-axis
14201:
14202: =item %Values: hash indicating or overriding any default values which are
14203: passed to graph.png.
14204: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14205:
14206: =back
14207:
14208: Returns:
14209:
14210: An <img> tag which references graph.png and the appropriate identifying
14211: information for the plot.
1.136 matthew 14212:
14213: =cut
14214:
14215: ############################################################
14216: ############################################################
1.137 matthew 14217: sub DrawXYYGraph {
14218: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14219: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14220: #
14221: # Create the identifier for the graph
14222: my $identifier = &get_cgi_id();
14223: my $id = 'cgi.'.$identifier;
14224: #
14225: $Title = '' if (! defined($Title));
14226: $xlabel = '' if (! defined($xlabel));
14227: $ylabel = '' if (! defined($ylabel));
14228: my %ValuesHash =
14229: (
1.369 www 14230: $id.'.title' => &escape($Title),
14231: $id.'.xlabel' => &escape($xlabel),
14232: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14233: $id.'.labels' => join(',',@$Xlabels),
14234: $id.'.PlotType' => 'XY',
14235: $id.'.NumSets' => 2,
1.137 matthew 14236: $id.'.two_axes' => 1,
14237: $id.'.y1_max_value' => $Max1,
14238: $id.'.y1_min_value' => $Min1,
14239: $id.'.y2_max_value' => $Max2,
14240: $id.'.y2_min_value' => $Min2,
1.136 matthew 14241: );
14242: #
1.137 matthew 14243: if (defined($colors) && ref($colors) eq 'ARRAY') {
14244: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14245: }
14246: #
14247: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14248: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14249: return '';
14250: }
14251: my $NumSets=1;
1.137 matthew 14252: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14253: next if (! ref($array));
14254: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14255: }
14256: #
14257: # Deal with other parameters
14258: while (my ($key,$value) = each(%Values)) {
14259: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14260: }
14261: #
1.646 raeburn 14262: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14263: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14264: }
14265:
14266: ############################################################
14267: ############################################################
14268:
14269: =pod
14270:
1.157 matthew 14271: =back
14272:
1.139 matthew 14273: =head1 Statistics helper routines?
14274:
14275: Bad place for them but what the hell.
14276:
1.157 matthew 14277: =over 4
14278:
1.648 raeburn 14279: =item * &chartlink()
1.139 matthew 14280:
14281: Returns a link to the chart for a specific student.
14282:
14283: Inputs:
14284:
14285: =over 4
14286:
14287: =item $linktext: The text of the link
14288:
14289: =item $sname: The students username
14290:
14291: =item $sdomain: The students domain
14292:
14293: =back
14294:
1.157 matthew 14295: =back
14296:
1.139 matthew 14297: =cut
14298:
14299: ############################################################
14300: ############################################################
14301: sub chartlink {
14302: my ($linktext, $sname, $sdomain) = @_;
14303: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14304: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14305: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14306: '">'.$linktext.'</a>';
1.153 matthew 14307: }
14308:
14309: #######################################################
14310: #######################################################
14311:
14312: =pod
14313:
14314: =head1 Course Environment Routines
1.157 matthew 14315:
14316: =over 4
1.153 matthew 14317:
1.648 raeburn 14318: =item * &restore_course_settings()
1.153 matthew 14319:
1.648 raeburn 14320: =item * &store_course_settings()
1.153 matthew 14321:
14322: Restores/Store indicated form parameters from the course environment.
14323: Will not overwrite existing values of the form parameters.
14324:
14325: Inputs:
14326: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14327:
14328: a hash ref describing the data to be stored. For example:
14329:
14330: %Save_Parameters = ('Status' => 'scalar',
14331: 'chartoutputmode' => 'scalar',
14332: 'chartoutputdata' => 'scalar',
14333: 'Section' => 'array',
1.373 raeburn 14334: 'Group' => 'array',
1.153 matthew 14335: 'StudentData' => 'array',
14336: 'Maps' => 'array');
14337:
14338: Returns: both routines return nothing
14339:
1.631 raeburn 14340: =back
14341:
1.153 matthew 14342: =cut
14343:
14344: #######################################################
14345: #######################################################
14346: sub store_course_settings {
1.496 albertel 14347: return &store_settings($env{'request.course.id'},@_);
14348: }
14349:
14350: sub store_settings {
1.153 matthew 14351: # save to the environment
14352: # appenv the same items, just to be safe
1.300 albertel 14353: my $udom = $env{'user.domain'};
14354: my $uname = $env{'user.name'};
1.496 albertel 14355: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14356: my %SaveHash;
14357: my %AppHash;
14358: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14359: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14360: my $envname = 'environment.'.$basename;
1.258 albertel 14361: if (exists($env{'form.'.$setting})) {
1.153 matthew 14362: # Save this value away
14363: if ($type eq 'scalar' &&
1.258 albertel 14364: (! exists($env{$envname}) ||
14365: $env{$envname} ne $env{'form.'.$setting})) {
14366: $SaveHash{$basename} = $env{'form.'.$setting};
14367: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14368: } elsif ($type eq 'array') {
14369: my $stored_form;
1.258 albertel 14370: if (ref($env{'form.'.$setting})) {
1.153 matthew 14371: $stored_form = join(',',
14372: map {
1.369 www 14373: &escape($_);
1.258 albertel 14374: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14375: } else {
14376: $stored_form =
1.369 www 14377: &escape($env{'form.'.$setting});
1.153 matthew 14378: }
14379: # Determine if the array contents are the same.
1.258 albertel 14380: if ($stored_form ne $env{$envname}) {
1.153 matthew 14381: $SaveHash{$basename} = $stored_form;
14382: $AppHash{$envname} = $stored_form;
14383: }
14384: }
14385: }
14386: }
14387: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14388: $udom,$uname);
1.153 matthew 14389: if ($put_result !~ /^(ok|delayed)/) {
14390: &Apache::lonnet::logthis('unable to save form parameters, '.
14391: 'got error:'.$put_result);
14392: }
14393: # Make sure these settings stick around in this session, too
1.646 raeburn 14394: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14395: return;
14396: }
14397:
14398: sub restore_course_settings {
1.499 albertel 14399: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14400: }
14401:
14402: sub restore_settings {
14403: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14404: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14405: next if (exists($env{'form.'.$setting}));
1.496 albertel 14406: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14407: '.'.$setting;
1.258 albertel 14408: if (exists($env{$envname})) {
1.153 matthew 14409: if ($type eq 'scalar') {
1.258 albertel 14410: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14411: } elsif ($type eq 'array') {
1.258 albertel 14412: $env{'form.'.$setting} = [
1.153 matthew 14413: map {
1.369 www 14414: &unescape($_);
1.258 albertel 14415: } split(',',$env{$envname})
1.153 matthew 14416: ];
14417: }
14418: }
14419: }
1.127 matthew 14420: }
14421:
1.618 raeburn 14422: #######################################################
14423: #######################################################
14424:
14425: =pod
14426:
14427: =head1 Domain E-mail Routines
14428:
14429: =over 4
14430:
1.648 raeburn 14431: =item * &build_recipient_list()
1.618 raeburn 14432:
1.1144 raeburn 14433: Build recipient lists for following types of e-mail:
1.766 raeburn 14434: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14435: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14436: module change checking, student/employee ID conflict checks, as
14437: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14438: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14439:
14440: Inputs:
1.619 raeburn 14441: defmail (scalar - email address of default recipient),
1.1144 raeburn 14442: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14443: requestsmail, updatesmail, or idconflictsmail).
14444:
1.619 raeburn 14445: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14446:
1.619 raeburn 14447: origmail (scalar - email address of recipient from loncapa.conf,
14448: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14449:
1.655 raeburn 14450: Returns: comma separated list of addresses to which to send e-mail.
14451:
14452: =back
1.618 raeburn 14453:
14454: =cut
14455:
14456: ############################################################
14457: ############################################################
14458: sub build_recipient_list {
1.619 raeburn 14459: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 14460: my @recipients;
14461: my $otheremails;
14462: my %domconfig =
14463: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
14464: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14465: if (exists($domconfig{'contacts'}{$mailing})) {
14466: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14467: my @contacts = ('adminemail','supportemail');
14468: foreach my $item (@contacts) {
14469: if ($domconfig{'contacts'}{$mailing}{$item}) {
14470: my $addr = $domconfig{'contacts'}{$item};
14471: if (!grep(/^\Q$addr\E$/,@recipients)) {
14472: push(@recipients,$addr);
14473: }
1.619 raeburn 14474: }
1.766 raeburn 14475: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 14476: }
14477: }
1.766 raeburn 14478: } elsif ($origmail ne '') {
14479: push(@recipients,$origmail);
1.618 raeburn 14480: }
1.619 raeburn 14481: } elsif ($origmail ne '') {
14482: push(@recipients,$origmail);
1.618 raeburn 14483: }
1.688 raeburn 14484: if (defined($defmail)) {
14485: if ($defmail ne '') {
14486: push(@recipients,$defmail);
14487: }
1.618 raeburn 14488: }
14489: if ($otheremails) {
1.619 raeburn 14490: my @others;
14491: if ($otheremails =~ /,/) {
14492: @others = split(/,/,$otheremails);
1.618 raeburn 14493: } else {
1.619 raeburn 14494: push(@others,$otheremails);
14495: }
14496: foreach my $addr (@others) {
14497: if (!grep(/^\Q$addr\E$/,@recipients)) {
14498: push(@recipients,$addr);
14499: }
1.618 raeburn 14500: }
14501: }
1.619 raeburn 14502: my $recipientlist = join(',',@recipients);
1.618 raeburn 14503: return $recipientlist;
14504: }
14505:
1.127 matthew 14506: ############################################################
14507: ############################################################
1.154 albertel 14508:
1.655 raeburn 14509: =pod
14510:
1.1224 musolffc 14511: =over 4
14512:
1.1223 musolffc 14513: =item * &mime_email()
14514:
14515: Sends an email with a possible attachment
14516:
14517: Inputs:
14518:
14519: =over 4
14520:
14521: from - Sender's email address
14522:
14523: to - Email address of recipient
14524:
14525: subject - Subject of email
14526:
14527: body - Body of email
14528:
14529: cc_string - Carbon copy email address
14530:
14531: bcc - Blind carbon copy email address
14532:
14533: type - File type of attachment
14534:
14535: attachment_path - Path of file to be attached
14536:
14537: file_name - Name of file to be attached
14538:
14539: attachment_text - The body of an attachment of type "TEXT"
14540:
14541: =back
14542:
14543: =back
14544:
14545: =cut
14546:
14547: ############################################################
14548: ############################################################
14549:
14550: sub mime_email {
14551: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14552: $file_name, $attachment_text) = @_;
14553: my $msg = MIME::Lite->new(
14554: From => $from,
14555: To => $to,
14556: Subject => $subject,
14557: Type =>'TEXT',
14558: Data => $body,
14559: );
14560: if ($cc_string ne '') {
14561: $msg->add("Cc" => $cc_string);
14562: }
14563: if ($bcc ne '') {
14564: $msg->add("Bcc" => $bcc);
14565: }
14566: $msg->attr("content-type" => "text/plain");
14567: $msg->attr("content-type.charset" => "UTF-8");
14568: # Attach file if given
14569: if ($attachment_path) {
14570: unless ($file_name) {
14571: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
14572: }
14573: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
14574: $msg->attach(Type => $type,
14575: Path => $attachment_path,
14576: Filename => $file_name
14577: );
14578: # Otherwise attach text if given
14579: } elsif ($attachment_text) {
14580: $msg->attach(Type => 'TEXT',
14581: Data => $attachment_text);
14582: }
14583: # Send it
14584: $msg->send('sendmail');
14585: }
14586:
14587: ############################################################
14588: ############################################################
14589:
14590: =pod
14591:
1.655 raeburn 14592: =head1 Course Catalog Routines
14593:
14594: =over 4
14595:
14596: =item * &gather_categories()
14597:
14598: Converts category definitions - keys of categories hash stored in
14599: coursecategories in configuration.db on the primary library server in a
14600: domain - to an array. Also generates javascript and idx hash used to
14601: generate Domain Coordinator interface for editing Course Categories.
14602:
14603: Inputs:
1.663 raeburn 14604:
1.655 raeburn 14605: categories (reference to hash of category definitions).
1.663 raeburn 14606:
1.655 raeburn 14607: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14608: categories and subcategories).
1.663 raeburn 14609:
1.655 raeburn 14610: idx (reference to hash of counters used in Domain Coordinator interface for
14611: editing Course Categories).
1.663 raeburn 14612:
1.655 raeburn 14613: jsarray (reference to array of categories used to create Javascript arrays for
14614: Domain Coordinator interface for editing Course Categories).
14615:
14616: Returns: nothing
14617:
14618: Side effects: populates cats, idx and jsarray.
14619:
14620: =cut
14621:
14622: sub gather_categories {
14623: my ($categories,$cats,$idx,$jsarray) = @_;
14624: my %counters;
14625: my $num = 0;
14626: foreach my $item (keys(%{$categories})) {
14627: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14628: if ($container eq '' && $depth == 0) {
14629: $cats->[$depth][$categories->{$item}] = $cat;
14630: } else {
14631: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14632: }
14633: my ($escitem,$tail) = split(/:/,$item,2);
14634: if ($counters{$tail} eq '') {
14635: $counters{$tail} = $num;
14636: $num ++;
14637: }
14638: if (ref($idx) eq 'HASH') {
14639: $idx->{$item} = $counters{$tail};
14640: }
14641: if (ref($jsarray) eq 'ARRAY') {
14642: push(@{$jsarray->[$counters{$tail}]},$item);
14643: }
14644: }
14645: return;
14646: }
14647:
14648: =pod
14649:
14650: =item * &extract_categories()
14651:
14652: Used to generate breadcrumb trails for course categories.
14653:
14654: Inputs:
1.663 raeburn 14655:
1.655 raeburn 14656: categories (reference to hash of category definitions).
1.663 raeburn 14657:
1.655 raeburn 14658: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14659: categories and subcategories).
1.663 raeburn 14660:
1.655 raeburn 14661: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14662:
1.655 raeburn 14663: allitems (reference to hash - key is category key
14664: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14665:
1.655 raeburn 14666: idx (reference to hash of counters used in Domain Coordinator interface for
14667: editing Course Categories).
1.663 raeburn 14668:
1.655 raeburn 14669: jsarray (reference to array of categories used to create Javascript arrays for
14670: Domain Coordinator interface for editing Course Categories).
14671:
1.665 raeburn 14672: subcats (reference to hash of arrays containing all subcategories within each
14673: category, -recursive)
14674:
1.655 raeburn 14675: Returns: nothing
14676:
14677: Side effects: populates trails and allitems hash references.
14678:
14679: =cut
14680:
14681: sub extract_categories {
1.665 raeburn 14682: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 14683: if (ref($categories) eq 'HASH') {
14684: &gather_categories($categories,$cats,$idx,$jsarray);
14685: if (ref($cats->[0]) eq 'ARRAY') {
14686: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14687: my $name = $cats->[0][$i];
14688: my $item = &escape($name).'::0';
14689: my $trailstr;
14690: if ($name eq 'instcode') {
14691: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14692: } elsif ($name eq 'communities') {
14693: $trailstr = &mt('Communities');
1.1239 raeburn 14694: } elsif ($name eq 'placement') {
14695: $trailstr = &mt('Placement Tests');
1.655 raeburn 14696: } else {
14697: $trailstr = $name;
14698: }
14699: if ($allitems->{$item} eq '') {
14700: push(@{$trails},$trailstr);
14701: $allitems->{$item} = scalar(@{$trails})-1;
14702: }
14703: my @parents = ($name);
14704: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14705: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14706: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14707: if (ref($subcats) eq 'HASH') {
14708: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14709: }
14710: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
14711: }
14712: } else {
14713: if (ref($subcats) eq 'HASH') {
14714: $subcats->{$item} = [];
1.655 raeburn 14715: }
14716: }
14717: }
14718: }
14719: }
14720: return;
14721: }
14722:
14723: =pod
14724:
1.1162 raeburn 14725: =item * &recurse_categories()
1.655 raeburn 14726:
14727: Recursively used to generate breadcrumb trails for course categories.
14728:
14729: Inputs:
1.663 raeburn 14730:
1.655 raeburn 14731: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14732: categories and subcategories).
1.663 raeburn 14733:
1.655 raeburn 14734: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14735:
14736: category (current course category, for which breadcrumb trail is being generated).
14737:
14738: trails (reference to array of breadcrumb trails for each category).
14739:
1.655 raeburn 14740: allitems (reference to hash - key is category key
14741: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14742:
1.655 raeburn 14743: parents (array containing containers directories for current category,
14744: back to top level).
14745:
14746: Returns: nothing
14747:
14748: Side effects: populates trails and allitems hash references
14749:
14750: =cut
14751:
14752: sub recurse_categories {
1.665 raeburn 14753: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14754: my $shallower = $depth - 1;
14755: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14756: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14757: my $name = $cats->[$depth]{$category}[$k];
14758: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14759: my $trailstr = join(' -> ',(@{$parents},$category));
14760: if ($allitems->{$item} eq '') {
14761: push(@{$trails},$trailstr);
14762: $allitems->{$item} = scalar(@{$trails})-1;
14763: }
14764: my $deeper = $depth+1;
14765: push(@{$parents},$category);
1.665 raeburn 14766: if (ref($subcats) eq 'HASH') {
14767: my $subcat = &escape($name).':'.$category.':'.$depth;
14768: for (my $j=@{$parents}; $j>=0; $j--) {
14769: my $higher;
14770: if ($j > 0) {
14771: $higher = &escape($parents->[$j]).':'.
14772: &escape($parents->[$j-1]).':'.$j;
14773: } else {
14774: $higher = &escape($parents->[$j]).'::'.$j;
14775: }
14776: push(@{$subcats->{$higher}},$subcat);
14777: }
14778: }
14779: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14780: $subcats);
1.655 raeburn 14781: pop(@{$parents});
14782: }
14783: } else {
14784: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14785: my $trailstr = join(' -> ',(@{$parents},$category));
14786: if ($allitems->{$item} eq '') {
14787: push(@{$trails},$trailstr);
14788: $allitems->{$item} = scalar(@{$trails})-1;
14789: }
14790: }
14791: return;
14792: }
14793:
1.663 raeburn 14794: =pod
14795:
1.1162 raeburn 14796: =item * &assign_categories_table()
1.663 raeburn 14797:
14798: Create a datatable for display of hierarchical categories in a domain,
14799: with checkboxes to allow a course to be categorized.
14800:
14801: Inputs:
14802:
14803: cathash - reference to hash of categories defined for the domain (from
14804: configuration.db)
14805:
14806: currcat - scalar with an & separated list of categories assigned to a course.
14807:
1.919 raeburn 14808: type - scalar contains course type (Course or Community).
14809:
1.663 raeburn 14810: Returns: $output (markup to be displayed)
14811:
14812: =cut
14813:
14814: sub assign_categories_table {
1.919 raeburn 14815: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14816: my $output;
14817: if (ref($cathash) eq 'HASH') {
14818: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14819: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14820: $maxdepth = scalar(@cats);
14821: if (@cats > 0) {
14822: my $itemcount = 0;
14823: if (ref($cats[0]) eq 'ARRAY') {
14824: my @currcategories;
14825: if ($currcat ne '') {
14826: @currcategories = split('&',$currcat);
14827: }
1.919 raeburn 14828: my $table;
1.663 raeburn 14829: for (my $i=0; $i<@{$cats[0]}; $i++) {
14830: my $parent = $cats[0][$i];
1.919 raeburn 14831: next if ($parent eq 'instcode');
14832: if ($type eq 'Community') {
14833: next unless ($parent eq 'communities');
1.1239 raeburn 14834: } elsif ($type eq 'Placement') {
14835: next unless ($parent eq 'placement');
1.919 raeburn 14836: } else {
1.1239 raeburn 14837: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 14838: }
1.663 raeburn 14839: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14840: my $item = &escape($parent).'::0';
14841: my $checked = '';
14842: if (@currcategories > 0) {
14843: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14844: $checked = ' checked="checked"';
1.663 raeburn 14845: }
14846: }
1.919 raeburn 14847: my $parent_title = $parent;
14848: if ($parent eq 'communities') {
14849: $parent_title = &mt('Communities');
1.1239 raeburn 14850: } elsif ($parent eq 'placement') {
14851: $parent_title = &mt('Placement Tests');
1.919 raeburn 14852: }
14853: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14854: '<input type="checkbox" name="usecategory" value="'.
14855: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14856: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14857: my $depth = 1;
14858: push(@path,$parent);
1.919 raeburn 14859: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14860: pop(@path);
1.919 raeburn 14861: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14862: $itemcount ++;
14863: }
1.919 raeburn 14864: if ($itemcount) {
14865: $output = &Apache::loncommon::start_data_table().
14866: $table.
14867: &Apache::loncommon::end_data_table();
14868: }
1.663 raeburn 14869: }
14870: }
14871: }
14872: return $output;
14873: }
14874:
14875: =pod
14876:
1.1162 raeburn 14877: =item * &assign_category_rows()
1.663 raeburn 14878:
14879: Create a datatable row for display of nested categories in a domain,
14880: with checkboxes to allow a course to be categorized,called recursively.
14881:
14882: Inputs:
14883:
14884: itemcount - track row number for alternating colors
14885:
14886: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14887: categories and subcategories.
14888:
14889: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14890:
14891: parent - parent of current category item
14892:
14893: path - Array containing all categories back up through the hierarchy from the
14894: current category to the top level.
14895:
14896: currcategories - reference to array of current categories assigned to the course
14897:
14898: Returns: $output (markup to be displayed).
14899:
14900: =cut
14901:
14902: sub assign_category_rows {
14903: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14904: my ($text,$name,$item,$chgstr);
14905: if (ref($cats) eq 'ARRAY') {
14906: my $maxdepth = scalar(@{$cats});
14907: if (ref($cats->[$depth]) eq 'HASH') {
14908: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14909: my $numchildren = @{$cats->[$depth]{$parent}};
14910: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14911: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14912: for (my $j=0; $j<$numchildren; $j++) {
14913: $name = $cats->[$depth]{$parent}[$j];
14914: $item = &escape($name).':'.&escape($parent).':'.$depth;
14915: my $deeper = $depth+1;
14916: my $checked = '';
14917: if (ref($currcategories) eq 'ARRAY') {
14918: if (@{$currcategories} > 0) {
14919: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14920: $checked = ' checked="checked"';
1.663 raeburn 14921: }
14922: }
14923: }
1.664 raeburn 14924: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14925: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14926: $item.'"'.$checked.' />'.$name.'</label></span>'.
14927: '<input type="hidden" name="catname" value="'.$name.'" />'.
14928: '</td><td>';
1.663 raeburn 14929: if (ref($path) eq 'ARRAY') {
14930: push(@{$path},$name);
14931: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14932: pop(@{$path});
14933: }
14934: $text .= '</td></tr>';
14935: }
14936: $text .= '</table></td>';
14937: }
14938: }
14939: }
14940: return $text;
14941: }
14942:
1.1181 raeburn 14943: =pod
14944:
14945: =back
14946:
14947: =cut
14948:
1.655 raeburn 14949: ############################################################
14950: ############################################################
14951:
14952:
1.443 albertel 14953: sub commit_customrole {
1.664 raeburn 14954: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14955: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14956: ($start?', '.&mt('starting').' '.localtime($start):'').
14957: ($end?', ending '.localtime($end):'').': <b>'.
14958: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14959: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14960: '</b><br />';
14961: return $output;
14962: }
14963:
14964: sub commit_standardrole {
1.1116 raeburn 14965: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14966: my ($output,$logmsg,$linefeed);
14967: if ($context eq 'auto') {
14968: $linefeed = "\n";
14969: } else {
14970: $linefeed = "<br />\n";
14971: }
1.443 albertel 14972: if ($three eq 'st') {
1.541 raeburn 14973: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14974: $one,$two,$sec,$context,$credits);
1.541 raeburn 14975: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14976: ($result eq 'unknown_course') || ($result eq 'refused')) {
14977: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14978: } else {
1.541 raeburn 14979: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14980: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14981: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14982: if ($context eq 'auto') {
14983: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14984: } else {
14985: $output .= '<b>'.$result.'</b>'.$linefeed.
14986: &mt('Add to classlist').': <b>ok</b>';
14987: }
14988: $output .= $linefeed;
1.443 albertel 14989: }
14990: } else {
14991: $output = &mt('Assigning').' '.$three.' in '.$url.
14992: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14993: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14994: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14995: if ($context eq 'auto') {
14996: $output .= $result.$linefeed;
14997: } else {
14998: $output .= '<b>'.$result.'</b>'.$linefeed;
14999: }
1.443 albertel 15000: }
15001: return $output;
15002: }
15003:
15004: sub commit_studentrole {
1.1116 raeburn 15005: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15006: $credits) = @_;
1.626 raeburn 15007: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15008: if ($context eq 'auto') {
15009: $linefeed = "\n";
15010: } else {
15011: $linefeed = '<br />'."\n";
15012: }
1.443 albertel 15013: if (defined($one) && defined($two)) {
15014: my $cid=$one.'_'.$two;
15015: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15016: my $secchange = 0;
15017: my $expire_role_result;
15018: my $modify_section_result;
1.628 raeburn 15019: if ($oldsec ne '-1') {
15020: if ($oldsec ne $sec) {
1.443 albertel 15021: $secchange = 1;
1.628 raeburn 15022: my $now = time;
1.443 albertel 15023: my $uurl='/'.$cid;
15024: $uurl=~s/\_/\//g;
15025: if ($oldsec) {
15026: $uurl.='/'.$oldsec;
15027: }
1.626 raeburn 15028: $oldsecurl = $uurl;
1.628 raeburn 15029: $expire_role_result =
1.652 raeburn 15030: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15031: if ($env{'request.course.sec'} ne '') {
15032: if ($expire_role_result eq 'refused') {
15033: my @roles = ('st');
15034: my @statuses = ('previous');
15035: my @roledoms = ($one);
15036: my $withsec = 1;
15037: my %roleshash =
15038: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15039: \@statuses,\@roles,\@roledoms,$withsec);
15040: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15041: my ($oldstart,$oldend) =
15042: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15043: if ($oldend > 0 && $oldend <= $now) {
15044: $expire_role_result = 'ok';
15045: }
15046: }
15047: }
15048: }
1.443 albertel 15049: $result = $expire_role_result;
15050: }
15051: }
15052: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15053: $modify_section_result =
15054: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15055: undef,undef,undef,$sec,
15056: $end,$start,'','',$cid,
15057: '',$context,$credits);
1.443 albertel 15058: if ($modify_section_result =~ /^ok/) {
15059: if ($secchange == 1) {
1.628 raeburn 15060: if ($sec eq '') {
15061: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15062: } else {
15063: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15064: }
1.443 albertel 15065: } elsif ($oldsec eq '-1') {
1.628 raeburn 15066: if ($sec eq '') {
15067: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15068: } else {
15069: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15070: }
1.443 albertel 15071: } else {
1.628 raeburn 15072: if ($sec eq '') {
15073: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15074: } else {
15075: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15076: }
1.443 albertel 15077: }
15078: } else {
1.1115 raeburn 15079: if ($secchange) {
1.628 raeburn 15080: $$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;
15081: } else {
15082: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15083: }
1.443 albertel 15084: }
15085: $result = $modify_section_result;
15086: } elsif ($secchange == 1) {
1.628 raeburn 15087: if ($oldsec eq '') {
1.1103 raeburn 15088: $$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 15089: } else {
15090: $$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;
15091: }
1.626 raeburn 15092: if ($expire_role_result eq 'refused') {
15093: my $newsecurl = '/'.$cid;
15094: $newsecurl =~ s/\_/\//g;
15095: if ($sec ne '') {
15096: $newsecurl.='/'.$sec;
15097: }
15098: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15099: if ($sec eq '') {
15100: $$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;
15101: } else {
15102: $$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;
15103: }
15104: }
15105: }
1.443 albertel 15106: }
15107: } else {
1.626 raeburn 15108: $$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 15109: $result = "error: incomplete course id\n";
15110: }
15111: return $result;
15112: }
15113:
1.1108 raeburn 15114: sub show_role_extent {
15115: my ($scope,$context,$role) = @_;
15116: $scope =~ s{^/}{};
15117: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15118: push(@courseroles,'co');
15119: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15120: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15121: $scope =~ s{/}{_};
15122: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15123: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15124: my ($audom,$auname) = split(/\//,$scope);
15125: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15126: &Apache::loncommon::plainname($auname,$audom).'</span>');
15127: } else {
15128: $scope =~ s{/$}{};
15129: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15130: &Apache::lonnet::domain($scope,'description').'</span>');
15131: }
15132: }
15133:
1.443 albertel 15134: ############################################################
15135: ############################################################
15136:
1.566 albertel 15137: sub check_clone {
1.578 raeburn 15138: my ($args,$linefeed) = @_;
1.566 albertel 15139: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15140: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15141: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15142: my $clonemsg;
15143: my $can_clone = 0;
1.944 raeburn 15144: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15145: if ($lctype ne 'community') {
15146: $lctype = 'course';
15147: }
1.566 albertel 15148: if ($clonehome eq 'no_host') {
1.944 raeburn 15149: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15150: $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'});
15151: } else {
15152: $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'});
15153: }
1.566 albertel 15154: } else {
15155: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15156: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15157: if ($clonedesc{'type'} ne 'Community') {
15158: $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'});
15159: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15160: }
15161: }
1.882 raeburn 15162: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
15163: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15164: $can_clone = 1;
15165: } else {
1.1221 raeburn 15166: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15167: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15168: if ($clonehash{'cloners'} eq '') {
15169: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15170: if ($domdefs{'canclone'}) {
15171: unless ($domdefs{'canclone'} eq 'none') {
15172: if ($domdefs{'canclone'} eq 'domain') {
15173: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15174: $can_clone = 1;
15175: }
15176: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15177: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15178: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15179: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15180: $can_clone = 1;
15181: }
15182: }
15183: }
15184: }
1.578 raeburn 15185: } else {
1.1221 raeburn 15186: my @cloners = split(/,/,$clonehash{'cloners'});
15187: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15188: $can_clone = 1;
1.1221 raeburn 15189: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15190: $can_clone = 1;
1.1225 raeburn 15191: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15192: $can_clone = 1;
1.1221 raeburn 15193: }
15194: unless ($can_clone) {
1.1225 raeburn 15195: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15196: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15197: my (%gotdomdefaults,%gotcodedefaults);
15198: foreach my $cloner (@cloners) {
15199: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15200: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15201: my (%codedefaults,@code_order);
15202: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15203: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15204: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15205: }
15206: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15207: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15208: }
15209: } else {
15210: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15211: \%codedefaults,
15212: \@code_order);
15213: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15214: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15215: }
15216: if (@code_order > 0) {
15217: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15218: $cloner,$clonehash{'internal.coursecode'},
15219: $args->{'crscode'})) {
15220: $can_clone = 1;
15221: last;
15222: }
15223: }
15224: }
15225: }
15226: }
1.1225 raeburn 15227: }
15228: }
15229: unless ($can_clone) {
15230: my $ccrole = 'cc';
15231: if ($args->{'crstype'} eq 'Community') {
15232: $ccrole = 'co';
15233: }
15234: my %roleshash =
15235: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15236: $args->{'ccdomain'},
15237: 'userroles',['active'],[$ccrole],
15238: [$args->{'clonedomain'}]);
15239: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15240: $can_clone = 1;
15241: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15242: $args->{'ccuname'},$args->{'ccdomain'})) {
15243: $can_clone = 1;
1.1221 raeburn 15244: }
15245: }
15246: unless ($can_clone) {
15247: if ($args->{'crstype'} eq 'Community') {
15248: $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'});
1.942 raeburn 15249: } else {
1.1221 raeburn 15250: $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'});
15251: }
1.566 albertel 15252: }
1.578 raeburn 15253: }
1.566 albertel 15254: }
15255: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15256: }
15257:
1.444 albertel 15258: sub construct_course {
1.1166 raeburn 15259: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 15260: my $outcome;
1.541 raeburn 15261: my $linefeed = '<br />'."\n";
15262: if ($context eq 'auto') {
15263: $linefeed = "\n";
15264: }
1.566 albertel 15265:
15266: #
15267: # Are we cloning?
15268: #
15269: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15270: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15271: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15272: if ($context ne 'auto') {
1.578 raeburn 15273: if ($clonemsg ne '') {
15274: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15275: }
1.566 albertel 15276: }
15277: $outcome .= $clonemsg.$linefeed;
15278:
15279: if (!$can_clone) {
15280: return (0,$outcome);
15281: }
15282: }
15283:
1.444 albertel 15284: #
15285: # Open course
15286: #
1.1239 raeburn 15287: my $showncrstype;
15288: if ($args->{'crstype'} eq 'Placement') {
15289: $showncrstype = 'placement test';
15290: } else {
15291: $showncrstype = lc($args->{'crstype'});
15292: }
1.444 albertel 15293: my %cenv=();
15294: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15295: $args->{'cdescr'},
15296: $args->{'curl'},
15297: $args->{'course_home'},
15298: $args->{'nonstandard'},
15299: $args->{'crscode'},
15300: $args->{'ccuname'}.':'.
15301: $args->{'ccdomain'},
1.882 raeburn 15302: $args->{'crstype'},
1.885 raeburn 15303: $cnum,$context,$category);
1.444 albertel 15304:
15305: # Note: The testing routines depend on this being output; see
15306: # Utils::Course. This needs to at least be output as a comment
15307: # if anyone ever decides to not show this, and Utils::Course::new
15308: # will need to be suitably modified.
1.1239 raeburn 15309: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 15310: if ($$courseid =~ /^error:/) {
15311: return (0,$outcome);
15312: }
15313:
1.444 albertel 15314: #
15315: # Check if created correctly
15316: #
1.479 albertel 15317: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15318: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15319: if ($crsuhome eq 'no_host') {
15320: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15321: return (0,$outcome);
15322: }
1.541 raeburn 15323: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15324:
1.444 albertel 15325: #
1.566 albertel 15326: # Do the cloning
15327: #
15328: if ($can_clone && $cloneid) {
1.1239 raeburn 15329: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 15330: if ($context ne 'auto') {
15331: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15332: }
15333: $outcome .= $clonemsg.$linefeed;
15334: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15335: # Copy all files
1.637 www 15336: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15337: # Restore URL
1.566 albertel 15338: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15339: # Restore title
1.566 albertel 15340: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15341: # Restore creation date, creator and creation context.
15342: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15343: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15344: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15345: # Mark as cloned
1.566 albertel 15346: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15347: # Need to clone grading mode
15348: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15349: $cenv{'grading'}=$newenv{'grading'};
15350: # Do not clone these environment entries
15351: &Apache::lonnet::del('environment',
15352: ['default_enrollment_start_date',
15353: 'default_enrollment_end_date',
15354: 'question.email',
15355: 'policy.email',
15356: 'comment.email',
15357: 'pch.users.denied',
1.725 raeburn 15358: 'plc.users.denied',
15359: 'hidefromcat',
1.1121 raeburn 15360: 'checkforpriv',
1.1166 raeburn 15361: 'categories',
15362: 'internal.uniquecode'],
1.638 www 15363: $$crsudom,$$crsunum);
1.1170 raeburn 15364: if ($args->{'textbook'}) {
15365: $cenv{'internal.textbook'} = $args->{'textbook'};
15366: }
1.444 albertel 15367: }
1.566 albertel 15368:
1.444 albertel 15369: #
15370: # Set environment (will override cloned, if existing)
15371: #
15372: my @sections = ();
15373: my @xlists = ();
15374: if ($args->{'crstype'}) {
15375: $cenv{'type'}=$args->{'crstype'};
15376: }
15377: if ($args->{'crsid'}) {
15378: $cenv{'courseid'}=$args->{'crsid'};
15379: }
15380: if ($args->{'crscode'}) {
15381: $cenv{'internal.coursecode'}=$args->{'crscode'};
15382: }
15383: if ($args->{'crsquota'} ne '') {
15384: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15385: } else {
15386: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15387: }
15388: if ($args->{'ccuname'}) {
15389: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15390: ':'.$args->{'ccdomain'};
15391: } else {
15392: $cenv{'internal.courseowner'} = $args->{'curruser'};
15393: }
1.1116 raeburn 15394: if ($args->{'defaultcredits'}) {
15395: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15396: }
1.444 albertel 15397: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15398: if ($args->{'crssections'}) {
15399: $cenv{'internal.sectionnums'} = '';
15400: if ($args->{'crssections'} =~ m/,/) {
15401: @sections = split/,/,$args->{'crssections'};
15402: } else {
15403: $sections[0] = $args->{'crssections'};
15404: }
15405: if (@sections > 0) {
15406: foreach my $item (@sections) {
15407: my ($sec,$gp) = split/:/,$item;
15408: my $class = $args->{'crscode'}.$sec;
15409: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15410: $cenv{'internal.sectionnums'} .= $item.',';
15411: unless ($addcheck eq 'ok') {
15412: push @badclasses, $class;
15413: }
15414: }
15415: $cenv{'internal.sectionnums'} =~ s/,$//;
15416: }
15417: }
15418: # do not hide course coordinator from staff listing,
15419: # even if privileged
15420: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15421: # add course coordinator's domain to domains to check for privileged users
15422: # if different to course domain
15423: if ($$crsudom ne $args->{'ccdomain'}) {
15424: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15425: }
1.444 albertel 15426: # add crosslistings
15427: if ($args->{'crsxlist'}) {
15428: $cenv{'internal.crosslistings'}='';
15429: if ($args->{'crsxlist'} =~ m/,/) {
15430: @xlists = split/,/,$args->{'crsxlist'};
15431: } else {
15432: $xlists[0] = $args->{'crsxlist'};
15433: }
15434: if (@xlists > 0) {
15435: foreach my $item (@xlists) {
15436: my ($xl,$gp) = split/:/,$item;
15437: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15438: $cenv{'internal.crosslistings'} .= $item.',';
15439: unless ($addcheck eq 'ok') {
15440: push @badclasses, $xl;
15441: }
15442: }
15443: $cenv{'internal.crosslistings'} =~ s/,$//;
15444: }
15445: }
15446: if ($args->{'autoadds'}) {
15447: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15448: }
15449: if ($args->{'autodrops'}) {
15450: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15451: }
15452: # check for notification of enrollment changes
15453: my @notified = ();
15454: if ($args->{'notify_owner'}) {
15455: if ($args->{'ccuname'} ne '') {
15456: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15457: }
15458: }
15459: if ($args->{'notify_dc'}) {
15460: if ($uname ne '') {
1.630 raeburn 15461: push(@notified,$uname.':'.$udom);
1.444 albertel 15462: }
15463: }
15464: if (@notified > 0) {
15465: my $notifylist;
15466: if (@notified > 1) {
15467: $notifylist = join(',',@notified);
15468: } else {
15469: $notifylist = $notified[0];
15470: }
15471: $cenv{'internal.notifylist'} = $notifylist;
15472: }
15473: if (@badclasses > 0) {
15474: my %lt=&Apache::lonlocal::texthash(
15475: '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',
15476: 'dnhr' => 'does not have rights to access enrollment in these classes',
15477: 'adby' => 'as determined by the policies of your institution on access to official classlists'
15478: );
1.541 raeburn 15479: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
15480: ' ('.$lt{'adby'}.')';
15481: if ($context eq 'auto') {
15482: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 15483: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 15484: foreach my $item (@badclasses) {
15485: if ($context eq 'auto') {
15486: $outcome .= " - $item\n";
15487: } else {
15488: $outcome .= "<li>$item</li>\n";
15489: }
15490: }
15491: if ($context eq 'auto') {
15492: $outcome .= $linefeed;
15493: } else {
1.566 albertel 15494: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15495: }
15496: }
1.444 albertel 15497: }
15498: if ($args->{'no_end_date'}) {
15499: $args->{'endaccess'} = 0;
15500: }
15501: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15502: $cenv{'internal.autoend'}=$args->{'enrollend'};
15503: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15504: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15505: if ($args->{'showphotos'}) {
15506: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15507: }
15508: $cenv{'internal.authtype'} = $args->{'authtype'};
15509: $cenv{'internal.autharg'} = $args->{'autharg'};
15510: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15511: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15512: 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');
15513: if ($context eq 'auto') {
15514: $outcome .= $krb_msg;
15515: } else {
1.566 albertel 15516: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15517: }
15518: $outcome .= $linefeed;
1.444 albertel 15519: }
15520: }
15521: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15522: if ($args->{'setpolicy'}) {
15523: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15524: }
15525: if ($args->{'setcontent'}) {
15526: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15527: }
1.1251 raeburn 15528: if ($args->{'setcomment'}) {
15529: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15530: }
1.444 albertel 15531: }
15532: if ($args->{'reshome'}) {
15533: $cenv{'reshome'}=$args->{'reshome'}.'/';
15534: $cenv{'reshome'}=~s/\/+$/\//;
15535: }
15536: #
15537: # course has keyed access
15538: #
15539: if ($args->{'setkeys'}) {
15540: $cenv{'keyaccess'}='yes';
15541: }
15542: # if specified, key authority is not course, but user
15543: # only active if keyaccess is yes
15544: if ($args->{'keyauth'}) {
1.487 albertel 15545: my ($user,$domain) = split(':',$args->{'keyauth'});
15546: $user = &LONCAPA::clean_username($user);
15547: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15548: if ($user ne '' && $domain ne '') {
1.487 albertel 15549: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15550: }
15551: }
15552:
1.1166 raeburn 15553: #
1.1167 raeburn 15554: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 15555: #
15556: if ($args->{'uniquecode'}) {
15557: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15558: if ($code) {
15559: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 15560: my %crsinfo =
15561: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15562: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15563: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15564: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15565: }
1.1166 raeburn 15566: if (ref($coderef)) {
15567: $$coderef = $code;
15568: }
15569: }
15570: }
15571:
1.444 albertel 15572: if ($args->{'disresdis'}) {
15573: $cenv{'pch.roles.denied'}='st';
15574: }
15575: if ($args->{'disablechat'}) {
15576: $cenv{'plc.roles.denied'}='st';
15577: }
15578:
15579: # Record we've not yet viewed the Course Initialization Helper for this
15580: # course
15581: $cenv{'course.helper.not.run'} = 1;
15582: #
15583: # Use new Randomseed
15584: #
15585: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15586: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15587: #
15588: # The encryption code and receipt prefix for this course
15589: #
15590: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15591: $cenv{'internal.encpref'}=100+int(9*rand(99));
15592: #
15593: # By default, use standard grading
15594: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15595:
1.541 raeburn 15596: $outcome .= $linefeed.&mt('Setting environment').': '.
15597: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15598: #
15599: # Open all assignments
15600: #
15601: if ($args->{'openall'}) {
15602: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15603: my %storecontent = ($storeunder => time,
15604: $storeunder.'.type' => 'date_start');
15605:
15606: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15607: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15608: }
15609: #
15610: # Set first page
15611: #
15612: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15613: || ($cloneid)) {
1.445 albertel 15614: use LONCAPA::map;
1.444 albertel 15615: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15616:
15617: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15618: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15619:
1.444 albertel 15620: $outcome .= ($fatal?$errtext:'read ok').' - ';
15621: my $title; my $url;
15622: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15623: $title=&mt('Syllabus');
1.444 albertel 15624: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15625: } else {
1.963 raeburn 15626: $title=&mt('Table of Contents');
1.444 albertel 15627: $url='/adm/navmaps';
15628: }
1.445 albertel 15629:
15630: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15631: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15632:
15633: if ($errtext) { $fatal=2; }
1.541 raeburn 15634: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15635: }
1.566 albertel 15636:
1.1237 raeburn 15637: #
15638: # Set params for Placement Tests
15639: #
1.1239 raeburn 15640: if ($args->{'crstype'} eq 'Placement') {
15641: my %storecontent;
15642: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
15643: my %defaults = (
15644: buttonshide => { value => 'yes',
15645: type => 'string_yesno',},
15646: type => { value => 'randomizetry',
15647: type => 'string_questiontype',},
15648: maxtries => { value => 1,
15649: type => 'int_pos',},
15650: problemstatus => { value => 'no',
15651: type => 'string_problemstatus',},
15652: );
15653: foreach my $key (keys(%defaults)) {
15654: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
15655: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
15656: }
1.1237 raeburn 15657: &Apache::lonnet::cput
15658: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
15659: }
15660:
1.566 albertel 15661: return (1,$outcome);
1.444 albertel 15662: }
15663:
1.1166 raeburn 15664: sub make_unique_code {
15665: my ($cdom,$cnum) = @_;
15666: # get lock on uniquecodes db
15667: my $lockhash = {
15668: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15669: ':'.$env{'user.domain'},
15670: };
15671: my $tries = 0;
15672: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15673: my ($code,$error);
15674:
15675: while (($gotlock ne 'ok') && ($tries<3)) {
15676: $tries ++;
15677: sleep 1;
15678: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15679: }
15680: if ($gotlock eq 'ok') {
15681: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15682: my $gotcode;
15683: my $attempts = 0;
15684: while ((!$gotcode) && ($attempts < 100)) {
15685: $code = &generate_code();
15686: if (!exists($currcodes{$code})) {
15687: $gotcode = 1;
15688: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15689: $error = 'nostore';
15690: }
15691: }
15692: $attempts ++;
15693: }
15694: my @del_lock = ($cnum."\0".'uniquecodes');
15695: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15696: } else {
15697: $error = 'nolock';
15698: }
15699: return ($code,$error);
15700: }
15701:
15702: sub generate_code {
15703: my $code;
15704: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15705: for (my $i=0; $i<6; $i++) {
15706: my $lettnum = int (rand 2);
15707: my $item = '';
15708: if ($lettnum) {
15709: $item = $letts[int( rand(18) )];
15710: } else {
15711: $item = 1+int( rand(8) );
15712: }
15713: $code .= $item;
15714: }
15715: return $code;
15716: }
15717:
1.444 albertel 15718: ############################################################
15719: ############################################################
15720:
1.1237 raeburn 15721: # Community, Course and Placement Test
1.378 raeburn 15722: sub course_type {
15723: my ($cid) = @_;
15724: if (!defined($cid)) {
15725: $cid = $env{'request.course.id'};
15726: }
1.404 albertel 15727: if (defined($env{'course.'.$cid.'.type'})) {
15728: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15729: } else {
15730: return 'Course';
1.377 raeburn 15731: }
15732: }
1.156 albertel 15733:
1.406 raeburn 15734: sub group_term {
15735: my $crstype = &course_type();
15736: my %names = (
15737: 'Course' => 'group',
1.865 raeburn 15738: 'Community' => 'group',
1.1237 raeburn 15739: 'Placement' => 'group',
1.406 raeburn 15740: );
15741: return $names{$crstype};
15742: }
15743:
1.902 raeburn 15744: sub course_types {
1.1237 raeburn 15745: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 15746: my %typename = (
15747: official => 'Official course',
15748: unofficial => 'Unofficial course',
15749: community => 'Community',
1.1165 raeburn 15750: textbook => 'Textbook course',
1.1237 raeburn 15751: placement => 'Placement test',
1.902 raeburn 15752: );
15753: return (\@types,\%typename);
15754: }
15755:
1.156 albertel 15756: sub icon {
15757: my ($file)=@_;
1.505 albertel 15758: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15759: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15760: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15761: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15762: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15763: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15764: $curfext.".gif") {
15765: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15766: $curfext.".gif";
15767: }
15768: }
1.249 albertel 15769: return &lonhttpdurl($iconname);
1.154 albertel 15770: }
1.84 albertel 15771:
1.575 albertel 15772: sub lonhttpdurl {
1.692 www 15773: #
15774: # Had been used for "small fry" static images on separate port 8080.
15775: # Modify here if lightweight http functionality desired again.
15776: # Currently eliminated due to increasing firewall issues.
15777: #
1.575 albertel 15778: my ($url)=@_;
1.692 www 15779: return $url;
1.215 albertel 15780: }
15781:
1.213 albertel 15782: sub connection_aborted {
15783: my ($r)=@_;
15784: $r->print(" ");$r->rflush();
15785: my $c = $r->connection;
15786: return $c->aborted();
15787: }
15788:
1.221 foxr 15789: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 15790: # strings as 'strings'.
15791: sub escape_single {
1.221 foxr 15792: my ($input) = @_;
1.223 albertel 15793: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 15794: $input =~ s/\'/\\\'/g; # Esacpe the 's....
15795: return $input;
15796: }
1.223 albertel 15797:
1.222 foxr 15798: # Same as escape_single, but escape's "'s This
15799: # can be used for "strings"
15800: sub escape_double {
15801: my ($input) = @_;
15802: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
15803: $input =~ s/\"/\\\"/g; # Esacpe the "s....
15804: return $input;
15805: }
1.223 albertel 15806:
1.222 foxr 15807: # Escapes the last element of a full URL.
15808: sub escape_url {
15809: my ($url) = @_;
1.238 raeburn 15810: my @urlslices = split(/\//, $url,-1);
1.369 www 15811: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 15812: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 15813: }
1.462 albertel 15814:
1.820 raeburn 15815: sub compare_arrays {
15816: my ($arrayref1,$arrayref2) = @_;
15817: my (@difference,%count);
15818: @difference = ();
15819: %count = ();
15820: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
15821: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
15822: foreach my $element (keys(%count)) {
15823: if ($count{$element} == 1) {
15824: push(@difference,$element);
15825: }
15826: }
15827: }
15828: return @difference;
15829: }
15830:
1.817 bisitz 15831: # -------------------------------------------------------- Initialize user login
1.462 albertel 15832: sub init_user_environment {
1.463 albertel 15833: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 15834: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
15835:
15836: my $public=($username eq 'public' && $domain eq 'public');
15837:
15838: # See if old ID present, if so, remove
15839:
1.1062 raeburn 15840: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 15841: my $now=time;
15842:
15843: if ($public) {
15844: my $max_public=100;
15845: my $oldest;
15846: my $oldest_time=0;
15847: for(my $next=1;$next<=$max_public;$next++) {
15848: if (-e $lonids."/publicuser_$next.id") {
15849: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15850: if ($mtime<$oldest_time || !$oldest_time) {
15851: $oldest_time=$mtime;
15852: $oldest=$next;
15853: }
15854: } else {
15855: $cookie="publicuser_$next";
15856: last;
15857: }
15858: }
15859: if (!$cookie) { $cookie="publicuser_$oldest"; }
15860: } else {
1.463 albertel 15861: # if this isn't a robot, kill any existing non-robot sessions
15862: if (!$args->{'robot'}) {
15863: opendir(DIR,$lonids);
15864: while ($filename=readdir(DIR)) {
15865: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15866: unlink($lonids.'/'.$filename);
15867: }
1.462 albertel 15868: }
1.463 albertel 15869: closedir(DIR);
1.1204 raeburn 15870: # If there is a undeleted lockfile for the user's paste buffer remove it.
15871: my $namespace = 'nohist_courseeditor';
15872: my $lockingkey = 'paste'."\0".'locked_num';
15873: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15874: $domain,$username);
15875: if (exists($lockhash{$lockingkey})) {
15876: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15877: unless ($delresult eq 'ok') {
15878: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15879: }
15880: }
1.462 albertel 15881: }
15882: # Give them a new cookie
1.463 albertel 15883: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15884: : $now.$$.int(rand(10000)));
1.463 albertel 15885: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15886:
15887: # Initialize roles
15888:
1.1062 raeburn 15889: ($userroles,$firstaccenv,$timerintenv) =
15890: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15891: }
15892: # ------------------------------------ Check browser type and MathML capability
15893:
1.1194 raeburn 15894: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15895: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15896:
15897: # ------------------------------------------------------------- Get environment
15898:
15899: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15900: my ($tmp) = keys(%userenv);
15901: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15902: } else {
15903: undef(%userenv);
15904: }
15905: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15906: $form->{'interface'}=$userenv{'interface'};
15907: }
15908: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15909:
15910: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15911: foreach my $option ('interface','localpath','localres') {
15912: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15913: }
15914: # --------------------------------------------------------- Write first profile
15915:
15916: {
15917: my %initial_env =
15918: ("user.name" => $username,
15919: "user.domain" => $domain,
15920: "user.home" => $authhost,
15921: "browser.type" => $clientbrowser,
15922: "browser.version" => $clientversion,
15923: "browser.mathml" => $clientmathml,
15924: "browser.unicode" => $clientunicode,
15925: "browser.os" => $clientos,
1.1137 raeburn 15926: "browser.mobile" => $clientmobile,
1.1141 raeburn 15927: "browser.info" => $clientinfo,
1.1194 raeburn 15928: "browser.osversion" => $clientosversion,
1.462 albertel 15929: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15930: "request.course.fn" => '',
15931: "request.course.uri" => '',
15932: "request.course.sec" => '',
15933: "request.role" => 'cm',
15934: "request.role.adv" => $env{'user.adv'},
15935: "request.host" => $ENV{'REMOTE_ADDR'},);
15936:
15937: if ($form->{'localpath'}) {
15938: $initial_env{"browser.localpath"} = $form->{'localpath'};
15939: $initial_env{"browser.localres"} = $form->{'localres'};
15940: }
15941:
15942: if ($form->{'interface'}) {
15943: $form->{'interface'}=~s/\W//gs;
15944: $initial_env{"browser.interface"} = $form->{'interface'};
15945: $env{'browser.interface'}=$form->{'interface'};
15946: }
15947:
1.1157 raeburn 15948: if ($form->{'iptoken'}) {
15949: my $lonhost = $r->dir_config('lonHostID');
15950: $initial_env{"user.noloadbalance"} = $lonhost;
15951: $env{'user.noloadbalance'} = $lonhost;
15952: }
15953:
1.981 raeburn 15954: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15955: my %domdef;
15956: unless ($domain eq 'public') {
15957: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15958: }
1.980 raeburn 15959:
1.1081 raeburn 15960: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15961: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15962: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15963: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15964: }
15965:
1.1237 raeburn 15966: foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765 raeburn 15967: $userenv{'canrequest.'.$crstype} =
15968: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15969: 'reload','requestcourses',
15970: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15971: }
15972:
1.1092 raeburn 15973: $userenv{'canrequest.author'} =
15974: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15975: 'reload','requestauthor',
15976: \%userenv,\%domdef,\%is_adv);
15977: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15978: $domain,$username);
15979: my $reqstatus = $reqauthor{'author_status'};
15980: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15981: if (ref($reqauthor{'author'}) eq 'HASH') {
15982: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15983: $reqauthor{'author'}{'timestamp'};
15984: }
15985: }
15986:
1.462 albertel 15987: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15988:
1.462 albertel 15989: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15990: &GDBM_WRCREAT(),0640)) {
15991: &_add_to_env(\%disk_env,\%initial_env);
15992: &_add_to_env(\%disk_env,\%userenv,'environment.');
15993: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15994: if (ref($firstaccenv) eq 'HASH') {
15995: &_add_to_env(\%disk_env,$firstaccenv);
15996: }
15997: if (ref($timerintenv) eq 'HASH') {
15998: &_add_to_env(\%disk_env,$timerintenv);
15999: }
1.463 albertel 16000: if (ref($args->{'extra_env'})) {
16001: &_add_to_env(\%disk_env,$args->{'extra_env'});
16002: }
1.462 albertel 16003: untie(%disk_env);
16004: } else {
1.705 tempelho 16005: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16006: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16007: return 'error: '.$!;
16008: }
16009: }
16010: $env{'request.role'}='cm';
16011: $env{'request.role.adv'}=$env{'user.adv'};
16012: $env{'browser.type'}=$clientbrowser;
16013:
16014: return $cookie;
16015:
16016: }
16017:
16018: sub _add_to_env {
16019: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16020: if (ref($env_data) eq 'HASH') {
16021: while (my ($key,$value) = each(%$env_data)) {
16022: $idf->{$prefix.$key} = $value;
16023: $env{$prefix.$key} = $value;
16024: }
1.462 albertel 16025: }
16026: }
16027:
1.685 tempelho 16028: # --- Get the symbolic name of a problem and the url
16029: sub get_symb {
16030: my ($request,$silent) = @_;
1.726 raeburn 16031: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16032: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16033: if ($symb eq '') {
16034: if (!$silent) {
1.1071 raeburn 16035: if (ref($request)) {
16036: $request->print("Unable to handle ambiguous references:$url:.");
16037: }
1.685 tempelho 16038: return ();
16039: }
16040: }
16041: &Apache::lonenc::check_decrypt(\$symb);
16042: return ($symb);
16043: }
16044:
16045: # --------------------------------------------------------------Get annotation
16046:
16047: sub get_annotation {
16048: my ($symb,$enc) = @_;
16049:
16050: my $key = $symb;
16051: if (!$enc) {
16052: $key =
16053: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16054: }
16055: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16056: return $annotation{$key};
16057: }
16058:
16059: sub clean_symb {
1.731 raeburn 16060: my ($symb,$delete_enc) = @_;
1.685 tempelho 16061:
16062: &Apache::lonenc::check_decrypt(\$symb);
16063: my $enc = $env{'request.enc'};
1.731 raeburn 16064: if ($delete_enc) {
1.730 raeburn 16065: delete($env{'request.enc'});
16066: }
1.685 tempelho 16067:
16068: return ($symb,$enc);
16069: }
1.462 albertel 16070:
1.1181 raeburn 16071: ############################################################
16072: ############################################################
16073:
16074: =pod
16075:
16076: =head1 Routines for building display used to search for courses
16077:
16078:
16079: =over 4
16080:
16081: =item * &build_filters()
16082:
16083: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16084: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16085: and quotacheck.pl
16086:
1.1181 raeburn 16087:
16088: Inputs:
16089:
16090: filterlist - anonymous array of fields to include as potential filters
16091:
16092: crstype - course type
16093:
16094: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16095: to pop-open a course selector (will contain "extra element").
16096:
16097: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16098:
16099: filter - anonymous hash of criteria and their values
16100:
16101: action - form action
16102:
16103: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16104:
1.1182 raeburn 16105: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16106:
16107: cloneruname - username of owner of new course who wants to clone
16108:
16109: clonerudom - domain of owner of new course who wants to clone
16110:
16111: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16112:
16113: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16114:
16115: codedom - domain
16116:
16117: formname - value of form element named "form".
16118:
16119: fixeddom - domain, if fixed.
16120:
16121: prevphase - value to assign to form element named "phase" when going back to the previous screen
16122:
16123: cnameelement - name of form element in form on opener page which will receive title of selected course
16124:
16125: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16126:
16127: cdomelement - name of form element in form on opener page which will receive domain of selected course
16128:
16129: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16130:
16131: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16132:
16133: clonewarning - warning message about missing information for intended course owner when DC creates a course
16134:
1.1182 raeburn 16135:
1.1181 raeburn 16136: Returns: $output - HTML for display of search criteria, and hidden form elements.
16137:
1.1182 raeburn 16138:
1.1181 raeburn 16139: Side Effects: None
16140:
16141: =cut
16142:
16143: # ---------------------------------------------- search for courses based on last activity etc.
16144:
16145: sub build_filters {
16146: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16147: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16148: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16149: $cnameelement,$cnumelement,$cdomelement,$setroles,
16150: $clonetext,$clonewarning) = @_;
1.1182 raeburn 16151: my ($list,$jscript);
1.1181 raeburn 16152: my $onchange = 'javascript:updateFilters(this)';
16153: my ($domainselectform,$sincefilterform,$createdfilterform,
16154: $ownerdomselectform,$persondomselectform,$instcodeform,
16155: $typeselectform,$instcodetitle);
16156: if ($formname eq '') {
16157: $formname = $caller;
16158: }
16159: foreach my $item (@{$filterlist}) {
16160: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16161: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16162: if ($item eq 'domainfilter') {
16163: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16164: } elsif ($item eq 'coursefilter') {
16165: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16166: } elsif ($item eq 'ownerfilter') {
16167: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16168: } elsif ($item eq 'ownerdomfilter') {
16169: $filter->{'ownerdomfilter'} =
16170: &LONCAPA::clean_domain($filter->{$item});
16171: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16172: 'ownerdomfilter',1);
16173: } elsif ($item eq 'personfilter') {
16174: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16175: } elsif ($item eq 'persondomfilter') {
16176: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16177: 'persondomfilter',1);
16178: } else {
16179: $filter->{$item} =~ s/\W//g;
16180: }
16181: if (!$filter->{$item}) {
16182: $filter->{$item} = '';
16183: }
16184: }
16185: if ($item eq 'domainfilter') {
16186: my $allow_blank = 1;
16187: if ($formname eq 'portform') {
16188: $allow_blank=0;
16189: } elsif ($formname eq 'studentform') {
16190: $allow_blank=0;
16191: }
16192: if ($fixeddom) {
16193: $domainselectform = '<input type="hidden" name="domainfilter"'.
16194: ' value="'.$codedom.'" />'.
16195: &Apache::lonnet::domain($codedom,'description');
16196: } else {
16197: $domainselectform = &select_dom_form($filter->{$item},
16198: 'domainfilter',
16199: $allow_blank,'',$onchange);
16200: }
16201: } else {
16202: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16203: }
16204: }
16205:
16206: # last course activity filter and selection
16207: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16208:
16209: # course created filter and selection
16210: if (exists($filter->{'createdfilter'})) {
16211: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16212: }
16213:
1.1239 raeburn 16214: my $prefix = $crstype;
16215: if ($crstype eq 'Placement') {
16216: $prefix = 'Placement Test'
16217: }
1.1181 raeburn 16218: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 16219: 'cac' => "$prefix Activity",
16220: 'ccr' => "$prefix Created",
16221: 'cde' => "$prefix Title",
16222: 'cdo' => "$prefix Domain",
1.1181 raeburn 16223: 'ins' => 'Institutional Code',
16224: 'inc' => 'Institutional Categorization',
1.1239 raeburn 16225: 'cow' => "$prefix Owner/Co-owner",
16226: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 16227: 'cog' => 'Type',
16228: );
16229:
16230: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16231: my $typeval = 'Course';
16232: if ($crstype eq 'Community') {
16233: $typeval = 'Community';
1.1239 raeburn 16234: } elsif ($crstype eq 'Placement') {
16235: $typeval = 'Placement';
1.1181 raeburn 16236: }
16237: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16238: } else {
16239: $typeselectform = '<select name="type" size="1"';
16240: if ($onchange) {
16241: $typeselectform .= ' onchange="'.$onchange.'"';
16242: }
16243: $typeselectform .= '>'."\n";
1.1237 raeburn 16244: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 16245: my $shown;
16246: if ($posstype eq 'Placement') {
16247: $shown = &mt('Placement Test');
16248: } else {
16249: $shown = &mt($posstype);
16250: }
1.1181 raeburn 16251: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 16252: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 16253: }
16254: $typeselectform.="</select>";
16255: }
16256:
16257: my ($cloneableonlyform,$cloneabletitle);
16258: if (exists($filter->{'cloneableonly'})) {
16259: my $cloneableon = '';
16260: my $cloneableoff = ' checked="checked"';
16261: if ($filter->{'cloneableonly'}) {
16262: $cloneableon = $cloneableoff;
16263: $cloneableoff = '';
16264: }
16265: $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>';
16266: if ($formname eq 'ccrs') {
1.1187 bisitz 16267: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 16268: } else {
16269: $cloneabletitle = &mt('Cloneable by you');
16270: }
16271: }
16272: my $officialjs;
16273: if ($crstype eq 'Course') {
16274: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 16275: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16276: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16277: if ($codedom) {
1.1181 raeburn 16278: $officialjs = 1;
16279: ($instcodeform,$jscript,$$numtitlesref) =
16280: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16281: $officialjs,$codetitlesref);
16282: if ($jscript) {
1.1182 raeburn 16283: $jscript = '<script type="text/javascript">'."\n".
16284: '// <![CDATA['."\n".
16285: $jscript."\n".
16286: '// ]]>'."\n".
16287: '</script>'."\n";
1.1181 raeburn 16288: }
16289: }
16290: if ($instcodeform eq '') {
16291: $instcodeform =
16292: '<input type="text" name="instcodefilter" size="10" value="'.
16293: $list->{'instcodefilter'}.'" />';
16294: $instcodetitle = $lt{'ins'};
16295: } else {
16296: $instcodetitle = $lt{'inc'};
16297: }
16298: if ($fixeddom) {
16299: $instcodetitle .= '<br />('.$codedom.')';
16300: }
16301: }
16302: }
16303: my $output = qq|
16304: <form method="post" name="filterpicker" action="$action">
16305: <input type="hidden" name="form" value="$formname" />
16306: |;
16307: if ($formname eq 'modifycourse') {
16308: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16309: '<input type="hidden" name="prevphase" value="'.
16310: $prevphase.'" />'."\n";
1.1198 musolffc 16311: } elsif ($formname eq 'quotacheck') {
16312: $output .= qq|
16313: <input type="hidden" name="sortby" value="" />
16314: <input type="hidden" name="sortorder" value="" />
16315: |;
16316: } else {
1.1181 raeburn 16317: my $name_input;
16318: if ($cnameelement ne '') {
16319: $name_input = '<input type="hidden" name="cnameelement" value="'.
16320: $cnameelement.'" />';
16321: }
16322: $output .= qq|
1.1182 raeburn 16323: <input type="hidden" name="cnumelement" value="$cnumelement" />
16324: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 16325: $name_input
16326: $roleelement
16327: $multelement
16328: $typeelement
16329: |;
16330: if ($formname eq 'portform') {
16331: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16332: }
16333: }
16334: if ($fixeddom) {
16335: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16336: }
16337: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16338: if ($sincefilterform) {
16339: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16340: .$sincefilterform
16341: .&Apache::lonhtmlcommon::row_closure();
16342: }
16343: if ($createdfilterform) {
16344: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16345: .$createdfilterform
16346: .&Apache::lonhtmlcommon::row_closure();
16347: }
16348: if ($domainselectform) {
16349: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16350: .$domainselectform
16351: .&Apache::lonhtmlcommon::row_closure();
16352: }
16353: if ($typeselectform) {
16354: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16355: $output .= $typeselectform;
16356: } else {
16357: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16358: .$typeselectform
16359: .&Apache::lonhtmlcommon::row_closure();
16360: }
16361: }
16362: if ($instcodeform) {
16363: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16364: .$instcodeform
16365: .&Apache::lonhtmlcommon::row_closure();
16366: }
16367: if (exists($filter->{'ownerfilter'})) {
16368: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16369: '<table><tr><td>'.&mt('Username').'<br />'.
16370: '<input type="text" name="ownerfilter" size="20" value="'.
16371: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16372: $ownerdomselectform.'</td></tr></table>'.
16373: &Apache::lonhtmlcommon::row_closure();
16374: }
16375: if (exists($filter->{'personfilter'})) {
16376: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16377: '<table><tr><td>'.&mt('Username').'<br />'.
16378: '<input type="text" name="personfilter" size="20" value="'.
16379: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16380: $persondomselectform.'</td></tr></table>'.
16381: &Apache::lonhtmlcommon::row_closure();
16382: }
16383: if (exists($filter->{'coursefilter'})) {
16384: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16385: .'<input type="text" name="coursefilter" size="25" value="'
16386: .$list->{'coursefilter'}.'" />'
16387: .&Apache::lonhtmlcommon::row_closure();
16388: }
16389: if ($cloneableonlyform) {
16390: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16391: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16392: }
16393: if (exists($filter->{'descriptfilter'})) {
16394: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16395: .'<input type="text" name="descriptfilter" size="40" value="'
16396: .$list->{'descriptfilter'}.'" />'
16397: .&Apache::lonhtmlcommon::row_closure(1);
16398: }
16399: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16400: '<input type="hidden" name="updater" value="" />'."\n".
16401: '<input type="submit" name="gosearch" value="'.
16402: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16403: return $jscript.$clonewarning.$output;
16404: }
16405:
16406: =pod
16407:
16408: =item * &timebased_select_form()
16409:
1.1182 raeburn 16410: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 16411: filter e.g., Course Activity, Course Created, when searching for courses
16412: or communities
16413:
16414: Inputs:
16415:
16416: item - name of form element (sincefilter or createdfilter)
16417:
16418: filter - anonymous hash of criteria and their values
16419:
16420: Returns: HTML for a select box contained a blank, then six time selections,
16421: with value set in incoming form variables currently selected.
16422:
16423: Side Effects: None
16424:
16425: =cut
16426:
16427: sub timebased_select_form {
16428: my ($item,$filter) = @_;
16429: if (ref($filter) eq 'HASH') {
16430: $filter->{$item} =~ s/[^\d-]//g;
16431: if (!$filter->{$item}) { $filter->{$item}=-1; }
16432: return &select_form(
16433: $filter->{$item},
16434: $item,
16435: { '-1' => '',
16436: '86400' => &mt('today'),
16437: '604800' => &mt('last week'),
16438: '2592000' => &mt('last month'),
16439: '7776000' => &mt('last three months'),
16440: '15552000' => &mt('last six months'),
16441: '31104000' => &mt('last year'),
16442: 'select_form_order' =>
16443: ['-1','86400','604800','2592000','7776000',
16444: '15552000','31104000']});
16445: }
16446: }
16447:
16448: =pod
16449:
16450: =item * &js_changer()
16451:
16452: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 16453: when course type or domain is changed, and also to hide 'Searching ...' on
16454: page load completion for page showing search result.
1.1181 raeburn 16455:
16456: Inputs: None
16457:
1.1183 raeburn 16458: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16459:
16460: Side Effects: None
16461:
16462: =cut
16463:
16464: sub js_changer {
16465: return <<ENDJS;
16466: <script type="text/javascript">
16467: // <![CDATA[
16468: function updateFilters(caller) {
16469: if (typeof(caller) != "undefined") {
16470: document.filterpicker.updater.value = caller.name;
16471: }
16472: document.filterpicker.submit();
16473: }
1.1183 raeburn 16474:
16475: function hideSearching() {
16476: if (document.getElementById('searching')) {
16477: document.getElementById('searching').style.display = 'none';
16478: }
16479: return;
16480: }
16481:
1.1181 raeburn 16482: // ]]>
16483: </script>
16484:
16485: ENDJS
16486: }
16487:
16488: =pod
16489:
1.1182 raeburn 16490: =item * &search_courses()
16491:
16492: Process selected filters form course search form and pass to lonnet::courseiddump
16493: to retrieve a hash for which keys are courseIDs which match the selected filters.
16494:
16495: Inputs:
16496:
16497: dom - domain being searched
16498:
16499: type - course type ('Course' or 'Community' or '.' if any).
16500:
16501: filter - anonymous hash of criteria and their values
16502:
16503: numtitles - for institutional codes - number of categories
16504:
16505: cloneruname - optional username of new course owner
16506:
16507: clonerudom - optional domain of new course owner
16508:
1.1221 raeburn 16509: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 16510: (used when DC is using course creation form)
16511:
16512: codetitles - reference to array of titles of components in institutional codes (official courses).
16513:
1.1221 raeburn 16514: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16515: (and so can clone automatically)
16516:
16517: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16518:
16519: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16520: courses to clone
1.1182 raeburn 16521:
16522: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16523:
16524:
16525: Side Effects: None
16526:
16527: =cut
16528:
16529:
16530: sub search_courses {
1.1221 raeburn 16531: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16532: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 16533: my (%courses,%showcourses,$cloner);
16534: if (($filter->{'ownerfilter'} ne '') ||
16535: ($filter->{'ownerdomfilter'} ne '')) {
16536: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16537: $filter->{'ownerdomfilter'};
16538: }
16539: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16540: if (!$filter->{$item}) {
16541: $filter->{$item}='.';
16542: }
16543: }
16544: my $now = time;
16545: my $timefilter =
16546: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16547: my ($createdbefore,$createdafter);
16548: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16549: $createdbefore = $now;
16550: $createdafter = $now-$filter->{'createdfilter'};
16551: }
16552: my ($instcodefilter,$regexpok);
16553: if ($numtitles) {
16554: if ($env{'form.official'} eq 'on') {
16555: $instcodefilter =
16556: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16557: $regexpok = 1;
16558: } elsif ($env{'form.official'} eq 'off') {
16559: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16560: unless ($instcodefilter eq '') {
16561: $regexpok = -1;
16562: }
16563: }
16564: } else {
16565: $instcodefilter = $filter->{'instcodefilter'};
16566: }
16567: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16568: if ($type eq '') { $type = '.'; }
16569:
16570: if (($clonerudom ne '') && ($cloneruname ne '')) {
16571: $cloner = $cloneruname.':'.$clonerudom;
16572: }
16573: %courses = &Apache::lonnet::courseiddump($dom,
16574: $filter->{'descriptfilter'},
16575: $timefilter,
16576: $instcodefilter,
16577: $filter->{'combownerfilter'},
16578: $filter->{'coursefilter'},
16579: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 16580: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 16581: $filter->{'cloneableonly'},
16582: $createdbefore,$createdafter,undef,
1.1221 raeburn 16583: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 16584: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16585: my $ccrole;
16586: if ($type eq 'Community') {
16587: $ccrole = 'co';
16588: } else {
16589: $ccrole = 'cc';
16590: }
16591: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16592: $filter->{'persondomfilter'},
16593: 'userroles',undef,
16594: [$ccrole,'in','ad','ep','ta','cr'],
16595: $dom);
16596: foreach my $role (keys(%rolehash)) {
16597: my ($cnum,$cdom,$courserole) = split(':',$role);
16598: my $cid = $cdom.'_'.$cnum;
16599: if (exists($courses{$cid})) {
16600: if (ref($courses{$cid}) eq 'HASH') {
16601: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16602: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
16603: push (@{$courses{$cid}{roles}},$courserole);
16604: }
16605: } else {
16606: $courses{$cid}{roles} = [$courserole];
16607: }
16608: $showcourses{$cid} = $courses{$cid};
16609: }
16610: }
16611: }
16612: %courses = %showcourses;
16613: }
16614: return %courses;
16615: }
16616:
16617: =pod
16618:
1.1181 raeburn 16619: =back
16620:
1.1207 raeburn 16621: =head1 Routines for version requirements for current course.
16622:
16623: =over 4
16624:
16625: =item * &check_release_required()
16626:
16627: Compares required LON-CAPA version with version on server, and
16628: if required version is newer looks for a server with the required version.
16629:
16630: Looks first at servers in user's owen domain; if none suitable, looks at
16631: servers in course's domain are permitted to host sessions for user's domain.
16632:
16633: Inputs:
16634:
16635: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16636:
16637: $courseid - Course ID of current course
16638:
16639: $rolecode - User's current role in course (for switchserver query string).
16640:
16641: $required - LON-CAPA version needed by course (format: Major.Minor).
16642:
16643:
16644: Returns:
16645:
16646: $switchserver - query string tp append to /adm/switchserver call (if
16647: current server's LON-CAPA version is too old.
16648:
16649: $warning - Message is displayed if no suitable server could be found.
16650:
16651: =cut
16652:
16653: sub check_release_required {
16654: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16655: my ($switchserver,$warning);
16656: if ($required ne '') {
16657: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16658: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16659: if ($reqdmajor ne '' && $reqdminor ne '') {
16660: my $otherserver;
16661: if (($major eq '' && $minor eq '') ||
16662: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16663: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16664: my $switchlcrev =
16665: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16666: $userdomserver);
16667: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16668: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16669: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16670: my $cdom = $env{'course.'.$courseid.'.domain'};
16671: if ($cdom ne $env{'user.domain'}) {
16672: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16673: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16674: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16675: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16676: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16677: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16678: my $canhost =
16679: &Apache::lonnet::can_host_session($env{'user.domain'},
16680: $coursedomserver,
16681: $remoterev,
16682: $udomdefaults{'remotesessions'},
16683: $defdomdefaults{'hostedsessions'});
16684:
16685: if ($canhost) {
16686: $otherserver = $coursedomserver;
16687: } else {
16688: $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.");
16689: }
16690: } else {
16691: $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).");
16692: }
16693: } else {
16694: $otherserver = $userdomserver;
16695: }
16696: }
16697: if ($otherserver ne '') {
16698: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16699: }
16700: }
16701: }
16702: return ($switchserver,$warning);
16703: }
16704:
16705: =pod
16706:
16707: =item * &check_release_result()
16708:
16709: Inputs:
16710:
16711: $switchwarning - Warning message if no suitable server found to host session.
16712:
16713: $switchserver - query string to append to /adm/switchserver containing lonHostID
16714: and current role.
16715:
16716: Returns: HTML to display with information about requirement to switch server.
16717: Either displaying warning with link to Roles/Courses screen or
16718: display link to switchserver.
16719:
1.1181 raeburn 16720: =cut
16721:
1.1207 raeburn 16722: sub check_release_result {
16723: my ($switchwarning,$switchserver) = @_;
16724: my $output = &start_page('Selected course unavailable on this server').
16725: '<p class="LC_warning">';
16726: if ($switchwarning) {
16727: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16728: if (&show_course()) {
16729: $output .= &mt('Display courses');
16730: } else {
16731: $output .= &mt('Display roles');
16732: }
16733: $output .= '</a>';
16734: } elsif ($switchserver) {
16735: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
16736: '<br />'.
16737: '<a href="/adm/switchserver?'.$switchserver.'">'.
16738: &mt('Switch Server').
16739: '</a>';
16740: }
16741: $output .= '</p>'.&end_page();
16742: return $output;
16743: }
16744:
16745: =pod
16746:
16747: =item * &needs_coursereinit()
16748:
16749: Determine if course contents stored for user's session needs to be
16750: refreshed, because content has changed since "Big Hash" last tied.
16751:
16752: Check for change is made if time last checked is more than 10 minutes ago
16753: (by default).
16754:
16755: Inputs:
16756:
16757: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16758:
16759: $interval (optional) - Time which may elapse (in s) between last check for content
16760: change in current course. (default: 600 s).
16761:
16762: Returns: an array; first element is:
16763:
16764: =over 4
16765:
16766: 'switch' - if content updates mean user's session
16767: needs to be switched to a server running a newer LON-CAPA version
16768:
16769: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
16770: on current server hosting user's session
16771:
16772: '' - if no action required.
16773:
16774: =back
16775:
16776: If first item element is 'switch':
16777:
16778: second item is $switchwarning - Warning message if no suitable server found to host session.
16779:
16780: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
16781: and current role.
16782:
16783: otherwise: no other elements returned.
16784:
16785: =back
16786:
16787: =cut
16788:
16789: sub needs_coursereinit {
16790: my ($loncaparev,$interval) = @_;
16791: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
16792: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
16793: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
16794: my $now = time;
16795: if ($interval eq '') {
16796: $interval = 600;
16797: }
16798: if (($now-$env{'request.course.timechecked'})>$interval) {
16799: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
16800: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
16801: if ($lastchange > $env{'request.course.tied'}) {
16802: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16803: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
16804: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
16805: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
16806: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
16807: $curr_reqd_hash{'internal.releaserequired'}});
16808: my ($switchserver,$switchwarning) =
16809: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
16810: $curr_reqd_hash{'internal.releaserequired'});
16811: if ($switchwarning ne '' || $switchserver ne '') {
16812: return ('switch',$switchwarning,$switchserver);
16813: }
16814: }
16815: }
16816: return ('update');
16817: }
16818: }
16819: return ();
16820: }
1.1181 raeburn 16821:
1.1083 raeburn 16822: sub update_content_constraints {
16823: my ($cdom,$cnum,$chome,$cid) = @_;
16824: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16825: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
16826: my %checkresponsetypes;
16827: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 16828: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 16829: if ($item eq 'resourcetag') {
16830: if ($name eq 'responsetype') {
16831: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
16832: }
16833: }
16834: }
16835: my $navmap = Apache::lonnavmaps::navmap->new();
16836: if (defined($navmap)) {
16837: my %allresponses;
16838: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
16839: my %responses = $res->responseTypes();
16840: foreach my $key (keys(%responses)) {
16841: next unless(exists($checkresponsetypes{$key}));
16842: $allresponses{$key} += $responses{$key};
16843: }
16844: }
16845: foreach my $key (keys(%allresponses)) {
16846: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
16847: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
16848: ($reqdmajor,$reqdminor) = ($major,$minor);
16849: }
16850: }
16851: undef($navmap);
16852: }
16853: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
16854: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
16855: }
16856: return;
16857: }
16858:
1.1110 raeburn 16859: sub allmaps_incourse {
16860: my ($cdom,$cnum,$chome,$cid) = @_;
16861: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
16862: $cid = $env{'request.course.id'};
16863: $cdom = $env{'course.'.$cid.'.domain'};
16864: $cnum = $env{'course.'.$cid.'.num'};
16865: $chome = $env{'course.'.$cid.'.home'};
16866: }
16867: my %allmaps = ();
16868: my $lastchange =
16869: &Apache::lonnet::get_coursechange($cdom,$cnum);
16870: if ($lastchange > $env{'request.course.tied'}) {
16871: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16872: unless ($ferr) {
16873: &update_content_constraints($cdom,$cnum,$chome,$cid);
16874: }
16875: }
16876: my $navmap = Apache::lonnavmaps::navmap->new();
16877: if (defined($navmap)) {
16878: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16879: $allmaps{$res->src()} = 1;
16880: }
16881: }
16882: return \%allmaps;
16883: }
16884:
1.1083 raeburn 16885: sub parse_supplemental_title {
16886: my ($title) = @_;
16887:
16888: my ($foldertitle,$renametitle);
16889: if ($title =~ /&&&/) {
16890: $title = &HTML::Entites::decode($title);
16891: }
16892: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16893: $renametitle=$4;
16894: my ($time,$uname,$udom) = ($1,$2,$3);
16895: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16896: my $name = &plainname($uname,$udom);
16897: $name = &HTML::Entities::encode($name,'"<>&\'');
16898: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16899: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16900: $name.': <br />'.$foldertitle;
16901: }
16902: if (wantarray) {
16903: return ($title,$foldertitle,$renametitle);
16904: }
16905: return $title;
16906: }
16907:
1.1143 raeburn 16908: sub recurse_supplemental {
16909: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16910: if ($suppmap) {
16911: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16912: if ($fatal) {
16913: $errors ++;
16914: } else {
16915: if ($#LONCAPA::map::resources > 0) {
16916: foreach my $res (@LONCAPA::map::resources) {
16917: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16918: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16919: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16920: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16921: } else {
16922: $numfiles ++;
16923: }
16924: }
16925: }
16926: }
16927: }
16928: }
16929: return ($numfiles,$errors);
16930: }
16931:
1.1101 raeburn 16932: sub symb_to_docspath {
16933: my ($symb) = @_;
16934: return unless ($symb);
16935: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16936: if ($resurl=~/\.(sequence|page)$/) {
16937: $mapurl=$resurl;
16938: } elsif ($resurl eq 'adm/navmaps') {
16939: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16940: }
16941: my $mapresobj;
16942: my $navmap = Apache::lonnavmaps::navmap->new();
16943: if (ref($navmap)) {
16944: $mapresobj = $navmap->getResourceByUrl($mapurl);
16945: }
16946: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16947: my $type=$2;
16948: my $path;
16949: if (ref($mapresobj)) {
16950: my $pcslist = $mapresobj->map_hierarchy();
16951: if ($pcslist ne '') {
16952: foreach my $pc (split(/,/,$pcslist)) {
16953: next if ($pc <= 1);
16954: my $res = $navmap->getByMapPc($pc);
16955: if (ref($res)) {
16956: my $thisurl = $res->src();
16957: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16958: my $thistitle = $res->title();
16959: $path .= '&'.
16960: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16961: &escape($thistitle).
1.1101 raeburn 16962: ':'.$res->randompick().
16963: ':'.$res->randomout().
16964: ':'.$res->encrypted().
16965: ':'.$res->randomorder().
16966: ':'.$res->is_page();
16967: }
16968: }
16969: }
16970: $path =~ s/^\&//;
16971: my $maptitle = $mapresobj->title();
16972: if ($mapurl eq 'default') {
1.1129 raeburn 16973: $maptitle = 'Main Content';
1.1101 raeburn 16974: }
16975: $path .= (($path ne '')? '&' : '').
16976: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16977: &escape($maptitle).
1.1101 raeburn 16978: ':'.$mapresobj->randompick().
16979: ':'.$mapresobj->randomout().
16980: ':'.$mapresobj->encrypted().
16981: ':'.$mapresobj->randomorder().
16982: ':'.$mapresobj->is_page();
16983: } else {
16984: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16985: my $ispage = (($type eq 'page')? 1 : '');
16986: if ($mapurl eq 'default') {
1.1129 raeburn 16987: $maptitle = 'Main Content';
1.1101 raeburn 16988: }
16989: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16990: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16991: }
16992: unless ($mapurl eq 'default') {
16993: $path = 'default&'.
1.1146 raeburn 16994: &escape('Main Content').
1.1101 raeburn 16995: ':::::&'.$path;
16996: }
16997: return $path;
16998: }
16999:
1.1094 raeburn 17000: sub captcha_display {
17001: my ($context,$lonhost) = @_;
17002: my ($output,$error);
1.1234 raeburn 17003: my ($captcha,$pubkey,$privkey,$version) =
17004: &get_captcha_config($context,$lonhost);
1.1095 raeburn 17005: if ($captcha eq 'original') {
1.1094 raeburn 17006: $output = &create_captcha();
17007: unless ($output) {
1.1172 raeburn 17008: $error = 'captcha';
1.1094 raeburn 17009: }
17010: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17011: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17012: unless ($output) {
1.1172 raeburn 17013: $error = 'recaptcha';
1.1094 raeburn 17014: }
17015: }
1.1234 raeburn 17016: return ($output,$error,$captcha,$version);
1.1094 raeburn 17017: }
17018:
17019: sub captcha_response {
17020: my ($context,$lonhost) = @_;
17021: my ($captcha_chk,$captcha_error);
1.1234 raeburn 17022: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 17023: if ($captcha eq 'original') {
1.1094 raeburn 17024: ($captcha_chk,$captcha_error) = &check_captcha();
17025: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17026: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17027: } else {
17028: $captcha_chk = 1;
17029: }
17030: return ($captcha_chk,$captcha_error);
17031: }
17032:
17033: sub get_captcha_config {
17034: my ($context,$lonhost) = @_;
1.1234 raeburn 17035: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17036: my $hostname = &Apache::lonnet::hostname($lonhost);
17037: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17038: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17039: if ($context eq 'usercreation') {
17040: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17041: if (ref($domconfig{$context}) eq 'HASH') {
17042: $hashtocheck = $domconfig{$context}{'cancreate'};
17043: if (ref($hashtocheck) eq 'HASH') {
17044: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17045: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17046: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17047: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17048: }
17049: if ($privkey && $pubkey) {
17050: $captcha = 'recaptcha';
1.1234 raeburn 17051: $version = $hashtocheck->{'recaptchaversion'};
17052: if ($version ne '2') {
17053: $version = 1;
17054: }
1.1095 raeburn 17055: } else {
17056: $captcha = 'original';
17057: }
17058: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17059: $captcha = 'original';
17060: }
1.1094 raeburn 17061: }
1.1095 raeburn 17062: } else {
17063: $captcha = 'captcha';
17064: }
17065: } elsif ($context eq 'login') {
17066: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17067: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17068: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17069: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17070: if ($privkey && $pubkey) {
17071: $captcha = 'recaptcha';
1.1234 raeburn 17072: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17073: if ($version ne '2') {
17074: $version = 1;
17075: }
1.1095 raeburn 17076: } else {
17077: $captcha = 'original';
1.1094 raeburn 17078: }
1.1095 raeburn 17079: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17080: $captcha = 'original';
1.1094 raeburn 17081: }
17082: }
1.1234 raeburn 17083: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 17084: }
17085:
17086: sub create_captcha {
17087: my %captcha_params = &captcha_settings();
17088: my ($output,$maxtries,$tries) = ('',10,0);
17089: while ($tries < $maxtries) {
17090: $tries ++;
17091: my $captcha = Authen::Captcha->new (
17092: output_folder => $captcha_params{'output_dir'},
17093: data_folder => $captcha_params{'db_dir'},
17094: );
17095: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17096:
17097: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17098: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
17099: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 17100: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
17101: '<br />'.
17102: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 17103: last;
17104: }
17105: }
17106: return $output;
17107: }
17108:
17109: sub captcha_settings {
17110: my %captcha_params = (
17111: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17112: www_output_dir => "/captchaspool",
17113: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17114: numchars => '5',
17115: );
17116: return %captcha_params;
17117: }
17118:
17119: sub check_captcha {
17120: my ($captcha_chk,$captcha_error);
17121: my $code = $env{'form.code'};
17122: my $md5sum = $env{'form.crypt'};
17123: my %captcha_params = &captcha_settings();
17124: my $captcha = Authen::Captcha->new(
17125: output_folder => $captcha_params{'output_dir'},
17126: data_folder => $captcha_params{'db_dir'},
17127: );
1.1109 raeburn 17128: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 17129: my %captcha_hash = (
17130: 0 => 'Code not checked (file error)',
17131: -1 => 'Failed: code expired',
17132: -2 => 'Failed: invalid code (not in database)',
17133: -3 => 'Failed: invalid code (code does not match crypt)',
17134: );
17135: if ($captcha_chk != 1) {
17136: $captcha_error = $captcha_hash{$captcha_chk}
17137: }
17138: return ($captcha_chk,$captcha_error);
17139: }
17140:
17141: sub create_recaptcha {
1.1234 raeburn 17142: my ($pubkey,$version) = @_;
17143: if ($version >= 2) {
17144: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17145: } else {
17146: my $use_ssl;
17147: if ($ENV{'SERVER_PORT'} == 443) {
17148: $use_ssl = 1;
17149: }
17150: my $captcha = Captcha::reCAPTCHA->new;
17151: return $captcha->get_options_setter({theme => 'white'})."\n".
17152: $captcha->get_html($pubkey,undef,$use_ssl).
17153: &mt('If the text is hard to read, [_1] will replace them.',
17154: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17155: '<br /><br />';
17156: }
1.1094 raeburn 17157: }
17158:
17159: sub check_recaptcha {
1.1234 raeburn 17160: my ($privkey,$version) = @_;
1.1094 raeburn 17161: my $captcha_chk;
1.1234 raeburn 17162: if ($version >= 2) {
17163: my $ua = LWP::UserAgent->new;
17164: $ua->timeout(10);
17165: my %info = (
17166: secret => $privkey,
17167: response => $env{'form.g-recaptcha-response'},
17168: remoteip => $ENV{'REMOTE_ADDR'},
17169: );
17170: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
17171: if ($response->is_success) {
17172: my $data = JSON::DWIW->from_json($response->decoded_content);
17173: if (ref($data) eq 'HASH') {
17174: if ($data->{'success'}) {
17175: $captcha_chk = 1;
17176: }
17177: }
17178: }
17179: } else {
17180: my $captcha = Captcha::reCAPTCHA->new;
17181: my $captcha_result =
17182: $captcha->check_answer(
17183: $privkey,
17184: $ENV{'REMOTE_ADDR'},
17185: $env{'form.recaptcha_challenge_field'},
17186: $env{'form.recaptcha_response_field'},
17187: );
17188: if ($captcha_result->{is_valid}) {
17189: $captcha_chk = 1;
17190: }
1.1094 raeburn 17191: }
17192: return $captcha_chk;
17193: }
17194:
1.1174 raeburn 17195: sub emailusername_info {
1.1244 raeburn 17196: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 17197: my %titles = &Apache::lonlocal::texthash (
17198: lastname => 'Last Name',
17199: firstname => 'First Name',
17200: institution => 'School/college/university',
17201: location => "School's city, state/province, country",
17202: web => "School's web address",
17203: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 17204: id => 'Student/Employee ID',
1.1174 raeburn 17205: );
17206: return (\@fields,\%titles);
17207: }
17208:
1.1161 raeburn 17209: sub cleanup_html {
17210: my ($incoming) = @_;
17211: my $outgoing;
17212: if ($incoming ne '') {
17213: $outgoing = $incoming;
17214: $outgoing =~ s/;/;/g;
17215: $outgoing =~ s/\#/#/g;
17216: $outgoing =~ s/\&/&/g;
17217: $outgoing =~ s/</</g;
17218: $outgoing =~ s/>/>/g;
17219: $outgoing =~ s/\(/(/g;
17220: $outgoing =~ s/\)/)/g;
17221: $outgoing =~ s/"/"/g;
17222: $outgoing =~ s/'/'/g;
17223: $outgoing =~ s/\$/$/g;
17224: $outgoing =~ s{/}{/}g;
17225: $outgoing =~ s/=/=/g;
17226: $outgoing =~ s/\\/\/g
17227: }
17228: return $outgoing;
17229: }
17230:
1.1190 musolffc 17231: # Checks for critical messages and returns a redirect url if one exists.
17232: # $interval indicates how often to check for messages.
17233: sub critical_redirect {
17234: my ($interval) = @_;
17235: if ((time-$env{'user.criticalcheck.time'})>$interval) {
17236: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17237: $env{'user.name'});
17238: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 17239: my $redirecturl;
1.1190 musolffc 17240: if ($what[0]) {
17241: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17242: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 17243: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17244: return (1, $url);
1.1190 musolffc 17245: }
1.1191 raeburn 17246: }
17247: }
17248: return ();
1.1190 musolffc 17249: }
17250:
1.1174 raeburn 17251: # Use:
17252: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17253: #
17254: ##################################################
17255: # password associated functions #
17256: ##################################################
17257: sub des_keys {
17258: # Make a new key for DES encryption.
17259: # Each key has two parts which are returned separately.
17260: # Please note: Each key must be passed through the &hex function
17261: # before it is output to the web browser. The hex versions cannot
17262: # be used to decrypt.
17263: my @hexstr=('0','1','2','3','4','5','6','7',
17264: '8','9','a','b','c','d','e','f');
17265: my $lkey='';
17266: for (0..7) {
17267: $lkey.=$hexstr[rand(15)];
17268: }
17269: my $ukey='';
17270: for (0..7) {
17271: $ukey.=$hexstr[rand(15)];
17272: }
17273: return ($lkey,$ukey);
17274: }
17275:
17276: sub des_decrypt {
17277: my ($key,$cyphertext) = @_;
17278: my $keybin=pack("H16",$key);
17279: my $cypher;
17280: if ($Crypt::DES::VERSION>=2.03) {
17281: $cypher=new Crypt::DES $keybin;
17282: } else {
17283: $cypher=new DES $keybin;
17284: }
1.1233 raeburn 17285: my $plaintext='';
17286: my $cypherlength = length($cyphertext);
17287: my $numchunks = int($cypherlength/32);
17288: for (my $j=0; $j<$numchunks; $j++) {
17289: my $start = $j*32;
17290: my $cypherblock = substr($cyphertext,$start,32);
17291: my $chunk =
17292: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17293: $chunk .=
17294: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17295: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17296: $plaintext .= $chunk;
17297: }
1.1174 raeburn 17298: return $plaintext;
17299: }
17300:
1.112 bowersj2 17301: 1;
17302: __END__;
1.41 ng 17303:
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