Annotation of loncom/interface/loncommon.pm, revision 1.1238
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1238 ! raeburn 4: # $Id: loncommon.pm,v 1.1237 2016/04/02 04:30:20 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1220 raeburn 76: use Encode();
1.1091 foxr 77: use Text::Aspell;
1.1094 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.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.906 raeburn 884: } elsif ($selecttype eq 'Course/Community') {
885: $linktext = &mt('Select Course/Community');
1.909 raeburn 886: $type = '';
1.1019 raeburn 887: } elsif ($selecttype eq 'Select') {
888: $linktext = &mt('Select');
889: $type = '';
1.871 raeburn 890: }
1.787 bisitz 891: return '<span class="LC_nobreak">'
892: ."<a href='"
893: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
894: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 895: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 896: ."'>".$linktext.'</a>'
1.787 bisitz 897: .'</span>';
1.74 www 898: }
1.42 matthew 899:
1.653 raeburn 900: sub selectauthor_link {
901: my ($form,$udom)=@_;
902: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
903: &mt('Select Author').'</a>';
904: }
905:
1.876 raeburn 906: sub selectuser_link {
1.881 raeburn 907: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 908: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 909: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 910: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 911: ');">'.$linktext.'</a>';
1.876 raeburn 912: }
913:
1.273 raeburn 914: sub check_uncheck_jscript {
915: my $jscript = <<"ENDSCRT";
916: function checkAll(field) {
917: if (field.length > 0) {
918: for (i = 0; i < field.length; i++) {
1.1093 raeburn 919: if (!field[i].disabled) {
920: field[i].checked = true;
921: }
1.273 raeburn 922: }
923: } else {
1.1093 raeburn 924: if (!field.disabled) {
925: field.checked = true;
926: }
1.273 raeburn 927: }
928: }
929:
930: function uncheckAll(field) {
931: if (field.length > 0) {
932: for (i = 0; i < field.length; i++) {
933: field[i].checked = false ;
1.543 albertel 934: }
935: } else {
1.273 raeburn 936: field.checked = false ;
937: }
938: }
939: ENDSCRT
940: return $jscript;
941: }
942:
1.656 www 943: sub select_timezone {
1.659 raeburn 944: my ($name,$selected,$onchange,$includeempty)=@_;
945: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
946: if ($includeempty) {
947: $output .= '<option value=""';
948: if (($selected eq '') || ($selected eq 'local')) {
949: $output .= ' selected="selected" ';
950: }
951: $output .= '> </option>';
952: }
1.657 raeburn 953: my @timezones = DateTime::TimeZone->all_names;
954: foreach my $tzone (@timezones) {
955: $output.= '<option value="'.$tzone.'"';
956: if ($tzone eq $selected) {
957: $output.=' selected="selected"';
958: }
959: $output.=">$tzone</option>\n";
1.656 www 960: }
961: $output.="</select>";
962: return $output;
963: }
1.273 raeburn 964:
1.687 raeburn 965: sub select_datelocale {
966: my ($name,$selected,$onchange,$includeempty)=@_;
967: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
968: if ($includeempty) {
969: $output .= '<option value=""';
970: if ($selected eq '') {
971: $output .= ' selected="selected" ';
972: }
973: $output .= '> </option>';
974: }
975: my (@possibles,%locale_names);
976: my @locales = DateTime::Locale::Catalog::Locales;
977: foreach my $locale (@locales) {
978: if (ref($locale) eq 'HASH') {
979: my $id = $locale->{'id'};
980: if ($id ne '') {
981: my $en_terr = $locale->{'en_territory'};
982: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 983: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 984: if (grep(/^en$/,@languages) || !@languages) {
985: if ($en_terr ne '') {
986: $locale_names{$id} = '('.$en_terr.')';
987: } elsif ($native_terr ne '') {
988: $locale_names{$id} = $native_terr;
989: }
990: } else {
991: if ($native_terr ne '') {
992: $locale_names{$id} = $native_terr.' ';
993: } elsif ($en_terr ne '') {
994: $locale_names{$id} = '('.$en_terr.')';
995: }
996: }
1.1220 raeburn 997: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687 raeburn 998: push (@possibles,$id);
999: }
1000: }
1001: }
1002: foreach my $item (sort(@possibles)) {
1003: $output.= '<option value="'.$item.'"';
1004: if ($item eq $selected) {
1005: $output.=' selected="selected"';
1006: }
1007: $output.=">$item";
1008: if ($locale_names{$item} ne '') {
1.1220 raeburn 1009: $output.=' '.$locale_names{$item};
1.687 raeburn 1010: }
1011: $output.="</option>\n";
1012: }
1013: $output.="</select>";
1014: return $output;
1015: }
1016:
1.792 raeburn 1017: sub select_language {
1018: my ($name,$selected,$includeempty) = @_;
1019: my %langchoices;
1020: if ($includeempty) {
1.1117 raeburn 1021: %langchoices = ('' => 'No language preference');
1.792 raeburn 1022: }
1023: foreach my $id (&languageids()) {
1024: my $code = &supportedlanguagecode($id);
1025: if ($code) {
1026: $langchoices{$code} = &plainlanguagedescription($id);
1027: }
1028: }
1.1117 raeburn 1029: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1030: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1031: }
1032:
1.42 matthew 1033: =pod
1.36 matthew 1034:
1.1088 foxr 1035:
1036: =item * &list_languages()
1037:
1038: Returns an array reference that is suitable for use in language prompters.
1039: Each array element is itself a two element array. The first element
1040: is the language code. The second element a descsriptiuon of the
1041: language itself. This is suitable for use in e.g.
1042: &Apache::edit::select_arg (once dereferenced that is).
1043:
1044: =cut
1045:
1046: sub list_languages {
1047: my @lang_choices;
1048:
1049: foreach my $id (&languageids()) {
1050: my $code = &supportedlanguagecode($id);
1051: if ($code) {
1052: my $selector = $supported_codes{$id};
1053: my $description = &plainlanguagedescription($id);
1054: push (@lang_choices, [$selector, $description]);
1055: }
1056: }
1057: return \@lang_choices;
1058: }
1059:
1060: =pod
1061:
1.648 raeburn 1062: =item * &linked_select_forms(...)
1.36 matthew 1063:
1064: linked_select_forms returns a string containing a <script></script> block
1065: and html for two <select> menus. The select menus will be linked in that
1066: changing the value of the first menu will result in new values being placed
1067: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1068: order unless a defined order is provided.
1.36 matthew 1069:
1070: linked_select_forms takes the following ordered inputs:
1071:
1072: =over 4
1073:
1.112 bowersj2 1074: =item * $formname, the name of the <form> tag
1.36 matthew 1075:
1.112 bowersj2 1076: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1077:
1.112 bowersj2 1078: =item * $firstdefault, the default value for the first menu
1.36 matthew 1079:
1.112 bowersj2 1080: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1081:
1.112 bowersj2 1082: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1083:
1.112 bowersj2 1084: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1085:
1.609 raeburn 1086: =item * $menuorder, the order of values in the first menu
1087:
1.1115 raeburn 1088: =item * $onchangefirst, additional javascript call to execute for an onchange
1089: event for the first <select> tag
1090:
1091: =item * $onchangesecond, additional javascript call to execute for an onchange
1092: event for the second <select> tag
1093:
1.41 ng 1094: =back
1095:
1.36 matthew 1096: Below is an example of such a hash. Only the 'text', 'default', and
1097: 'select2' keys must appear as stated. keys(%menu) are the possible
1098: values for the first select menu. The text that coincides with the
1.41 ng 1099: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1100: and text for the second menu are given in the hash pointed to by
1101: $menu{$choice1}->{'select2'}.
1102:
1.112 bowersj2 1103: my %menu = ( A1 => { text =>"Choice A1" ,
1104: default => "B3",
1105: select2 => {
1106: B1 => "Choice B1",
1107: B2 => "Choice B2",
1108: B3 => "Choice B3",
1109: B4 => "Choice B4"
1.609 raeburn 1110: },
1111: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1112: },
1113: A2 => { text =>"Choice A2" ,
1114: default => "C2",
1115: select2 => {
1116: C1 => "Choice C1",
1117: C2 => "Choice C2",
1118: C3 => "Choice C3"
1.609 raeburn 1119: },
1120: order => ['C2','C1','C3'],
1.112 bowersj2 1121: },
1122: A3 => { text =>"Choice A3" ,
1123: default => "D6",
1124: select2 => {
1125: D1 => "Choice D1",
1126: D2 => "Choice D2",
1127: D3 => "Choice D3",
1128: D4 => "Choice D4",
1129: D5 => "Choice D5",
1130: D6 => "Choice D6",
1131: D7 => "Choice D7"
1.609 raeburn 1132: },
1133: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1134: }
1135: );
1.36 matthew 1136:
1137: =cut
1138:
1139: sub linked_select_forms {
1140: my ($formname,
1141: $middletext,
1142: $firstdefault,
1143: $firstselectname,
1144: $secondselectname,
1.609 raeburn 1145: $hashref,
1146: $menuorder,
1.1115 raeburn 1147: $onchangefirst,
1148: $onchangesecond
1.36 matthew 1149: ) = @_;
1150: my $second = "document.$formname.$secondselectname";
1151: my $first = "document.$formname.$firstselectname";
1152: # output the javascript to do the changing
1153: my $result = '';
1.776 bisitz 1154: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1155: $result.="// <![CDATA[\n";
1.36 matthew 1156: $result.="var select2data = new Object();\n";
1157: $" = '","';
1158: my $debug = '';
1159: foreach my $s1 (sort(keys(%$hashref))) {
1160: $result.="select2data.d_$s1 = new Object();\n";
1161: $result.="select2data.d_$s1.def = new String('".
1162: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1163: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1164: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1165: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1166: @s2values = @{$hashref->{$s1}->{'order'}};
1167: }
1.36 matthew 1168: $result.="\"@s2values\");\n";
1169: $result.="select2data.d_$s1.texts = new Array(";
1170: my @s2texts;
1171: foreach my $value (@s2values) {
1172: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1173: }
1174: $result.="\"@s2texts\");\n";
1175: }
1176: $"=' ';
1177: $result.= <<"END";
1178:
1179: function select1_changed() {
1180: // Determine new choice
1181: var newvalue = "d_" + $first.value;
1182: // update select2
1183: var values = select2data[newvalue].values;
1184: var texts = select2data[newvalue].texts;
1185: var select2def = select2data[newvalue].def;
1186: var i;
1187: // out with the old
1188: for (i = 0; i < $second.options.length; i++) {
1189: $second.options[i] = null;
1190: }
1191: // in with the nuclear
1192: for (i=0;i<values.length; i++) {
1193: $second.options[i] = new Option(values[i]);
1.143 matthew 1194: $second.options[i].value = values[i];
1.36 matthew 1195: $second.options[i].text = texts[i];
1196: if (values[i] == select2def) {
1197: $second.options[i].selected = true;
1198: }
1199: }
1200: }
1.824 bisitz 1201: // ]]>
1.36 matthew 1202: </script>
1203: END
1204: # output the initial values for the selection lists
1.1115 raeburn 1205: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1206: my @order = sort(keys(%{$hashref}));
1207: if (ref($menuorder) eq 'ARRAY') {
1208: @order = @{$menuorder};
1209: }
1210: foreach my $value (@order) {
1.36 matthew 1211: $result.=" <option value=\"$value\" ";
1.253 albertel 1212: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1213: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1214: }
1215: $result .= "</select>\n";
1216: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1217: $result .= $middletext;
1.1115 raeburn 1218: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1219: if ($onchangesecond) {
1220: $result .= ' onchange="'.$onchangesecond.'"';
1221: }
1222: $result .= ">\n";
1.36 matthew 1223: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1224:
1225: my @secondorder = sort(keys(%select2));
1226: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1227: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1228: }
1229: foreach my $value (@secondorder) {
1.36 matthew 1230: $result.=" <option value=\"$value\" ";
1.253 albertel 1231: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1232: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1233: }
1234: $result .= "</select>\n";
1235: # return $debug;
1236: return $result;
1237: } # end of sub linked_select_forms {
1238:
1.45 matthew 1239: =pod
1.44 bowersj2 1240:
1.973 raeburn 1241: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1242:
1.112 bowersj2 1243: Returns a string corresponding to an HTML link to the given help
1244: $topic, where $topic corresponds to the name of a .tex file in
1245: /home/httpd/html/adm/help/tex, with underscores replaced by
1246: spaces.
1247:
1248: $text will optionally be linked to the same topic, allowing you to
1249: link text in addition to the graphic. If you do not want to link
1250: text, but wish to specify one of the later parameters, pass an
1251: empty string.
1252:
1253: $stayOnPage is a value that will be interpreted as a boolean. If true,
1254: the link will not open a new window. If false, the link will open
1255: a new window using Javascript. (Default is false.)
1256:
1257: $width and $height are optional numerical parameters that will
1258: override the width and height of the popped up window, which may
1.973 raeburn 1259: be useful for certain help topics with big pictures included.
1260:
1261: $imgid is the id of the img tag used for the help icon. This may be
1262: used in a javascript call to switch the image src. See
1263: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1264:
1265: =cut
1266:
1267: sub help_open_topic {
1.973 raeburn 1268: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1269: $text = "" if (not defined $text);
1.44 bowersj2 1270: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1271: $width = 500 if (not defined $width);
1.44 bowersj2 1272: $height = 400 if (not defined $height);
1273: my $filename = $topic;
1274: $filename =~ s/ /_/g;
1275:
1.48 bowersj2 1276: my $template = "";
1277: my $link;
1.572 banghart 1278:
1.159 www 1279: $topic=~s/\W/\_/g;
1.44 bowersj2 1280:
1.572 banghart 1281: if (!$stayOnPage) {
1.1033 www 1282: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1283: } elsif ($stayOnPage eq 'popup') {
1284: $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 1285: } else {
1.48 bowersj2 1286: $link = "/adm/help/${filename}.hlp";
1287: }
1288:
1289: # Add the text
1.755 neumanie 1290: if ($text ne "") {
1.763 bisitz 1291: $template.='<span class="LC_help_open_topic">'
1292: .'<a target="_top" href="'.$link.'">'
1293: .$text.'</a>';
1.48 bowersj2 1294: }
1295:
1.763 bisitz 1296: # (Always) Add the graphic
1.179 matthew 1297: my $title = &mt('Online Help');
1.667 raeburn 1298: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1299: if ($imgid ne '') {
1300: $imgid = ' id="'.$imgid.'"';
1301: }
1.763 bisitz 1302: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1303: .'<img src="'.$helpicon.'" border="0"'
1304: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1305: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1306: .' /></a>';
1307: if ($text ne "") {
1308: $template.='</span>';
1309: }
1.44 bowersj2 1310: return $template;
1311:
1.106 bowersj2 1312: }
1313:
1314: # This is a quicky function for Latex cheatsheet editing, since it
1315: # appears in at least four places
1316: sub helpLatexCheatsheet {
1.1037 www 1317: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1318: my $out;
1.106 bowersj2 1319: my $addOther = '';
1.732 raeburn 1320: if ($topic) {
1.1037 www 1321: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1322: }
1323: $out = '<span>' # Start cheatsheet
1324: .$addOther
1325: .'<span>'
1.1037 www 1326: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1327: .'</span> <span>'
1.1037 www 1328: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1329: .'</span>';
1.732 raeburn 1330: unless ($not_author) {
1.1186 kruse 1331: $out .= '<span>'
1332: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1333: .'</span> <span>'
1334: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1335: .'</span>';
1.732 raeburn 1336: }
1.763 bisitz 1337: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1338: return $out;
1.172 www 1339: }
1340:
1.430 albertel 1341: sub general_help {
1342: my $helptopic='Student_Intro';
1343: if ($env{'request.role'}=~/^(ca|au)/) {
1344: $helptopic='Authoring_Intro';
1.907 raeburn 1345: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1346: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1347: } elsif ($env{'request.role'}=~/^dc/) {
1348: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1349: }
1350: return $helptopic;
1351: }
1352:
1353: sub update_help_link {
1354: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1355: my $origurl = $ENV{'REQUEST_URI'};
1356: $origurl=~s|^/~|/priv/|;
1357: my $timestamp = time;
1358: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1359: $$datum = &escape($$datum);
1360: }
1361:
1362: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1363: my $output .= <<"ENDOUTPUT";
1364: <script type="text/javascript">
1.824 bisitz 1365: // <![CDATA[
1.430 albertel 1366: banner_link = '$banner_link';
1.824 bisitz 1367: // ]]>
1.430 albertel 1368: </script>
1369: ENDOUTPUT
1370: return $output;
1371: }
1372:
1373: # now just updates the help link and generates a blue icon
1.193 raeburn 1374: sub help_open_menu {
1.430 albertel 1375: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1376: = @_;
1.949 droeschl 1377: $stayOnPage = 1;
1.430 albertel 1378: my $output;
1379: if ($component_help) {
1380: if (!$text) {
1381: $output=&help_open_topic($component_help,undef,$stayOnPage,
1382: $width,$height);
1383: } else {
1384: my $help_text;
1385: $help_text=&unescape($topic);
1386: $output='<table><tr><td>'.
1387: &help_open_topic($component_help,$help_text,$stayOnPage,
1388: $width,$height).'</td></tr></table>';
1389: }
1390: }
1391: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1392: return $output.$banner_link;
1393: }
1394:
1395: sub top_nav_help {
1396: my ($text) = @_;
1.436 albertel 1397: $text = &mt($text);
1.949 droeschl 1398: my $stay_on_page = 1;
1399:
1.1168 raeburn 1400: my ($link,$banner_link);
1401: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1402: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1403: : "javascript:helpMenu('open')";
1404: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1405: }
1.201 raeburn 1406: my $title = &mt('Get help');
1.1168 raeburn 1407: if ($link) {
1408: return <<"END";
1.436 albertel 1409: $banner_link
1.1159 raeburn 1410: <a href="$link" title="$title">$text</a>
1.436 albertel 1411: END
1.1168 raeburn 1412: } else {
1413: return ' '.$text.' ';
1414: }
1.436 albertel 1415: }
1416:
1417: sub help_menu_js {
1.1154 raeburn 1418: my ($httphost) = @_;
1.949 droeschl 1419: my $stayOnPage = 1;
1.436 albertel 1420: my $width = 620;
1421: my $height = 600;
1.430 albertel 1422: my $helptopic=&general_help();
1.1154 raeburn 1423: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1424: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1425: my $start_page =
1426: &Apache::loncommon::start_page('Help Menu', undef,
1427: {'frameset' => 1,
1428: 'js_ready' => 1,
1.1154 raeburn 1429: 'use_absolute' => $httphost,
1.331 albertel 1430: 'add_entries' => {
1.1168 raeburn 1431: 'border' => '0',
1.579 raeburn 1432: 'rows' => "110,*",},});
1.331 albertel 1433: my $end_page =
1434: &Apache::loncommon::end_page({'frameset' => 1,
1435: 'js_ready' => 1,});
1436:
1.436 albertel 1437: my $template .= <<"ENDTEMPLATE";
1438: <script type="text/javascript">
1.877 bisitz 1439: // <![CDATA[
1.253 albertel 1440: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1441: var banner_link = '';
1.243 raeburn 1442: function helpMenu(target) {
1443: var caller = this;
1444: if (target == 'open') {
1445: var newWindow = null;
1446: try {
1.262 albertel 1447: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1448: }
1449: catch(error) {
1450: writeHelp(caller);
1451: return;
1452: }
1453: if (newWindow) {
1454: caller = newWindow;
1455: }
1.193 raeburn 1456: }
1.243 raeburn 1457: writeHelp(caller);
1458: return;
1459: }
1460: function writeHelp(caller) {
1.1168 raeburn 1461: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1462: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1463: caller.document.close();
1464: caller.focus();
1.193 raeburn 1465: }
1.877 bisitz 1466: // END LON-CAPA Internal -->
1.253 albertel 1467: // ]]>
1.436 albertel 1468: </script>
1.193 raeburn 1469: ENDTEMPLATE
1470: return $template;
1471: }
1472:
1.172 www 1473: sub help_open_bug {
1474: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1475: unless ($env{'user.adv'}) { return ''; }
1.172 www 1476: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1477: $text = "" if (not defined $text);
1478: $stayOnPage=1;
1.184 albertel 1479: $width = 600 if (not defined $width);
1480: $height = 600 if (not defined $height);
1.172 www 1481:
1482: $topic=~s/\W+/\+/g;
1483: my $link='';
1484: my $template='';
1.379 albertel 1485: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1486: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1487: if (!$stayOnPage)
1488: {
1489: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1490: }
1491: else
1492: {
1493: $link = $url;
1494: }
1495: # Add the text
1496: if ($text ne "")
1497: {
1498: $template .=
1499: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1500: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1501: }
1502:
1503: # Add the graphic
1.179 matthew 1504: my $title = &mt('Report a Bug');
1.215 albertel 1505: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1506: $template .= <<"ENDTEMPLATE";
1.436 albertel 1507: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1508: ENDTEMPLATE
1509: if ($text ne '') { $template.='</td></tr></table>' };
1510: return $template;
1511:
1512: }
1513:
1514: sub help_open_faq {
1515: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1516: unless ($env{'user.adv'}) { return ''; }
1.172 www 1517: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1518: $text = "" if (not defined $text);
1519: $stayOnPage=1;
1520: $width = 350 if (not defined $width);
1521: $height = 400 if (not defined $height);
1522:
1523: $topic=~s/\W+/\+/g;
1524: my $link='';
1525: my $template='';
1526: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1527: if (!$stayOnPage)
1528: {
1529: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1530: }
1531: else
1532: {
1533: $link = $url;
1534: }
1535:
1536: # Add the text
1537: if ($text ne "")
1538: {
1539: $template .=
1.173 www 1540: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1541: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1542: }
1543:
1544: # Add the graphic
1.179 matthew 1545: my $title = &mt('View the FAQ');
1.215 albertel 1546: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1547: $template .= <<"ENDTEMPLATE";
1.436 albertel 1548: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1549: ENDTEMPLATE
1550: if ($text ne '') { $template.='</td></tr></table>' };
1551: return $template;
1552:
1.44 bowersj2 1553: }
1.37 matthew 1554:
1.180 matthew 1555: ###############################################################
1556: ###############################################################
1557:
1.45 matthew 1558: =pod
1559:
1.648 raeburn 1560: =item * &change_content_javascript():
1.256 matthew 1561:
1562: This and the next function allow you to create small sections of an
1563: otherwise static HTML page that you can update on the fly with
1564: Javascript, even in Netscape 4.
1565:
1566: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1567: must be written to the HTML page once. It will prove the Javascript
1568: function "change(name, content)". Calling the change function with the
1569: name of the section
1570: you want to update, matching the name passed to C<changable_area>, and
1571: the new content you want to put in there, will put the content into
1572: that area.
1573:
1574: B<Note>: Netscape 4 only reserves enough space for the changable area
1575: to contain room for the original contents. You need to "make space"
1576: for whatever changes you wish to make, and be B<sure> to check your
1577: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1578: it's adequate for updating a one-line status display, but little more.
1579: This script will set the space to 100% width, so you only need to
1580: worry about height in Netscape 4.
1581:
1582: Modern browsers are much less limiting, and if you can commit to the
1583: user not using Netscape 4, this feature may be used freely with
1584: pretty much any HTML.
1585:
1586: =cut
1587:
1588: sub change_content_javascript {
1589: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1590: if ($env{'browser.type'} eq 'netscape' &&
1591: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1592: return (<<NETSCAPE4);
1593: function change(name, content) {
1594: doc = document.layers[name+"___escape"].layers[0].document;
1595: doc.open();
1596: doc.write(content);
1597: doc.close();
1598: }
1599: NETSCAPE4
1600: } else {
1601: # Otherwise, we need to use semi-standards-compliant code
1602: # (technically, "innerHTML" isn't standard but the equivalent
1603: # is really scary, and every useful browser supports it
1604: return (<<DOMBASED);
1605: function change(name, content) {
1606: element = document.getElementById(name);
1607: element.innerHTML = content;
1608: }
1609: DOMBASED
1610: }
1611: }
1612:
1613: =pod
1614:
1.648 raeburn 1615: =item * &changable_area($name,$origContent):
1.256 matthew 1616:
1617: This provides a "changable area" that can be modified on the fly via
1618: the Javascript code provided in C<change_content_javascript>. $name is
1619: the name you will use to reference the area later; do not repeat the
1620: same name on a given HTML page more then once. $origContent is what
1621: the area will originally contain, which can be left blank.
1622:
1623: =cut
1624:
1625: sub changable_area {
1626: my ($name, $origContent) = @_;
1627:
1.258 albertel 1628: if ($env{'browser.type'} eq 'netscape' &&
1629: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1630: # If this is netscape 4, we need to use the Layer tag
1631: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1632: } else {
1633: return "<span id='$name'>$origContent</span>";
1634: }
1635: }
1636:
1637: =pod
1638:
1.648 raeburn 1639: =item * &viewport_geometry_js
1.590 raeburn 1640:
1641: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1642:
1643: =cut
1644:
1645:
1646: sub viewport_geometry_js {
1647: return <<"GEOMETRY";
1648: var Geometry = {};
1649: function init_geometry() {
1650: if (Geometry.init) { return };
1651: Geometry.init=1;
1652: if (window.innerHeight) {
1653: Geometry.getViewportHeight = function() { return window.innerHeight; };
1654: Geometry.getViewportWidth = function() { return window.innerWidth; };
1655: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1656: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1657: }
1658: else if (document.documentElement && document.documentElement.clientHeight) {
1659: Geometry.getViewportHeight =
1660: function() { return document.documentElement.clientHeight; };
1661: Geometry.getViewportWidth =
1662: function() { return document.documentElement.clientWidth; };
1663:
1664: Geometry.getHorizontalScroll =
1665: function() { return document.documentElement.scrollLeft; };
1666: Geometry.getVerticalScroll =
1667: function() { return document.documentElement.scrollTop; };
1668: }
1669: else if (document.body.clientHeight) {
1670: Geometry.getViewportHeight =
1671: function() { return document.body.clientHeight; };
1672: Geometry.getViewportWidth =
1673: function() { return document.body.clientWidth; };
1674: Geometry.getHorizontalScroll =
1675: function() { return document.body.scrollLeft; };
1676: Geometry.getVerticalScroll =
1677: function() { return document.body.scrollTop; };
1678: }
1679: }
1680:
1681: GEOMETRY
1682: }
1683:
1684: =pod
1685:
1.648 raeburn 1686: =item * &viewport_size_js()
1.590 raeburn 1687:
1688: 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.
1689:
1690: =cut
1691:
1692: sub viewport_size_js {
1693: my $geometry = &viewport_geometry_js();
1694: return <<"DIMS";
1695:
1696: $geometry
1697:
1698: function getViewportDims(width,height) {
1699: init_geometry();
1700: width.value = Geometry.getViewportWidth();
1701: height.value = Geometry.getViewportHeight();
1702: return;
1703: }
1704:
1705: DIMS
1706: }
1707:
1708: =pod
1709:
1.648 raeburn 1710: =item * &resize_textarea_js()
1.565 albertel 1711:
1712: emits the needed javascript to resize a textarea to be as big as possible
1713:
1714: creates a function resize_textrea that takes two IDs first should be
1715: the id of the element to resize, second should be the id of a div that
1716: surrounds everything that comes after the textarea, this routine needs
1717: to be attached to the <body> for the onload and onresize events.
1718:
1.648 raeburn 1719: =back
1.565 albertel 1720:
1721: =cut
1722:
1723: sub resize_textarea_js {
1.590 raeburn 1724: my $geometry = &viewport_geometry_js();
1.565 albertel 1725: return <<"RESIZE";
1726: <script type="text/javascript">
1.824 bisitz 1727: // <![CDATA[
1.590 raeburn 1728: $geometry
1.565 albertel 1729:
1.588 albertel 1730: function getX(element) {
1731: var x = 0;
1732: while (element) {
1733: x += element.offsetLeft;
1734: element = element.offsetParent;
1735: }
1736: return x;
1737: }
1738: function getY(element) {
1739: var y = 0;
1740: while (element) {
1741: y += element.offsetTop;
1742: element = element.offsetParent;
1743: }
1744: return y;
1745: }
1746:
1747:
1.565 albertel 1748: function resize_textarea(textarea_id,bottom_id) {
1749: init_geometry();
1750: var textarea = document.getElementById(textarea_id);
1751: //alert(textarea);
1752:
1.588 albertel 1753: var textarea_top = getY(textarea);
1.565 albertel 1754: var textarea_height = textarea.offsetHeight;
1755: var bottom = document.getElementById(bottom_id);
1.588 albertel 1756: var bottom_top = getY(bottom);
1.565 albertel 1757: var bottom_height = bottom.offsetHeight;
1758: var window_height = Geometry.getViewportHeight();
1.588 albertel 1759: var fudge = 23;
1.565 albertel 1760: var new_height = window_height-fudge-textarea_top-bottom_height;
1761: if (new_height < 300) {
1762: new_height = 300;
1763: }
1764: textarea.style.height=new_height+'px';
1765: }
1.824 bisitz 1766: // ]]>
1.565 albertel 1767: </script>
1768: RESIZE
1769:
1770: }
1771:
1.1205 golterma 1772: sub colorfuleditor_js {
1773: return <<"COLORFULEDIT"
1774: <script type="text/javascript">
1775: // <![CDATA[>
1776: function fold_box(curDepth, lastresource){
1777:
1778: // we need a list because there can be several blocks you need to fold in one tag
1779: var block = document.getElementsByName('foldblock_'+curDepth);
1780: // but there is only one folding button per tag
1781: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1782:
1783: if(block.item(0).style.display == 'none'){
1784:
1785: foldbutton.value = '@{[&mt("Hide")]}';
1786: for (i = 0; i < block.length; i++){
1787: block.item(i).style.display = '';
1788: }
1789: }else{
1790:
1791: foldbutton.value = '@{[&mt("Show")]}';
1792: for (i = 0; i < block.length; i++){
1793: // block.item(i).style.visibility = 'collapse';
1794: block.item(i).style.display = 'none';
1795: }
1796: };
1797: saveState(lastresource);
1798: }
1799:
1800: function saveState (lastresource) {
1801:
1802: var tag_list = getTagList();
1803: if(tag_list != null){
1804: var timestamp = new Date().getTime();
1805: var key = lastresource;
1806:
1807: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1808: // starting with timestamp
1809: var value = timestamp+';';
1810:
1811: // building the list of key-value pairs
1812: for(var i = 0; i < tag_list.length; i++){
1813: value += tag_list[i]+',';
1814: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1815: }
1816:
1817: // only iterate whole storage if nothing to override
1818: if(localStorage.getItem(key) == null){
1819:
1820: // prevent storage from growing large
1821: if(localStorage.length > 50){
1822: var regex_getTimestamp = /^(?:\d)+;/;
1823: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1824: var oldest_key;
1825:
1826: for(var i = 1; i < localStorage.length; i++){
1827: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1828: oldest_key = localStorage.key(i);
1829: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1830: }
1831: }
1832: localStorage.removeItem(oldest_key);
1833: }
1834: }
1835: localStorage.setItem(key,value);
1836: }
1837: }
1838:
1839: // restore folding status of blocks (on page load)
1840: function restoreState (lastresource) {
1841: if(localStorage.getItem(lastresource) != null){
1842: var key = lastresource;
1843: var value = localStorage.getItem(key);
1844: var regex_delTimestamp = /^\d+;/;
1845:
1846: value.replace(regex_delTimestamp, '');
1847:
1848: var valueArr = value.split(';');
1849: var pairs;
1850: var elements;
1851: for (var i = 0; i < valueArr.length; i++){
1852: pairs = valueArr[i].split(',');
1853: elements = document.getElementsByName(pairs[0]);
1854:
1855: for (var j = 0; j < elements.length; j++){
1856: elements[j].style.display = pairs[1];
1857: if (pairs[1] == "none"){
1858: var regex_id = /([_\\d]+)\$/;
1859: regex_id.exec(pairs[0]);
1860: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1861: }
1862: }
1863: }
1864: }
1865: }
1866:
1867: function getTagList () {
1868:
1869: var stringToSearch = document.lonhomework.innerHTML;
1870:
1871: var ret = new Array();
1872: var regex_findBlock = /(foldblock_.*?)"/g;
1873: var tag_list = stringToSearch.match(regex_findBlock);
1874:
1875: if(tag_list != null){
1876: for(var i = 0; i < tag_list.length; i++){
1877: ret.push(tag_list[i].replace(/"/, ''));
1878: }
1879: }
1880: return ret;
1881: }
1882:
1883: function saveScrollPosition (resource) {
1884: var tag_list = getTagList();
1885:
1886: // we dont always want to jump to the first block
1887: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1888: if(\$(window).scrollTop() > 170){
1889: if(tag_list != null){
1890: var result;
1891: for(var i = 0; i < tag_list.length; i++){
1892: if(isElementInViewport(tag_list[i])){
1893: result += tag_list[i]+';';
1894: }
1895: }
1896: sessionStorage.setItem('anchor_'+resource, result);
1897: }
1898: } else {
1899: // we dont need to save zero, just delete the item to leave everything tidy
1900: sessionStorage.removeItem('anchor_'+resource);
1901: }
1902: }
1903:
1904: function restoreScrollPosition(resource){
1905:
1906: var elem = sessionStorage.getItem('anchor_'+resource);
1907: if(elem != null){
1908: var tag_list = elem.split(';');
1909: var elem_list;
1910:
1911: for(var i = 0; i < tag_list.length; i++){
1912: elem_list = document.getElementsByName(tag_list[i]);
1913:
1914: if(elem_list.length > 0){
1915: elem = elem_list[0];
1916: break;
1917: }
1918: }
1919: elem.scrollIntoView();
1920: }
1921: }
1922:
1923: function isElementInViewport(el) {
1924:
1925: // change to last element instead of first
1926: var elem = document.getElementsByName(el);
1927: var rect = elem[0].getBoundingClientRect();
1928:
1929: return (
1930: rect.top >= 0 &&
1931: rect.left >= 0 &&
1932: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1933: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1934: );
1935: }
1936:
1937: function autosize(depth){
1938: var cmInst = window['cm'+depth];
1939: var fitsizeButton = document.getElementById('fitsize'+depth);
1940:
1941: // is fixed size, switching to dynamic
1942: if (sessionStorage.getItem("autosized_"+depth) == null) {
1943: cmInst.setSize("","auto");
1944: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1945: sessionStorage.setItem("autosized_"+depth, "yes");
1946:
1947: // is dynamic size, switching to fixed
1948: } else {
1949: cmInst.setSize("","300px");
1950: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1951: sessionStorage.removeItem("autosized_"+depth);
1952: }
1953: }
1954:
1955:
1956:
1957: // ]]>
1958: </script>
1959: COLORFULEDIT
1960: }
1961:
1962: sub xmleditor_js {
1963: return <<XMLEDIT
1964: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1965: <script type="text/javascript">
1966: // <![CDATA[>
1967:
1968: function saveScrollPosition (resource) {
1969:
1970: var scrollPos = \$(window).scrollTop();
1971: sessionStorage.setItem(resource,scrollPos);
1972: }
1973:
1974: function restoreScrollPosition(resource){
1975:
1976: var scrollPos = sessionStorage.getItem(resource);
1977: \$(window).scrollTop(scrollPos);
1978: }
1979:
1980: // unless internet explorer
1981: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1982:
1983: \$(document).ready(function() {
1984: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1985: });
1986: }
1987:
1988: // inserts text at cursor position into codemirror (xml editor only)
1989: function insertText(text){
1990: cm.focus();
1991: var curPos = cm.getCursor();
1992: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1993: }
1994: // ]]>
1995: </script>
1996: XMLEDIT
1997: }
1998:
1999: sub insert_folding_button {
2000: my $curDepth = $Apache::lonxml::curdepth;
2001: my $lastresource = $env{'request.ambiguous'};
2002:
2003: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2004: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2005: }
2006:
1.565 albertel 2007: =pod
2008:
1.256 matthew 2009: =head1 Excel and CSV file utility routines
2010:
2011: =cut
2012:
2013: ###############################################################
2014: ###############################################################
2015:
2016: =pod
2017:
1.1162 raeburn 2018: =over 4
2019:
1.648 raeburn 2020: =item * &csv_translate($text)
1.37 matthew 2021:
1.185 www 2022: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2023: format.
2024:
2025: =cut
2026:
1.180 matthew 2027: ###############################################################
2028: ###############################################################
1.37 matthew 2029: sub csv_translate {
2030: my $text = shift;
2031: $text =~ s/\"/\"\"/g;
1.209 albertel 2032: $text =~ s/\n/ /g;
1.37 matthew 2033: return $text;
2034: }
1.180 matthew 2035:
2036: ###############################################################
2037: ###############################################################
2038:
2039: =pod
2040:
1.648 raeburn 2041: =item * &define_excel_formats()
1.180 matthew 2042:
2043: Define some commonly used Excel cell formats.
2044:
2045: Currently supported formats:
2046:
2047: =over 4
2048:
2049: =item header
2050:
2051: =item bold
2052:
2053: =item h1
2054:
2055: =item h2
2056:
2057: =item h3
2058:
1.256 matthew 2059: =item h4
2060:
2061: =item i
2062:
1.180 matthew 2063: =item date
2064:
2065: =back
2066:
2067: Inputs: $workbook
2068:
2069: Returns: $format, a hash reference.
2070:
1.1057 foxr 2071:
1.180 matthew 2072: =cut
2073:
2074: ###############################################################
2075: ###############################################################
2076: sub define_excel_formats {
2077: my ($workbook) = @_;
2078: my $format;
2079: $format->{'header'} = $workbook->add_format(bold => 1,
2080: bottom => 1,
2081: align => 'center');
2082: $format->{'bold'} = $workbook->add_format(bold=>1);
2083: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2084: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2085: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2086: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2087: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2088: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2089: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2090: return $format;
2091: }
2092:
2093: ###############################################################
2094: ###############################################################
1.113 bowersj2 2095:
2096: =pod
2097:
1.648 raeburn 2098: =item * &create_workbook()
1.255 matthew 2099:
2100: Create an Excel worksheet. If it fails, output message on the
2101: request object and return undefs.
2102:
2103: Inputs: Apache request object
2104:
2105: Returns (undef) on failure,
2106: Excel worksheet object, scalar with filename, and formats
2107: from &Apache::loncommon::define_excel_formats on success
2108:
2109: =cut
2110:
2111: ###############################################################
2112: ###############################################################
2113: sub create_workbook {
2114: my ($r) = @_;
2115: #
2116: # Create the excel spreadsheet
2117: my $filename = '/prtspool/'.
1.258 albertel 2118: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2119: time.'_'.rand(1000000000).'.xls';
2120: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2121: if (! defined($workbook)) {
2122: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2123: $r->print(
2124: '<p class="LC_error">'
2125: .&mt('Problems occurred in creating the new Excel file.')
2126: .' '.&mt('This error has been logged.')
2127: .' '.&mt('Please alert your LON-CAPA administrator.')
2128: .'</p>'
2129: );
1.255 matthew 2130: return (undef);
2131: }
2132: #
1.1014 foxr 2133: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2134: #
2135: my $format = &Apache::loncommon::define_excel_formats($workbook);
2136: return ($workbook,$filename,$format);
2137: }
2138:
2139: ###############################################################
2140: ###############################################################
2141:
2142: =pod
2143:
1.648 raeburn 2144: =item * &create_text_file()
1.113 bowersj2 2145:
1.542 raeburn 2146: Create a file to write to and eventually make available to the user.
1.256 matthew 2147: If file creation fails, outputs an error message on the request object and
2148: return undefs.
1.113 bowersj2 2149:
1.256 matthew 2150: Inputs: Apache request object, and file suffix
1.113 bowersj2 2151:
1.256 matthew 2152: Returns (undef) on failure,
2153: Filehandle and filename on success.
1.113 bowersj2 2154:
2155: =cut
2156:
1.256 matthew 2157: ###############################################################
2158: ###############################################################
2159: sub create_text_file {
2160: my ($r,$suffix) = @_;
2161: if (! defined($suffix)) { $suffix = 'txt'; };
2162: my $fh;
2163: my $filename = '/prtspool/'.
1.258 albertel 2164: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2165: time.'_'.rand(1000000000).'.'.$suffix;
2166: $fh = Apache::File->new('>/home/httpd'.$filename);
2167: if (! defined($fh)) {
2168: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2169: $r->print(
2170: '<p class="LC_error">'
2171: .&mt('Problems occurred in creating the output file.')
2172: .' '.&mt('This error has been logged.')
2173: .' '.&mt('Please alert your LON-CAPA administrator.')
2174: .'</p>'
2175: );
1.113 bowersj2 2176: }
1.256 matthew 2177: return ($fh,$filename)
1.113 bowersj2 2178: }
2179:
2180:
1.256 matthew 2181: =pod
1.113 bowersj2 2182:
2183: =back
2184:
2185: =cut
1.37 matthew 2186:
2187: ###############################################################
1.33 matthew 2188: ## Home server <option> list generating code ##
2189: ###############################################################
1.35 matthew 2190:
1.169 www 2191: # ------------------------------------------
2192:
2193: sub domain_select {
2194: my ($name,$value,$multiple)=@_;
2195: my %domains=map {
1.514 albertel 2196: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2197: } &Apache::lonnet::all_domains();
1.169 www 2198: if ($multiple) {
2199: $domains{''}=&mt('Any domain');
1.550 albertel 2200: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2201: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2202: } else {
1.550 albertel 2203: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2204: return &select_form($name,$value,\%domains);
1.169 www 2205: }
2206: }
2207:
1.282 albertel 2208: #-------------------------------------------
2209:
2210: =pod
2211:
1.519 raeburn 2212: =head1 Routines for form select boxes
2213:
2214: =over 4
2215:
1.648 raeburn 2216: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2217:
2218: Returns a string containing a <select> element int multiple mode
2219:
2220:
2221: Args:
2222: $name - name of the <select> element
1.506 raeburn 2223: $value - scalar or array ref of values that should already be selected
1.282 albertel 2224: $size - number of rows long the select element is
1.283 albertel 2225: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2226: (shown text should already have been &mt())
1.506 raeburn 2227: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2228:
1.282 albertel 2229: =cut
2230:
2231: #-------------------------------------------
1.169 www 2232: sub multiple_select_form {
1.284 albertel 2233: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2234: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2235: my $output='';
1.191 matthew 2236: if (! defined($size)) {
2237: $size = 4;
1.283 albertel 2238: if (scalar(keys(%$hash))<4) {
2239: $size = scalar(keys(%$hash));
1.191 matthew 2240: }
2241: }
1.734 bisitz 2242: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2243: my @order;
1.506 raeburn 2244: if (ref($order) eq 'ARRAY') {
2245: @order = @{$order};
2246: } else {
2247: @order = sort(keys(%$hash));
1.501 banghart 2248: }
2249: if (exists($$hash{'select_form_order'})) {
2250: @order = @{$$hash{'select_form_order'}};
2251: }
2252:
1.284 albertel 2253: foreach my $key (@order) {
1.356 albertel 2254: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2255: $output.='selected="selected" ' if ($selected{$key});
2256: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2257: }
2258: $output.="</select>\n";
2259: return $output;
2260: }
2261:
1.88 www 2262: #-------------------------------------------
2263:
2264: =pod
2265:
1.970 raeburn 2266: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2267:
2268: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2269: allow a user to select options from a ref to a hash containing:
2270: option_name => displayed text. An optional $onchange can include
2271: a javascript onchange item, e.g., onchange="this.form.submit();"
2272:
1.88 www 2273: See lonrights.pm for an example invocation and use.
2274:
2275: =cut
2276:
2277: #-------------------------------------------
2278: sub select_form {
1.1228 raeburn 2279: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2280: return unless (ref($hashref) eq 'HASH');
2281: if ($onchange) {
2282: $onchange = ' onchange="'.$onchange.'"';
2283: }
1.1228 raeburn 2284: my $disabled;
2285: if ($readonly) {
2286: $disabled = ' disabled="disabled"';
2287: }
2288: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2289: my @keys;
1.970 raeburn 2290: if (exists($hashref->{'select_form_order'})) {
2291: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2292: } else {
1.970 raeburn 2293: @keys=sort(keys(%{$hashref}));
1.128 albertel 2294: }
1.356 albertel 2295: foreach my $key (@keys) {
2296: $selectform.=
2297: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2298: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2299: ">".$hashref->{$key}."</option>\n";
1.88 www 2300: }
2301: $selectform.="</select>";
2302: return $selectform;
2303: }
2304:
1.475 www 2305: # For display filters
2306:
2307: sub display_filter {
1.1074 raeburn 2308: my ($context) = @_;
1.475 www 2309: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2310: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2311: my $phraseinput = 'hidden';
2312: my $includeinput = 'hidden';
2313: my ($checked,$includetypestext);
2314: if ($env{'form.displayfilter'} eq 'containing') {
2315: $phraseinput = 'text';
2316: if ($context eq 'parmslog') {
2317: $includeinput = 'checkbox';
2318: if ($env{'form.includetypes'}) {
2319: $checked = ' checked="checked"';
2320: }
2321: $includetypestext = &mt('Include parameter types');
2322: }
2323: } else {
2324: $includetypestext = ' ';
2325: }
2326: my ($additional,$secondid,$thirdid);
2327: if ($context eq 'parmslog') {
2328: $additional =
2329: '<label><input type="'.$includeinput.'" name="includetypes"'.
2330: $checked.' name="includetypes" value="1" id="includetypes" />'.
2331: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2332: '</label>';
2333: $secondid = 'includetypes';
2334: $thirdid = 'includetypestext';
2335: }
2336: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2337: '$secondid','$thirdid')";
2338: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2339: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2340: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2341: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2342: &mt('Filter: [_1]',
1.477 www 2343: &select_form($env{'form.displayfilter'},
2344: 'displayfilter',
1.970 raeburn 2345: {'currentfolder' => 'Current folder/page',
1.477 www 2346: 'containing' => 'Containing phrase',
1.1074 raeburn 2347: 'none' => 'None'},$onchange)).' '.
2348: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2349: &HTML::Entities::encode($env{'form.containingphrase'}).
2350: '" />'.$additional;
2351: }
2352:
2353: sub display_filter_js {
2354: my $includetext = &mt('Include parameter types');
2355: return <<"ENDJS";
2356:
2357: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2358: var firstType = 'hidden';
2359: if (setter.options[setter.selectedIndex].value == 'containing') {
2360: firstType = 'text';
2361: }
2362: firstObject = document.getElementById(firstid);
2363: if (typeof(firstObject) == 'object') {
2364: if (firstObject.type != firstType) {
2365: changeInputType(firstObject,firstType);
2366: }
2367: }
2368: if (context == 'parmslog') {
2369: var secondType = 'hidden';
2370: if (firstType == 'text') {
2371: secondType = 'checkbox';
2372: }
2373: secondObject = document.getElementById(secondid);
2374: if (typeof(secondObject) == 'object') {
2375: if (secondObject.type != secondType) {
2376: changeInputType(secondObject,secondType);
2377: }
2378: }
2379: var textItem = document.getElementById(thirdid);
2380: var currtext = textItem.innerHTML;
2381: var newtext;
2382: if (firstType == 'text') {
2383: newtext = '$includetext';
2384: } else {
2385: newtext = ' ';
2386: }
2387: if (currtext != newtext) {
2388: textItem.innerHTML = newtext;
2389: }
2390: }
2391: return;
2392: }
2393:
2394: function changeInputType(oldObject,newType) {
2395: var newObject = document.createElement('input');
2396: newObject.type = newType;
2397: if (oldObject.size) {
2398: newObject.size = oldObject.size;
2399: }
2400: if (oldObject.value) {
2401: newObject.value = oldObject.value;
2402: }
2403: if (oldObject.name) {
2404: newObject.name = oldObject.name;
2405: }
2406: if (oldObject.id) {
2407: newObject.id = oldObject.id;
2408: }
2409: oldObject.parentNode.replaceChild(newObject,oldObject);
2410: return;
2411: }
2412:
2413: ENDJS
1.475 www 2414: }
2415:
1.167 www 2416: sub gradeleveldescription {
2417: my $gradelevel=shift;
2418: my %gradelevels=(0 => 'Not specified',
2419: 1 => 'Grade 1',
2420: 2 => 'Grade 2',
2421: 3 => 'Grade 3',
2422: 4 => 'Grade 4',
2423: 5 => 'Grade 5',
2424: 6 => 'Grade 6',
2425: 7 => 'Grade 7',
2426: 8 => 'Grade 8',
2427: 9 => 'Grade 9',
2428: 10 => 'Grade 10',
2429: 11 => 'Grade 11',
2430: 12 => 'Grade 12',
2431: 13 => 'Grade 13',
2432: 14 => '100 Level',
2433: 15 => '200 Level',
2434: 16 => '300 Level',
2435: 17 => '400 Level',
2436: 18 => 'Graduate Level');
2437: return &mt($gradelevels{$gradelevel});
2438: }
2439:
1.163 www 2440: sub select_level_form {
2441: my ($deflevel,$name)=@_;
2442: unless ($deflevel) { $deflevel=0; }
1.167 www 2443: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2444: for (my $i=0; $i<=18; $i++) {
2445: $selectform.="<option value=\"$i\" ".
1.253 albertel 2446: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2447: ">".&gradeleveldescription($i)."</option>\n";
2448: }
2449: $selectform.="</select>";
2450: return $selectform;
1.163 www 2451: }
1.167 www 2452:
1.35 matthew 2453: #-------------------------------------------
2454:
1.45 matthew 2455: =pod
2456:
1.1121 raeburn 2457: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2458:
2459: Returns a string containing a <select name='$name' size='1'> form to
2460: allow a user to select the domain to preform an operation in.
2461: See loncreateuser.pm for an example invocation and use.
2462:
1.90 www 2463: If the $includeempty flag is set, it also includes an empty choice ("no domain
2464: selected");
2465:
1.743 raeburn 2466: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2467:
1.910 raeburn 2468: 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.
2469:
1.1121 raeburn 2470: The optional $incdoms is a reference to an array of domains which will be the only available options.
2471:
2472: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2473:
1.35 matthew 2474: =cut
2475:
2476: #-------------------------------------------
1.34 matthew 2477: sub select_dom_form {
1.1121 raeburn 2478: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2479: if ($onchange) {
1.874 raeburn 2480: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2481: }
1.1121 raeburn 2482: my (@domains,%exclude);
1.910 raeburn 2483: if (ref($incdoms) eq 'ARRAY') {
2484: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2485: } else {
2486: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2487: }
1.90 www 2488: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2489: if (ref($excdoms) eq 'ARRAY') {
2490: map { $exclude{$_} = 1; } @{$excdoms};
2491: }
1.743 raeburn 2492: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2493: foreach my $dom (@domains) {
1.1121 raeburn 2494: next if ($exclude{$dom});
1.356 albertel 2495: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2496: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2497: if ($showdomdesc) {
2498: if ($dom ne '') {
2499: my $domdesc = &Apache::lonnet::domain($dom,'description');
2500: if ($domdesc ne '') {
2501: $selectdomain .= ' ('.$domdesc.')';
2502: }
2503: }
2504: }
2505: $selectdomain .= "</option>\n";
1.34 matthew 2506: }
2507: $selectdomain.="</select>";
2508: return $selectdomain;
2509: }
2510:
1.35 matthew 2511: #-------------------------------------------
2512:
1.45 matthew 2513: =pod
2514:
1.648 raeburn 2515: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2516:
1.586 raeburn 2517: input: 4 arguments (two required, two optional) -
2518: $domain - domain of new user
2519: $name - name of form element
2520: $default - Value of 'default' causes a default item to be first
2521: option, and selected by default.
2522: $hide - Value of 'hide' causes hiding of the name of the server,
2523: if 1 server found, or default, if 0 found.
1.594 raeburn 2524: output: returns 2 items:
1.586 raeburn 2525: (a) form element which contains either:
2526: (i) <select name="$name">
2527: <option value="$hostid1">$hostid $servers{$hostid}</option>
2528: <option value="$hostid2">$hostid $servers{$hostid}</option>
2529: </select>
2530: form item if there are multiple library servers in $domain, or
2531: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2532: if there is only one library server in $domain.
2533:
2534: (b) number of library servers found.
2535:
2536: See loncreateuser.pm for example of use.
1.35 matthew 2537:
2538: =cut
2539:
2540: #-------------------------------------------
1.586 raeburn 2541: sub home_server_form_item {
2542: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2543: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2544: my $result;
2545: my $numlib = keys(%servers);
2546: if ($numlib > 1) {
2547: $result .= '<select name="'.$name.'" />'."\n";
2548: if ($default) {
1.804 bisitz 2549: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2550: '</option>'."\n";
2551: }
2552: foreach my $hostid (sort(keys(%servers))) {
2553: $result.= '<option value="'.$hostid.'">'.
2554: $hostid.' '.$servers{$hostid}."</option>\n";
2555: }
2556: $result .= '</select>'."\n";
2557: } elsif ($numlib == 1) {
2558: my $hostid;
2559: foreach my $item (keys(%servers)) {
2560: $hostid = $item;
2561: }
2562: $result .= '<input type="hidden" name="'.$name.'" value="'.
2563: $hostid.'" />';
2564: if (!$hide) {
2565: $result .= $hostid.' '.$servers{$hostid};
2566: }
2567: $result .= "\n";
2568: } elsif ($default) {
2569: $result .= '<input type="hidden" name="'.$name.
2570: '" value="default" />';
2571: if (!$hide) {
2572: $result .= &mt('default');
2573: }
2574: $result .= "\n";
1.33 matthew 2575: }
1.586 raeburn 2576: return ($result,$numlib);
1.33 matthew 2577: }
1.112 bowersj2 2578:
2579: =pod
2580:
1.534 albertel 2581: =back
2582:
1.112 bowersj2 2583: =cut
1.87 matthew 2584:
2585: ###############################################################
1.112 bowersj2 2586: ## Decoding User Agent ##
1.87 matthew 2587: ###############################################################
2588:
2589: =pod
2590:
1.112 bowersj2 2591: =head1 Decoding the User Agent
2592:
2593: =over 4
2594:
2595: =item * &decode_user_agent()
1.87 matthew 2596:
2597: Inputs: $r
2598:
2599: Outputs:
2600:
2601: =over 4
2602:
1.112 bowersj2 2603: =item * $httpbrowser
1.87 matthew 2604:
1.112 bowersj2 2605: =item * $clientbrowser
1.87 matthew 2606:
1.112 bowersj2 2607: =item * $clientversion
1.87 matthew 2608:
1.112 bowersj2 2609: =item * $clientmathml
1.87 matthew 2610:
1.112 bowersj2 2611: =item * $clientunicode
1.87 matthew 2612:
1.112 bowersj2 2613: =item * $clientos
1.87 matthew 2614:
1.1137 raeburn 2615: =item * $clientmobile
2616:
1.1141 raeburn 2617: =item * $clientinfo
2618:
1.1194 raeburn 2619: =item * $clientosversion
2620:
1.87 matthew 2621: =back
2622:
1.157 matthew 2623: =back
2624:
1.87 matthew 2625: =cut
2626:
2627: ###############################################################
2628: ###############################################################
2629: sub decode_user_agent {
1.247 albertel 2630: my ($r)=@_;
1.87 matthew 2631: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2632: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2633: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2634: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2635: my $clientbrowser='unknown';
2636: my $clientversion='0';
2637: my $clientmathml='';
2638: my $clientunicode='0';
1.1137 raeburn 2639: my $clientmobile=0;
1.1194 raeburn 2640: my $clientosversion='';
1.87 matthew 2641: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2642: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2643: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2644: $clientbrowser=$bname;
2645: $httpbrowser=~/$vreg/i;
2646: $clientversion=$1;
2647: $clientmathml=($clientversion>=$minv);
2648: $clientunicode=($clientversion>=$univ);
2649: }
2650: }
2651: my $clientos='unknown';
1.1141 raeburn 2652: my $clientinfo;
1.87 matthew 2653: if (($httpbrowser=~/linux/i) ||
2654: ($httpbrowser=~/unix/i) ||
2655: ($httpbrowser=~/ux/i) ||
2656: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2657: if (($httpbrowser=~/vax/i) ||
2658: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2659: if ($httpbrowser=~/next/i) { $clientos='next'; }
2660: if (($httpbrowser=~/mac/i) ||
2661: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2662: if ($httpbrowser=~/win/i) {
2663: $clientos='win';
2664: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2665: $clientosversion = $1;
2666: }
2667: }
1.87 matthew 2668: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2669: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2670: $clientmobile=lc($1);
2671: }
1.1141 raeburn 2672: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2673: $clientinfo = 'firefox-'.$1;
2674: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2675: $clientinfo = 'chromeframe-'.$1;
2676: }
1.87 matthew 2677: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2678: $clientunicode,$clientos,$clientmobile,$clientinfo,
2679: $clientosversion);
1.87 matthew 2680: }
2681:
1.32 matthew 2682: ###############################################################
2683: ## Authentication changing form generation subroutines ##
2684: ###############################################################
2685: ##
2686: ## All of the authform_xxxxxxx subroutines take their inputs in a
2687: ## hash, and have reasonable default values.
2688: ##
2689: ## formname = the name given in the <form> tag.
1.35 matthew 2690: #-------------------------------------------
2691:
1.45 matthew 2692: =pod
2693:
1.112 bowersj2 2694: =head1 Authentication Routines
2695:
2696: =over 4
2697:
1.648 raeburn 2698: =item * &authform_xxxxxx()
1.35 matthew 2699:
2700: The authform_xxxxxx subroutines provide javascript and html forms which
2701: handle some of the conveniences required for authentication forms.
2702: This is not an optimal method, but it works.
2703:
2704: =over 4
2705:
1.112 bowersj2 2706: =item * authform_header
1.35 matthew 2707:
1.112 bowersj2 2708: =item * authform_authorwarning
1.35 matthew 2709:
1.112 bowersj2 2710: =item * authform_nochange
1.35 matthew 2711:
1.112 bowersj2 2712: =item * authform_kerberos
1.35 matthew 2713:
1.112 bowersj2 2714: =item * authform_internal
1.35 matthew 2715:
1.112 bowersj2 2716: =item * authform_filesystem
1.35 matthew 2717:
2718: =back
2719:
1.648 raeburn 2720: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2721:
1.35 matthew 2722: =cut
2723:
2724: #-------------------------------------------
1.32 matthew 2725: sub authform_header{
2726: my %in = (
2727: formname => 'cu',
1.80 albertel 2728: kerb_def_dom => '',
1.32 matthew 2729: @_,
2730: );
2731: $in{'formname'} = 'document.' . $in{'formname'};
2732: my $result='';
1.80 albertel 2733:
2734: #---------------------------------------------- Code for upper case translation
2735: my $Javascript_toUpperCase;
2736: unless ($in{kerb_def_dom}) {
2737: $Javascript_toUpperCase =<<"END";
2738: switch (choice) {
2739: case 'krb': currentform.elements[choicearg].value =
2740: currentform.elements[choicearg].value.toUpperCase();
2741: break;
2742: default:
2743: }
2744: END
2745: } else {
2746: $Javascript_toUpperCase = "";
2747: }
2748:
1.165 raeburn 2749: my $radioval = "'nochange'";
1.591 raeburn 2750: if (defined($in{'curr_authtype'})) {
2751: if ($in{'curr_authtype'} ne '') {
2752: $radioval = "'".$in{'curr_authtype'}."arg'";
2753: }
1.174 matthew 2754: }
1.165 raeburn 2755: my $argfield = 'null';
1.591 raeburn 2756: if (defined($in{'mode'})) {
1.165 raeburn 2757: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2758: if (defined($in{'curr_autharg'})) {
2759: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2760: $argfield = "'$in{'curr_autharg'}'";
2761: }
2762: }
2763: }
2764: }
2765:
1.32 matthew 2766: $result.=<<"END";
2767: var current = new Object();
1.165 raeburn 2768: current.radiovalue = $radioval;
2769: current.argfield = $argfield;
1.32 matthew 2770:
2771: function changed_radio(choice,currentform) {
2772: var choicearg = choice + 'arg';
2773: // If a radio button in changed, we need to change the argfield
2774: if (current.radiovalue != choice) {
2775: current.radiovalue = choice;
2776: if (current.argfield != null) {
2777: currentform.elements[current.argfield].value = '';
2778: }
2779: if (choice == 'nochange') {
2780: current.argfield = null;
2781: } else {
2782: current.argfield = choicearg;
2783: switch(choice) {
2784: case 'krb':
2785: currentform.elements[current.argfield].value =
2786: "$in{'kerb_def_dom'}";
2787: break;
2788: default:
2789: break;
2790: }
2791: }
2792: }
2793: return;
2794: }
1.22 www 2795:
1.32 matthew 2796: function changed_text(choice,currentform) {
2797: var choicearg = choice + 'arg';
2798: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2799: $Javascript_toUpperCase
1.32 matthew 2800: // clear old field
2801: if ((current.argfield != choicearg) && (current.argfield != null)) {
2802: currentform.elements[current.argfield].value = '';
2803: }
2804: current.argfield = choicearg;
2805: }
2806: set_auth_radio_buttons(choice,currentform);
2807: return;
1.20 www 2808: }
1.32 matthew 2809:
2810: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2811: var numauthchoices = currentform.login.length;
2812: if (typeof numauthchoices == "undefined") {
2813: return;
2814: }
1.32 matthew 2815: var i=0;
1.986 raeburn 2816: while (i < numauthchoices) {
1.32 matthew 2817: if (currentform.login[i].value == newvalue) { break; }
2818: i++;
2819: }
1.986 raeburn 2820: if (i == numauthchoices) {
1.32 matthew 2821: return;
2822: }
2823: current.radiovalue = newvalue;
2824: currentform.login[i].checked = true;
2825: return;
2826: }
2827: END
2828: return $result;
2829: }
2830:
1.1106 raeburn 2831: sub authform_authorwarning {
1.32 matthew 2832: my $result='';
1.144 matthew 2833: $result='<i>'.
2834: &mt('As a general rule, only authors or co-authors should be '.
2835: 'filesystem authenticated '.
2836: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2837: return $result;
2838: }
2839:
1.1106 raeburn 2840: sub authform_nochange {
1.32 matthew 2841: my %in = (
2842: formname => 'document.cu',
2843: kerb_def_dom => 'MSU.EDU',
2844: @_,
2845: );
1.1106 raeburn 2846: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2847: my $result;
1.1104 raeburn 2848: if (!$authnum) {
1.1105 raeburn 2849: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2850: } else {
2851: $result = '<label>'.&mt('[_1] Do not change login data',
2852: '<input type="radio" name="login" value="nochange" '.
2853: 'checked="checked" onclick="'.
1.281 albertel 2854: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2855: '</label>';
1.586 raeburn 2856: }
1.32 matthew 2857: return $result;
2858: }
2859:
1.591 raeburn 2860: sub authform_kerberos {
1.32 matthew 2861: my %in = (
2862: formname => 'document.cu',
2863: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2864: kerb_def_auth => 'krb4',
1.32 matthew 2865: @_,
2866: );
1.586 raeburn 2867: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2868: $autharg,$jscall);
1.1106 raeburn 2869: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2870: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2871: $check5 = ' checked="checked"';
1.80 albertel 2872: } else {
1.772 bisitz 2873: $check4 = ' checked="checked"';
1.80 albertel 2874: }
1.165 raeburn 2875: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2876: if (defined($in{'curr_authtype'})) {
2877: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2878: $krbcheck = ' checked="checked"';
1.623 raeburn 2879: if (defined($in{'mode'})) {
2880: if ($in{'mode'} eq 'modifyuser') {
2881: $krbcheck = '';
2882: }
2883: }
1.591 raeburn 2884: if (defined($in{'curr_kerb_ver'})) {
2885: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2886: $check5 = ' checked="checked"';
1.591 raeburn 2887: $check4 = '';
2888: } else {
1.772 bisitz 2889: $check4 = ' checked="checked"';
1.591 raeburn 2890: $check5 = '';
2891: }
1.586 raeburn 2892: }
1.591 raeburn 2893: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2894: $krbarg = $in{'curr_autharg'};
2895: }
1.586 raeburn 2896: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2897: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2898: $result =
2899: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2900: $in{'curr_autharg'},$krbver);
2901: } else {
2902: $result =
2903: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2904: }
2905: return $result;
2906: }
2907: }
2908: } else {
2909: if ($authnum == 1) {
1.784 bisitz 2910: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2911: }
2912: }
1.586 raeburn 2913: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2914: return;
1.587 raeburn 2915: } elsif ($authtype eq '') {
1.591 raeburn 2916: if (defined($in{'mode'})) {
1.587 raeburn 2917: if ($in{'mode'} eq 'modifycourse') {
2918: if ($authnum == 1) {
1.1104 raeburn 2919: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2920: }
2921: }
2922: }
1.586 raeburn 2923: }
2924: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2925: if ($authtype eq '') {
2926: $authtype = '<input type="radio" name="login" value="krb" '.
2927: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2928: $krbcheck.' />';
2929: }
2930: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2931: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2932: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2933: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2934: $in{'curr_authtype'} eq 'krb4')) {
2935: $result .= &mt
1.144 matthew 2936: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2937: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2938: '<label>'.$authtype,
1.281 albertel 2939: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2940: 'value="'.$krbarg.'" '.
1.144 matthew 2941: 'onchange="'.$jscall.'" />',
1.281 albertel 2942: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2943: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2944: '</label>');
1.586 raeburn 2945: } elsif ($can_assign{'krb4'}) {
2946: $result .= &mt
2947: ('[_1] Kerberos authenticated with domain [_2] '.
2948: '[_3] Version 4 [_4]',
2949: '<label>'.$authtype,
2950: '</label><input type="text" size="10" name="krbarg" '.
2951: 'value="'.$krbarg.'" '.
2952: 'onchange="'.$jscall.'" />',
2953: '<label><input type="hidden" name="krbver" value="4" />',
2954: '</label>');
2955: } elsif ($can_assign{'krb5'}) {
2956: $result .= &mt
2957: ('[_1] Kerberos authenticated with domain [_2] '.
2958: '[_3] Version 5 [_4]',
2959: '<label>'.$authtype,
2960: '</label><input type="text" size="10" name="krbarg" '.
2961: 'value="'.$krbarg.'" '.
2962: 'onchange="'.$jscall.'" />',
2963: '<label><input type="hidden" name="krbver" value="5" />',
2964: '</label>');
2965: }
1.32 matthew 2966: return $result;
2967: }
2968:
1.1106 raeburn 2969: sub authform_internal {
1.586 raeburn 2970: my %in = (
1.32 matthew 2971: formname => 'document.cu',
2972: kerb_def_dom => 'MSU.EDU',
2973: @_,
2974: );
1.586 raeburn 2975: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2976: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2977: if (defined($in{'curr_authtype'})) {
2978: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2979: if ($can_assign{'int'}) {
1.772 bisitz 2980: $intcheck = 'checked="checked" ';
1.623 raeburn 2981: if (defined($in{'mode'})) {
2982: if ($in{'mode'} eq 'modifyuser') {
2983: $intcheck = '';
2984: }
2985: }
1.591 raeburn 2986: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2987: $intarg = $in{'curr_autharg'};
2988: }
2989: } else {
2990: $result = &mt('Currently internally authenticated.');
2991: return $result;
1.165 raeburn 2992: }
2993: }
1.586 raeburn 2994: } else {
2995: if ($authnum == 1) {
1.784 bisitz 2996: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2997: }
2998: }
2999: if (!$can_assign{'int'}) {
3000: return;
1.587 raeburn 3001: } elsif ($authtype eq '') {
1.591 raeburn 3002: if (defined($in{'mode'})) {
1.587 raeburn 3003: if ($in{'mode'} eq 'modifycourse') {
3004: if ($authnum == 1) {
1.1104 raeburn 3005: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 3006: }
3007: }
3008: }
1.165 raeburn 3009: }
1.586 raeburn 3010: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3011: if ($authtype eq '') {
3012: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
3013: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
3014: }
1.605 bisitz 3015: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3016: $intarg.'" onchange="'.$jscall.'" />';
3017: $result = &mt
1.144 matthew 3018: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3019: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3020: $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 3021: return $result;
3022: }
3023:
1.1104 raeburn 3024: sub authform_local {
1.32 matthew 3025: my %in = (
3026: formname => 'document.cu',
3027: kerb_def_dom => 'MSU.EDU',
3028: @_,
3029: );
1.586 raeburn 3030: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3031: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3032: if (defined($in{'curr_authtype'})) {
3033: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3034: if ($can_assign{'loc'}) {
1.772 bisitz 3035: $loccheck = 'checked="checked" ';
1.623 raeburn 3036: if (defined($in{'mode'})) {
3037: if ($in{'mode'} eq 'modifyuser') {
3038: $loccheck = '';
3039: }
3040: }
1.591 raeburn 3041: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3042: $locarg = $in{'curr_autharg'};
3043: }
3044: } else {
3045: $result = &mt('Currently using local (institutional) authentication.');
3046: return $result;
1.165 raeburn 3047: }
3048: }
1.586 raeburn 3049: } else {
3050: if ($authnum == 1) {
1.784 bisitz 3051: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3052: }
3053: }
3054: if (!$can_assign{'loc'}) {
3055: return;
1.587 raeburn 3056: } elsif ($authtype eq '') {
1.591 raeburn 3057: if (defined($in{'mode'})) {
1.587 raeburn 3058: if ($in{'mode'} eq 'modifycourse') {
3059: if ($authnum == 1) {
1.1104 raeburn 3060: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3061: }
3062: }
3063: }
1.165 raeburn 3064: }
1.586 raeburn 3065: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3066: if ($authtype eq '') {
3067: $authtype = '<input type="radio" name="login" value="loc" '.
3068: $loccheck.' onchange="'.$jscall.'" onclick="'.
3069: $jscall.'" />';
3070: }
3071: $autharg = '<input type="text" size="10" name="locarg" value="'.
3072: $locarg.'" onchange="'.$jscall.'" />';
3073: $result = &mt('[_1] Local Authentication with argument [_2]',
3074: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3075: return $result;
3076: }
3077:
1.1106 raeburn 3078: sub authform_filesystem {
1.32 matthew 3079: my %in = (
3080: formname => 'document.cu',
3081: kerb_def_dom => 'MSU.EDU',
3082: @_,
3083: );
1.586 raeburn 3084: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3085: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3086: if (defined($in{'curr_authtype'})) {
3087: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3088: if ($can_assign{'fsys'}) {
1.772 bisitz 3089: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3090: if (defined($in{'mode'})) {
3091: if ($in{'mode'} eq 'modifyuser') {
3092: $fsyscheck = '';
3093: }
3094: }
1.586 raeburn 3095: } else {
3096: $result = &mt('Currently Filesystem Authenticated.');
3097: return $result;
3098: }
3099: }
3100: } else {
3101: if ($authnum == 1) {
1.784 bisitz 3102: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3103: }
3104: }
3105: if (!$can_assign{'fsys'}) {
3106: return;
1.587 raeburn 3107: } elsif ($authtype eq '') {
1.591 raeburn 3108: if (defined($in{'mode'})) {
1.587 raeburn 3109: if ($in{'mode'} eq 'modifycourse') {
3110: if ($authnum == 1) {
1.1104 raeburn 3111: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3112: }
3113: }
3114: }
1.586 raeburn 3115: }
3116: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3117: if ($authtype eq '') {
3118: $authtype = '<input type="radio" name="login" value="fsys" '.
3119: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3120: $jscall.'" />';
3121: }
3122: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3123: ' onchange="'.$jscall.'" />';
3124: $result = &mt
1.144 matthew 3125: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3126: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3127: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3128: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3129: 'onchange="'.$jscall.'" />');
1.32 matthew 3130: return $result;
3131: }
3132:
1.586 raeburn 3133: sub get_assignable_auth {
3134: my ($dom) = @_;
3135: if ($dom eq '') {
3136: $dom = $env{'request.role.domain'};
3137: }
3138: my %can_assign = (
3139: krb4 => 1,
3140: krb5 => 1,
3141: int => 1,
3142: loc => 1,
3143: );
3144: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3145: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3146: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3147: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3148: my $context;
3149: if ($env{'request.role'} =~ /^au/) {
3150: $context = 'author';
3151: } elsif ($env{'request.role'} =~ /^dc/) {
3152: $context = 'domain';
3153: } elsif ($env{'request.course.id'}) {
3154: $context = 'course';
3155: }
3156: if ($context) {
3157: if (ref($authhash->{$context}) eq 'HASH') {
3158: %can_assign = %{$authhash->{$context}};
3159: }
3160: }
3161: }
3162: }
3163: my $authnum = 0;
3164: foreach my $key (keys(%can_assign)) {
3165: if ($can_assign{$key}) {
3166: $authnum ++;
3167: }
3168: }
3169: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3170: $authnum --;
3171: }
3172: return ($authnum,%can_assign);
3173: }
3174:
1.80 albertel 3175: ###############################################################
3176: ## Get Kerberos Defaults for Domain ##
3177: ###############################################################
3178: ##
3179: ## Returns default kerberos version and an associated argument
3180: ## as listed in file domain.tab. If not listed, provides
3181: ## appropriate default domain and kerberos version.
3182: ##
3183: #-------------------------------------------
3184:
3185: =pod
3186:
1.648 raeburn 3187: =item * &get_kerberos_defaults()
1.80 albertel 3188:
3189: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3190: version and domain. If not found, it defaults to version 4 and the
3191: domain of the server.
1.80 albertel 3192:
1.648 raeburn 3193: =over 4
3194:
1.80 albertel 3195: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3196:
1.648 raeburn 3197: =back
3198:
3199: =back
3200:
1.80 albertel 3201: =cut
3202:
3203: #-------------------------------------------
3204: sub get_kerberos_defaults {
3205: my $domain=shift;
1.641 raeburn 3206: my ($krbdef,$krbdefdom);
3207: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3208: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3209: $krbdef = $domdefaults{'auth_def'};
3210: $krbdefdom = $domdefaults{'auth_arg_def'};
3211: } else {
1.80 albertel 3212: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3213: my $krbdefdom=$1;
3214: $krbdefdom=~tr/a-z/A-Z/;
3215: $krbdef = "krb4";
3216: }
3217: return ($krbdef,$krbdefdom);
3218: }
1.112 bowersj2 3219:
1.32 matthew 3220:
1.46 matthew 3221: ###############################################################
3222: ## Thesaurus Functions ##
3223: ###############################################################
1.20 www 3224:
1.46 matthew 3225: =pod
1.20 www 3226:
1.112 bowersj2 3227: =head1 Thesaurus Functions
3228:
3229: =over 4
3230:
1.648 raeburn 3231: =item * &initialize_keywords()
1.46 matthew 3232:
3233: Initializes the package variable %Keywords if it is empty. Uses the
3234: package variable $thesaurus_db_file.
3235:
3236: =cut
3237:
3238: ###################################################
3239:
3240: sub initialize_keywords {
3241: return 1 if (scalar keys(%Keywords));
3242: # If we are here, %Keywords is empty, so fill it up
3243: # Make sure the file we need exists...
3244: if (! -e $thesaurus_db_file) {
3245: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3246: " failed because it does not exist");
3247: return 0;
3248: }
3249: # Set up the hash as a database
3250: my %thesaurus_db;
3251: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3252: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3253: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3254: $thesaurus_db_file);
3255: return 0;
3256: }
3257: # Get the average number of appearances of a word.
3258: my $avecount = $thesaurus_db{'average.count'};
3259: # Put keywords (those that appear > average) into %Keywords
3260: while (my ($word,$data)=each (%thesaurus_db)) {
3261: my ($count,undef) = split /:/,$data;
3262: $Keywords{$word}++ if ($count > $avecount);
3263: }
3264: untie %thesaurus_db;
3265: # Remove special values from %Keywords.
1.356 albertel 3266: foreach my $value ('total.count','average.count') {
3267: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3268: }
1.46 matthew 3269: return 1;
3270: }
3271:
3272: ###################################################
3273:
3274: =pod
3275:
1.648 raeburn 3276: =item * &keyword($word)
1.46 matthew 3277:
3278: Returns true if $word is a keyword. A keyword is a word that appears more
3279: than the average number of times in the thesaurus database. Calls
3280: &initialize_keywords
3281:
3282: =cut
3283:
3284: ###################################################
1.20 www 3285:
3286: sub keyword {
1.46 matthew 3287: return if (!&initialize_keywords());
3288: my $word=lc(shift());
3289: $word=~s/\W//g;
3290: return exists($Keywords{$word});
1.20 www 3291: }
1.46 matthew 3292:
3293: ###############################################################
3294:
3295: =pod
1.20 www 3296:
1.648 raeburn 3297: =item * &get_related_words()
1.46 matthew 3298:
1.160 matthew 3299: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3300: an array of words. If the keyword is not in the thesaurus, an empty array
3301: will be returned. The order of the words returned is determined by the
3302: database which holds them.
3303:
3304: Uses global $thesaurus_db_file.
3305:
1.1057 foxr 3306:
1.46 matthew 3307: =cut
3308:
3309: ###############################################################
3310: sub get_related_words {
3311: my $keyword = shift;
3312: my %thesaurus_db;
3313: if (! -e $thesaurus_db_file) {
3314: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3315: "failed because the file does not exist");
3316: return ();
3317: }
3318: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3319: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3320: return ();
3321: }
3322: my @Words=();
1.429 www 3323: my $count=0;
1.46 matthew 3324: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3325: # The first element is the number of times
3326: # the word appears. We do not need it now.
1.429 www 3327: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3328: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3329: my $threshold=$mostfrequentcount/10;
3330: foreach my $possibleword (@RelatedWords) {
3331: my ($word,$wordcount)=split(/\,/,$possibleword);
3332: if ($wordcount>$threshold) {
3333: push(@Words,$word);
3334: $count++;
3335: if ($count>10) { last; }
3336: }
1.20 www 3337: }
3338: }
1.46 matthew 3339: untie %thesaurus_db;
3340: return @Words;
1.14 harris41 3341: }
1.1090 foxr 3342: ###############################################################
3343: #
3344: # Spell checking
3345: #
3346:
3347: =pod
3348:
1.1142 raeburn 3349: =back
3350:
1.1090 foxr 3351: =head1 Spell checking
3352:
3353: =over 4
3354:
3355: =item * &check_spelling($wordlist $language)
3356:
3357: Takes a string containing words and feeds it to an external
3358: spellcheck program via a pipeline. Returns a string containing
3359: them mis-spelled words.
3360:
3361: Parameters:
3362:
3363: =over 4
3364:
3365: =item - $wordlist
3366:
3367: String that will be fed into the spellcheck program.
3368:
3369: =item - $language
3370:
3371: Language string that specifies the language for which the spell
3372: check will be performed.
3373:
3374: =back
3375:
3376: =back
3377:
3378: Note: This sub assumes that aspell is installed.
3379:
3380:
3381: =cut
3382:
1.46 matthew 3383:
1.1090 foxr 3384: sub check_spelling {
3385: my ($wordlist, $language) = @_;
1.1091 foxr 3386: my @misspellings;
3387:
3388: # Generate the speller and set the langauge.
3389: # if explicitly selected:
1.1090 foxr 3390:
1.1091 foxr 3391: my $speller = Text::Aspell->new;
1.1090 foxr 3392: if ($language) {
1.1091 foxr 3393: $speller->set_option('lang', $language);
1.1090 foxr 3394: }
3395:
1.1091 foxr 3396: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3397:
1.1091 foxr 3398: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3399:
1.1091 foxr 3400: foreach my $word (@words) {
3401: if(! $speller->check($word)) {
3402: push(@misspellings, $word);
1.1090 foxr 3403: }
3404: }
1.1091 foxr 3405: return join(' ', @misspellings);
3406:
1.1090 foxr 3407: }
3408:
1.61 www 3409: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3410: =pod
3411:
1.112 bowersj2 3412: =head1 User Name Functions
3413:
3414: =over 4
3415:
1.648 raeburn 3416: =item * &plainname($uname,$udom,$first)
1.81 albertel 3417:
1.112 bowersj2 3418: Takes a users logon name and returns it as a string in
1.226 albertel 3419: "first middle last generation" form
3420: if $first is set to 'lastname' then it returns it as
3421: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3422:
3423: =cut
1.61 www 3424:
1.295 www 3425:
1.81 albertel 3426: ###############################################################
1.61 www 3427: sub plainname {
1.226 albertel 3428: my ($uname,$udom,$first)=@_;
1.537 albertel 3429: return if (!defined($uname) || !defined($udom));
1.295 www 3430: my %names=&getnames($uname,$udom);
1.226 albertel 3431: my $name=&Apache::lonnet::format_name($names{'firstname'},
3432: $names{'middlename'},
3433: $names{'lastname'},
3434: $names{'generation'},$first);
3435: $name=~s/^\s+//;
1.62 www 3436: $name=~s/\s+$//;
3437: $name=~s/\s+/ /g;
1.353 albertel 3438: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3439: return $name;
1.61 www 3440: }
1.66 www 3441:
3442: # -------------------------------------------------------------------- Nickname
1.81 albertel 3443: =pod
3444:
1.648 raeburn 3445: =item * &nickname($uname,$udom)
1.81 albertel 3446:
3447: Gets a users name and returns it as a string as
3448:
3449: ""nickname""
1.66 www 3450:
1.81 albertel 3451: if the user has a nickname or
3452:
3453: "first middle last generation"
3454:
3455: if the user does not
3456:
3457: =cut
1.66 www 3458:
3459: sub nickname {
3460: my ($uname,$udom)=@_;
1.537 albertel 3461: return if (!defined($uname) || !defined($udom));
1.295 www 3462: my %names=&getnames($uname,$udom);
1.68 albertel 3463: my $name=$names{'nickname'};
1.66 www 3464: if ($name) {
3465: $name='"'.$name.'"';
3466: } else {
3467: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3468: $names{'lastname'}.' '.$names{'generation'};
3469: $name=~s/\s+$//;
3470: $name=~s/\s+/ /g;
3471: }
3472: return $name;
3473: }
3474:
1.295 www 3475: sub getnames {
3476: my ($uname,$udom)=@_;
1.537 albertel 3477: return if (!defined($uname) || !defined($udom));
1.433 albertel 3478: if ($udom eq 'public' && $uname eq 'public') {
3479: return ('lastname' => &mt('Public'));
3480: }
1.295 www 3481: my $id=$uname.':'.$udom;
3482: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3483: if ($cached) {
3484: return %{$names};
3485: } else {
3486: my %loadnames=&Apache::lonnet::get('environment',
3487: ['firstname','middlename','lastname','generation','nickname'],
3488: $udom,$uname);
3489: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3490: return %loadnames;
3491: }
3492: }
1.61 www 3493:
1.542 raeburn 3494: # -------------------------------------------------------------------- getemails
1.648 raeburn 3495:
1.542 raeburn 3496: =pod
3497:
1.648 raeburn 3498: =item * &getemails($uname,$udom)
1.542 raeburn 3499:
3500: Gets a user's email information and returns it as a hash with keys:
3501: notification, critnotification, permanentemail
3502:
3503: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3504: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3505:
1.648 raeburn 3506:
1.542 raeburn 3507: =cut
3508:
1.648 raeburn 3509:
1.466 albertel 3510: sub getemails {
3511: my ($uname,$udom)=@_;
3512: if ($udom eq 'public' && $uname eq 'public') {
3513: return;
3514: }
1.467 www 3515: if (!$udom) { $udom=$env{'user.domain'}; }
3516: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3517: my $id=$uname.':'.$udom;
3518: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3519: if ($cached) {
3520: return %{$names};
3521: } else {
3522: my %loadnames=&Apache::lonnet::get('environment',
3523: ['notification','critnotification',
3524: 'permanentemail'],
3525: $udom,$uname);
3526: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3527: return %loadnames;
3528: }
3529: }
3530:
1.551 albertel 3531: sub flush_email_cache {
3532: my ($uname,$udom)=@_;
3533: if (!$udom) { $udom =$env{'user.domain'}; }
3534: if (!$uname) { $uname=$env{'user.name'}; }
3535: return if ($udom eq 'public' && $uname eq 'public');
3536: my $id=$uname.':'.$udom;
3537: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3538: }
3539:
1.728 raeburn 3540: # -------------------------------------------------------------------- getlangs
3541:
3542: =pod
3543:
3544: =item * &getlangs($uname,$udom)
3545:
3546: Gets a user's language preference and returns it as a hash with key:
3547: language.
3548:
3549: =cut
3550:
3551:
3552: sub getlangs {
3553: my ($uname,$udom) = @_;
3554: if (!$udom) { $udom =$env{'user.domain'}; }
3555: if (!$uname) { $uname=$env{'user.name'}; }
3556: my $id=$uname.':'.$udom;
3557: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3558: if ($cached) {
3559: return %{$langs};
3560: } else {
3561: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3562: $udom,$uname);
3563: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3564: return %loadlangs;
3565: }
3566: }
3567:
3568: sub flush_langs_cache {
3569: my ($uname,$udom)=@_;
3570: if (!$udom) { $udom =$env{'user.domain'}; }
3571: if (!$uname) { $uname=$env{'user.name'}; }
3572: return if ($udom eq 'public' && $uname eq 'public');
3573: my $id=$uname.':'.$udom;
3574: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3575: }
3576:
1.61 www 3577: # ------------------------------------------------------------------ Screenname
1.81 albertel 3578:
3579: =pod
3580:
1.648 raeburn 3581: =item * &screenname($uname,$udom)
1.81 albertel 3582:
3583: Gets a users screenname and returns it as a string
3584:
3585: =cut
1.61 www 3586:
3587: sub screenname {
3588: my ($uname,$udom)=@_;
1.258 albertel 3589: if ($uname eq $env{'user.name'} &&
3590: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3591: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3592: return $names{'screenname'};
1.62 www 3593: }
3594:
1.212 albertel 3595:
1.802 bisitz 3596: # ------------------------------------------------------------- Confirm Wrapper
3597: =pod
3598:
1.1142 raeburn 3599: =item * &confirmwrapper($message)
1.802 bisitz 3600:
3601: Wrap messages about completion of operation in box
3602:
3603: =cut
3604:
3605: sub confirmwrapper {
3606: my ($message)=@_;
3607: if ($message) {
3608: return "\n".'<div class="LC_confirm_box">'."\n"
3609: .$message."\n"
3610: .'</div>'."\n";
3611: } else {
3612: return $message;
3613: }
3614: }
3615:
1.62 www 3616: # ------------------------------------------------------------- Message Wrapper
3617:
3618: sub messagewrapper {
1.369 www 3619: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3620: return
1.441 albertel 3621: '<a href="/adm/email?compose=individual&'.
3622: 'recname='.$username.'&recdom='.$domain.
3623: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3624: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3625: }
1.802 bisitz 3626:
1.74 www 3627: # --------------------------------------------------------------- Notes Wrapper
3628:
3629: sub noteswrapper {
3630: my ($link,$un,$do)=@_;
3631: return
1.896 amueller 3632: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3633: }
1.802 bisitz 3634:
1.62 www 3635: # ------------------------------------------------------------- Aboutme Wrapper
3636:
3637: sub aboutmewrapper {
1.1070 raeburn 3638: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3639: if (!defined($username) && !defined($domain)) {
3640: return;
3641: }
1.1096 raeburn 3642: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3643: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3644: }
3645:
3646: # ------------------------------------------------------------ Syllabus Wrapper
3647:
3648: sub syllabuswrapper {
1.707 bisitz 3649: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3650: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3651: }
1.14 harris41 3652:
1.802 bisitz 3653: # -----------------------------------------------------------------------------
3654:
1.208 matthew 3655: sub track_student_link {
1.887 raeburn 3656: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3657: my $link ="/adm/trackstudent?";
1.208 matthew 3658: my $title = 'View recent activity';
3659: if (defined($sname) && $sname !~ /^\s*$/ &&
3660: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3661: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3662: $title .= ' of this student';
1.268 albertel 3663: }
1.208 matthew 3664: if (defined($target) && $target !~ /^\s*$/) {
3665: $target = qq{target="$target"};
3666: } else {
3667: $target = '';
3668: }
1.268 albertel 3669: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3670: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3671: $title = &mt($title);
3672: $linktext = &mt($linktext);
1.448 albertel 3673: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3674: &help_open_topic('View_recent_activity');
1.208 matthew 3675: }
3676:
1.781 raeburn 3677: sub slot_reservations_link {
3678: my ($linktext,$sname,$sdom,$target) = @_;
3679: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3680: my $title = 'View slot reservation history';
3681: if (defined($sname) && $sname !~ /^\s*$/ &&
3682: defined($sdom) && $sdom !~ /^\s*$/) {
3683: $link .= "&uname=$sname&udom=$sdom";
3684: $title .= ' of this student';
3685: }
3686: if (defined($target) && $target !~ /^\s*$/) {
3687: $target = qq{target="$target"};
3688: } else {
3689: $target = '';
3690: }
3691: $title = &mt($title);
3692: $linktext = &mt($linktext);
3693: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3694: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3695:
3696: }
3697:
1.508 www 3698: # ===================================================== Display a student photo
3699:
3700:
1.509 albertel 3701: sub student_image_tag {
1.508 www 3702: my ($domain,$user)=@_;
3703: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3704: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3705: return '<img src="'.$imgsrc.'" align="right" />';
3706: } else {
3707: return '';
3708: }
3709: }
3710:
1.112 bowersj2 3711: =pod
3712:
3713: =back
3714:
3715: =head1 Access .tab File Data
3716:
3717: =over 4
3718:
1.648 raeburn 3719: =item * &languageids()
1.112 bowersj2 3720:
3721: returns list of all language ids
3722:
3723: =cut
3724:
1.14 harris41 3725: sub languageids {
1.16 harris41 3726: return sort(keys(%language));
1.14 harris41 3727: }
3728:
1.112 bowersj2 3729: =pod
3730:
1.648 raeburn 3731: =item * &languagedescription()
1.112 bowersj2 3732:
3733: returns description of a specified language id
3734:
3735: =cut
3736:
1.14 harris41 3737: sub languagedescription {
1.125 www 3738: my $code=shift;
3739: return ($supported_language{$code}?'* ':'').
3740: $language{$code}.
1.126 www 3741: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3742: }
3743:
1.1048 foxr 3744: =pod
3745:
3746: =item * &plainlanguagedescription
3747:
3748: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3749: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3750:
3751: =cut
3752:
1.145 www 3753: sub plainlanguagedescription {
3754: my $code=shift;
3755: return $language{$code};
3756: }
3757:
1.1048 foxr 3758: =pod
3759:
3760: =item * &supportedlanguagecode
3761:
3762: Returns the supported language code (e.g. sptutf maps to pt) given a language
3763: code.
3764:
3765: =cut
3766:
1.145 www 3767: sub supportedlanguagecode {
3768: my $code=shift;
3769: return $supported_language{$code};
1.97 www 3770: }
3771:
1.112 bowersj2 3772: =pod
3773:
1.1048 foxr 3774: =item * &latexlanguage()
3775:
3776: Given a language key code returns the correspondnig language to use
3777: to select the correct hyphenation on LaTeX printouts. This is undef if there
3778: is no supported hyphenation for the language code.
3779:
3780: =cut
3781:
3782: sub latexlanguage {
3783: my $code = shift;
3784: return $latex_language{$code};
3785: }
3786:
3787: =pod
3788:
3789: =item * &latexhyphenation()
3790:
3791: Same as above but what's supplied is the language as it might be stored
3792: in the metadata.
3793:
3794: =cut
3795:
3796: sub latexhyphenation {
3797: my $key = shift;
3798: return $latex_language_bykey{$key};
3799: }
3800:
3801: =pod
3802:
1.648 raeburn 3803: =item * ©rightids()
1.112 bowersj2 3804:
3805: returns list of all copyrights
3806:
3807: =cut
3808:
3809: sub copyrightids {
3810: return sort(keys(%cprtag));
3811: }
3812:
3813: =pod
3814:
1.648 raeburn 3815: =item * ©rightdescription()
1.112 bowersj2 3816:
3817: returns description of a specified copyright id
3818:
3819: =cut
3820:
3821: sub copyrightdescription {
1.166 www 3822: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3823: }
1.197 matthew 3824:
3825: =pod
3826:
1.648 raeburn 3827: =item * &source_copyrightids()
1.192 taceyjo1 3828:
3829: returns list of all source copyrights
3830:
3831: =cut
3832:
3833: sub source_copyrightids {
3834: return sort(keys(%scprtag));
3835: }
3836:
3837: =pod
3838:
1.648 raeburn 3839: =item * &source_copyrightdescription()
1.192 taceyjo1 3840:
3841: returns description of a specified source copyright id
3842:
3843: =cut
3844:
3845: sub source_copyrightdescription {
3846: return &mt($scprtag{shift(@_)});
3847: }
1.112 bowersj2 3848:
3849: =pod
3850:
1.648 raeburn 3851: =item * &filecategories()
1.112 bowersj2 3852:
3853: returns list of all file categories
3854:
3855: =cut
3856:
3857: sub filecategories {
3858: return sort(keys(%category_extensions));
3859: }
3860:
3861: =pod
3862:
1.648 raeburn 3863: =item * &filecategorytypes()
1.112 bowersj2 3864:
3865: returns list of file types belonging to a given file
3866: category
3867:
3868: =cut
3869:
3870: sub filecategorytypes {
1.356 albertel 3871: my ($cat) = @_;
3872: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3873: }
3874:
3875: =pod
3876:
1.648 raeburn 3877: =item * &fileembstyle()
1.112 bowersj2 3878:
3879: returns embedding style for a specified file type
3880:
3881: =cut
3882:
3883: sub fileembstyle {
3884: return $fe{lc(shift(@_))};
1.169 www 3885: }
3886:
1.351 www 3887: sub filemimetype {
3888: return $fm{lc(shift(@_))};
3889: }
3890:
1.169 www 3891:
3892: sub filecategoryselect {
3893: my ($name,$value)=@_;
1.189 matthew 3894: return &select_form($value,$name,
1.970 raeburn 3895: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3896: }
3897:
3898: =pod
3899:
1.648 raeburn 3900: =item * &filedescription()
1.112 bowersj2 3901:
3902: returns description for a specified file type
3903:
3904: =cut
3905:
3906: sub filedescription {
1.188 matthew 3907: my $file_description = $fd{lc(shift())};
3908: $file_description =~ s:([\[\]]):~$1:g;
3909: return &mt($file_description);
1.112 bowersj2 3910: }
3911:
3912: =pod
3913:
1.648 raeburn 3914: =item * &filedescriptionex()
1.112 bowersj2 3915:
3916: returns description for a specified file type with
3917: extra formatting
3918:
3919: =cut
3920:
3921: sub filedescriptionex {
3922: my $ex=shift;
1.188 matthew 3923: my $file_description = $fd{lc($ex)};
3924: $file_description =~ s:([\[\]]):~$1:g;
3925: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3926: }
3927:
3928: # End of .tab access
3929: =pod
3930:
3931: =back
3932:
3933: =cut
3934:
3935: # ------------------------------------------------------------------ File Types
3936: sub fileextensions {
3937: return sort(keys(%fe));
3938: }
3939:
1.97 www 3940: # ----------------------------------------------------------- Display Languages
3941: # returns a hash with all desired display languages
3942: #
3943:
3944: sub display_languages {
3945: my %languages=();
1.695 raeburn 3946: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3947: $languages{$lang}=1;
1.97 www 3948: }
3949: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3950: if ($env{'form.displaylanguage'}) {
1.356 albertel 3951: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3952: $languages{$lang}=1;
1.97 www 3953: }
3954: }
3955: return %languages;
1.14 harris41 3956: }
3957:
1.582 albertel 3958: sub languages {
3959: my ($possible_langs) = @_;
1.695 raeburn 3960: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3961: if (!ref($possible_langs)) {
3962: if( wantarray ) {
3963: return @preferred_langs;
3964: } else {
3965: return $preferred_langs[0];
3966: }
3967: }
3968: my %possibilities = map { $_ => 1 } (@$possible_langs);
3969: my @preferred_possibilities;
3970: foreach my $preferred_lang (@preferred_langs) {
3971: if (exists($possibilities{$preferred_lang})) {
3972: push(@preferred_possibilities, $preferred_lang);
3973: }
3974: }
3975: if( wantarray ) {
3976: return @preferred_possibilities;
3977: }
3978: return $preferred_possibilities[0];
3979: }
3980:
1.742 raeburn 3981: sub user_lang {
3982: my ($touname,$toudom,$fromcid) = @_;
3983: my @userlangs;
3984: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3985: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3986: $env{'course.'.$fromcid.'.languages'}));
3987: } else {
3988: my %langhash = &getlangs($touname,$toudom);
3989: if ($langhash{'languages'} ne '') {
3990: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3991: } else {
3992: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3993: if ($domdefs{'lang_def'} ne '') {
3994: @userlangs = ($domdefs{'lang_def'});
3995: }
3996: }
3997: }
3998: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3999: my $user_lh = Apache::localize->get_handle(@languages);
4000: return $user_lh;
4001: }
4002:
4003:
1.112 bowersj2 4004: ###############################################################
4005: ## Student Answer Attempts ##
4006: ###############################################################
4007:
4008: =pod
4009:
4010: =head1 Alternate Problem Views
4011:
4012: =over 4
4013:
1.648 raeburn 4014: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4015: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4016:
4017: Return string with previous attempt on problem. Arguments:
4018:
4019: =over 4
4020:
4021: =item * $symb: Problem, including path
4022:
4023: =item * $username: username of the desired student
4024:
4025: =item * $domain: domain of the desired student
1.14 harris41 4026:
1.112 bowersj2 4027: =item * $course: Course ID
1.14 harris41 4028:
1.112 bowersj2 4029: =item * $getattempt: Leave blank for all attempts, otherwise put
4030: something
1.14 harris41 4031:
1.112 bowersj2 4032: =item * $regexp: if string matches this regexp, the string will be
4033: sent to $gradesub
1.14 harris41 4034:
1.112 bowersj2 4035: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4036:
1.1199 raeburn 4037: =item * $usec: section of the desired student
4038:
4039: =item * $identifier: counter for student (multiple students one problem) or
4040: problem (one student; whole sequence).
4041:
1.112 bowersj2 4042: =back
1.14 harris41 4043:
1.112 bowersj2 4044: The output string is a table containing all desired attempts, if any.
1.16 harris41 4045:
1.112 bowersj2 4046: =cut
1.1 albertel 4047:
4048: sub get_previous_attempt {
1.1199 raeburn 4049: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4050: my $prevattempts='';
1.43 ng 4051: no strict 'refs';
1.1 albertel 4052: if ($symb) {
1.3 albertel 4053: my (%returnhash)=
4054: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4055: if ($returnhash{'version'}) {
4056: my %lasthash=();
4057: my $version;
4058: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4059: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4060: if ($key =~ /\.rawrndseed$/) {
4061: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4062: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4063: } else {
4064: $lasthash{$key}=$returnhash{$version.':'.$key};
4065: }
1.19 harris41 4066: }
1.1 albertel 4067: }
1.596 albertel 4068: $prevattempts=&start_data_table().&start_data_table_header_row();
4069: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4070: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4071: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4072: foreach my $key (sort(keys(%lasthash))) {
4073: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4074: if ($#parts > 0) {
1.31 albertel 4075: my $data=$parts[-1];
1.989 raeburn 4076: next if ($data eq 'foilorder');
1.31 albertel 4077: pop(@parts);
1.1010 www 4078: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4079: if ($data eq 'type') {
4080: unless ($showsurv) {
4081: my $id = join(',',@parts);
4082: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4083: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4084: $lasthidden{$ign.'.'.$id} = 1;
4085: }
1.945 raeburn 4086: }
1.1199 raeburn 4087: if ($identifier ne '') {
4088: my $id = join(',',@parts);
4089: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4090: $domain,$username,$usec,undef,$course) =~ /^no/) {
4091: $hidestatus{$ign.'.'.$id} = 1;
4092: }
4093: }
4094: } elsif ($data eq 'regrader') {
4095: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4096: my $id = join(',',@parts);
4097: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4098: }
1.1010 www 4099: }
1.31 albertel 4100: } else {
1.41 ng 4101: if ($#parts == 0) {
4102: $prevattempts.='<th>'.$parts[0].'</th>';
4103: } else {
4104: $prevattempts.='<th>'.$ign.'</th>';
4105: }
1.31 albertel 4106: }
1.16 harris41 4107: }
1.596 albertel 4108: $prevattempts.=&end_data_table_header_row();
1.40 ng 4109: if ($getattempt eq '') {
1.1199 raeburn 4110: my (%solved,%resets,%probstatus);
1.1200 raeburn 4111: if (($identifier ne '') && (keys(%regraded) > 0)) {
4112: for ($version=1;$version<=$returnhash{'version'};$version++) {
4113: foreach my $id (keys(%regraded)) {
4114: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4115: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4116: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4117: push(@{$resets{$id}},$version);
1.1199 raeburn 4118: }
4119: }
4120: }
1.1200 raeburn 4121: }
4122: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4123: my (@hidden,@unsolved);
1.945 raeburn 4124: if (%typeparts) {
4125: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4126: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4127: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4128: push(@hidden,$id);
1.1199 raeburn 4129: } elsif ($identifier ne '') {
4130: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4131: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4132: ($hidestatus{$id})) {
1.1200 raeburn 4133: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4134: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4135: push(@{$solved{$id}},$version);
4136: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4137: (ref($solved{$id}) eq 'ARRAY')) {
4138: my $skip;
4139: if (ref($resets{$id}) eq 'ARRAY') {
4140: foreach my $reset (@{$resets{$id}}) {
4141: if ($reset > $solved{$id}[-1]) {
4142: $skip=1;
4143: last;
4144: }
4145: }
4146: }
4147: unless ($skip) {
4148: my ($ign,$partslist) = split(/\./,$id,2);
4149: push(@unsolved,$partslist);
4150: }
4151: }
4152: }
1.945 raeburn 4153: }
4154: }
4155: }
4156: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4157: '<td>'.&mt('Transaction [_1]',$version);
4158: if (@unsolved) {
4159: $prevattempts .= '<span class="LC_nobreak"><label>'.
4160: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4161: &mt('Hide').'</label></span>';
4162: }
4163: $prevattempts .= '</td>';
1.945 raeburn 4164: if (@hidden) {
4165: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4166: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4167: my $hide;
4168: foreach my $id (@hidden) {
4169: if ($key =~ /^\Q$id\E/) {
4170: $hide = 1;
4171: last;
4172: }
4173: }
4174: if ($hide) {
4175: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4176: if (($data eq 'award') || ($data eq 'awarddetail')) {
4177: my $value = &format_previous_attempt_value($key,
4178: $returnhash{$version.':'.$key});
1.1173 kruse 4179: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4180: } else {
4181: $prevattempts.='<td> </td>';
4182: }
4183: } else {
4184: if ($key =~ /\./) {
1.1212 raeburn 4185: my $value = $returnhash{$version.':'.$key};
4186: if ($key =~ /\.rndseed$/) {
4187: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4188: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4189: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4190: }
4191: }
4192: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4193: ' </td>';
1.945 raeburn 4194: } else {
4195: $prevattempts.='<td> </td>';
4196: }
4197: }
4198: }
4199: } else {
4200: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4201: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4202: my $value = $returnhash{$version.':'.$key};
4203: if ($key =~ /\.rndseed$/) {
4204: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4205: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4206: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4207: }
4208: }
4209: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4210: ' </td>';
1.945 raeburn 4211: }
4212: }
4213: $prevattempts.=&end_data_table_row();
1.40 ng 4214: }
1.1 albertel 4215: }
1.945 raeburn 4216: my @currhidden = keys(%lasthidden);
1.596 albertel 4217: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4218: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4219: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4220: if (%typeparts) {
4221: my $hidden;
4222: foreach my $id (@currhidden) {
4223: if ($key =~ /^\Q$id\E/) {
4224: $hidden = 1;
4225: last;
4226: }
4227: }
4228: if ($hidden) {
4229: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4230: if (($data eq 'award') || ($data eq 'awarddetail')) {
4231: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4232: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4233: $value = &$gradesub($value);
4234: }
1.1173 kruse 4235: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4236: } else {
4237: $prevattempts.='<td> </td>';
4238: }
4239: } else {
4240: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4241: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4242: $value = &$gradesub($value);
4243: }
1.1173 kruse 4244: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4245: }
4246: } else {
4247: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4248: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4249: $value = &$gradesub($value);
4250: }
1.1173 kruse 4251: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4252: }
1.16 harris41 4253: }
1.596 albertel 4254: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4255: } else {
1.596 albertel 4256: $prevattempts=
4257: &start_data_table().&start_data_table_row().
4258: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4259: &end_data_table_row().&end_data_table();
1.1 albertel 4260: }
4261: } else {
1.596 albertel 4262: $prevattempts=
4263: &start_data_table().&start_data_table_row().
4264: '<td>'.&mt('No data.').'</td>'.
4265: &end_data_table_row().&end_data_table();
1.1 albertel 4266: }
1.10 albertel 4267: }
4268:
1.581 albertel 4269: sub format_previous_attempt_value {
4270: my ($key,$value) = @_;
1.1011 www 4271: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4272: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4273: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4274: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4275: } elsif ($key =~ /answerstring$/) {
4276: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4277: my @answer = %answers;
4278: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4279: my @anskeys = sort(keys(%answers));
4280: if (@anskeys == 1) {
4281: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4282: if ($answer =~ m{\0}) {
4283: $answer =~ s{\0}{,}g;
1.988 raeburn 4284: }
4285: my $tag_internal_answer_name = 'INTERNAL';
4286: if ($anskeys[0] eq $tag_internal_answer_name) {
4287: $value = $answer;
4288: } else {
4289: $value = $anskeys[0].'='.$answer;
4290: }
4291: } else {
4292: foreach my $ans (@anskeys) {
4293: my $answer = $answers{$ans};
1.1001 raeburn 4294: if ($answer =~ m{\0}) {
4295: $answer =~ s{\0}{,}g;
1.988 raeburn 4296: }
4297: $value .= $ans.'='.$answer.'<br />';;
4298: }
4299: }
1.581 albertel 4300: } else {
1.1173 kruse 4301: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4302: }
4303: return $value;
4304: }
4305:
4306:
1.107 albertel 4307: sub relative_to_absolute {
4308: my ($url,$output)=@_;
4309: my $parser=HTML::TokeParser->new(\$output);
4310: my $token;
4311: my $thisdir=$url;
4312: my @rlinks=();
4313: while ($token=$parser->get_token) {
4314: if ($token->[0] eq 'S') {
4315: if ($token->[1] eq 'a') {
4316: if ($token->[2]->{'href'}) {
4317: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4318: }
4319: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4320: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4321: } elsif ($token->[1] eq 'base') {
4322: $thisdir=$token->[2]->{'href'};
4323: }
4324: }
4325: }
4326: $thisdir=~s-/[^/]*$--;
1.356 albertel 4327: foreach my $link (@rlinks) {
1.726 raeburn 4328: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4329: ($link=~/^\//) ||
4330: ($link=~/^javascript:/i) ||
4331: ($link=~/^mailto:/i) ||
4332: ($link=~/^\#/)) {
4333: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4334: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4335: }
4336: }
4337: # -------------------------------------------------- Deal with Applet codebases
4338: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4339: return $output;
4340: }
4341:
1.112 bowersj2 4342: =pod
4343:
1.648 raeburn 4344: =item * &get_student_view()
1.112 bowersj2 4345:
4346: show a snapshot of what student was looking at
4347:
4348: =cut
4349:
1.10 albertel 4350: sub get_student_view {
1.186 albertel 4351: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4352: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4353: my (%form);
1.10 albertel 4354: my @elements=('symb','courseid','domain','username');
4355: foreach my $element (@elements) {
1.186 albertel 4356: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4357: }
1.186 albertel 4358: if (defined($moreenv)) {
4359: %form=(%form,%{$moreenv});
4360: }
1.236 albertel 4361: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4362: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4363: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4364: $userview=~s/\<body[^\>]*\>//gi;
4365: $userview=~s/\<\/body\>//gi;
4366: $userview=~s/\<html\>//gi;
4367: $userview=~s/\<\/html\>//gi;
4368: $userview=~s/\<head\>//gi;
4369: $userview=~s/\<\/head\>//gi;
4370: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4371: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4372: if (wantarray) {
4373: return ($userview,$response);
4374: } else {
4375: return $userview;
4376: }
4377: }
4378:
4379: sub get_student_view_with_retries {
4380: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4381:
4382: my $ok = 0; # True if we got a good response.
4383: my $content;
4384: my $response;
4385:
4386: # Try to get the student_view done. within the retries count:
4387:
4388: do {
4389: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4390: $ok = $response->is_success;
4391: if (!$ok) {
4392: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4393: }
4394: $retries--;
4395: } while (!$ok && ($retries > 0));
4396:
4397: if (!$ok) {
4398: $content = ''; # On error return an empty content.
4399: }
1.651 www 4400: if (wantarray) {
4401: return ($content, $response);
4402: } else {
4403: return $content;
4404: }
1.11 albertel 4405: }
4406:
1.112 bowersj2 4407: =pod
4408:
1.648 raeburn 4409: =item * &get_student_answers()
1.112 bowersj2 4410:
4411: show a snapshot of how student was answering problem
4412:
4413: =cut
4414:
1.11 albertel 4415: sub get_student_answers {
1.100 sakharuk 4416: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4417: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4418: my (%moreenv);
1.11 albertel 4419: my @elements=('symb','courseid','domain','username');
4420: foreach my $element (@elements) {
1.186 albertel 4421: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4422: }
1.186 albertel 4423: $moreenv{'grade_target'}='answer';
4424: %moreenv=(%form,%moreenv);
1.497 raeburn 4425: $feedurl = &Apache::lonnet::clutter($feedurl);
4426: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4427: return $userview;
1.1 albertel 4428: }
1.116 albertel 4429:
4430: =pod
4431:
4432: =item * &submlink()
4433:
1.242 albertel 4434: Inputs: $text $uname $udom $symb $target
1.116 albertel 4435:
4436: Returns: A link to grades.pm such as to see the SUBM view of a student
4437:
4438: =cut
4439:
4440: ###############################################
4441: sub submlink {
1.242 albertel 4442: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4443: if (!($uname && $udom)) {
4444: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4445: &Apache::lonnet::whichuser($symb);
1.116 albertel 4446: if (!$symb) { $symb=$cursymb; }
4447: }
1.254 matthew 4448: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4449: $symb=&escape($symb);
1.960 bisitz 4450: if ($target) { $target=" target=\"$target\""; }
4451: return
4452: '<a href="/adm/grades?command=submission'.
4453: '&symb='.$symb.
4454: '&student='.$uname.
4455: '&userdom='.$udom.'"'.
4456: $target.'>'.$text.'</a>';
1.242 albertel 4457: }
4458: ##############################################
4459:
4460: =pod
4461:
4462: =item * &pgrdlink()
4463:
4464: Inputs: $text $uname $udom $symb $target
4465:
4466: Returns: A link to grades.pm such as to see the PGRD view of a student
4467:
4468: =cut
4469:
4470: ###############################################
4471: sub pgrdlink {
4472: my $link=&submlink(@_);
4473: $link=~s/(&command=submission)/$1&showgrading=yes/;
4474: return $link;
4475: }
4476: ##############################################
4477:
4478: =pod
4479:
4480: =item * &pprmlink()
4481:
4482: Inputs: $text $uname $udom $symb $target
4483:
4484: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4485: student and a specific resource
1.242 albertel 4486:
4487: =cut
4488:
4489: ###############################################
4490: sub pprmlink {
4491: my ($text,$uname,$udom,$symb,$target)=@_;
4492: if (!($uname && $udom)) {
4493: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4494: &Apache::lonnet::whichuser($symb);
1.242 albertel 4495: if (!$symb) { $symb=$cursymb; }
4496: }
1.254 matthew 4497: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4498: $symb=&escape($symb);
1.242 albertel 4499: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4500: return '<a href="/adm/parmset?command=set&'.
4501: 'symb='.$symb.'&uname='.$uname.
4502: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4503: }
4504: ##############################################
1.37 matthew 4505:
1.112 bowersj2 4506: =pod
4507:
4508: =back
4509:
4510: =cut
4511:
1.37 matthew 4512: ###############################################
1.51 www 4513:
4514:
4515: sub timehash {
1.687 raeburn 4516: my ($thistime) = @_;
4517: my $timezone = &Apache::lonlocal::gettimezone();
4518: my $dt = DateTime->from_epoch(epoch => $thistime)
4519: ->set_time_zone($timezone);
4520: my $wday = $dt->day_of_week();
4521: if ($wday == 7) { $wday = 0; }
4522: return ( 'second' => $dt->second(),
4523: 'minute' => $dt->minute(),
4524: 'hour' => $dt->hour(),
4525: 'day' => $dt->day_of_month(),
4526: 'month' => $dt->month(),
4527: 'year' => $dt->year(),
4528: 'weekday' => $wday,
4529: 'dayyear' => $dt->day_of_year(),
4530: 'dlsav' => $dt->is_dst() );
1.51 www 4531: }
4532:
1.370 www 4533: sub utc_string {
4534: my ($date)=@_;
1.371 www 4535: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4536: }
4537:
1.51 www 4538: sub maketime {
4539: my %th=@_;
1.687 raeburn 4540: my ($epoch_time,$timezone,$dt);
4541: $timezone = &Apache::lonlocal::gettimezone();
4542: eval {
4543: $dt = DateTime->new( year => $th{'year'},
4544: month => $th{'month'},
4545: day => $th{'day'},
4546: hour => $th{'hour'},
4547: minute => $th{'minute'},
4548: second => $th{'second'},
4549: time_zone => $timezone,
4550: );
4551: };
4552: if (!$@) {
4553: $epoch_time = $dt->epoch;
4554: if ($epoch_time) {
4555: return $epoch_time;
4556: }
4557: }
1.51 www 4558: return POSIX::mktime(
4559: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4560: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4561: }
4562:
4563: #########################################
1.51 www 4564:
4565: sub findallcourses {
1.482 raeburn 4566: my ($roles,$uname,$udom) = @_;
1.355 albertel 4567: my %roles;
4568: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4569: my %courses;
1.51 www 4570: my $now=time;
1.482 raeburn 4571: if (!defined($uname)) {
4572: $uname = $env{'user.name'};
4573: }
4574: if (!defined($udom)) {
4575: $udom = $env{'user.domain'};
4576: }
4577: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4578: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4579: if (!%roles) {
4580: %roles = (
4581: cc => 1,
1.907 raeburn 4582: co => 1,
1.482 raeburn 4583: in => 1,
4584: ep => 1,
4585: ta => 1,
4586: cr => 1,
4587: st => 1,
4588: );
4589: }
4590: foreach my $entry (keys(%roleshash)) {
4591: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4592: if ($trole =~ /^cr/) {
4593: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4594: } else {
4595: next if (!exists($roles{$trole}));
4596: }
4597: if ($tend) {
4598: next if ($tend < $now);
4599: }
4600: if ($tstart) {
4601: next if ($tstart > $now);
4602: }
1.1058 raeburn 4603: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4604: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4605: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4606: if ($secpart eq '') {
4607: ($cnum,$role) = split(/_/,$cnumpart);
4608: $sec = 'none';
1.1058 raeburn 4609: $value .= $cnum.'/';
1.482 raeburn 4610: } else {
4611: $cnum = $cnumpart;
4612: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4613: $value .= $cnum.'/'.$sec;
4614: }
4615: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4616: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4617: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4618: }
4619: } else {
4620: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4621: }
1.482 raeburn 4622: }
4623: } else {
4624: foreach my $key (keys(%env)) {
1.483 albertel 4625: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4626: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4627: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4628: next if ($role eq 'ca' || $role eq 'aa');
4629: next if (%roles && !exists($roles{$role}));
4630: my ($starttime,$endtime)=split(/\./,$env{$key});
4631: my $active=1;
4632: if ($starttime) {
4633: if ($now<$starttime) { $active=0; }
4634: }
4635: if ($endtime) {
4636: if ($now>$endtime) { $active=0; }
4637: }
4638: if ($active) {
1.1058 raeburn 4639: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4640: if ($sec eq '') {
4641: $sec = 'none';
1.1058 raeburn 4642: } else {
4643: $value .= $sec;
4644: }
4645: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4646: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4647: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4648: }
4649: } else {
4650: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4651: }
1.474 raeburn 4652: }
4653: }
1.51 www 4654: }
4655: }
1.474 raeburn 4656: return %courses;
1.51 www 4657: }
1.37 matthew 4658:
1.54 www 4659: ###############################################
1.474 raeburn 4660:
4661: sub blockcheck {
1.1189 raeburn 4662: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4663:
1.1189 raeburn 4664: if (defined($udom) && defined($uname)) {
4665: # If uname and udom are for a course, check for blocks in the course.
4666: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4667: my ($startblock,$endblock,$triggerblock) =
4668: &get_blocks($setters,$activity,$udom,$uname,$url);
4669: return ($startblock,$endblock,$triggerblock);
4670: }
4671: } else {
1.490 raeburn 4672: $udom = $env{'user.domain'};
4673: $uname = $env{'user.name'};
4674: }
4675:
1.502 raeburn 4676: my $startblock = 0;
4677: my $endblock = 0;
1.1062 raeburn 4678: my $triggerblock = '';
1.482 raeburn 4679: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4680:
1.490 raeburn 4681: # If uname is for a user, and activity is course-specific, i.e.,
4682: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4683:
1.490 raeburn 4684: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4685: $activity eq 'groups' || $activity eq 'printout') &&
4686: ($env{'request.course.id'})) {
1.490 raeburn 4687: foreach my $key (keys(%live_courses)) {
4688: if ($key ne $env{'request.course.id'}) {
4689: delete($live_courses{$key});
4690: }
4691: }
4692: }
4693:
4694: my $otheruser = 0;
4695: my %own_courses;
4696: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4697: # Resource belongs to user other than current user.
4698: $otheruser = 1;
4699: # Gather courses for current user
4700: %own_courses =
4701: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4702: }
4703:
4704: # Gather active course roles - course coordinator, instructor,
4705: # exam proctor, ta, student, or custom role.
1.474 raeburn 4706:
4707: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4708: my ($cdom,$cnum);
4709: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4710: $cdom = $env{'course.'.$course.'.domain'};
4711: $cnum = $env{'course.'.$course.'.num'};
4712: } else {
1.490 raeburn 4713: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4714: }
4715: my $no_ownblock = 0;
4716: my $no_userblock = 0;
1.533 raeburn 4717: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4718: # Check if current user has 'evb' priv for this
4719: if (defined($own_courses{$course})) {
4720: foreach my $sec (keys(%{$own_courses{$course}})) {
4721: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4722: if ($sec ne 'none') {
4723: $checkrole .= '/'.$sec;
4724: }
4725: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4726: $no_ownblock = 1;
4727: last;
4728: }
4729: }
4730: }
4731: # if they have 'evb' priv and are currently not playing student
4732: next if (($no_ownblock) &&
4733: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4734: }
1.474 raeburn 4735: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4736: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4737: if ($sec ne 'none') {
1.482 raeburn 4738: $checkrole .= '/'.$sec;
1.474 raeburn 4739: }
1.490 raeburn 4740: if ($otheruser) {
4741: # Resource belongs to user other than current user.
4742: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4743: my (%allroles,%userroles);
4744: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4745: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4746: my ($trole,$tdom,$tnum,$tsec);
4747: if ($entry =~ /^cr/) {
4748: ($trole,$tdom,$tnum,$tsec) =
4749: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4750: } else {
4751: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4752: }
4753: my ($spec,$area,$trest);
4754: $area = '/'.$tdom.'/'.$tnum;
4755: $trest = $tnum;
4756: if ($tsec ne '') {
4757: $area .= '/'.$tsec;
4758: $trest .= '/'.$tsec;
4759: }
4760: $spec = $trole.'.'.$area;
4761: if ($trole =~ /^cr/) {
4762: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4763: $tdom,$spec,$trest,$area);
4764: } else {
4765: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4766: $tdom,$spec,$trest,$area);
4767: }
4768: }
4769: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4770: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4771: if ($1) {
4772: $no_userblock = 1;
4773: last;
4774: }
1.486 raeburn 4775: }
4776: }
1.490 raeburn 4777: } else {
4778: # Resource belongs to current user
4779: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4780: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4781: $no_ownblock = 1;
4782: last;
4783: }
1.474 raeburn 4784: }
4785: }
4786: # if they have the evb priv and are currently not playing student
1.482 raeburn 4787: next if (($no_ownblock) &&
1.491 albertel 4788: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4789: next if ($no_userblock);
1.474 raeburn 4790:
1.866 kalberla 4791: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4792: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4793:
1.1062 raeburn 4794: my ($start,$end,$trigger) =
4795: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4796: if (($start != 0) &&
4797: (($startblock == 0) || ($startblock > $start))) {
4798: $startblock = $start;
1.1062 raeburn 4799: if ($trigger ne '') {
4800: $triggerblock = $trigger;
4801: }
1.502 raeburn 4802: }
4803: if (($end != 0) &&
4804: (($endblock == 0) || ($endblock < $end))) {
4805: $endblock = $end;
1.1062 raeburn 4806: if ($trigger ne '') {
4807: $triggerblock = $trigger;
4808: }
1.502 raeburn 4809: }
1.490 raeburn 4810: }
1.1062 raeburn 4811: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4812: }
4813:
4814: sub get_blocks {
1.1062 raeburn 4815: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4816: my $startblock = 0;
4817: my $endblock = 0;
1.1062 raeburn 4818: my $triggerblock = '';
1.490 raeburn 4819: my $course = $cdom.'_'.$cnum;
4820: $setters->{$course} = {};
4821: $setters->{$course}{'staff'} = [];
4822: $setters->{$course}{'times'} = [];
1.1062 raeburn 4823: $setters->{$course}{'triggers'} = [];
4824: my (@blockers,%triggered);
4825: my $now = time;
4826: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4827: if ($activity eq 'docs') {
4828: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4829: foreach my $block (@blockers) {
4830: if ($block =~ /^firstaccess____(.+)$/) {
4831: my $item = $1;
4832: my $type = 'map';
4833: my $timersymb = $item;
4834: if ($item eq 'course') {
4835: $type = 'course';
4836: } elsif ($item =~ /___\d+___/) {
4837: $type = 'resource';
4838: } else {
4839: $timersymb = &Apache::lonnet::symbread($item);
4840: }
4841: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4842: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4843: $triggered{$block} = {
4844: start => $start,
4845: end => $end,
4846: type => $type,
4847: };
4848: }
4849: }
4850: } else {
4851: foreach my $block (keys(%commblocks)) {
4852: if ($block =~ m/^(\d+)____(\d+)$/) {
4853: my ($start,$end) = ($1,$2);
4854: if ($start <= time && $end >= time) {
4855: if (ref($commblocks{$block}) eq 'HASH') {
4856: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4857: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4858: unless(grep(/^\Q$block\E$/,@blockers)) {
4859: push(@blockers,$block);
4860: }
4861: }
4862: }
4863: }
4864: }
4865: } elsif ($block =~ /^firstaccess____(.+)$/) {
4866: my $item = $1;
4867: my $timersymb = $item;
4868: my $type = 'map';
4869: if ($item eq 'course') {
4870: $type = 'course';
4871: } elsif ($item =~ /___\d+___/) {
4872: $type = 'resource';
4873: } else {
4874: $timersymb = &Apache::lonnet::symbread($item);
4875: }
4876: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4877: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4878: if ($start && $end) {
4879: if (($start <= time) && ($end >= time)) {
4880: unless (grep(/^\Q$block\E$/,@blockers)) {
4881: push(@blockers,$block);
4882: $triggered{$block} = {
4883: start => $start,
4884: end => $end,
4885: type => $type,
4886: };
4887: }
4888: }
1.490 raeburn 4889: }
1.1062 raeburn 4890: }
4891: }
4892: }
4893: foreach my $blocker (@blockers) {
4894: my ($staff_name,$staff_dom,$title,$blocks) =
4895: &parse_block_record($commblocks{$blocker});
4896: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4897: my ($start,$end,$triggertype);
4898: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4899: ($start,$end) = ($1,$2);
4900: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4901: $start = $triggered{$blocker}{'start'};
4902: $end = $triggered{$blocker}{'end'};
4903: $triggertype = $triggered{$blocker}{'type'};
4904: }
4905: if ($start) {
4906: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4907: if ($triggertype) {
4908: push(@{$$setters{$course}{'triggers'}},$triggertype);
4909: } else {
4910: push(@{$$setters{$course}{'triggers'}},0);
4911: }
4912: if ( ($startblock == 0) || ($startblock > $start) ) {
4913: $startblock = $start;
4914: if ($triggertype) {
4915: $triggerblock = $blocker;
1.474 raeburn 4916: }
4917: }
1.1062 raeburn 4918: if ( ($endblock == 0) || ($endblock < $end) ) {
4919: $endblock = $end;
4920: if ($triggertype) {
4921: $triggerblock = $blocker;
4922: }
4923: }
1.474 raeburn 4924: }
4925: }
1.1062 raeburn 4926: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4927: }
4928:
4929: sub parse_block_record {
4930: my ($record) = @_;
4931: my ($setuname,$setudom,$title,$blocks);
4932: if (ref($record) eq 'HASH') {
4933: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4934: $title = &unescape($record->{'event'});
4935: $blocks = $record->{'blocks'};
4936: } else {
4937: my @data = split(/:/,$record,3);
4938: if (scalar(@data) eq 2) {
4939: $title = $data[1];
4940: ($setuname,$setudom) = split(/@/,$data[0]);
4941: } else {
4942: ($setuname,$setudom,$title) = @data;
4943: }
4944: $blocks = { 'com' => 'on' };
4945: }
4946: return ($setuname,$setudom,$title,$blocks);
4947: }
4948:
1.854 kalberla 4949: sub blocking_status {
1.1189 raeburn 4950: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4951: my %setters;
1.890 droeschl 4952:
1.1061 raeburn 4953: # check for active blocking
1.1062 raeburn 4954: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4955: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4956: my $blocked = 0;
4957: if ($startblock && $endblock) {
4958: $blocked = 1;
4959: }
1.890 droeschl 4960:
1.1061 raeburn 4961: # caller just wants to know whether a block is active
4962: if (!wantarray) { return $blocked; }
4963:
4964: # build a link to a popup window containing the details
4965: my $querystring = "?activity=$activity";
4966: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 4967: if (($activity eq 'port') || ($activity eq 'passwd')) {
4968: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
4969: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 4970: } elsif ($activity eq 'docs') {
4971: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4972: }
1.1061 raeburn 4973:
4974: my $output .= <<'END_MYBLOCK';
4975: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4976: var options = "width=" + w + ",height=" + h + ",";
4977: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4978: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4979: var newWin = window.open(url, wdwName, options);
4980: newWin.focus();
4981: }
1.890 droeschl 4982: END_MYBLOCK
1.854 kalberla 4983:
1.1061 raeburn 4984: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4985:
1.1061 raeburn 4986: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4987: my $text = &mt('Communication Blocked');
1.1217 raeburn 4988: my $class = 'LC_comblock';
1.1062 raeburn 4989: if ($activity eq 'docs') {
4990: $text = &mt('Content Access Blocked');
1.1217 raeburn 4991: $class = '';
1.1063 raeburn 4992: } elsif ($activity eq 'printout') {
4993: $text = &mt('Printing Blocked');
1.1232 raeburn 4994: } elsif ($activity eq 'passwd') {
4995: $text = &mt('Password Changing Blocked');
1.1062 raeburn 4996: }
1.1061 raeburn 4997: $output .= <<"END_BLOCK";
1.1217 raeburn 4998: <div class='$class'>
1.869 kalberla 4999: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5000: title='$text'>
5001: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5002: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5003: title='$text'>$text</a>
1.867 kalberla 5004: </div>
5005:
5006: END_BLOCK
1.474 raeburn 5007:
1.1061 raeburn 5008: return ($blocked, $output);
1.854 kalberla 5009: }
1.490 raeburn 5010:
1.60 matthew 5011: ###############################################
5012:
1.682 raeburn 5013: sub check_ip_acc {
1.1201 raeburn 5014: my ($acc,$clientip)=@_;
1.682 raeburn 5015: &Apache::lonxml::debug("acc is $acc");
5016: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5017: return 1;
5018: }
1.1219 raeburn 5019: my $allowed;
1.1201 raeburn 5020: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682 raeburn 5021:
5022: my $name;
1.1219 raeburn 5023: my %access = (
5024: allowfrom => 1,
5025: denyfrom => 0,
5026: );
5027: my @allows;
5028: my @denies;
5029: foreach my $item (split(',',$acc)) {
5030: $item =~ s/^\s*//;
5031: $item =~ s/\s*$//;
5032: my $pattern;
5033: if ($item =~ /^\!(.+)$/) {
5034: push(@denies,$1);
5035: } else {
5036: push(@allows,$item);
5037: }
5038: }
5039: my $numdenies = scalar(@denies);
5040: my $numallows = scalar(@allows);
5041: my $count = 0;
5042: foreach my $pattern (@denies,@allows) {
5043: $count ++;
5044: my $acctype = 'allowfrom';
5045: if ($count <= $numdenies) {
5046: $acctype = 'denyfrom';
5047: }
1.682 raeburn 5048: if ($pattern =~ /\*$/) {
5049: #35.8.*
5050: $pattern=~s/\*//;
1.1219 raeburn 5051: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5052: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5053: #35.8.3.[34-56]
5054: my $low=$2;
5055: my $high=$3;
5056: $pattern=$1;
5057: if ($ip =~ /^\Q$pattern\E/) {
5058: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5059: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5060: }
5061: } elsif ($pattern =~ /^\*/) {
5062: #*.msu.edu
5063: $pattern=~s/\*//;
5064: if (!defined($name)) {
5065: use Socket;
5066: my $netaddr=inet_aton($ip);
5067: ($name)=gethostbyaddr($netaddr,AF_INET);
5068: }
1.1219 raeburn 5069: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5070: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5071: #127.0.0.1
1.1219 raeburn 5072: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5073: } else {
5074: #some.name.com
5075: if (!defined($name)) {
5076: use Socket;
5077: my $netaddr=inet_aton($ip);
5078: ($name)=gethostbyaddr($netaddr,AF_INET);
5079: }
1.1219 raeburn 5080: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5081: }
5082: if ($allowed =~ /^(0|1)$/) { last; }
5083: }
5084: if ($allowed eq '') {
5085: if ($numdenies && !$numallows) {
5086: $allowed = 1;
5087: } else {
5088: $allowed = 0;
1.682 raeburn 5089: }
5090: }
5091: return $allowed;
5092: }
5093:
5094: ###############################################
5095:
1.60 matthew 5096: =pod
5097:
1.112 bowersj2 5098: =head1 Domain Template Functions
5099:
5100: =over 4
5101:
5102: =item * &determinedomain()
1.60 matthew 5103:
5104: Inputs: $domain (usually will be undef)
5105:
1.63 www 5106: Returns: Determines which domain should be used for designs
1.60 matthew 5107:
5108: =cut
1.54 www 5109:
1.60 matthew 5110: ###############################################
1.63 www 5111: sub determinedomain {
5112: my $domain=shift;
1.531 albertel 5113: if (! $domain) {
1.60 matthew 5114: # Determine domain if we have not been given one
1.893 raeburn 5115: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5116: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5117: if ($env{'request.role.domain'}) {
5118: $domain=$env{'request.role.domain'};
1.60 matthew 5119: }
5120: }
1.63 www 5121: return $domain;
5122: }
5123: ###############################################
1.517 raeburn 5124:
1.518 albertel 5125: sub devalidate_domconfig_cache {
5126: my ($udom)=@_;
5127: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5128: }
5129:
5130: # ---------------------- Get domain configuration for a domain
5131: sub get_domainconf {
5132: my ($udom) = @_;
5133: my $cachetime=1800;
5134: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5135: if (defined($cached)) { return %{$result}; }
5136:
5137: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5138: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5139: my (%designhash,%legacy);
1.518 albertel 5140: if (keys(%domconfig) > 0) {
5141: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5142: if (keys(%{$domconfig{'login'}})) {
5143: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5144: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5145: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5146: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5147: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5148: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5149: if ($key eq 'loginvia') {
5150: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5151: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5152: $designhash{$udom.'.login.loginvia'} = $server;
5153: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5154:
5155: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5156: } else {
5157: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5158: }
1.948 raeburn 5159: }
1.1208 raeburn 5160: } elsif ($key eq 'headtag') {
5161: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5162: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5163: }
1.946 raeburn 5164: }
1.1208 raeburn 5165: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5166: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5167: }
1.946 raeburn 5168: }
5169: }
5170: }
5171: } else {
5172: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5173: $designhash{$udom.'.login.'.$key.'_'.$img} =
5174: $domconfig{'login'}{$key}{$img};
5175: }
1.699 raeburn 5176: }
5177: } else {
5178: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5179: }
1.632 raeburn 5180: }
5181: } else {
5182: $legacy{'login'} = 1;
1.518 albertel 5183: }
1.632 raeburn 5184: } else {
5185: $legacy{'login'} = 1;
1.518 albertel 5186: }
5187: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5188: if (keys(%{$domconfig{'rolecolors'}})) {
5189: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5190: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5191: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5192: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5193: }
1.518 albertel 5194: }
5195: }
1.632 raeburn 5196: } else {
5197: $legacy{'rolecolors'} = 1;
1.518 albertel 5198: }
1.632 raeburn 5199: } else {
5200: $legacy{'rolecolors'} = 1;
1.518 albertel 5201: }
1.948 raeburn 5202: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5203: if ($domconfig{'autoenroll'}{'co-owners'}) {
5204: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5205: }
5206: }
1.632 raeburn 5207: if (keys(%legacy) > 0) {
5208: my %legacyhash = &get_legacy_domconf($udom);
5209: foreach my $item (keys(%legacyhash)) {
5210: if ($item =~ /^\Q$udom\E\.login/) {
5211: if ($legacy{'login'}) {
5212: $designhash{$item} = $legacyhash{$item};
5213: }
5214: } else {
5215: if ($legacy{'rolecolors'}) {
5216: $designhash{$item} = $legacyhash{$item};
5217: }
1.518 albertel 5218: }
5219: }
5220: }
1.632 raeburn 5221: } else {
5222: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5223: }
5224: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5225: $cachetime);
5226: return %designhash;
5227: }
5228:
1.632 raeburn 5229: sub get_legacy_domconf {
5230: my ($udom) = @_;
5231: my %legacyhash;
5232: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5233: my $designfile = $designdir.'/'.$udom.'.tab';
5234: if (-e $designfile) {
5235: if ( open (my $fh,"<$designfile") ) {
5236: while (my $line = <$fh>) {
5237: next if ($line =~ /^\#/);
5238: chomp($line);
5239: my ($key,$val)=(split(/\=/,$line));
5240: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5241: }
5242: close($fh);
5243: }
5244: }
1.1026 raeburn 5245: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5246: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5247: }
5248: return %legacyhash;
5249: }
5250:
1.63 www 5251: =pod
5252:
1.112 bowersj2 5253: =item * &domainlogo()
1.63 www 5254:
5255: Inputs: $domain (usually will be undef)
5256:
5257: Returns: A link to a domain logo, if the domain logo exists.
5258: If the domain logo does not exist, a description of the domain.
5259:
5260: =cut
1.112 bowersj2 5261:
1.63 www 5262: ###############################################
5263: sub domainlogo {
1.517 raeburn 5264: my $domain = &determinedomain(shift);
1.518 albertel 5265: my %designhash = &get_domainconf($domain);
1.517 raeburn 5266: # See if there is a logo
5267: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5268: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5269: if ($imgsrc =~ m{^/(adm|res)/}) {
5270: if ($imgsrc =~ m{^/res/}) {
5271: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5272: &Apache::lonnet::repcopy($local_name);
5273: }
5274: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5275: }
5276: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5277: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5278: return &Apache::lonnet::domain($domain,'description');
1.59 www 5279: } else {
1.60 matthew 5280: return '';
1.59 www 5281: }
5282: }
1.63 www 5283: ##############################################
5284:
5285: =pod
5286:
1.112 bowersj2 5287: =item * &designparm()
1.63 www 5288:
5289: Inputs: $which parameter; $domain (usually will be undef)
5290:
5291: Returns: value of designparamter $which
5292:
5293: =cut
1.112 bowersj2 5294:
1.397 albertel 5295:
1.400 albertel 5296: ##############################################
1.397 albertel 5297: sub designparm {
5298: my ($which,$domain)=@_;
5299: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5300: return $env{'environment.color.'.$which};
1.96 www 5301: }
1.63 www 5302: $domain=&determinedomain($domain);
1.1016 raeburn 5303: my %domdesign;
5304: unless ($domain eq 'public') {
5305: %domdesign = &get_domainconf($domain);
5306: }
1.520 raeburn 5307: my $output;
1.517 raeburn 5308: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5309: $output = $domdesign{$domain.'.'.$which};
1.63 www 5310: } else {
1.520 raeburn 5311: $output = $defaultdesign{$which};
5312: }
5313: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5314: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5315: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5316: if ($output =~ m{^/res/}) {
5317: my $local_name = &Apache::lonnet::filelocation('',$output);
5318: &Apache::lonnet::repcopy($local_name);
5319: }
1.520 raeburn 5320: $output = &lonhttpdurl($output);
5321: }
1.63 www 5322: }
1.520 raeburn 5323: return $output;
1.63 www 5324: }
1.59 www 5325:
1.822 bisitz 5326: ##############################################
5327: =pod
5328:
1.832 bisitz 5329: =item * &authorspace()
5330:
1.1028 raeburn 5331: Inputs: $url (usually will be undef).
1.832 bisitz 5332:
1.1132 raeburn 5333: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5334: directory being viewed (or for which action is being taken).
5335: If $url is provided, and begins /priv/<domain>/<uname>
5336: the path will be that portion of the $context argument.
5337: Otherwise the path will be for the author space of the current
5338: user when the current role is author, or for that of the
5339: co-author/assistant co-author space when the current role
5340: is co-author or assistant co-author.
1.832 bisitz 5341:
5342: =cut
5343:
5344: sub authorspace {
1.1028 raeburn 5345: my ($url) = @_;
5346: if ($url ne '') {
5347: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5348: return $1;
5349: }
5350: }
1.832 bisitz 5351: my $caname = '';
1.1024 www 5352: my $cadom = '';
1.1028 raeburn 5353: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5354: ($cadom,$caname) =
1.832 bisitz 5355: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5356: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5357: $caname = $env{'user.name'};
1.1024 www 5358: $cadom = $env{'user.domain'};
1.832 bisitz 5359: }
1.1028 raeburn 5360: if (($caname ne '') && ($cadom ne '')) {
5361: return "/priv/$cadom/$caname/";
5362: }
5363: return;
1.832 bisitz 5364: }
5365:
5366: ##############################################
5367: =pod
5368:
1.822 bisitz 5369: =item * &head_subbox()
5370:
5371: Inputs: $content (contains HTML code with page functions, etc.)
5372:
5373: Returns: HTML div with $content
5374: To be included in page header
5375:
5376: =cut
5377:
5378: sub head_subbox {
5379: my ($content)=@_;
5380: my $output =
1.993 raeburn 5381: '<div class="LC_head_subbox">'
1.822 bisitz 5382: .$content
5383: .'</div>'
5384: }
5385:
5386: ##############################################
5387: =pod
5388:
5389: =item * &CSTR_pageheader()
5390:
1.1026 raeburn 5391: Input: (optional) filename from which breadcrumb trail is built.
5392: In most cases no input as needed, as $env{'request.filename'}
5393: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5394:
5395: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5396: To be included on Authoring Space pages
1.822 bisitz 5397:
5398: =cut
5399:
5400: sub CSTR_pageheader {
1.1026 raeburn 5401: my ($trailfile) = @_;
5402: if ($trailfile eq '') {
5403: $trailfile = $env{'request.filename'};
5404: }
5405:
5406: # this is for resources; directories have customtitle, and crumbs
5407: # and select recent are created in lonpubdir.pm
5408:
5409: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5410: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5411: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5412: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5413: $formaction =~ s{/+}{/}g;
1.822 bisitz 5414:
5415: my $parentpath = '';
5416: my $lastitem = '';
5417: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5418: $parentpath = $1;
5419: $lastitem = $2;
5420: } else {
5421: $lastitem = $thisdisfn;
5422: }
1.921 bisitz 5423:
5424: my $output =
1.822 bisitz 5425: '<div>'
5426: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5427: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5428: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5429: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5430: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5431:
5432: if ($lastitem) {
5433: $output .=
5434: '<span class="LC_filename">'
5435: .$lastitem
5436: .'</span>';
5437: }
5438: $output .=
5439: '<br />'
1.822 bisitz 5440: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5441: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5442: .'</form>'
5443: .&Apache::lonmenu::constspaceform()
5444: .'</div>';
1.921 bisitz 5445:
5446: return $output;
1.822 bisitz 5447: }
5448:
1.60 matthew 5449: ###############################################
5450: ###############################################
5451:
5452: =pod
5453:
1.112 bowersj2 5454: =back
5455:
1.549 albertel 5456: =head1 HTML Helpers
1.112 bowersj2 5457:
5458: =over 4
5459:
5460: =item * &bodytag()
1.60 matthew 5461:
5462: Returns a uniform header for LON-CAPA web pages.
5463:
5464: Inputs:
5465:
1.112 bowersj2 5466: =over 4
5467:
5468: =item * $title, A title to be displayed on the page.
5469:
5470: =item * $function, the current role (can be undef).
5471:
5472: =item * $addentries, extra parameters for the <body> tag.
5473:
5474: =item * $bodyonly, if defined, only return the <body> tag.
5475:
5476: =item * $domain, if defined, force a given domain.
5477:
5478: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5479: text interface only)
1.60 matthew 5480:
1.814 bisitz 5481: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5482: navigational links
1.317 albertel 5483:
1.338 albertel 5484: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5485:
1.460 albertel 5486: =item * $args, optional argument valid values are
5487: no_auto_mt_title -> prevents &mt()ing the title arg
5488:
1.1096 raeburn 5489: =item * $advtoolsref, optional argument, ref to an array containing
5490: inlineremote items to be added in "Functions" menu below
5491: breadcrumbs.
5492:
1.112 bowersj2 5493: =back
5494:
1.60 matthew 5495: Returns: A uniform header for LON-CAPA web pages.
5496: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5497: If $bodyonly is undef or zero, an html string containing a <body> tag and
5498: other decorations will be returned.
5499:
5500: =cut
5501:
1.54 www 5502: sub bodytag {
1.831 bisitz 5503: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5504: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5505:
1.954 raeburn 5506: my $public;
5507: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5508: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5509: $public = 1;
5510: }
1.460 albertel 5511: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5512: my $httphost = $args->{'use_absolute'};
1.339 albertel 5513:
1.183 matthew 5514: $function = &get_users_function() if (!$function);
1.339 albertel 5515: my $img = &designparm($function.'.img',$domain);
5516: my $font = &designparm($function.'.font',$domain);
5517: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5518:
1.803 bisitz 5519: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5520: 'bgcolor' => $pgbg,
1.339 albertel 5521: 'text' => $font,
5522: 'alink' => &designparm($function.'.alink',$domain),
5523: 'vlink' => &designparm($function.'.vlink',$domain),
5524: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5525: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5526:
1.63 www 5527: # role and realm
1.1178 raeburn 5528: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5529: if ($realm) {
5530: $realm = '/'.$realm;
5531: }
1.378 raeburn 5532: if ($role eq 'ca') {
1.479 albertel 5533: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5534: $realm = &plainname($rname,$rdom);
1.378 raeburn 5535: }
1.55 www 5536: # realm
1.258 albertel 5537: if ($env{'request.course.id'}) {
1.378 raeburn 5538: if ($env{'request.role'} !~ /^cr/) {
5539: $role = &Apache::lonnet::plaintext($role,&course_type());
5540: }
1.898 raeburn 5541: if ($env{'request.course.sec'}) {
5542: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5543: }
1.359 albertel 5544: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5545: } else {
5546: $role = &Apache::lonnet::plaintext($role);
1.54 www 5547: }
1.433 albertel 5548:
1.359 albertel 5549: if (!$realm) { $realm=' '; }
1.330 albertel 5550:
1.438 albertel 5551: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5552:
1.101 www 5553: # construct main body tag
1.359 albertel 5554: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5555: &Apache::lontexconvert::init_math_support();
1.252 albertel 5556:
1.1131 raeburn 5557: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5558:
1.1130 raeburn 5559: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5560: return $bodytag;
1.1130 raeburn 5561: }
1.359 albertel 5562:
1.954 raeburn 5563: if ($public) {
1.433 albertel 5564: undef($role);
5565: }
1.359 albertel 5566:
1.762 bisitz 5567: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5568: #
5569: # Extra info if you are the DC
5570: my $dc_info = '';
5571: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5572: $env{'course.'.$env{'request.course.id'}.
5573: '.domain'}.'/'})) {
5574: my $cid = $env{'request.course.id'};
1.917 raeburn 5575: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5576: $dc_info =~ s/\s+$//;
1.359 albertel 5577: }
5578:
1.1237 raeburn 5579: my $crstype;
5580: if ($env{'request.course.id'}) {
5581: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5582: } elsif ($args->{'crstype'}) {
5583: $crstype = $args->{'crstype'};
5584: }
5585: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5586: undef($role);
5587: } else {
5588: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
5589: }
1.853 droeschl 5590:
1.903 droeschl 5591: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5592:
5593: # if ($env{'request.state'} eq 'construct') {
5594: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5595: # }
5596:
1.1130 raeburn 5597: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5598: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5599:
1.1237 raeburn 5600: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5601:
1.916 droeschl 5602: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5603: if ($dc_info) {
5604: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5605: }
1.1130 raeburn 5606: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5607: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5608: return $bodytag;
5609: }
1.894 droeschl 5610:
1.927 raeburn 5611: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5612: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5613: }
1.916 droeschl 5614:
1.1130 raeburn 5615: $bodytag .= $right;
1.852 droeschl 5616:
1.917 raeburn 5617: if ($dc_info) {
5618: $dc_info = &dc_courseid_toggle($dc_info);
5619: }
5620: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5621:
1.1169 raeburn 5622: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5623: if ($args->{'no_secondary_menu'}) {
5624: return $bodytag;
5625: }
1.1169 raeburn 5626: #don't show menus for public users
1.954 raeburn 5627: if (!$public){
1.1154 raeburn 5628: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5629: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5630: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5631: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5632: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5633: $args->{'bread_crumbs'});
1.1096 raeburn 5634: } elsif ($forcereg) {
5635: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5636: $args->{'group'});
5637: } else {
5638: $bodytag .=
5639: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5640: $forcereg,$args->{'group'},
5641: $args->{'bread_crumbs'},
5642: $advtoolsref);
1.920 raeburn 5643: }
1.903 droeschl 5644: }else{
5645: # this is to seperate menu from content when there's no secondary
5646: # menu. Especially needed for public accessible ressources.
5647: $bodytag .= '<hr style="clear:both" />';
5648: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5649: }
1.903 droeschl 5650:
1.235 raeburn 5651: return $bodytag;
1.182 matthew 5652: }
5653:
1.917 raeburn 5654: sub dc_courseid_toggle {
5655: my ($dc_info) = @_;
1.980 raeburn 5656: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5657: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5658: &mt('(More ...)').'</a></span>'.
5659: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5660: }
5661:
1.330 albertel 5662: sub make_attr_string {
5663: my ($register,$attr_ref) = @_;
5664:
5665: if ($attr_ref && !ref($attr_ref)) {
5666: die("addentries Must be a hash ref ".
5667: join(':',caller(1))." ".
5668: join(':',caller(0))." ");
5669: }
5670:
5671: if ($register) {
1.339 albertel 5672: my ($on_load,$on_unload);
5673: foreach my $key (keys(%{$attr_ref})) {
5674: if (lc($key) eq 'onload') {
5675: $on_load.=$attr_ref->{$key}.';';
5676: delete($attr_ref->{$key});
5677:
5678: } elsif (lc($key) eq 'onunload') {
5679: $on_unload.=$attr_ref->{$key}.';';
5680: delete($attr_ref->{$key});
5681: }
5682: }
1.953 droeschl 5683: $attr_ref->{'onload'} = $on_load;
5684: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5685: }
1.339 albertel 5686:
1.330 albertel 5687: my $attr_string;
1.1159 raeburn 5688: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5689: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5690: }
5691: return $attr_string;
5692: }
5693:
5694:
1.182 matthew 5695: ###############################################
1.251 albertel 5696: ###############################################
5697:
5698: =pod
5699:
5700: =item * &endbodytag()
5701:
5702: Returns a uniform footer for LON-CAPA web pages.
5703:
1.635 raeburn 5704: Inputs: 1 - optional reference to an args hash
5705: If in the hash, key for noredirectlink has a value which evaluates to true,
5706: a 'Continue' link is not displayed if the page contains an
5707: internal redirect in the <head></head> section,
5708: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5709:
5710: =cut
5711:
5712: sub endbodytag {
1.635 raeburn 5713: my ($args) = @_;
1.1080 raeburn 5714: my $endbodytag;
5715: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5716: $endbodytag='</body>';
5717: }
1.315 albertel 5718: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5719: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5720: $endbodytag=
5721: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5722: &mt('Continue').'</a>'.
5723: $endbodytag;
5724: }
1.315 albertel 5725: }
1.251 albertel 5726: return $endbodytag;
5727: }
5728:
1.352 albertel 5729: =pod
5730:
5731: =item * &standard_css()
5732:
5733: Returns a style sheet
5734:
5735: Inputs: (all optional)
5736: domain -> force to color decorate a page for a specific
5737: domain
5738: function -> force usage of a specific rolish color scheme
5739: bgcolor -> override the default page bgcolor
5740:
5741: =cut
5742:
1.343 albertel 5743: sub standard_css {
1.345 albertel 5744: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5745: $function = &get_users_function() if (!$function);
5746: my $img = &designparm($function.'.img', $domain);
5747: my $tabbg = &designparm($function.'.tabbg', $domain);
5748: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5749: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5750: #second colour for later usage
1.345 albertel 5751: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5752: my $pgbg_or_bgcolor =
5753: $bgcolor ||
1.352 albertel 5754: &designparm($function.'.pgbg', $domain);
1.382 albertel 5755: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5756: my $alink = &designparm($function.'.alink', $domain);
5757: my $vlink = &designparm($function.'.vlink', $domain);
5758: my $link = &designparm($function.'.link', $domain);
5759:
1.602 albertel 5760: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5761: my $mono = 'monospace';
1.850 bisitz 5762: my $data_table_head = $sidebg;
5763: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5764: my $data_table_dark = '#E0E0E0';
1.470 banghart 5765: my $data_table_darker = '#CCCCCC';
1.349 albertel 5766: my $data_table_highlight = '#FFFF00';
1.352 albertel 5767: my $mail_new = '#FFBB77';
5768: my $mail_new_hover = '#DD9955';
5769: my $mail_read = '#BBBB77';
5770: my $mail_read_hover = '#999944';
5771: my $mail_replied = '#AAAA88';
5772: my $mail_replied_hover = '#888855';
5773: my $mail_other = '#99BBBB';
5774: my $mail_other_hover = '#669999';
1.391 albertel 5775: my $table_header = '#DDDDDD';
1.489 raeburn 5776: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5777: my $lg_border_color = '#C8C8C8';
1.952 onken 5778: my $button_hover = '#BF2317';
1.392 albertel 5779:
1.608 albertel 5780: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5781: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5782: : '0 3px 0 4px';
1.448 albertel 5783:
1.523 albertel 5784:
1.343 albertel 5785: return <<END;
1.947 droeschl 5786:
5787: /* needed for iframe to allow 100% height in FF */
5788: body, html {
5789: margin: 0;
5790: padding: 0 0.5%;
5791: height: 99%; /* to avoid scrollbars */
5792: }
5793:
1.795 www 5794: body {
1.911 bisitz 5795: font-family: $sans;
5796: line-height:130%;
5797: font-size:0.83em;
5798: color:$font;
1.795 www 5799: }
5800:
1.959 onken 5801: a:focus,
5802: a:focus img {
1.795 www 5803: color: red;
5804: }
1.698 harmsja 5805:
1.911 bisitz 5806: form, .inline {
5807: display: inline;
1.795 www 5808: }
1.721 harmsja 5809:
1.795 www 5810: .LC_right {
1.911 bisitz 5811: text-align:right;
1.795 www 5812: }
5813:
5814: .LC_middle {
1.911 bisitz 5815: vertical-align:middle;
1.795 www 5816: }
1.721 harmsja 5817:
1.1130 raeburn 5818: .LC_floatleft {
5819: float: left;
5820: }
5821:
5822: .LC_floatright {
5823: float: right;
5824: }
5825:
1.911 bisitz 5826: .LC_400Box {
5827: width:400px;
5828: }
1.721 harmsja 5829:
1.947 droeschl 5830: .LC_iframecontainer {
5831: width: 98%;
5832: margin: 0;
5833: position: fixed;
5834: top: 8.5em;
5835: bottom: 0;
5836: }
5837:
5838: .LC_iframecontainer iframe{
5839: border: none;
5840: width: 100%;
5841: height: 100%;
5842: }
5843:
1.778 bisitz 5844: .LC_filename {
5845: font-family: $mono;
5846: white-space:pre;
1.921 bisitz 5847: font-size: 120%;
1.778 bisitz 5848: }
5849:
5850: .LC_fileicon {
5851: border: none;
5852: height: 1.3em;
5853: vertical-align: text-bottom;
5854: margin-right: 0.3em;
5855: text-decoration:none;
5856: }
5857:
1.1008 www 5858: .LC_setting {
5859: text-decoration:underline;
5860: }
5861:
1.350 albertel 5862: .LC_error {
5863: color: red;
5864: }
1.795 www 5865:
1.1097 bisitz 5866: .LC_warning {
5867: color: darkorange;
5868: }
5869:
1.457 albertel 5870: .LC_diff_removed {
1.733 bisitz 5871: color: red;
1.394 albertel 5872: }
1.532 albertel 5873:
5874: .LC_info,
1.457 albertel 5875: .LC_success,
5876: .LC_diff_added {
1.350 albertel 5877: color: green;
5878: }
1.795 www 5879:
1.802 bisitz 5880: div.LC_confirm_box {
5881: background-color: #FAFAFA;
5882: border: 1px solid $lg_border_color;
5883: margin-right: 0;
5884: padding: 5px;
5885: }
5886:
5887: div.LC_confirm_box .LC_error img,
5888: div.LC_confirm_box .LC_success img {
5889: vertical-align: middle;
5890: }
5891:
1.440 albertel 5892: .LC_icon {
1.771 droeschl 5893: border: none;
1.790 droeschl 5894: vertical-align: middle;
1.771 droeschl 5895: }
5896:
1.543 albertel 5897: .LC_docs_spacer {
5898: width: 25px;
5899: height: 1px;
1.771 droeschl 5900: border: none;
1.543 albertel 5901: }
1.346 albertel 5902:
1.532 albertel 5903: .LC_internal_info {
1.735 bisitz 5904: color: #999999;
1.532 albertel 5905: }
5906:
1.794 www 5907: .LC_discussion {
1.1050 www 5908: background: $data_table_dark;
1.911 bisitz 5909: border: 1px solid black;
5910: margin: 2px;
1.794 www 5911: }
5912:
5913: .LC_disc_action_left {
1.1050 www 5914: background: $sidebg;
1.911 bisitz 5915: text-align: left;
1.1050 www 5916: padding: 4px;
5917: margin: 2px;
1.794 www 5918: }
5919:
5920: .LC_disc_action_right {
1.1050 www 5921: background: $sidebg;
1.911 bisitz 5922: text-align: right;
1.1050 www 5923: padding: 4px;
5924: margin: 2px;
1.794 www 5925: }
5926:
5927: .LC_disc_new_item {
1.911 bisitz 5928: background: white;
5929: border: 2px solid red;
1.1050 www 5930: margin: 4px;
5931: padding: 4px;
1.794 www 5932: }
5933:
5934: .LC_disc_old_item {
1.911 bisitz 5935: background: white;
1.1050 www 5936: margin: 4px;
5937: padding: 4px;
1.794 www 5938: }
5939:
1.458 albertel 5940: table.LC_pastsubmission {
5941: border: 1px solid black;
5942: margin: 2px;
5943: }
5944:
1.924 bisitz 5945: table#LC_menubuttons {
1.345 albertel 5946: width: 100%;
5947: background: $pgbg;
1.392 albertel 5948: border: 2px;
1.402 albertel 5949: border-collapse: separate;
1.803 bisitz 5950: padding: 0;
1.345 albertel 5951: }
1.392 albertel 5952:
1.801 tempelho 5953: table#LC_title_bar a {
5954: color: $fontmenu;
5955: }
1.836 bisitz 5956:
1.807 droeschl 5957: table#LC_title_bar {
1.819 tempelho 5958: clear: both;
1.836 bisitz 5959: display: none;
1.807 droeschl 5960: }
5961:
1.795 www 5962: table#LC_title_bar,
1.933 droeschl 5963: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5964: table#LC_title_bar.LC_with_remote {
1.359 albertel 5965: width: 100%;
1.392 albertel 5966: border-color: $pgbg;
5967: border-style: solid;
5968: border-width: $border;
1.379 albertel 5969: background: $pgbg;
1.801 tempelho 5970: color: $fontmenu;
1.392 albertel 5971: border-collapse: collapse;
1.803 bisitz 5972: padding: 0;
1.819 tempelho 5973: margin: 0;
1.359 albertel 5974: }
1.795 www 5975:
1.933 droeschl 5976: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5977: margin: 0;
5978: padding: 0;
1.933 droeschl 5979: position: relative;
5980: list-style: none;
1.913 droeschl 5981: }
1.933 droeschl 5982: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5983: display: inline;
5984: }
1.933 droeschl 5985:
5986: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5987: padding: 0;
1.933 droeschl 5988: margin: 0;
5989: float: left;
1.913 droeschl 5990: }
1.933 droeschl 5991: .LC_breadcrumb_tools_tools {
5992: padding: 0;
5993: margin: 0;
1.913 droeschl 5994: float: right;
5995: }
5996:
1.359 albertel 5997: table#LC_title_bar td {
5998: background: $tabbg;
5999: }
1.795 www 6000:
1.911 bisitz 6001: table#LC_menubuttons img {
1.803 bisitz 6002: border: none;
1.346 albertel 6003: }
1.795 www 6004:
1.842 droeschl 6005: .LC_breadcrumbs_component {
1.911 bisitz 6006: float: right;
6007: margin: 0 1em;
1.357 albertel 6008: }
1.842 droeschl 6009: .LC_breadcrumbs_component img {
1.911 bisitz 6010: vertical-align: middle;
1.777 tempelho 6011: }
1.795 www 6012:
1.383 albertel 6013: td.LC_table_cell_checkbox {
6014: text-align: center;
6015: }
1.795 www 6016:
6017: .LC_fontsize_small {
1.911 bisitz 6018: font-size: 70%;
1.705 tempelho 6019: }
6020:
1.844 bisitz 6021: #LC_breadcrumbs {
1.911 bisitz 6022: clear:both;
6023: background: $sidebg;
6024: border-bottom: 1px solid $lg_border_color;
6025: line-height: 2.5em;
1.933 droeschl 6026: overflow: hidden;
1.911 bisitz 6027: margin: 0;
6028: padding: 0;
1.995 raeburn 6029: text-align: left;
1.819 tempelho 6030: }
1.862 bisitz 6031:
1.1098 bisitz 6032: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6033: clear:both;
6034: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6035: border: 1px solid $sidebg;
1.1098 bisitz 6036: margin: 0 0 10px 0;
1.966 bisitz 6037: padding: 3px;
1.995 raeburn 6038: text-align: left;
1.822 bisitz 6039: }
6040:
1.795 www 6041: .LC_fontsize_medium {
1.911 bisitz 6042: font-size: 85%;
1.705 tempelho 6043: }
6044:
1.795 www 6045: .LC_fontsize_large {
1.911 bisitz 6046: font-size: 120%;
1.705 tempelho 6047: }
6048:
1.346 albertel 6049: .LC_menubuttons_inline_text {
6050: color: $font;
1.698 harmsja 6051: font-size: 90%;
1.701 harmsja 6052: padding-left:3px;
1.346 albertel 6053: }
6054:
1.934 droeschl 6055: .LC_menubuttons_inline_text img{
6056: vertical-align: middle;
6057: }
6058:
1.1051 www 6059: li.LC_menubuttons_inline_text img {
1.951 onken 6060: cursor:pointer;
1.1002 droeschl 6061: text-decoration: none;
1.951 onken 6062: }
6063:
1.526 www 6064: .LC_menubuttons_link {
6065: text-decoration: none;
6066: }
1.795 www 6067:
1.522 albertel 6068: .LC_menubuttons_category {
1.521 www 6069: color: $font;
1.526 www 6070: background: $pgbg;
1.521 www 6071: font-size: larger;
6072: font-weight: bold;
6073: }
6074:
1.346 albertel 6075: td.LC_menubuttons_text {
1.911 bisitz 6076: color: $font;
1.346 albertel 6077: }
1.706 harmsja 6078:
1.346 albertel 6079: .LC_current_location {
6080: background: $tabbg;
6081: }
1.795 www 6082:
1.938 bisitz 6083: table.LC_data_table {
1.347 albertel 6084: border: 1px solid #000000;
1.402 albertel 6085: border-collapse: separate;
1.426 albertel 6086: border-spacing: 1px;
1.610 albertel 6087: background: $pgbg;
1.347 albertel 6088: }
1.795 www 6089:
1.422 albertel 6090: .LC_data_table_dense {
6091: font-size: small;
6092: }
1.795 www 6093:
1.507 raeburn 6094: table.LC_nested_outer {
6095: border: 1px solid #000000;
1.589 raeburn 6096: border-collapse: collapse;
1.803 bisitz 6097: border-spacing: 0;
1.507 raeburn 6098: width: 100%;
6099: }
1.795 www 6100:
1.879 raeburn 6101: table.LC_innerpickbox,
1.507 raeburn 6102: table.LC_nested {
1.803 bisitz 6103: border: none;
1.589 raeburn 6104: border-collapse: collapse;
1.803 bisitz 6105: border-spacing: 0;
1.507 raeburn 6106: width: 100%;
6107: }
1.795 www 6108:
1.911 bisitz 6109: table.LC_data_table tr th,
6110: table.LC_calendar tr th,
1.879 raeburn 6111: table.LC_prior_tries tr th,
6112: table.LC_innerpickbox tr th {
1.349 albertel 6113: font-weight: bold;
6114: background-color: $data_table_head;
1.801 tempelho 6115: color:$fontmenu;
1.701 harmsja 6116: font-size:90%;
1.347 albertel 6117: }
1.795 www 6118:
1.879 raeburn 6119: table.LC_innerpickbox tr th,
6120: table.LC_innerpickbox tr td {
6121: vertical-align: top;
6122: }
6123:
1.711 raeburn 6124: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6125: background-color: #CCCCCC;
1.711 raeburn 6126: font-weight: bold;
6127: text-align: left;
6128: }
1.795 www 6129:
1.912 bisitz 6130: table.LC_data_table tr.LC_odd_row > td {
6131: background-color: $data_table_light;
6132: padding: 2px;
6133: vertical-align: top;
6134: }
6135:
1.809 bisitz 6136: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6137: background-color: $data_table_light;
1.912 bisitz 6138: vertical-align: top;
6139: }
6140:
6141: table.LC_data_table tr.LC_even_row > td {
6142: background-color: $data_table_dark;
1.425 albertel 6143: padding: 2px;
1.900 bisitz 6144: vertical-align: top;
1.347 albertel 6145: }
1.795 www 6146:
1.809 bisitz 6147: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6148: background-color: $data_table_dark;
1.900 bisitz 6149: vertical-align: top;
1.347 albertel 6150: }
1.795 www 6151:
1.425 albertel 6152: table.LC_data_table tr.LC_data_table_highlight td {
6153: background-color: $data_table_darker;
6154: }
1.795 www 6155:
1.639 raeburn 6156: table.LC_data_table tr td.LC_leftcol_header {
6157: background-color: $data_table_head;
6158: font-weight: bold;
6159: }
1.795 www 6160:
1.451 albertel 6161: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6162: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6163: font-weight: bold;
6164: font-style: italic;
6165: text-align: center;
6166: padding: 8px;
1.347 albertel 6167: }
1.795 www 6168:
1.1114 raeburn 6169: table.LC_data_table tr.LC_empty_row td,
6170: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6171: background-color: $sidebg;
6172: }
6173:
6174: table.LC_nested tr.LC_empty_row td {
6175: background-color: #FFFFFF;
6176: }
6177:
1.890 droeschl 6178: table.LC_caption {
6179: }
6180:
1.507 raeburn 6181: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6182: padding: 4ex
6183: }
1.795 www 6184:
1.507 raeburn 6185: table.LC_nested_outer tr th {
6186: font-weight: bold;
1.801 tempelho 6187: color:$fontmenu;
1.507 raeburn 6188: background-color: $data_table_head;
1.701 harmsja 6189: font-size: small;
1.507 raeburn 6190: border-bottom: 1px solid #000000;
6191: }
1.795 www 6192:
1.507 raeburn 6193: table.LC_nested_outer tr td.LC_subheader {
6194: background-color: $data_table_head;
6195: font-weight: bold;
6196: font-size: small;
6197: border-bottom: 1px solid #000000;
6198: text-align: right;
1.451 albertel 6199: }
1.795 www 6200:
1.507 raeburn 6201: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6202: background-color: #CCCCCC;
1.451 albertel 6203: font-weight: bold;
6204: font-size: small;
1.507 raeburn 6205: text-align: center;
6206: }
1.795 www 6207:
1.589 raeburn 6208: table.LC_nested tr.LC_info_row td.LC_left_item,
6209: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6210: text-align: left;
1.451 albertel 6211: }
1.795 www 6212:
1.507 raeburn 6213: table.LC_nested td {
1.735 bisitz 6214: background-color: #FFFFFF;
1.451 albertel 6215: font-size: small;
1.507 raeburn 6216: }
1.795 www 6217:
1.507 raeburn 6218: table.LC_nested_outer tr th.LC_right_item,
6219: table.LC_nested tr.LC_info_row td.LC_right_item,
6220: table.LC_nested tr.LC_odd_row td.LC_right_item,
6221: table.LC_nested tr td.LC_right_item {
1.451 albertel 6222: text-align: right;
6223: }
6224:
1.507 raeburn 6225: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6226: background-color: #EEEEEE;
1.451 albertel 6227: }
6228:
1.473 raeburn 6229: table.LC_createuser {
6230: }
6231:
6232: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6233: font-size: small;
1.473 raeburn 6234: }
6235:
6236: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6237: background-color: #CCCCCC;
1.473 raeburn 6238: font-weight: bold;
6239: text-align: center;
6240: }
6241:
1.349 albertel 6242: table.LC_calendar {
6243: border: 1px solid #000000;
6244: border-collapse: collapse;
1.917 raeburn 6245: width: 98%;
1.349 albertel 6246: }
1.795 www 6247:
1.349 albertel 6248: table.LC_calendar_pickdate {
6249: font-size: xx-small;
6250: }
1.795 www 6251:
1.349 albertel 6252: table.LC_calendar tr td {
6253: border: 1px solid #000000;
6254: vertical-align: top;
1.917 raeburn 6255: width: 14%;
1.349 albertel 6256: }
1.795 www 6257:
1.349 albertel 6258: table.LC_calendar tr td.LC_calendar_day_empty {
6259: background-color: $data_table_dark;
6260: }
1.795 www 6261:
1.779 bisitz 6262: table.LC_calendar tr td.LC_calendar_day_current {
6263: background-color: $data_table_highlight;
1.777 tempelho 6264: }
1.795 www 6265:
1.938 bisitz 6266: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6267: background-color: $mail_new;
6268: }
1.795 www 6269:
1.938 bisitz 6270: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6271: background-color: $mail_new_hover;
6272: }
1.795 www 6273:
1.938 bisitz 6274: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6275: background-color: $mail_read;
6276: }
1.795 www 6277:
1.938 bisitz 6278: /*
6279: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6280: background-color: $mail_read_hover;
6281: }
1.938 bisitz 6282: */
1.795 www 6283:
1.938 bisitz 6284: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6285: background-color: $mail_replied;
6286: }
1.795 www 6287:
1.938 bisitz 6288: /*
6289: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6290: background-color: $mail_replied_hover;
6291: }
1.938 bisitz 6292: */
1.795 www 6293:
1.938 bisitz 6294: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6295: background-color: $mail_other;
6296: }
1.795 www 6297:
1.938 bisitz 6298: /*
6299: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6300: background-color: $mail_other_hover;
6301: }
1.938 bisitz 6302: */
1.494 raeburn 6303:
1.777 tempelho 6304: table.LC_data_table tr > td.LC_browser_file,
6305: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6306: background: #AAEE77;
1.389 albertel 6307: }
1.795 www 6308:
1.777 tempelho 6309: table.LC_data_table tr > td.LC_browser_file_locked,
6310: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6311: background: #FFAA99;
1.387 albertel 6312: }
1.795 www 6313:
1.777 tempelho 6314: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6315: background: #888888;
1.779 bisitz 6316: }
1.795 www 6317:
1.777 tempelho 6318: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6319: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6320: background: #F8F866;
1.777 tempelho 6321: }
1.795 www 6322:
1.696 bisitz 6323: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6324: background: #E0E8FF;
1.387 albertel 6325: }
1.696 bisitz 6326:
1.707 bisitz 6327: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6328: /* background: #77FF77; */
1.707 bisitz 6329: }
1.795 www 6330:
1.707 bisitz 6331: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6332: border-right: 8px solid #FFFF77;
1.707 bisitz 6333: }
1.795 www 6334:
1.707 bisitz 6335: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6336: border-right: 8px solid #FFAA77;
1.707 bisitz 6337: }
1.795 www 6338:
1.707 bisitz 6339: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6340: border-right: 8px solid #FF7777;
1.707 bisitz 6341: }
1.795 www 6342:
1.707 bisitz 6343: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6344: border-right: 8px solid #AAFF77;
1.707 bisitz 6345: }
1.795 www 6346:
1.707 bisitz 6347: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6348: border-right: 8px solid #11CC55;
1.707 bisitz 6349: }
6350:
1.388 albertel 6351: span.LC_current_location {
1.701 harmsja 6352: font-size:larger;
1.388 albertel 6353: background: $pgbg;
6354: }
1.387 albertel 6355:
1.1029 www 6356: span.LC_current_nav_location {
6357: font-weight:bold;
6358: background: $sidebg;
6359: }
6360:
1.395 albertel 6361: span.LC_parm_menu_item {
6362: font-size: larger;
6363: }
1.795 www 6364:
1.395 albertel 6365: span.LC_parm_scope_all {
6366: color: red;
6367: }
1.795 www 6368:
1.395 albertel 6369: span.LC_parm_scope_folder {
6370: color: green;
6371: }
1.795 www 6372:
1.395 albertel 6373: span.LC_parm_scope_resource {
6374: color: orange;
6375: }
1.795 www 6376:
1.395 albertel 6377: span.LC_parm_part {
6378: color: blue;
6379: }
1.795 www 6380:
1.911 bisitz 6381: span.LC_parm_folder,
6382: span.LC_parm_symb {
1.395 albertel 6383: font-size: x-small;
6384: font-family: $mono;
6385: color: #AAAAAA;
6386: }
6387:
1.977 bisitz 6388: ul.LC_parm_parmlist li {
6389: display: inline-block;
6390: padding: 0.3em 0.8em;
6391: vertical-align: top;
6392: width: 150px;
6393: border-top:1px solid $lg_border_color;
6394: }
6395:
1.795 www 6396: td.LC_parm_overview_level_menu,
6397: td.LC_parm_overview_map_menu,
6398: td.LC_parm_overview_parm_selectors,
6399: td.LC_parm_overview_restrictions {
1.396 albertel 6400: border: 1px solid black;
6401: border-collapse: collapse;
6402: }
1.795 www 6403:
1.396 albertel 6404: table.LC_parm_overview_restrictions td {
6405: border-width: 1px 4px 1px 4px;
6406: border-style: solid;
6407: border-color: $pgbg;
6408: text-align: center;
6409: }
1.795 www 6410:
1.396 albertel 6411: table.LC_parm_overview_restrictions th {
6412: background: $tabbg;
6413: border-width: 1px 4px 1px 4px;
6414: border-style: solid;
6415: border-color: $pgbg;
6416: }
1.795 www 6417:
1.398 albertel 6418: table#LC_helpmenu {
1.803 bisitz 6419: border: none;
1.398 albertel 6420: height: 55px;
1.803 bisitz 6421: border-spacing: 0;
1.398 albertel 6422: }
6423:
6424: table#LC_helpmenu fieldset legend {
6425: font-size: larger;
6426: }
1.795 www 6427:
1.397 albertel 6428: table#LC_helpmenu_links {
6429: width: 100%;
6430: border: 1px solid black;
6431: background: $pgbg;
1.803 bisitz 6432: padding: 0;
1.397 albertel 6433: border-spacing: 1px;
6434: }
1.795 www 6435:
1.397 albertel 6436: table#LC_helpmenu_links tr td {
6437: padding: 1px;
6438: background: $tabbg;
1.399 albertel 6439: text-align: center;
6440: font-weight: bold;
1.397 albertel 6441: }
1.396 albertel 6442:
1.795 www 6443: table#LC_helpmenu_links a:link,
6444: table#LC_helpmenu_links a:visited,
1.397 albertel 6445: table#LC_helpmenu_links a:active {
6446: text-decoration: none;
6447: color: $font;
6448: }
1.795 www 6449:
1.397 albertel 6450: table#LC_helpmenu_links a:hover {
6451: text-decoration: underline;
6452: color: $vlink;
6453: }
1.396 albertel 6454:
1.417 albertel 6455: .LC_chrt_popup_exists {
6456: border: 1px solid #339933;
6457: margin: -1px;
6458: }
1.795 www 6459:
1.417 albertel 6460: .LC_chrt_popup_up {
6461: border: 1px solid yellow;
6462: margin: -1px;
6463: }
1.795 www 6464:
1.417 albertel 6465: .LC_chrt_popup {
6466: border: 1px solid #8888FF;
6467: background: #CCCCFF;
6468: }
1.795 www 6469:
1.421 albertel 6470: table.LC_pick_box {
6471: border-collapse: separate;
6472: background: white;
6473: border: 1px solid black;
6474: border-spacing: 1px;
6475: }
1.795 www 6476:
1.421 albertel 6477: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6478: background: $sidebg;
1.421 albertel 6479: font-weight: bold;
1.900 bisitz 6480: text-align: left;
1.740 bisitz 6481: vertical-align: top;
1.421 albertel 6482: width: 184px;
6483: padding: 8px;
6484: }
1.795 www 6485:
1.579 raeburn 6486: table.LC_pick_box td.LC_pick_box_value {
6487: text-align: left;
6488: padding: 8px;
6489: }
1.795 www 6490:
1.579 raeburn 6491: table.LC_pick_box td.LC_pick_box_select {
6492: text-align: left;
6493: padding: 8px;
6494: }
1.795 www 6495:
1.424 albertel 6496: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6497: padding: 0;
1.421 albertel 6498: height: 1px;
6499: background: black;
6500: }
1.795 www 6501:
1.421 albertel 6502: table.LC_pick_box td.LC_pick_box_submit {
6503: text-align: right;
6504: }
1.795 www 6505:
1.579 raeburn 6506: table.LC_pick_box td.LC_evenrow_value {
6507: text-align: left;
6508: padding: 8px;
6509: background-color: $data_table_light;
6510: }
1.795 www 6511:
1.579 raeburn 6512: table.LC_pick_box td.LC_oddrow_value {
6513: text-align: left;
6514: padding: 8px;
6515: background-color: $data_table_light;
6516: }
1.795 www 6517:
1.579 raeburn 6518: span.LC_helpform_receipt_cat {
6519: font-weight: bold;
6520: }
1.795 www 6521:
1.424 albertel 6522: table.LC_group_priv_box {
6523: background: white;
6524: border: 1px solid black;
6525: border-spacing: 1px;
6526: }
1.795 www 6527:
1.424 albertel 6528: table.LC_group_priv_box td.LC_pick_box_title {
6529: background: $tabbg;
6530: font-weight: bold;
6531: text-align: right;
6532: width: 184px;
6533: }
1.795 www 6534:
1.424 albertel 6535: table.LC_group_priv_box td.LC_groups_fixed {
6536: background: $data_table_light;
6537: text-align: center;
6538: }
1.795 www 6539:
1.424 albertel 6540: table.LC_group_priv_box td.LC_groups_optional {
6541: background: $data_table_dark;
6542: text-align: center;
6543: }
1.795 www 6544:
1.424 albertel 6545: table.LC_group_priv_box td.LC_groups_functionality {
6546: background: $data_table_darker;
6547: text-align: center;
6548: font-weight: bold;
6549: }
1.795 www 6550:
1.424 albertel 6551: table.LC_group_priv td {
6552: text-align: left;
1.803 bisitz 6553: padding: 0;
1.424 albertel 6554: }
6555:
6556: .LC_navbuttons {
6557: margin: 2ex 0ex 2ex 0ex;
6558: }
1.795 www 6559:
1.423 albertel 6560: .LC_topic_bar {
6561: font-weight: bold;
6562: background: $tabbg;
1.918 wenzelju 6563: margin: 1em 0em 1em 2em;
1.805 bisitz 6564: padding: 3px;
1.918 wenzelju 6565: font-size: 1.2em;
1.423 albertel 6566: }
1.795 www 6567:
1.423 albertel 6568: .LC_topic_bar span {
1.918 wenzelju 6569: left: 0.5em;
6570: position: absolute;
1.423 albertel 6571: vertical-align: middle;
1.918 wenzelju 6572: font-size: 1.2em;
1.423 albertel 6573: }
1.795 www 6574:
1.423 albertel 6575: table.LC_course_group_status {
6576: margin: 20px;
6577: }
1.795 www 6578:
1.423 albertel 6579: table.LC_status_selector td {
6580: vertical-align: top;
6581: text-align: center;
1.424 albertel 6582: padding: 4px;
6583: }
1.795 www 6584:
1.599 albertel 6585: div.LC_feedback_link {
1.616 albertel 6586: clear: both;
1.829 kalberla 6587: background: $sidebg;
1.779 bisitz 6588: width: 100%;
1.829 kalberla 6589: padding-bottom: 10px;
6590: border: 1px $tabbg solid;
1.833 kalberla 6591: height: 22px;
6592: line-height: 22px;
6593: padding-top: 5px;
6594: }
6595:
6596: div.LC_feedback_link img {
6597: height: 22px;
1.867 kalberla 6598: vertical-align:middle;
1.829 kalberla 6599: }
6600:
1.911 bisitz 6601: div.LC_feedback_link a {
1.829 kalberla 6602: text-decoration: none;
1.489 raeburn 6603: }
1.795 www 6604:
1.867 kalberla 6605: div.LC_comblock {
1.911 bisitz 6606: display:inline;
1.867 kalberla 6607: color:$font;
6608: font-size:90%;
6609: }
6610:
6611: div.LC_feedback_link div.LC_comblock {
6612: padding-left:5px;
6613: }
6614:
6615: div.LC_feedback_link div.LC_comblock a {
6616: color:$font;
6617: }
6618:
1.489 raeburn 6619: span.LC_feedback_link {
1.858 bisitz 6620: /* background: $feedback_link_bg; */
1.599 albertel 6621: font-size: larger;
6622: }
1.795 www 6623:
1.599 albertel 6624: span.LC_message_link {
1.858 bisitz 6625: /* background: $feedback_link_bg; */
1.599 albertel 6626: font-size: larger;
6627: position: absolute;
6628: right: 1em;
1.489 raeburn 6629: }
1.421 albertel 6630:
1.515 albertel 6631: table.LC_prior_tries {
1.524 albertel 6632: border: 1px solid #000000;
6633: border-collapse: separate;
6634: border-spacing: 1px;
1.515 albertel 6635: }
1.523 albertel 6636:
1.515 albertel 6637: table.LC_prior_tries td {
1.524 albertel 6638: padding: 2px;
1.515 albertel 6639: }
1.523 albertel 6640:
6641: .LC_answer_correct {
1.795 www 6642: background: lightgreen;
6643: color: darkgreen;
6644: padding: 6px;
1.523 albertel 6645: }
1.795 www 6646:
1.523 albertel 6647: .LC_answer_charged_try {
1.797 www 6648: background: #FFAAAA;
1.795 www 6649: color: darkred;
6650: padding: 6px;
1.523 albertel 6651: }
1.795 www 6652:
1.779 bisitz 6653: .LC_answer_not_charged_try,
1.523 albertel 6654: .LC_answer_no_grade,
6655: .LC_answer_late {
1.795 www 6656: background: lightyellow;
1.523 albertel 6657: color: black;
1.795 www 6658: padding: 6px;
1.523 albertel 6659: }
1.795 www 6660:
1.523 albertel 6661: .LC_answer_previous {
1.795 www 6662: background: lightblue;
6663: color: darkblue;
6664: padding: 6px;
1.523 albertel 6665: }
1.795 www 6666:
1.779 bisitz 6667: .LC_answer_no_message {
1.777 tempelho 6668: background: #FFFFFF;
6669: color: black;
1.795 www 6670: padding: 6px;
1.779 bisitz 6671: }
1.795 www 6672:
1.779 bisitz 6673: .LC_answer_unknown {
6674: background: orange;
6675: color: black;
1.795 www 6676: padding: 6px;
1.777 tempelho 6677: }
1.795 www 6678:
1.529 albertel 6679: span.LC_prior_numerical,
6680: span.LC_prior_string,
6681: span.LC_prior_custom,
6682: span.LC_prior_reaction,
6683: span.LC_prior_math {
1.925 bisitz 6684: font-family: $mono;
1.523 albertel 6685: white-space: pre;
6686: }
6687:
1.525 albertel 6688: span.LC_prior_string {
1.925 bisitz 6689: font-family: $mono;
1.525 albertel 6690: white-space: pre;
6691: }
6692:
1.523 albertel 6693: table.LC_prior_option {
6694: width: 100%;
6695: border-collapse: collapse;
6696: }
1.795 www 6697:
1.911 bisitz 6698: table.LC_prior_rank,
1.795 www 6699: table.LC_prior_match {
1.528 albertel 6700: border-collapse: collapse;
6701: }
1.795 www 6702:
1.528 albertel 6703: table.LC_prior_option tr td,
6704: table.LC_prior_rank tr td,
6705: table.LC_prior_match tr td {
1.524 albertel 6706: border: 1px solid #000000;
1.515 albertel 6707: }
6708:
1.855 bisitz 6709: .LC_nobreak {
1.544 albertel 6710: white-space: nowrap;
1.519 raeburn 6711: }
6712:
1.576 raeburn 6713: span.LC_cusr_emph {
6714: font-style: italic;
6715: }
6716:
1.633 raeburn 6717: span.LC_cusr_subheading {
6718: font-weight: normal;
6719: font-size: 85%;
6720: }
6721:
1.861 bisitz 6722: div.LC_docs_entry_move {
1.859 bisitz 6723: border: 1px solid #BBBBBB;
1.545 albertel 6724: background: #DDDDDD;
1.861 bisitz 6725: width: 22px;
1.859 bisitz 6726: padding: 1px;
6727: margin: 0;
1.545 albertel 6728: }
6729:
1.861 bisitz 6730: table.LC_data_table tr > td.LC_docs_entry_commands,
6731: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6732: font-size: x-small;
6733: }
1.795 www 6734:
1.861 bisitz 6735: .LC_docs_entry_parameter {
6736: white-space: nowrap;
6737: }
6738:
1.544 albertel 6739: .LC_docs_copy {
1.545 albertel 6740: color: #000099;
1.544 albertel 6741: }
1.795 www 6742:
1.544 albertel 6743: .LC_docs_cut {
1.545 albertel 6744: color: #550044;
1.544 albertel 6745: }
1.795 www 6746:
1.544 albertel 6747: .LC_docs_rename {
1.545 albertel 6748: color: #009900;
1.544 albertel 6749: }
1.795 www 6750:
1.544 albertel 6751: .LC_docs_remove {
1.545 albertel 6752: color: #990000;
6753: }
6754:
1.547 albertel 6755: .LC_docs_reinit_warn,
6756: .LC_docs_ext_edit {
6757: font-size: x-small;
6758: }
6759:
1.545 albertel 6760: table.LC_docs_adddocs td,
6761: table.LC_docs_adddocs th {
6762: border: 1px solid #BBBBBB;
6763: padding: 4px;
6764: background: #DDDDDD;
1.543 albertel 6765: }
6766:
1.584 albertel 6767: table.LC_sty_begin {
6768: background: #BBFFBB;
6769: }
1.795 www 6770:
1.584 albertel 6771: table.LC_sty_end {
6772: background: #FFBBBB;
6773: }
6774:
1.589 raeburn 6775: table.LC_double_column {
1.803 bisitz 6776: border-width: 0;
1.589 raeburn 6777: border-collapse: collapse;
6778: width: 100%;
6779: padding: 2px;
6780: }
6781:
6782: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6783: top: 2px;
1.589 raeburn 6784: left: 2px;
6785: width: 47%;
6786: vertical-align: top;
6787: }
6788:
6789: table.LC_double_column tr td.LC_right_col {
6790: top: 2px;
1.779 bisitz 6791: right: 2px;
1.589 raeburn 6792: width: 47%;
6793: vertical-align: top;
6794: }
6795:
1.591 raeburn 6796: div.LC_left_float {
6797: float: left;
6798: padding-right: 5%;
1.597 albertel 6799: padding-bottom: 4px;
1.591 raeburn 6800: }
6801:
6802: div.LC_clear_float_header {
1.597 albertel 6803: padding-bottom: 2px;
1.591 raeburn 6804: }
6805:
6806: div.LC_clear_float_footer {
1.597 albertel 6807: padding-top: 10px;
1.591 raeburn 6808: clear: both;
6809: }
6810:
1.597 albertel 6811: div.LC_grade_show_user {
1.941 bisitz 6812: /* border-left: 5px solid $sidebg; */
6813: border-top: 5px solid #000000;
6814: margin: 50px 0 0 0;
1.936 bisitz 6815: padding: 15px 0 5px 10px;
1.597 albertel 6816: }
1.795 www 6817:
1.936 bisitz 6818: div.LC_grade_show_user_odd_row {
1.941 bisitz 6819: /* border-left: 5px solid #000000; */
6820: }
6821:
6822: div.LC_grade_show_user div.LC_Box {
6823: margin-right: 50px;
1.597 albertel 6824: }
6825:
6826: div.LC_grade_submissions,
6827: div.LC_grade_message_center,
1.936 bisitz 6828: div.LC_grade_info_links {
1.597 albertel 6829: margin: 5px;
6830: width: 99%;
6831: background: #FFFFFF;
6832: }
1.795 www 6833:
1.597 albertel 6834: div.LC_grade_submissions_header,
1.936 bisitz 6835: div.LC_grade_message_center_header {
1.705 tempelho 6836: font-weight: bold;
6837: font-size: large;
1.597 albertel 6838: }
1.795 www 6839:
1.597 albertel 6840: div.LC_grade_submissions_body,
1.936 bisitz 6841: div.LC_grade_message_center_body {
1.597 albertel 6842: border: 1px solid black;
6843: width: 99%;
6844: background: #FFFFFF;
6845: }
1.795 www 6846:
1.613 albertel 6847: table.LC_scantron_action {
6848: width: 100%;
6849: }
1.795 www 6850:
1.613 albertel 6851: table.LC_scantron_action tr th {
1.698 harmsja 6852: font-weight:bold;
6853: font-style:normal;
1.613 albertel 6854: }
1.795 www 6855:
1.779 bisitz 6856: .LC_edit_problem_header,
1.614 albertel 6857: div.LC_edit_problem_footer {
1.705 tempelho 6858: font-weight: normal;
6859: font-size: medium;
1.602 albertel 6860: margin: 2px;
1.1060 bisitz 6861: background-color: $sidebg;
1.600 albertel 6862: }
1.795 www 6863:
1.600 albertel 6864: div.LC_edit_problem_header,
1.602 albertel 6865: div.LC_edit_problem_header div,
1.614 albertel 6866: div.LC_edit_problem_footer,
6867: div.LC_edit_problem_footer div,
1.602 albertel 6868: div.LC_edit_problem_editxml_header,
6869: div.LC_edit_problem_editxml_header div {
1.1205 golterma 6870: z-index: 100;
1.600 albertel 6871: }
1.795 www 6872:
1.600 albertel 6873: div.LC_edit_problem_header_title {
1.705 tempelho 6874: font-weight: bold;
6875: font-size: larger;
1.602 albertel 6876: background: $tabbg;
6877: padding: 3px;
1.1060 bisitz 6878: margin: 0 0 5px 0;
1.602 albertel 6879: }
1.795 www 6880:
1.602 albertel 6881: table.LC_edit_problem_header_title {
6882: width: 100%;
1.600 albertel 6883: background: $tabbg;
1.602 albertel 6884: }
6885:
1.1205 golterma 6886: div.LC_edit_actionbar {
6887: background-color: $sidebg;
1.1218 droeschl 6888: margin: 0;
6889: padding: 0;
6890: line-height: 200%;
1.602 albertel 6891: }
1.795 www 6892:
1.1218 droeschl 6893: div.LC_edit_actionbar div{
6894: padding: 0;
6895: margin: 0;
6896: display: inline-block;
1.600 albertel 6897: }
1.795 www 6898:
1.1124 bisitz 6899: .LC_edit_opt {
6900: padding-left: 1em;
6901: white-space: nowrap;
6902: }
6903:
1.1152 golterma 6904: .LC_edit_problem_latexhelper{
6905: text-align: right;
6906: }
6907:
6908: #LC_edit_problem_colorful div{
6909: margin-left: 40px;
6910: }
6911:
1.1205 golterma 6912: #LC_edit_problem_codemirror div{
6913: margin-left: 0px;
6914: }
6915:
1.911 bisitz 6916: img.stift {
1.803 bisitz 6917: border-width: 0;
6918: vertical-align: middle;
1.677 riegler 6919: }
1.680 riegler 6920:
1.923 bisitz 6921: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6922: vertical-align: top;
1.777 tempelho 6923: }
1.795 www 6924:
1.716 raeburn 6925: div.LC_createcourse {
1.911 bisitz 6926: margin: 10px 10px 10px 10px;
1.716 raeburn 6927: }
6928:
1.917 raeburn 6929: .LC_dccid {
1.1130 raeburn 6930: float: right;
1.917 raeburn 6931: margin: 0.2em 0 0 0;
6932: padding: 0;
6933: font-size: 90%;
6934: display:none;
6935: }
6936:
1.897 wenzelju 6937: ol.LC_primary_menu a:hover,
1.721 harmsja 6938: ol#LC_MenuBreadcrumbs a:hover,
6939: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6940: ul#LC_secondary_menu a:hover,
1.721 harmsja 6941: .LC_FormSectionClearButton input:hover
1.795 www 6942: ul.LC_TabContent li:hover a {
1.952 onken 6943: color:$button_hover;
1.911 bisitz 6944: text-decoration:none;
1.693 droeschl 6945: }
6946:
1.779 bisitz 6947: h1 {
1.911 bisitz 6948: padding: 0;
6949: line-height:130%;
1.693 droeschl 6950: }
1.698 harmsja 6951:
1.911 bisitz 6952: h2,
6953: h3,
6954: h4,
6955: h5,
6956: h6 {
6957: margin: 5px 0 5px 0;
6958: padding: 0;
6959: line-height:130%;
1.693 droeschl 6960: }
1.795 www 6961:
6962: .LC_hcell {
1.911 bisitz 6963: padding:3px 15px 3px 15px;
6964: margin: 0;
6965: background-color:$tabbg;
6966: color:$fontmenu;
6967: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6968: }
1.795 www 6969:
1.840 bisitz 6970: .LC_Box > .LC_hcell {
1.911 bisitz 6971: margin: 0 -10px 10px -10px;
1.835 bisitz 6972: }
6973:
1.721 harmsja 6974: .LC_noBorder {
1.911 bisitz 6975: border: 0;
1.698 harmsja 6976: }
1.693 droeschl 6977:
1.721 harmsja 6978: .LC_FormSectionClearButton input {
1.911 bisitz 6979: background-color:transparent;
6980: border: none;
6981: cursor:pointer;
6982: text-decoration:underline;
1.693 droeschl 6983: }
1.763 bisitz 6984:
6985: .LC_help_open_topic {
1.911 bisitz 6986: color: #FFFFFF;
6987: background-color: #EEEEFF;
6988: margin: 1px;
6989: padding: 4px;
6990: border: 1px solid #000033;
6991: white-space: nowrap;
6992: /* vertical-align: middle; */
1.759 neumanie 6993: }
1.693 droeschl 6994:
1.911 bisitz 6995: dl,
6996: ul,
6997: div,
6998: fieldset {
6999: margin: 10px 10px 10px 0;
7000: /* overflow: hidden; */
1.693 droeschl 7001: }
1.795 www 7002:
1.1211 raeburn 7003: article.geogebraweb div {
7004: margin: 0;
7005: }
7006:
1.838 bisitz 7007: fieldset > legend {
1.911 bisitz 7008: font-weight: bold;
7009: padding: 0 5px 0 5px;
1.838 bisitz 7010: }
7011:
1.813 bisitz 7012: #LC_nav_bar {
1.911 bisitz 7013: float: left;
1.995 raeburn 7014: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7015: margin: 0 0 2px 0;
1.807 droeschl 7016: }
7017:
1.916 droeschl 7018: #LC_realm {
7019: margin: 0.2em 0 0 0;
7020: padding: 0;
7021: font-weight: bold;
7022: text-align: center;
1.995 raeburn 7023: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7024: }
7025:
1.911 bisitz 7026: #LC_nav_bar em {
7027: font-weight: bold;
7028: font-style: normal;
1.807 droeschl 7029: }
7030:
1.897 wenzelju 7031: ol.LC_primary_menu {
1.934 droeschl 7032: margin: 0;
1.1076 raeburn 7033: padding: 0;
1.807 droeschl 7034: }
7035:
1.852 droeschl 7036: ol#LC_PathBreadcrumbs {
1.911 bisitz 7037: margin: 0;
1.693 droeschl 7038: }
7039:
1.897 wenzelju 7040: ol.LC_primary_menu li {
1.1076 raeburn 7041: color: RGB(80, 80, 80);
7042: vertical-align: middle;
7043: text-align: left;
7044: list-style: none;
1.1205 golterma 7045: position: relative;
1.1076 raeburn 7046: float: left;
1.1205 golterma 7047: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7048: line-height: 1.5em;
1.1076 raeburn 7049: }
7050:
1.1205 golterma 7051: ol.LC_primary_menu li a,
7052: ol.LC_primary_menu li p {
1.1076 raeburn 7053: display: block;
7054: margin: 0;
7055: padding: 0 5px 0 10px;
7056: text-decoration: none;
7057: }
7058:
1.1205 golterma 7059: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7060: display: inline-block;
7061: width: 95%;
7062: text-align: left;
7063: }
7064:
7065: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7066: display: inline-block;
7067: width: 5%;
7068: float: right;
7069: text-align: right;
7070: font-size: 70%;
7071: }
7072:
7073: ol.LC_primary_menu ul {
1.1076 raeburn 7074: display: none;
1.1205 golterma 7075: width: 15em;
1.1076 raeburn 7076: background-color: $data_table_light;
1.1205 golterma 7077: position: absolute;
7078: top: 100%;
1.1076 raeburn 7079: }
7080:
1.1205 golterma 7081: ol.LC_primary_menu ul ul {
7082: left: 100%;
7083: top: 0;
7084: }
7085:
7086: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7087: display: block;
7088: position: absolute;
7089: margin: 0;
7090: padding: 0;
1.1078 raeburn 7091: z-index: 2;
1.1076 raeburn 7092: }
7093:
7094: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7095: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7096: font-size: 90%;
1.911 bisitz 7097: vertical-align: top;
1.1076 raeburn 7098: float: none;
1.1079 raeburn 7099: border-left: 1px solid black;
7100: border-right: 1px solid black;
1.1205 golterma 7101: /* A dark bottom border to visualize different menu options;
7102: overwritten in the create_submenu routine for the last border-bottom of the menu */
7103: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7104: }
7105:
1.1205 golterma 7106: ol.LC_primary_menu li li p:hover {
7107: color:$button_hover;
7108: text-decoration:none;
7109: background-color:$data_table_dark;
1.1076 raeburn 7110: }
7111:
7112: ol.LC_primary_menu li li a:hover {
7113: color:$button_hover;
7114: background-color:$data_table_dark;
1.693 droeschl 7115: }
7116:
1.1205 golterma 7117: /* Font-size equal to the size of the predecessors*/
7118: ol.LC_primary_menu li:hover li li {
7119: font-size: 100%;
7120: }
7121:
1.897 wenzelju 7122: ol.LC_primary_menu li img {
1.911 bisitz 7123: vertical-align: bottom;
1.934 droeschl 7124: height: 1.1em;
1.1077 raeburn 7125: margin: 0.2em 0 0 0;
1.693 droeschl 7126: }
7127:
1.897 wenzelju 7128: ol.LC_primary_menu a {
1.911 bisitz 7129: color: RGB(80, 80, 80);
7130: text-decoration: none;
1.693 droeschl 7131: }
1.795 www 7132:
1.949 droeschl 7133: ol.LC_primary_menu a.LC_new_message {
7134: font-weight:bold;
7135: color: darkred;
7136: }
7137:
1.975 raeburn 7138: ol.LC_docs_parameters {
7139: margin-left: 0;
7140: padding: 0;
7141: list-style: none;
7142: }
7143:
7144: ol.LC_docs_parameters li {
7145: margin: 0;
7146: padding-right: 20px;
7147: display: inline;
7148: }
7149:
1.976 raeburn 7150: ol.LC_docs_parameters li:before {
7151: content: "\\002022 \\0020";
7152: }
7153:
7154: li.LC_docs_parameters_title {
7155: font-weight: bold;
7156: }
7157:
7158: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7159: content: "";
7160: }
7161:
1.897 wenzelju 7162: ul#LC_secondary_menu {
1.1107 raeburn 7163: clear: right;
1.911 bisitz 7164: color: $fontmenu;
7165: background: $tabbg;
7166: list-style: none;
7167: padding: 0;
7168: margin: 0;
7169: width: 100%;
1.995 raeburn 7170: text-align: left;
1.1107 raeburn 7171: float: left;
1.808 droeschl 7172: }
7173:
1.897 wenzelju 7174: ul#LC_secondary_menu li {
1.911 bisitz 7175: font-weight: bold;
7176: line-height: 1.8em;
1.1107 raeburn 7177: border-right: 1px solid black;
7178: float: left;
7179: }
7180:
7181: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7182: background-color: $data_table_light;
7183: }
7184:
7185: ul#LC_secondary_menu li a {
1.911 bisitz 7186: padding: 0 0.8em;
1.1107 raeburn 7187: }
7188:
7189: ul#LC_secondary_menu li ul {
7190: display: none;
7191: }
7192:
7193: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7194: display: block;
7195: position: absolute;
7196: margin: 0;
7197: padding: 0;
7198: list-style:none;
7199: float: none;
7200: background-color: $data_table_light;
7201: z-index: 2;
7202: margin-left: -1px;
7203: }
7204:
7205: ul#LC_secondary_menu li ul li {
7206: font-size: 90%;
7207: vertical-align: top;
7208: border-left: 1px solid black;
1.911 bisitz 7209: border-right: 1px solid black;
1.1119 raeburn 7210: background-color: $data_table_light;
1.1107 raeburn 7211: list-style:none;
7212: float: none;
7213: }
7214:
7215: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7216: background-color: $data_table_dark;
1.807 droeschl 7217: }
7218:
1.847 tempelho 7219: ul.LC_TabContent {
1.911 bisitz 7220: display:block;
7221: background: $sidebg;
7222: border-bottom: solid 1px $lg_border_color;
7223: list-style:none;
1.1020 raeburn 7224: margin: -1px -10px 0 -10px;
1.911 bisitz 7225: padding: 0;
1.693 droeschl 7226: }
7227:
1.795 www 7228: ul.LC_TabContent li,
7229: ul.LC_TabContentBigger li {
1.911 bisitz 7230: float:left;
1.741 harmsja 7231: }
1.795 www 7232:
1.897 wenzelju 7233: ul#LC_secondary_menu li a {
1.911 bisitz 7234: color: $fontmenu;
7235: text-decoration: none;
1.693 droeschl 7236: }
1.795 www 7237:
1.721 harmsja 7238: ul.LC_TabContent {
1.952 onken 7239: min-height:20px;
1.721 harmsja 7240: }
1.795 www 7241:
7242: ul.LC_TabContent li {
1.911 bisitz 7243: vertical-align:middle;
1.959 onken 7244: padding: 0 16px 0 10px;
1.911 bisitz 7245: background-color:$tabbg;
7246: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7247: border-left: solid 1px $font;
1.721 harmsja 7248: }
1.795 www 7249:
1.847 tempelho 7250: ul.LC_TabContent .right {
1.911 bisitz 7251: float:right;
1.847 tempelho 7252: }
7253:
1.911 bisitz 7254: ul.LC_TabContent li a,
7255: ul.LC_TabContent li {
7256: color:rgb(47,47,47);
7257: text-decoration:none;
7258: font-size:95%;
7259: font-weight:bold;
1.952 onken 7260: min-height:20px;
7261: }
7262:
1.959 onken 7263: ul.LC_TabContent li a:hover,
7264: ul.LC_TabContent li a:focus {
1.952 onken 7265: color: $button_hover;
1.959 onken 7266: background:none;
7267: outline:none;
1.952 onken 7268: }
7269:
7270: ul.LC_TabContent li:hover {
7271: color: $button_hover;
7272: cursor:pointer;
1.721 harmsja 7273: }
1.795 www 7274:
1.911 bisitz 7275: ul.LC_TabContent li.active {
1.952 onken 7276: color: $font;
1.911 bisitz 7277: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7278: border-bottom:solid 1px #FFFFFF;
7279: cursor: default;
1.744 ehlerst 7280: }
1.795 www 7281:
1.959 onken 7282: ul.LC_TabContent li.active a {
7283: color:$font;
7284: background:#FFFFFF;
7285: outline: none;
7286: }
1.1047 raeburn 7287:
7288: ul.LC_TabContent li.goback {
7289: float: left;
7290: border-left: none;
7291: }
7292:
1.870 tempelho 7293: #maincoursedoc {
1.911 bisitz 7294: clear:both;
1.870 tempelho 7295: }
7296:
7297: ul.LC_TabContentBigger {
1.911 bisitz 7298: display:block;
7299: list-style:none;
7300: padding: 0;
1.870 tempelho 7301: }
7302:
1.795 www 7303: ul.LC_TabContentBigger li {
1.911 bisitz 7304: vertical-align:bottom;
7305: height: 30px;
7306: font-size:110%;
7307: font-weight:bold;
7308: color: #737373;
1.841 tempelho 7309: }
7310:
1.957 onken 7311: ul.LC_TabContentBigger li.active {
7312: position: relative;
7313: top: 1px;
7314: }
7315:
1.870 tempelho 7316: ul.LC_TabContentBigger li a {
1.911 bisitz 7317: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7318: height: 30px;
7319: line-height: 30px;
7320: text-align: center;
7321: display: block;
7322: text-decoration: none;
1.958 onken 7323: outline: none;
1.741 harmsja 7324: }
1.795 www 7325:
1.870 tempelho 7326: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7327: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7328: color:$font;
1.744 ehlerst 7329: }
1.795 www 7330:
1.870 tempelho 7331: ul.LC_TabContentBigger li b {
1.911 bisitz 7332: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7333: display: block;
7334: float: left;
7335: padding: 0 30px;
1.957 onken 7336: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7337: }
7338:
1.956 onken 7339: ul.LC_TabContentBigger li:hover b {
7340: color:$button_hover;
7341: }
7342:
1.870 tempelho 7343: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7344: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7345: color:$font;
1.957 onken 7346: border: 0;
1.741 harmsja 7347: }
1.693 droeschl 7348:
1.870 tempelho 7349:
1.862 bisitz 7350: ul.LC_CourseBreadcrumbs {
7351: background: $sidebg;
1.1020 raeburn 7352: height: 2em;
1.862 bisitz 7353: padding-left: 10px;
1.1020 raeburn 7354: margin: 0;
1.862 bisitz 7355: list-style-position: inside;
7356: }
7357:
1.911 bisitz 7358: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7359: ol#LC_PathBreadcrumbs {
1.911 bisitz 7360: padding-left: 10px;
7361: margin: 0;
1.933 droeschl 7362: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7363: }
7364:
1.911 bisitz 7365: ol#LC_MenuBreadcrumbs li,
7366: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7367: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7368: display: inline;
1.933 droeschl 7369: white-space: normal;
1.693 droeschl 7370: }
7371:
1.823 bisitz 7372: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7373: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7374: text-decoration: none;
7375: font-size:90%;
1.693 droeschl 7376: }
1.795 www 7377:
1.969 droeschl 7378: ol#LC_MenuBreadcrumbs h1 {
7379: display: inline;
7380: font-size: 90%;
7381: line-height: 2.5em;
7382: margin: 0;
7383: padding: 0;
7384: }
7385:
1.795 www 7386: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7387: text-decoration:none;
7388: font-size:100%;
7389: font-weight:bold;
1.693 droeschl 7390: }
1.795 www 7391:
1.840 bisitz 7392: .LC_Box {
1.911 bisitz 7393: border: solid 1px $lg_border_color;
7394: padding: 0 10px 10px 10px;
1.746 neumanie 7395: }
1.795 www 7396:
1.1020 raeburn 7397: .LC_DocsBox {
7398: border: solid 1px $lg_border_color;
7399: padding: 0 0 10px 10px;
7400: }
7401:
1.795 www 7402: .LC_AboutMe_Image {
1.911 bisitz 7403: float:left;
7404: margin-right:10px;
1.747 neumanie 7405: }
1.795 www 7406:
7407: .LC_Clear_AboutMe_Image {
1.911 bisitz 7408: clear:left;
1.747 neumanie 7409: }
1.795 www 7410:
1.721 harmsja 7411: dl.LC_ListStyleClean dt {
1.911 bisitz 7412: padding-right: 5px;
7413: display: table-header-group;
1.693 droeschl 7414: }
7415:
1.721 harmsja 7416: dl.LC_ListStyleClean dd {
1.911 bisitz 7417: display: table-row;
1.693 droeschl 7418: }
7419:
1.721 harmsja 7420: .LC_ListStyleClean,
7421: .LC_ListStyleSimple,
7422: .LC_ListStyleNormal,
1.795 www 7423: .LC_ListStyleSpecial {
1.911 bisitz 7424: /* display:block; */
7425: list-style-position: inside;
7426: list-style-type: none;
7427: overflow: hidden;
7428: padding: 0;
1.693 droeschl 7429: }
7430:
1.721 harmsja 7431: .LC_ListStyleSimple li,
7432: .LC_ListStyleSimple dd,
7433: .LC_ListStyleNormal li,
7434: .LC_ListStyleNormal dd,
7435: .LC_ListStyleSpecial li,
1.795 www 7436: .LC_ListStyleSpecial dd {
1.911 bisitz 7437: margin: 0;
7438: padding: 5px 5px 5px 10px;
7439: clear: both;
1.693 droeschl 7440: }
7441:
1.721 harmsja 7442: .LC_ListStyleClean li,
7443: .LC_ListStyleClean dd {
1.911 bisitz 7444: padding-top: 0;
7445: padding-bottom: 0;
1.693 droeschl 7446: }
7447:
1.721 harmsja 7448: .LC_ListStyleSimple dd,
1.795 www 7449: .LC_ListStyleSimple li {
1.911 bisitz 7450: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7451: }
7452:
1.721 harmsja 7453: .LC_ListStyleSpecial li,
7454: .LC_ListStyleSpecial dd {
1.911 bisitz 7455: list-style-type: none;
7456: background-color: RGB(220, 220, 220);
7457: margin-bottom: 4px;
1.693 droeschl 7458: }
7459:
1.721 harmsja 7460: table.LC_SimpleTable {
1.911 bisitz 7461: margin:5px;
7462: border:solid 1px $lg_border_color;
1.795 www 7463: }
1.693 droeschl 7464:
1.721 harmsja 7465: table.LC_SimpleTable tr {
1.911 bisitz 7466: padding: 0;
7467: border:solid 1px $lg_border_color;
1.693 droeschl 7468: }
1.795 www 7469:
7470: table.LC_SimpleTable thead {
1.911 bisitz 7471: background:rgb(220,220,220);
1.693 droeschl 7472: }
7473:
1.721 harmsja 7474: div.LC_columnSection {
1.911 bisitz 7475: display: block;
7476: clear: both;
7477: overflow: hidden;
7478: margin: 0;
1.693 droeschl 7479: }
7480:
1.721 harmsja 7481: div.LC_columnSection>* {
1.911 bisitz 7482: float: left;
7483: margin: 10px 20px 10px 0;
7484: overflow:hidden;
1.693 droeschl 7485: }
1.721 harmsja 7486:
1.795 www 7487: table em {
1.911 bisitz 7488: font-weight: bold;
7489: font-style: normal;
1.748 schulted 7490: }
1.795 www 7491:
1.779 bisitz 7492: table.LC_tableBrowseRes,
1.795 www 7493: table.LC_tableOfContent {
1.911 bisitz 7494: border:none;
7495: border-spacing: 1px;
7496: padding: 3px;
7497: background-color: #FFFFFF;
7498: font-size: 90%;
1.753 droeschl 7499: }
1.789 droeschl 7500:
1.911 bisitz 7501: table.LC_tableOfContent {
7502: border-collapse: collapse;
1.789 droeschl 7503: }
7504:
1.771 droeschl 7505: table.LC_tableBrowseRes a,
1.768 schulted 7506: table.LC_tableOfContent a {
1.911 bisitz 7507: background-color: transparent;
7508: text-decoration: none;
1.753 droeschl 7509: }
7510:
1.795 www 7511: table.LC_tableOfContent img {
1.911 bisitz 7512: border: none;
7513: height: 1.3em;
7514: vertical-align: text-bottom;
7515: margin-right: 0.3em;
1.753 droeschl 7516: }
1.757 schulted 7517:
1.795 www 7518: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7519: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7520: }
7521:
1.795 www 7522: a#LC_content_toolbar_everything {
1.911 bisitz 7523: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7524: }
7525:
1.795 www 7526: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7527: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7528: }
7529:
1.795 www 7530: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7531: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7532: }
7533:
1.795 www 7534: a#LC_content_toolbar_changefolder {
1.911 bisitz 7535: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7536: }
7537:
1.795 www 7538: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7539: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7540: }
7541:
1.1043 raeburn 7542: a#LC_content_toolbar_edittoplevel {
7543: background-image:url(/res/adm/pages/edittoplevel.gif);
7544: }
7545:
1.795 www 7546: ul#LC_toolbar li a:hover {
1.911 bisitz 7547: background-position: bottom center;
1.757 schulted 7548: }
7549:
1.795 www 7550: ul#LC_toolbar {
1.911 bisitz 7551: padding: 0;
7552: margin: 2px;
7553: list-style:none;
7554: position:relative;
7555: background-color:white;
1.1082 raeburn 7556: overflow: auto;
1.757 schulted 7557: }
7558:
1.795 www 7559: ul#LC_toolbar li {
1.911 bisitz 7560: border:1px solid white;
7561: padding: 0;
7562: margin: 0;
7563: float: left;
7564: display:inline;
7565: vertical-align:middle;
1.1082 raeburn 7566: white-space: nowrap;
1.911 bisitz 7567: }
1.757 schulted 7568:
1.783 amueller 7569:
1.795 www 7570: a.LC_toolbarItem {
1.911 bisitz 7571: display:block;
7572: padding: 0;
7573: margin: 0;
7574: height: 32px;
7575: width: 32px;
7576: color:white;
7577: border: none;
7578: background-repeat:no-repeat;
7579: background-color:transparent;
1.757 schulted 7580: }
7581:
1.915 droeschl 7582: ul.LC_funclist {
7583: margin: 0;
7584: padding: 0.5em 1em 0.5em 0;
7585: }
7586:
1.933 droeschl 7587: ul.LC_funclist > li:first-child {
7588: font-weight:bold;
7589: margin-left:0.8em;
7590: }
7591:
1.915 droeschl 7592: ul.LC_funclist + ul.LC_funclist {
7593: /*
7594: left border as a seperator if we have more than
7595: one list
7596: */
7597: border-left: 1px solid $sidebg;
7598: /*
7599: this hides the left border behind the border of the
7600: outer box if element is wrapped to the next 'line'
7601: */
7602: margin-left: -1px;
7603: }
7604:
1.843 bisitz 7605: ul.LC_funclist li {
1.915 droeschl 7606: display: inline;
1.782 bisitz 7607: white-space: nowrap;
1.915 droeschl 7608: margin: 0 0 0 25px;
7609: line-height: 150%;
1.782 bisitz 7610: }
7611:
1.974 wenzelju 7612: .LC_hidden {
7613: display: none;
7614: }
7615:
1.1030 www 7616: .LCmodal-overlay {
7617: position:fixed;
7618: top:0;
7619: right:0;
7620: bottom:0;
7621: left:0;
7622: height:100%;
7623: width:100%;
7624: margin:0;
7625: padding:0;
7626: background:#999;
7627: opacity:.75;
7628: filter: alpha(opacity=75);
7629: -moz-opacity: 0.75;
7630: z-index:101;
7631: }
7632:
7633: * html .LCmodal-overlay {
7634: position: absolute;
7635: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7636: }
7637:
7638: .LCmodal-window {
7639: position:fixed;
7640: top:50%;
7641: left:50%;
7642: margin:0;
7643: padding:0;
7644: z-index:102;
7645: }
7646:
7647: * html .LCmodal-window {
7648: position:absolute;
7649: }
7650:
7651: .LCclose-window {
7652: position:absolute;
7653: width:32px;
7654: height:32px;
7655: right:8px;
7656: top:8px;
7657: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7658: text-indent:-99999px;
7659: overflow:hidden;
7660: cursor:pointer;
7661: }
7662:
1.1100 raeburn 7663: /*
1.1231 damieng 7664: styles used for response display
7665: */
7666: div.LC_radiofoil, div.LC_rankfoil {
7667: margin: .5em 0em .5em 0em;
7668: }
7669: table.LC_itemgroup {
7670: margin-top: 1em;
7671: }
7672:
7673: /*
1.1100 raeburn 7674: styles used by TTH when "Default set of options to pass to tth/m
7675: when converting TeX" in course settings has been set
7676:
7677: option passed: -t
7678:
7679: */
7680:
7681: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7682: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7683: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7684: td div.norm {line-height:normal;}
7685:
7686: /*
7687: option passed -y3
7688: */
7689:
7690: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7691: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7692: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7693:
1.1230 damieng 7694: /*
7695: sections with roles, for content only
7696: */
7697: section[class^="role-"] {
7698: padding-left: 10px;
7699: padding-right: 5px;
7700: margin-top: 8px;
7701: margin-bottom: 8px;
7702: border: 1px solid #2A4;
7703: border-radius: 5px;
7704: box-shadow: 0px 1px 1px #BBB;
7705: }
7706: section[class^="role-"]>h1 {
7707: position: relative;
7708: margin: 0px;
7709: padding-top: 10px;
7710: padding-left: 40px;
7711: }
7712: section[class^="role-"]>h1:before {
7713: position: absolute;
7714: left: -5px;
7715: top: 5px;
7716: }
7717: section.role-activity>h1:before {
7718: content:url('/adm/daxe/images/section_icons/activity.png');
7719: }
7720: section.role-advice>h1:before {
7721: content:url('/adm/daxe/images/section_icons/advice.png');
7722: }
7723: section.role-bibliography>h1:before {
7724: content:url('/adm/daxe/images/section_icons/bibliography.png');
7725: }
7726: section.role-citation>h1:before {
7727: content:url('/adm/daxe/images/section_icons/citation.png');
7728: }
7729: section.role-conclusion>h1:before {
7730: content:url('/adm/daxe/images/section_icons/conclusion.png');
7731: }
7732: section.role-definition>h1:before {
7733: content:url('/adm/daxe/images/section_icons/definition.png');
7734: }
7735: section.role-demonstration>h1:before {
7736: content:url('/adm/daxe/images/section_icons/demonstration.png');
7737: }
7738: section.role-example>h1:before {
7739: content:url('/adm/daxe/images/section_icons/example.png');
7740: }
7741: section.role-explanation>h1:before {
7742: content:url('/adm/daxe/images/section_icons/explanation.png');
7743: }
7744: section.role-introduction>h1:before {
7745: content:url('/adm/daxe/images/section_icons/introduction.png');
7746: }
7747: section.role-method>h1:before {
7748: content:url('/adm/daxe/images/section_icons/method.png');
7749: }
7750: section.role-more_information>h1:before {
7751: content:url('/adm/daxe/images/section_icons/more_information.png');
7752: }
7753: section.role-objectives>h1:before {
7754: content:url('/adm/daxe/images/section_icons/objectives.png');
7755: }
7756: section.role-prerequisites>h1:before {
7757: content:url('/adm/daxe/images/section_icons/prerequisites.png');
7758: }
7759: section.role-remark>h1:before {
7760: content:url('/adm/daxe/images/section_icons/remark.png');
7761: }
7762: section.role-reminder>h1:before {
7763: content:url('/adm/daxe/images/section_icons/reminder.png');
7764: }
7765: section.role-summary>h1:before {
7766: content:url('/adm/daxe/images/section_icons/summary.png');
7767: }
7768: section.role-syntax>h1:before {
7769: content:url('/adm/daxe/images/section_icons/syntax.png');
7770: }
7771: section.role-warning>h1:before {
7772: content:url('/adm/daxe/images/section_icons/warning.png');
7773: }
7774:
1.343 albertel 7775: END
7776: }
7777:
1.306 albertel 7778: =pod
7779:
7780: =item * &headtag()
7781:
7782: Returns a uniform footer for LON-CAPA web pages.
7783:
1.307 albertel 7784: Inputs: $title - optional title for the head
7785: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7786: $args - optional arguments
1.319 albertel 7787: force_register - if is true call registerurl so the remote is
7788: informed
1.415 albertel 7789: redirect -> array ref of
7790: 1- seconds before redirect occurs
7791: 2- url to redirect to
7792: 3- whether the side effect should occur
1.315 albertel 7793: (side effect of setting
7794: $env{'internal.head.redirect'} to the url
7795: redirected too)
1.352 albertel 7796: domain -> force to color decorate a page for a specific
7797: domain
7798: function -> force usage of a specific rolish color scheme
7799: bgcolor -> override the default page bgcolor
1.460 albertel 7800: no_auto_mt_title
7801: -> prevent &mt()ing the title arg
1.464 albertel 7802:
1.306 albertel 7803: =cut
7804:
7805: sub headtag {
1.313 albertel 7806: my ($title,$head_extra,$args) = @_;
1.306 albertel 7807:
1.363 albertel 7808: my $function = $args->{'function'} || &get_users_function();
7809: my $domain = $args->{'domain'} || &determinedomain();
7810: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7811: my $httphost = $args->{'use_absolute'};
1.418 albertel 7812: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7813: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7814: #time(),
1.418 albertel 7815: $env{'environment.color.timestamp'},
1.363 albertel 7816: $function,$domain,$bgcolor);
7817:
1.369 www 7818: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7819:
1.308 albertel 7820: my $result =
7821: '<head>'.
1.1160 raeburn 7822: &font_settings($args);
1.319 albertel 7823:
1.1188 raeburn 7824: my $inhibitprint;
7825: if ($args->{'print_suppress'}) {
7826: $inhibitprint = &print_suppression();
7827: }
1.1064 raeburn 7828:
1.461 albertel 7829: if (!$args->{'frameset'}) {
7830: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7831: }
1.962 droeschl 7832: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7833: $result .= Apache::lonxml::display_title();
1.319 albertel 7834: }
1.436 albertel 7835: if (!$args->{'no_nav_bar'}
7836: && !$args->{'only_body'}
7837: && !$args->{'frameset'}) {
1.1154 raeburn 7838: $result .= &help_menu_js($httphost);
1.1032 www 7839: $result.=&modal_window();
1.1038 www 7840: $result.=&togglebox_script();
1.1034 www 7841: $result.=&wishlist_window();
1.1041 www 7842: $result.=&LCprogressbarUpdate_script();
1.1034 www 7843: } else {
7844: if ($args->{'add_modal'}) {
7845: $result.=&modal_window();
7846: }
7847: if ($args->{'add_wishlist'}) {
7848: $result.=&wishlist_window();
7849: }
1.1038 www 7850: if ($args->{'add_togglebox'}) {
7851: $result.=&togglebox_script();
7852: }
1.1041 www 7853: if ($args->{'add_progressbar'}) {
7854: $result.=&LCprogressbarUpdate_script();
7855: }
1.436 albertel 7856: }
1.314 albertel 7857: if (ref($args->{'redirect'})) {
1.414 albertel 7858: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7859: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7860: if (!$inhibit_continue) {
7861: $env{'internal.head.redirect'} = $url;
7862: }
1.313 albertel 7863: $result.=<<ADDMETA
7864: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7865: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7866: ADDMETA
1.1210 raeburn 7867: } else {
7868: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7869: my $requrl = $env{'request.uri'};
7870: if ($requrl eq '') {
7871: $requrl = $ENV{'REQUEST_URI'};
7872: $requrl =~ s/\?.+$//;
7873: }
7874: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7875: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7876: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7877: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7878: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7879: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7880: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7881: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7882: if ($domdefs{'offloadnow'}{$lonhost}) {
7883: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7884: if (($newserver) && ($newserver ne $lonhost)) {
7885: my $numsec = 5;
7886: my $timeout = $numsec * 1000;
7887: my ($newurl,$locknum,%locks,$msg);
7888: if ($env{'request.role.adv'}) {
7889: ($locknum,%locks) = &Apache::lonnet::get_locks();
7890: }
7891: my $disable_submit = 0;
7892: if ($requrl =~ /$LONCAPA::assess_re/) {
7893: $disable_submit = 1;
7894: }
7895: if ($locknum) {
7896: my @lockinfo = sort(values(%locks));
7897: $msg = &mt('Once the following tasks are complete: ')."\\n".
7898: join(", ",sort(values(%locks)))."\\n".
7899: &mt('your session will be transferred to a different server, after you click "Roles".');
7900: } else {
7901: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7902: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7903: }
7904: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7905: $newurl = '/adm/switchserver?otherserver='.$newserver;
7906: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7907: $newurl .= '&role='.$env{'request.role'};
7908: }
7909: if ($env{'request.symb'}) {
7910: $newurl .= '&symb='.$env{'request.symb'};
7911: } else {
7912: $newurl .= '&origurl='.$requrl;
7913: }
7914: }
1.1222 damieng 7915: &js_escape(\$msg);
1.1210 raeburn 7916: $result.=<<OFFLOAD
7917: <meta http-equiv="pragma" content="no-cache" />
7918: <script type="text/javascript">
1.1215 raeburn 7919: // <![CDATA[
1.1210 raeburn 7920: function LC_Offload_Now() {
7921: var dest = "$newurl";
7922: if (dest != '') {
7923: window.location.href="$newurl";
7924: }
7925: }
1.1214 raeburn 7926: \$(document).ready(function () {
7927: window.alert('$msg');
7928: if ($disable_submit) {
1.1210 raeburn 7929: \$(".LC_hwk_submit").prop("disabled", true);
7930: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 7931: }
7932: setTimeout('LC_Offload_Now()', $timeout);
7933: });
1.1215 raeburn 7934: // ]]>
1.1210 raeburn 7935: </script>
7936: OFFLOAD
7937: }
7938: }
7939: }
7940: }
7941: }
7942: }
1.313 albertel 7943: }
1.306 albertel 7944: if (!defined($title)) {
7945: $title = 'The LearningOnline Network with CAPA';
7946: }
1.460 albertel 7947: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7948: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7949: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7950: if (!$args->{'frameset'}) {
7951: $result .= ' /';
7952: }
7953: $result .= '>'
1.1064 raeburn 7954: .$inhibitprint
1.414 albertel 7955: .$head_extra;
1.1137 raeburn 7956: if ($env{'browser.mobile'}) {
7957: $result .= '
7958: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7959: <meta name="apple-mobile-web-app-capable" content="yes" />';
7960: }
1.962 droeschl 7961: return $result.'</head>';
1.306 albertel 7962: }
7963:
7964: =pod
7965:
1.340 albertel 7966: =item * &font_settings()
7967:
7968: Returns neccessary <meta> to set the proper encoding
7969:
1.1160 raeburn 7970: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7971:
7972: =cut
7973:
7974: sub font_settings {
1.1160 raeburn 7975: my ($args) = @_;
1.340 albertel 7976: my $headerstring='';
1.1160 raeburn 7977: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7978: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7979: $headerstring.=
7980: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7981: if (!$args->{'frameset'}) {
7982: $headerstring.= ' /';
7983: }
7984: $headerstring .= '>'."\n";
1.340 albertel 7985: }
7986: return $headerstring;
7987: }
7988:
1.341 albertel 7989: =pod
7990:
1.1064 raeburn 7991: =item * &print_suppression()
7992:
7993: In course context returns css which causes the body to be blank when media="print",
7994: if printout generation is unavailable for the current resource.
7995:
7996: This could be because:
7997:
7998: (a) printstartdate is in the future
7999:
8000: (b) printenddate is in the past
8001:
8002: (c) there is an active exam block with "printout"
8003: functionality blocked
8004:
8005: Users with pav, pfo or evb privileges are exempt.
8006:
8007: Inputs: none
8008:
8009: =cut
8010:
8011:
8012: sub print_suppression {
8013: my $noprint;
8014: if ($env{'request.course.id'}) {
8015: my $scope = $env{'request.course.id'};
8016: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8017: (&Apache::lonnet::allowed('pfo',$scope))) {
8018: return;
8019: }
8020: if ($env{'request.course.sec'} ne '') {
8021: $scope .= "/$env{'request.course.sec'}";
8022: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8023: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8024: return;
1.1064 raeburn 8025: }
8026: }
8027: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8028: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8029: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8030: if ($blocked) {
8031: my $checkrole = "cm./$cdom/$cnum";
8032: if ($env{'request.course.sec'} ne '') {
8033: $checkrole .= "/$env{'request.course.sec'}";
8034: }
8035: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8036: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8037: $noprint = 1;
8038: }
8039: }
8040: unless ($noprint) {
8041: my $symb = &Apache::lonnet::symbread();
8042: if ($symb ne '') {
8043: my $navmap = Apache::lonnavmaps::navmap->new();
8044: if (ref($navmap)) {
8045: my $res = $navmap->getBySymb($symb);
8046: if (ref($res)) {
8047: if (!$res->resprintable()) {
8048: $noprint = 1;
8049: }
8050: }
8051: }
8052: }
8053: }
8054: if ($noprint) {
8055: return <<"ENDSTYLE";
8056: <style type="text/css" media="print">
8057: body { display:none }
8058: </style>
8059: ENDSTYLE
8060: }
8061: }
8062: return;
8063: }
8064:
8065: =pod
8066:
1.341 albertel 8067: =item * &xml_begin()
8068:
8069: Returns the needed doctype and <html>
8070:
8071: Inputs: none
8072:
8073: =cut
8074:
8075: sub xml_begin {
1.1168 raeburn 8076: my ($is_frameset) = @_;
1.341 albertel 8077: my $output='';
8078:
8079: if ($env{'browser.mathml'}) {
8080: $output='<?xml version="1.0"?>'
8081: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8082: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8083:
8084: # .'<!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">] >'
8085: .'<!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">'
8086: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8087: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8088: } elsif ($is_frameset) {
8089: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8090: '<html>'."\n";
1.341 albertel 8091: } else {
1.1168 raeburn 8092: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8093: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8094: }
8095: return $output;
8096: }
1.340 albertel 8097:
8098: =pod
8099:
1.306 albertel 8100: =item * &start_page()
8101:
8102: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8103:
1.648 raeburn 8104: Inputs:
8105:
8106: =over 4
8107:
8108: $title - optional title for the page
8109:
8110: $head_extra - optional extra HTML to incude inside the <head>
8111:
8112: $args - additional optional args supported are:
8113:
8114: =over 8
8115:
8116: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8117: arg on
1.814 bisitz 8118: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8119: add_entries -> additional attributes to add to the <body>
8120: domain -> force to color decorate a page for a
1.317 albertel 8121: specific domain
1.648 raeburn 8122: function -> force usage of a specific rolish color
1.317 albertel 8123: scheme
1.648 raeburn 8124: redirect -> see &headtag()
8125: bgcolor -> override the default page bg color
8126: js_ready -> return a string ready for being used in
1.317 albertel 8127: a javascript writeln
1.648 raeburn 8128: html_encode -> return a string ready for being used in
1.320 albertel 8129: a html attribute
1.648 raeburn 8130: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8131: $forcereg arg
1.648 raeburn 8132: frameset -> if true will start with a <frameset>
1.330 albertel 8133: rather than <body>
1.648 raeburn 8134: skip_phases -> hash ref of
1.338 albertel 8135: head -> skip the <html><head> generation
8136: body -> skip all <body> generation
1.648 raeburn 8137: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8138: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8139: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8140: group -> includes the current group, if page is for a
8141: specific group
1.361 albertel 8142:
1.648 raeburn 8143: =back
1.460 albertel 8144:
1.648 raeburn 8145: =back
1.562 albertel 8146:
1.306 albertel 8147: =cut
8148:
8149: sub start_page {
1.309 albertel 8150: my ($title,$head_extra,$args) = @_;
1.318 albertel 8151: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8152:
1.315 albertel 8153: $env{'internal.start_page'}++;
1.1096 raeburn 8154: my ($result,@advtools);
1.964 droeschl 8155:
1.338 albertel 8156: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8157: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8158: }
8159:
8160: if (! exists($args->{'skip_phases'}{'body'}) ) {
8161: if ($args->{'frameset'}) {
8162: my $attr_string = &make_attr_string($args->{'force_register'},
8163: $args->{'add_entries'});
8164: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8165: } else {
8166: $result .=
8167: &bodytag($title,
8168: $args->{'function'}, $args->{'add_entries'},
8169: $args->{'only_body'}, $args->{'domain'},
8170: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8171: $args->{'bgcolor'}, $args,
8172: \@advtools);
1.831 bisitz 8173: }
1.330 albertel 8174: }
1.338 albertel 8175:
1.315 albertel 8176: if ($args->{'js_ready'}) {
1.713 kaisler 8177: $result = &js_ready($result);
1.315 albertel 8178: }
1.320 albertel 8179: if ($args->{'html_encode'}) {
1.713 kaisler 8180: $result = &html_encode($result);
8181: }
8182:
1.813 bisitz 8183: # Preparation for new and consistent functionlist at top of screen
8184: # if ($args->{'functionlist'}) {
8185: # $result .= &build_functionlist();
8186: #}
8187:
1.964 droeschl 8188: # Don't add anything more if only_body wanted or in const space
8189: return $result if $args->{'only_body'}
8190: || $env{'request.state'} eq 'construct';
1.813 bisitz 8191:
8192: #Breadcrumbs
1.758 kaisler 8193: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8194: &Apache::lonhtmlcommon::clear_breadcrumbs();
8195: #if any br links exists, add them to the breadcrumbs
8196: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8197: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8198: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8199: }
8200: }
1.1096 raeburn 8201: # if @advtools array contains items add then to the breadcrumbs
8202: if (@advtools > 0) {
8203: &Apache::lonmenu::advtools_crumbs(@advtools);
8204: }
1.758 kaisler 8205:
8206: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8207: if(exists($args->{'bread_crumbs_component'})){
8208: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237 raeburn 8209: } elsif ($args->{'crstype'} eq 'Placement') {
8210: $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
8211: $args->{'crstype'});
8212: } else {
1.758 kaisler 8213: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8214: }
1.320 albertel 8215: }
1.315 albertel 8216: return $result;
1.306 albertel 8217: }
8218:
8219: sub end_page {
1.315 albertel 8220: my ($args) = @_;
8221: $env{'internal.end_page'}++;
1.330 albertel 8222: my $result;
1.335 albertel 8223: if ($args->{'discussion'}) {
8224: my ($target,$parser);
8225: if (ref($args->{'discussion'})) {
8226: ($target,$parser) =($args->{'discussion'}{'target'},
8227: $args->{'discussion'}{'parser'});
8228: }
8229: $result .= &Apache::lonxml::xmlend($target,$parser);
8230: }
1.330 albertel 8231: if ($args->{'frameset'}) {
8232: $result .= '</frameset>';
8233: } else {
1.635 raeburn 8234: $result .= &endbodytag($args);
1.330 albertel 8235: }
1.1080 raeburn 8236: unless ($args->{'notbody'}) {
8237: $result .= "\n</html>";
8238: }
1.330 albertel 8239:
1.315 albertel 8240: if ($args->{'js_ready'}) {
1.317 albertel 8241: $result = &js_ready($result);
1.315 albertel 8242: }
1.335 albertel 8243:
1.320 albertel 8244: if ($args->{'html_encode'}) {
8245: $result = &html_encode($result);
8246: }
1.335 albertel 8247:
1.315 albertel 8248: return $result;
8249: }
8250:
1.1034 www 8251: sub wishlist_window {
8252: return(<<'ENDWISHLIST');
1.1046 raeburn 8253: <script type="text/javascript">
1.1034 www 8254: // <![CDATA[
8255: // <!-- BEGIN LON-CAPA Internal
8256: function set_wishlistlink(title, path) {
8257: if (!title) {
8258: title = document.title;
8259: title = title.replace(/^LON-CAPA /,'');
8260: }
1.1175 raeburn 8261: title = encodeURIComponent(title);
1.1203 raeburn 8262: title = title.replace("'","\\\'");
1.1034 www 8263: if (!path) {
8264: path = location.pathname;
8265: }
1.1175 raeburn 8266: path = encodeURIComponent(path);
1.1203 raeburn 8267: path = path.replace("'","\\\'");
1.1034 www 8268: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8269: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8270: }
8271: // END LON-CAPA Internal -->
8272: // ]]>
8273: </script>
8274: ENDWISHLIST
8275: }
8276:
1.1030 www 8277: sub modal_window {
8278: return(<<'ENDMODAL');
1.1046 raeburn 8279: <script type="text/javascript">
1.1030 www 8280: // <![CDATA[
8281: // <!-- BEGIN LON-CAPA Internal
8282: var modalWindow = {
8283: parent:"body",
8284: windowId:null,
8285: content:null,
8286: width:null,
8287: height:null,
8288: close:function()
8289: {
8290: $(".LCmodal-window").remove();
8291: $(".LCmodal-overlay").remove();
8292: },
8293: open:function()
8294: {
8295: var modal = "";
8296: modal += "<div class=\"LCmodal-overlay\"></div>";
8297: 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;\">";
8298: modal += this.content;
8299: modal += "</div>";
8300:
8301: $(this.parent).append(modal);
8302:
8303: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8304: $(".LCclose-window").click(function(){modalWindow.close();});
8305: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8306: }
8307: };
1.1140 raeburn 8308: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8309: {
1.1203 raeburn 8310: source = source.replace("'","'");
1.1030 www 8311: modalWindow.windowId = "myModal";
8312: modalWindow.width = width;
8313: modalWindow.height = height;
1.1196 raeburn 8314: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8315: modalWindow.open();
1.1208 raeburn 8316: };
1.1030 www 8317: // END LON-CAPA Internal -->
8318: // ]]>
8319: </script>
8320: ENDMODAL
8321: }
8322:
8323: sub modal_link {
1.1140 raeburn 8324: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8325: unless ($width) { $width=480; }
8326: unless ($height) { $height=400; }
1.1031 www 8327: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8328: unless ($transparency) { $transparency='true'; }
8329:
1.1074 raeburn 8330: my $target_attr;
8331: if (defined($target)) {
8332: $target_attr = 'target="'.$target.'"';
8333: }
8334: return <<"ENDLINK";
1.1140 raeburn 8335: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8336: $linktext</a>
8337: ENDLINK
1.1030 www 8338: }
8339:
1.1032 www 8340: sub modal_adhoc_script {
8341: my ($funcname,$width,$height,$content)=@_;
8342: return (<<ENDADHOC);
1.1046 raeburn 8343: <script type="text/javascript">
1.1032 www 8344: // <![CDATA[
8345: var $funcname = function()
8346: {
8347: modalWindow.windowId = "myModal";
8348: modalWindow.width = $width;
8349: modalWindow.height = $height;
8350: modalWindow.content = '$content';
8351: modalWindow.open();
8352: };
8353: // ]]>
8354: </script>
8355: ENDADHOC
8356: }
8357:
1.1041 www 8358: sub modal_adhoc_inner {
8359: my ($funcname,$width,$height,$content)=@_;
8360: my $innerwidth=$width-20;
8361: $content=&js_ready(
1.1140 raeburn 8362: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8363: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8364: $content.
1.1041 www 8365: &end_scrollbox().
1.1140 raeburn 8366: &end_page()
1.1041 www 8367: );
8368: return &modal_adhoc_script($funcname,$width,$height,$content);
8369: }
8370:
8371: sub modal_adhoc_window {
8372: my ($funcname,$width,$height,$content,$linktext)=@_;
8373: return &modal_adhoc_inner($funcname,$width,$height,$content).
8374: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8375: }
8376:
8377: sub modal_adhoc_launch {
8378: my ($funcname,$width,$height,$content)=@_;
8379: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8380: <script type="text/javascript">
8381: // <![CDATA[
8382: $funcname();
8383: // ]]>
8384: </script>
8385: ENDLAUNCH
8386: }
8387:
8388: sub modal_adhoc_close {
8389: return (<<ENDCLOSE);
8390: <script type="text/javascript">
8391: // <![CDATA[
8392: modalWindow.close();
8393: // ]]>
8394: </script>
8395: ENDCLOSE
8396: }
8397:
1.1038 www 8398: sub togglebox_script {
8399: return(<<ENDTOGGLE);
8400: <script type="text/javascript">
8401: // <![CDATA[
8402: function LCtoggleDisplay(id,hidetext,showtext) {
8403: link = document.getElementById(id + "link").childNodes[0];
8404: with (document.getElementById(id).style) {
8405: if (display == "none" ) {
8406: display = "inline";
8407: link.nodeValue = hidetext;
8408: } else {
8409: display = "none";
8410: link.nodeValue = showtext;
8411: }
8412: }
8413: }
8414: // ]]>
8415: </script>
8416: ENDTOGGLE
8417: }
8418:
1.1039 www 8419: sub start_togglebox {
8420: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8421: unless ($heading) { $heading=''; } else { $heading.=' '; }
8422: unless ($showtext) { $showtext=&mt('show'); }
8423: unless ($hidetext) { $hidetext=&mt('hide'); }
8424: unless ($headerbg) { $headerbg='#FFFFFF'; }
8425: return &start_data_table().
8426: &start_data_table_header_row().
8427: '<td bgcolor="'.$headerbg.'">'.$heading.
8428: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8429: $showtext.'\')">'.$showtext.'</a>]</td>'.
8430: &end_data_table_header_row().
8431: '<tr id="'.$id.'" style="display:none""><td>';
8432: }
8433:
8434: sub end_togglebox {
8435: return '</td></tr>'.&end_data_table();
8436: }
8437:
1.1041 www 8438: sub LCprogressbar_script {
1.1045 www 8439: my ($id)=@_;
1.1041 www 8440: return(<<ENDPROGRESS);
8441: <script type="text/javascript">
8442: // <![CDATA[
1.1045 www 8443: \$('#progressbar$id').progressbar({
1.1041 www 8444: value: 0,
8445: change: function(event, ui) {
8446: var newVal = \$(this).progressbar('option', 'value');
8447: \$('.pblabel', this).text(LCprogressTxt);
8448: }
8449: });
8450: // ]]>
8451: </script>
8452: ENDPROGRESS
8453: }
8454:
8455: sub LCprogressbarUpdate_script {
8456: return(<<ENDPROGRESSUPDATE);
8457: <style type="text/css">
8458: .ui-progressbar { position:relative; }
8459: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8460: </style>
8461: <script type="text/javascript">
8462: // <![CDATA[
1.1045 www 8463: var LCprogressTxt='---';
8464:
8465: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8466: LCprogressTxt=progresstext;
1.1045 www 8467: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8468: }
8469: // ]]>
8470: </script>
8471: ENDPROGRESSUPDATE
8472: }
8473:
1.1042 www 8474: my $LClastpercent;
1.1045 www 8475: my $LCidcnt;
8476: my $LCcurrentid;
1.1042 www 8477:
1.1041 www 8478: sub LCprogressbar {
1.1042 www 8479: my ($r)=(@_);
8480: $LClastpercent=0;
1.1045 www 8481: $LCidcnt++;
8482: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8483: my $starting=&mt('Starting');
8484: my $content=(<<ENDPROGBAR);
1.1045 www 8485: <div id="progressbar$LCcurrentid">
1.1041 www 8486: <span class="pblabel">$starting</span>
8487: </div>
8488: ENDPROGBAR
1.1045 www 8489: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8490: }
8491:
8492: sub LCprogressbarUpdate {
1.1042 www 8493: my ($r,$val,$text)=@_;
8494: unless ($val) {
8495: if ($LClastpercent) {
8496: $val=$LClastpercent;
8497: } else {
8498: $val=0;
8499: }
8500: }
1.1041 www 8501: if ($val<0) { $val=0; }
8502: if ($val>100) { $val=0; }
1.1042 www 8503: $LClastpercent=$val;
1.1041 www 8504: unless ($text) { $text=$val.'%'; }
8505: $text=&js_ready($text);
1.1044 www 8506: &r_print($r,<<ENDUPDATE);
1.1041 www 8507: <script type="text/javascript">
8508: // <![CDATA[
1.1045 www 8509: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8510: // ]]>
8511: </script>
8512: ENDUPDATE
1.1035 www 8513: }
8514:
1.1042 www 8515: sub LCprogressbarClose {
8516: my ($r)=@_;
8517: $LClastpercent=0;
1.1044 www 8518: &r_print($r,<<ENDCLOSE);
1.1042 www 8519: <script type="text/javascript">
8520: // <![CDATA[
1.1045 www 8521: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8522: // ]]>
8523: </script>
8524: ENDCLOSE
1.1044 www 8525: }
8526:
8527: sub r_print {
8528: my ($r,$to_print)=@_;
8529: if ($r) {
8530: $r->print($to_print);
8531: $r->rflush();
8532: } else {
8533: print($to_print);
8534: }
1.1042 www 8535: }
8536:
1.320 albertel 8537: sub html_encode {
8538: my ($result) = @_;
8539:
1.322 albertel 8540: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8541:
8542: return $result;
8543: }
1.1044 www 8544:
1.317 albertel 8545: sub js_ready {
8546: my ($result) = @_;
8547:
1.323 albertel 8548: $result =~ s/[\n\r]/ /xmsg;
8549: $result =~ s/\\/\\\\/xmsg;
8550: $result =~ s/'/\\'/xmsg;
1.372 albertel 8551: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8552:
8553: return $result;
8554: }
8555:
1.315 albertel 8556: sub validate_page {
8557: if ( exists($env{'internal.start_page'})
1.316 albertel 8558: && $env{'internal.start_page'} > 1) {
8559: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8560: $env{'internal.start_page'}.' '.
1.316 albertel 8561: $ENV{'request.filename'});
1.315 albertel 8562: }
8563: if ( exists($env{'internal.end_page'})
1.316 albertel 8564: && $env{'internal.end_page'} > 1) {
8565: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8566: $env{'internal.end_page'}.' '.
1.316 albertel 8567: $env{'request.filename'});
1.315 albertel 8568: }
8569: if ( exists($env{'internal.start_page'})
8570: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8571: &Apache::lonnet::logthis('start_page called without end_page '.
8572: $env{'request.filename'});
1.315 albertel 8573: }
8574: if ( ! exists($env{'internal.start_page'})
8575: && exists($env{'internal.end_page'})) {
1.316 albertel 8576: &Apache::lonnet::logthis('end_page called without start_page'.
8577: $env{'request.filename'});
1.315 albertel 8578: }
1.306 albertel 8579: }
1.315 albertel 8580:
1.996 www 8581:
8582: sub start_scrollbox {
1.1140 raeburn 8583: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8584: unless ($outerwidth) { $outerwidth='520px'; }
8585: unless ($width) { $width='500px'; }
8586: unless ($height) { $height='200px'; }
1.1075 raeburn 8587: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8588: if ($id ne '') {
1.1140 raeburn 8589: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8590: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8591: }
1.1075 raeburn 8592: if ($bgcolor ne '') {
8593: $tdcol = "background-color: $bgcolor;";
8594: }
1.1137 raeburn 8595: my $nicescroll_js;
8596: if ($env{'browser.mobile'}) {
1.1140 raeburn 8597: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8598: }
8599: return <<"END";
8600: $nicescroll_js
8601:
8602: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8603: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8604: END
8605: }
8606:
8607: sub end_scrollbox {
8608: return '</div></td></tr></table>';
8609: }
8610:
8611: sub nicescroll_javascript {
8612: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8613: my %options;
8614: if (ref($cursor) eq 'HASH') {
8615: %options = %{$cursor};
8616: }
8617: unless ($options{'railalign'} =~ /^left|right$/) {
8618: $options{'railalign'} = 'left';
8619: }
8620: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8621: my $function = &get_users_function();
8622: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8623: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8624: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8625: }
1.1140 raeburn 8626: }
8627: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8628: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8629: $options{'cursoropacity'}='1.0';
8630: }
1.1140 raeburn 8631: } else {
8632: $options{'cursoropacity'}='1.0';
8633: }
8634: if ($options{'cursorfixedheight'} eq 'none') {
8635: delete($options{'cursorfixedheight'});
8636: } else {
8637: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8638: }
8639: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8640: delete($options{'railoffset'});
8641: }
8642: my @niceoptions;
8643: while (my($key,$value) = each(%options)) {
8644: if ($value =~ /^\{.+\}$/) {
8645: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8646: } else {
1.1140 raeburn 8647: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8648: }
1.1140 raeburn 8649: }
8650: my $nicescroll_js = '
1.1137 raeburn 8651: $(document).ready(
1.1140 raeburn 8652: function() {
8653: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8654: }
1.1137 raeburn 8655: );
8656: ';
1.1140 raeburn 8657: if ($framecheck) {
8658: $nicescroll_js .= '
8659: function expand_div(caller) {
8660: if (top === self) {
8661: document.getElementById("'.$id.'").style.width = "auto";
8662: document.getElementById("'.$id.'").style.height = "auto";
8663: } else {
8664: try {
8665: if (parent.frames) {
8666: if (parent.frames.length > 1) {
8667: var framesrc = parent.frames[1].location.href;
8668: var currsrc = framesrc.replace(/\#.*$/,"");
8669: if ((caller == "search") || (currsrc == "'.$location.'")) {
8670: document.getElementById("'.$id.'").style.width = "auto";
8671: document.getElementById("'.$id.'").style.height = "auto";
8672: }
8673: }
8674: }
8675: } catch (e) {
8676: return;
8677: }
1.1137 raeburn 8678: }
1.1140 raeburn 8679: return;
1.996 www 8680: }
1.1140 raeburn 8681: ';
8682: }
8683: if ($needjsready) {
8684: $nicescroll_js = '
8685: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8686: } else {
8687: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8688: }
8689: return $nicescroll_js;
1.996 www 8690: }
8691:
1.318 albertel 8692: sub simple_error_page {
1.1150 bisitz 8693: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8694: if (ref($args) eq 'HASH') {
8695: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8696: } else {
8697: $msg = &mt($msg);
8698: }
1.1150 bisitz 8699:
1.318 albertel 8700: my $page =
8701: &Apache::loncommon::start_page($title).
1.1150 bisitz 8702: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8703: &Apache::loncommon::end_page();
8704: if (ref($r)) {
8705: $r->print($page);
1.327 albertel 8706: return;
1.318 albertel 8707: }
8708: return $page;
8709: }
1.347 albertel 8710:
8711: {
1.610 albertel 8712: my @row_count;
1.961 onken 8713:
8714: sub start_data_table_count {
8715: unshift(@row_count, 0);
8716: return;
8717: }
8718:
8719: sub end_data_table_count {
8720: shift(@row_count);
8721: return;
8722: }
8723:
1.347 albertel 8724: sub start_data_table {
1.1018 raeburn 8725: my ($add_class,$id) = @_;
1.422 albertel 8726: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8727: my $table_id;
8728: if (defined($id)) {
8729: $table_id = ' id="'.$id.'"';
8730: }
1.961 onken 8731: &start_data_table_count();
1.1018 raeburn 8732: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8733: }
8734:
8735: sub end_data_table {
1.961 onken 8736: &end_data_table_count();
1.389 albertel 8737: return '</table>'."\n";;
1.347 albertel 8738: }
8739:
8740: sub start_data_table_row {
1.974 wenzelju 8741: my ($add_class, $id) = @_;
1.610 albertel 8742: $row_count[0]++;
8743: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8744: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8745: $id = (' id="'.$id.'"') unless ($id eq '');
8746: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8747: }
1.471 banghart 8748:
8749: sub continue_data_table_row {
1.974 wenzelju 8750: my ($add_class, $id) = @_;
1.610 albertel 8751: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8752: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8753: $id = (' id="'.$id.'"') unless ($id eq '');
8754: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8755: }
1.347 albertel 8756:
8757: sub end_data_table_row {
1.389 albertel 8758: return '</tr>'."\n";;
1.347 albertel 8759: }
1.367 www 8760:
1.421 albertel 8761: sub start_data_table_empty_row {
1.707 bisitz 8762: # $row_count[0]++;
1.421 albertel 8763: return '<tr class="LC_empty_row" >'."\n";;
8764: }
8765:
8766: sub end_data_table_empty_row {
8767: return '</tr>'."\n";;
8768: }
8769:
1.367 www 8770: sub start_data_table_header_row {
1.389 albertel 8771: return '<tr class="LC_header_row">'."\n";;
1.367 www 8772: }
8773:
8774: sub end_data_table_header_row {
1.389 albertel 8775: return '</tr>'."\n";;
1.367 www 8776: }
1.890 droeschl 8777:
8778: sub data_table_caption {
8779: my $caption = shift;
8780: return "<caption class=\"LC_caption\">$caption</caption>";
8781: }
1.347 albertel 8782: }
8783:
1.548 albertel 8784: =pod
8785:
8786: =item * &inhibit_menu_check($arg)
8787:
8788: Checks for a inhibitmenu state and generates output to preserve it
8789:
8790: Inputs: $arg - can be any of
8791: - undef - in which case the return value is a string
8792: to add into arguments list of a uri
8793: - 'input' - in which case the return value is a HTML
8794: <form> <input> field of type hidden to
8795: preserve the value
8796: - a url - in which case the return value is the url with
8797: the neccesary cgi args added to preserve the
8798: inhibitmenu state
8799: - a ref to a url - no return value, but the string is
8800: updated to include the neccessary cgi
8801: args to preserve the inhibitmenu state
8802:
8803: =cut
8804:
8805: sub inhibit_menu_check {
8806: my ($arg) = @_;
8807: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8808: if ($arg eq 'input') {
8809: if ($env{'form.inhibitmenu'}) {
8810: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8811: } else {
8812: return
8813: }
8814: }
8815: if ($env{'form.inhibitmenu'}) {
8816: if (ref($arg)) {
8817: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8818: } elsif ($arg eq '') {
8819: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8820: } else {
8821: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8822: }
8823: }
8824: if (!ref($arg)) {
8825: return $arg;
8826: }
8827: }
8828:
1.251 albertel 8829: ###############################################
1.182 matthew 8830:
8831: =pod
8832:
1.549 albertel 8833: =back
8834:
8835: =head1 User Information Routines
8836:
8837: =over 4
8838:
1.405 albertel 8839: =item * &get_users_function()
1.182 matthew 8840:
8841: Used by &bodytag to determine the current users primary role.
8842: Returns either 'student','coordinator','admin', or 'author'.
8843:
8844: =cut
8845:
8846: ###############################################
8847: sub get_users_function {
1.815 tempelho 8848: my $function = 'norole';
1.818 tempelho 8849: if ($env{'request.role'}=~/^(st)/) {
8850: $function='student';
8851: }
1.907 raeburn 8852: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8853: $function='coordinator';
8854: }
1.258 albertel 8855: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8856: $function='admin';
8857: }
1.826 bisitz 8858: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8859: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8860: $function='author';
8861: }
8862: return $function;
1.54 www 8863: }
1.99 www 8864:
8865: ###############################################
8866:
1.233 raeburn 8867: =pod
8868:
1.821 raeburn 8869: =item * &show_course()
8870:
8871: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8872: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8873:
8874: Inputs:
8875: None
8876:
8877: Outputs:
8878: Scalar: 1 if 'Course' to be used, 0 otherwise.
8879:
8880: =cut
8881:
8882: ###############################################
8883: sub show_course {
8884: my $course = !$env{'user.adv'};
8885: if (!$env{'user.adv'}) {
8886: foreach my $env (keys(%env)) {
8887: next if ($env !~ m/^user\.priv\./);
8888: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8889: $course = 0;
8890: last;
8891: }
8892: }
8893: }
8894: return $course;
8895: }
8896:
8897: ###############################################
8898:
8899: =pod
8900:
1.542 raeburn 8901: =item * &check_user_status()
1.274 raeburn 8902:
8903: Determines current status of supplied role for a
8904: specific user. Roles can be active, previous or future.
8905:
8906: Inputs:
8907: user's domain, user's username, course's domain,
1.375 raeburn 8908: course's number, optional section ID.
1.274 raeburn 8909:
8910: Outputs:
8911: role status: active, previous or future.
8912:
8913: =cut
8914:
8915: sub check_user_status {
1.412 raeburn 8916: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8917: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 8918: my @uroles = keys(%userinfo);
1.274 raeburn 8919: my $srchstr;
8920: my $active_chk = 'none';
1.412 raeburn 8921: my $now = time;
1.274 raeburn 8922: if (@uroles > 0) {
1.908 raeburn 8923: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8924: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8925: } else {
1.412 raeburn 8926: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8927: }
8928: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8929: my $role_end = 0;
8930: my $role_start = 0;
8931: $active_chk = 'active';
1.412 raeburn 8932: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8933: $role_end = $1;
8934: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8935: $role_start = $1;
1.274 raeburn 8936: }
8937: }
8938: if ($role_start > 0) {
1.412 raeburn 8939: if ($now < $role_start) {
1.274 raeburn 8940: $active_chk = 'future';
8941: }
8942: }
8943: if ($role_end > 0) {
1.412 raeburn 8944: if ($now > $role_end) {
1.274 raeburn 8945: $active_chk = 'previous';
8946: }
8947: }
8948: }
8949: }
8950: return $active_chk;
8951: }
8952:
8953: ###############################################
8954:
8955: =pod
8956:
1.405 albertel 8957: =item * &get_sections()
1.233 raeburn 8958:
8959: Determines all the sections for a course including
8960: sections with students and sections containing other roles.
1.419 raeburn 8961: Incoming parameters:
8962:
8963: 1. domain
8964: 2. course number
8965: 3. reference to array containing roles for which sections should
8966: be gathered (optional).
8967: 4. reference to array containing status types for which sections
8968: should be gathered (optional).
8969:
8970: If the third argument is undefined, sections are gathered for any role.
8971: If the fourth argument is undefined, sections are gathered for any status.
8972: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8973:
1.374 raeburn 8974: Returns section hash (keys are section IDs, values are
8975: number of users in each section), subject to the
1.419 raeburn 8976: optional roles filter, optional status filter
1.233 raeburn 8977:
8978: =cut
8979:
8980: ###############################################
8981: sub get_sections {
1.419 raeburn 8982: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8983: if (!defined($cdom) || !defined($cnum)) {
8984: my $cid = $env{'request.course.id'};
8985:
8986: return if (!defined($cid));
8987:
8988: $cdom = $env{'course.'.$cid.'.domain'};
8989: $cnum = $env{'course.'.$cid.'.num'};
8990: }
8991:
8992: my %sectioncount;
1.419 raeburn 8993: my $now = time;
1.240 albertel 8994:
1.1118 raeburn 8995: my $check_students = 1;
8996: my $only_students = 0;
8997: if (ref($possible_roles) eq 'ARRAY') {
8998: if (grep(/^st$/,@{$possible_roles})) {
8999: if (@{$possible_roles} == 1) {
9000: $only_students = 1;
9001: }
9002: } else {
9003: $check_students = 0;
9004: }
9005: }
9006:
9007: if ($check_students) {
1.276 albertel 9008: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9009: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9010: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9011: my $start_index = &Apache::loncoursedata::CL_START();
9012: my $end_index = &Apache::loncoursedata::CL_END();
9013: my $status;
1.366 albertel 9014: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9015: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9016: $data->[$status_index],
9017: $data->[$start_index],
9018: $data->[$end_index]);
9019: if ($stu_status eq 'Active') {
9020: $status = 'active';
9021: } elsif ($end < $now) {
9022: $status = 'previous';
9023: } elsif ($start > $now) {
9024: $status = 'future';
9025: }
9026: if ($section ne '-1' && $section !~ /^\s*$/) {
9027: if ((!defined($possible_status)) || (($status ne '') &&
9028: (grep/^\Q$status\E$/,@{$possible_status}))) {
9029: $sectioncount{$section}++;
9030: }
1.240 albertel 9031: }
9032: }
9033: }
1.1118 raeburn 9034: if ($only_students) {
9035: return %sectioncount;
9036: }
1.240 albertel 9037: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9038: foreach my $user (sort(keys(%courseroles))) {
9039: if ($user !~ /^(\w{2})/) { next; }
9040: my ($role) = ($user =~ /^(\w{2})/);
9041: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9042: my ($section,$status);
1.240 albertel 9043: if ($role eq 'cr' &&
9044: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9045: $section=$1;
9046: }
9047: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9048: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9049: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9050: if ($end == -1 && $start == -1) {
9051: next; #deleted role
9052: }
9053: if (!defined($possible_status)) {
9054: $sectioncount{$section}++;
9055: } else {
9056: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9057: $status = 'active';
9058: } elsif ($end < $now) {
9059: $status = 'future';
9060: } elsif ($start > $now) {
9061: $status = 'previous';
9062: }
9063: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9064: $sectioncount{$section}++;
9065: }
9066: }
1.233 raeburn 9067: }
1.366 albertel 9068: return %sectioncount;
1.233 raeburn 9069: }
9070:
1.274 raeburn 9071: ###############################################
1.294 raeburn 9072:
9073: =pod
1.405 albertel 9074:
9075: =item * &get_course_users()
9076:
1.275 raeburn 9077: Retrieves usernames:domains for users in the specified course
9078: with specific role(s), and access status.
9079:
9080: Incoming parameters:
1.277 albertel 9081: 1. course domain
9082: 2. course number
9083: 3. access status: users must have - either active,
1.275 raeburn 9084: previous, future, or all.
1.277 albertel 9085: 4. reference to array of permissible roles
1.288 raeburn 9086: 5. reference to array of section restrictions (optional)
9087: 6. reference to results object (hash of hashes).
9088: 7. reference to optional userdata hash
1.609 raeburn 9089: 8. reference to optional statushash
1.630 raeburn 9090: 9. flag if privileged users (except those set to unhide in
9091: course settings) should be excluded
1.609 raeburn 9092: Keys of top level results hash are roles.
1.275 raeburn 9093: Keys of inner hashes are username:domain, with
9094: values set to access type.
1.288 raeburn 9095: Optional userdata hash returns an array with arguments in the
9096: same order as loncoursedata::get_classlist() for student data.
9097:
1.609 raeburn 9098: Optional statushash returns
9099:
1.288 raeburn 9100: Entries for end, start, section and status are blank because
9101: of the possibility of multiple values for non-student roles.
9102:
1.275 raeburn 9103: =cut
1.405 albertel 9104:
1.275 raeburn 9105: ###############################################
1.405 albertel 9106:
1.275 raeburn 9107: sub get_course_users {
1.630 raeburn 9108: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9109: my %idx = ();
1.419 raeburn 9110: my %seclists;
1.288 raeburn 9111:
9112: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9113: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9114: $idx{end} = &Apache::loncoursedata::CL_END();
9115: $idx{start} = &Apache::loncoursedata::CL_START();
9116: $idx{id} = &Apache::loncoursedata::CL_ID();
9117: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9118: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9119: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9120:
1.290 albertel 9121: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9122: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9123: my $now = time;
1.277 albertel 9124: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9125: my $match = 0;
1.412 raeburn 9126: my $secmatch = 0;
1.419 raeburn 9127: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9128: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9129: if ($section eq '') {
9130: $section = 'none';
9131: }
1.291 albertel 9132: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9133: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9134: $secmatch = 1;
9135: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9136: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9137: $secmatch = 1;
9138: }
9139: } else {
1.419 raeburn 9140: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9141: $secmatch = 1;
9142: }
1.290 albertel 9143: }
1.412 raeburn 9144: if (!$secmatch) {
9145: next;
9146: }
1.419 raeburn 9147: }
1.275 raeburn 9148: if (defined($$types{'active'})) {
1.288 raeburn 9149: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9150: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9151: $match = 1;
1.275 raeburn 9152: }
9153: }
9154: if (defined($$types{'previous'})) {
1.609 raeburn 9155: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9156: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9157: $match = 1;
1.275 raeburn 9158: }
9159: }
9160: if (defined($$types{'future'})) {
1.609 raeburn 9161: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9162: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9163: $match = 1;
1.275 raeburn 9164: }
9165: }
1.609 raeburn 9166: if ($match) {
9167: push(@{$seclists{$student}},$section);
9168: if (ref($userdata) eq 'HASH') {
9169: $$userdata{$student} = $$classlist{$student};
9170: }
9171: if (ref($statushash) eq 'HASH') {
9172: $statushash->{$student}{'st'}{$section} = $status;
9173: }
1.288 raeburn 9174: }
1.275 raeburn 9175: }
9176: }
1.412 raeburn 9177: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9178: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9179: my $now = time;
1.609 raeburn 9180: my %displaystatus = ( previous => 'Expired',
9181: active => 'Active',
9182: future => 'Future',
9183: );
1.1121 raeburn 9184: my (%nothide,@possdoms);
1.630 raeburn 9185: if ($hidepriv) {
9186: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9187: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9188: if ($user !~ /:/) {
9189: $nothide{join(':',split(/[\@]/,$user))}=1;
9190: } else {
9191: $nothide{$user} = 1;
9192: }
9193: }
1.1121 raeburn 9194: my @possdoms = ($cdom);
9195: if ($coursehash{'checkforpriv'}) {
9196: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9197: }
1.630 raeburn 9198: }
1.439 raeburn 9199: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9200: my $match = 0;
1.412 raeburn 9201: my $secmatch = 0;
1.439 raeburn 9202: my $status;
1.412 raeburn 9203: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9204: $user =~ s/:$//;
1.439 raeburn 9205: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9206: if ($end == -1 || $start == -1) {
9207: next;
9208: }
9209: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9210: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9211: my ($uname,$udom) = split(/:/,$user);
9212: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9213: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9214: $secmatch = 1;
9215: } elsif ($usec eq '') {
1.420 albertel 9216: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9217: $secmatch = 1;
9218: }
9219: } else {
9220: if (grep(/^\Q$usec\E$/,@{$sections})) {
9221: $secmatch = 1;
9222: }
9223: }
9224: if (!$secmatch) {
9225: next;
9226: }
1.288 raeburn 9227: }
1.419 raeburn 9228: if ($usec eq '') {
9229: $usec = 'none';
9230: }
1.275 raeburn 9231: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9232: if ($hidepriv) {
1.1121 raeburn 9233: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9234: (!$nothide{$uname.':'.$udom})) {
9235: next;
9236: }
9237: }
1.503 raeburn 9238: if ($end > 0 && $end < $now) {
1.439 raeburn 9239: $status = 'previous';
9240: } elsif ($start > $now) {
9241: $status = 'future';
9242: } else {
9243: $status = 'active';
9244: }
1.277 albertel 9245: foreach my $type (keys(%{$types})) {
1.275 raeburn 9246: if ($status eq $type) {
1.420 albertel 9247: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9248: push(@{$$users{$role}{$user}},$type);
9249: }
1.288 raeburn 9250: $match = 1;
9251: }
9252: }
1.419 raeburn 9253: if (($match) && (ref($userdata) eq 'HASH')) {
9254: if (!exists($$userdata{$uname.':'.$udom})) {
9255: &get_user_info($udom,$uname,\%idx,$userdata);
9256: }
1.420 albertel 9257: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9258: push(@{$seclists{$uname.':'.$udom}},$usec);
9259: }
1.609 raeburn 9260: if (ref($statushash) eq 'HASH') {
9261: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9262: }
1.275 raeburn 9263: }
9264: }
9265: }
9266: }
1.290 albertel 9267: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9268: if ((defined($cdom)) && (defined($cnum))) {
9269: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9270: if ( defined($csettings{'internal.courseowner'}) ) {
9271: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9272: next if ($owner eq '');
9273: my ($ownername,$ownerdom);
9274: if ($owner =~ /^([^:]+):([^:]+)$/) {
9275: $ownername = $1;
9276: $ownerdom = $2;
9277: } else {
9278: $ownername = $owner;
9279: $ownerdom = $cdom;
9280: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9281: }
9282: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9283: if (defined($userdata) &&
1.609 raeburn 9284: !exists($$userdata{$owner})) {
9285: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9286: if (!grep(/^none$/,@{$seclists{$owner}})) {
9287: push(@{$seclists{$owner}},'none');
9288: }
9289: if (ref($statushash) eq 'HASH') {
9290: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9291: }
1.290 albertel 9292: }
1.279 raeburn 9293: }
9294: }
9295: }
1.419 raeburn 9296: foreach my $user (keys(%seclists)) {
9297: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9298: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9299: }
1.275 raeburn 9300: }
9301: return;
9302: }
9303:
1.288 raeburn 9304: sub get_user_info {
9305: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9306: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9307: &plainname($uname,$udom,'lastname');
1.291 albertel 9308: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9309: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9310: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9311: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9312: return;
9313: }
1.275 raeburn 9314:
1.472 raeburn 9315: ###############################################
9316:
9317: =pod
9318:
9319: =item * &get_user_quota()
9320:
1.1134 raeburn 9321: Retrieves quota assigned for storage of user files.
9322: Default is to report quota for portfolio files.
1.472 raeburn 9323:
9324: Incoming parameters:
9325: 1. user's username
9326: 2. user's domain
1.1134 raeburn 9327: 3. quota name - portfolio, author, or course
1.1136 raeburn 9328: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9329: 4. crstype - official, unofficial, textbook, placement or community,
9330: if quota name is course
1.472 raeburn 9331:
9332: Returns:
1.1163 raeburn 9333: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9334: 2. (Optional) Type of setting: custom or default
9335: (individually assigned or default for user's
9336: institutional status).
9337: 3. (Optional) - User's institutional status (e.g., faculty, staff
9338: or student - types as defined in localenroll::inst_usertypes
9339: for user's domain, which determines default quota for user.
9340: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9341:
9342: If a value has been stored in the user's environment,
1.536 raeburn 9343: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9344: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9345:
9346: =cut
9347:
9348: ###############################################
9349:
9350:
9351: sub get_user_quota {
1.1136 raeburn 9352: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9353: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9354: if (!defined($udom)) {
9355: $udom = $env{'user.domain'};
9356: }
9357: if (!defined($uname)) {
9358: $uname = $env{'user.name'};
9359: }
9360: if (($udom eq '' || $uname eq '') ||
9361: ($udom eq 'public') && ($uname eq 'public')) {
9362: $quota = 0;
1.536 raeburn 9363: $quotatype = 'default';
9364: $defquota = 0;
1.472 raeburn 9365: } else {
1.536 raeburn 9366: my $inststatus;
1.1134 raeburn 9367: if ($quotaname eq 'course') {
9368: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9369: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9370: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9371: } else {
9372: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9373: $quota = $cenv{'internal.uploadquota'};
9374: }
1.536 raeburn 9375: } else {
1.1134 raeburn 9376: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9377: if ($quotaname eq 'author') {
9378: $quota = $env{'environment.authorquota'};
9379: } else {
9380: $quota = $env{'environment.portfolioquota'};
9381: }
9382: $inststatus = $env{'environment.inststatus'};
9383: } else {
9384: my %userenv =
9385: &Apache::lonnet::get('environment',['portfolioquota',
9386: 'authorquota','inststatus'],$udom,$uname);
9387: my ($tmp) = keys(%userenv);
9388: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9389: if ($quotaname eq 'author') {
9390: $quota = $userenv{'authorquota'};
9391: } else {
9392: $quota = $userenv{'portfolioquota'};
9393: }
9394: $inststatus = $userenv{'inststatus'};
9395: } else {
9396: undef(%userenv);
9397: }
9398: }
9399: }
9400: if ($quota eq '' || wantarray) {
9401: if ($quotaname eq 'course') {
9402: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9403: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9404: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9405: ($crstype eq 'placement')) {
1.1136 raeburn 9406: $defquota = $domdefs{$crstype.'quota'};
9407: }
9408: if ($defquota eq '') {
9409: $defquota = 500;
9410: }
1.1134 raeburn 9411: } else {
9412: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9413: }
9414: if ($quota eq '') {
9415: $quota = $defquota;
9416: $quotatype = 'default';
9417: } else {
9418: $quotatype = 'custom';
9419: }
1.472 raeburn 9420: }
9421: }
1.536 raeburn 9422: if (wantarray) {
9423: return ($quota,$quotatype,$settingstatus,$defquota);
9424: } else {
9425: return $quota;
9426: }
1.472 raeburn 9427: }
9428:
9429: ###############################################
9430:
9431: =pod
9432:
9433: =item * &default_quota()
9434:
1.536 raeburn 9435: Retrieves default quota assigned for storage of user portfolio files,
9436: given an (optional) user's institutional status.
1.472 raeburn 9437:
9438: Incoming parameters:
1.1142 raeburn 9439:
1.472 raeburn 9440: 1. domain
1.536 raeburn 9441: 2. (Optional) institutional status(es). This is a : separated list of
9442: status types (e.g., faculty, staff, student etc.)
9443: which apply to the user for whom the default is being retrieved.
9444: If the institutional status string in undefined, the domain
1.1134 raeburn 9445: default quota will be returned.
9446: 3. quota name - portfolio, author, or course
9447: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9448:
9449: Returns:
1.1142 raeburn 9450:
1.1163 raeburn 9451: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9452: 2. (Optional) institutional type which determined the value of the
9453: default quota.
1.472 raeburn 9454:
9455: If a value has been stored in the domain's configuration db,
9456: it will return that, otherwise it returns 20 (for backwards
9457: compatibility with domains which have not set up a configuration
1.1163 raeburn 9458: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9459:
1.536 raeburn 9460: If the user's status includes multiple types (e.g., staff and student),
9461: the largest default quota which applies to the user determines the
9462: default quota returned.
9463:
1.472 raeburn 9464: =cut
9465:
9466: ###############################################
9467:
9468:
9469: sub default_quota {
1.1134 raeburn 9470: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9471: my ($defquota,$settingstatus);
9472: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9473: ['quotas'],$udom);
1.1134 raeburn 9474: my $key = 'defaultquota';
9475: if ($quotaname eq 'author') {
9476: $key = 'authorquota';
9477: }
1.622 raeburn 9478: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9479: if ($inststatus ne '') {
1.765 raeburn 9480: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9481: foreach my $item (@statuses) {
1.1134 raeburn 9482: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9483: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9484: if ($defquota eq '') {
1.1134 raeburn 9485: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9486: $settingstatus = $item;
1.1134 raeburn 9487: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9488: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9489: $settingstatus = $item;
9490: }
9491: }
1.1134 raeburn 9492: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9493: if ($quotahash{'quotas'}{$item} ne '') {
9494: if ($defquota eq '') {
9495: $defquota = $quotahash{'quotas'}{$item};
9496: $settingstatus = $item;
9497: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9498: $defquota = $quotahash{'quotas'}{$item};
9499: $settingstatus = $item;
9500: }
1.536 raeburn 9501: }
9502: }
9503: }
9504: }
9505: if ($defquota eq '') {
1.1134 raeburn 9506: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9507: $defquota = $quotahash{'quotas'}{$key}{'default'};
9508: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9509: $defquota = $quotahash{'quotas'}{'default'};
9510: }
1.536 raeburn 9511: $settingstatus = 'default';
1.1139 raeburn 9512: if ($defquota eq '') {
9513: if ($quotaname eq 'author') {
9514: $defquota = 500;
9515: }
9516: }
1.536 raeburn 9517: }
9518: } else {
9519: $settingstatus = 'default';
1.1134 raeburn 9520: if ($quotaname eq 'author') {
9521: $defquota = 500;
9522: } else {
9523: $defquota = 20;
9524: }
1.536 raeburn 9525: }
9526: if (wantarray) {
9527: return ($defquota,$settingstatus);
1.472 raeburn 9528: } else {
1.536 raeburn 9529: return $defquota;
1.472 raeburn 9530: }
9531: }
9532:
1.1135 raeburn 9533: ###############################################
9534:
9535: =pod
9536:
1.1136 raeburn 9537: =item * &excess_filesize_warning()
1.1135 raeburn 9538:
9539: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9540: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9541: space to be exceeded.
1.1136 raeburn 9542:
9543: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9544: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9545:
1.1165 raeburn 9546: Inputs: 7
1.1136 raeburn 9547: 1. username or coursenum
1.1135 raeburn 9548: 2. domain
1.1136 raeburn 9549: 3. context ('author' or 'course')
1.1135 raeburn 9550: 4. filename of file for which action is being requested
9551: 5. filesize (kB) of file
9552: 6. action being taken: copy or upload.
1.1237 raeburn 9553: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 9554:
9555: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9556: otherwise return null.
9557:
9558: =back
1.1135 raeburn 9559:
9560: =cut
9561:
1.1136 raeburn 9562: sub excess_filesize_warning {
1.1165 raeburn 9563: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9564: my $current_disk_usage = 0;
1.1165 raeburn 9565: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9566: if ($context eq 'author') {
9567: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9568: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9569: } else {
9570: foreach my $subdir ('docs','supplemental') {
9571: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9572: }
9573: }
1.1135 raeburn 9574: $disk_quota = int($disk_quota * 1000);
9575: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9576: return '<p class="LC_warning">'.
1.1135 raeburn 9577: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9578: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9579: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9580: $disk_quota,$current_disk_usage).
9581: '</p>';
9582: }
9583: return;
9584: }
9585:
9586: ###############################################
9587:
9588:
1.1136 raeburn 9589:
9590:
1.384 raeburn 9591: sub get_secgrprole_info {
9592: my ($cdom,$cnum,$needroles,$type) = @_;
9593: my %sections_count = &get_sections($cdom,$cnum);
9594: my @sections = (sort {$a <=> $b} keys(%sections_count));
9595: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9596: my @groups = sort(keys(%curr_groups));
9597: my $allroles = [];
9598: my $rolehash;
9599: my $accesshash = {
9600: active => 'Currently has access',
9601: future => 'Will have future access',
9602: previous => 'Previously had access',
9603: };
9604: if ($needroles) {
9605: $rolehash = {'all' => 'all'};
1.385 albertel 9606: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9607: if (&Apache::lonnet::error(%user_roles)) {
9608: undef(%user_roles);
9609: }
9610: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9611: my ($role)=split(/\:/,$item,2);
9612: if ($role eq 'cr') { next; }
9613: if ($role =~ /^cr/) {
9614: $$rolehash{$role} = (split('/',$role))[3];
9615: } else {
9616: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9617: }
9618: }
9619: foreach my $key (sort(keys(%{$rolehash}))) {
9620: push(@{$allroles},$key);
9621: }
9622: push (@{$allroles},'st');
9623: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9624: }
9625: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9626: }
9627:
1.555 raeburn 9628: sub user_picker {
1.994 raeburn 9629: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9630: my $currdom = $dom;
9631: my %curr_selected = (
9632: srchin => 'dom',
1.580 raeburn 9633: srchby => 'lastname',
1.555 raeburn 9634: );
9635: my $srchterm;
1.625 raeburn 9636: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9637: if ($srch->{'srchby'} ne '') {
9638: $curr_selected{'srchby'} = $srch->{'srchby'};
9639: }
9640: if ($srch->{'srchin'} ne '') {
9641: $curr_selected{'srchin'} = $srch->{'srchin'};
9642: }
9643: if ($srch->{'srchtype'} ne '') {
9644: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9645: }
9646: if ($srch->{'srchdomain'} ne '') {
9647: $currdom = $srch->{'srchdomain'};
9648: }
9649: $srchterm = $srch->{'srchterm'};
9650: }
1.1222 damieng 9651: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 9652: 'usr' => 'Search criteria',
1.563 raeburn 9653: 'doma' => 'Domain/institution to search',
1.558 albertel 9654: 'uname' => 'username',
9655: 'lastname' => 'last name',
1.555 raeburn 9656: 'lastfirst' => 'last name, first name',
1.558 albertel 9657: 'crs' => 'in this course',
1.576 raeburn 9658: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9659: 'alc' => 'all LON-CAPA',
1.573 raeburn 9660: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9661: 'exact' => 'is',
9662: 'contains' => 'contains',
1.569 raeburn 9663: 'begins' => 'begins with',
1.1222 damieng 9664: );
9665: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 9666: 'youm' => "You must include some text to search for.",
9667: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9668: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9669: 'yomc' => "You must choose a domain when using an institutional directory search.",
9670: 'ymcd' => "You must choose a domain when using a domain search.",
9671: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9672: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9673: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9674: );
1.1222 damieng 9675: &html_escape(\%html_lt);
9676: &js_escape(\%js_lt);
1.563 raeburn 9677: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9678: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9679:
9680: my @srchins = ('crs','dom','alc','instd');
9681:
9682: foreach my $option (@srchins) {
9683: # FIXME 'alc' option unavailable until
9684: # loncreateuser::print_user_query_page()
9685: # has been completed.
9686: next if ($option eq 'alc');
1.880 raeburn 9687: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9688: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9689: if ($curr_selected{'srchin'} eq $option) {
9690: $srchinsel .= '
1.1222 damieng 9691: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 9692: } else {
9693: $srchinsel .= '
1.1222 damieng 9694: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 9695: }
1.555 raeburn 9696: }
1.563 raeburn 9697: $srchinsel .= "\n </select>\n";
1.555 raeburn 9698:
9699: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9700: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9701: if ($curr_selected{'srchby'} eq $option) {
9702: $srchbysel .= '
1.1222 damieng 9703: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9704: } else {
9705: $srchbysel .= '
1.1222 damieng 9706: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9707: }
9708: }
9709: $srchbysel .= "\n </select>\n";
9710:
9711: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9712: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9713: if ($curr_selected{'srchtype'} eq $option) {
9714: $srchtypesel .= '
1.1222 damieng 9715: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9716: } else {
9717: $srchtypesel .= '
1.1222 damieng 9718: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9719: }
9720: }
9721: $srchtypesel .= "\n </select>\n";
9722:
1.558 albertel 9723: my ($newuserscript,$new_user_create);
1.994 raeburn 9724: my $context_dom = $env{'request.role.domain'};
9725: if ($context eq 'requestcrs') {
9726: if ($env{'form.coursedom'} ne '') {
9727: $context_dom = $env{'form.coursedom'};
9728: }
9729: }
1.556 raeburn 9730: if ($forcenewuser) {
1.576 raeburn 9731: if (ref($srch) eq 'HASH') {
1.994 raeburn 9732: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9733: if ($cancreate) {
9734: $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>';
9735: } else {
1.799 bisitz 9736: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9737: my %usertypetext = (
9738: official => 'institutional',
9739: unofficial => 'non-institutional',
9740: );
1.799 bisitz 9741: $new_user_create = '<p class="LC_warning">'
9742: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9743: .' '
9744: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9745: ,'<a href="'.$helplink.'">','</a>')
9746: .'</p><br />';
1.627 raeburn 9747: }
1.576 raeburn 9748: }
9749: }
9750:
1.556 raeburn 9751: $newuserscript = <<"ENDSCRIPT";
9752:
1.570 raeburn 9753: function setSearch(createnew,callingForm) {
1.556 raeburn 9754: if (createnew == 1) {
1.570 raeburn 9755: for (var i=0; i<callingForm.srchby.length; i++) {
9756: if (callingForm.srchby.options[i].value == 'uname') {
9757: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9758: }
9759: }
1.570 raeburn 9760: for (var i=0; i<callingForm.srchin.length; i++) {
9761: if ( callingForm.srchin.options[i].value == 'dom') {
9762: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9763: }
9764: }
1.570 raeburn 9765: for (var i=0; i<callingForm.srchtype.length; i++) {
9766: if (callingForm.srchtype.options[i].value == 'exact') {
9767: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9768: }
9769: }
1.570 raeburn 9770: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9771: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9772: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9773: }
9774: }
9775: }
9776: }
9777: ENDSCRIPT
1.558 albertel 9778:
1.556 raeburn 9779: }
9780:
1.555 raeburn 9781: my $output = <<"END_BLOCK";
1.556 raeburn 9782: <script type="text/javascript">
1.824 bisitz 9783: // <![CDATA[
1.570 raeburn 9784: function validateEntry(callingForm) {
1.558 albertel 9785:
1.556 raeburn 9786: var checkok = 1;
1.558 albertel 9787: var srchin;
1.570 raeburn 9788: for (var i=0; i<callingForm.srchin.length; i++) {
9789: if ( callingForm.srchin[i].checked ) {
9790: srchin = callingForm.srchin[i].value;
1.558 albertel 9791: }
9792: }
9793:
1.570 raeburn 9794: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9795: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9796: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9797: var srchterm = callingForm.srchterm.value;
9798: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9799: var msg = "";
9800:
9801: if (srchterm == "") {
9802: checkok = 0;
1.1222 damieng 9803: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 9804: }
9805:
1.569 raeburn 9806: if (srchtype== 'begins') {
9807: if (srchterm.length < 2) {
9808: checkok = 0;
1.1222 damieng 9809: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 9810: }
9811: }
9812:
1.556 raeburn 9813: if (srchtype== 'contains') {
9814: if (srchterm.length < 3) {
9815: checkok = 0;
1.1222 damieng 9816: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 9817: }
9818: }
9819: if (srchin == 'instd') {
9820: if (srchdomain == '') {
9821: checkok = 0;
1.1222 damieng 9822: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 9823: }
9824: }
9825: if (srchin == 'dom') {
9826: if (srchdomain == '') {
9827: checkok = 0;
1.1222 damieng 9828: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 9829: }
9830: }
9831: if (srchby == 'lastfirst') {
9832: if (srchterm.indexOf(",") == -1) {
9833: checkok = 0;
1.1222 damieng 9834: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 9835: }
9836: if (srchterm.indexOf(",") == srchterm.length -1) {
9837: checkok = 0;
1.1222 damieng 9838: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 9839: }
9840: }
9841: if (checkok == 0) {
1.1222 damieng 9842: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 9843: return;
9844: }
9845: if (checkok == 1) {
1.570 raeburn 9846: callingForm.submit();
1.556 raeburn 9847: }
9848: }
9849:
9850: $newuserscript
9851:
1.824 bisitz 9852: // ]]>
1.556 raeburn 9853: </script>
1.558 albertel 9854:
9855: $new_user_create
9856:
1.555 raeburn 9857: END_BLOCK
1.558 albertel 9858:
1.876 raeburn 9859: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 9860: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 9861: $domform.
9862: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 9863: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 9864: $srchbysel.
9865: $srchtypesel.
9866: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9867: $srchinsel.
9868: &Apache::lonhtmlcommon::row_closure(1).
9869: &Apache::lonhtmlcommon::end_pick_box().
9870: '<br />';
1.555 raeburn 9871: return $output;
9872: }
9873:
1.612 raeburn 9874: sub user_rule_check {
1.615 raeburn 9875: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 9876: my ($response,%inst_response);
1.612 raeburn 9877: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 9878: if (keys(%{$usershash}) > 1) {
9879: my (%by_username,%by_id,%userdoms);
9880: my $checkid;
9881: if (ref($checks) eq 'HASH') {
9882: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
9883: $checkid = 1;
9884: }
9885: }
9886: foreach my $user (keys(%{$usershash})) {
9887: my ($uname,$udom) = split(/:/,$user);
9888: if ($checkid) {
9889: if (ref($usershash->{$user}) eq 'HASH') {
9890: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 9891: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 9892: $userdoms{$udom} = 1;
1.1227 raeburn 9893: if (ref($inst_results) eq 'HASH') {
9894: $inst_results->{$uname.':'.$udom} = {};
9895: }
1.1226 raeburn 9896: }
9897: }
9898: } else {
9899: $by_username{$udom}{$uname} = 1;
9900: $userdoms{$udom} = 1;
1.1227 raeburn 9901: if (ref($inst_results) eq 'HASH') {
9902: $inst_results->{$uname.':'.$udom} = {};
9903: }
1.1226 raeburn 9904: }
9905: }
9906: foreach my $udom (keys(%userdoms)) {
9907: if (!$got_rules->{$udom}) {
9908: my %domconfig = &Apache::lonnet::get_dom('configuration',
9909: ['usercreation'],$udom);
9910: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9911: foreach my $item ('username','id') {
9912: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 9913: $$curr_rules{$udom}{$item} =
9914: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 9915: }
9916: }
9917: }
9918: $got_rules->{$udom} = 1;
9919: }
1.612 raeburn 9920: }
1.1226 raeburn 9921: if ($checkid) {
9922: foreach my $udom (keys(%by_id)) {
9923: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
9924: if ($outcome eq 'ok') {
1.1227 raeburn 9925: foreach my $id (keys(%{$by_id{$udom}})) {
9926: my $uname = $by_id{$udom}{$id};
9927: $inst_response{$uname.':'.$udom} = $outcome;
9928: }
1.1226 raeburn 9929: if (ref($results) eq 'HASH') {
9930: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 9931: if (exists($inst_response{$uname.':'.$udom})) {
9932: $inst_response{$uname.':'.$udom} = $outcome;
9933: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9934: }
1.1226 raeburn 9935: }
9936: }
9937: }
1.612 raeburn 9938: }
1.615 raeburn 9939: } else {
1.1226 raeburn 9940: foreach my $udom (keys(%by_username)) {
9941: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
9942: if ($outcome eq 'ok') {
1.1227 raeburn 9943: foreach my $uname (keys(%{$by_username{$udom}})) {
9944: $inst_response{$uname.':'.$udom} = $outcome;
9945: }
1.1226 raeburn 9946: if (ref($results) eq 'HASH') {
9947: foreach my $uname (keys(%{$results})) {
9948: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9949: }
9950: }
9951: }
9952: }
1.612 raeburn 9953: }
1.1226 raeburn 9954: } elsif (keys(%{$usershash}) == 1) {
9955: my $user = (keys(%{$usershash}))[0];
9956: my ($uname,$udom) = split(/:/,$user);
9957: if (($udom ne '') && ($uname ne '')) {
9958: if (ref($usershash->{$user}) eq 'HASH') {
9959: if (ref($checks) eq 'HASH') {
9960: if (defined($checks->{'username'})) {
9961: ($inst_response{$user},%{$inst_results->{$user}}) =
9962: &Apache::lonnet::get_instuser($udom,$uname);
9963: } elsif (defined($checks->{'id'})) {
9964: if ($usershash->{$user}->{'id'} ne '') {
9965: ($inst_response{$user},%{$inst_results->{$user}}) =
9966: &Apache::lonnet::get_instuser($udom,undef,
9967: $usershash->{$user}->{'id'});
9968: } else {
9969: ($inst_response{$user},%{$inst_results->{$user}}) =
9970: &Apache::lonnet::get_instuser($udom,$uname);
9971: }
1.585 raeburn 9972: }
1.1226 raeburn 9973: } else {
9974: ($inst_response{$user},%{$inst_results->{$user}}) =
9975: &Apache::lonnet::get_instuser($udom,$uname);
9976: return;
9977: }
9978: if (!$got_rules->{$udom}) {
9979: my %domconfig = &Apache::lonnet::get_dom('configuration',
9980: ['usercreation'],$udom);
9981: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9982: foreach my $item ('username','id') {
9983: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9984: $$curr_rules{$udom}{$item} =
9985: $domconfig{'usercreation'}{$item.'_rule'};
9986: }
9987: }
9988: }
9989: $got_rules->{$udom} = 1;
1.585 raeburn 9990: }
9991: }
1.1226 raeburn 9992: } else {
9993: return;
9994: }
9995: } else {
9996: return;
9997: }
9998: foreach my $user (keys(%{$usershash})) {
9999: my ($uname,$udom) = split(/:/,$user);
10000: next if (($udom eq '') || ($uname eq ''));
10001: my $id;
1.1227 raeburn 10002: if (ref($inst_results) eq 'HASH') {
10003: if (ref($inst_results->{$user}) eq 'HASH') {
10004: $id = $inst_results->{$user}->{'id'};
10005: }
10006: }
10007: if ($id eq '') {
10008: if (ref($usershash->{$user})) {
10009: $id = $usershash->{$user}->{'id'};
10010: }
1.585 raeburn 10011: }
1.612 raeburn 10012: foreach my $item (keys(%{$checks})) {
10013: if (ref($$curr_rules{$udom}) eq 'HASH') {
10014: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10015: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10016: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10017: $$curr_rules{$udom}{$item});
1.612 raeburn 10018: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10019: if ($rule_check{$rule}) {
10020: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10021: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10022: if (ref($inst_results) eq 'HASH') {
10023: if (ref($inst_results->{$user}) eq 'HASH') {
10024: if (keys(%{$inst_results->{$user}}) == 0) {
10025: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10026: } elsif ($item eq 'id') {
10027: if ($inst_results->{$user}->{'id'} eq '') {
10028: $$alerts{$item}{$udom}{$uname} = 1;
10029: }
1.615 raeburn 10030: }
1.612 raeburn 10031: }
10032: }
1.615 raeburn 10033: }
10034: last;
1.585 raeburn 10035: }
10036: }
10037: }
10038: }
10039: }
10040: }
10041: }
10042: }
1.612 raeburn 10043: return;
10044: }
10045:
10046: sub user_rule_formats {
10047: my ($domain,$domdesc,$curr_rules,$check) = @_;
10048: my %text = (
10049: 'username' => 'Usernames',
10050: 'id' => 'IDs',
10051: );
10052: my $output;
10053: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10054: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10055: if (@{$ruleorder} > 0) {
1.1102 raeburn 10056: $output = '<br />'.
10057: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10058: '<span class="LC_cusr_emph">','</span>',$domdesc).
10059: ' <ul>';
1.612 raeburn 10060: foreach my $rule (@{$ruleorder}) {
10061: if (ref($curr_rules) eq 'ARRAY') {
10062: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10063: if (ref($rules->{$rule}) eq 'HASH') {
10064: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10065: $rules->{$rule}{'desc'}.'</li>';
10066: }
10067: }
10068: }
10069: }
10070: $output .= '</ul>';
10071: }
10072: }
10073: return $output;
10074: }
10075:
10076: sub instrule_disallow_msg {
1.615 raeburn 10077: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10078: my $response;
10079: my %text = (
10080: item => 'username',
10081: items => 'usernames',
10082: match => 'matches',
10083: do => 'does',
10084: action => 'a username',
10085: one => 'one',
10086: );
10087: if ($count > 1) {
10088: $text{'item'} = 'usernames';
10089: $text{'match'} ='match';
10090: $text{'do'} = 'do';
10091: $text{'action'} = 'usernames',
10092: $text{'one'} = 'ones';
10093: }
10094: if ($checkitem eq 'id') {
10095: $text{'items'} = 'IDs';
10096: $text{'item'} = 'ID';
10097: $text{'action'} = 'an ID';
1.615 raeburn 10098: if ($count > 1) {
10099: $text{'item'} = 'IDs';
10100: $text{'action'} = 'IDs';
10101: }
1.612 raeburn 10102: }
1.674 bisitz 10103: $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 10104: if ($mode eq 'upload') {
10105: if ($checkitem eq 'username') {
10106: $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'}.");
10107: } elsif ($checkitem eq 'id') {
1.674 bisitz 10108: $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 10109: }
1.669 raeburn 10110: } elsif ($mode eq 'selfcreate') {
10111: if ($checkitem eq 'id') {
10112: $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.");
10113: }
1.615 raeburn 10114: } else {
10115: if ($checkitem eq 'username') {
10116: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10117: } elsif ($checkitem eq 'id') {
10118: $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.");
10119: }
1.612 raeburn 10120: }
10121: return $response;
1.585 raeburn 10122: }
10123:
1.624 raeburn 10124: sub personal_data_fieldtitles {
10125: my %fieldtitles = &Apache::lonlocal::texthash (
10126: id => 'Student/Employee ID',
10127: permanentemail => 'E-mail address',
10128: lastname => 'Last Name',
10129: firstname => 'First Name',
10130: middlename => 'Middle Name',
10131: generation => 'Generation',
10132: gen => 'Generation',
1.765 raeburn 10133: inststatus => 'Affiliation',
1.624 raeburn 10134: );
10135: return %fieldtitles;
10136: }
10137:
1.642 raeburn 10138: sub sorted_inst_types {
10139: my ($dom) = @_;
1.1185 raeburn 10140: my ($usertypes,$order);
10141: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10142: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10143: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10144: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10145: } else {
10146: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10147: }
1.642 raeburn 10148: my $othertitle = &mt('All users');
10149: if ($env{'request.course.id'}) {
1.668 raeburn 10150: $othertitle = &mt('Any users');
1.642 raeburn 10151: }
10152: my @types;
10153: if (ref($order) eq 'ARRAY') {
10154: @types = @{$order};
10155: }
10156: if (@types == 0) {
10157: if (ref($usertypes) eq 'HASH') {
10158: @types = sort(keys(%{$usertypes}));
10159: }
10160: }
10161: if (keys(%{$usertypes}) > 0) {
10162: $othertitle = &mt('Other users');
10163: }
10164: return ($othertitle,$usertypes,\@types);
10165: }
10166:
1.645 raeburn 10167: sub get_institutional_codes {
10168: my ($settings,$allcourses,$LC_code) = @_;
10169: # Get complete list of course sections to update
10170: my @currsections = ();
10171: my @currxlists = ();
10172: my $coursecode = $$settings{'internal.coursecode'};
10173:
10174: if ($$settings{'internal.sectionnums'} ne '') {
10175: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10176: }
10177:
10178: if ($$settings{'internal.crosslistings'} ne '') {
10179: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10180: }
10181:
10182: if (@currxlists > 0) {
10183: foreach (@currxlists) {
10184: if (m/^([^:]+):(\w*)$/) {
10185: unless (grep/^$1$/,@{$allcourses}) {
10186: push @{$allcourses},$1;
10187: $$LC_code{$1} = $2;
10188: }
10189: }
10190: }
10191: }
10192:
10193: if (@currsections > 0) {
10194: foreach (@currsections) {
10195: if (m/^(\w+):(\w*)$/) {
10196: my $sec = $coursecode.$1;
10197: my $lc_sec = $2;
10198: unless (grep/^$sec$/,@{$allcourses}) {
10199: push @{$allcourses},$sec;
10200: $$LC_code{$sec} = $lc_sec;
10201: }
10202: }
10203: }
10204: }
10205: return;
10206: }
10207:
1.971 raeburn 10208: sub get_standard_codeitems {
10209: return ('Year','Semester','Department','Number','Section');
10210: }
10211:
1.112 bowersj2 10212: =pod
10213:
1.780 raeburn 10214: =head1 Slot Helpers
10215:
10216: =over 4
10217:
10218: =item * sorted_slots()
10219:
1.1040 raeburn 10220: Sorts an array of slot names in order of an optional sort key,
10221: default sort is by slot start time (earliest first).
1.780 raeburn 10222:
10223: Inputs:
10224:
10225: =over 4
10226:
10227: slotsarr - Reference to array of unsorted slot names.
10228:
10229: slots - Reference to hash of hash, where outer hash keys are slot names.
10230:
1.1040 raeburn 10231: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10232:
1.549 albertel 10233: =back
10234:
1.780 raeburn 10235: Returns:
10236:
10237: =over 4
10238:
1.1040 raeburn 10239: sorted - An array of slot names sorted by a specified sort key
10240: (default sort key is start time of the slot).
1.780 raeburn 10241:
10242: =back
10243:
10244: =cut
10245:
10246:
10247: sub sorted_slots {
1.1040 raeburn 10248: my ($slotsarr,$slots,$sortkey) = @_;
10249: if ($sortkey eq '') {
10250: $sortkey = 'starttime';
10251: }
1.780 raeburn 10252: my @sorted;
10253: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10254: @sorted =
10255: sort {
10256: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10257: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10258: }
10259: if (ref($slots->{$a})) { return -1;}
10260: if (ref($slots->{$b})) { return 1;}
10261: return 0;
10262: } @{$slotsarr};
10263: }
10264: return @sorted;
10265: }
10266:
1.1040 raeburn 10267: =pod
10268:
10269: =item * get_future_slots()
10270:
10271: Inputs:
10272:
10273: =over 4
10274:
10275: cnum - course number
10276:
10277: cdom - course domain
10278:
10279: now - current UNIX time
10280:
10281: symb - optional symb
10282:
10283: =back
10284:
10285: Returns:
10286:
10287: =over 4
10288:
10289: sorted_reservable - ref to array of student_schedulable slots currently
10290: reservable, ordered by end date of reservation period.
10291:
10292: reservable_now - ref to hash of student_schedulable slots currently
10293: reservable.
10294:
10295: Keys in inner hash are:
10296: (a) symb: either blank or symb to which slot use is restricted.
10297: (b) endreserve: end date of reservation period.
10298:
10299: sorted_future - ref to array of student_schedulable slots reservable in
10300: the future, ordered by start date of reservation period.
10301:
10302: future_reservable - ref to hash of student_schedulable slots reservable
10303: in the future.
10304:
10305: Keys in inner hash are:
10306: (a) symb: either blank or symb to which slot use is restricted.
10307: (b) startreserve: start date of reservation period.
10308:
10309: =back
10310:
10311: =cut
10312:
10313: sub get_future_slots {
10314: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10315: my $map;
10316: if ($symb) {
10317: ($map) = &Apache::lonnet::decode_symb($symb);
10318: }
1.1040 raeburn 10319: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10320: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10321: foreach my $slot (keys(%slots)) {
10322: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10323: if ($symb) {
1.1229 raeburn 10324: if ($slots{$slot}->{'symb'} ne '') {
10325: my $canuse;
10326: my %oksymbs;
10327: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10328: map { $oksymbs{$_} = 1; } @slotsymbs;
10329: if ($oksymbs{$symb}) {
10330: $canuse = 1;
10331: } else {
10332: foreach my $item (@slotsymbs) {
10333: if ($item =~ /\.(page|sequence)$/) {
10334: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10335: if (($map ne '') && ($map eq $sloturl)) {
10336: $canuse = 1;
10337: last;
10338: }
10339: }
10340: }
10341: }
10342: next unless ($canuse);
10343: }
1.1040 raeburn 10344: }
10345: if (($slots{$slot}->{'starttime'} > $now) &&
10346: ($slots{$slot}->{'endtime'} > $now)) {
10347: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10348: my $userallowed = 0;
10349: if ($slots{$slot}->{'allowedsections'}) {
10350: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10351: if (!defined($env{'request.role.sec'})
10352: && grep(/^No section assigned$/,@allowed_sec)) {
10353: $userallowed=1;
10354: } else {
10355: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10356: $userallowed=1;
10357: }
10358: }
10359: unless ($userallowed) {
10360: if (defined($env{'request.course.groups'})) {
10361: my @groups = split(/:/,$env{'request.course.groups'});
10362: foreach my $group (@groups) {
10363: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10364: $userallowed=1;
10365: last;
10366: }
10367: }
10368: }
10369: }
10370: }
10371: if ($slots{$slot}->{'allowedusers'}) {
10372: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10373: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10374: if (grep(/^\Q$user\E$/,@allowed_users)) {
10375: $userallowed = 1;
10376: }
10377: }
10378: next unless($userallowed);
10379: }
10380: my $startreserve = $slots{$slot}->{'startreserve'};
10381: my $endreserve = $slots{$slot}->{'endreserve'};
10382: my $symb = $slots{$slot}->{'symb'};
10383: if (($startreserve < $now) &&
10384: (!$endreserve || $endreserve > $now)) {
10385: my $lastres = $endreserve;
10386: if (!$lastres) {
10387: $lastres = $slots{$slot}->{'starttime'};
10388: }
10389: $reservable_now{$slot} = {
10390: symb => $symb,
10391: endreserve => $lastres
10392: };
10393: } elsif (($startreserve > $now) &&
10394: (!$endreserve || $endreserve > $startreserve)) {
10395: $future_reservable{$slot} = {
10396: symb => $symb,
10397: startreserve => $startreserve
10398: };
10399: }
10400: }
10401: }
10402: my @unsorted_reservable = keys(%reservable_now);
10403: if (@unsorted_reservable > 0) {
10404: @sorted_reservable =
10405: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10406: }
10407: my @unsorted_future = keys(%future_reservable);
10408: if (@unsorted_future > 0) {
10409: @sorted_future =
10410: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10411: }
10412: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10413: }
1.780 raeburn 10414:
10415: =pod
10416:
1.1057 foxr 10417: =back
10418:
1.549 albertel 10419: =head1 HTTP Helpers
10420:
10421: =over 4
10422:
1.648 raeburn 10423: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10424:
1.258 albertel 10425: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10426: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10427: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10428:
10429: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10430: $possible_names is an ref to an array of form element names. As an example:
10431: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10432: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10433:
10434: =cut
1.1 albertel 10435:
1.6 albertel 10436: sub get_unprocessed_cgi {
1.25 albertel 10437: my ($query,$possible_names)= @_;
1.26 matthew 10438: # $Apache::lonxml::debug=1;
1.356 albertel 10439: foreach my $pair (split(/&/,$query)) {
10440: my ($name, $value) = split(/=/,$pair);
1.369 www 10441: $name = &unescape($name);
1.25 albertel 10442: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10443: $value =~ tr/+/ /;
10444: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10445: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10446: }
1.16 harris41 10447: }
1.6 albertel 10448: }
10449:
1.112 bowersj2 10450: =pod
10451:
1.648 raeburn 10452: =item * &cacheheader()
1.112 bowersj2 10453:
10454: returns cache-controlling header code
10455:
10456: =cut
10457:
1.7 albertel 10458: sub cacheheader {
1.258 albertel 10459: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10460: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10461: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10462: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10463: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10464: return $output;
1.7 albertel 10465: }
10466:
1.112 bowersj2 10467: =pod
10468:
1.648 raeburn 10469: =item * &no_cache($r)
1.112 bowersj2 10470:
10471: specifies header code to not have cache
10472:
10473: =cut
10474:
1.9 albertel 10475: sub no_cache {
1.216 albertel 10476: my ($r) = @_;
10477: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10478: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10479: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10480: $r->no_cache(1);
10481: $r->header_out("Expires" => $date);
10482: $r->header_out("Pragma" => "no-cache");
1.123 www 10483: }
10484:
10485: sub content_type {
1.181 albertel 10486: my ($r,$type,$charset) = @_;
1.299 foxr 10487: if ($r) {
10488: # Note that printout.pl calls this with undef for $r.
10489: &no_cache($r);
10490: }
1.258 albertel 10491: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10492: unless ($charset) {
10493: $charset=&Apache::lonlocal::current_encoding;
10494: }
10495: if ($charset) { $type.='; charset='.$charset; }
10496: if ($r) {
10497: $r->content_type($type);
10498: } else {
10499: print("Content-type: $type\n\n");
10500: }
1.9 albertel 10501: }
1.25 albertel 10502:
1.112 bowersj2 10503: =pod
10504:
1.648 raeburn 10505: =item * &add_to_env($name,$value)
1.112 bowersj2 10506:
1.258 albertel 10507: adds $name to the %env hash with value
1.112 bowersj2 10508: $value, if $name already exists, the entry is converted to an array
10509: reference and $value is added to the array.
10510:
10511: =cut
10512:
1.25 albertel 10513: sub add_to_env {
10514: my ($name,$value)=@_;
1.258 albertel 10515: if (defined($env{$name})) {
10516: if (ref($env{$name})) {
1.25 albertel 10517: #already have multiple values
1.258 albertel 10518: push(@{ $env{$name} },$value);
1.25 albertel 10519: } else {
10520: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10521: my $first=$env{$name};
10522: undef($env{$name});
10523: push(@{ $env{$name} },$first,$value);
1.25 albertel 10524: }
10525: } else {
1.258 albertel 10526: $env{$name}=$value;
1.25 albertel 10527: }
1.31 albertel 10528: }
1.149 albertel 10529:
10530: =pod
10531:
1.648 raeburn 10532: =item * &get_env_multiple($name)
1.149 albertel 10533:
1.258 albertel 10534: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10535: values may be defined and end up as an array ref.
10536:
10537: returns an array of values
10538:
10539: =cut
10540:
10541: sub get_env_multiple {
10542: my ($name) = @_;
10543: my @values;
1.258 albertel 10544: if (defined($env{$name})) {
1.149 albertel 10545: # exists is it an array
1.258 albertel 10546: if (ref($env{$name})) {
10547: @values=@{ $env{$name} };
1.149 albertel 10548: } else {
1.258 albertel 10549: $values[0]=$env{$name};
1.149 albertel 10550: }
10551: }
10552: return(@values);
10553: }
10554:
1.660 raeburn 10555: sub ask_for_embedded_content {
10556: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10557: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10558: %currsubfile,%unused,$rem);
1.1071 raeburn 10559: my $counter = 0;
10560: my $numnew = 0;
1.987 raeburn 10561: my $numremref = 0;
10562: my $numinvalid = 0;
10563: my $numpathchg = 0;
10564: my $numexisting = 0;
1.1071 raeburn 10565: my $numunused = 0;
10566: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10567: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10568: my $heading = &mt('Upload embedded files');
10569: my $buttontext = &mt('Upload');
10570:
1.1085 raeburn 10571: if ($env{'request.course.id'}) {
1.1123 raeburn 10572: if ($actionurl eq '/adm/dependencies') {
10573: $navmap = Apache::lonnavmaps::navmap->new();
10574: }
10575: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10576: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10577: }
1.1123 raeburn 10578: if (($actionurl eq '/adm/portfolio') ||
10579: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10580: my $current_path='/';
10581: if ($env{'form.currentpath'}) {
10582: $current_path = $env{'form.currentpath'};
10583: }
10584: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10585: $udom = $cdom;
10586: $uname = $cnum;
1.984 raeburn 10587: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10588: } else {
10589: $udom = $env{'user.domain'};
10590: $uname = $env{'user.name'};
10591: $url = '/userfiles/portfolio';
10592: }
1.987 raeburn 10593: $toplevel = $url.'/';
1.984 raeburn 10594: $url .= $current_path;
10595: $getpropath = 1;
1.987 raeburn 10596: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10597: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10598: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10599: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10600: $toplevel = $url;
1.984 raeburn 10601: if ($rest ne '') {
1.987 raeburn 10602: $url .= $rest;
10603: }
10604: } elsif ($actionurl eq '/adm/coursedocs') {
10605: if (ref($args) eq 'HASH') {
1.1071 raeburn 10606: $url = $args->{'docs_url'};
10607: $toplevel = $url;
1.1084 raeburn 10608: if ($args->{'context'} eq 'paste') {
10609: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10610: ($path) =
10611: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10612: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10613: $fileloc =~ s{^/}{};
10614: }
1.1071 raeburn 10615: }
1.1084 raeburn 10616: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 10617: if ($env{'request.course.id'} ne '') {
10618: if (ref($args) eq 'HASH') {
10619: $url = $args->{'docs_url'};
10620: $title = $args->{'docs_title'};
1.1126 raeburn 10621: $toplevel = $url;
10622: unless ($toplevel =~ m{^/}) {
10623: $toplevel = "/$url";
10624: }
1.1085 raeburn 10625: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 10626: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10627: $path = $1;
10628: } else {
10629: ($path) =
10630: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10631: }
1.1195 raeburn 10632: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10633: $fileloc = $toplevel;
10634: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10635: my ($udom,$uname,$fname) =
10636: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10637: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10638: } else {
10639: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10640: }
1.1071 raeburn 10641: $fileloc =~ s{^/}{};
10642: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10643: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10644: }
1.987 raeburn 10645: }
1.1123 raeburn 10646: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10647: $udom = $cdom;
10648: $uname = $cnum;
10649: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10650: $toplevel = $url;
10651: $path = $url;
10652: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10653: $fileloc =~ s{^/}{};
1.987 raeburn 10654: }
1.1126 raeburn 10655: foreach my $file (keys(%{$allfiles})) {
10656: my $embed_file;
10657: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10658: $embed_file = $1;
10659: } else {
10660: $embed_file = $file;
10661: }
1.1158 raeburn 10662: my ($absolutepath,$cleaned_file);
10663: if ($embed_file =~ m{^\w+://}) {
10664: $cleaned_file = $embed_file;
1.1147 raeburn 10665: $newfiles{$cleaned_file} = 1;
10666: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10667: } else {
1.1158 raeburn 10668: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10669: if ($embed_file =~ m{^/}) {
10670: $absolutepath = $embed_file;
10671: }
1.1147 raeburn 10672: if ($cleaned_file =~ m{/}) {
10673: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10674: $path = &check_for_traversal($path,$url,$toplevel);
10675: my $item = $fname;
10676: if ($path ne '') {
10677: $item = $path.'/'.$fname;
10678: $subdependencies{$path}{$fname} = 1;
10679: } else {
10680: $dependencies{$item} = 1;
10681: }
10682: if ($absolutepath) {
10683: $mapping{$item} = $absolutepath;
10684: } else {
10685: $mapping{$item} = $embed_file;
10686: }
10687: } else {
10688: $dependencies{$embed_file} = 1;
10689: if ($absolutepath) {
1.1147 raeburn 10690: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10691: } else {
1.1147 raeburn 10692: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10693: }
10694: }
1.984 raeburn 10695: }
10696: }
1.1071 raeburn 10697: my $dirptr = 16384;
1.984 raeburn 10698: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10699: $currsubfile{$path} = {};
1.1123 raeburn 10700: if (($actionurl eq '/adm/portfolio') ||
10701: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10702: my ($sublistref,$listerror) =
10703: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10704: if (ref($sublistref) eq 'ARRAY') {
10705: foreach my $line (@{$sublistref}) {
10706: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10707: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10708: }
1.984 raeburn 10709: }
1.987 raeburn 10710: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10711: if (opendir(my $dir,$url.'/'.$path)) {
10712: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10713: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10714: }
1.1084 raeburn 10715: } elsif (($actionurl eq '/adm/dependencies') ||
10716: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10717: ($args->{'context'} eq 'paste')) ||
10718: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10719: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10720: my $dir;
10721: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10722: $dir = $fileloc;
10723: } else {
10724: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10725: }
1.1071 raeburn 10726: if ($dir ne '') {
10727: my ($sublistref,$listerror) =
10728: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10729: if (ref($sublistref) eq 'ARRAY') {
10730: foreach my $line (@{$sublistref}) {
10731: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10732: undef,$mtime)=split(/\&/,$line,12);
10733: unless (($testdir&$dirptr) ||
10734: ($file_name =~ /^\.\.?$/)) {
10735: $currsubfile{$path}{$file_name} = [$size,$mtime];
10736: }
10737: }
10738: }
10739: }
1.984 raeburn 10740: }
10741: }
10742: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10743: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10744: my $item = $path.'/'.$file;
10745: unless ($mapping{$item} eq $item) {
10746: $pathchanges{$item} = 1;
10747: }
10748: $existing{$item} = 1;
10749: $numexisting ++;
10750: } else {
10751: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10752: }
10753: }
1.1071 raeburn 10754: if ($actionurl eq '/adm/dependencies') {
10755: foreach my $path (keys(%currsubfile)) {
10756: if (ref($currsubfile{$path}) eq 'HASH') {
10757: foreach my $file (keys(%{$currsubfile{$path}})) {
10758: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10759: next if (($rem ne '') &&
10760: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10761: (ref($navmap) &&
10762: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10763: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10764: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10765: $unused{$path.'/'.$file} = 1;
10766: }
10767: }
10768: }
10769: }
10770: }
1.984 raeburn 10771: }
1.987 raeburn 10772: my %currfile;
1.1123 raeburn 10773: if (($actionurl eq '/adm/portfolio') ||
10774: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10775: my ($dirlistref,$listerror) =
10776: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10777: if (ref($dirlistref) eq 'ARRAY') {
10778: foreach my $line (@{$dirlistref}) {
10779: my ($file_name,$rest) = split(/\&/,$line,2);
10780: $currfile{$file_name} = 1;
10781: }
1.984 raeburn 10782: }
1.987 raeburn 10783: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10784: if (opendir(my $dir,$url)) {
1.987 raeburn 10785: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10786: map {$currfile{$_} = 1;} @dir_list;
10787: }
1.1084 raeburn 10788: } elsif (($actionurl eq '/adm/dependencies') ||
10789: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10790: ($args->{'context'} eq 'paste')) ||
10791: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10792: if ($env{'request.course.id'} ne '') {
10793: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10794: if ($dir ne '') {
10795: my ($dirlistref,$listerror) =
10796: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10797: if (ref($dirlistref) eq 'ARRAY') {
10798: foreach my $line (@{$dirlistref}) {
10799: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10800: $size,undef,$mtime)=split(/\&/,$line,12);
10801: unless (($testdir&$dirptr) ||
10802: ($file_name =~ /^\.\.?$/)) {
10803: $currfile{$file_name} = [$size,$mtime];
10804: }
10805: }
10806: }
10807: }
10808: }
1.984 raeburn 10809: }
10810: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10811: if (exists($currfile{$file})) {
1.987 raeburn 10812: unless ($mapping{$file} eq $file) {
10813: $pathchanges{$file} = 1;
10814: }
10815: $existing{$file} = 1;
10816: $numexisting ++;
10817: } else {
1.984 raeburn 10818: $newfiles{$file} = 1;
10819: }
10820: }
1.1071 raeburn 10821: foreach my $file (keys(%currfile)) {
10822: unless (($file eq $filename) ||
10823: ($file eq $filename.'.bak') ||
10824: ($dependencies{$file})) {
1.1085 raeburn 10825: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10826: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10827: next if (($rem ne '') &&
10828: (($env{"httpref.$rem".$file} ne '') ||
10829: (ref($navmap) &&
10830: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10831: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10832: ($navmap->getResourceByUrl($rem.$1)))))));
10833: }
1.1085 raeburn 10834: }
1.1071 raeburn 10835: $unused{$file} = 1;
10836: }
10837: }
1.1084 raeburn 10838: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10839: ($args->{'context'} eq 'paste')) {
10840: $counter = scalar(keys(%existing));
10841: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10842: return ($output,$counter,$numpathchg,\%existing);
10843: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10844: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10845: $counter = scalar(keys(%existing));
10846: $numpathchg = scalar(keys(%pathchanges));
10847: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10848: }
1.984 raeburn 10849: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10850: if ($actionurl eq '/adm/dependencies') {
10851: next if ($embed_file =~ m{^\w+://});
10852: }
1.660 raeburn 10853: $upload_output .= &start_data_table_row().
1.1123 raeburn 10854: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10855: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10856: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10857: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10858: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10859: }
1.1123 raeburn 10860: $upload_output .= '</td>';
1.1071 raeburn 10861: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10862: $upload_output.='<td align="right">'.
10863: '<span class="LC_info LC_fontsize_medium">'.
10864: &mt("URL points to web address").'</span>';
1.987 raeburn 10865: $numremref++;
1.660 raeburn 10866: } elsif ($args->{'error_on_invalid_names'}
10867: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10868: $upload_output.='<td align="right"><span class="LC_warning">'.
10869: &mt('Invalid characters').'</span>';
1.987 raeburn 10870: $numinvalid++;
1.660 raeburn 10871: } else {
1.1123 raeburn 10872: $upload_output .= '<td>'.
10873: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10874: $embed_file,\%mapping,
1.1071 raeburn 10875: $allfiles,$codebase,'upload');
10876: $counter ++;
10877: $numnew ++;
1.987 raeburn 10878: }
10879: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10880: }
10881: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10882: if ($actionurl eq '/adm/dependencies') {
10883: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10884: $modify_output .= &start_data_table_row().
10885: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10886: '<img src="'.&icon($embed_file).'" border="0" />'.
10887: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10888: '<td>'.$size.'</td>'.
10889: '<td>'.$mtime.'</td>'.
10890: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10891: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10892: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10893: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10894: &embedded_file_element('upload_embedded',$counter,
10895: $embed_file,\%mapping,
10896: $allfiles,$codebase,'modify').
10897: '</div></td>'.
10898: &end_data_table_row()."\n";
10899: $counter ++;
10900: } else {
10901: $upload_output .= &start_data_table_row().
1.1123 raeburn 10902: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10903: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10904: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10905: &Apache::loncommon::end_data_table_row()."\n";
10906: }
10907: }
10908: my $delidx = $counter;
10909: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10910: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10911: $delete_output .= &start_data_table_row().
10912: '<td><img src="'.&icon($oldfile).'" />'.
10913: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10914: '<td>'.$size.'</td>'.
10915: '<td>'.$mtime.'</td>'.
10916: '<td><label><input type="checkbox" name="del_upload_dep" '.
10917: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10918: &embedded_file_element('upload_embedded',$delidx,
10919: $oldfile,\%mapping,$allfiles,
10920: $codebase,'delete').'</td>'.
10921: &end_data_table_row()."\n";
10922: $numunused ++;
10923: $delidx ++;
1.987 raeburn 10924: }
10925: if ($upload_output) {
10926: $upload_output = &start_data_table().
10927: $upload_output.
10928: &end_data_table()."\n";
10929: }
1.1071 raeburn 10930: if ($modify_output) {
10931: $modify_output = &start_data_table().
10932: &start_data_table_header_row().
10933: '<th>'.&mt('File').'</th>'.
10934: '<th>'.&mt('Size (KB)').'</th>'.
10935: '<th>'.&mt('Modified').'</th>'.
10936: '<th>'.&mt('Upload replacement?').'</th>'.
10937: &end_data_table_header_row().
10938: $modify_output.
10939: &end_data_table()."\n";
10940: }
10941: if ($delete_output) {
10942: $delete_output = &start_data_table().
10943: &start_data_table_header_row().
10944: '<th>'.&mt('File').'</th>'.
10945: '<th>'.&mt('Size (KB)').'</th>'.
10946: '<th>'.&mt('Modified').'</th>'.
10947: '<th>'.&mt('Delete?').'</th>'.
10948: &end_data_table_header_row().
10949: $delete_output.
10950: &end_data_table()."\n";
10951: }
1.987 raeburn 10952: my $applies = 0;
10953: if ($numremref) {
10954: $applies ++;
10955: }
10956: if ($numinvalid) {
10957: $applies ++;
10958: }
10959: if ($numexisting) {
10960: $applies ++;
10961: }
1.1071 raeburn 10962: if ($counter || $numunused) {
1.987 raeburn 10963: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10964: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10965: $state.'<h3>'.$heading.'</h3>';
10966: if ($actionurl eq '/adm/dependencies') {
10967: if ($numnew) {
10968: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10969: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10970: $upload_output.'<br />'."\n";
10971: }
10972: if ($numexisting) {
10973: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10974: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10975: $modify_output.'<br />'."\n";
10976: $buttontext = &mt('Save changes');
10977: }
10978: if ($numunused) {
10979: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10980: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10981: $delete_output.'<br />'."\n";
10982: $buttontext = &mt('Save changes');
10983: }
10984: } else {
10985: $output .= $upload_output.'<br />'."\n";
10986: }
10987: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10988: $counter.'" />'."\n";
10989: if ($actionurl eq '/adm/dependencies') {
10990: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10991: $numnew.'" />'."\n";
10992: } elsif ($actionurl eq '') {
1.987 raeburn 10993: $output .= '<input type="hidden" name="phase" value="three" />';
10994: }
10995: } elsif ($applies) {
10996: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10997: if ($applies > 1) {
10998: $output .=
1.1123 raeburn 10999: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11000: if ($numremref) {
11001: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11002: }
11003: if ($numinvalid) {
11004: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11005: }
11006: if ($numexisting) {
11007: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11008: }
11009: $output .= '</ul><br />';
11010: } elsif ($numremref) {
11011: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11012: } elsif ($numinvalid) {
11013: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11014: } elsif ($numexisting) {
11015: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11016: }
11017: $output .= $upload_output.'<br />';
11018: }
11019: my ($pathchange_output,$chgcount);
1.1071 raeburn 11020: $chgcount = $counter;
1.987 raeburn 11021: if (keys(%pathchanges) > 0) {
11022: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11023: if ($counter) {
1.987 raeburn 11024: $output .= &embedded_file_element('pathchange',$chgcount,
11025: $embed_file,\%mapping,
1.1071 raeburn 11026: $allfiles,$codebase,'change');
1.987 raeburn 11027: } else {
11028: $pathchange_output .=
11029: &start_data_table_row().
11030: '<td><input type ="checkbox" name="namechange" value="'.
11031: $chgcount.'" checked="checked" /></td>'.
11032: '<td>'.$mapping{$embed_file}.'</td>'.
11033: '<td>'.$embed_file.
11034: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11035: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11036: '</td>'.&end_data_table_row();
1.660 raeburn 11037: }
1.987 raeburn 11038: $numpathchg ++;
11039: $chgcount ++;
1.660 raeburn 11040: }
11041: }
1.1127 raeburn 11042: if (($counter) || ($numunused)) {
1.987 raeburn 11043: if ($numpathchg) {
11044: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11045: $numpathchg.'" />'."\n";
11046: }
11047: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11048: ($actionurl eq '/adm/imsimport')) {
11049: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11050: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11051: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11052: } elsif ($actionurl eq '/adm/dependencies') {
11053: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11054: }
1.1123 raeburn 11055: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11056: } elsif ($numpathchg) {
11057: my %pathchange = ();
11058: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11059: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11060: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11061: }
1.987 raeburn 11062: }
1.1071 raeburn 11063: return ($output,$counter,$numpathchg);
1.987 raeburn 11064: }
11065:
1.1147 raeburn 11066: =pod
11067:
11068: =item * clean_path($name)
11069:
11070: Performs clean-up of directories, subdirectories and filename in an
11071: embedded object, referenced in an HTML file which is being uploaded
11072: to a course or portfolio, where
11073: "Upload embedded images/multimedia files if HTML file" checkbox was
11074: checked.
11075:
11076: Clean-up is similar to replacements in lonnet::clean_filename()
11077: except each / between sub-directory and next level is preserved.
11078:
11079: =cut
11080:
11081: sub clean_path {
11082: my ($embed_file) = @_;
11083: $embed_file =~s{^/+}{};
11084: my @contents;
11085: if ($embed_file =~ m{/}) {
11086: @contents = split(/\//,$embed_file);
11087: } else {
11088: @contents = ($embed_file);
11089: }
11090: my $lastidx = scalar(@contents)-1;
11091: for (my $i=0; $i<=$lastidx; $i++) {
11092: $contents[$i]=~s{\\}{/}g;
11093: $contents[$i]=~s/\s+/\_/g;
11094: $contents[$i]=~s{[^/\w\.\-]}{}g;
11095: if ($i == $lastidx) {
11096: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11097: }
11098: }
11099: if ($lastidx > 0) {
11100: return join('/',@contents);
11101: } else {
11102: return $contents[0];
11103: }
11104: }
11105:
1.987 raeburn 11106: sub embedded_file_element {
1.1071 raeburn 11107: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11108: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11109: (ref($codebase) eq 'HASH'));
11110: my $output;
1.1071 raeburn 11111: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11112: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11113: }
11114: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11115: &escape($embed_file).'" />';
11116: unless (($context eq 'upload_embedded') &&
11117: ($mapping->{$embed_file} eq $embed_file)) {
11118: $output .='
11119: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11120: }
11121: my $attrib;
11122: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11123: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11124: }
11125: $output .=
11126: "\n\t\t".
11127: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11128: $attrib.'" />';
11129: if (exists($codebase->{$mapping->{$embed_file}})) {
11130: $output .=
11131: "\n\t\t".
11132: '<input name="codebase_'.$num.'" type="hidden" value="'.
11133: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11134: }
1.987 raeburn 11135: return $output;
1.660 raeburn 11136: }
11137:
1.1071 raeburn 11138: sub get_dependency_details {
11139: my ($currfile,$currsubfile,$embed_file) = @_;
11140: my ($size,$mtime,$showsize,$showmtime);
11141: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11142: if ($embed_file =~ m{/}) {
11143: my ($path,$fname) = split(/\//,$embed_file);
11144: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11145: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11146: }
11147: } else {
11148: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11149: ($size,$mtime) = @{$currfile->{$embed_file}};
11150: }
11151: }
11152: $showsize = $size/1024.0;
11153: $showsize = sprintf("%.1f",$showsize);
11154: if ($mtime > 0) {
11155: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11156: }
11157: }
11158: return ($showsize,$showmtime);
11159: }
11160:
11161: sub ask_embedded_js {
11162: return <<"END";
11163: <script type="text/javascript"">
11164: // <![CDATA[
11165: function toggleBrowse(counter) {
11166: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11167: var fileid = document.getElementById('embedded_item_'+counter);
11168: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11169: if (chkboxid.checked == true) {
11170: uploaddivid.style.display='block';
11171: } else {
11172: uploaddivid.style.display='none';
11173: fileid.value = '';
11174: }
11175: }
11176: // ]]>
11177: </script>
11178:
11179: END
11180: }
11181:
1.661 raeburn 11182: sub upload_embedded {
11183: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11184: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11185: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11186: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11187: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11188: my $orig_uploaded_filename =
11189: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11190: foreach my $type ('orig','ref','attrib','codebase') {
11191: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11192: $env{'form.embedded_'.$type.'_'.$i} =
11193: &unescape($env{'form.embedded_'.$type.'_'.$i});
11194: }
11195: }
1.661 raeburn 11196: my ($path,$fname) =
11197: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11198: # no path, whole string is fname
11199: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11200: $fname = &Apache::lonnet::clean_filename($fname);
11201: # See if there is anything left
11202: next if ($fname eq '');
11203:
11204: # Check if file already exists as a file or directory.
11205: my ($state,$msg);
11206: if ($context eq 'portfolio') {
11207: my $port_path = $dirpath;
11208: if ($group ne '') {
11209: $port_path = "groups/$group/$port_path";
11210: }
1.987 raeburn 11211: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11212: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11213: $dir_root,$port_path,$disk_quota,
11214: $current_disk_usage,$uname,$udom);
11215: if ($state eq 'will_exceed_quota'
1.984 raeburn 11216: || $state eq 'file_locked') {
1.661 raeburn 11217: $output .= $msg;
11218: next;
11219: }
11220: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11221: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11222: if ($state eq 'exists') {
11223: $output .= $msg;
11224: next;
11225: }
11226: }
11227: # Check if extension is valid
11228: if (($fname =~ /\.(\w+)$/) &&
11229: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11230: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11231: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11232: next;
11233: } elsif (($fname =~ /\.(\w+)$/) &&
11234: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11235: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11236: next;
11237: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11238: $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 11239: next;
11240: }
11241: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11242: my $subdir = $path;
11243: $subdir =~ s{/+$}{};
1.661 raeburn 11244: if ($context eq 'portfolio') {
1.984 raeburn 11245: my $result;
11246: if ($state eq 'existingfile') {
11247: $result=
11248: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11249: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11250: } else {
1.984 raeburn 11251: $result=
11252: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11253: $dirpath.
1.1123 raeburn 11254: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11255: if ($result !~ m|^/uploaded/|) {
11256: $output .= '<span class="LC_error">'
11257: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11258: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11259: .'</span><br />';
11260: next;
11261: } else {
1.987 raeburn 11262: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11263: $path.$fname.'</span>').'<br />';
1.984 raeburn 11264: }
1.661 raeburn 11265: }
1.1123 raeburn 11266: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11267: my $extendedsubdir = $dirpath.'/'.$subdir;
11268: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11269: my $result =
1.1126 raeburn 11270: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11271: if ($result !~ m|^/uploaded/|) {
11272: $output .= '<span class="LC_error">'
11273: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11274: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11275: .'</span><br />';
11276: next;
11277: } else {
11278: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11279: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11280: if ($context eq 'syllabus') {
11281: &Apache::lonnet::make_public_indefinitely($result);
11282: }
1.987 raeburn 11283: }
1.661 raeburn 11284: } else {
11285: # Save the file
11286: my $target = $env{'form.embedded_item_'.$i};
11287: my $fullpath = $dir_root.$dirpath.'/'.$path;
11288: my $dest = $fullpath.$fname;
11289: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11290: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11291: my $count;
11292: my $filepath = $dir_root;
1.1027 raeburn 11293: foreach my $subdir (@parts) {
11294: $filepath .= "/$subdir";
11295: if (!-e $filepath) {
1.661 raeburn 11296: mkdir($filepath,0770);
11297: }
11298: }
11299: my $fh;
11300: if (!open($fh,'>'.$dest)) {
11301: &Apache::lonnet::logthis('Failed to create '.$dest);
11302: $output .= '<span class="LC_error">'.
1.1071 raeburn 11303: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11304: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11305: '</span><br />';
11306: } else {
11307: if (!print $fh $env{'form.embedded_item_'.$i}) {
11308: &Apache::lonnet::logthis('Failed to write to '.$dest);
11309: $output .= '<span class="LC_error">'.
1.1071 raeburn 11310: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11311: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11312: '</span><br />';
11313: } else {
1.987 raeburn 11314: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11315: $url.'</span>').'<br />';
11316: unless ($context eq 'testbank') {
11317: $footer .= &mt('View embedded file: [_1]',
11318: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11319: }
11320: }
11321: close($fh);
11322: }
11323: }
11324: if ($env{'form.embedded_ref_'.$i}) {
11325: $pathchange{$i} = 1;
11326: }
11327: }
11328: if ($output) {
11329: $output = '<p>'.$output.'</p>';
11330: }
11331: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11332: $returnflag = 'ok';
1.1071 raeburn 11333: my $numpathchgs = scalar(keys(%pathchange));
11334: if ($numpathchgs > 0) {
1.987 raeburn 11335: if ($context eq 'portfolio') {
11336: $output .= '<p>'.&mt('or').'</p>';
11337: } elsif ($context eq 'testbank') {
1.1071 raeburn 11338: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11339: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11340: $returnflag = 'modify_orightml';
11341: }
11342: }
1.1071 raeburn 11343: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11344: }
11345:
11346: sub modify_html_form {
11347: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11348: my $end = 0;
11349: my $modifyform;
11350: if ($context eq 'upload_embedded') {
11351: return unless (ref($pathchange) eq 'HASH');
11352: if ($env{'form.number_embedded_items'}) {
11353: $end += $env{'form.number_embedded_items'};
11354: }
11355: if ($env{'form.number_pathchange_items'}) {
11356: $end += $env{'form.number_pathchange_items'};
11357: }
11358: if ($end) {
11359: for (my $i=0; $i<$end; $i++) {
11360: if ($i < $env{'form.number_embedded_items'}) {
11361: next unless($pathchange->{$i});
11362: }
11363: $modifyform .=
11364: &start_data_table_row().
11365: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11366: 'checked="checked" /></td>'.
11367: '<td>'.$env{'form.embedded_ref_'.$i}.
11368: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11369: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11370: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11371: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11372: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11373: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11374: '<td>'.$env{'form.embedded_orig_'.$i}.
11375: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11376: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11377: &end_data_table_row();
1.1071 raeburn 11378: }
1.987 raeburn 11379: }
11380: } else {
11381: $modifyform = $pathchgtable;
11382: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11383: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11384: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11385: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11386: }
11387: }
11388: if ($modifyform) {
1.1071 raeburn 11389: if ($actionurl eq '/adm/dependencies') {
11390: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11391: }
1.987 raeburn 11392: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11393: '<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".
11394: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11395: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11396: '</ol></p>'."\n".'<p>'.
11397: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11398: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11399: &start_data_table()."\n".
11400: &start_data_table_header_row().
11401: '<th>'.&mt('Change?').'</th>'.
11402: '<th>'.&mt('Current reference').'</th>'.
11403: '<th>'.&mt('Required reference').'</th>'.
11404: &end_data_table_header_row()."\n".
11405: $modifyform.
11406: &end_data_table().'<br />'."\n".$hiddenstate.
11407: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11408: '</form>'."\n";
11409: }
11410: return;
11411: }
11412:
11413: sub modify_html_refs {
1.1123 raeburn 11414: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11415: my $container;
11416: if ($context eq 'portfolio') {
11417: $container = $env{'form.container'};
11418: } elsif ($context eq 'coursedoc') {
11419: $container = $env{'form.primaryurl'};
1.1071 raeburn 11420: } elsif ($context eq 'manage_dependencies') {
11421: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11422: $container = "/$container";
1.1123 raeburn 11423: } elsif ($context eq 'syllabus') {
11424: $container = $url;
1.987 raeburn 11425: } else {
1.1027 raeburn 11426: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11427: }
11428: my (%allfiles,%codebase,$output,$content);
11429: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11430: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11431: if (wantarray) {
11432: return ('',0,0);
11433: } else {
11434: return;
11435: }
11436: }
11437: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11438: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11439: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11440: if (wantarray) {
11441: return ('',0,0);
11442: } else {
11443: return;
11444: }
11445: }
1.987 raeburn 11446: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11447: if ($content eq '-1') {
11448: if (wantarray) {
11449: return ('',0,0);
11450: } else {
11451: return;
11452: }
11453: }
1.987 raeburn 11454: } else {
1.1071 raeburn 11455: unless ($container =~ /^\Q$dir_root\E/) {
11456: if (wantarray) {
11457: return ('',0,0);
11458: } else {
11459: return;
11460: }
11461: }
1.987 raeburn 11462: if (open(my $fh,"<$container")) {
11463: $content = join('', <$fh>);
11464: close($fh);
11465: } else {
1.1071 raeburn 11466: if (wantarray) {
11467: return ('',0,0);
11468: } else {
11469: return;
11470: }
1.987 raeburn 11471: }
11472: }
11473: my ($count,$codebasecount) = (0,0);
11474: my $mm = new File::MMagic;
11475: my $mime_type = $mm->checktype_contents($content);
11476: if ($mime_type eq 'text/html') {
11477: my $parse_result =
11478: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11479: \%codebase,\$content);
11480: if ($parse_result eq 'ok') {
11481: foreach my $i (@changes) {
11482: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11483: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11484: if ($allfiles{$ref}) {
11485: my $newname = $orig;
11486: my ($attrib_regexp,$codebase);
1.1006 raeburn 11487: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11488: if ($attrib_regexp =~ /:/) {
11489: $attrib_regexp =~ s/\:/|/g;
11490: }
11491: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11492: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11493: $count += $numchg;
1.1123 raeburn 11494: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11495: delete($allfiles{$ref});
1.987 raeburn 11496: }
11497: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11498: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11499: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11500: $codebasecount ++;
11501: }
11502: }
11503: }
1.1123 raeburn 11504: my $skiprewrites;
1.987 raeburn 11505: if ($count || $codebasecount) {
11506: my $saveresult;
1.1071 raeburn 11507: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11508: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11509: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11510: if ($url eq $container) {
11511: my ($fname) = ($container =~ m{/([^/]+)$});
11512: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11513: $count,'<span class="LC_filename">'.
1.1071 raeburn 11514: $fname.'</span>').'</p>';
1.987 raeburn 11515: } else {
11516: $output = '<p class="LC_error">'.
11517: &mt('Error: update failed for: [_1].',
11518: '<span class="LC_filename">'.
11519: $container.'</span>').'</p>';
11520: }
1.1123 raeburn 11521: if ($context eq 'syllabus') {
11522: unless ($saveresult eq 'ok') {
11523: $skiprewrites = 1;
11524: }
11525: }
1.987 raeburn 11526: } else {
11527: if (open(my $fh,">$container")) {
11528: print $fh $content;
11529: close($fh);
11530: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11531: $count,'<span class="LC_filename">'.
11532: $container.'</span>').'</p>';
1.661 raeburn 11533: } else {
1.987 raeburn 11534: $output = '<p class="LC_error">'.
11535: &mt('Error: could not update [_1].',
11536: '<span class="LC_filename">'.
11537: $container.'</span>').'</p>';
1.661 raeburn 11538: }
11539: }
11540: }
1.1123 raeburn 11541: if (($context eq 'syllabus') && (!$skiprewrites)) {
11542: my ($actionurl,$state);
11543: $actionurl = "/public/$udom/$uname/syllabus";
11544: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11545: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11546: \%codebase,
11547: {'context' => 'rewrites',
11548: 'ignore_remote_references' => 1,});
11549: if (ref($mapping) eq 'HASH') {
11550: my $rewrites = 0;
11551: foreach my $key (keys(%{$mapping})) {
11552: next if ($key =~ m{^https?://});
11553: my $ref = $mapping->{$key};
11554: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11555: my $attrib;
11556: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11557: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11558: }
11559: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11560: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11561: $rewrites += $numchg;
11562: }
11563: }
11564: if ($rewrites) {
11565: my $saveresult;
11566: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11567: if ($url eq $container) {
11568: my ($fname) = ($container =~ m{/([^/]+)$});
11569: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11570: $count,'<span class="LC_filename">'.
11571: $fname.'</span>').'</p>';
11572: } else {
11573: $output .= '<p class="LC_error">'.
11574: &mt('Error: could not update links in [_1].',
11575: '<span class="LC_filename">'.
11576: $container.'</span>').'</p>';
11577:
11578: }
11579: }
11580: }
11581: }
1.987 raeburn 11582: } else {
11583: &logthis('Failed to parse '.$container.
11584: ' to modify references: '.$parse_result);
1.661 raeburn 11585: }
11586: }
1.1071 raeburn 11587: if (wantarray) {
11588: return ($output,$count,$codebasecount);
11589: } else {
11590: return $output;
11591: }
1.661 raeburn 11592: }
11593:
11594: sub check_for_existing {
11595: my ($path,$fname,$element) = @_;
11596: my ($state,$msg);
11597: if (-d $path.'/'.$fname) {
11598: $state = 'exists';
11599: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11600: } elsif (-e $path.'/'.$fname) {
11601: $state = 'exists';
11602: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11603: }
11604: if ($state eq 'exists') {
11605: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11606: }
11607: return ($state,$msg);
11608: }
11609:
11610: sub check_for_upload {
11611: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11612: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11613: my $filesize = length($env{'form.'.$element});
11614: if (!$filesize) {
11615: my $msg = '<span class="LC_error">'.
11616: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11617: '<span class="LC_filename">'.$fname.'</span>',
11618: $filesize).'<br />'.
1.1007 raeburn 11619: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11620: '</span>';
11621: return ('zero_bytes',$msg);
11622: }
11623: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11624: my $getpropath = 1;
1.1021 raeburn 11625: my ($dirlistref,$listerror) =
11626: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11627: my $found_file = 0;
11628: my $locked_file = 0;
1.991 raeburn 11629: my @lockers;
11630: my $navmap;
11631: if ($env{'request.course.id'}) {
11632: $navmap = Apache::lonnavmaps::navmap->new();
11633: }
1.1021 raeburn 11634: if (ref($dirlistref) eq 'ARRAY') {
11635: foreach my $line (@{$dirlistref}) {
11636: my ($file_name,$rest)=split(/\&/,$line,2);
11637: if ($file_name eq $fname){
11638: $file_name = $path.$file_name;
11639: if ($group ne '') {
11640: $file_name = $group.$file_name;
11641: }
11642: $found_file = 1;
11643: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11644: foreach my $lock (@lockers) {
11645: if (ref($lock) eq 'ARRAY') {
11646: my ($symb,$crsid) = @{$lock};
11647: if ($crsid eq $env{'request.course.id'}) {
11648: if (ref($navmap)) {
11649: my $res = $navmap->getBySymb($symb);
11650: foreach my $part (@{$res->parts()}) {
11651: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11652: unless (($slot_status == $res->RESERVED) ||
11653: ($slot_status == $res->RESERVED_LOCATION)) {
11654: $locked_file = 1;
11655: }
1.991 raeburn 11656: }
1.1021 raeburn 11657: } else {
11658: $locked_file = 1;
1.991 raeburn 11659: }
11660: } else {
11661: $locked_file = 1;
11662: }
11663: }
1.1021 raeburn 11664: }
11665: } else {
11666: my @info = split(/\&/,$rest);
11667: my $currsize = $info[6]/1000;
11668: if ($currsize < $filesize) {
11669: my $extra = $filesize - $currsize;
11670: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11671: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11672: &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 11673: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11674: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11675: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11676: return ('will_exceed_quota',$msg);
11677: }
1.984 raeburn 11678: }
11679: }
1.661 raeburn 11680: }
11681: }
11682: }
11683: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11684: my $msg = '<p class="LC_warning">'.
11685: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11686: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11687: return ('will_exceed_quota',$msg);
11688: } elsif ($found_file) {
11689: if ($locked_file) {
1.1179 bisitz 11690: my $msg = '<p class="LC_warning">';
1.661 raeburn 11691: $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 11692: $msg .= '</p>';
1.661 raeburn 11693: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11694: return ('file_locked',$msg);
11695: } else {
1.1179 bisitz 11696: my $msg = '<p class="LC_error">';
1.984 raeburn 11697: $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 11698: $msg .= '</p>';
1.984 raeburn 11699: return ('existingfile',$msg);
1.661 raeburn 11700: }
11701: }
11702: }
11703:
1.987 raeburn 11704: sub check_for_traversal {
11705: my ($path,$url,$toplevel) = @_;
11706: my @parts=split(/\//,$path);
11707: my $cleanpath;
11708: my $fullpath = $url;
11709: for (my $i=0;$i<@parts;$i++) {
11710: next if ($parts[$i] eq '.');
11711: if ($parts[$i] eq '..') {
11712: $fullpath =~ s{([^/]+/)$}{};
11713: } else {
11714: $fullpath .= $parts[$i].'/';
11715: }
11716: }
11717: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11718: $cleanpath = $1;
11719: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11720: my $curr_toprel = $1;
11721: my @parts = split(/\//,$curr_toprel);
11722: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11723: my @urlparts = split(/\//,$url_toprel);
11724: my $doubledots;
11725: my $startdiff = -1;
11726: for (my $i=0; $i<@urlparts; $i++) {
11727: if ($startdiff == -1) {
11728: unless ($urlparts[$i] eq $parts[$i]) {
11729: $startdiff = $i;
11730: $doubledots .= '../';
11731: }
11732: } else {
11733: $doubledots .= '../';
11734: }
11735: }
11736: if ($startdiff > -1) {
11737: $cleanpath = $doubledots;
11738: for (my $i=$startdiff; $i<@parts; $i++) {
11739: $cleanpath .= $parts[$i].'/';
11740: }
11741: }
11742: }
11743: $cleanpath =~ s{(/)$}{};
11744: return $cleanpath;
11745: }
1.31 albertel 11746:
1.1053 raeburn 11747: sub is_archive_file {
11748: my ($mimetype) = @_;
11749: if (($mimetype eq 'application/octet-stream') ||
11750: ($mimetype eq 'application/x-stuffit') ||
11751: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11752: return 1;
11753: }
11754: return;
11755: }
11756:
11757: sub decompress_form {
1.1065 raeburn 11758: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11759: my %lt = &Apache::lonlocal::texthash (
11760: this => 'This file is an archive file.',
1.1067 raeburn 11761: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11762: itsc => 'Its contents are as follows:',
1.1053 raeburn 11763: youm => 'You may wish to extract its contents.',
11764: extr => 'Extract contents',
1.1067 raeburn 11765: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11766: proa => 'Process automatically?',
1.1053 raeburn 11767: yes => 'Yes',
11768: no => 'No',
1.1067 raeburn 11769: fold => 'Title for folder containing movie',
11770: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11771: );
1.1065 raeburn 11772: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11773: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11774: my $info = &list_archive_contents($fileloc,\@paths);
11775: if (@paths) {
11776: foreach my $path (@paths) {
11777: $path =~ s{^/}{};
1.1067 raeburn 11778: if ($path =~ m{^([^/]+)/$}) {
11779: $topdir = $1;
11780: }
1.1065 raeburn 11781: if ($path =~ m{^([^/]+)/}) {
11782: $toplevel{$1} = $path;
11783: } else {
11784: $toplevel{$path} = $path;
11785: }
11786: }
11787: }
1.1067 raeburn 11788: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11789: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11790: "$topdir/media/",
11791: "$topdir/media/$topdir.mp4",
11792: "$topdir/media/FirstFrame.png",
11793: "$topdir/media/player.swf",
11794: "$topdir/media/swfobject.js",
11795: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11796: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11797: "$topdir/$topdir.mp4",
11798: "$topdir/$topdir\_config.xml",
11799: "$topdir/$topdir\_controller.swf",
11800: "$topdir/$topdir\_embed.css",
11801: "$topdir/$topdir\_First_Frame.png",
11802: "$topdir/$topdir\_player.html",
11803: "$topdir/$topdir\_Thumbnails.png",
11804: "$topdir/playerProductInstall.swf",
11805: "$topdir/scripts/",
11806: "$topdir/scripts/config_xml.js",
11807: "$topdir/scripts/handlebars.js",
11808: "$topdir/scripts/jquery-1.7.1.min.js",
11809: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11810: "$topdir/scripts/modernizr.js",
11811: "$topdir/scripts/player-min.js",
11812: "$topdir/scripts/swfobject.js",
11813: "$topdir/skins/",
11814: "$topdir/skins/configuration_express.xml",
11815: "$topdir/skins/express_show/",
11816: "$topdir/skins/express_show/player-min.css",
11817: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11818: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11819: "$topdir/$topdir.mp4",
11820: "$topdir/$topdir\_config.xml",
11821: "$topdir/$topdir\_controller.swf",
11822: "$topdir/$topdir\_embed.css",
11823: "$topdir/$topdir\_First_Frame.png",
11824: "$topdir/$topdir\_player.html",
11825: "$topdir/$topdir\_Thumbnails.png",
11826: "$topdir/playerProductInstall.swf",
11827: "$topdir/scripts/",
11828: "$topdir/scripts/config_xml.js",
11829: "$topdir/scripts/techsmith-smart-player.min.js",
11830: "$topdir/skins/",
11831: "$topdir/skins/configuration_express.xml",
11832: "$topdir/skins/express_show/",
11833: "$topdir/skins/express_show/spritesheet.min.css",
11834: "$topdir/skins/express_show/spritesheet.png",
11835: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11836: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11837: if (@diffs == 0) {
1.1164 raeburn 11838: $is_camtasia = 6;
11839: } else {
1.1197 raeburn 11840: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11841: if (@diffs == 0) {
11842: $is_camtasia = 8;
1.1197 raeburn 11843: } else {
11844: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11845: if (@diffs == 0) {
11846: $is_camtasia = 8;
11847: }
1.1164 raeburn 11848: }
1.1067 raeburn 11849: }
11850: }
11851: my $output;
11852: if ($is_camtasia) {
11853: $output = <<"ENDCAM";
11854: <script type="text/javascript" language="Javascript">
11855: // <![CDATA[
11856:
11857: function camtasiaToggle() {
11858: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11859: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11860: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11861: document.getElementById('camtasia_titles').style.display='block';
11862: } else {
11863: document.getElementById('camtasia_titles').style.display='none';
11864: }
11865: }
11866: }
11867: return;
11868: }
11869:
11870: // ]]>
11871: </script>
11872: <p>$lt{'camt'}</p>
11873: ENDCAM
1.1065 raeburn 11874: } else {
1.1067 raeburn 11875: $output = '<p>'.$lt{'this'};
11876: if ($info eq '') {
11877: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11878: } else {
11879: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11880: '<div><pre>'.$info.'</pre></div>';
11881: }
1.1065 raeburn 11882: }
1.1067 raeburn 11883: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11884: my $duplicates;
11885: my $num = 0;
11886: if (ref($dirlist) eq 'ARRAY') {
11887: foreach my $item (@{$dirlist}) {
11888: if (ref($item) eq 'ARRAY') {
11889: if (exists($toplevel{$item->[0]})) {
11890: $duplicates .=
11891: &start_data_table_row().
11892: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11893: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11894: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11895: 'value="1" />'.&mt('Yes').'</label>'.
11896: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11897: '<td>'.$item->[0].'</td>';
11898: if ($item->[2]) {
11899: $duplicates .= '<td>'.&mt('Directory').'</td>';
11900: } else {
11901: $duplicates .= '<td>'.&mt('File').'</td>';
11902: }
11903: $duplicates .= '<td>'.$item->[3].'</td>'.
11904: '<td>'.
11905: &Apache::lonlocal::locallocaltime($item->[4]).
11906: '</td>'.
11907: &end_data_table_row();
11908: $num ++;
11909: }
11910: }
11911: }
11912: }
11913: my $itemcount;
11914: if (@paths > 0) {
11915: $itemcount = scalar(@paths);
11916: } else {
11917: $itemcount = 1;
11918: }
1.1067 raeburn 11919: if ($is_camtasia) {
11920: $output .= $lt{'auto'}.'<br />'.
11921: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11922: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11923: $lt{'yes'}.'</label> <label>'.
11924: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11925: $lt{'no'}.'</label></span><br />'.
11926: '<div id="camtasia_titles" style="display:block">'.
11927: &Apache::lonhtmlcommon::start_pick_box().
11928: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11929: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11930: &Apache::lonhtmlcommon::row_closure().
11931: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11932: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11933: &Apache::lonhtmlcommon::row_closure(1).
11934: &Apache::lonhtmlcommon::end_pick_box().
11935: '</div>';
11936: }
1.1065 raeburn 11937: $output .=
11938: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11939: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11940: "\n";
1.1065 raeburn 11941: if ($duplicates ne '') {
11942: $output .= '<p><span class="LC_warning">'.
11943: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11944: &start_data_table().
11945: &start_data_table_header_row().
11946: '<th>'.&mt('Overwrite?').'</th>'.
11947: '<th>'.&mt('Name').'</th>'.
11948: '<th>'.&mt('Type').'</th>'.
11949: '<th>'.&mt('Size').'</th>'.
11950: '<th>'.&mt('Last modified').'</th>'.
11951: &end_data_table_header_row().
11952: $duplicates.
11953: &end_data_table().
11954: '</p>';
11955: }
1.1067 raeburn 11956: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11957: if (ref($hiddenelements) eq 'HASH') {
11958: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11959: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11960: }
11961: }
11962: $output .= <<"END";
1.1067 raeburn 11963: <br />
1.1053 raeburn 11964: <input type="submit" name="decompress" value="$lt{'extr'}" />
11965: </form>
11966: $noextract
11967: END
11968: return $output;
11969: }
11970:
1.1065 raeburn 11971: sub decompression_utility {
11972: my ($program) = @_;
11973: my @utilities = ('tar','gunzip','bunzip2','unzip');
11974: my $location;
11975: if (grep(/^\Q$program\E$/,@utilities)) {
11976: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11977: '/usr/sbin/') {
11978: if (-x $dir.$program) {
11979: $location = $dir.$program;
11980: last;
11981: }
11982: }
11983: }
11984: return $location;
11985: }
11986:
11987: sub list_archive_contents {
11988: my ($file,$pathsref) = @_;
11989: my (@cmd,$output);
11990: my $needsregexp;
11991: if ($file =~ /\.zip$/) {
11992: @cmd = (&decompression_utility('unzip'),"-l");
11993: $needsregexp = 1;
11994: } elsif (($file =~ m/\.tar\.gz$/) ||
11995: ($file =~ /\.tgz$/)) {
11996: @cmd = (&decompression_utility('tar'),"-ztf");
11997: } elsif ($file =~ /\.tar\.bz2$/) {
11998: @cmd = (&decompression_utility('tar'),"-jtf");
11999: } elsif ($file =~ m|\.tar$|) {
12000: @cmd = (&decompression_utility('tar'),"-tf");
12001: }
12002: if (@cmd) {
12003: undef($!);
12004: undef($@);
12005: if (open(my $fh,"-|", @cmd, $file)) {
12006: while (my $line = <$fh>) {
12007: $output .= $line;
12008: chomp($line);
12009: my $item;
12010: if ($needsregexp) {
12011: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12012: } else {
12013: $item = $line;
12014: }
12015: if ($item ne '') {
12016: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12017: push(@{$pathsref},$item);
12018: }
12019: }
12020: }
12021: close($fh);
12022: }
12023: }
12024: return $output;
12025: }
12026:
1.1053 raeburn 12027: sub decompress_uploaded_file {
12028: my ($file,$dir) = @_;
12029: &Apache::lonnet::appenv({'cgi.file' => $file});
12030: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12031: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12032: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12033: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12034: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12035: my $decompressed = $env{'cgi.decompressed'};
12036: &Apache::lonnet::delenv('cgi.file');
12037: &Apache::lonnet::delenv('cgi.dir');
12038: &Apache::lonnet::delenv('cgi.decompressed');
12039: return ($decompressed,$result);
12040: }
12041:
1.1055 raeburn 12042: sub process_decompression {
12043: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
12044: my ($dir,$error,$warning,$output);
1.1180 raeburn 12045: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12046: $error = &mt('Filename not a supported archive file type.').
12047: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12048: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12049: } else {
12050: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12051: if ($docuhome eq 'no_host') {
12052: $error = &mt('Could not determine home server for course.');
12053: } else {
12054: my @ids=&Apache::lonnet::current_machine_ids();
12055: my $currdir = "$dir_root/$destination";
12056: if (grep(/^\Q$docuhome\E$/,@ids)) {
12057: $dir = &LONCAPA::propath($docudom,$docuname).
12058: "$dir_root/$destination";
12059: } else {
12060: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12061: "$dir_root/$docudom/$docuname/$destination";
12062: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12063: $error = &mt('Archive file not found.');
12064: }
12065: }
1.1065 raeburn 12066: my (@to_overwrite,@to_skip);
12067: if ($env{'form.archive_overwrite_total'} > 0) {
12068: my $total = $env{'form.archive_overwrite_total'};
12069: for (my $i=0; $i<$total; $i++) {
12070: if ($env{'form.archive_overwrite_'.$i} == 1) {
12071: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12072: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12073: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12074: }
12075: }
12076: }
12077: my $numskip = scalar(@to_skip);
12078: if (($numskip > 0) &&
12079: ($numskip == $env{'form.archive_itemcount'})) {
12080: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12081: } elsif ($dir eq '') {
1.1055 raeburn 12082: $error = &mt('Directory containing archive file unavailable.');
12083: } elsif (!$error) {
1.1065 raeburn 12084: my ($decompressed,$display);
12085: if ($numskip > 0) {
12086: my $tempdir = time.'_'.$$.int(rand(10000));
12087: mkdir("$dir/$tempdir",0755);
12088: system("mv $dir/$file $dir/$tempdir/$file");
12089: ($decompressed,$display) =
12090: &decompress_uploaded_file($file,"$dir/$tempdir");
12091: foreach my $item (@to_skip) {
12092: if (($item ne '') && ($item !~ /\.\./)) {
12093: if (-f "$dir/$tempdir/$item") {
12094: unlink("$dir/$tempdir/$item");
12095: } elsif (-d "$dir/$tempdir/$item") {
12096: system("rm -rf $dir/$tempdir/$item");
12097: }
12098: }
12099: }
12100: system("mv $dir/$tempdir/* $dir");
12101: rmdir("$dir/$tempdir");
12102: } else {
12103: ($decompressed,$display) =
12104: &decompress_uploaded_file($file,$dir);
12105: }
1.1055 raeburn 12106: if ($decompressed eq 'ok') {
1.1065 raeburn 12107: $output = '<p class="LC_info">'.
12108: &mt('Files extracted successfully from archive.').
12109: '</p>'."\n";
1.1055 raeburn 12110: my ($warning,$result,@contents);
12111: my ($newdirlistref,$newlisterror) =
12112: &Apache::lonnet::dirlist($currdir,$docudom,
12113: $docuname,1);
12114: my (%is_dir,%changes,@newitems);
12115: my $dirptr = 16384;
1.1065 raeburn 12116: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12117: foreach my $dir_line (@{$newdirlistref}) {
12118: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 12119: unless (($item =~ /^\.+$/) || ($item eq $file) ||
12120: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 12121: push(@newitems,$item);
12122: if ($dirptr&$testdir) {
12123: $is_dir{$item} = 1;
12124: }
12125: $changes{$item} = 1;
12126: }
12127: }
12128: }
12129: if (keys(%changes) > 0) {
12130: foreach my $item (sort(@newitems)) {
12131: if ($changes{$item}) {
12132: push(@contents,$item);
12133: }
12134: }
12135: }
12136: if (@contents > 0) {
1.1067 raeburn 12137: my $wantform;
12138: unless ($env{'form.autoextract_camtasia'}) {
12139: $wantform = 1;
12140: }
1.1056 raeburn 12141: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12142: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12143: $currdir,\%is_dir,
12144: \%children,\%parent,
1.1056 raeburn 12145: \@contents,\%dirorder,
12146: \%titles,$wantform);
1.1055 raeburn 12147: if ($datatable ne '') {
12148: $output .= &archive_options_form('decompressed',$datatable,
12149: $count,$hiddenelem);
1.1065 raeburn 12150: my $startcount = 6;
1.1055 raeburn 12151: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12152: \%titles,\%children);
1.1055 raeburn 12153: }
1.1067 raeburn 12154: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12155: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12156: my %displayed;
12157: my $total = 1;
12158: $env{'form.archive_directory'} = [];
12159: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12160: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12161: $path =~ s{/$}{};
12162: my $item;
12163: if ($path ne '') {
12164: $item = "$path/$titles{$i}";
12165: } else {
12166: $item = $titles{$i};
12167: }
12168: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12169: if ($item eq $contents[0]) {
12170: push(@{$env{'form.archive_directory'}},$i);
12171: $env{'form.archive_'.$i} = 'display';
12172: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12173: $displayed{'folder'} = $i;
1.1164 raeburn 12174: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12175: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12176: $env{'form.archive_'.$i} = 'display';
12177: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12178: $displayed{'web'} = $i;
12179: } else {
1.1164 raeburn 12180: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12181: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12182: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12183: push(@{$env{'form.archive_directory'}},$i);
12184: }
12185: $env{'form.archive_'.$i} = 'dependency';
12186: }
12187: $total ++;
12188: }
12189: for (my $i=1; $i<$total; $i++) {
12190: next if ($i == $displayed{'web'});
12191: next if ($i == $displayed{'folder'});
12192: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12193: }
12194: $env{'form.phase'} = 'decompress_cleanup';
12195: $env{'form.archivedelete'} = 1;
12196: $env{'form.archive_count'} = $total-1;
12197: $output .=
12198: &process_extracted_files('coursedocs',$docudom,
12199: $docuname,$destination,
12200: $dir_root,$hiddenelem);
12201: }
1.1055 raeburn 12202: } else {
12203: $warning = &mt('No new items extracted from archive file.');
12204: }
12205: } else {
12206: $output = $display;
12207: $error = &mt('An error occurred during extraction from the archive file.');
12208: }
12209: }
12210: }
12211: }
12212: if ($error) {
12213: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12214: $error.'</p>'."\n";
12215: }
12216: if ($warning) {
12217: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12218: }
12219: return $output;
12220: }
12221:
12222: sub get_extracted {
1.1056 raeburn 12223: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12224: $titles,$wantform) = @_;
1.1055 raeburn 12225: my $count = 0;
12226: my $depth = 0;
12227: my $datatable;
1.1056 raeburn 12228: my @hierarchy;
1.1055 raeburn 12229: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12230: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12231: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12232: foreach my $item (@{$contents}) {
12233: $count ++;
1.1056 raeburn 12234: @{$dirorder->{$count}} = @hierarchy;
12235: $titles->{$count} = $item;
1.1055 raeburn 12236: &archive_hierarchy($depth,$count,$parent,$children);
12237: if ($wantform) {
12238: $datatable .= &archive_row($is_dir->{$item},$item,
12239: $currdir,$depth,$count);
12240: }
12241: if ($is_dir->{$item}) {
12242: $depth ++;
1.1056 raeburn 12243: push(@hierarchy,$count);
12244: $parent->{$depth} = $count;
1.1055 raeburn 12245: $datatable .=
12246: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12247: \$depth,\$count,\@hierarchy,$dirorder,
12248: $children,$parent,$titles,$wantform);
1.1055 raeburn 12249: $depth --;
1.1056 raeburn 12250: pop(@hierarchy);
1.1055 raeburn 12251: }
12252: }
12253: return ($count,$datatable);
12254: }
12255:
12256: sub recurse_extracted_archive {
1.1056 raeburn 12257: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12258: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12259: my $result='';
1.1056 raeburn 12260: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12261: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12262: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12263: return $result;
12264: }
12265: my $dirptr = 16384;
12266: my ($newdirlistref,$newlisterror) =
12267: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12268: if (ref($newdirlistref) eq 'ARRAY') {
12269: foreach my $dir_line (@{$newdirlistref}) {
12270: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12271: unless ($item =~ /^\.+$/) {
12272: $$count ++;
1.1056 raeburn 12273: @{$dirorder->{$$count}} = @{$hierarchy};
12274: $titles->{$$count} = $item;
1.1055 raeburn 12275: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12276:
1.1055 raeburn 12277: my $is_dir;
12278: if ($dirptr&$testdir) {
12279: $is_dir = 1;
12280: }
12281: if ($wantform) {
12282: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12283: }
12284: if ($is_dir) {
12285: $$depth ++;
1.1056 raeburn 12286: push(@{$hierarchy},$$count);
12287: $parent->{$$depth} = $$count;
1.1055 raeburn 12288: $result .=
12289: &recurse_extracted_archive("$currdir/$item",$docudom,
12290: $docuname,$depth,$count,
1.1056 raeburn 12291: $hierarchy,$dirorder,$children,
12292: $parent,$titles,$wantform);
1.1055 raeburn 12293: $$depth --;
1.1056 raeburn 12294: pop(@{$hierarchy});
1.1055 raeburn 12295: }
12296: }
12297: }
12298: }
12299: return $result;
12300: }
12301:
12302: sub archive_hierarchy {
12303: my ($depth,$count,$parent,$children) =@_;
12304: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12305: if (exists($parent->{$depth})) {
12306: $children->{$parent->{$depth}} .= $count.':';
12307: }
12308: }
12309: return;
12310: }
12311:
12312: sub archive_row {
12313: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12314: my ($name) = ($item =~ m{([^/]+)$});
12315: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12316: 'display' => 'Add as file',
1.1055 raeburn 12317: 'dependency' => 'Include as dependency',
12318: 'discard' => 'Discard',
12319: );
12320: if ($is_dir) {
1.1059 raeburn 12321: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12322: }
1.1056 raeburn 12323: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12324: my $offset = 0;
1.1055 raeburn 12325: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12326: $offset ++;
1.1065 raeburn 12327: if ($action ne 'display') {
12328: $offset ++;
12329: }
1.1055 raeburn 12330: $output .= '<td><span class="LC_nobreak">'.
12331: '<label><input type="radio" name="archive_'.$count.
12332: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12333: my $text = $choices{$action};
12334: if ($is_dir) {
12335: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12336: if ($action eq 'display') {
1.1059 raeburn 12337: $text = &mt('Add as folder');
1.1055 raeburn 12338: }
1.1056 raeburn 12339: } else {
12340: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12341:
12342: }
12343: $output .= ' /> '.$choices{$action}.'</label></span>';
12344: if ($action eq 'dependency') {
12345: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12346: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12347: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12348: '<option value=""></option>'."\n".
12349: '</select>'."\n".
12350: '</div>';
1.1059 raeburn 12351: } elsif ($action eq 'display') {
12352: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12353: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12354: '</div>';
1.1055 raeburn 12355: }
1.1056 raeburn 12356: $output .= '</td>';
1.1055 raeburn 12357: }
12358: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12359: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12360: for (my $i=0; $i<$depth; $i++) {
12361: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12362: }
12363: if ($is_dir) {
12364: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12365: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12366: } else {
12367: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12368: }
12369: $output .= ' '.$name.'</td>'."\n".
12370: &end_data_table_row();
12371: return $output;
12372: }
12373:
12374: sub archive_options_form {
1.1065 raeburn 12375: my ($form,$display,$count,$hiddenelem) = @_;
12376: my %lt = &Apache::lonlocal::texthash(
12377: perm => 'Permanently remove archive file?',
12378: hows => 'How should each extracted item be incorporated in the course?',
12379: cont => 'Content actions for all',
12380: addf => 'Add as folder/file',
12381: incd => 'Include as dependency for a displayed file',
12382: disc => 'Discard',
12383: no => 'No',
12384: yes => 'Yes',
12385: save => 'Save',
12386: );
12387: my $output = <<"END";
12388: <form name="$form" method="post" action="">
12389: <p><span class="LC_nobreak">$lt{'perm'}
12390: <label>
12391: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12392: </label>
12393:
12394: <label>
12395: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12396: </span>
12397: </p>
12398: <input type="hidden" name="phase" value="decompress_cleanup" />
12399: <br />$lt{'hows'}
12400: <div class="LC_columnSection">
12401: <fieldset>
12402: <legend>$lt{'cont'}</legend>
12403: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12404: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12405: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12406: </fieldset>
12407: </div>
12408: END
12409: return $output.
1.1055 raeburn 12410: &start_data_table()."\n".
1.1065 raeburn 12411: $display."\n".
1.1055 raeburn 12412: &end_data_table()."\n".
12413: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12414: $hiddenelem.
1.1065 raeburn 12415: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12416: '</form>';
12417: }
12418:
12419: sub archive_javascript {
1.1056 raeburn 12420: my ($startcount,$numitems,$titles,$children) = @_;
12421: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12422: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12423: my $scripttag = <<START;
12424: <script type="text/javascript">
12425: // <![CDATA[
12426:
12427: function checkAll(form,prefix) {
12428: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12429: for (var i=0; i < form.elements.length; i++) {
12430: var id = form.elements[i].id;
12431: if ((id != '') && (id != undefined)) {
12432: if (idstr.test(id)) {
12433: if (form.elements[i].type == 'radio') {
12434: form.elements[i].checked = true;
1.1056 raeburn 12435: var nostart = i-$startcount;
1.1059 raeburn 12436: var offset = nostart%7;
12437: var count = (nostart-offset)/7;
1.1056 raeburn 12438: dependencyCheck(form,count,offset);
1.1055 raeburn 12439: }
12440: }
12441: }
12442: }
12443: }
12444:
12445: function propagateCheck(form,count) {
12446: if (count > 0) {
1.1059 raeburn 12447: var startelement = $startcount + ((count-1) * 7);
12448: for (var j=1; j<6; j++) {
12449: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12450: var item = startelement + j;
12451: if (form.elements[item].type == 'radio') {
12452: if (form.elements[item].checked) {
12453: containerCheck(form,count,j);
12454: break;
12455: }
1.1055 raeburn 12456: }
12457: }
12458: }
12459: }
12460: }
12461:
12462: numitems = $numitems
1.1056 raeburn 12463: var titles = new Array(numitems);
12464: var parents = new Array(numitems);
1.1055 raeburn 12465: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12466: parents[i] = new Array;
1.1055 raeburn 12467: }
1.1059 raeburn 12468: var maintitle = '$maintitle';
1.1055 raeburn 12469:
12470: START
12471:
1.1056 raeburn 12472: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12473: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12474: for (my $i=0; $i<@contents; $i ++) {
12475: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12476: }
12477: }
12478:
1.1056 raeburn 12479: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12480: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12481: }
12482:
1.1055 raeburn 12483: $scripttag .= <<END;
12484:
12485: function containerCheck(form,count,offset) {
12486: if (count > 0) {
1.1056 raeburn 12487: dependencyCheck(form,count,offset);
1.1059 raeburn 12488: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12489: form.elements[item].checked = true;
12490: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12491: if (parents[count].length > 0) {
12492: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12493: containerCheck(form,parents[count][j],offset);
12494: }
12495: }
12496: }
12497: }
12498: }
12499:
12500: function dependencyCheck(form,count,offset) {
12501: if (count > 0) {
1.1059 raeburn 12502: var chosen = (offset+$startcount)+7*(count-1);
12503: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12504: var currtype = form.elements[depitem].type;
12505: if (form.elements[chosen].value == 'dependency') {
12506: document.getElementById('arc_depon_'+count).style.display='block';
12507: form.elements[depitem].options.length = 0;
12508: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12509: for (var i=1; i<=numitems; i++) {
12510: if (i == count) {
12511: continue;
12512: }
1.1059 raeburn 12513: var startelement = $startcount + (i-1) * 7;
12514: for (var j=1; j<6; j++) {
12515: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12516: var item = startelement + j;
12517: if (form.elements[item].type == 'radio') {
12518: if (form.elements[item].checked) {
12519: if (form.elements[item].value == 'display') {
12520: var n = form.elements[depitem].options.length;
12521: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12522: }
12523: }
12524: }
12525: }
12526: }
12527: }
12528: } else {
12529: document.getElementById('arc_depon_'+count).style.display='none';
12530: form.elements[depitem].options.length = 0;
12531: form.elements[depitem].options[0] = new Option('Select','',true,true);
12532: }
1.1059 raeburn 12533: titleCheck(form,count,offset);
1.1056 raeburn 12534: }
12535: }
12536:
12537: function propagateSelect(form,count,offset) {
12538: if (count > 0) {
1.1065 raeburn 12539: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12540: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12541: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12542: if (parents[count].length > 0) {
12543: for (var j=0; j<parents[count].length; j++) {
12544: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12545: }
12546: }
12547: }
12548: }
12549: }
1.1056 raeburn 12550:
12551: function containerSelect(form,count,offset,picked) {
12552: if (count > 0) {
1.1065 raeburn 12553: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12554: if (form.elements[item].type == 'radio') {
12555: if (form.elements[item].value == 'dependency') {
12556: if (form.elements[item+1].type == 'select-one') {
12557: for (var i=0; i<form.elements[item+1].options.length; i++) {
12558: if (form.elements[item+1].options[i].value == picked) {
12559: form.elements[item+1].selectedIndex = i;
12560: break;
12561: }
12562: }
12563: }
12564: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12565: if (parents[count].length > 0) {
12566: for (var j=0; j<parents[count].length; j++) {
12567: containerSelect(form,parents[count][j],offset,picked);
12568: }
12569: }
12570: }
12571: }
12572: }
12573: }
12574: }
12575:
1.1059 raeburn 12576: function titleCheck(form,count,offset) {
12577: if (count > 0) {
12578: var chosen = (offset+$startcount)+7*(count-1);
12579: var depitem = $startcount + ((count-1) * 7) + 2;
12580: var currtype = form.elements[depitem].type;
12581: if (form.elements[chosen].value == 'display') {
12582: document.getElementById('arc_title_'+count).style.display='block';
12583: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12584: document.getElementById('archive_title_'+count).value=maintitle;
12585: }
12586: } else {
12587: document.getElementById('arc_title_'+count).style.display='none';
12588: if (currtype == 'text') {
12589: document.getElementById('archive_title_'+count).value='';
12590: }
12591: }
12592: }
12593: return;
12594: }
12595:
1.1055 raeburn 12596: // ]]>
12597: </script>
12598: END
12599: return $scripttag;
12600: }
12601:
12602: sub process_extracted_files {
1.1067 raeburn 12603: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12604: my $numitems = $env{'form.archive_count'};
12605: return unless ($numitems);
12606: my @ids=&Apache::lonnet::current_machine_ids();
12607: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12608: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12609: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12610: if (grep(/^\Q$docuhome\E$/,@ids)) {
12611: $prefix = &LONCAPA::propath($docudom,$docuname);
12612: $pathtocheck = "$dir_root/$destination";
12613: $dir = $dir_root;
12614: $ishome = 1;
12615: } else {
12616: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12617: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12618: $dir = "$dir_root/$docudom/$docuname";
12619: }
12620: my $currdir = "$dir_root/$destination";
12621: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12622: if ($env{'form.folderpath'}) {
12623: my @items = split('&',$env{'form.folderpath'});
12624: $folders{'0'} = $items[-2];
1.1099 raeburn 12625: if ($env{'form.folderpath'} =~ /\:1$/) {
12626: $containers{'0'}='page';
12627: } else {
12628: $containers{'0'}='sequence';
12629: }
1.1055 raeburn 12630: }
12631: my @archdirs = &get_env_multiple('form.archive_directory');
12632: if ($numitems) {
12633: for (my $i=1; $i<=$numitems; $i++) {
12634: my $path = $env{'form.archive_content_'.$i};
12635: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12636: my $item = $1;
12637: $toplevelitems{$item} = $i;
12638: if (grep(/^\Q$i\E$/,@archdirs)) {
12639: $is_dir{$item} = 1;
12640: }
12641: }
12642: }
12643: }
1.1067 raeburn 12644: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12645: if (keys(%toplevelitems) > 0) {
12646: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12647: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12648: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12649: }
1.1066 raeburn 12650: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12651: if ($numitems) {
12652: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 12653: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12654: my $path = $env{'form.archive_content_'.$i};
12655: if ($path =~ /^\Q$pathtocheck\E/) {
12656: if ($env{'form.archive_'.$i} eq 'discard') {
12657: if ($prefix ne '' && $path ne '') {
12658: if (-e $prefix.$path) {
1.1066 raeburn 12659: if ((@archdirs > 0) &&
12660: (grep(/^\Q$i\E$/,@archdirs))) {
12661: $todeletedir{$prefix.$path} = 1;
12662: } else {
12663: $todelete{$prefix.$path} = 1;
12664: }
1.1055 raeburn 12665: }
12666: }
12667: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12668: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12669: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12670: $docstitle = $env{'form.archive_title_'.$i};
12671: if ($docstitle eq '') {
12672: $docstitle = $title;
12673: }
1.1055 raeburn 12674: $outer = 0;
1.1056 raeburn 12675: if (ref($dirorder{$i}) eq 'ARRAY') {
12676: if (@{$dirorder{$i}} > 0) {
12677: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12678: if ($env{'form.archive_'.$item} eq 'display') {
12679: $outer = $item;
12680: last;
12681: }
12682: }
12683: }
12684: }
12685: my ($errtext,$fatal) =
12686: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12687: '/'.$folders{$outer}.'.'.
12688: $containers{$outer});
12689: next if ($fatal);
12690: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12691: if ($context eq 'coursedocs') {
1.1056 raeburn 12692: $mapinner{$i} = time;
1.1055 raeburn 12693: $folders{$i} = 'default_'.$mapinner{$i};
12694: $containers{$i} = 'sequence';
12695: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12696: $folders{$i}.'.'.$containers{$i};
12697: my $newidx = &LONCAPA::map::getresidx();
12698: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12699: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12700: push(@LONCAPA::map::order,$newidx);
12701: my ($outtext,$errtext) =
12702: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12703: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12704: '.'.$containers{$outer},1,1);
1.1056 raeburn 12705: $newseqid{$i} = $newidx;
1.1067 raeburn 12706: unless ($errtext) {
12707: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12708: }
1.1055 raeburn 12709: }
12710: } else {
12711: if ($context eq 'coursedocs') {
12712: my $newidx=&LONCAPA::map::getresidx();
12713: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12714: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12715: $title;
12716: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12717: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12718: }
12719: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12720: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12721: }
12722: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12723: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12724: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12725: unless ($ishome) {
12726: my $fetch = "$newdest{$i}/$title";
12727: $fetch =~ s/^\Q$prefix$dir\E//;
12728: $prompttofetch{$fetch} = 1;
12729: }
1.1055 raeburn 12730: }
12731: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12732: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12733: push(@LONCAPA::map::order, $newidx);
12734: my ($outtext,$errtext)=
12735: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12736: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12737: '.'.$containers{$outer},1,1);
1.1067 raeburn 12738: unless ($errtext) {
12739: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12740: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12741: }
12742: }
1.1055 raeburn 12743: }
12744: }
1.1086 raeburn 12745: }
12746: } else {
12747: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12748: }
12749: }
12750: for (my $i=1; $i<=$numitems; $i++) {
12751: next unless ($env{'form.archive_'.$i} eq 'dependency');
12752: my $path = $env{'form.archive_content_'.$i};
12753: if ($path =~ /^\Q$pathtocheck\E/) {
12754: my ($title) = ($path =~ m{/([^/]+)$});
12755: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12756: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12757: if (ref($dirorder{$i}) eq 'ARRAY') {
12758: my ($itemidx,$fullpath,$relpath);
12759: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12760: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12761: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12762: if ($dirorder{$i}->[$j] eq $container) {
12763: $itemidx = $j;
1.1056 raeburn 12764: }
12765: }
1.1086 raeburn 12766: }
12767: if ($itemidx eq '') {
12768: $itemidx = 0;
12769: }
12770: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12771: if ($mapinner{$referrer{$i}}) {
12772: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12773: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12774: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12775: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12776: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12777: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12778: if (!-e $fullpath) {
12779: mkdir($fullpath,0755);
1.1056 raeburn 12780: }
12781: }
1.1086 raeburn 12782: } else {
12783: last;
1.1056 raeburn 12784: }
1.1086 raeburn 12785: }
12786: }
12787: } elsif ($newdest{$referrer{$i}}) {
12788: $fullpath = $newdest{$referrer{$i}};
12789: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12790: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12791: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12792: last;
12793: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12794: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12795: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12796: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12797: if (!-e $fullpath) {
12798: mkdir($fullpath,0755);
1.1056 raeburn 12799: }
12800: }
1.1086 raeburn 12801: } else {
12802: last;
1.1056 raeburn 12803: }
1.1055 raeburn 12804: }
12805: }
1.1086 raeburn 12806: if ($fullpath ne '') {
12807: if (-e "$prefix$path") {
12808: system("mv $prefix$path $fullpath/$title");
12809: }
12810: if (-e "$fullpath/$title") {
12811: my $showpath;
12812: if ($relpath ne '') {
12813: $showpath = "$relpath/$title";
12814: } else {
12815: $showpath = "/$title";
12816: }
12817: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12818: }
12819: unless ($ishome) {
12820: my $fetch = "$fullpath/$title";
12821: $fetch =~ s/^\Q$prefix$dir\E//;
12822: $prompttofetch{$fetch} = 1;
12823: }
12824: }
1.1055 raeburn 12825: }
1.1086 raeburn 12826: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12827: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12828: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12829: }
12830: } else {
12831: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12832: }
12833: }
12834: if (keys(%todelete)) {
12835: foreach my $key (keys(%todelete)) {
12836: unlink($key);
1.1066 raeburn 12837: }
12838: }
12839: if (keys(%todeletedir)) {
12840: foreach my $key (keys(%todeletedir)) {
12841: rmdir($key);
12842: }
12843: }
12844: foreach my $dir (sort(keys(%is_dir))) {
12845: if (($pathtocheck ne '') && ($dir ne '')) {
12846: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12847: }
12848: }
1.1067 raeburn 12849: if ($result ne '') {
12850: $output .= '<ul>'."\n".
12851: $result."\n".
12852: '</ul>';
12853: }
12854: unless ($ishome) {
12855: my $replicationfail;
12856: foreach my $item (keys(%prompttofetch)) {
12857: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12858: unless ($fetchresult eq 'ok') {
12859: $replicationfail .= '<li>'.$item.'</li>'."\n";
12860: }
12861: }
12862: if ($replicationfail) {
12863: $output .= '<p class="LC_error">'.
12864: &mt('Course home server failed to retrieve:').'<ul>'.
12865: $replicationfail.
12866: '</ul></p>';
12867: }
12868: }
1.1055 raeburn 12869: } else {
12870: $warning = &mt('No items found in archive.');
12871: }
12872: if ($error) {
12873: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12874: $error.'</p>'."\n";
12875: }
12876: if ($warning) {
12877: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12878: }
12879: return $output;
12880: }
12881:
1.1066 raeburn 12882: sub cleanup_empty_dirs {
12883: my ($path) = @_;
12884: if (($path ne '') && (-d $path)) {
12885: if (opendir(my $dirh,$path)) {
12886: my @dircontents = grep(!/^\./,readdir($dirh));
12887: my $numitems = 0;
12888: foreach my $item (@dircontents) {
12889: if (-d "$path/$item") {
1.1111 raeburn 12890: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12891: if (-e "$path/$item") {
12892: $numitems ++;
12893: }
12894: } else {
12895: $numitems ++;
12896: }
12897: }
12898: if ($numitems == 0) {
12899: rmdir($path);
12900: }
12901: closedir($dirh);
12902: }
12903: }
12904: return;
12905: }
12906:
1.41 ng 12907: =pod
1.45 matthew 12908:
1.1162 raeburn 12909: =item * &get_folder_hierarchy()
1.1068 raeburn 12910:
12911: Provides hierarchy of names of folders/sub-folders containing the current
12912: item,
12913:
12914: Inputs: 3
12915: - $navmap - navmaps object
12916:
12917: - $map - url for map (either the trigger itself, or map containing
12918: the resource, which is the trigger).
12919:
12920: - $showitem - 1 => show title for map itself; 0 => do not show.
12921:
12922: Outputs: 1 @pathitems - array of folder/subfolder names.
12923:
12924: =cut
12925:
12926: sub get_folder_hierarchy {
12927: my ($navmap,$map,$showitem) = @_;
12928: my @pathitems;
12929: if (ref($navmap)) {
12930: my $mapres = $navmap->getResourceByUrl($map);
12931: if (ref($mapres)) {
12932: my $pcslist = $mapres->map_hierarchy();
12933: if ($pcslist ne '') {
12934: my @pcs = split(/,/,$pcslist);
12935: foreach my $pc (@pcs) {
12936: if ($pc == 1) {
1.1129 raeburn 12937: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12938: } else {
12939: my $res = $navmap->getByMapPc($pc);
12940: if (ref($res)) {
12941: my $title = $res->compTitle();
12942: $title =~ s/\W+/_/g;
12943: if ($title ne '') {
12944: push(@pathitems,$title);
12945: }
12946: }
12947: }
12948: }
12949: }
1.1071 raeburn 12950: if ($showitem) {
12951: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12952: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12953: } else {
12954: my $maptitle = $mapres->compTitle();
12955: $maptitle =~ s/\W+/_/g;
12956: if ($maptitle ne '') {
12957: push(@pathitems,$maptitle);
12958: }
1.1068 raeburn 12959: }
12960: }
12961: }
12962: }
12963: return @pathitems;
12964: }
12965:
12966: =pod
12967:
1.1015 raeburn 12968: =item * &get_turnedin_filepath()
12969:
12970: Determines path in a user's portfolio file for storage of files uploaded
12971: to a specific essayresponse or dropbox item.
12972:
12973: Inputs: 3 required + 1 optional.
12974: $symb is symb for resource, $uname and $udom are for current user (required).
12975: $caller is optional (can be "submission", if routine is called when storing
12976: an upoaded file when "Submit Answer" button was pressed).
12977:
12978: Returns array containing $path and $multiresp.
12979: $path is path in portfolio. $multiresp is 1 if this resource contains more
12980: than one file upload item. Callers of routine should append partid as a
12981: subdirectory to $path in cases where $multiresp is 1.
12982:
12983: Called by: homework/essayresponse.pm and homework/structuretags.pm
12984:
12985: =cut
12986:
12987: sub get_turnedin_filepath {
12988: my ($symb,$uname,$udom,$caller) = @_;
12989: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12990: my $turnindir;
12991: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12992: $turnindir = $userhash{'turnindir'};
12993: my ($path,$multiresp);
12994: if ($turnindir eq '') {
12995: if ($caller eq 'submission') {
12996: $turnindir = &mt('turned in');
12997: $turnindir =~ s/\W+/_/g;
12998: my %newhash = (
12999: 'turnindir' => $turnindir,
13000: );
13001: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13002: }
13003: }
13004: if ($turnindir ne '') {
13005: $path = '/'.$turnindir.'/';
13006: my ($multipart,$turnin,@pathitems);
13007: my $navmap = Apache::lonnavmaps::navmap->new();
13008: if (defined($navmap)) {
13009: my $mapres = $navmap->getResourceByUrl($map);
13010: if (ref($mapres)) {
13011: my $pcslist = $mapres->map_hierarchy();
13012: if ($pcslist ne '') {
13013: foreach my $pc (split(/,/,$pcslist)) {
13014: my $res = $navmap->getByMapPc($pc);
13015: if (ref($res)) {
13016: my $title = $res->compTitle();
13017: $title =~ s/\W+/_/g;
13018: if ($title ne '') {
1.1149 raeburn 13019: if (($pc > 1) && (length($title) > 12)) {
13020: $title = substr($title,0,12);
13021: }
1.1015 raeburn 13022: push(@pathitems,$title);
13023: }
13024: }
13025: }
13026: }
13027: my $maptitle = $mapres->compTitle();
13028: $maptitle =~ s/\W+/_/g;
13029: if ($maptitle ne '') {
1.1149 raeburn 13030: if (length($maptitle) > 12) {
13031: $maptitle = substr($maptitle,0,12);
13032: }
1.1015 raeburn 13033: push(@pathitems,$maptitle);
13034: }
13035: unless ($env{'request.state'} eq 'construct') {
13036: my $res = $navmap->getBySymb($symb);
13037: if (ref($res)) {
13038: my $partlist = $res->parts();
13039: my $totaluploads = 0;
13040: if (ref($partlist) eq 'ARRAY') {
13041: foreach my $part (@{$partlist}) {
13042: my @types = $res->responseType($part);
13043: my @ids = $res->responseIds($part);
13044: for (my $i=0; $i < scalar(@ids); $i++) {
13045: if ($types[$i] eq 'essay') {
13046: my $partid = $part.'_'.$ids[$i];
13047: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13048: $totaluploads ++;
13049: }
13050: }
13051: }
13052: }
13053: if ($totaluploads > 1) {
13054: $multiresp = 1;
13055: }
13056: }
13057: }
13058: }
13059: } else {
13060: return;
13061: }
13062: } else {
13063: return;
13064: }
13065: my $restitle=&Apache::lonnet::gettitle($symb);
13066: $restitle =~ s/\W+/_/g;
13067: if ($restitle eq '') {
13068: $restitle = ($resurl =~ m{/[^/]+$});
13069: if ($restitle eq '') {
13070: $restitle = time;
13071: }
13072: }
1.1149 raeburn 13073: if (length($restitle) > 12) {
13074: $restitle = substr($restitle,0,12);
13075: }
1.1015 raeburn 13076: push(@pathitems,$restitle);
13077: $path .= join('/',@pathitems);
13078: }
13079: return ($path,$multiresp);
13080: }
13081:
13082: =pod
13083:
1.464 albertel 13084: =back
1.41 ng 13085:
1.112 bowersj2 13086: =head1 CSV Upload/Handling functions
1.38 albertel 13087:
1.41 ng 13088: =over 4
13089:
1.648 raeburn 13090: =item * &upfile_store($r)
1.41 ng 13091:
13092: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13093: needs $env{'form.upfile'}
1.41 ng 13094: returns $datatoken to be put into hidden field
13095:
13096: =cut
1.31 albertel 13097:
13098: sub upfile_store {
13099: my $r=shift;
1.258 albertel 13100: $env{'form.upfile'}=~s/\r/\n/gs;
13101: $env{'form.upfile'}=~s/\f/\n/gs;
13102: $env{'form.upfile'}=~s/\n+/\n/gs;
13103: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13104:
1.258 albertel 13105: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
13106: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 13107: {
1.158 raeburn 13108: my $datafile = $r->dir_config('lonDaemons').
13109: '/tmp/'.$datatoken.'.tmp';
13110: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13111: print $fh $env{'form.upfile'};
1.158 raeburn 13112: close($fh);
13113: }
1.31 albertel 13114: }
13115: return $datatoken;
13116: }
13117:
1.56 matthew 13118: =pod
13119:
1.648 raeburn 13120: =item * &load_tmp_file($r)
1.41 ng 13121:
13122: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 13123: needs $env{'form.datatoken'},
13124: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13125:
13126: =cut
1.31 albertel 13127:
13128: sub load_tmp_file {
13129: my $r=shift;
13130: my @studentdata=();
13131: {
1.158 raeburn 13132: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 13133: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 13134: if ( open(my $fh,"<$studentfile") ) {
13135: @studentdata=<$fh>;
13136: close($fh);
13137: }
1.31 albertel 13138: }
1.258 albertel 13139: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13140: }
13141:
1.56 matthew 13142: =pod
13143:
1.648 raeburn 13144: =item * &upfile_record_sep()
1.41 ng 13145:
13146: Separate uploaded file into records
13147: returns array of records,
1.258 albertel 13148: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13149:
13150: =cut
1.31 albertel 13151:
13152: sub upfile_record_sep {
1.258 albertel 13153: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13154: } else {
1.248 albertel 13155: my @records;
1.258 albertel 13156: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13157: if ($line=~/^\s*$/) { next; }
13158: push(@records,$line);
13159: }
13160: return @records;
1.31 albertel 13161: }
13162: }
13163:
1.56 matthew 13164: =pod
13165:
1.648 raeburn 13166: =item * &record_sep($record)
1.41 ng 13167:
1.258 albertel 13168: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13169:
13170: =cut
13171:
1.263 www 13172: sub takeleft {
13173: my $index=shift;
13174: return substr('0000'.$index,-4,4);
13175: }
13176:
1.31 albertel 13177: sub record_sep {
13178: my $record=shift;
13179: my %components=();
1.258 albertel 13180: if ($env{'form.upfiletype'} eq 'xml') {
13181: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13182: my $i=0;
1.356 albertel 13183: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13184: $field=~s/^(\"|\')//;
13185: $field=~s/(\"|\')$//;
1.263 www 13186: $components{&takeleft($i)}=$field;
1.31 albertel 13187: $i++;
13188: }
1.258 albertel 13189: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13190: my $i=0;
1.356 albertel 13191: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13192: $field=~s/^(\"|\')//;
13193: $field=~s/(\"|\')$//;
1.263 www 13194: $components{&takeleft($i)}=$field;
1.31 albertel 13195: $i++;
13196: }
13197: } else {
1.561 www 13198: my $separator=',';
1.480 banghart 13199: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13200: $separator=';';
1.480 banghart 13201: }
1.31 albertel 13202: my $i=0;
1.561 www 13203: # the character we are looking for to indicate the end of a quote or a record
13204: my $looking_for=$separator;
13205: # do not add the characters to the fields
13206: my $ignore=0;
13207: # we just encountered a separator (or the beginning of the record)
13208: my $just_found_separator=1;
13209: # store the field we are working on here
13210: my $field='';
13211: # work our way through all characters in record
13212: foreach my $character ($record=~/(.)/g) {
13213: if ($character eq $looking_for) {
13214: if ($character ne $separator) {
13215: # Found the end of a quote, again looking for separator
13216: $looking_for=$separator;
13217: $ignore=1;
13218: } else {
13219: # Found a separator, store away what we got
13220: $components{&takeleft($i)}=$field;
13221: $i++;
13222: $just_found_separator=1;
13223: $ignore=0;
13224: $field='';
13225: }
13226: next;
13227: }
13228: # single or double quotation marks after a separator indicate beginning of a quote
13229: # we are now looking for the end of the quote and need to ignore separators
13230: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13231: $looking_for=$character;
13232: next;
13233: }
13234: # ignore would be true after we reached the end of a quote
13235: if ($ignore) { next; }
13236: if (($just_found_separator) && ($character=~/\s/)) { next; }
13237: $field.=$character;
13238: $just_found_separator=0;
1.31 albertel 13239: }
1.561 www 13240: # catch the very last entry, since we never encountered the separator
13241: $components{&takeleft($i)}=$field;
1.31 albertel 13242: }
13243: return %components;
13244: }
13245:
1.144 matthew 13246: ######################################################
13247: ######################################################
13248:
1.56 matthew 13249: =pod
13250:
1.648 raeburn 13251: =item * &upfile_select_html()
1.41 ng 13252:
1.144 matthew 13253: Return HTML code to select a file from the users machine and specify
13254: the file type.
1.41 ng 13255:
13256: =cut
13257:
1.144 matthew 13258: ######################################################
13259: ######################################################
1.31 albertel 13260: sub upfile_select_html {
1.144 matthew 13261: my %Types = (
13262: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13263: semisv => &mt('Semicolon separated values'),
1.144 matthew 13264: space => &mt('Space separated'),
13265: tab => &mt('Tabulator separated'),
13266: # xml => &mt('HTML/XML'),
13267: );
13268: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13269: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13270: foreach my $type (sort(keys(%Types))) {
13271: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13272: }
13273: $Str .= "</select>\n";
13274: return $Str;
1.31 albertel 13275: }
13276:
1.301 albertel 13277: sub get_samples {
13278: my ($records,$toget) = @_;
13279: my @samples=({});
13280: my $got=0;
13281: foreach my $rec (@$records) {
13282: my %temp = &record_sep($rec);
13283: if (! grep(/\S/, values(%temp))) { next; }
13284: if (%temp) {
13285: $samples[$got]=\%temp;
13286: $got++;
13287: if ($got == $toget) { last; }
13288: }
13289: }
13290: return \@samples;
13291: }
13292:
1.144 matthew 13293: ######################################################
13294: ######################################################
13295:
1.56 matthew 13296: =pod
13297:
1.648 raeburn 13298: =item * &csv_print_samples($r,$records)
1.41 ng 13299:
13300: Prints a table of sample values from each column uploaded $r is an
13301: Apache Request ref, $records is an arrayref from
13302: &Apache::loncommon::upfile_record_sep
13303:
13304: =cut
13305:
1.144 matthew 13306: ######################################################
13307: ######################################################
1.31 albertel 13308: sub csv_print_samples {
13309: my ($r,$records) = @_;
1.662 bisitz 13310: my $samples = &get_samples($records,5);
1.301 albertel 13311:
1.594 raeburn 13312: $r->print(&mt('Samples').'<br />'.&start_data_table().
13313: &start_data_table_header_row());
1.356 albertel 13314: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13315: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13316: $r->print(&end_data_table_header_row());
1.301 albertel 13317: foreach my $hash (@$samples) {
1.594 raeburn 13318: $r->print(&start_data_table_row());
1.356 albertel 13319: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13320: $r->print('<td>');
1.356 albertel 13321: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13322: $r->print('</td>');
13323: }
1.594 raeburn 13324: $r->print(&end_data_table_row());
1.31 albertel 13325: }
1.594 raeburn 13326: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13327: }
13328:
1.144 matthew 13329: ######################################################
13330: ######################################################
13331:
1.56 matthew 13332: =pod
13333:
1.648 raeburn 13334: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13335:
13336: Prints a table to create associations between values and table columns.
1.144 matthew 13337:
1.41 ng 13338: $r is an Apache Request ref,
13339: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13340: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13341:
13342: =cut
13343:
1.144 matthew 13344: ######################################################
13345: ######################################################
1.31 albertel 13346: sub csv_print_select_table {
13347: my ($r,$records,$d) = @_;
1.301 albertel 13348: my $i=0;
13349: my $samples = &get_samples($records,1);
1.144 matthew 13350: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13351: &start_data_table().&start_data_table_header_row().
1.144 matthew 13352: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13353: '<th>'.&mt('Column').'</th>'.
13354: &end_data_table_header_row()."\n");
1.356 albertel 13355: foreach my $array_ref (@$d) {
13356: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13357: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13358:
1.875 bisitz 13359: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13360: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13361: $r->print('<option value="none"></option>');
1.356 albertel 13362: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13363: $r->print('<option value="'.$sample.'"'.
13364: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13365: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13366: }
1.594 raeburn 13367: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13368: $i++;
13369: }
1.594 raeburn 13370: $r->print(&end_data_table());
1.31 albertel 13371: $i--;
13372: return $i;
13373: }
1.56 matthew 13374:
1.144 matthew 13375: ######################################################
13376: ######################################################
13377:
1.56 matthew 13378: =pod
1.31 albertel 13379:
1.648 raeburn 13380: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13381:
13382: Prints a table of sample values from the upload and can make associate samples to internal names.
13383:
13384: $r is an Apache Request ref,
13385: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13386: $d is an array of 2 element arrays (internal name, displayed name)
13387:
13388: =cut
13389:
1.144 matthew 13390: ######################################################
13391: ######################################################
1.31 albertel 13392: sub csv_samples_select_table {
13393: my ($r,$records,$d) = @_;
13394: my $i=0;
1.144 matthew 13395: #
1.662 bisitz 13396: my $max_samples = 5;
13397: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13398: $r->print(&start_data_table().
13399: &start_data_table_header_row().'<th>'.
13400: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13401: &end_data_table_header_row());
1.301 albertel 13402:
13403: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13404: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13405: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13406: foreach my $option (@$d) {
13407: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13408: $r->print('<option value="'.$value.'"'.
1.253 albertel 13409: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13410: $display.'</option>');
1.31 albertel 13411: }
13412: $r->print('</select></td><td>');
1.662 bisitz 13413: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13414: if (defined($samples->[$line]{$key})) {
13415: $r->print($samples->[$line]{$key}."<br />\n");
13416: }
13417: }
1.594 raeburn 13418: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13419: $i++;
13420: }
1.594 raeburn 13421: $r->print(&end_data_table());
1.31 albertel 13422: $i--;
13423: return($i);
1.115 matthew 13424: }
13425:
1.144 matthew 13426: ######################################################
13427: ######################################################
13428:
1.115 matthew 13429: =pod
13430:
1.648 raeburn 13431: =item * &clean_excel_name($name)
1.115 matthew 13432:
13433: Returns a replacement for $name which does not contain any illegal characters.
13434:
13435: =cut
13436:
1.144 matthew 13437: ######################################################
13438: ######################################################
1.115 matthew 13439: sub clean_excel_name {
13440: my ($name) = @_;
13441: $name =~ s/[:\*\?\/\\]//g;
13442: if (length($name) > 31) {
13443: $name = substr($name,0,31);
13444: }
13445: return $name;
1.25 albertel 13446: }
1.84 albertel 13447:
1.85 albertel 13448: =pod
13449:
1.648 raeburn 13450: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13451:
13452: Returns either 1 or undef
13453:
13454: 1 if the part is to be hidden, undef if it is to be shown
13455:
13456: Arguments are:
13457:
13458: $id the id of the part to be checked
13459: $symb, optional the symb of the resource to check
13460: $udom, optional the domain of the user to check for
13461: $uname, optional the username of the user to check for
13462:
13463: =cut
1.84 albertel 13464:
13465: sub check_if_partid_hidden {
13466: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13467: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13468: $symb,$udom,$uname);
1.141 albertel 13469: my $truth=1;
13470: #if the string starts with !, then the list is the list to show not hide
13471: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13472: my @hiddenlist=split(/,/,$hiddenparts);
13473: foreach my $checkid (@hiddenlist) {
1.141 albertel 13474: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13475: }
1.141 albertel 13476: return !$truth;
1.84 albertel 13477: }
1.127 matthew 13478:
1.138 matthew 13479:
13480: ############################################################
13481: ############################################################
13482:
13483: =pod
13484:
1.157 matthew 13485: =back
13486:
1.138 matthew 13487: =head1 cgi-bin script and graphing routines
13488:
1.157 matthew 13489: =over 4
13490:
1.648 raeburn 13491: =item * &get_cgi_id()
1.138 matthew 13492:
13493: Inputs: none
13494:
13495: Returns an id which can be used to pass environment variables
13496: to various cgi-bin scripts. These environment variables will
13497: be removed from the users environment after a given time by
13498: the routine &Apache::lonnet::transfer_profile_to_env.
13499:
13500: =cut
13501:
13502: ############################################################
13503: ############################################################
1.152 albertel 13504: my $uniq=0;
1.136 matthew 13505: sub get_cgi_id {
1.154 albertel 13506: $uniq=($uniq+1)%100000;
1.280 albertel 13507: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13508: }
13509:
1.127 matthew 13510: ############################################################
13511: ############################################################
13512:
13513: =pod
13514:
1.648 raeburn 13515: =item * &DrawBarGraph()
1.127 matthew 13516:
1.138 matthew 13517: Facilitates the plotting of data in a (stacked) bar graph.
13518: Puts plot definition data into the users environment in order for
13519: graph.png to plot it. Returns an <img> tag for the plot.
13520: The bars on the plot are labeled '1','2',...,'n'.
13521:
13522: Inputs:
13523:
13524: =over 4
13525:
13526: =item $Title: string, the title of the plot
13527:
13528: =item $xlabel: string, text describing the X-axis of the plot
13529:
13530: =item $ylabel: string, text describing the Y-axis of the plot
13531:
13532: =item $Max: scalar, the maximum Y value to use in the plot
13533: If $Max is < any data point, the graph will not be rendered.
13534:
1.140 matthew 13535: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13536: they are plotted. If undefined, default values will be used.
13537:
1.178 matthew 13538: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13539:
1.138 matthew 13540: =item @Values: An array of array references. Each array reference holds data
13541: to be plotted in a stacked bar chart.
13542:
1.239 matthew 13543: =item If the final element of @Values is a hash reference the key/value
13544: pairs will be added to the graph definition.
13545:
1.138 matthew 13546: =back
13547:
13548: Returns:
13549:
13550: An <img> tag which references graph.png and the appropriate identifying
13551: information for the plot.
13552:
1.127 matthew 13553: =cut
13554:
13555: ############################################################
13556: ############################################################
1.134 matthew 13557: sub DrawBarGraph {
1.178 matthew 13558: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13559: #
13560: if (! defined($colors)) {
13561: $colors = ['#33ff00',
13562: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13563: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13564: ];
13565: }
1.228 matthew 13566: my $extra_settings = {};
13567: if (ref($Values[-1]) eq 'HASH') {
13568: $extra_settings = pop(@Values);
13569: }
1.127 matthew 13570: #
1.136 matthew 13571: my $identifier = &get_cgi_id();
13572: my $id = 'cgi.'.$identifier;
1.129 matthew 13573: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13574: return '';
13575: }
1.225 matthew 13576: #
13577: my @Labels;
13578: if (defined($labels)) {
13579: @Labels = @$labels;
13580: } else {
13581: for (my $i=0;$i<@{$Values[0]};$i++) {
13582: push (@Labels,$i+1);
13583: }
13584: }
13585: #
1.129 matthew 13586: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13587: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13588: my %ValuesHash;
13589: my $NumSets=1;
13590: foreach my $array (@Values) {
13591: next if (! ref($array));
1.136 matthew 13592: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13593: join(',',@$array);
1.129 matthew 13594: }
1.127 matthew 13595: #
1.136 matthew 13596: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13597: if ($NumBars < 3) {
13598: $width = 120+$NumBars*32;
1.220 matthew 13599: $xskip = 1;
1.225 matthew 13600: $bar_width = 30;
13601: } elsif ($NumBars < 5) {
13602: $width = 120+$NumBars*20;
13603: $xskip = 1;
13604: $bar_width = 20;
1.220 matthew 13605: } elsif ($NumBars < 10) {
1.136 matthew 13606: $width = 120+$NumBars*15;
13607: $xskip = 1;
13608: $bar_width = 15;
13609: } elsif ($NumBars <= 25) {
13610: $width = 120+$NumBars*11;
13611: $xskip = 5;
13612: $bar_width = 8;
13613: } elsif ($NumBars <= 50) {
13614: $width = 120+$NumBars*8;
13615: $xskip = 5;
13616: $bar_width = 4;
13617: } else {
13618: $width = 120+$NumBars*8;
13619: $xskip = 5;
13620: $bar_width = 4;
13621: }
13622: #
1.137 matthew 13623: $Max = 1 if ($Max < 1);
13624: if ( int($Max) < $Max ) {
13625: $Max++;
13626: $Max = int($Max);
13627: }
1.127 matthew 13628: $Title = '' if (! defined($Title));
13629: $xlabel = '' if (! defined($xlabel));
13630: $ylabel = '' if (! defined($ylabel));
1.369 www 13631: $ValuesHash{$id.'.title'} = &escape($Title);
13632: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13633: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13634: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13635: $ValuesHash{$id.'.NumBars'} = $NumBars;
13636: $ValuesHash{$id.'.NumSets'} = $NumSets;
13637: $ValuesHash{$id.'.PlotType'} = 'bar';
13638: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13639: $ValuesHash{$id.'.height'} = $height;
13640: $ValuesHash{$id.'.width'} = $width;
13641: $ValuesHash{$id.'.xskip'} = $xskip;
13642: $ValuesHash{$id.'.bar_width'} = $bar_width;
13643: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13644: #
1.228 matthew 13645: # Deal with other parameters
13646: while (my ($key,$value) = each(%$extra_settings)) {
13647: $ValuesHash{$id.'.'.$key} = $value;
13648: }
13649: #
1.646 raeburn 13650: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13651: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13652: }
13653:
13654: ############################################################
13655: ############################################################
13656:
13657: =pod
13658:
1.648 raeburn 13659: =item * &DrawXYGraph()
1.137 matthew 13660:
1.138 matthew 13661: Facilitates the plotting of data in an XY graph.
13662: Puts plot definition data into the users environment in order for
13663: graph.png to plot it. Returns an <img> tag for the plot.
13664:
13665: Inputs:
13666:
13667: =over 4
13668:
13669: =item $Title: string, the title of the plot
13670:
13671: =item $xlabel: string, text describing the X-axis of the plot
13672:
13673: =item $ylabel: string, text describing the Y-axis of the plot
13674:
13675: =item $Max: scalar, the maximum Y value to use in the plot
13676: If $Max is < any data point, the graph will not be rendered.
13677:
13678: =item $colors: Array ref containing the hex color codes for the data to be
13679: plotted in. If undefined, default values will be used.
13680:
13681: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13682:
13683: =item $Ydata: Array ref containing Array refs.
1.185 www 13684: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13685:
13686: =item %Values: hash indicating or overriding any default values which are
13687: passed to graph.png.
13688: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13689:
13690: =back
13691:
13692: Returns:
13693:
13694: An <img> tag which references graph.png and the appropriate identifying
13695: information for the plot.
13696:
1.137 matthew 13697: =cut
13698:
13699: ############################################################
13700: ############################################################
13701: sub DrawXYGraph {
13702: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13703: #
13704: # Create the identifier for the graph
13705: my $identifier = &get_cgi_id();
13706: my $id = 'cgi.'.$identifier;
13707: #
13708: $Title = '' if (! defined($Title));
13709: $xlabel = '' if (! defined($xlabel));
13710: $ylabel = '' if (! defined($ylabel));
13711: my %ValuesHash =
13712: (
1.369 www 13713: $id.'.title' => &escape($Title),
13714: $id.'.xlabel' => &escape($xlabel),
13715: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13716: $id.'.y_max_value'=> $Max,
13717: $id.'.labels' => join(',',@$Xlabels),
13718: $id.'.PlotType' => 'XY',
13719: );
13720: #
13721: if (defined($colors) && ref($colors) eq 'ARRAY') {
13722: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13723: }
13724: #
13725: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13726: return '';
13727: }
13728: my $NumSets=1;
1.138 matthew 13729: foreach my $array (@{$Ydata}){
1.137 matthew 13730: next if (! ref($array));
13731: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13732: }
1.138 matthew 13733: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13734: #
13735: # Deal with other parameters
13736: while (my ($key,$value) = each(%Values)) {
13737: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13738: }
13739: #
1.646 raeburn 13740: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13741: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13742: }
13743:
13744: ############################################################
13745: ############################################################
13746:
13747: =pod
13748:
1.648 raeburn 13749: =item * &DrawXYYGraph()
1.138 matthew 13750:
13751: Facilitates the plotting of data in an XY graph with two Y axes.
13752: Puts plot definition data into the users environment in order for
13753: graph.png to plot it. Returns an <img> tag for the plot.
13754:
13755: Inputs:
13756:
13757: =over 4
13758:
13759: =item $Title: string, the title of the plot
13760:
13761: =item $xlabel: string, text describing the X-axis of the plot
13762:
13763: =item $ylabel: string, text describing the Y-axis of the plot
13764:
13765: =item $colors: Array ref containing the hex color codes for the data to be
13766: plotted in. If undefined, default values will be used.
13767:
13768: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13769:
13770: =item $Ydata1: The first data set
13771:
13772: =item $Min1: The minimum value of the left Y-axis
13773:
13774: =item $Max1: The maximum value of the left Y-axis
13775:
13776: =item $Ydata2: The second data set
13777:
13778: =item $Min2: The minimum value of the right Y-axis
13779:
13780: =item $Max2: The maximum value of the left Y-axis
13781:
13782: =item %Values: hash indicating or overriding any default values which are
13783: passed to graph.png.
13784: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13785:
13786: =back
13787:
13788: Returns:
13789:
13790: An <img> tag which references graph.png and the appropriate identifying
13791: information for the plot.
1.136 matthew 13792:
13793: =cut
13794:
13795: ############################################################
13796: ############################################################
1.137 matthew 13797: sub DrawXYYGraph {
13798: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13799: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13800: #
13801: # Create the identifier for the graph
13802: my $identifier = &get_cgi_id();
13803: my $id = 'cgi.'.$identifier;
13804: #
13805: $Title = '' if (! defined($Title));
13806: $xlabel = '' if (! defined($xlabel));
13807: $ylabel = '' if (! defined($ylabel));
13808: my %ValuesHash =
13809: (
1.369 www 13810: $id.'.title' => &escape($Title),
13811: $id.'.xlabel' => &escape($xlabel),
13812: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13813: $id.'.labels' => join(',',@$Xlabels),
13814: $id.'.PlotType' => 'XY',
13815: $id.'.NumSets' => 2,
1.137 matthew 13816: $id.'.two_axes' => 1,
13817: $id.'.y1_max_value' => $Max1,
13818: $id.'.y1_min_value' => $Min1,
13819: $id.'.y2_max_value' => $Max2,
13820: $id.'.y2_min_value' => $Min2,
1.136 matthew 13821: );
13822: #
1.137 matthew 13823: if (defined($colors) && ref($colors) eq 'ARRAY') {
13824: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13825: }
13826: #
13827: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13828: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13829: return '';
13830: }
13831: my $NumSets=1;
1.137 matthew 13832: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13833: next if (! ref($array));
13834: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13835: }
13836: #
13837: # Deal with other parameters
13838: while (my ($key,$value) = each(%Values)) {
13839: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13840: }
13841: #
1.646 raeburn 13842: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13843: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13844: }
13845:
13846: ############################################################
13847: ############################################################
13848:
13849: =pod
13850:
1.157 matthew 13851: =back
13852:
1.139 matthew 13853: =head1 Statistics helper routines?
13854:
13855: Bad place for them but what the hell.
13856:
1.157 matthew 13857: =over 4
13858:
1.648 raeburn 13859: =item * &chartlink()
1.139 matthew 13860:
13861: Returns a link to the chart for a specific student.
13862:
13863: Inputs:
13864:
13865: =over 4
13866:
13867: =item $linktext: The text of the link
13868:
13869: =item $sname: The students username
13870:
13871: =item $sdomain: The students domain
13872:
13873: =back
13874:
1.157 matthew 13875: =back
13876:
1.139 matthew 13877: =cut
13878:
13879: ############################################################
13880: ############################################################
13881: sub chartlink {
13882: my ($linktext, $sname, $sdomain) = @_;
13883: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13884: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13885: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13886: '">'.$linktext.'</a>';
1.153 matthew 13887: }
13888:
13889: #######################################################
13890: #######################################################
13891:
13892: =pod
13893:
13894: =head1 Course Environment Routines
1.157 matthew 13895:
13896: =over 4
1.153 matthew 13897:
1.648 raeburn 13898: =item * &restore_course_settings()
1.153 matthew 13899:
1.648 raeburn 13900: =item * &store_course_settings()
1.153 matthew 13901:
13902: Restores/Store indicated form parameters from the course environment.
13903: Will not overwrite existing values of the form parameters.
13904:
13905: Inputs:
13906: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13907:
13908: a hash ref describing the data to be stored. For example:
13909:
13910: %Save_Parameters = ('Status' => 'scalar',
13911: 'chartoutputmode' => 'scalar',
13912: 'chartoutputdata' => 'scalar',
13913: 'Section' => 'array',
1.373 raeburn 13914: 'Group' => 'array',
1.153 matthew 13915: 'StudentData' => 'array',
13916: 'Maps' => 'array');
13917:
13918: Returns: both routines return nothing
13919:
1.631 raeburn 13920: =back
13921:
1.153 matthew 13922: =cut
13923:
13924: #######################################################
13925: #######################################################
13926: sub store_course_settings {
1.496 albertel 13927: return &store_settings($env{'request.course.id'},@_);
13928: }
13929:
13930: sub store_settings {
1.153 matthew 13931: # save to the environment
13932: # appenv the same items, just to be safe
1.300 albertel 13933: my $udom = $env{'user.domain'};
13934: my $uname = $env{'user.name'};
1.496 albertel 13935: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13936: my %SaveHash;
13937: my %AppHash;
13938: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13939: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13940: my $envname = 'environment.'.$basename;
1.258 albertel 13941: if (exists($env{'form.'.$setting})) {
1.153 matthew 13942: # Save this value away
13943: if ($type eq 'scalar' &&
1.258 albertel 13944: (! exists($env{$envname}) ||
13945: $env{$envname} ne $env{'form.'.$setting})) {
13946: $SaveHash{$basename} = $env{'form.'.$setting};
13947: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13948: } elsif ($type eq 'array') {
13949: my $stored_form;
1.258 albertel 13950: if (ref($env{'form.'.$setting})) {
1.153 matthew 13951: $stored_form = join(',',
13952: map {
1.369 www 13953: &escape($_);
1.258 albertel 13954: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13955: } else {
13956: $stored_form =
1.369 www 13957: &escape($env{'form.'.$setting});
1.153 matthew 13958: }
13959: # Determine if the array contents are the same.
1.258 albertel 13960: if ($stored_form ne $env{$envname}) {
1.153 matthew 13961: $SaveHash{$basename} = $stored_form;
13962: $AppHash{$envname} = $stored_form;
13963: }
13964: }
13965: }
13966: }
13967: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13968: $udom,$uname);
1.153 matthew 13969: if ($put_result !~ /^(ok|delayed)/) {
13970: &Apache::lonnet::logthis('unable to save form parameters, '.
13971: 'got error:'.$put_result);
13972: }
13973: # Make sure these settings stick around in this session, too
1.646 raeburn 13974: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13975: return;
13976: }
13977:
13978: sub restore_course_settings {
1.499 albertel 13979: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13980: }
13981:
13982: sub restore_settings {
13983: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13984: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13985: next if (exists($env{'form.'.$setting}));
1.496 albertel 13986: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13987: '.'.$setting;
1.258 albertel 13988: if (exists($env{$envname})) {
1.153 matthew 13989: if ($type eq 'scalar') {
1.258 albertel 13990: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13991: } elsif ($type eq 'array') {
1.258 albertel 13992: $env{'form.'.$setting} = [
1.153 matthew 13993: map {
1.369 www 13994: &unescape($_);
1.258 albertel 13995: } split(',',$env{$envname})
1.153 matthew 13996: ];
13997: }
13998: }
13999: }
1.127 matthew 14000: }
14001:
1.618 raeburn 14002: #######################################################
14003: #######################################################
14004:
14005: =pod
14006:
14007: =head1 Domain E-mail Routines
14008:
14009: =over 4
14010:
1.648 raeburn 14011: =item * &build_recipient_list()
1.618 raeburn 14012:
1.1144 raeburn 14013: Build recipient lists for following types of e-mail:
1.766 raeburn 14014: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14015: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14016: module change checking, student/employee ID conflict checks, as
14017: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14018: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14019:
14020: Inputs:
1.619 raeburn 14021: defmail (scalar - email address of default recipient),
1.1144 raeburn 14022: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14023: requestsmail, updatesmail, or idconflictsmail).
14024:
1.619 raeburn 14025: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14026:
1.619 raeburn 14027: origmail (scalar - email address of recipient from loncapa.conf,
14028: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14029:
1.655 raeburn 14030: Returns: comma separated list of addresses to which to send e-mail.
14031:
14032: =back
1.618 raeburn 14033:
14034: =cut
14035:
14036: ############################################################
14037: ############################################################
14038: sub build_recipient_list {
1.619 raeburn 14039: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 14040: my @recipients;
14041: my $otheremails;
14042: my %domconfig =
14043: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
14044: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14045: if (exists($domconfig{'contacts'}{$mailing})) {
14046: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14047: my @contacts = ('adminemail','supportemail');
14048: foreach my $item (@contacts) {
14049: if ($domconfig{'contacts'}{$mailing}{$item}) {
14050: my $addr = $domconfig{'contacts'}{$item};
14051: if (!grep(/^\Q$addr\E$/,@recipients)) {
14052: push(@recipients,$addr);
14053: }
1.619 raeburn 14054: }
1.766 raeburn 14055: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 14056: }
14057: }
1.766 raeburn 14058: } elsif ($origmail ne '') {
14059: push(@recipients,$origmail);
1.618 raeburn 14060: }
1.619 raeburn 14061: } elsif ($origmail ne '') {
14062: push(@recipients,$origmail);
1.618 raeburn 14063: }
1.688 raeburn 14064: if (defined($defmail)) {
14065: if ($defmail ne '') {
14066: push(@recipients,$defmail);
14067: }
1.618 raeburn 14068: }
14069: if ($otheremails) {
1.619 raeburn 14070: my @others;
14071: if ($otheremails =~ /,/) {
14072: @others = split(/,/,$otheremails);
1.618 raeburn 14073: } else {
1.619 raeburn 14074: push(@others,$otheremails);
14075: }
14076: foreach my $addr (@others) {
14077: if (!grep(/^\Q$addr\E$/,@recipients)) {
14078: push(@recipients,$addr);
14079: }
1.618 raeburn 14080: }
14081: }
1.619 raeburn 14082: my $recipientlist = join(',',@recipients);
1.618 raeburn 14083: return $recipientlist;
14084: }
14085:
1.127 matthew 14086: ############################################################
14087: ############################################################
1.154 albertel 14088:
1.655 raeburn 14089: =pod
14090:
1.1224 musolffc 14091: =over 4
14092:
1.1223 musolffc 14093: =item * &mime_email()
14094:
14095: Sends an email with a possible attachment
14096:
14097: Inputs:
14098:
14099: =over 4
14100:
14101: from - Sender's email address
14102:
14103: to - Email address of recipient
14104:
14105: subject - Subject of email
14106:
14107: body - Body of email
14108:
14109: cc_string - Carbon copy email address
14110:
14111: bcc - Blind carbon copy email address
14112:
14113: type - File type of attachment
14114:
14115: attachment_path - Path of file to be attached
14116:
14117: file_name - Name of file to be attached
14118:
14119: attachment_text - The body of an attachment of type "TEXT"
14120:
14121: =back
14122:
14123: =back
14124:
14125: =cut
14126:
14127: ############################################################
14128: ############################################################
14129:
14130: sub mime_email {
14131: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14132: $file_name, $attachment_text) = @_;
14133: my $msg = MIME::Lite->new(
14134: From => $from,
14135: To => $to,
14136: Subject => $subject,
14137: Type =>'TEXT',
14138: Data => $body,
14139: );
14140: if ($cc_string ne '') {
14141: $msg->add("Cc" => $cc_string);
14142: }
14143: if ($bcc ne '') {
14144: $msg->add("Bcc" => $bcc);
14145: }
14146: $msg->attr("content-type" => "text/plain");
14147: $msg->attr("content-type.charset" => "UTF-8");
14148: # Attach file if given
14149: if ($attachment_path) {
14150: unless ($file_name) {
14151: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
14152: }
14153: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
14154: $msg->attach(Type => $type,
14155: Path => $attachment_path,
14156: Filename => $file_name
14157: );
14158: # Otherwise attach text if given
14159: } elsif ($attachment_text) {
14160: $msg->attach(Type => 'TEXT',
14161: Data => $attachment_text);
14162: }
14163: # Send it
14164: $msg->send('sendmail');
14165: }
14166:
14167: ############################################################
14168: ############################################################
14169:
14170: =pod
14171:
1.655 raeburn 14172: =head1 Course Catalog Routines
14173:
14174: =over 4
14175:
14176: =item * &gather_categories()
14177:
14178: Converts category definitions - keys of categories hash stored in
14179: coursecategories in configuration.db on the primary library server in a
14180: domain - to an array. Also generates javascript and idx hash used to
14181: generate Domain Coordinator interface for editing Course Categories.
14182:
14183: Inputs:
1.663 raeburn 14184:
1.655 raeburn 14185: categories (reference to hash of category definitions).
1.663 raeburn 14186:
1.655 raeburn 14187: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14188: categories and subcategories).
1.663 raeburn 14189:
1.655 raeburn 14190: idx (reference to hash of counters used in Domain Coordinator interface for
14191: editing Course Categories).
1.663 raeburn 14192:
1.655 raeburn 14193: jsarray (reference to array of categories used to create Javascript arrays for
14194: Domain Coordinator interface for editing Course Categories).
14195:
14196: Returns: nothing
14197:
14198: Side effects: populates cats, idx and jsarray.
14199:
14200: =cut
14201:
14202: sub gather_categories {
14203: my ($categories,$cats,$idx,$jsarray) = @_;
14204: my %counters;
14205: my $num = 0;
14206: foreach my $item (keys(%{$categories})) {
14207: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14208: if ($container eq '' && $depth == 0) {
14209: $cats->[$depth][$categories->{$item}] = $cat;
14210: } else {
14211: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14212: }
14213: my ($escitem,$tail) = split(/:/,$item,2);
14214: if ($counters{$tail} eq '') {
14215: $counters{$tail} = $num;
14216: $num ++;
14217: }
14218: if (ref($idx) eq 'HASH') {
14219: $idx->{$item} = $counters{$tail};
14220: }
14221: if (ref($jsarray) eq 'ARRAY') {
14222: push(@{$jsarray->[$counters{$tail}]},$item);
14223: }
14224: }
14225: return;
14226: }
14227:
14228: =pod
14229:
14230: =item * &extract_categories()
14231:
14232: Used to generate breadcrumb trails for course categories.
14233:
14234: Inputs:
1.663 raeburn 14235:
1.655 raeburn 14236: categories (reference to hash of category definitions).
1.663 raeburn 14237:
1.655 raeburn 14238: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14239: categories and subcategories).
1.663 raeburn 14240:
1.655 raeburn 14241: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14242:
1.655 raeburn 14243: allitems (reference to hash - key is category key
14244: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14245:
1.655 raeburn 14246: idx (reference to hash of counters used in Domain Coordinator interface for
14247: editing Course Categories).
1.663 raeburn 14248:
1.655 raeburn 14249: jsarray (reference to array of categories used to create Javascript arrays for
14250: Domain Coordinator interface for editing Course Categories).
14251:
1.665 raeburn 14252: subcats (reference to hash of arrays containing all subcategories within each
14253: category, -recursive)
14254:
1.655 raeburn 14255: Returns: nothing
14256:
14257: Side effects: populates trails and allitems hash references.
14258:
14259: =cut
14260:
14261: sub extract_categories {
1.665 raeburn 14262: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 14263: if (ref($categories) eq 'HASH') {
14264: &gather_categories($categories,$cats,$idx,$jsarray);
14265: if (ref($cats->[0]) eq 'ARRAY') {
14266: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14267: my $name = $cats->[0][$i];
14268: my $item = &escape($name).'::0';
14269: my $trailstr;
14270: if ($name eq 'instcode') {
14271: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14272: } elsif ($name eq 'communities') {
14273: $trailstr = &mt('Communities');
1.655 raeburn 14274: } else {
14275: $trailstr = $name;
14276: }
14277: if ($allitems->{$item} eq '') {
14278: push(@{$trails},$trailstr);
14279: $allitems->{$item} = scalar(@{$trails})-1;
14280: }
14281: my @parents = ($name);
14282: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14283: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14284: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14285: if (ref($subcats) eq 'HASH') {
14286: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14287: }
14288: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
14289: }
14290: } else {
14291: if (ref($subcats) eq 'HASH') {
14292: $subcats->{$item} = [];
1.655 raeburn 14293: }
14294: }
14295: }
14296: }
14297: }
14298: return;
14299: }
14300:
14301: =pod
14302:
1.1162 raeburn 14303: =item * &recurse_categories()
1.655 raeburn 14304:
14305: Recursively used to generate breadcrumb trails for course categories.
14306:
14307: Inputs:
1.663 raeburn 14308:
1.655 raeburn 14309: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14310: categories and subcategories).
1.663 raeburn 14311:
1.655 raeburn 14312: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14313:
14314: category (current course category, for which breadcrumb trail is being generated).
14315:
14316: trails (reference to array of breadcrumb trails for each category).
14317:
1.655 raeburn 14318: allitems (reference to hash - key is category key
14319: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14320:
1.655 raeburn 14321: parents (array containing containers directories for current category,
14322: back to top level).
14323:
14324: Returns: nothing
14325:
14326: Side effects: populates trails and allitems hash references
14327:
14328: =cut
14329:
14330: sub recurse_categories {
1.665 raeburn 14331: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14332: my $shallower = $depth - 1;
14333: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14334: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14335: my $name = $cats->[$depth]{$category}[$k];
14336: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14337: my $trailstr = join(' -> ',(@{$parents},$category));
14338: if ($allitems->{$item} eq '') {
14339: push(@{$trails},$trailstr);
14340: $allitems->{$item} = scalar(@{$trails})-1;
14341: }
14342: my $deeper = $depth+1;
14343: push(@{$parents},$category);
1.665 raeburn 14344: if (ref($subcats) eq 'HASH') {
14345: my $subcat = &escape($name).':'.$category.':'.$depth;
14346: for (my $j=@{$parents}; $j>=0; $j--) {
14347: my $higher;
14348: if ($j > 0) {
14349: $higher = &escape($parents->[$j]).':'.
14350: &escape($parents->[$j-1]).':'.$j;
14351: } else {
14352: $higher = &escape($parents->[$j]).'::'.$j;
14353: }
14354: push(@{$subcats->{$higher}},$subcat);
14355: }
14356: }
14357: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14358: $subcats);
1.655 raeburn 14359: pop(@{$parents});
14360: }
14361: } else {
14362: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14363: my $trailstr = join(' -> ',(@{$parents},$category));
14364: if ($allitems->{$item} eq '') {
14365: push(@{$trails},$trailstr);
14366: $allitems->{$item} = scalar(@{$trails})-1;
14367: }
14368: }
14369: return;
14370: }
14371:
1.663 raeburn 14372: =pod
14373:
1.1162 raeburn 14374: =item * &assign_categories_table()
1.663 raeburn 14375:
14376: Create a datatable for display of hierarchical categories in a domain,
14377: with checkboxes to allow a course to be categorized.
14378:
14379: Inputs:
14380:
14381: cathash - reference to hash of categories defined for the domain (from
14382: configuration.db)
14383:
14384: currcat - scalar with an & separated list of categories assigned to a course.
14385:
1.919 raeburn 14386: type - scalar contains course type (Course or Community).
14387:
1.663 raeburn 14388: Returns: $output (markup to be displayed)
14389:
14390: =cut
14391:
14392: sub assign_categories_table {
1.919 raeburn 14393: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14394: my $output;
14395: if (ref($cathash) eq 'HASH') {
14396: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14397: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14398: $maxdepth = scalar(@cats);
14399: if (@cats > 0) {
14400: my $itemcount = 0;
14401: if (ref($cats[0]) eq 'ARRAY') {
14402: my @currcategories;
14403: if ($currcat ne '') {
14404: @currcategories = split('&',$currcat);
14405: }
1.919 raeburn 14406: my $table;
1.663 raeburn 14407: for (my $i=0; $i<@{$cats[0]}; $i++) {
14408: my $parent = $cats[0][$i];
1.919 raeburn 14409: next if ($parent eq 'instcode');
14410: if ($type eq 'Community') {
14411: next unless ($parent eq 'communities');
14412: } else {
14413: next if ($parent eq 'communities');
14414: }
1.663 raeburn 14415: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14416: my $item = &escape($parent).'::0';
14417: my $checked = '';
14418: if (@currcategories > 0) {
14419: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14420: $checked = ' checked="checked"';
1.663 raeburn 14421: }
14422: }
1.919 raeburn 14423: my $parent_title = $parent;
14424: if ($parent eq 'communities') {
14425: $parent_title = &mt('Communities');
14426: }
14427: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14428: '<input type="checkbox" name="usecategory" value="'.
14429: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14430: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14431: my $depth = 1;
14432: push(@path,$parent);
1.919 raeburn 14433: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14434: pop(@path);
1.919 raeburn 14435: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14436: $itemcount ++;
14437: }
1.919 raeburn 14438: if ($itemcount) {
14439: $output = &Apache::loncommon::start_data_table().
14440: $table.
14441: &Apache::loncommon::end_data_table();
14442: }
1.663 raeburn 14443: }
14444: }
14445: }
14446: return $output;
14447: }
14448:
14449: =pod
14450:
1.1162 raeburn 14451: =item * &assign_category_rows()
1.663 raeburn 14452:
14453: Create a datatable row for display of nested categories in a domain,
14454: with checkboxes to allow a course to be categorized,called recursively.
14455:
14456: Inputs:
14457:
14458: itemcount - track row number for alternating colors
14459:
14460: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14461: categories and subcategories.
14462:
14463: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14464:
14465: parent - parent of current category item
14466:
14467: path - Array containing all categories back up through the hierarchy from the
14468: current category to the top level.
14469:
14470: currcategories - reference to array of current categories assigned to the course
14471:
14472: Returns: $output (markup to be displayed).
14473:
14474: =cut
14475:
14476: sub assign_category_rows {
14477: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14478: my ($text,$name,$item,$chgstr);
14479: if (ref($cats) eq 'ARRAY') {
14480: my $maxdepth = scalar(@{$cats});
14481: if (ref($cats->[$depth]) eq 'HASH') {
14482: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14483: my $numchildren = @{$cats->[$depth]{$parent}};
14484: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14485: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14486: for (my $j=0; $j<$numchildren; $j++) {
14487: $name = $cats->[$depth]{$parent}[$j];
14488: $item = &escape($name).':'.&escape($parent).':'.$depth;
14489: my $deeper = $depth+1;
14490: my $checked = '';
14491: if (ref($currcategories) eq 'ARRAY') {
14492: if (@{$currcategories} > 0) {
14493: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14494: $checked = ' checked="checked"';
1.663 raeburn 14495: }
14496: }
14497: }
1.664 raeburn 14498: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14499: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14500: $item.'"'.$checked.' />'.$name.'</label></span>'.
14501: '<input type="hidden" name="catname" value="'.$name.'" />'.
14502: '</td><td>';
1.663 raeburn 14503: if (ref($path) eq 'ARRAY') {
14504: push(@{$path},$name);
14505: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14506: pop(@{$path});
14507: }
14508: $text .= '</td></tr>';
14509: }
14510: $text .= '</table></td>';
14511: }
14512: }
14513: }
14514: return $text;
14515: }
14516:
1.1181 raeburn 14517: =pod
14518:
14519: =back
14520:
14521: =cut
14522:
1.655 raeburn 14523: ############################################################
14524: ############################################################
14525:
14526:
1.443 albertel 14527: sub commit_customrole {
1.664 raeburn 14528: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14529: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14530: ($start?', '.&mt('starting').' '.localtime($start):'').
14531: ($end?', ending '.localtime($end):'').': <b>'.
14532: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14533: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14534: '</b><br />';
14535: return $output;
14536: }
14537:
14538: sub commit_standardrole {
1.1116 raeburn 14539: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14540: my ($output,$logmsg,$linefeed);
14541: if ($context eq 'auto') {
14542: $linefeed = "\n";
14543: } else {
14544: $linefeed = "<br />\n";
14545: }
1.443 albertel 14546: if ($three eq 'st') {
1.541 raeburn 14547: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14548: $one,$two,$sec,$context,$credits);
1.541 raeburn 14549: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14550: ($result eq 'unknown_course') || ($result eq 'refused')) {
14551: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14552: } else {
1.541 raeburn 14553: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14554: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14555: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14556: if ($context eq 'auto') {
14557: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14558: } else {
14559: $output .= '<b>'.$result.'</b>'.$linefeed.
14560: &mt('Add to classlist').': <b>ok</b>';
14561: }
14562: $output .= $linefeed;
1.443 albertel 14563: }
14564: } else {
14565: $output = &mt('Assigning').' '.$three.' in '.$url.
14566: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14567: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14568: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14569: if ($context eq 'auto') {
14570: $output .= $result.$linefeed;
14571: } else {
14572: $output .= '<b>'.$result.'</b>'.$linefeed;
14573: }
1.443 albertel 14574: }
14575: return $output;
14576: }
14577:
14578: sub commit_studentrole {
1.1116 raeburn 14579: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14580: $credits) = @_;
1.626 raeburn 14581: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14582: if ($context eq 'auto') {
14583: $linefeed = "\n";
14584: } else {
14585: $linefeed = '<br />'."\n";
14586: }
1.443 albertel 14587: if (defined($one) && defined($two)) {
14588: my $cid=$one.'_'.$two;
14589: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14590: my $secchange = 0;
14591: my $expire_role_result;
14592: my $modify_section_result;
1.628 raeburn 14593: if ($oldsec ne '-1') {
14594: if ($oldsec ne $sec) {
1.443 albertel 14595: $secchange = 1;
1.628 raeburn 14596: my $now = time;
1.443 albertel 14597: my $uurl='/'.$cid;
14598: $uurl=~s/\_/\//g;
14599: if ($oldsec) {
14600: $uurl.='/'.$oldsec;
14601: }
1.626 raeburn 14602: $oldsecurl = $uurl;
1.628 raeburn 14603: $expire_role_result =
1.652 raeburn 14604: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14605: if ($env{'request.course.sec'} ne '') {
14606: if ($expire_role_result eq 'refused') {
14607: my @roles = ('st');
14608: my @statuses = ('previous');
14609: my @roledoms = ($one);
14610: my $withsec = 1;
14611: my %roleshash =
14612: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14613: \@statuses,\@roles,\@roledoms,$withsec);
14614: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14615: my ($oldstart,$oldend) =
14616: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14617: if ($oldend > 0 && $oldend <= $now) {
14618: $expire_role_result = 'ok';
14619: }
14620: }
14621: }
14622: }
1.443 albertel 14623: $result = $expire_role_result;
14624: }
14625: }
14626: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 14627: $modify_section_result =
14628: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14629: undef,undef,undef,$sec,
14630: $end,$start,'','',$cid,
14631: '',$context,$credits);
1.443 albertel 14632: if ($modify_section_result =~ /^ok/) {
14633: if ($secchange == 1) {
1.628 raeburn 14634: if ($sec eq '') {
14635: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14636: } else {
14637: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14638: }
1.443 albertel 14639: } elsif ($oldsec eq '-1') {
1.628 raeburn 14640: if ($sec eq '') {
14641: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14642: } else {
14643: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14644: }
1.443 albertel 14645: } else {
1.628 raeburn 14646: if ($sec eq '') {
14647: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14648: } else {
14649: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14650: }
1.443 albertel 14651: }
14652: } else {
1.1115 raeburn 14653: if ($secchange) {
1.628 raeburn 14654: $$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;
14655: } else {
14656: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14657: }
1.443 albertel 14658: }
14659: $result = $modify_section_result;
14660: } elsif ($secchange == 1) {
1.628 raeburn 14661: if ($oldsec eq '') {
1.1103 raeburn 14662: $$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 14663: } else {
14664: $$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;
14665: }
1.626 raeburn 14666: if ($expire_role_result eq 'refused') {
14667: my $newsecurl = '/'.$cid;
14668: $newsecurl =~ s/\_/\//g;
14669: if ($sec ne '') {
14670: $newsecurl.='/'.$sec;
14671: }
14672: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14673: if ($sec eq '') {
14674: $$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;
14675: } else {
14676: $$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;
14677: }
14678: }
14679: }
1.443 albertel 14680: }
14681: } else {
1.626 raeburn 14682: $$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 14683: $result = "error: incomplete course id\n";
14684: }
14685: return $result;
14686: }
14687:
1.1108 raeburn 14688: sub show_role_extent {
14689: my ($scope,$context,$role) = @_;
14690: $scope =~ s{^/}{};
14691: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14692: push(@courseroles,'co');
14693: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14694: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14695: $scope =~ s{/}{_};
14696: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14697: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14698: my ($audom,$auname) = split(/\//,$scope);
14699: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14700: &Apache::loncommon::plainname($auname,$audom).'</span>');
14701: } else {
14702: $scope =~ s{/$}{};
14703: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14704: &Apache::lonnet::domain($scope,'description').'</span>');
14705: }
14706: }
14707:
1.443 albertel 14708: ############################################################
14709: ############################################################
14710:
1.566 albertel 14711: sub check_clone {
1.578 raeburn 14712: my ($args,$linefeed) = @_;
1.566 albertel 14713: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14714: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14715: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14716: my $clonemsg;
14717: my $can_clone = 0;
1.944 raeburn 14718: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14719: if ($lctype ne 'community') {
14720: $lctype = 'course';
14721: }
1.566 albertel 14722: if ($clonehome eq 'no_host') {
1.944 raeburn 14723: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14724: $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'});
14725: } else {
14726: $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'});
14727: }
1.566 albertel 14728: } else {
14729: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14730: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14731: if ($clonedesc{'type'} ne 'Community') {
14732: $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'});
14733: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14734: }
14735: }
1.882 raeburn 14736: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14737: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14738: $can_clone = 1;
14739: } else {
1.1221 raeburn 14740: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 14741: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 14742: if ($clonehash{'cloners'} eq '') {
14743: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
14744: if ($domdefs{'canclone'}) {
14745: unless ($domdefs{'canclone'} eq 'none') {
14746: if ($domdefs{'canclone'} eq 'domain') {
14747: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
14748: $can_clone = 1;
14749: }
14750: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14751: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
14752: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
14753: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
14754: $can_clone = 1;
14755: }
14756: }
14757: }
14758: }
1.578 raeburn 14759: } else {
1.1221 raeburn 14760: my @cloners = split(/,/,$clonehash{'cloners'});
14761: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 14762: $can_clone = 1;
1.1221 raeburn 14763: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 14764: $can_clone = 1;
1.1225 raeburn 14765: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14766: $can_clone = 1;
1.1221 raeburn 14767: }
14768: unless ($can_clone) {
1.1225 raeburn 14769: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14770: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 14771: my (%gotdomdefaults,%gotcodedefaults);
14772: foreach my $cloner (@cloners) {
14773: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
14774: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
14775: my (%codedefaults,@code_order);
14776: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
14777: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
14778: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
14779: }
14780: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
14781: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
14782: }
14783: } else {
14784: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
14785: \%codedefaults,
14786: \@code_order);
14787: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
14788: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
14789: }
14790: if (@code_order > 0) {
14791: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
14792: $cloner,$clonehash{'internal.coursecode'},
14793: $args->{'crscode'})) {
14794: $can_clone = 1;
14795: last;
14796: }
14797: }
14798: }
14799: }
14800: }
1.1225 raeburn 14801: }
14802: }
14803: unless ($can_clone) {
14804: my $ccrole = 'cc';
14805: if ($args->{'crstype'} eq 'Community') {
14806: $ccrole = 'co';
14807: }
14808: my %roleshash =
14809: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14810: $args->{'ccdomain'},
14811: 'userroles',['active'],[$ccrole],
14812: [$args->{'clonedomain'}]);
14813: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
14814: $can_clone = 1;
14815: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
14816: $args->{'ccuname'},$args->{'ccdomain'})) {
14817: $can_clone = 1;
1.1221 raeburn 14818: }
14819: }
14820: unless ($can_clone) {
14821: if ($args->{'crstype'} eq 'Community') {
14822: $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 14823: } else {
1.1221 raeburn 14824: $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'});
14825: }
1.566 albertel 14826: }
1.578 raeburn 14827: }
1.566 albertel 14828: }
14829: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14830: }
14831:
1.444 albertel 14832: sub construct_course {
1.1166 raeburn 14833: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14834: my $outcome;
1.541 raeburn 14835: my $linefeed = '<br />'."\n";
14836: if ($context eq 'auto') {
14837: $linefeed = "\n";
14838: }
1.566 albertel 14839:
14840: #
14841: # Are we cloning?
14842: #
14843: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14844: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14845: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14846: if ($context ne 'auto') {
1.578 raeburn 14847: if ($clonemsg ne '') {
14848: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14849: }
1.566 albertel 14850: }
14851: $outcome .= $clonemsg.$linefeed;
14852:
14853: if (!$can_clone) {
14854: return (0,$outcome);
14855: }
14856: }
14857:
1.444 albertel 14858: #
14859: # Open course
14860: #
14861: my $crstype = lc($args->{'crstype'});
14862: my %cenv=();
14863: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14864: $args->{'cdescr'},
14865: $args->{'curl'},
14866: $args->{'course_home'},
14867: $args->{'nonstandard'},
14868: $args->{'crscode'},
14869: $args->{'ccuname'}.':'.
14870: $args->{'ccdomain'},
1.882 raeburn 14871: $args->{'crstype'},
1.885 raeburn 14872: $cnum,$context,$category);
1.444 albertel 14873:
14874: # Note: The testing routines depend on this being output; see
14875: # Utils::Course. This needs to at least be output as a comment
14876: # if anyone ever decides to not show this, and Utils::Course::new
14877: # will need to be suitably modified.
1.541 raeburn 14878: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14879: if ($$courseid =~ /^error:/) {
14880: return (0,$outcome);
14881: }
14882:
1.444 albertel 14883: #
14884: # Check if created correctly
14885: #
1.479 albertel 14886: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14887: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14888: if ($crsuhome eq 'no_host') {
14889: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14890: return (0,$outcome);
14891: }
1.541 raeburn 14892: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14893:
1.444 albertel 14894: #
1.566 albertel 14895: # Do the cloning
14896: #
14897: if ($can_clone && $cloneid) {
14898: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14899: if ($context ne 'auto') {
14900: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14901: }
14902: $outcome .= $clonemsg.$linefeed;
14903: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14904: # Copy all files
1.637 www 14905: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14906: # Restore URL
1.566 albertel 14907: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14908: # Restore title
1.566 albertel 14909: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14910: # Restore creation date, creator and creation context.
14911: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14912: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14913: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14914: # Mark as cloned
1.566 albertel 14915: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14916: # Need to clone grading mode
14917: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14918: $cenv{'grading'}=$newenv{'grading'};
14919: # Do not clone these environment entries
14920: &Apache::lonnet::del('environment',
14921: ['default_enrollment_start_date',
14922: 'default_enrollment_end_date',
14923: 'question.email',
14924: 'policy.email',
14925: 'comment.email',
14926: 'pch.users.denied',
1.725 raeburn 14927: 'plc.users.denied',
14928: 'hidefromcat',
1.1121 raeburn 14929: 'checkforpriv',
1.1166 raeburn 14930: 'categories',
14931: 'internal.uniquecode'],
1.638 www 14932: $$crsudom,$$crsunum);
1.1170 raeburn 14933: if ($args->{'textbook'}) {
14934: $cenv{'internal.textbook'} = $args->{'textbook'};
14935: }
1.444 albertel 14936: }
1.566 albertel 14937:
1.444 albertel 14938: #
14939: # Set environment (will override cloned, if existing)
14940: #
14941: my @sections = ();
14942: my @xlists = ();
14943: if ($args->{'crstype'}) {
14944: $cenv{'type'}=$args->{'crstype'};
14945: }
14946: if ($args->{'crsid'}) {
14947: $cenv{'courseid'}=$args->{'crsid'};
14948: }
14949: if ($args->{'crscode'}) {
14950: $cenv{'internal.coursecode'}=$args->{'crscode'};
14951: }
14952: if ($args->{'crsquota'} ne '') {
14953: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14954: } else {
14955: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14956: }
14957: if ($args->{'ccuname'}) {
14958: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14959: ':'.$args->{'ccdomain'};
14960: } else {
14961: $cenv{'internal.courseowner'} = $args->{'curruser'};
14962: }
1.1116 raeburn 14963: if ($args->{'defaultcredits'}) {
14964: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14965: }
1.444 albertel 14966: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14967: if ($args->{'crssections'}) {
14968: $cenv{'internal.sectionnums'} = '';
14969: if ($args->{'crssections'} =~ m/,/) {
14970: @sections = split/,/,$args->{'crssections'};
14971: } else {
14972: $sections[0] = $args->{'crssections'};
14973: }
14974: if (@sections > 0) {
14975: foreach my $item (@sections) {
14976: my ($sec,$gp) = split/:/,$item;
14977: my $class = $args->{'crscode'}.$sec;
14978: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14979: $cenv{'internal.sectionnums'} .= $item.',';
14980: unless ($addcheck eq 'ok') {
14981: push @badclasses, $class;
14982: }
14983: }
14984: $cenv{'internal.sectionnums'} =~ s/,$//;
14985: }
14986: }
14987: # do not hide course coordinator from staff listing,
14988: # even if privileged
14989: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14990: # add course coordinator's domain to domains to check for privileged users
14991: # if different to course domain
14992: if ($$crsudom ne $args->{'ccdomain'}) {
14993: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14994: }
1.444 albertel 14995: # add crosslistings
14996: if ($args->{'crsxlist'}) {
14997: $cenv{'internal.crosslistings'}='';
14998: if ($args->{'crsxlist'} =~ m/,/) {
14999: @xlists = split/,/,$args->{'crsxlist'};
15000: } else {
15001: $xlists[0] = $args->{'crsxlist'};
15002: }
15003: if (@xlists > 0) {
15004: foreach my $item (@xlists) {
15005: my ($xl,$gp) = split/:/,$item;
15006: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15007: $cenv{'internal.crosslistings'} .= $item.',';
15008: unless ($addcheck eq 'ok') {
15009: push @badclasses, $xl;
15010: }
15011: }
15012: $cenv{'internal.crosslistings'} =~ s/,$//;
15013: }
15014: }
15015: if ($args->{'autoadds'}) {
15016: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15017: }
15018: if ($args->{'autodrops'}) {
15019: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15020: }
15021: # check for notification of enrollment changes
15022: my @notified = ();
15023: if ($args->{'notify_owner'}) {
15024: if ($args->{'ccuname'} ne '') {
15025: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15026: }
15027: }
15028: if ($args->{'notify_dc'}) {
15029: if ($uname ne '') {
1.630 raeburn 15030: push(@notified,$uname.':'.$udom);
1.444 albertel 15031: }
15032: }
15033: if (@notified > 0) {
15034: my $notifylist;
15035: if (@notified > 1) {
15036: $notifylist = join(',',@notified);
15037: } else {
15038: $notifylist = $notified[0];
15039: }
15040: $cenv{'internal.notifylist'} = $notifylist;
15041: }
15042: if (@badclasses > 0) {
15043: my %lt=&Apache::lonlocal::texthash(
15044: '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',
15045: 'dnhr' => 'does not have rights to access enrollment in these classes',
15046: 'adby' => 'as determined by the policies of your institution on access to official classlists'
15047: );
1.541 raeburn 15048: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
15049: ' ('.$lt{'adby'}.')';
15050: if ($context eq 'auto') {
15051: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 15052: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 15053: foreach my $item (@badclasses) {
15054: if ($context eq 'auto') {
15055: $outcome .= " - $item\n";
15056: } else {
15057: $outcome .= "<li>$item</li>\n";
15058: }
15059: }
15060: if ($context eq 'auto') {
15061: $outcome .= $linefeed;
15062: } else {
1.566 albertel 15063: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15064: }
15065: }
1.444 albertel 15066: }
15067: if ($args->{'no_end_date'}) {
15068: $args->{'endaccess'} = 0;
15069: }
15070: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15071: $cenv{'internal.autoend'}=$args->{'enrollend'};
15072: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15073: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15074: if ($args->{'showphotos'}) {
15075: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15076: }
15077: $cenv{'internal.authtype'} = $args->{'authtype'};
15078: $cenv{'internal.autharg'} = $args->{'autharg'};
15079: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15080: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15081: 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');
15082: if ($context eq 'auto') {
15083: $outcome .= $krb_msg;
15084: } else {
1.566 albertel 15085: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15086: }
15087: $outcome .= $linefeed;
1.444 albertel 15088: }
15089: }
15090: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15091: if ($args->{'setpolicy'}) {
15092: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15093: }
15094: if ($args->{'setcontent'}) {
15095: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15096: }
15097: }
15098: if ($args->{'reshome'}) {
15099: $cenv{'reshome'}=$args->{'reshome'}.'/';
15100: $cenv{'reshome'}=~s/\/+$/\//;
15101: }
15102: #
15103: # course has keyed access
15104: #
15105: if ($args->{'setkeys'}) {
15106: $cenv{'keyaccess'}='yes';
15107: }
15108: # if specified, key authority is not course, but user
15109: # only active if keyaccess is yes
15110: if ($args->{'keyauth'}) {
1.487 albertel 15111: my ($user,$domain) = split(':',$args->{'keyauth'});
15112: $user = &LONCAPA::clean_username($user);
15113: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15114: if ($user ne '' && $domain ne '') {
1.487 albertel 15115: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15116: }
15117: }
15118:
1.1166 raeburn 15119: #
1.1167 raeburn 15120: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 15121: #
15122: if ($args->{'uniquecode'}) {
15123: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15124: if ($code) {
15125: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 15126: my %crsinfo =
15127: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15128: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15129: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15130: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15131: }
1.1166 raeburn 15132: if (ref($coderef)) {
15133: $$coderef = $code;
15134: }
15135: }
15136: }
15137:
1.444 albertel 15138: if ($args->{'disresdis'}) {
15139: $cenv{'pch.roles.denied'}='st';
15140: }
15141: if ($args->{'disablechat'}) {
15142: $cenv{'plc.roles.denied'}='st';
15143: }
15144:
15145: # Record we've not yet viewed the Course Initialization Helper for this
15146: # course
15147: $cenv{'course.helper.not.run'} = 1;
15148: #
15149: # Use new Randomseed
15150: #
15151: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15152: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15153: #
15154: # The encryption code and receipt prefix for this course
15155: #
15156: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15157: $cenv{'internal.encpref'}=100+int(9*rand(99));
15158: #
15159: # By default, use standard grading
15160: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15161:
1.541 raeburn 15162: $outcome .= $linefeed.&mt('Setting environment').': '.
15163: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15164: #
15165: # Open all assignments
15166: #
15167: if ($args->{'openall'}) {
15168: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15169: my %storecontent = ($storeunder => time,
15170: $storeunder.'.type' => 'date_start');
15171:
15172: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15173: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15174: }
15175: #
15176: # Set first page
15177: #
15178: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15179: || ($cloneid)) {
1.445 albertel 15180: use LONCAPA::map;
1.444 albertel 15181: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15182:
15183: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15184: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15185:
1.444 albertel 15186: $outcome .= ($fatal?$errtext:'read ok').' - ';
15187: my $title; my $url;
15188: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15189: $title=&mt('Syllabus');
1.444 albertel 15190: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15191: } else {
1.963 raeburn 15192: $title=&mt('Table of Contents');
1.444 albertel 15193: $url='/adm/navmaps';
15194: }
1.445 albertel 15195:
15196: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15197: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15198:
15199: if ($errtext) { $fatal=2; }
1.541 raeburn 15200: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15201: }
1.566 albertel 15202:
1.1237 raeburn 15203: #
15204: # Set params for Placement Tests
15205: #
15206: if ($crstype eq 'Placement') {
15207: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.buttonshide';
15208: my %storecontent = ($storeunder => 'yes',
15209: $storeunder.'.type' => 'string_yesno');
15210: &Apache::lonnet::cput
15211: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
15212: }
15213:
1.566 albertel 15214: return (1,$outcome);
1.444 albertel 15215: }
15216:
1.1166 raeburn 15217: sub make_unique_code {
15218: my ($cdom,$cnum) = @_;
15219: # get lock on uniquecodes db
15220: my $lockhash = {
15221: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15222: ':'.$env{'user.domain'},
15223: };
15224: my $tries = 0;
15225: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15226: my ($code,$error);
15227:
15228: while (($gotlock ne 'ok') && ($tries<3)) {
15229: $tries ++;
15230: sleep 1;
15231: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15232: }
15233: if ($gotlock eq 'ok') {
15234: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15235: my $gotcode;
15236: my $attempts = 0;
15237: while ((!$gotcode) && ($attempts < 100)) {
15238: $code = &generate_code();
15239: if (!exists($currcodes{$code})) {
15240: $gotcode = 1;
15241: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15242: $error = 'nostore';
15243: }
15244: }
15245: $attempts ++;
15246: }
15247: my @del_lock = ($cnum."\0".'uniquecodes');
15248: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15249: } else {
15250: $error = 'nolock';
15251: }
15252: return ($code,$error);
15253: }
15254:
15255: sub generate_code {
15256: my $code;
15257: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15258: for (my $i=0; $i<6; $i++) {
15259: my $lettnum = int (rand 2);
15260: my $item = '';
15261: if ($lettnum) {
15262: $item = $letts[int( rand(18) )];
15263: } else {
15264: $item = 1+int( rand(8) );
15265: }
15266: $code .= $item;
15267: }
15268: return $code;
15269: }
15270:
1.444 albertel 15271: ############################################################
15272: ############################################################
15273:
1.1237 raeburn 15274: # Community, Course and Placement Test
1.378 raeburn 15275: sub course_type {
15276: my ($cid) = @_;
15277: if (!defined($cid)) {
15278: $cid = $env{'request.course.id'};
15279: }
1.404 albertel 15280: if (defined($env{'course.'.$cid.'.type'})) {
15281: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15282: } else {
15283: return 'Course';
1.377 raeburn 15284: }
15285: }
1.156 albertel 15286:
1.406 raeburn 15287: sub group_term {
15288: my $crstype = &course_type();
15289: my %names = (
15290: 'Course' => 'group',
1.865 raeburn 15291: 'Community' => 'group',
1.1237 raeburn 15292: 'Placement' => 'group',
1.406 raeburn 15293: );
15294: return $names{$crstype};
15295: }
15296:
1.902 raeburn 15297: sub course_types {
1.1237 raeburn 15298: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 15299: my %typename = (
15300: official => 'Official course',
15301: unofficial => 'Unofficial course',
15302: community => 'Community',
1.1165 raeburn 15303: textbook => 'Textbook course',
1.1237 raeburn 15304: placement => 'Placement test',
1.902 raeburn 15305: );
15306: return (\@types,\%typename);
15307: }
15308:
1.156 albertel 15309: sub icon {
15310: my ($file)=@_;
1.505 albertel 15311: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15312: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15313: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15314: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15315: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15316: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15317: $curfext.".gif") {
15318: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15319: $curfext.".gif";
15320: }
15321: }
1.249 albertel 15322: return &lonhttpdurl($iconname);
1.154 albertel 15323: }
1.84 albertel 15324:
1.575 albertel 15325: sub lonhttpdurl {
1.692 www 15326: #
15327: # Had been used for "small fry" static images on separate port 8080.
15328: # Modify here if lightweight http functionality desired again.
15329: # Currently eliminated due to increasing firewall issues.
15330: #
1.575 albertel 15331: my ($url)=@_;
1.692 www 15332: return $url;
1.215 albertel 15333: }
15334:
1.213 albertel 15335: sub connection_aborted {
15336: my ($r)=@_;
15337: $r->print(" ");$r->rflush();
15338: my $c = $r->connection;
15339: return $c->aborted();
15340: }
15341:
1.221 foxr 15342: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 15343: # strings as 'strings'.
15344: sub escape_single {
1.221 foxr 15345: my ($input) = @_;
1.223 albertel 15346: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 15347: $input =~ s/\'/\\\'/g; # Esacpe the 's....
15348: return $input;
15349: }
1.223 albertel 15350:
1.222 foxr 15351: # Same as escape_single, but escape's "'s This
15352: # can be used for "strings"
15353: sub escape_double {
15354: my ($input) = @_;
15355: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
15356: $input =~ s/\"/\\\"/g; # Esacpe the "s....
15357: return $input;
15358: }
1.223 albertel 15359:
1.222 foxr 15360: # Escapes the last element of a full URL.
15361: sub escape_url {
15362: my ($url) = @_;
1.238 raeburn 15363: my @urlslices = split(/\//, $url,-1);
1.369 www 15364: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 15365: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 15366: }
1.462 albertel 15367:
1.820 raeburn 15368: sub compare_arrays {
15369: my ($arrayref1,$arrayref2) = @_;
15370: my (@difference,%count);
15371: @difference = ();
15372: %count = ();
15373: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
15374: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
15375: foreach my $element (keys(%count)) {
15376: if ($count{$element} == 1) {
15377: push(@difference,$element);
15378: }
15379: }
15380: }
15381: return @difference;
15382: }
15383:
1.817 bisitz 15384: # -------------------------------------------------------- Initialize user login
1.462 albertel 15385: sub init_user_environment {
1.463 albertel 15386: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 15387: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
15388:
15389: my $public=($username eq 'public' && $domain eq 'public');
15390:
15391: # See if old ID present, if so, remove
15392:
1.1062 raeburn 15393: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 15394: my $now=time;
15395:
15396: if ($public) {
15397: my $max_public=100;
15398: my $oldest;
15399: my $oldest_time=0;
15400: for(my $next=1;$next<=$max_public;$next++) {
15401: if (-e $lonids."/publicuser_$next.id") {
15402: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15403: if ($mtime<$oldest_time || !$oldest_time) {
15404: $oldest_time=$mtime;
15405: $oldest=$next;
15406: }
15407: } else {
15408: $cookie="publicuser_$next";
15409: last;
15410: }
15411: }
15412: if (!$cookie) { $cookie="publicuser_$oldest"; }
15413: } else {
1.463 albertel 15414: # if this isn't a robot, kill any existing non-robot sessions
15415: if (!$args->{'robot'}) {
15416: opendir(DIR,$lonids);
15417: while ($filename=readdir(DIR)) {
15418: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15419: unlink($lonids.'/'.$filename);
15420: }
1.462 albertel 15421: }
1.463 albertel 15422: closedir(DIR);
1.1204 raeburn 15423: # If there is a undeleted lockfile for the user's paste buffer remove it.
15424: my $namespace = 'nohist_courseeditor';
15425: my $lockingkey = 'paste'."\0".'locked_num';
15426: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15427: $domain,$username);
15428: if (exists($lockhash{$lockingkey})) {
15429: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15430: unless ($delresult eq 'ok') {
15431: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15432: }
15433: }
1.462 albertel 15434: }
15435: # Give them a new cookie
1.463 albertel 15436: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15437: : $now.$$.int(rand(10000)));
1.463 albertel 15438: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15439:
15440: # Initialize roles
15441:
1.1062 raeburn 15442: ($userroles,$firstaccenv,$timerintenv) =
15443: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15444: }
15445: # ------------------------------------ Check browser type and MathML capability
15446:
1.1194 raeburn 15447: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15448: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15449:
15450: # ------------------------------------------------------------- Get environment
15451:
15452: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15453: my ($tmp) = keys(%userenv);
15454: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15455: } else {
15456: undef(%userenv);
15457: }
15458: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15459: $form->{'interface'}=$userenv{'interface'};
15460: }
15461: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15462:
15463: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15464: foreach my $option ('interface','localpath','localres') {
15465: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15466: }
15467: # --------------------------------------------------------- Write first profile
15468:
15469: {
15470: my %initial_env =
15471: ("user.name" => $username,
15472: "user.domain" => $domain,
15473: "user.home" => $authhost,
15474: "browser.type" => $clientbrowser,
15475: "browser.version" => $clientversion,
15476: "browser.mathml" => $clientmathml,
15477: "browser.unicode" => $clientunicode,
15478: "browser.os" => $clientos,
1.1137 raeburn 15479: "browser.mobile" => $clientmobile,
1.1141 raeburn 15480: "browser.info" => $clientinfo,
1.1194 raeburn 15481: "browser.osversion" => $clientosversion,
1.462 albertel 15482: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15483: "request.course.fn" => '',
15484: "request.course.uri" => '',
15485: "request.course.sec" => '',
15486: "request.role" => 'cm',
15487: "request.role.adv" => $env{'user.adv'},
15488: "request.host" => $ENV{'REMOTE_ADDR'},);
15489:
15490: if ($form->{'localpath'}) {
15491: $initial_env{"browser.localpath"} = $form->{'localpath'};
15492: $initial_env{"browser.localres"} = $form->{'localres'};
15493: }
15494:
15495: if ($form->{'interface'}) {
15496: $form->{'interface'}=~s/\W//gs;
15497: $initial_env{"browser.interface"} = $form->{'interface'};
15498: $env{'browser.interface'}=$form->{'interface'};
15499: }
15500:
1.1157 raeburn 15501: if ($form->{'iptoken'}) {
15502: my $lonhost = $r->dir_config('lonHostID');
15503: $initial_env{"user.noloadbalance"} = $lonhost;
15504: $env{'user.noloadbalance'} = $lonhost;
15505: }
15506:
1.981 raeburn 15507: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15508: my %domdef;
15509: unless ($domain eq 'public') {
15510: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15511: }
1.980 raeburn 15512:
1.1081 raeburn 15513: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15514: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15515: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15516: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15517: }
15518:
1.1237 raeburn 15519: foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765 raeburn 15520: $userenv{'canrequest.'.$crstype} =
15521: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15522: 'reload','requestcourses',
15523: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15524: }
15525:
1.1092 raeburn 15526: $userenv{'canrequest.author'} =
15527: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15528: 'reload','requestauthor',
15529: \%userenv,\%domdef,\%is_adv);
15530: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15531: $domain,$username);
15532: my $reqstatus = $reqauthor{'author_status'};
15533: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15534: if (ref($reqauthor{'author'}) eq 'HASH') {
15535: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15536: $reqauthor{'author'}{'timestamp'};
15537: }
15538: }
15539:
1.462 albertel 15540: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15541:
1.462 albertel 15542: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15543: &GDBM_WRCREAT(),0640)) {
15544: &_add_to_env(\%disk_env,\%initial_env);
15545: &_add_to_env(\%disk_env,\%userenv,'environment.');
15546: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15547: if (ref($firstaccenv) eq 'HASH') {
15548: &_add_to_env(\%disk_env,$firstaccenv);
15549: }
15550: if (ref($timerintenv) eq 'HASH') {
15551: &_add_to_env(\%disk_env,$timerintenv);
15552: }
1.463 albertel 15553: if (ref($args->{'extra_env'})) {
15554: &_add_to_env(\%disk_env,$args->{'extra_env'});
15555: }
1.462 albertel 15556: untie(%disk_env);
15557: } else {
1.705 tempelho 15558: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15559: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15560: return 'error: '.$!;
15561: }
15562: }
15563: $env{'request.role'}='cm';
15564: $env{'request.role.adv'}=$env{'user.adv'};
15565: $env{'browser.type'}=$clientbrowser;
15566:
15567: return $cookie;
15568:
15569: }
15570:
15571: sub _add_to_env {
15572: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15573: if (ref($env_data) eq 'HASH') {
15574: while (my ($key,$value) = each(%$env_data)) {
15575: $idf->{$prefix.$key} = $value;
15576: $env{$prefix.$key} = $value;
15577: }
1.462 albertel 15578: }
15579: }
15580:
1.685 tempelho 15581: # --- Get the symbolic name of a problem and the url
15582: sub get_symb {
15583: my ($request,$silent) = @_;
1.726 raeburn 15584: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15585: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15586: if ($symb eq '') {
15587: if (!$silent) {
1.1071 raeburn 15588: if (ref($request)) {
15589: $request->print("Unable to handle ambiguous references:$url:.");
15590: }
1.685 tempelho 15591: return ();
15592: }
15593: }
15594: &Apache::lonenc::check_decrypt(\$symb);
15595: return ($symb);
15596: }
15597:
15598: # --------------------------------------------------------------Get annotation
15599:
15600: sub get_annotation {
15601: my ($symb,$enc) = @_;
15602:
15603: my $key = $symb;
15604: if (!$enc) {
15605: $key =
15606: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15607: }
15608: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15609: return $annotation{$key};
15610: }
15611:
15612: sub clean_symb {
1.731 raeburn 15613: my ($symb,$delete_enc) = @_;
1.685 tempelho 15614:
15615: &Apache::lonenc::check_decrypt(\$symb);
15616: my $enc = $env{'request.enc'};
1.731 raeburn 15617: if ($delete_enc) {
1.730 raeburn 15618: delete($env{'request.enc'});
15619: }
1.685 tempelho 15620:
15621: return ($symb,$enc);
15622: }
1.462 albertel 15623:
1.1181 raeburn 15624: ############################################################
15625: ############################################################
15626:
15627: =pod
15628:
15629: =head1 Routines for building display used to search for courses
15630:
15631:
15632: =over 4
15633:
15634: =item * &build_filters()
15635:
15636: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 15637: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15638: and quotacheck.pl
15639:
1.1181 raeburn 15640:
15641: Inputs:
15642:
15643: filterlist - anonymous array of fields to include as potential filters
15644:
15645: crstype - course type
15646:
15647: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15648: to pop-open a course selector (will contain "extra element").
15649:
15650: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15651:
15652: filter - anonymous hash of criteria and their values
15653:
15654: action - form action
15655:
15656: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15657:
1.1182 raeburn 15658: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 15659:
15660: cloneruname - username of owner of new course who wants to clone
15661:
15662: clonerudom - domain of owner of new course who wants to clone
15663:
15664: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15665:
15666: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15667:
15668: codedom - domain
15669:
15670: formname - value of form element named "form".
15671:
15672: fixeddom - domain, if fixed.
15673:
15674: prevphase - value to assign to form element named "phase" when going back to the previous screen
15675:
15676: cnameelement - name of form element in form on opener page which will receive title of selected course
15677:
15678: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15679:
15680: cdomelement - name of form element in form on opener page which will receive domain of selected course
15681:
15682: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15683:
15684: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15685:
15686: clonewarning - warning message about missing information for intended course owner when DC creates a course
15687:
1.1182 raeburn 15688:
1.1181 raeburn 15689: Returns: $output - HTML for display of search criteria, and hidden form elements.
15690:
1.1182 raeburn 15691:
1.1181 raeburn 15692: Side Effects: None
15693:
15694: =cut
15695:
15696: # ---------------------------------------------- search for courses based on last activity etc.
15697:
15698: sub build_filters {
15699: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15700: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15701: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15702: $cnameelement,$cnumelement,$cdomelement,$setroles,
15703: $clonetext,$clonewarning) = @_;
1.1182 raeburn 15704: my ($list,$jscript);
1.1181 raeburn 15705: my $onchange = 'javascript:updateFilters(this)';
15706: my ($domainselectform,$sincefilterform,$createdfilterform,
15707: $ownerdomselectform,$persondomselectform,$instcodeform,
15708: $typeselectform,$instcodetitle);
15709: if ($formname eq '') {
15710: $formname = $caller;
15711: }
15712: foreach my $item (@{$filterlist}) {
15713: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15714: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15715: if ($item eq 'domainfilter') {
15716: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15717: } elsif ($item eq 'coursefilter') {
15718: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15719: } elsif ($item eq 'ownerfilter') {
15720: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15721: } elsif ($item eq 'ownerdomfilter') {
15722: $filter->{'ownerdomfilter'} =
15723: &LONCAPA::clean_domain($filter->{$item});
15724: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15725: 'ownerdomfilter',1);
15726: } elsif ($item eq 'personfilter') {
15727: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15728: } elsif ($item eq 'persondomfilter') {
15729: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15730: 'persondomfilter',1);
15731: } else {
15732: $filter->{$item} =~ s/\W//g;
15733: }
15734: if (!$filter->{$item}) {
15735: $filter->{$item} = '';
15736: }
15737: }
15738: if ($item eq 'domainfilter') {
15739: my $allow_blank = 1;
15740: if ($formname eq 'portform') {
15741: $allow_blank=0;
15742: } elsif ($formname eq 'studentform') {
15743: $allow_blank=0;
15744: }
15745: if ($fixeddom) {
15746: $domainselectform = '<input type="hidden" name="domainfilter"'.
15747: ' value="'.$codedom.'" />'.
15748: &Apache::lonnet::domain($codedom,'description');
15749: } else {
15750: $domainselectform = &select_dom_form($filter->{$item},
15751: 'domainfilter',
15752: $allow_blank,'',$onchange);
15753: }
15754: } else {
15755: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15756: }
15757: }
15758:
15759: # last course activity filter and selection
15760: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15761:
15762: # course created filter and selection
15763: if (exists($filter->{'createdfilter'})) {
15764: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15765: }
15766:
15767: my %lt = &Apache::lonlocal::texthash(
15768: 'cac' => "$crstype Activity",
15769: 'ccr' => "$crstype Created",
15770: 'cde' => "$crstype Title",
15771: 'cdo' => "$crstype Domain",
15772: 'ins' => 'Institutional Code',
15773: 'inc' => 'Institutional Categorization',
15774: 'cow' => "$crstype Owner/Co-owner",
15775: 'cop' => "$crstype Personnel Includes",
15776: 'cog' => 'Type',
15777: );
15778:
15779: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15780: my $typeval = 'Course';
15781: if ($crstype eq 'Community') {
15782: $typeval = 'Community';
15783: }
15784: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15785: } else {
15786: $typeselectform = '<select name="type" size="1"';
15787: if ($onchange) {
15788: $typeselectform .= ' onchange="'.$onchange.'"';
15789: }
15790: $typeselectform .= '>'."\n";
1.1237 raeburn 15791: foreach my $posstype ('Course','Community','Placement') {
1.1181 raeburn 15792: $typeselectform.='<option value="'.$posstype.'"'.
15793: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15794: }
15795: $typeselectform.="</select>";
15796: }
15797:
15798: my ($cloneableonlyform,$cloneabletitle);
15799: if (exists($filter->{'cloneableonly'})) {
15800: my $cloneableon = '';
15801: my $cloneableoff = ' checked="checked"';
15802: if ($filter->{'cloneableonly'}) {
15803: $cloneableon = $cloneableoff;
15804: $cloneableoff = '';
15805: }
15806: $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>';
15807: if ($formname eq 'ccrs') {
1.1187 bisitz 15808: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 15809: } else {
15810: $cloneabletitle = &mt('Cloneable by you');
15811: }
15812: }
15813: my $officialjs;
15814: if ($crstype eq 'Course') {
15815: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 15816: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15817: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15818: if ($codedom) {
1.1181 raeburn 15819: $officialjs = 1;
15820: ($instcodeform,$jscript,$$numtitlesref) =
15821: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15822: $officialjs,$codetitlesref);
15823: if ($jscript) {
1.1182 raeburn 15824: $jscript = '<script type="text/javascript">'."\n".
15825: '// <![CDATA['."\n".
15826: $jscript."\n".
15827: '// ]]>'."\n".
15828: '</script>'."\n";
1.1181 raeburn 15829: }
15830: }
15831: if ($instcodeform eq '') {
15832: $instcodeform =
15833: '<input type="text" name="instcodefilter" size="10" value="'.
15834: $list->{'instcodefilter'}.'" />';
15835: $instcodetitle = $lt{'ins'};
15836: } else {
15837: $instcodetitle = $lt{'inc'};
15838: }
15839: if ($fixeddom) {
15840: $instcodetitle .= '<br />('.$codedom.')';
15841: }
15842: }
15843: }
15844: my $output = qq|
15845: <form method="post" name="filterpicker" action="$action">
15846: <input type="hidden" name="form" value="$formname" />
15847: |;
15848: if ($formname eq 'modifycourse') {
15849: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15850: '<input type="hidden" name="prevphase" value="'.
15851: $prevphase.'" />'."\n";
1.1198 musolffc 15852: } elsif ($formname eq 'quotacheck') {
15853: $output .= qq|
15854: <input type="hidden" name="sortby" value="" />
15855: <input type="hidden" name="sortorder" value="" />
15856: |;
15857: } else {
1.1181 raeburn 15858: my $name_input;
15859: if ($cnameelement ne '') {
15860: $name_input = '<input type="hidden" name="cnameelement" value="'.
15861: $cnameelement.'" />';
15862: }
15863: $output .= qq|
1.1182 raeburn 15864: <input type="hidden" name="cnumelement" value="$cnumelement" />
15865: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15866: $name_input
15867: $roleelement
15868: $multelement
15869: $typeelement
15870: |;
15871: if ($formname eq 'portform') {
15872: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15873: }
15874: }
15875: if ($fixeddom) {
15876: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15877: }
15878: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15879: if ($sincefilterform) {
15880: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15881: .$sincefilterform
15882: .&Apache::lonhtmlcommon::row_closure();
15883: }
15884: if ($createdfilterform) {
15885: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15886: .$createdfilterform
15887: .&Apache::lonhtmlcommon::row_closure();
15888: }
15889: if ($domainselectform) {
15890: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15891: .$domainselectform
15892: .&Apache::lonhtmlcommon::row_closure();
15893: }
15894: if ($typeselectform) {
15895: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15896: $output .= $typeselectform;
15897: } else {
15898: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15899: .$typeselectform
15900: .&Apache::lonhtmlcommon::row_closure();
15901: }
15902: }
15903: if ($instcodeform) {
15904: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15905: .$instcodeform
15906: .&Apache::lonhtmlcommon::row_closure();
15907: }
15908: if (exists($filter->{'ownerfilter'})) {
15909: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15910: '<table><tr><td>'.&mt('Username').'<br />'.
15911: '<input type="text" name="ownerfilter" size="20" value="'.
15912: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15913: $ownerdomselectform.'</td></tr></table>'.
15914: &Apache::lonhtmlcommon::row_closure();
15915: }
15916: if (exists($filter->{'personfilter'})) {
15917: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15918: '<table><tr><td>'.&mt('Username').'<br />'.
15919: '<input type="text" name="personfilter" size="20" value="'.
15920: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15921: $persondomselectform.'</td></tr></table>'.
15922: &Apache::lonhtmlcommon::row_closure();
15923: }
15924: if (exists($filter->{'coursefilter'})) {
15925: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15926: .'<input type="text" name="coursefilter" size="25" value="'
15927: .$list->{'coursefilter'}.'" />'
15928: .&Apache::lonhtmlcommon::row_closure();
15929: }
15930: if ($cloneableonlyform) {
15931: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15932: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15933: }
15934: if (exists($filter->{'descriptfilter'})) {
15935: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15936: .'<input type="text" name="descriptfilter" size="40" value="'
15937: .$list->{'descriptfilter'}.'" />'
15938: .&Apache::lonhtmlcommon::row_closure(1);
15939: }
15940: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15941: '<input type="hidden" name="updater" value="" />'."\n".
15942: '<input type="submit" name="gosearch" value="'.
15943: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15944: return $jscript.$clonewarning.$output;
15945: }
15946:
15947: =pod
15948:
15949: =item * &timebased_select_form()
15950:
1.1182 raeburn 15951: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15952: filter e.g., Course Activity, Course Created, when searching for courses
15953: or communities
15954:
15955: Inputs:
15956:
15957: item - name of form element (sincefilter or createdfilter)
15958:
15959: filter - anonymous hash of criteria and their values
15960:
15961: Returns: HTML for a select box contained a blank, then six time selections,
15962: with value set in incoming form variables currently selected.
15963:
15964: Side Effects: None
15965:
15966: =cut
15967:
15968: sub timebased_select_form {
15969: my ($item,$filter) = @_;
15970: if (ref($filter) eq 'HASH') {
15971: $filter->{$item} =~ s/[^\d-]//g;
15972: if (!$filter->{$item}) { $filter->{$item}=-1; }
15973: return &select_form(
15974: $filter->{$item},
15975: $item,
15976: { '-1' => '',
15977: '86400' => &mt('today'),
15978: '604800' => &mt('last week'),
15979: '2592000' => &mt('last month'),
15980: '7776000' => &mt('last three months'),
15981: '15552000' => &mt('last six months'),
15982: '31104000' => &mt('last year'),
15983: 'select_form_order' =>
15984: ['-1','86400','604800','2592000','7776000',
15985: '15552000','31104000']});
15986: }
15987: }
15988:
15989: =pod
15990:
15991: =item * &js_changer()
15992:
15993: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15994: when course type or domain is changed, and also to hide 'Searching ...' on
15995: page load completion for page showing search result.
1.1181 raeburn 15996:
15997: Inputs: None
15998:
1.1183 raeburn 15999: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16000:
16001: Side Effects: None
16002:
16003: =cut
16004:
16005: sub js_changer {
16006: return <<ENDJS;
16007: <script type="text/javascript">
16008: // <![CDATA[
16009: function updateFilters(caller) {
16010: if (typeof(caller) != "undefined") {
16011: document.filterpicker.updater.value = caller.name;
16012: }
16013: document.filterpicker.submit();
16014: }
1.1183 raeburn 16015:
16016: function hideSearching() {
16017: if (document.getElementById('searching')) {
16018: document.getElementById('searching').style.display = 'none';
16019: }
16020: return;
16021: }
16022:
1.1181 raeburn 16023: // ]]>
16024: </script>
16025:
16026: ENDJS
16027: }
16028:
16029: =pod
16030:
1.1182 raeburn 16031: =item * &search_courses()
16032:
16033: Process selected filters form course search form and pass to lonnet::courseiddump
16034: to retrieve a hash for which keys are courseIDs which match the selected filters.
16035:
16036: Inputs:
16037:
16038: dom - domain being searched
16039:
16040: type - course type ('Course' or 'Community' or '.' if any).
16041:
16042: filter - anonymous hash of criteria and their values
16043:
16044: numtitles - for institutional codes - number of categories
16045:
16046: cloneruname - optional username of new course owner
16047:
16048: clonerudom - optional domain of new course owner
16049:
1.1221 raeburn 16050: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 16051: (used when DC is using course creation form)
16052:
16053: codetitles - reference to array of titles of components in institutional codes (official courses).
16054:
1.1221 raeburn 16055: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16056: (and so can clone automatically)
16057:
16058: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16059:
16060: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16061: courses to clone
1.1182 raeburn 16062:
16063: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16064:
16065:
16066: Side Effects: None
16067:
16068: =cut
16069:
16070:
16071: sub search_courses {
1.1221 raeburn 16072: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16073: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 16074: my (%courses,%showcourses,$cloner);
16075: if (($filter->{'ownerfilter'} ne '') ||
16076: ($filter->{'ownerdomfilter'} ne '')) {
16077: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16078: $filter->{'ownerdomfilter'};
16079: }
16080: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16081: if (!$filter->{$item}) {
16082: $filter->{$item}='.';
16083: }
16084: }
16085: my $now = time;
16086: my $timefilter =
16087: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16088: my ($createdbefore,$createdafter);
16089: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16090: $createdbefore = $now;
16091: $createdafter = $now-$filter->{'createdfilter'};
16092: }
16093: my ($instcodefilter,$regexpok);
16094: if ($numtitles) {
16095: if ($env{'form.official'} eq 'on') {
16096: $instcodefilter =
16097: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16098: $regexpok = 1;
16099: } elsif ($env{'form.official'} eq 'off') {
16100: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16101: unless ($instcodefilter eq '') {
16102: $regexpok = -1;
16103: }
16104: }
16105: } else {
16106: $instcodefilter = $filter->{'instcodefilter'};
16107: }
16108: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16109: if ($type eq '') { $type = '.'; }
16110:
16111: if (($clonerudom ne '') && ($cloneruname ne '')) {
16112: $cloner = $cloneruname.':'.$clonerudom;
16113: }
16114: %courses = &Apache::lonnet::courseiddump($dom,
16115: $filter->{'descriptfilter'},
16116: $timefilter,
16117: $instcodefilter,
16118: $filter->{'combownerfilter'},
16119: $filter->{'coursefilter'},
16120: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 16121: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 16122: $filter->{'cloneableonly'},
16123: $createdbefore,$createdafter,undef,
1.1221 raeburn 16124: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 16125: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16126: my $ccrole;
16127: if ($type eq 'Community') {
16128: $ccrole = 'co';
16129: } else {
16130: $ccrole = 'cc';
16131: }
16132: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16133: $filter->{'persondomfilter'},
16134: 'userroles',undef,
16135: [$ccrole,'in','ad','ep','ta','cr'],
16136: $dom);
16137: foreach my $role (keys(%rolehash)) {
16138: my ($cnum,$cdom,$courserole) = split(':',$role);
16139: my $cid = $cdom.'_'.$cnum;
16140: if (exists($courses{$cid})) {
16141: if (ref($courses{$cid}) eq 'HASH') {
16142: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16143: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
16144: push (@{$courses{$cid}{roles}},$courserole);
16145: }
16146: } else {
16147: $courses{$cid}{roles} = [$courserole];
16148: }
16149: $showcourses{$cid} = $courses{$cid};
16150: }
16151: }
16152: }
16153: %courses = %showcourses;
16154: }
16155: return %courses;
16156: }
16157:
16158: =pod
16159:
1.1181 raeburn 16160: =back
16161:
1.1207 raeburn 16162: =head1 Routines for version requirements for current course.
16163:
16164: =over 4
16165:
16166: =item * &check_release_required()
16167:
16168: Compares required LON-CAPA version with version on server, and
16169: if required version is newer looks for a server with the required version.
16170:
16171: Looks first at servers in user's owen domain; if none suitable, looks at
16172: servers in course's domain are permitted to host sessions for user's domain.
16173:
16174: Inputs:
16175:
16176: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16177:
16178: $courseid - Course ID of current course
16179:
16180: $rolecode - User's current role in course (for switchserver query string).
16181:
16182: $required - LON-CAPA version needed by course (format: Major.Minor).
16183:
16184:
16185: Returns:
16186:
16187: $switchserver - query string tp append to /adm/switchserver call (if
16188: current server's LON-CAPA version is too old.
16189:
16190: $warning - Message is displayed if no suitable server could be found.
16191:
16192: =cut
16193:
16194: sub check_release_required {
16195: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16196: my ($switchserver,$warning);
16197: if ($required ne '') {
16198: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16199: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16200: if ($reqdmajor ne '' && $reqdminor ne '') {
16201: my $otherserver;
16202: if (($major eq '' && $minor eq '') ||
16203: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16204: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16205: my $switchlcrev =
16206: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16207: $userdomserver);
16208: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16209: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16210: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16211: my $cdom = $env{'course.'.$courseid.'.domain'};
16212: if ($cdom ne $env{'user.domain'}) {
16213: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16214: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16215: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16216: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16217: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16218: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16219: my $canhost =
16220: &Apache::lonnet::can_host_session($env{'user.domain'},
16221: $coursedomserver,
16222: $remoterev,
16223: $udomdefaults{'remotesessions'},
16224: $defdomdefaults{'hostedsessions'});
16225:
16226: if ($canhost) {
16227: $otherserver = $coursedomserver;
16228: } else {
16229: $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.");
16230: }
16231: } else {
16232: $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).");
16233: }
16234: } else {
16235: $otherserver = $userdomserver;
16236: }
16237: }
16238: if ($otherserver ne '') {
16239: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16240: }
16241: }
16242: }
16243: return ($switchserver,$warning);
16244: }
16245:
16246: =pod
16247:
16248: =item * &check_release_result()
16249:
16250: Inputs:
16251:
16252: $switchwarning - Warning message if no suitable server found to host session.
16253:
16254: $switchserver - query string to append to /adm/switchserver containing lonHostID
16255: and current role.
16256:
16257: Returns: HTML to display with information about requirement to switch server.
16258: Either displaying warning with link to Roles/Courses screen or
16259: display link to switchserver.
16260:
1.1181 raeburn 16261: =cut
16262:
1.1207 raeburn 16263: sub check_release_result {
16264: my ($switchwarning,$switchserver) = @_;
16265: my $output = &start_page('Selected course unavailable on this server').
16266: '<p class="LC_warning">';
16267: if ($switchwarning) {
16268: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16269: if (&show_course()) {
16270: $output .= &mt('Display courses');
16271: } else {
16272: $output .= &mt('Display roles');
16273: }
16274: $output .= '</a>';
16275: } elsif ($switchserver) {
16276: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
16277: '<br />'.
16278: '<a href="/adm/switchserver?'.$switchserver.'">'.
16279: &mt('Switch Server').
16280: '</a>';
16281: }
16282: $output .= '</p>'.&end_page();
16283: return $output;
16284: }
16285:
16286: =pod
16287:
16288: =item * &needs_coursereinit()
16289:
16290: Determine if course contents stored for user's session needs to be
16291: refreshed, because content has changed since "Big Hash" last tied.
16292:
16293: Check for change is made if time last checked is more than 10 minutes ago
16294: (by default).
16295:
16296: Inputs:
16297:
16298: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16299:
16300: $interval (optional) - Time which may elapse (in s) between last check for content
16301: change in current course. (default: 600 s).
16302:
16303: Returns: an array; first element is:
16304:
16305: =over 4
16306:
16307: 'switch' - if content updates mean user's session
16308: needs to be switched to a server running a newer LON-CAPA version
16309:
16310: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
16311: on current server hosting user's session
16312:
16313: '' - if no action required.
16314:
16315: =back
16316:
16317: If first item element is 'switch':
16318:
16319: second item is $switchwarning - Warning message if no suitable server found to host session.
16320:
16321: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
16322: and current role.
16323:
16324: otherwise: no other elements returned.
16325:
16326: =back
16327:
16328: =cut
16329:
16330: sub needs_coursereinit {
16331: my ($loncaparev,$interval) = @_;
16332: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
16333: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
16334: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
16335: my $now = time;
16336: if ($interval eq '') {
16337: $interval = 600;
16338: }
16339: if (($now-$env{'request.course.timechecked'})>$interval) {
16340: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
16341: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
16342: if ($lastchange > $env{'request.course.tied'}) {
16343: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16344: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
16345: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
16346: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
16347: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
16348: $curr_reqd_hash{'internal.releaserequired'}});
16349: my ($switchserver,$switchwarning) =
16350: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
16351: $curr_reqd_hash{'internal.releaserequired'});
16352: if ($switchwarning ne '' || $switchserver ne '') {
16353: return ('switch',$switchwarning,$switchserver);
16354: }
16355: }
16356: }
16357: return ('update');
16358: }
16359: }
16360: return ();
16361: }
1.1181 raeburn 16362:
1.1083 raeburn 16363: sub update_content_constraints {
16364: my ($cdom,$cnum,$chome,$cid) = @_;
16365: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16366: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
16367: my %checkresponsetypes;
16368: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 16369: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 16370: if ($item eq 'resourcetag') {
16371: if ($name eq 'responsetype') {
16372: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
16373: }
16374: }
16375: }
16376: my $navmap = Apache::lonnavmaps::navmap->new();
16377: if (defined($navmap)) {
16378: my %allresponses;
16379: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
16380: my %responses = $res->responseTypes();
16381: foreach my $key (keys(%responses)) {
16382: next unless(exists($checkresponsetypes{$key}));
16383: $allresponses{$key} += $responses{$key};
16384: }
16385: }
16386: foreach my $key (keys(%allresponses)) {
16387: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
16388: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
16389: ($reqdmajor,$reqdminor) = ($major,$minor);
16390: }
16391: }
16392: undef($navmap);
16393: }
16394: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
16395: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
16396: }
16397: return;
16398: }
16399:
1.1110 raeburn 16400: sub allmaps_incourse {
16401: my ($cdom,$cnum,$chome,$cid) = @_;
16402: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
16403: $cid = $env{'request.course.id'};
16404: $cdom = $env{'course.'.$cid.'.domain'};
16405: $cnum = $env{'course.'.$cid.'.num'};
16406: $chome = $env{'course.'.$cid.'.home'};
16407: }
16408: my %allmaps = ();
16409: my $lastchange =
16410: &Apache::lonnet::get_coursechange($cdom,$cnum);
16411: if ($lastchange > $env{'request.course.tied'}) {
16412: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16413: unless ($ferr) {
16414: &update_content_constraints($cdom,$cnum,$chome,$cid);
16415: }
16416: }
16417: my $navmap = Apache::lonnavmaps::navmap->new();
16418: if (defined($navmap)) {
16419: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16420: $allmaps{$res->src()} = 1;
16421: }
16422: }
16423: return \%allmaps;
16424: }
16425:
1.1083 raeburn 16426: sub parse_supplemental_title {
16427: my ($title) = @_;
16428:
16429: my ($foldertitle,$renametitle);
16430: if ($title =~ /&&&/) {
16431: $title = &HTML::Entites::decode($title);
16432: }
16433: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16434: $renametitle=$4;
16435: my ($time,$uname,$udom) = ($1,$2,$3);
16436: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16437: my $name = &plainname($uname,$udom);
16438: $name = &HTML::Entities::encode($name,'"<>&\'');
16439: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16440: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16441: $name.': <br />'.$foldertitle;
16442: }
16443: if (wantarray) {
16444: return ($title,$foldertitle,$renametitle);
16445: }
16446: return $title;
16447: }
16448:
1.1143 raeburn 16449: sub recurse_supplemental {
16450: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16451: if ($suppmap) {
16452: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16453: if ($fatal) {
16454: $errors ++;
16455: } else {
16456: if ($#LONCAPA::map::resources > 0) {
16457: foreach my $res (@LONCAPA::map::resources) {
16458: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16459: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16460: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16461: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16462: } else {
16463: $numfiles ++;
16464: }
16465: }
16466: }
16467: }
16468: }
16469: }
16470: return ($numfiles,$errors);
16471: }
16472:
1.1101 raeburn 16473: sub symb_to_docspath {
16474: my ($symb) = @_;
16475: return unless ($symb);
16476: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16477: if ($resurl=~/\.(sequence|page)$/) {
16478: $mapurl=$resurl;
16479: } elsif ($resurl eq 'adm/navmaps') {
16480: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16481: }
16482: my $mapresobj;
16483: my $navmap = Apache::lonnavmaps::navmap->new();
16484: if (ref($navmap)) {
16485: $mapresobj = $navmap->getResourceByUrl($mapurl);
16486: }
16487: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16488: my $type=$2;
16489: my $path;
16490: if (ref($mapresobj)) {
16491: my $pcslist = $mapresobj->map_hierarchy();
16492: if ($pcslist ne '') {
16493: foreach my $pc (split(/,/,$pcslist)) {
16494: next if ($pc <= 1);
16495: my $res = $navmap->getByMapPc($pc);
16496: if (ref($res)) {
16497: my $thisurl = $res->src();
16498: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16499: my $thistitle = $res->title();
16500: $path .= '&'.
16501: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16502: &escape($thistitle).
1.1101 raeburn 16503: ':'.$res->randompick().
16504: ':'.$res->randomout().
16505: ':'.$res->encrypted().
16506: ':'.$res->randomorder().
16507: ':'.$res->is_page();
16508: }
16509: }
16510: }
16511: $path =~ s/^\&//;
16512: my $maptitle = $mapresobj->title();
16513: if ($mapurl eq 'default') {
1.1129 raeburn 16514: $maptitle = 'Main Content';
1.1101 raeburn 16515: }
16516: $path .= (($path ne '')? '&' : '').
16517: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16518: &escape($maptitle).
1.1101 raeburn 16519: ':'.$mapresobj->randompick().
16520: ':'.$mapresobj->randomout().
16521: ':'.$mapresobj->encrypted().
16522: ':'.$mapresobj->randomorder().
16523: ':'.$mapresobj->is_page();
16524: } else {
16525: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16526: my $ispage = (($type eq 'page')? 1 : '');
16527: if ($mapurl eq 'default') {
1.1129 raeburn 16528: $maptitle = 'Main Content';
1.1101 raeburn 16529: }
16530: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16531: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16532: }
16533: unless ($mapurl eq 'default') {
16534: $path = 'default&'.
1.1146 raeburn 16535: &escape('Main Content').
1.1101 raeburn 16536: ':::::&'.$path;
16537: }
16538: return $path;
16539: }
16540:
1.1094 raeburn 16541: sub captcha_display {
16542: my ($context,$lonhost) = @_;
16543: my ($output,$error);
1.1234 raeburn 16544: my ($captcha,$pubkey,$privkey,$version) =
16545: &get_captcha_config($context,$lonhost);
1.1095 raeburn 16546: if ($captcha eq 'original') {
1.1094 raeburn 16547: $output = &create_captcha();
16548: unless ($output) {
1.1172 raeburn 16549: $error = 'captcha';
1.1094 raeburn 16550: }
16551: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 16552: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 16553: unless ($output) {
1.1172 raeburn 16554: $error = 'recaptcha';
1.1094 raeburn 16555: }
16556: }
1.1234 raeburn 16557: return ($output,$error,$captcha,$version);
1.1094 raeburn 16558: }
16559:
16560: sub captcha_response {
16561: my ($context,$lonhost) = @_;
16562: my ($captcha_chk,$captcha_error);
1.1234 raeburn 16563: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 16564: if ($captcha eq 'original') {
1.1094 raeburn 16565: ($captcha_chk,$captcha_error) = &check_captcha();
16566: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 16567: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 16568: } else {
16569: $captcha_chk = 1;
16570: }
16571: return ($captcha_chk,$captcha_error);
16572: }
16573:
16574: sub get_captcha_config {
16575: my ($context,$lonhost) = @_;
1.1234 raeburn 16576: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 16577: my $hostname = &Apache::lonnet::hostname($lonhost);
16578: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16579: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 16580: if ($context eq 'usercreation') {
16581: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16582: if (ref($domconfig{$context}) eq 'HASH') {
16583: $hashtocheck = $domconfig{$context}{'cancreate'};
16584: if (ref($hashtocheck) eq 'HASH') {
16585: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16586: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16587: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16588: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16589: }
16590: if ($privkey && $pubkey) {
16591: $captcha = 'recaptcha';
1.1234 raeburn 16592: $version = $hashtocheck->{'recaptchaversion'};
16593: if ($version ne '2') {
16594: $version = 1;
16595: }
1.1095 raeburn 16596: } else {
16597: $captcha = 'original';
16598: }
16599: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16600: $captcha = 'original';
16601: }
1.1094 raeburn 16602: }
1.1095 raeburn 16603: } else {
16604: $captcha = 'captcha';
16605: }
16606: } elsif ($context eq 'login') {
16607: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16608: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16609: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16610: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 16611: if ($privkey && $pubkey) {
16612: $captcha = 'recaptcha';
1.1234 raeburn 16613: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
16614: if ($version ne '2') {
16615: $version = 1;
16616: }
1.1095 raeburn 16617: } else {
16618: $captcha = 'original';
1.1094 raeburn 16619: }
1.1095 raeburn 16620: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16621: $captcha = 'original';
1.1094 raeburn 16622: }
16623: }
1.1234 raeburn 16624: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 16625: }
16626:
16627: sub create_captcha {
16628: my %captcha_params = &captcha_settings();
16629: my ($output,$maxtries,$tries) = ('',10,0);
16630: while ($tries < $maxtries) {
16631: $tries ++;
16632: my $captcha = Authen::Captcha->new (
16633: output_folder => $captcha_params{'output_dir'},
16634: data_folder => $captcha_params{'db_dir'},
16635: );
16636: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16637:
16638: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16639: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16640: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 16641: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16642: '<br />'.
16643: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 16644: last;
16645: }
16646: }
16647: return $output;
16648: }
16649:
16650: sub captcha_settings {
16651: my %captcha_params = (
16652: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16653: www_output_dir => "/captchaspool",
16654: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16655: numchars => '5',
16656: );
16657: return %captcha_params;
16658: }
16659:
16660: sub check_captcha {
16661: my ($captcha_chk,$captcha_error);
16662: my $code = $env{'form.code'};
16663: my $md5sum = $env{'form.crypt'};
16664: my %captcha_params = &captcha_settings();
16665: my $captcha = Authen::Captcha->new(
16666: output_folder => $captcha_params{'output_dir'},
16667: data_folder => $captcha_params{'db_dir'},
16668: );
1.1109 raeburn 16669: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 16670: my %captcha_hash = (
16671: 0 => 'Code not checked (file error)',
16672: -1 => 'Failed: code expired',
16673: -2 => 'Failed: invalid code (not in database)',
16674: -3 => 'Failed: invalid code (code does not match crypt)',
16675: );
16676: if ($captcha_chk != 1) {
16677: $captcha_error = $captcha_hash{$captcha_chk}
16678: }
16679: return ($captcha_chk,$captcha_error);
16680: }
16681:
16682: sub create_recaptcha {
1.1234 raeburn 16683: my ($pubkey,$version) = @_;
16684: if ($version >= 2) {
16685: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
16686: } else {
16687: my $use_ssl;
16688: if ($ENV{'SERVER_PORT'} == 443) {
16689: $use_ssl = 1;
16690: }
16691: my $captcha = Captcha::reCAPTCHA->new;
16692: return $captcha->get_options_setter({theme => 'white'})."\n".
16693: $captcha->get_html($pubkey,undef,$use_ssl).
16694: &mt('If the text is hard to read, [_1] will replace them.',
16695: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
16696: '<br /><br />';
16697: }
1.1094 raeburn 16698: }
16699:
16700: sub check_recaptcha {
1.1234 raeburn 16701: my ($privkey,$version) = @_;
1.1094 raeburn 16702: my $captcha_chk;
1.1234 raeburn 16703: if ($version >= 2) {
16704: my $ua = LWP::UserAgent->new;
16705: $ua->timeout(10);
16706: my %info = (
16707: secret => $privkey,
16708: response => $env{'form.g-recaptcha-response'},
16709: remoteip => $ENV{'REMOTE_ADDR'},
16710: );
16711: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
16712: if ($response->is_success) {
16713: my $data = JSON::DWIW->from_json($response->decoded_content);
16714: if (ref($data) eq 'HASH') {
16715: if ($data->{'success'}) {
16716: $captcha_chk = 1;
16717: }
16718: }
16719: }
16720: } else {
16721: my $captcha = Captcha::reCAPTCHA->new;
16722: my $captcha_result =
16723: $captcha->check_answer(
16724: $privkey,
16725: $ENV{'REMOTE_ADDR'},
16726: $env{'form.recaptcha_challenge_field'},
16727: $env{'form.recaptcha_response_field'},
16728: );
16729: if ($captcha_result->{is_valid}) {
16730: $captcha_chk = 1;
16731: }
1.1094 raeburn 16732: }
16733: return $captcha_chk;
16734: }
16735:
1.1174 raeburn 16736: sub emailusername_info {
1.1177 raeburn 16737: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 16738: my %titles = &Apache::lonlocal::texthash (
16739: lastname => 'Last Name',
16740: firstname => 'First Name',
16741: institution => 'School/college/university',
16742: location => "School's city, state/province, country",
16743: web => "School's web address",
16744: officialemail => 'E-mail address at institution (if different)',
16745: );
16746: return (\@fields,\%titles);
16747: }
16748:
1.1161 raeburn 16749: sub cleanup_html {
16750: my ($incoming) = @_;
16751: my $outgoing;
16752: if ($incoming ne '') {
16753: $outgoing = $incoming;
16754: $outgoing =~ s/;/;/g;
16755: $outgoing =~ s/\#/#/g;
16756: $outgoing =~ s/\&/&/g;
16757: $outgoing =~ s/</</g;
16758: $outgoing =~ s/>/>/g;
16759: $outgoing =~ s/\(/(/g;
16760: $outgoing =~ s/\)/)/g;
16761: $outgoing =~ s/"/"/g;
16762: $outgoing =~ s/'/'/g;
16763: $outgoing =~ s/\$/$/g;
16764: $outgoing =~ s{/}{/}g;
16765: $outgoing =~ s/=/=/g;
16766: $outgoing =~ s/\\/\/g
16767: }
16768: return $outgoing;
16769: }
16770:
1.1190 musolffc 16771: # Checks for critical messages and returns a redirect url if one exists.
16772: # $interval indicates how often to check for messages.
16773: sub critical_redirect {
16774: my ($interval) = @_;
16775: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16776: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16777: $env{'user.name'});
16778: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 16779: my $redirecturl;
1.1190 musolffc 16780: if ($what[0]) {
16781: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16782: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 16783: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16784: return (1, $url);
1.1190 musolffc 16785: }
1.1191 raeburn 16786: }
16787: }
16788: return ();
1.1190 musolffc 16789: }
16790:
1.1174 raeburn 16791: # Use:
16792: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16793: #
16794: ##################################################
16795: # password associated functions #
16796: ##################################################
16797: sub des_keys {
16798: # Make a new key for DES encryption.
16799: # Each key has two parts which are returned separately.
16800: # Please note: Each key must be passed through the &hex function
16801: # before it is output to the web browser. The hex versions cannot
16802: # be used to decrypt.
16803: my @hexstr=('0','1','2','3','4','5','6','7',
16804: '8','9','a','b','c','d','e','f');
16805: my $lkey='';
16806: for (0..7) {
16807: $lkey.=$hexstr[rand(15)];
16808: }
16809: my $ukey='';
16810: for (0..7) {
16811: $ukey.=$hexstr[rand(15)];
16812: }
16813: return ($lkey,$ukey);
16814: }
16815:
16816: sub des_decrypt {
16817: my ($key,$cyphertext) = @_;
16818: my $keybin=pack("H16",$key);
16819: my $cypher;
16820: if ($Crypt::DES::VERSION>=2.03) {
16821: $cypher=new Crypt::DES $keybin;
16822: } else {
16823: $cypher=new DES $keybin;
16824: }
1.1233 raeburn 16825: my $plaintext='';
16826: my $cypherlength = length($cyphertext);
16827: my $numchunks = int($cypherlength/32);
16828: for (my $j=0; $j<$numchunks; $j++) {
16829: my $start = $j*32;
16830: my $cypherblock = substr($cyphertext,$start,32);
16831: my $chunk =
16832: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
16833: $chunk .=
16834: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
16835: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
16836: $plaintext .= $chunk;
16837: }
1.1174 raeburn 16838: return $plaintext;
16839: }
16840:
1.112 bowersj2 16841: 1;
16842: __END__;
1.41 ng 16843:
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