Annotation of loncom/interface/loncommon.pm, revision 1.1254
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1254 ! raeburn 4: # $Id: loncommon.pm,v 1.1253 2016/09/05 01:46:07 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.1241 raeburn 75: use DateTime::Locale;
1.1220 raeburn 76: use Encode();
1.1091 foxr 77: use Text::Aspell;
1.1094 raeburn 78: use Authen::Captcha;
79: use Captcha::reCAPTCHA;
1.1234 raeburn 80: use JSON::DWIW;
81: use LWP::UserAgent;
1.1174 raeburn 82: use Crypt::DES;
83: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 84: use MIME::Lite;
85: use MIME::Types;
1.117 www 86:
1.517 raeburn 87: # ---------------------------------------------- Designs
88: use vars qw(%defaultdesign);
89:
1.22 www 90: my $readit;
91:
1.517 raeburn 92:
1.157 matthew 93: ##
94: ## Global Variables
95: ##
1.46 matthew 96:
1.643 foxr 97:
98: # ----------------------------------------------- SSI with retries:
99: #
100:
101: =pod
102:
1.648 raeburn 103: =head1 Server Side include with retries:
1.643 foxr 104:
105: =over 4
106:
1.648 raeburn 107: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 108:
109: Performs an ssi with some number of retries. Retries continue either
110: until the result is ok or until the retry count supplied by the
111: caller is exhausted.
112:
113: Inputs:
1.648 raeburn 114:
115: =over 4
116:
1.643 foxr 117: resource - Identifies the resource to insert.
1.648 raeburn 118:
1.643 foxr 119: retries - Count of the number of retries allowed.
1.648 raeburn 120:
1.643 foxr 121: form - Hash that identifies the rendering options.
122:
1.648 raeburn 123: =back
124:
125: Returns:
126:
127: =over 4
128:
1.643 foxr 129: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 130:
1.643 foxr 131: response - The response from the last attempt (which may or may not have been successful.
132:
1.648 raeburn 133: =back
134:
135: =back
136:
1.643 foxr 137: =cut
138:
139: sub ssi_with_retries {
140: my ($resource, $retries, %form) = @_;
141:
142:
143: my $ok = 0; # True if we got a good response.
144: my $content;
145: my $response;
146:
147: # Try to get the ssi done. within the retries count:
148:
149: do {
150: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
151: $ok = $response->is_success;
1.650 www 152: if (!$ok) {
153: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
154: }
1.643 foxr 155: $retries--;
156: } while (!$ok && ($retries > 0));
157:
158: if (!$ok) {
159: $content = ''; # On error return an empty content.
160: }
161: return ($content, $response);
162:
163: }
164:
165:
166:
1.20 www 167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 168: my %language;
1.124 www 169: my %supported_language;
1.1088 foxr 170: my %supported_codes;
1.1048 foxr 171: my %latex_language; # For choosing hyphenation in <transl..>
172: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 173: my %cprtag;
1.192 taceyjo1 174: my %scprtag;
1.351 www 175: my %fe; my %fd; my %fm;
1.41 ng 176: my %category_extensions;
1.12 harris41 177:
1.46 matthew 178: # ---------------------------------------------- Thesaurus variables
1.144 matthew 179: #
180: # %Keywords:
181: # A hash used by &keyword to determine if a word is considered a keyword.
182: # $thesaurus_db_file
183: # Scalar containing the full path to the thesaurus database.
1.46 matthew 184:
185: my %Keywords;
186: my $thesaurus_db_file;
187:
1.144 matthew 188: #
189: # Initialize values from language.tab, copyright.tab, filetypes.tab,
190: # thesaurus.tab, and filecategories.tab.
191: #
1.18 www 192: BEGIN {
1.46 matthew 193: # Variable initialization
194: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
195: #
1.22 www 196: unless ($readit) {
1.12 harris41 197: # ------------------------------------------------------------------- languages
198: {
1.158 raeburn 199: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
200: '/language.tab';
201: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 202: while (my $line = <$fh>) {
203: next if ($line=~/^\#/);
204: chomp($line);
1.1088 foxr 205: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 206: $language{$key}=$val.' - '.$enc;
207: if ($sup) {
208: $supported_language{$key}=$sup;
1.1088 foxr 209: $supported_codes{$key} = $code;
1.158 raeburn 210: }
1.1048 foxr 211: if ($latex) {
212: $latex_language_bykey{$key} = $latex;
1.1088 foxr 213: $latex_language{$code} = $latex;
1.1048 foxr 214: }
1.158 raeburn 215: }
216: close($fh);
217: }
1.12 harris41 218: }
219: # ------------------------------------------------------------------ copyrights
220: {
1.158 raeburn 221: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
222: '/copyright.tab';
223: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 224: while (my $line = <$fh>) {
225: next if ($line=~/^\#/);
226: chomp($line);
227: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 228: $cprtag{$key}=$val;
229: }
230: close($fh);
231: }
1.12 harris41 232: }
1.351 www 233: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 234: {
235: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
236: '/source_copyright.tab';
237: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 238: while (my $line = <$fh>) {
239: next if ($line =~ /^\#/);
240: chomp($line);
241: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 242: $scprtag{$key}=$val;
243: }
244: close($fh);
245: }
246: }
1.63 www 247:
1.517 raeburn 248: # -------------------------------------------------------------- default domain designs
1.63 www 249: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 250: my $designfile = $designdir.'/default.tab';
251: if ( open (my $fh,"<$designfile") ) {
252: while (my $line = <$fh>) {
253: next if ($line =~ /^\#/);
254: chomp($line);
255: my ($key,$val)=(split(/\=/,$line));
256: if ($val) { $defaultdesign{$key}=$val; }
257: }
258: close($fh);
1.63 www 259: }
260:
1.15 harris41 261: # ------------------------------------------------------------- file categories
262: {
1.158 raeburn 263: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
264: '/filecategories.tab';
265: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 266: while (my $line = <$fh>) {
267: next if ($line =~ /^\#/);
268: chomp($line);
269: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 270: push @{$category_extensions{lc($category)}},$extension;
271: }
272: close($fh);
273: }
274:
1.15 harris41 275: }
1.12 harris41 276: # ------------------------------------------------------------------ file types
277: {
1.158 raeburn 278: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
279: '/filetypes.tab';
280: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 281: while (my $line = <$fh>) {
282: next if ($line =~ /^\#/);
283: chomp($line);
284: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 285: if ($descr ne '') {
286: $fe{$ending}=lc($emb);
287: $fd{$ending}=$descr;
1.351 www 288: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 289: }
290: }
291: close($fh);
292: }
1.12 harris41 293: }
1.22 www 294: &Apache::lonnet::logthis(
1.705 tempelho 295: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 296: $readit=1;
1.46 matthew 297: } # end of unless($readit)
1.32 matthew 298:
299: }
1.112 bowersj2 300:
1.42 matthew 301: ###############################################################
302: ## HTML and Javascript Helper Functions ##
303: ###############################################################
304:
305: =pod
306:
1.112 bowersj2 307: =head1 HTML and Javascript Functions
1.42 matthew 308:
1.112 bowersj2 309: =over 4
310:
1.648 raeburn 311: =item * &browser_and_searcher_javascript()
1.112 bowersj2 312:
313: X<browsing, javascript>X<searching, javascript>Returns a string
314: containing javascript with two functions, C<openbrowser> and
315: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
316: tags.
1.42 matthew 317:
1.648 raeburn 318: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 319:
320: inputs: formname, elementname, only, omit
321:
322: formname and elementname indicate the name of the html form and name of
323: the element that the results of the browsing selection are to be placed in.
324:
325: Specifying 'only' will restrict the browser to displaying only files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
328: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 329: with the given extension. Can be a comma separated list.
1.42 matthew 330:
1.648 raeburn 331: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 332:
333: Inputs: formname, elementname
334:
335: formname and elementname specify the name of the html form and the name
336: of the element the selection from the search results will be placed in.
1.542 raeburn 337:
1.42 matthew 338: =cut
339:
340: sub browser_and_searcher_javascript {
1.199 albertel 341: my ($mode)=@_;
342: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 343: my $resurl=&escape_single(&lastresurl());
1.42 matthew 344: return <<END;
1.219 albertel 345: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 346: var editbrowser = null;
1.135 albertel 347: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 348: var url = '$resurl/?';
1.42 matthew 349: if (editbrowser == null) {
350: url += 'launch=1&';
351: }
352: url += 'catalogmode=interactive&';
1.199 albertel 353: url += 'mode=$mode&';
1.611 albertel 354: url += 'inhibitmenu=yes&';
1.42 matthew 355: url += 'form=' + formname + '&';
356: if (only != null) {
357: url += 'only=' + only + '&';
1.217 albertel 358: } else {
359: url += 'only=&';
360: }
1.42 matthew 361: if (omit != null) {
362: url += 'omit=' + omit + '&';
1.217 albertel 363: } else {
364: url += 'omit=&';
365: }
1.135 albertel 366: if (titleelement != null) {
367: url += 'titleelement=' + titleelement + '&';
1.217 albertel 368: } else {
369: url += 'titleelement=&';
370: }
1.42 matthew 371: url += 'element=' + elementname + '';
372: var title = 'Browser';
1.435 albertel 373: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 374: options += ',width=700,height=600';
375: editbrowser = open(url,title,options,'1');
376: editbrowser.focus();
377: }
378: var editsearcher;
1.135 albertel 379: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 380: var url = '/adm/searchcat?';
381: if (editsearcher == null) {
382: url += 'launch=1&';
383: }
384: url += 'catalogmode=interactive&';
1.199 albertel 385: url += 'mode=$mode&';
1.42 matthew 386: url += 'form=' + formname + '&';
1.135 albertel 387: if (titleelement != null) {
388: url += 'titleelement=' + titleelement + '&';
1.217 albertel 389: } else {
390: url += 'titleelement=&';
391: }
1.42 matthew 392: url += 'element=' + elementname + '';
393: var title = 'Search';
1.435 albertel 394: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 395: options += ',width=700,height=600';
396: editsearcher = open(url,title,options,'1');
397: editsearcher.focus();
398: }
1.219 albertel 399: // END LON-CAPA Internal -->
1.42 matthew 400: END
1.170 www 401: }
402:
403: sub lastresurl {
1.258 albertel 404: if ($env{'environment.lastresurl'}) {
405: return $env{'environment.lastresurl'}
1.170 www 406: } else {
407: return '/res';
408: }
409: }
410:
411: sub storeresurl {
412: my $resurl=&Apache::lonnet::clutter(shift);
413: unless ($resurl=~/^\/res/) { return 0; }
414: $resurl=~s/\/$//;
415: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 416: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 417: return 1;
1.42 matthew 418: }
419:
1.74 www 420: sub studentbrowser_javascript {
1.111 www 421: unless (
1.258 albertel 422: (($env{'request.course.id'}) &&
1.302 albertel 423: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
424: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
425: '/'.$env{'request.course.sec'})
426: ))
1.258 albertel 427: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 428: ) { return ''; }
1.74 www 429: return (<<'ENDSTDBRW');
1.776 bisitz 430: <script type="text/javascript" language="Javascript">
1.824 bisitz 431: // <![CDATA[
1.74 www 432: var stdeditbrowser;
1.999 www 433: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 434: var url = '/adm/pickstudent?';
435: var filter;
1.558 albertel 436: if (!ignorefilter) {
437: eval('filter=document.'+formname+'.'+uname+'.value;');
438: }
1.74 www 439: if (filter != null) {
440: if (filter != '') {
441: url += 'filter='+filter+'&';
442: }
443: }
444: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 445: '&udomelement='+udom+
446: '&clicker='+clicker;
1.111 www 447: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 448: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 449: var title = 'Student_Browser';
1.74 www 450: var options = 'scrollbars=1,resizable=1,menubar=0';
451: options += ',width=700,height=600';
452: stdeditbrowser = open(url,title,options,'1');
453: stdeditbrowser.focus();
454: }
1.824 bisitz 455: // ]]>
1.74 www 456: </script>
457: ENDSTDBRW
458: }
1.42 matthew 459:
1.1003 www 460: sub resourcebrowser_javascript {
461: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 462: return (<<'ENDRESBRW');
1.1003 www 463: <script type="text/javascript" language="Javascript">
464: // <![CDATA[
465: var reseditbrowser;
1.1004 www 466: function openresbrowser(formname,reslink) {
1.1005 www 467: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 468: var title = 'Resource_Browser';
469: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 470: options += ',width=700,height=500';
1.1004 www 471: reseditbrowser = open(url,title,options,'1');
472: reseditbrowser.focus();
1.1003 www 473: }
474: // ]]>
475: </script>
1.1004 www 476: ENDRESBRW
1.1003 www 477: }
478:
1.74 www 479: sub selectstudent_link {
1.999 www 480: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
481: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
482: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
483: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 484: if ($env{'request.course.id'}) {
1.302 albertel 485: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
486: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
487: '/'.$env{'request.course.sec'})) {
1.111 www 488: return '';
489: }
1.999 www 490: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 491: if ($courseadvonly) {
492: $callargs .= ",'',1,1";
493: }
494: return '<span class="LC_nobreak">'.
495: '<a href="javascript:openstdbrowser('.$callargs.');">'.
496: &mt('Select User').'</a></span>';
1.74 www 497: }
1.258 albertel 498: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 499: $callargs .= ",'',1";
1.793 raeburn 500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openstdbrowser('.$callargs.');">'.
502: &mt('Select User').'</a></span>';
1.111 www 503: }
504: return '';
1.91 www 505: }
506:
1.1004 www 507: sub selectresource_link {
508: my ($form,$reslink,$arg)=@_;
509:
510: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
511: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
512: unless ($env{'request.course.id'}) { return $arg; }
513: return '<span class="LC_nobreak">'.
514: '<a href="javascript:openresbrowser('.$callargs.');">'.
515: $arg.'</a></span>';
516: }
517:
518:
519:
1.653 raeburn 520: sub authorbrowser_javascript {
521: return <<"ENDAUTHORBRW";
1.776 bisitz 522: <script type="text/javascript" language="JavaScript">
1.824 bisitz 523: // <![CDATA[
1.653 raeburn 524: var stdeditbrowser;
525:
526: function openauthorbrowser(formname,udom) {
527: var url = '/adm/pickauthor?';
528: url += 'form='+formname+'&roledom='+udom;
529: var title = 'Author_Browser';
530: var options = 'scrollbars=1,resizable=1,menubar=0';
531: options += ',width=700,height=600';
532: stdeditbrowser = open(url,title,options,'1');
533: stdeditbrowser.focus();
534: }
535:
1.824 bisitz 536: // ]]>
1.653 raeburn 537: </script>
538: ENDAUTHORBRW
539: }
540:
1.91 www 541: sub coursebrowser_javascript {
1.1116 raeburn 542: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 543: $credits_element,$instcode) = @_;
1.932 raeburn 544: my $wintitle = 'Course_Browser';
1.931 raeburn 545: if ($crstype eq 'Community') {
1.932 raeburn 546: $wintitle = 'Community_Browser';
1.909 raeburn 547: }
1.876 raeburn 548: my $id_functions = &javascript_index_functions();
549: my $output = '
1.776 bisitz 550: <script type="text/javascript" language="JavaScript">
1.824 bisitz 551: // <![CDATA[
1.468 raeburn 552: var stdeditbrowser;'."\n";
1.876 raeburn 553:
554: $output .= <<"ENDSTDBRW";
1.909 raeburn 555: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 556: var url = '/adm/pickcourse?';
1.895 raeburn 557: var formid = getFormIdByName(formname);
1.876 raeburn 558: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 559: if (domainfilter != null) {
560: if (domainfilter != '') {
561: url += 'domainfilter='+domainfilter+'&';
562: }
563: }
1.91 www 564: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 565: '&cdomelement='+udom+
566: '&cnameelement='+desc;
1.468 raeburn 567: if (extra_element !=null && extra_element != '') {
1.594 raeburn 568: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 569: url += '&roleelement='+extra_element;
570: if (domainfilter == null || domainfilter == '') {
571: url += '&domainfilter='+extra_element;
572: }
1.234 raeburn 573: }
1.468 raeburn 574: else {
575: if (formname == 'portform') {
576: url += '&setroles='+extra_element;
1.800 raeburn 577: } else {
578: if (formname == 'rules') {
579: url += '&fixeddom='+extra_element;
580: }
1.468 raeburn 581: }
582: }
1.230 raeburn 583: }
1.909 raeburn 584: if (type != null && type != '') {
585: url += '&type='+type;
586: }
587: if (type_elem != null && type_elem != '') {
588: url += '&typeelement='+type_elem;
589: }
1.872 raeburn 590: if (formname == 'ccrs') {
591: var ownername = document.forms[formid].ccuname.value;
592: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 593: url += '&cloner='+ownername+':'+ownerdom;
594: if (type == 'Course') {
595: url += '&crscode='+document.forms[formid].crscode.value;
596: }
1.1221 raeburn 597: }
598: if (formname == 'requestcrs') {
599: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 600: }
1.293 raeburn 601: if (multflag !=null && multflag != '') {
602: url += '&multiple='+multflag;
603: }
1.909 raeburn 604: var title = '$wintitle';
1.91 www 605: var options = 'scrollbars=1,resizable=1,menubar=0';
606: options += ',width=700,height=600';
607: stdeditbrowser = open(url,title,options,'1');
608: stdeditbrowser.focus();
609: }
1.876 raeburn 610: $id_functions
611: ENDSTDBRW
1.1116 raeburn 612: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
613: $output .= &setsec_javascript($sec_element,$formname,$role_element,
614: $credits_element);
1.876 raeburn 615: }
616: $output .= '
617: // ]]>
618: </script>';
619: return $output;
620: }
621:
622: sub javascript_index_functions {
623: return <<"ENDJS";
624:
625: function getFormIdByName(formname) {
626: for (var i=0;i<document.forms.length;i++) {
627: if (document.forms[i].name == formname) {
628: return i;
629: }
630: }
631: return -1;
632: }
633:
634: function getIndexByName(formid,item) {
635: for (var i=0;i<document.forms[formid].elements.length;i++) {
636: if (document.forms[formid].elements[i].name == item) {
637: return i;
638: }
639: }
640: return -1;
641: }
1.468 raeburn 642:
1.876 raeburn 643: function getDomainFromSelectbox(formname,udom) {
644: var userdom;
645: var formid = getFormIdByName(formname);
646: if (formid > -1) {
647: var domid = getIndexByName(formid,udom);
648: if (domid > -1) {
649: if (document.forms[formid].elements[domid].type == 'select-one') {
650: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
651: }
652: if (document.forms[formid].elements[domid].type == 'hidden') {
653: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 654: }
655: }
656: }
1.876 raeburn 657: return userdom;
658: }
659:
660: ENDJS
1.468 raeburn 661:
1.876 raeburn 662: }
663:
1.1017 raeburn 664: sub javascript_array_indexof {
1.1018 raeburn 665: return <<ENDJS;
1.1017 raeburn 666: <script type="text/javascript" language="JavaScript">
667: // <![CDATA[
668:
669: if (!Array.prototype.indexOf) {
670: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
671: "use strict";
672: if (this === void 0 || this === null) {
673: throw new TypeError();
674: }
675: var t = Object(this);
676: var len = t.length >>> 0;
677: if (len === 0) {
678: return -1;
679: }
680: var n = 0;
681: if (arguments.length > 0) {
682: n = Number(arguments[1]);
1.1088 foxr 683: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 684: n = 0;
685: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
686: n = (n > 0 || -1) * Math.floor(Math.abs(n));
687: }
688: }
689: if (n >= len) {
690: return -1;
691: }
692: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
693: for (; k < len; k++) {
694: if (k in t && t[k] === searchElement) {
695: return k;
696: }
697: }
698: return -1;
699: }
700: }
701:
702: // ]]>
703: </script>
704:
705: ENDJS
706:
707: }
708:
1.876 raeburn 709: sub userbrowser_javascript {
710: my $id_functions = &javascript_index_functions();
711: return <<"ENDUSERBRW";
712:
1.888 raeburn 713: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 714: var url = '/adm/pickuser?';
715: var userdom = getDomainFromSelectbox(formname,udom);
716: if (userdom != null) {
717: if (userdom != '') {
718: url += 'srchdom='+userdom+'&';
719: }
720: }
721: url += 'form=' + formname + '&unameelement='+uname+
722: '&udomelement='+udom+
723: '&ulastelement='+ulast+
724: '&ufirstelement='+ufirst+
725: '&uemailelement='+uemail+
1.881 raeburn 726: '&hideudomelement='+hideudom+
727: '&coursedom='+crsdom;
1.888 raeburn 728: if ((caller != null) && (caller != undefined)) {
729: url += '&caller='+caller;
730: }
1.876 raeburn 731: var title = 'User_Browser';
732: var options = 'scrollbars=1,resizable=1,menubar=0';
733: options += ',width=700,height=600';
734: var stdeditbrowser = open(url,title,options,'1');
735: stdeditbrowser.focus();
736: }
737:
1.888 raeburn 738: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 739: var formid = getFormIdByName(formname);
740: if (formid > -1) {
1.888 raeburn 741: var unameid = getIndexByName(formid,uname);
1.876 raeburn 742: var domid = getIndexByName(formid,udom);
743: var hidedomid = getIndexByName(formid,origdom);
744: if (hidedomid > -1) {
745: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 746: var unameval = document.forms[formid].elements[unameid].value;
747: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
748: if (domid > -1) {
749: var slct = document.forms[formid].elements[domid];
750: if (slct.type == 'select-one') {
751: var i;
752: for (i=0;i<slct.length;i++) {
753: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
754: }
755: }
756: if (slct.type == 'hidden') {
757: slct.value = fixeddom;
1.876 raeburn 758: }
759: }
1.468 raeburn 760: }
761: }
762: }
1.876 raeburn 763: return;
764: }
765:
766: $id_functions
767: ENDUSERBRW
1.468 raeburn 768: }
769:
770: sub setsec_javascript {
1.1116 raeburn 771: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 772: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
773: $communityrolestr);
774: if ($role_element ne '') {
775: my @allroles = ('st','ta','ep','in','ad');
776: foreach my $crstype ('Course','Community') {
777: if ($crstype eq 'Community') {
778: foreach my $role (@allroles) {
779: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
780: }
781: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
782: } else {
783: foreach my $role (@allroles) {
784: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
785: }
786: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
787: }
788: }
789: $rolestr = '"'.join('","',@allroles).'"';
790: $courserolestr = '"'.join('","',@courserolenames).'"';
791: $communityrolestr = '"'.join('","',@communityrolenames).'"';
792: }
1.468 raeburn 793: my $setsections = qq|
794: function setSect(sectionlist) {
1.629 raeburn 795: var sectionsArray = new Array();
796: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
797: sectionsArray = sectionlist.split(",");
798: }
1.468 raeburn 799: var numSections = sectionsArray.length;
800: document.$formname.$sec_element.length = 0;
801: if (numSections == 0) {
802: document.$formname.$sec_element.multiple=false;
803: document.$formname.$sec_element.size=1;
804: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
805: } else {
806: if (numSections == 1) {
807: document.$formname.$sec_element.multiple=false;
808: document.$formname.$sec_element.size=1;
809: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
810: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
811: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
812: } else {
813: for (var i=0; i<numSections; i++) {
814: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
815: }
816: document.$formname.$sec_element.multiple=true
817: if (numSections < 3) {
818: document.$formname.$sec_element.size=numSections;
819: } else {
820: document.$formname.$sec_element.size=3;
821: }
822: document.$formname.$sec_element.options[0].selected = false
823: }
824: }
1.91 www 825: }
1.905 raeburn 826:
827: function setRole(crstype) {
1.468 raeburn 828: |;
1.905 raeburn 829: if ($role_element eq '') {
830: $setsections .= ' return;
831: }
832: ';
833: } else {
834: $setsections .= qq|
835: var elementLength = document.$formname.$role_element.length;
836: var allroles = Array($rolestr);
837: var courserolenames = Array($courserolestr);
838: var communityrolenames = Array($communityrolestr);
839: if (elementLength != undefined) {
840: if (document.$formname.$role_element.options[5].value == 'cc') {
841: if (crstype == 'Course') {
842: return;
843: } else {
844: allroles[5] = 'co';
845: for (var i=0; i<6; i++) {
846: document.$formname.$role_element.options[i].value = allroles[i];
847: document.$formname.$role_element.options[i].text = communityrolenames[i];
848: }
849: }
850: } else {
851: if (crstype == 'Community') {
852: return;
853: } else {
854: allroles[5] = 'cc';
855: for (var i=0; i<6; i++) {
856: document.$formname.$role_element.options[i].value = allroles[i];
857: document.$formname.$role_element.options[i].text = courserolenames[i];
858: }
859: }
860: }
861: }
862: return;
863: }
864: |;
865: }
1.1116 raeburn 866: if ($credits_element) {
867: $setsections .= qq|
868: function setCredits(defaultcredits) {
869: document.$formname.$credits_element.value = defaultcredits;
870: return;
871: }
872: |;
873: }
1.468 raeburn 874: return $setsections;
875: }
876:
1.91 www 877: sub selectcourse_link {
1.909 raeburn 878: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
879: $typeelement) = @_;
880: my $type = $selecttype;
1.871 raeburn 881: my $linktext = &mt('Select Course');
882: if ($selecttype eq 'Community') {
1.909 raeburn 883: $linktext = &mt('Select Community');
1.1239 raeburn 884: } elsif ($selecttype eq 'Placement') {
885: $linktext = &mt('Select Placement Test');
1.906 raeburn 886: } elsif ($selecttype eq 'Course/Community') {
887: $linktext = &mt('Select Course/Community');
1.909 raeburn 888: $type = '';
1.1019 raeburn 889: } elsif ($selecttype eq 'Select') {
890: $linktext = &mt('Select');
891: $type = '';
1.871 raeburn 892: }
1.787 bisitz 893: return '<span class="LC_nobreak">'
894: ."<a href='"
895: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
896: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 897: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 898: ."'>".$linktext.'</a>'
1.787 bisitz 899: .'</span>';
1.74 www 900: }
1.42 matthew 901:
1.653 raeburn 902: sub selectauthor_link {
903: my ($form,$udom)=@_;
904: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
905: &mt('Select Author').'</a>';
906: }
907:
1.876 raeburn 908: sub selectuser_link {
1.881 raeburn 909: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 910: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 911: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 912: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 913: ');">'.$linktext.'</a>';
1.876 raeburn 914: }
915:
1.273 raeburn 916: sub check_uncheck_jscript {
917: my $jscript = <<"ENDSCRT";
918: function checkAll(field) {
919: if (field.length > 0) {
920: for (i = 0; i < field.length; i++) {
1.1093 raeburn 921: if (!field[i].disabled) {
922: field[i].checked = true;
923: }
1.273 raeburn 924: }
925: } else {
1.1093 raeburn 926: if (!field.disabled) {
927: field.checked = true;
928: }
1.273 raeburn 929: }
930: }
931:
932: function uncheckAll(field) {
933: if (field.length > 0) {
934: for (i = 0; i < field.length; i++) {
935: field[i].checked = false ;
1.543 albertel 936: }
937: } else {
1.273 raeburn 938: field.checked = false ;
939: }
940: }
941: ENDSCRT
942: return $jscript;
943: }
944:
1.656 www 945: sub select_timezone {
1.659 raeburn 946: my ($name,$selected,$onchange,$includeempty)=@_;
947: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
948: if ($includeempty) {
949: $output .= '<option value=""';
950: if (($selected eq '') || ($selected eq 'local')) {
951: $output .= ' selected="selected" ';
952: }
953: $output .= '> </option>';
954: }
1.657 raeburn 955: my @timezones = DateTime::TimeZone->all_names;
956: foreach my $tzone (@timezones) {
957: $output.= '<option value="'.$tzone.'"';
958: if ($tzone eq $selected) {
959: $output.=' selected="selected"';
960: }
961: $output.=">$tzone</option>\n";
1.656 www 962: }
963: $output.="</select>";
964: return $output;
965: }
1.273 raeburn 966:
1.687 raeburn 967: sub select_datelocale {
968: my ($name,$selected,$onchange,$includeempty)=@_;
969: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
970: if ($includeempty) {
971: $output .= '<option value=""';
972: if ($selected eq '') {
973: $output .= ' selected="selected" ';
974: }
975: $output .= '> </option>';
976: }
1.1241 raeburn 977: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 978: my (@possibles,%locale_names);
1.1241 raeburn 979: my @locales = DateTime::Locale->ids();
980: foreach my $id (@locales) {
981: if ($id ne '') {
982: my ($en_terr,$native_terr);
983: my $loc = DateTime::Locale->load($id);
984: if (ref($loc)) {
985: $en_terr = $loc->name();
986: $native_terr = $loc->native_name();
1.687 raeburn 987: if (grep(/^en$/,@languages) || !@languages) {
988: if ($en_terr ne '') {
989: $locale_names{$id} = '('.$en_terr.')';
990: } elsif ($native_terr ne '') {
991: $locale_names{$id} = $native_terr;
992: }
993: } else {
994: if ($native_terr ne '') {
995: $locale_names{$id} = $native_terr.' ';
996: } elsif ($en_terr ne '') {
997: $locale_names{$id} = '('.$en_terr.')';
998: }
999: }
1.1220 raeburn 1000: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1001: push(@possibles,$id);
1002: }
1.687 raeburn 1003: }
1004: }
1005: foreach my $item (sort(@possibles)) {
1006: $output.= '<option value="'.$item.'"';
1007: if ($item eq $selected) {
1008: $output.=' selected="selected"';
1009: }
1010: $output.=">$item";
1011: if ($locale_names{$item} ne '') {
1.1220 raeburn 1012: $output.=' '.$locale_names{$item};
1.687 raeburn 1013: }
1014: $output.="</option>\n";
1015: }
1016: $output.="</select>";
1017: return $output;
1018: }
1019:
1.792 raeburn 1020: sub select_language {
1021: my ($name,$selected,$includeempty) = @_;
1022: my %langchoices;
1023: if ($includeempty) {
1.1117 raeburn 1024: %langchoices = ('' => 'No language preference');
1.792 raeburn 1025: }
1026: foreach my $id (&languageids()) {
1027: my $code = &supportedlanguagecode($id);
1028: if ($code) {
1029: $langchoices{$code} = &plainlanguagedescription($id);
1030: }
1031: }
1.1117 raeburn 1032: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1033: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1034: }
1035:
1.42 matthew 1036: =pod
1.36 matthew 1037:
1.1088 foxr 1038:
1039: =item * &list_languages()
1040:
1041: Returns an array reference that is suitable for use in language prompters.
1042: Each array element is itself a two element array. The first element
1043: is the language code. The second element a descsriptiuon of the
1044: language itself. This is suitable for use in e.g.
1045: &Apache::edit::select_arg (once dereferenced that is).
1046:
1047: =cut
1048:
1049: sub list_languages {
1050: my @lang_choices;
1051:
1052: foreach my $id (&languageids()) {
1053: my $code = &supportedlanguagecode($id);
1054: if ($code) {
1055: my $selector = $supported_codes{$id};
1056: my $description = &plainlanguagedescription($id);
1057: push (@lang_choices, [$selector, $description]);
1058: }
1059: }
1060: return \@lang_choices;
1061: }
1062:
1063: =pod
1064:
1.648 raeburn 1065: =item * &linked_select_forms(...)
1.36 matthew 1066:
1067: linked_select_forms returns a string containing a <script></script> block
1068: and html for two <select> menus. The select menus will be linked in that
1069: changing the value of the first menu will result in new values being placed
1070: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1071: order unless a defined order is provided.
1.36 matthew 1072:
1073: linked_select_forms takes the following ordered inputs:
1074:
1075: =over 4
1076:
1.112 bowersj2 1077: =item * $formname, the name of the <form> tag
1.36 matthew 1078:
1.112 bowersj2 1079: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1080:
1.112 bowersj2 1081: =item * $firstdefault, the default value for the first menu
1.36 matthew 1082:
1.112 bowersj2 1083: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1084:
1.112 bowersj2 1085: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1086:
1.112 bowersj2 1087: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1088:
1.609 raeburn 1089: =item * $menuorder, the order of values in the first menu
1090:
1.1115 raeburn 1091: =item * $onchangefirst, additional javascript call to execute for an onchange
1092: event for the first <select> tag
1093:
1094: =item * $onchangesecond, additional javascript call to execute for an onchange
1095: event for the second <select> tag
1096:
1.1245 raeburn 1097: =item * $suffix, to differentiate separate uses of select2data javascript
1098: objects in a page.
1099:
1.41 ng 1100: =back
1101:
1.36 matthew 1102: Below is an example of such a hash. Only the 'text', 'default', and
1103: 'select2' keys must appear as stated. keys(%menu) are the possible
1104: values for the first select menu. The text that coincides with the
1.41 ng 1105: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1106: and text for the second menu are given in the hash pointed to by
1107: $menu{$choice1}->{'select2'}.
1108:
1.112 bowersj2 1109: my %menu = ( A1 => { text =>"Choice A1" ,
1110: default => "B3",
1111: select2 => {
1112: B1 => "Choice B1",
1113: B2 => "Choice B2",
1114: B3 => "Choice B3",
1115: B4 => "Choice B4"
1.609 raeburn 1116: },
1117: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1118: },
1119: A2 => { text =>"Choice A2" ,
1120: default => "C2",
1121: select2 => {
1122: C1 => "Choice C1",
1123: C2 => "Choice C2",
1124: C3 => "Choice C3"
1.609 raeburn 1125: },
1126: order => ['C2','C1','C3'],
1.112 bowersj2 1127: },
1128: A3 => { text =>"Choice A3" ,
1129: default => "D6",
1130: select2 => {
1131: D1 => "Choice D1",
1132: D2 => "Choice D2",
1133: D3 => "Choice D3",
1134: D4 => "Choice D4",
1135: D5 => "Choice D5",
1136: D6 => "Choice D6",
1137: D7 => "Choice D7"
1.609 raeburn 1138: },
1139: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1140: }
1141: );
1.36 matthew 1142:
1143: =cut
1144:
1145: sub linked_select_forms {
1146: my ($formname,
1147: $middletext,
1148: $firstdefault,
1149: $firstselectname,
1150: $secondselectname,
1.609 raeburn 1151: $hashref,
1152: $menuorder,
1.1115 raeburn 1153: $onchangefirst,
1.1245 raeburn 1154: $onchangesecond,
1155: $suffix
1.36 matthew 1156: ) = @_;
1157: my $second = "document.$formname.$secondselectname";
1158: my $first = "document.$formname.$firstselectname";
1159: # output the javascript to do the changing
1160: my $result = '';
1.776 bisitz 1161: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1162: $result.="// <![CDATA[\n";
1.1245 raeburn 1163: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1164: $" = '","';
1165: my $debug = '';
1166: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1167: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1168: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1169: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1170: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1171: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1172: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1173: @s2values = @{$hashref->{$s1}->{'order'}};
1174: }
1.36 matthew 1175: $result.="\"@s2values\");\n";
1.1245 raeburn 1176: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1177: my @s2texts;
1178: foreach my $value (@s2values) {
1179: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1180: }
1181: $result.="\"@s2texts\");\n";
1182: }
1183: $"=' ';
1184: $result.= <<"END";
1185:
1.1245 raeburn 1186: function select1${suffix}_changed() {
1.36 matthew 1187: // Determine new choice
1.1245 raeburn 1188: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1189: // update select2
1.1245 raeburn 1190: var values = select2data${suffix}[newvalue].values;
1191: var texts = select2data${suffix}[newvalue].texts;
1192: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1193: var i;
1194: // out with the old
1.1245 raeburn 1195: $second.options.length = 0;
1196: // in with the new
1.36 matthew 1197: for (i=0;i<values.length; i++) {
1198: $second.options[i] = new Option(values[i]);
1.143 matthew 1199: $second.options[i].value = values[i];
1.36 matthew 1200: $second.options[i].text = texts[i];
1201: if (values[i] == select2def) {
1202: $second.options[i].selected = true;
1203: }
1204: }
1205: }
1.824 bisitz 1206: // ]]>
1.36 matthew 1207: </script>
1208: END
1209: # output the initial values for the selection lists
1.1245 raeburn 1210: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1211: my @order = sort(keys(%{$hashref}));
1212: if (ref($menuorder) eq 'ARRAY') {
1213: @order = @{$menuorder};
1214: }
1215: foreach my $value (@order) {
1.36 matthew 1216: $result.=" <option value=\"$value\" ";
1.253 albertel 1217: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1218: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1219: }
1220: $result .= "</select>\n";
1221: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1222: $result .= $middletext;
1.1115 raeburn 1223: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1224: if ($onchangesecond) {
1225: $result .= ' onchange="'.$onchangesecond.'"';
1226: }
1227: $result .= ">\n";
1.36 matthew 1228: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1229:
1230: my @secondorder = sort(keys(%select2));
1231: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1232: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1233: }
1234: foreach my $value (@secondorder) {
1.36 matthew 1235: $result.=" <option value=\"$value\" ";
1.253 albertel 1236: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1237: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1238: }
1239: $result .= "</select>\n";
1240: # return $debug;
1241: return $result;
1242: } # end of sub linked_select_forms {
1243:
1.45 matthew 1244: =pod
1.44 bowersj2 1245:
1.973 raeburn 1246: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1247:
1.112 bowersj2 1248: Returns a string corresponding to an HTML link to the given help
1249: $topic, where $topic corresponds to the name of a .tex file in
1250: /home/httpd/html/adm/help/tex, with underscores replaced by
1251: spaces.
1252:
1253: $text will optionally be linked to the same topic, allowing you to
1254: link text in addition to the graphic. If you do not want to link
1255: text, but wish to specify one of the later parameters, pass an
1256: empty string.
1257:
1258: $stayOnPage is a value that will be interpreted as a boolean. If true,
1259: the link will not open a new window. If false, the link will open
1260: a new window using Javascript. (Default is false.)
1261:
1262: $width and $height are optional numerical parameters that will
1263: override the width and height of the popped up window, which may
1.973 raeburn 1264: be useful for certain help topics with big pictures included.
1265:
1266: $imgid is the id of the img tag used for the help icon. This may be
1267: used in a javascript call to switch the image src. See
1268: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1269:
1270: =cut
1271:
1272: sub help_open_topic {
1.973 raeburn 1273: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1274: $text = "" if (not defined $text);
1.44 bowersj2 1275: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1276: $width = 500 if (not defined $width);
1.44 bowersj2 1277: $height = 400 if (not defined $height);
1278: my $filename = $topic;
1279: $filename =~ s/ /_/g;
1280:
1.48 bowersj2 1281: my $template = "";
1282: my $link;
1.572 banghart 1283:
1.159 www 1284: $topic=~s/\W/\_/g;
1.44 bowersj2 1285:
1.572 banghart 1286: if (!$stayOnPage) {
1.1033 www 1287: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1288: } elsif ($stayOnPage eq 'popup') {
1289: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572 banghart 1290: } else {
1.48 bowersj2 1291: $link = "/adm/help/${filename}.hlp";
1292: }
1293:
1294: # Add the text
1.755 neumanie 1295: if ($text ne "") {
1.763 bisitz 1296: $template.='<span class="LC_help_open_topic">'
1297: .'<a target="_top" href="'.$link.'">'
1298: .$text.'</a>';
1.48 bowersj2 1299: }
1300:
1.763 bisitz 1301: # (Always) Add the graphic
1.179 matthew 1302: my $title = &mt('Online Help');
1.667 raeburn 1303: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1304: if ($imgid ne '') {
1305: $imgid = ' id="'.$imgid.'"';
1306: }
1.763 bisitz 1307: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1308: .'<img src="'.$helpicon.'" border="0"'
1309: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1310: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1311: .' /></a>';
1312: if ($text ne "") {
1313: $template.='</span>';
1314: }
1.44 bowersj2 1315: return $template;
1316:
1.106 bowersj2 1317: }
1318:
1319: # This is a quicky function for Latex cheatsheet editing, since it
1320: # appears in at least four places
1321: sub helpLatexCheatsheet {
1.1037 www 1322: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1323: my $out;
1.106 bowersj2 1324: my $addOther = '';
1.732 raeburn 1325: if ($topic) {
1.1037 www 1326: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1327: }
1328: $out = '<span>' # Start cheatsheet
1329: .$addOther
1330: .'<span>'
1.1037 www 1331: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1332: .'</span> <span>'
1.1037 www 1333: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1334: .'</span>';
1.732 raeburn 1335: unless ($not_author) {
1.1186 kruse 1336: $out .= '<span>'
1337: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1338: .'</span> <span>'
1339: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1340: .'</span>';
1.732 raeburn 1341: }
1.763 bisitz 1342: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1343: return $out;
1.172 www 1344: }
1345:
1.430 albertel 1346: sub general_help {
1347: my $helptopic='Student_Intro';
1348: if ($env{'request.role'}=~/^(ca|au)/) {
1349: $helptopic='Authoring_Intro';
1.907 raeburn 1350: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1351: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1352: } elsif ($env{'request.role'}=~/^dc/) {
1353: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1354: }
1355: return $helptopic;
1356: }
1357:
1358: sub update_help_link {
1359: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1360: my $origurl = $ENV{'REQUEST_URI'};
1361: $origurl=~s|^/~|/priv/|;
1362: my $timestamp = time;
1363: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1364: $$datum = &escape($$datum);
1365: }
1366:
1367: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1368: my $output .= <<"ENDOUTPUT";
1369: <script type="text/javascript">
1.824 bisitz 1370: // <![CDATA[
1.430 albertel 1371: banner_link = '$banner_link';
1.824 bisitz 1372: // ]]>
1.430 albertel 1373: </script>
1374: ENDOUTPUT
1375: return $output;
1376: }
1377:
1378: # now just updates the help link and generates a blue icon
1.193 raeburn 1379: sub help_open_menu {
1.430 albertel 1380: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1381: = @_;
1.949 droeschl 1382: $stayOnPage = 1;
1.430 albertel 1383: my $output;
1384: if ($component_help) {
1385: if (!$text) {
1386: $output=&help_open_topic($component_help,undef,$stayOnPage,
1387: $width,$height);
1388: } else {
1389: my $help_text;
1390: $help_text=&unescape($topic);
1391: $output='<table><tr><td>'.
1392: &help_open_topic($component_help,$help_text,$stayOnPage,
1393: $width,$height).'</td></tr></table>';
1394: }
1395: }
1396: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1397: return $output.$banner_link;
1398: }
1399:
1400: sub top_nav_help {
1401: my ($text) = @_;
1.436 albertel 1402: $text = &mt($text);
1.949 droeschl 1403: my $stay_on_page = 1;
1404:
1.1168 raeburn 1405: my ($link,$banner_link);
1406: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1407: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1408: : "javascript:helpMenu('open')";
1409: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1410: }
1.201 raeburn 1411: my $title = &mt('Get help');
1.1168 raeburn 1412: if ($link) {
1413: return <<"END";
1.436 albertel 1414: $banner_link
1.1159 raeburn 1415: <a href="$link" title="$title">$text</a>
1.436 albertel 1416: END
1.1168 raeburn 1417: } else {
1418: return ' '.$text.' ';
1419: }
1.436 albertel 1420: }
1421:
1422: sub help_menu_js {
1.1154 raeburn 1423: my ($httphost) = @_;
1.949 droeschl 1424: my $stayOnPage = 1;
1.436 albertel 1425: my $width = 620;
1426: my $height = 600;
1.430 albertel 1427: my $helptopic=&general_help();
1.1154 raeburn 1428: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1429: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1430: my $start_page =
1431: &Apache::loncommon::start_page('Help Menu', undef,
1432: {'frameset' => 1,
1433: 'js_ready' => 1,
1.1154 raeburn 1434: 'use_absolute' => $httphost,
1.331 albertel 1435: 'add_entries' => {
1.1168 raeburn 1436: 'border' => '0',
1.579 raeburn 1437: 'rows' => "110,*",},});
1.331 albertel 1438: my $end_page =
1439: &Apache::loncommon::end_page({'frameset' => 1,
1440: 'js_ready' => 1,});
1441:
1.436 albertel 1442: my $template .= <<"ENDTEMPLATE";
1443: <script type="text/javascript">
1.877 bisitz 1444: // <![CDATA[
1.253 albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1446: var banner_link = '';
1.243 raeburn 1447: function helpMenu(target) {
1448: var caller = this;
1449: if (target == 'open') {
1450: var newWindow = null;
1451: try {
1.262 albertel 1452: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1453: }
1454: catch(error) {
1455: writeHelp(caller);
1456: return;
1457: }
1458: if (newWindow) {
1459: caller = newWindow;
1460: }
1.193 raeburn 1461: }
1.243 raeburn 1462: writeHelp(caller);
1463: return;
1464: }
1465: function writeHelp(caller) {
1.1168 raeburn 1466: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1467: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1468: caller.document.close();
1469: caller.focus();
1.193 raeburn 1470: }
1.877 bisitz 1471: // END LON-CAPA Internal -->
1.253 albertel 1472: // ]]>
1.436 albertel 1473: </script>
1.193 raeburn 1474: ENDTEMPLATE
1475: return $template;
1476: }
1477:
1.172 www 1478: sub help_open_bug {
1479: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1480: unless ($env{'user.adv'}) { return ''; }
1.172 www 1481: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1482: $text = "" if (not defined $text);
1483: $stayOnPage=1;
1.184 albertel 1484: $width = 600 if (not defined $width);
1485: $height = 600 if (not defined $height);
1.172 www 1486:
1487: $topic=~s/\W+/\+/g;
1488: my $link='';
1489: my $template='';
1.379 albertel 1490: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1491: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1492: if (!$stayOnPage)
1493: {
1494: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1495: }
1496: else
1497: {
1498: $link = $url;
1499: }
1500: # Add the text
1501: if ($text ne "")
1502: {
1503: $template .=
1504: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1505: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1506: }
1507:
1508: # Add the graphic
1.179 matthew 1509: my $title = &mt('Report a Bug');
1.215 albertel 1510: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1511: $template .= <<"ENDTEMPLATE";
1.436 albertel 1512: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1513: ENDTEMPLATE
1514: if ($text ne '') { $template.='</td></tr></table>' };
1515: return $template;
1516:
1517: }
1518:
1519: sub help_open_faq {
1520: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1521: unless ($env{'user.adv'}) { return ''; }
1.172 www 1522: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1523: $text = "" if (not defined $text);
1524: $stayOnPage=1;
1525: $width = 350 if (not defined $width);
1526: $height = 400 if (not defined $height);
1527:
1528: $topic=~s/\W+/\+/g;
1529: my $link='';
1530: my $template='';
1531: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1532: if (!$stayOnPage)
1533: {
1534: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1535: }
1536: else
1537: {
1538: $link = $url;
1539: }
1540:
1541: # Add the text
1542: if ($text ne "")
1543: {
1544: $template .=
1.173 www 1545: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1546: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1547: }
1548:
1549: # Add the graphic
1.179 matthew 1550: my $title = &mt('View the FAQ');
1.215 albertel 1551: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1552: $template .= <<"ENDTEMPLATE";
1.436 albertel 1553: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1554: ENDTEMPLATE
1555: if ($text ne '') { $template.='</td></tr></table>' };
1556: return $template;
1557:
1.44 bowersj2 1558: }
1.37 matthew 1559:
1.180 matthew 1560: ###############################################################
1561: ###############################################################
1562:
1.45 matthew 1563: =pod
1564:
1.648 raeburn 1565: =item * &change_content_javascript():
1.256 matthew 1566:
1567: This and the next function allow you to create small sections of an
1568: otherwise static HTML page that you can update on the fly with
1569: Javascript, even in Netscape 4.
1570:
1571: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1572: must be written to the HTML page once. It will prove the Javascript
1573: function "change(name, content)". Calling the change function with the
1574: name of the section
1575: you want to update, matching the name passed to C<changable_area>, and
1576: the new content you want to put in there, will put the content into
1577: that area.
1578:
1579: B<Note>: Netscape 4 only reserves enough space for the changable area
1580: to contain room for the original contents. You need to "make space"
1581: for whatever changes you wish to make, and be B<sure> to check your
1582: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1583: it's adequate for updating a one-line status display, but little more.
1584: This script will set the space to 100% width, so you only need to
1585: worry about height in Netscape 4.
1586:
1587: Modern browsers are much less limiting, and if you can commit to the
1588: user not using Netscape 4, this feature may be used freely with
1589: pretty much any HTML.
1590:
1591: =cut
1592:
1593: sub change_content_javascript {
1594: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1595: if ($env{'browser.type'} eq 'netscape' &&
1596: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1597: return (<<NETSCAPE4);
1598: function change(name, content) {
1599: doc = document.layers[name+"___escape"].layers[0].document;
1600: doc.open();
1601: doc.write(content);
1602: doc.close();
1603: }
1604: NETSCAPE4
1605: } else {
1606: # Otherwise, we need to use semi-standards-compliant code
1607: # (technically, "innerHTML" isn't standard but the equivalent
1608: # is really scary, and every useful browser supports it
1609: return (<<DOMBASED);
1610: function change(name, content) {
1611: element = document.getElementById(name);
1612: element.innerHTML = content;
1613: }
1614: DOMBASED
1615: }
1616: }
1617:
1618: =pod
1619:
1.648 raeburn 1620: =item * &changable_area($name,$origContent):
1.256 matthew 1621:
1622: This provides a "changable area" that can be modified on the fly via
1623: the Javascript code provided in C<change_content_javascript>. $name is
1624: the name you will use to reference the area later; do not repeat the
1625: same name on a given HTML page more then once. $origContent is what
1626: the area will originally contain, which can be left blank.
1627:
1628: =cut
1629:
1630: sub changable_area {
1631: my ($name, $origContent) = @_;
1632:
1.258 albertel 1633: if ($env{'browser.type'} eq 'netscape' &&
1634: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1635: # If this is netscape 4, we need to use the Layer tag
1636: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1637: } else {
1638: return "<span id='$name'>$origContent</span>";
1639: }
1640: }
1641:
1642: =pod
1643:
1.648 raeburn 1644: =item * &viewport_geometry_js
1.590 raeburn 1645:
1646: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1647:
1648: =cut
1649:
1650:
1651: sub viewport_geometry_js {
1652: return <<"GEOMETRY";
1653: var Geometry = {};
1654: function init_geometry() {
1655: if (Geometry.init) { return };
1656: Geometry.init=1;
1657: if (window.innerHeight) {
1658: Geometry.getViewportHeight = function() { return window.innerHeight; };
1659: Geometry.getViewportWidth = function() { return window.innerWidth; };
1660: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1661: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1662: }
1663: else if (document.documentElement && document.documentElement.clientHeight) {
1664: Geometry.getViewportHeight =
1665: function() { return document.documentElement.clientHeight; };
1666: Geometry.getViewportWidth =
1667: function() { return document.documentElement.clientWidth; };
1668:
1669: Geometry.getHorizontalScroll =
1670: function() { return document.documentElement.scrollLeft; };
1671: Geometry.getVerticalScroll =
1672: function() { return document.documentElement.scrollTop; };
1673: }
1674: else if (document.body.clientHeight) {
1675: Geometry.getViewportHeight =
1676: function() { return document.body.clientHeight; };
1677: Geometry.getViewportWidth =
1678: function() { return document.body.clientWidth; };
1679: Geometry.getHorizontalScroll =
1680: function() { return document.body.scrollLeft; };
1681: Geometry.getVerticalScroll =
1682: function() { return document.body.scrollTop; };
1683: }
1684: }
1685:
1686: GEOMETRY
1687: }
1688:
1689: =pod
1690:
1.648 raeburn 1691: =item * &viewport_size_js()
1.590 raeburn 1692:
1693: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.
1694:
1695: =cut
1696:
1697: sub viewport_size_js {
1698: my $geometry = &viewport_geometry_js();
1699: return <<"DIMS";
1700:
1701: $geometry
1702:
1703: function getViewportDims(width,height) {
1704: init_geometry();
1705: width.value = Geometry.getViewportWidth();
1706: height.value = Geometry.getViewportHeight();
1707: return;
1708: }
1709:
1710: DIMS
1711: }
1712:
1713: =pod
1714:
1.648 raeburn 1715: =item * &resize_textarea_js()
1.565 albertel 1716:
1717: emits the needed javascript to resize a textarea to be as big as possible
1718:
1719: creates a function resize_textrea that takes two IDs first should be
1720: the id of the element to resize, second should be the id of a div that
1721: surrounds everything that comes after the textarea, this routine needs
1722: to be attached to the <body> for the onload and onresize events.
1723:
1.648 raeburn 1724: =back
1.565 albertel 1725:
1726: =cut
1727:
1728: sub resize_textarea_js {
1.590 raeburn 1729: my $geometry = &viewport_geometry_js();
1.565 albertel 1730: return <<"RESIZE";
1731: <script type="text/javascript">
1.824 bisitz 1732: // <![CDATA[
1.590 raeburn 1733: $geometry
1.565 albertel 1734:
1.588 albertel 1735: function getX(element) {
1736: var x = 0;
1737: while (element) {
1738: x += element.offsetLeft;
1739: element = element.offsetParent;
1740: }
1741: return x;
1742: }
1743: function getY(element) {
1744: var y = 0;
1745: while (element) {
1746: y += element.offsetTop;
1747: element = element.offsetParent;
1748: }
1749: return y;
1750: }
1751:
1752:
1.565 albertel 1753: function resize_textarea(textarea_id,bottom_id) {
1754: init_geometry();
1755: var textarea = document.getElementById(textarea_id);
1756: //alert(textarea);
1757:
1.588 albertel 1758: var textarea_top = getY(textarea);
1.565 albertel 1759: var textarea_height = textarea.offsetHeight;
1760: var bottom = document.getElementById(bottom_id);
1.588 albertel 1761: var bottom_top = getY(bottom);
1.565 albertel 1762: var bottom_height = bottom.offsetHeight;
1763: var window_height = Geometry.getViewportHeight();
1.588 albertel 1764: var fudge = 23;
1.565 albertel 1765: var new_height = window_height-fudge-textarea_top-bottom_height;
1766: if (new_height < 300) {
1767: new_height = 300;
1768: }
1769: textarea.style.height=new_height+'px';
1770: }
1.824 bisitz 1771: // ]]>
1.565 albertel 1772: </script>
1773: RESIZE
1774:
1775: }
1776:
1.1205 golterma 1777: sub colorfuleditor_js {
1.1248 raeburn 1778: my $browse_or_search;
1779: my $respath;
1780: my ($cnum,$cdom) = &crsauthor_url();
1781: if ($cnum) {
1782: $respath = "/res/$cdom/$cnum/";
1783: my %js_lt = &Apache::lonlocal::texthash(
1784: sunm => 'Sub-directory name',
1785: save => 'Save page to make this permanent',
1786: );
1787: &js_escape(\%js_lt);
1788: $browse_or_search = <<"END";
1789:
1790: function toggleChooser(form,element,titleid,only,search) {
1791: var disp = 'none';
1792: if (document.getElementById('chooser_'+element)) {
1793: var curr = document.getElementById('chooser_'+element).style.display;
1794: if (curr == 'none') {
1795: disp='inline';
1796: if (form.elements['chooser_'+element].length) {
1797: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1798: form.elements['chooser_'+element][i].checked = false;
1799: }
1800: }
1801: toggleResImport(form,element);
1802: }
1803: document.getElementById('chooser_'+element).style.display = disp;
1804: }
1805: }
1806:
1807: function toggleCrsFile(form,element,numdirs) {
1808: if (document.getElementById('chooser_'+element+'_crsres')) {
1809: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1810: if (curr == 'none') {
1811: if (numdirs) {
1812: form.elements['coursepath_'+element].selectedIndex = 0;
1813: if (numdirs > 1) {
1814: window['select1'+element+'_changed']();
1815: }
1816: }
1817: }
1818: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1819:
1820: }
1821: if (document.getElementById('chooser_'+element+'_upload')) {
1822: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1823: if (document.getElementById('uploadcrsres_'+element)) {
1824: document.getElementById('uploadcrsres_'+element).value = '';
1825: }
1826: }
1827: return;
1828: }
1829:
1830: function toggleCrsUpload(form,element,numcrsdirs) {
1831: if (document.getElementById('chooser_'+element+'_crsres')) {
1832: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1833: }
1834: if (document.getElementById('chooser_'+element+'_upload')) {
1835: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1836: if (curr == 'none') {
1837: if (numcrsdirs) {
1838: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1839: form.elements['newsubdir_'+element][0].checked = true;
1840: toggleNewsubdir(form,element);
1841: }
1842: }
1843: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1844: }
1845: return;
1846: }
1847:
1848: function toggleResImport(form,element) {
1849: var choices = new Array('crsres','upload');
1850: for (var i=0; i<choices.length; i++) {
1851: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1852: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1853: }
1854: }
1855: }
1856:
1857: function toggleNewsubdir(form,element) {
1858: var newsub = form.elements['newsubdir_'+element];
1859: if (newsub) {
1860: if (newsub.length) {
1861: for (var j=0; j<newsub.length; j++) {
1862: if (newsub[j].checked) {
1863: if (document.getElementById('newsubdirname_'+element)) {
1864: if (newsub[j].value == '1') {
1865: document.getElementById('newsubdirname_'+element).type = "text";
1866: if (document.getElementById('newsubdir_'+element)) {
1867: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1868: }
1869: } else {
1870: document.getElementById('newsubdirname_'+element).type = "hidden";
1871: document.getElementById('newsubdirname_'+element).value = "";
1872: document.getElementById('newsubdir_'+element).innerHTML = "";
1873: }
1874: }
1875: break;
1876: }
1877: }
1878: }
1879: }
1880: }
1881:
1882: function updateCrsFile(form,element) {
1883: var directory = form.elements['coursepath_'+element];
1884: var filename = form.elements['coursefile_'+element];
1885: var path = directory.options[directory.selectedIndex].value;
1886: var file = filename.options[filename.selectedIndex].value;
1887: form.elements[element].value = '$respath';
1888: if (path == '/') {
1889: form.elements[element].value += file;
1890: } else {
1891: form.elements[element].value += path+'/'+file;
1892: }
1893: unClean();
1894: if (document.getElementById('previewimg_'+element)) {
1895: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1896: var newsrc = document.getElementById('previewimg_'+element).src;
1897: }
1898: if (document.getElementById('showimg_'+element)) {
1899: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1900: }
1901: toggleChooser(form,element);
1902: return;
1903: }
1904:
1905: function uploadDone(suffix,name) {
1906: if (name) {
1907: document.forms["lonhomework"].elements[suffix].value = name;
1908: unClean();
1909: toggleChooser(document.forms["lonhomework"],suffix);
1910: }
1911: }
1912:
1913: \$(document).ready(function(){
1914:
1915: \$(document).delegate('form :submit', 'click', function( event ) {
1916: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1917: var buttonId = this.id;
1918: var suffix = buttonId.toString();
1919: suffix = suffix.replace(/^crsupload_/,'');
1920: event.preventDefault();
1921: document.lonhomework.target = 'crsupload_target_'+suffix;
1922: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1923: \$(this.form).submit();
1924: document.lonhomework.target = '';
1925: if (document.getElementById('crsuploadto_'+suffix)) {
1926: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1927: }
1928: return false;
1929: }
1930: });
1931: });
1932: END
1933: }
1.1205 golterma 1934: return <<"COLORFULEDIT"
1935: <script type="text/javascript">
1936: // <![CDATA[>
1937: function fold_box(curDepth, lastresource){
1938:
1939: // we need a list because there can be several blocks you need to fold in one tag
1940: var block = document.getElementsByName('foldblock_'+curDepth);
1941: // but there is only one folding button per tag
1942: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1943:
1944: if(block.item(0).style.display == 'none'){
1945:
1946: foldbutton.value = '@{[&mt("Hide")]}';
1947: for (i = 0; i < block.length; i++){
1948: block.item(i).style.display = '';
1949: }
1950: }else{
1951:
1952: foldbutton.value = '@{[&mt("Show")]}';
1953: for (i = 0; i < block.length; i++){
1954: // block.item(i).style.visibility = 'collapse';
1955: block.item(i).style.display = 'none';
1956: }
1957: };
1958: saveState(lastresource);
1959: }
1960:
1961: function saveState (lastresource) {
1962:
1963: var tag_list = getTagList();
1964: if(tag_list != null){
1965: var timestamp = new Date().getTime();
1966: var key = lastresource;
1967:
1968: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1969: // starting with timestamp
1970: var value = timestamp+';';
1971:
1972: // building the list of key-value pairs
1973: for(var i = 0; i < tag_list.length; i++){
1974: value += tag_list[i]+',';
1975: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1976: }
1977:
1978: // only iterate whole storage if nothing to override
1979: if(localStorage.getItem(key) == null){
1980:
1981: // prevent storage from growing large
1982: if(localStorage.length > 50){
1983: var regex_getTimestamp = /^(?:\d)+;/;
1984: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1985: var oldest_key;
1986:
1987: for(var i = 1; i < localStorage.length; i++){
1988: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1989: oldest_key = localStorage.key(i);
1990: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1991: }
1992: }
1993: localStorage.removeItem(oldest_key);
1994: }
1995: }
1996: localStorage.setItem(key,value);
1997: }
1998: }
1999:
2000: // restore folding status of blocks (on page load)
2001: function restoreState (lastresource) {
2002: if(localStorage.getItem(lastresource) != null){
2003: var key = lastresource;
2004: var value = localStorage.getItem(key);
2005: var regex_delTimestamp = /^\d+;/;
2006:
2007: value.replace(regex_delTimestamp, '');
2008:
2009: var valueArr = value.split(';');
2010: var pairs;
2011: var elements;
2012: for (var i = 0; i < valueArr.length; i++){
2013: pairs = valueArr[i].split(',');
2014: elements = document.getElementsByName(pairs[0]);
2015:
2016: for (var j = 0; j < elements.length; j++){
2017: elements[j].style.display = pairs[1];
2018: if (pairs[1] == "none"){
2019: var regex_id = /([_\\d]+)\$/;
2020: regex_id.exec(pairs[0]);
2021: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2022: }
2023: }
2024: }
2025: }
2026: }
2027:
2028: function getTagList () {
2029:
2030: var stringToSearch = document.lonhomework.innerHTML;
2031:
2032: var ret = new Array();
2033: var regex_findBlock = /(foldblock_.*?)"/g;
2034: var tag_list = stringToSearch.match(regex_findBlock);
2035:
2036: if(tag_list != null){
2037: for(var i = 0; i < tag_list.length; i++){
2038: ret.push(tag_list[i].replace(/"/, ''));
2039: }
2040: }
2041: return ret;
2042: }
2043:
2044: function saveScrollPosition (resource) {
2045: var tag_list = getTagList();
2046:
2047: // we dont always want to jump to the first block
2048: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2049: if(\$(window).scrollTop() > 170){
2050: if(tag_list != null){
2051: var result;
2052: for(var i = 0; i < tag_list.length; i++){
2053: if(isElementInViewport(tag_list[i])){
2054: result += tag_list[i]+';';
2055: }
2056: }
2057: sessionStorage.setItem('anchor_'+resource, result);
2058: }
2059: } else {
2060: // we dont need to save zero, just delete the item to leave everything tidy
2061: sessionStorage.removeItem('anchor_'+resource);
2062: }
2063: }
2064:
2065: function restoreScrollPosition(resource){
2066:
2067: var elem = sessionStorage.getItem('anchor_'+resource);
2068: if(elem != null){
2069: var tag_list = elem.split(';');
2070: var elem_list;
2071:
2072: for(var i = 0; i < tag_list.length; i++){
2073: elem_list = document.getElementsByName(tag_list[i]);
2074:
2075: if(elem_list.length > 0){
2076: elem = elem_list[0];
2077: break;
2078: }
2079: }
2080: elem.scrollIntoView();
2081: }
2082: }
2083:
2084: function isElementInViewport(el) {
2085:
2086: // change to last element instead of first
2087: var elem = document.getElementsByName(el);
2088: var rect = elem[0].getBoundingClientRect();
2089:
2090: return (
2091: rect.top >= 0 &&
2092: rect.left >= 0 &&
2093: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2094: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2095: );
2096: }
2097:
2098: function autosize(depth){
2099: var cmInst = window['cm'+depth];
2100: var fitsizeButton = document.getElementById('fitsize'+depth);
2101:
2102: // is fixed size, switching to dynamic
2103: if (sessionStorage.getItem("autosized_"+depth) == null) {
2104: cmInst.setSize("","auto");
2105: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2106: sessionStorage.setItem("autosized_"+depth, "yes");
2107:
2108: // is dynamic size, switching to fixed
2109: } else {
2110: cmInst.setSize("","300px");
2111: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2112: sessionStorage.removeItem("autosized_"+depth);
2113: }
2114: }
2115:
1.1248 raeburn 2116: $browse_or_search
1.1205 golterma 2117:
2118: // ]]>
2119: </script>
2120: COLORFULEDIT
2121: }
2122:
2123: sub xmleditor_js {
2124: return <<XMLEDIT
2125: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2126: <script type="text/javascript">
2127: // <![CDATA[>
2128:
2129: function saveScrollPosition (resource) {
2130:
2131: var scrollPos = \$(window).scrollTop();
2132: sessionStorage.setItem(resource,scrollPos);
2133: }
2134:
2135: function restoreScrollPosition(resource){
2136:
2137: var scrollPos = sessionStorage.getItem(resource);
2138: \$(window).scrollTop(scrollPos);
2139: }
2140:
2141: // unless internet explorer
2142: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2143:
2144: \$(document).ready(function() {
2145: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2146: });
2147: }
2148:
2149: // inserts text at cursor position into codemirror (xml editor only)
2150: function insertText(text){
2151: cm.focus();
2152: var curPos = cm.getCursor();
2153: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2154: }
2155: // ]]>
2156: </script>
2157: XMLEDIT
2158: }
2159:
2160: sub insert_folding_button {
2161: my $curDepth = $Apache::lonxml::curdepth;
2162: my $lastresource = $env{'request.ambiguous'};
2163:
2164: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2165: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2166: }
2167:
1.1248 raeburn 2168: sub crsauthor_url {
2169: my ($url) = @_;
2170: if ($url eq '') {
2171: $url = $ENV{'REQUEST_URI'};
2172: }
2173: my ($cnum,$cdom);
2174: if ($env{'request.course.id'}) {
2175: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2176: if ($audom ne '' && $auname ne '') {
2177: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2178: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2179: $cnum = $auname;
2180: $cdom = $audom;
2181: }
2182: }
2183: }
2184: return ($cnum,$cdom);
2185: }
2186:
2187: sub import_crsauthor_form {
2188: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix) = @_;
2189: return (0) unless ($env{'request.course.id'});
2190: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2191: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2192: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2193: return (0) unless (($cnum ne '') && ($cdom ne ''));
2194: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2195: my @ids=&Apache::lonnet::current_machine_ids();
2196: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2197:
2198: if (grep(/^\Q$crshome\E$/,@ids)) {
2199: $is_home = 1;
2200: }
2201: $relpath = "/priv/$cdom/$cnum";
2202: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2203: my %lt = &Apache::lonlocal::texthash (
2204: fnam => 'Filename',
2205: dire => 'Directory',
2206: );
2207: my $numdirs = scalar(keys(%files));
2208: my (%possexts,$singledir,@singledirfiles);
2209: if ($only) {
2210: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2211: }
2212: my (%nonemptydirs,$possdirs);
2213: if ($numdirs > 1) {
2214: my @order;
2215: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2216: if (ref($files{$key}) eq 'HASH') {
2217: my $shown = $key;
2218: if ($key eq '') {
2219: $shown = '/';
2220: }
2221: my @ordered = ();
2222: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
2223: if ($only) {
2224: my ($ext) = ($file =~ /\.([^.]+)$/);
2225: unless ($possexts{lc($ext)}) {
2226: next;
2227: }
2228: }
2229: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2230: push(@ordered,$file);
2231: }
2232: if (@ordered) {
2233: push(@order,$key);
2234: $nonemptydirs{$key} = 1;
2235: $selimport_menus{$key}->{'text'} = $shown;
2236: $selimport_menus{$key}->{'default'} = '';
2237: $selimport_menus{$key}->{'select2'}->{''} = '';
2238: $selimport_menus{$key}->{'order'} = \@ordered;
2239: }
2240: }
2241: }
2242: $possdirs = scalar(keys(%nonemptydirs));
2243: if ($possdirs > 1) {
2244: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2245: $output = $lt{'dire'}.
2246: &linked_select_forms($form,'<br />'.
2247: $lt{'fnam'},'',
2248: $firstselectname,$secondselectname,
2249: \%selimport_menus,\@order,
2250: $onchangefirst,'',$suffix).'<br />';
2251: } elsif ($possdirs == 1) {
2252: $singledir = (keys(%nonemptydirs))[0];
2253: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2254: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2255: }
2256: delete($selimport_menus{$singledir});
2257: }
2258: } elsif ($numdirs == 1) {
2259: $singledir = (keys(%files))[0];
2260: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2261: if ($only) {
2262: my ($ext) = ($file =~ /\.([^.]+)$/);
2263: unless ($possexts{lc($ext)}) {
2264: next;
2265: }
2266: }
2267: push(@singledirfiles,$file);
2268: }
2269: if (@singledirfiles) {
2270: $possdirs == 1;
2271: }
2272: }
2273: if (($possdirs == 1) && (@singledirfiles)) {
2274: my $showdir = $singledir;
2275: if ($singledir eq '') {
2276: $showdir = '/';
2277: }
2278: $output = $lt{'dire'}.
2279: '<select name="'.$firstselectname.'">'.
2280: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2281: '</select><br />'.
2282: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2283: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2284: foreach my $file (@singledirfiles) {
2285: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2286: }
2287: $output .= '</select><br />'."\n";
2288: }
2289: return ($possdirs,$output);
2290: }
2291:
1.565 albertel 2292: =pod
2293:
1.256 matthew 2294: =head1 Excel and CSV file utility routines
2295:
2296: =cut
2297:
2298: ###############################################################
2299: ###############################################################
2300:
2301: =pod
2302:
1.1162 raeburn 2303: =over 4
2304:
1.648 raeburn 2305: =item * &csv_translate($text)
1.37 matthew 2306:
1.185 www 2307: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2308: format.
2309:
2310: =cut
2311:
1.180 matthew 2312: ###############################################################
2313: ###############################################################
1.37 matthew 2314: sub csv_translate {
2315: my $text = shift;
2316: $text =~ s/\"/\"\"/g;
1.209 albertel 2317: $text =~ s/\n/ /g;
1.37 matthew 2318: return $text;
2319: }
1.180 matthew 2320:
2321: ###############################################################
2322: ###############################################################
2323:
2324: =pod
2325:
1.648 raeburn 2326: =item * &define_excel_formats()
1.180 matthew 2327:
2328: Define some commonly used Excel cell formats.
2329:
2330: Currently supported formats:
2331:
2332: =over 4
2333:
2334: =item header
2335:
2336: =item bold
2337:
2338: =item h1
2339:
2340: =item h2
2341:
2342: =item h3
2343:
1.256 matthew 2344: =item h4
2345:
2346: =item i
2347:
1.180 matthew 2348: =item date
2349:
2350: =back
2351:
2352: Inputs: $workbook
2353:
2354: Returns: $format, a hash reference.
2355:
1.1057 foxr 2356:
1.180 matthew 2357: =cut
2358:
2359: ###############################################################
2360: ###############################################################
2361: sub define_excel_formats {
2362: my ($workbook) = @_;
2363: my $format;
2364: $format->{'header'} = $workbook->add_format(bold => 1,
2365: bottom => 1,
2366: align => 'center');
2367: $format->{'bold'} = $workbook->add_format(bold=>1);
2368: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2369: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2370: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2371: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2372: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2373: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2374: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2375: return $format;
2376: }
2377:
2378: ###############################################################
2379: ###############################################################
1.113 bowersj2 2380:
2381: =pod
2382:
1.648 raeburn 2383: =item * &create_workbook()
1.255 matthew 2384:
2385: Create an Excel worksheet. If it fails, output message on the
2386: request object and return undefs.
2387:
2388: Inputs: Apache request object
2389:
2390: Returns (undef) on failure,
2391: Excel worksheet object, scalar with filename, and formats
2392: from &Apache::loncommon::define_excel_formats on success
2393:
2394: =cut
2395:
2396: ###############################################################
2397: ###############################################################
2398: sub create_workbook {
2399: my ($r) = @_;
2400: #
2401: # Create the excel spreadsheet
2402: my $filename = '/prtspool/'.
1.258 albertel 2403: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2404: time.'_'.rand(1000000000).'.xls';
2405: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2406: if (! defined($workbook)) {
2407: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2408: $r->print(
2409: '<p class="LC_error">'
2410: .&mt('Problems occurred in creating the new Excel file.')
2411: .' '.&mt('This error has been logged.')
2412: .' '.&mt('Please alert your LON-CAPA administrator.')
2413: .'</p>'
2414: );
1.255 matthew 2415: return (undef);
2416: }
2417: #
1.1014 foxr 2418: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2419: #
2420: my $format = &Apache::loncommon::define_excel_formats($workbook);
2421: return ($workbook,$filename,$format);
2422: }
2423:
2424: ###############################################################
2425: ###############################################################
2426:
2427: =pod
2428:
1.648 raeburn 2429: =item * &create_text_file()
1.113 bowersj2 2430:
1.542 raeburn 2431: Create a file to write to and eventually make available to the user.
1.256 matthew 2432: If file creation fails, outputs an error message on the request object and
2433: return undefs.
1.113 bowersj2 2434:
1.256 matthew 2435: Inputs: Apache request object, and file suffix
1.113 bowersj2 2436:
1.256 matthew 2437: Returns (undef) on failure,
2438: Filehandle and filename on success.
1.113 bowersj2 2439:
2440: =cut
2441:
1.256 matthew 2442: ###############################################################
2443: ###############################################################
2444: sub create_text_file {
2445: my ($r,$suffix) = @_;
2446: if (! defined($suffix)) { $suffix = 'txt'; };
2447: my $fh;
2448: my $filename = '/prtspool/'.
1.258 albertel 2449: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2450: time.'_'.rand(1000000000).'.'.$suffix;
2451: $fh = Apache::File->new('>/home/httpd'.$filename);
2452: if (! defined($fh)) {
2453: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2454: $r->print(
2455: '<p class="LC_error">'
2456: .&mt('Problems occurred in creating the output file.')
2457: .' '.&mt('This error has been logged.')
2458: .' '.&mt('Please alert your LON-CAPA administrator.')
2459: .'</p>'
2460: );
1.113 bowersj2 2461: }
1.256 matthew 2462: return ($fh,$filename)
1.113 bowersj2 2463: }
2464:
2465:
1.256 matthew 2466: =pod
1.113 bowersj2 2467:
2468: =back
2469:
2470: =cut
1.37 matthew 2471:
2472: ###############################################################
1.33 matthew 2473: ## Home server <option> list generating code ##
2474: ###############################################################
1.35 matthew 2475:
1.169 www 2476: # ------------------------------------------
2477:
2478: sub domain_select {
2479: my ($name,$value,$multiple)=@_;
2480: my %domains=map {
1.514 albertel 2481: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2482: } &Apache::lonnet::all_domains();
1.169 www 2483: if ($multiple) {
2484: $domains{''}=&mt('Any domain');
1.550 albertel 2485: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2486: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2487: } else {
1.550 albertel 2488: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2489: return &select_form($name,$value,\%domains);
1.169 www 2490: }
2491: }
2492:
1.282 albertel 2493: #-------------------------------------------
2494:
2495: =pod
2496:
1.519 raeburn 2497: =head1 Routines for form select boxes
2498:
2499: =over 4
2500:
1.648 raeburn 2501: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2502:
2503: Returns a string containing a <select> element int multiple mode
2504:
2505:
2506: Args:
2507: $name - name of the <select> element
1.506 raeburn 2508: $value - scalar or array ref of values that should already be selected
1.282 albertel 2509: $size - number of rows long the select element is
1.283 albertel 2510: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2511: (shown text should already have been &mt())
1.506 raeburn 2512: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2513:
1.282 albertel 2514: =cut
2515:
2516: #-------------------------------------------
1.169 www 2517: sub multiple_select_form {
1.284 albertel 2518: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2519: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2520: my $output='';
1.191 matthew 2521: if (! defined($size)) {
2522: $size = 4;
1.283 albertel 2523: if (scalar(keys(%$hash))<4) {
2524: $size = scalar(keys(%$hash));
1.191 matthew 2525: }
2526: }
1.734 bisitz 2527: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2528: my @order;
1.506 raeburn 2529: if (ref($order) eq 'ARRAY') {
2530: @order = @{$order};
2531: } else {
2532: @order = sort(keys(%$hash));
1.501 banghart 2533: }
2534: if (exists($$hash{'select_form_order'})) {
2535: @order = @{$$hash{'select_form_order'}};
2536: }
2537:
1.284 albertel 2538: foreach my $key (@order) {
1.356 albertel 2539: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2540: $output.='selected="selected" ' if ($selected{$key});
2541: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2542: }
2543: $output.="</select>\n";
2544: return $output;
2545: }
2546:
1.88 www 2547: #-------------------------------------------
2548:
2549: =pod
2550:
1.1254 ! raeburn 2551: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2552:
2553: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2554: allow a user to select options from a ref to a hash containing:
2555: option_name => displayed text. An optional $onchange can include
1.1254 ! raeburn 2556: a javascript onchange item, e.g., onchange="this.form.submit();".
! 2557: An optional arg -- $readonly -- if true will cause the select form
! 2558: to be disabled, e.g., for the case where an instructor has a section-
! 2559: specific role, and is viewing/modifying parameters.
1.970 raeburn 2560:
1.88 www 2561: See lonrights.pm for an example invocation and use.
2562:
2563: =cut
2564:
2565: #-------------------------------------------
2566: sub select_form {
1.1228 raeburn 2567: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2568: return unless (ref($hashref) eq 'HASH');
2569: if ($onchange) {
2570: $onchange = ' onchange="'.$onchange.'"';
2571: }
1.1228 raeburn 2572: my $disabled;
2573: if ($readonly) {
2574: $disabled = ' disabled="disabled"';
2575: }
2576: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2577: my @keys;
1.970 raeburn 2578: if (exists($hashref->{'select_form_order'})) {
2579: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2580: } else {
1.970 raeburn 2581: @keys=sort(keys(%{$hashref}));
1.128 albertel 2582: }
1.356 albertel 2583: foreach my $key (@keys) {
2584: $selectform.=
2585: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2586: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2587: ">".$hashref->{$key}."</option>\n";
1.88 www 2588: }
2589: $selectform.="</select>";
2590: return $selectform;
2591: }
2592:
1.475 www 2593: # For display filters
2594:
2595: sub display_filter {
1.1074 raeburn 2596: my ($context) = @_;
1.475 www 2597: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2598: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2599: my $phraseinput = 'hidden';
2600: my $includeinput = 'hidden';
2601: my ($checked,$includetypestext);
2602: if ($env{'form.displayfilter'} eq 'containing') {
2603: $phraseinput = 'text';
2604: if ($context eq 'parmslog') {
2605: $includeinput = 'checkbox';
2606: if ($env{'form.includetypes'}) {
2607: $checked = ' checked="checked"';
2608: }
2609: $includetypestext = &mt('Include parameter types');
2610: }
2611: } else {
2612: $includetypestext = ' ';
2613: }
2614: my ($additional,$secondid,$thirdid);
2615: if ($context eq 'parmslog') {
2616: $additional =
2617: '<label><input type="'.$includeinput.'" name="includetypes"'.
2618: $checked.' name="includetypes" value="1" id="includetypes" />'.
2619: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2620: '</label>';
2621: $secondid = 'includetypes';
2622: $thirdid = 'includetypestext';
2623: }
2624: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2625: '$secondid','$thirdid')";
2626: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2627: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2628: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2629: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2630: &mt('Filter: [_1]',
1.477 www 2631: &select_form($env{'form.displayfilter'},
2632: 'displayfilter',
1.970 raeburn 2633: {'currentfolder' => 'Current folder/page',
1.477 www 2634: 'containing' => 'Containing phrase',
1.1074 raeburn 2635: 'none' => 'None'},$onchange)).' '.
2636: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2637: &HTML::Entities::encode($env{'form.containingphrase'}).
2638: '" />'.$additional;
2639: }
2640:
2641: sub display_filter_js {
2642: my $includetext = &mt('Include parameter types');
2643: return <<"ENDJS";
2644:
2645: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2646: var firstType = 'hidden';
2647: if (setter.options[setter.selectedIndex].value == 'containing') {
2648: firstType = 'text';
2649: }
2650: firstObject = document.getElementById(firstid);
2651: if (typeof(firstObject) == 'object') {
2652: if (firstObject.type != firstType) {
2653: changeInputType(firstObject,firstType);
2654: }
2655: }
2656: if (context == 'parmslog') {
2657: var secondType = 'hidden';
2658: if (firstType == 'text') {
2659: secondType = 'checkbox';
2660: }
2661: secondObject = document.getElementById(secondid);
2662: if (typeof(secondObject) == 'object') {
2663: if (secondObject.type != secondType) {
2664: changeInputType(secondObject,secondType);
2665: }
2666: }
2667: var textItem = document.getElementById(thirdid);
2668: var currtext = textItem.innerHTML;
2669: var newtext;
2670: if (firstType == 'text') {
2671: newtext = '$includetext';
2672: } else {
2673: newtext = ' ';
2674: }
2675: if (currtext != newtext) {
2676: textItem.innerHTML = newtext;
2677: }
2678: }
2679: return;
2680: }
2681:
2682: function changeInputType(oldObject,newType) {
2683: var newObject = document.createElement('input');
2684: newObject.type = newType;
2685: if (oldObject.size) {
2686: newObject.size = oldObject.size;
2687: }
2688: if (oldObject.value) {
2689: newObject.value = oldObject.value;
2690: }
2691: if (oldObject.name) {
2692: newObject.name = oldObject.name;
2693: }
2694: if (oldObject.id) {
2695: newObject.id = oldObject.id;
2696: }
2697: oldObject.parentNode.replaceChild(newObject,oldObject);
2698: return;
2699: }
2700:
2701: ENDJS
1.475 www 2702: }
2703:
1.167 www 2704: sub gradeleveldescription {
2705: my $gradelevel=shift;
2706: my %gradelevels=(0 => 'Not specified',
2707: 1 => 'Grade 1',
2708: 2 => 'Grade 2',
2709: 3 => 'Grade 3',
2710: 4 => 'Grade 4',
2711: 5 => 'Grade 5',
2712: 6 => 'Grade 6',
2713: 7 => 'Grade 7',
2714: 8 => 'Grade 8',
2715: 9 => 'Grade 9',
2716: 10 => 'Grade 10',
2717: 11 => 'Grade 11',
2718: 12 => 'Grade 12',
2719: 13 => 'Grade 13',
2720: 14 => '100 Level',
2721: 15 => '200 Level',
2722: 16 => '300 Level',
2723: 17 => '400 Level',
2724: 18 => 'Graduate Level');
2725: return &mt($gradelevels{$gradelevel});
2726: }
2727:
1.163 www 2728: sub select_level_form {
2729: my ($deflevel,$name)=@_;
2730: unless ($deflevel) { $deflevel=0; }
1.167 www 2731: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2732: for (my $i=0; $i<=18; $i++) {
2733: $selectform.="<option value=\"$i\" ".
1.253 albertel 2734: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2735: ">".&gradeleveldescription($i)."</option>\n";
2736: }
2737: $selectform.="</select>";
2738: return $selectform;
1.163 www 2739: }
1.167 www 2740:
1.35 matthew 2741: #-------------------------------------------
2742:
1.45 matthew 2743: =pod
2744:
1.1121 raeburn 2745: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2746:
2747: Returns a string containing a <select name='$name' size='1'> form to
2748: allow a user to select the domain to preform an operation in.
2749: See loncreateuser.pm for an example invocation and use.
2750:
1.90 www 2751: If the $includeempty flag is set, it also includes an empty choice ("no domain
2752: selected");
2753:
1.743 raeburn 2754: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2755:
1.910 raeburn 2756: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
2757:
1.1121 raeburn 2758: The optional $incdoms is a reference to an array of domains which will be the only available options.
2759:
2760: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2761:
1.35 matthew 2762: =cut
2763:
2764: #-------------------------------------------
1.34 matthew 2765: sub select_dom_form {
1.1121 raeburn 2766: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2767: if ($onchange) {
1.874 raeburn 2768: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2769: }
1.1121 raeburn 2770: my (@domains,%exclude);
1.910 raeburn 2771: if (ref($incdoms) eq 'ARRAY') {
2772: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2773: } else {
2774: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2775: }
1.90 www 2776: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2777: if (ref($excdoms) eq 'ARRAY') {
2778: map { $exclude{$_} = 1; } @{$excdoms};
2779: }
1.743 raeburn 2780: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2781: foreach my $dom (@domains) {
1.1121 raeburn 2782: next if ($exclude{$dom});
1.356 albertel 2783: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2784: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2785: if ($showdomdesc) {
2786: if ($dom ne '') {
2787: my $domdesc = &Apache::lonnet::domain($dom,'description');
2788: if ($domdesc ne '') {
2789: $selectdomain .= ' ('.$domdesc.')';
2790: }
2791: }
2792: }
2793: $selectdomain .= "</option>\n";
1.34 matthew 2794: }
2795: $selectdomain.="</select>";
2796: return $selectdomain;
2797: }
2798:
1.35 matthew 2799: #-------------------------------------------
2800:
1.45 matthew 2801: =pod
2802:
1.648 raeburn 2803: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2804:
1.586 raeburn 2805: input: 4 arguments (two required, two optional) -
2806: $domain - domain of new user
2807: $name - name of form element
2808: $default - Value of 'default' causes a default item to be first
2809: option, and selected by default.
2810: $hide - Value of 'hide' causes hiding of the name of the server,
2811: if 1 server found, or default, if 0 found.
1.594 raeburn 2812: output: returns 2 items:
1.586 raeburn 2813: (a) form element which contains either:
2814: (i) <select name="$name">
2815: <option value="$hostid1">$hostid $servers{$hostid}</option>
2816: <option value="$hostid2">$hostid $servers{$hostid}</option>
2817: </select>
2818: form item if there are multiple library servers in $domain, or
2819: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2820: if there is only one library server in $domain.
2821:
2822: (b) number of library servers found.
2823:
2824: See loncreateuser.pm for example of use.
1.35 matthew 2825:
2826: =cut
2827:
2828: #-------------------------------------------
1.586 raeburn 2829: sub home_server_form_item {
2830: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2831: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2832: my $result;
2833: my $numlib = keys(%servers);
2834: if ($numlib > 1) {
2835: $result .= '<select name="'.$name.'" />'."\n";
2836: if ($default) {
1.804 bisitz 2837: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2838: '</option>'."\n";
2839: }
2840: foreach my $hostid (sort(keys(%servers))) {
2841: $result.= '<option value="'.$hostid.'">'.
2842: $hostid.' '.$servers{$hostid}."</option>\n";
2843: }
2844: $result .= '</select>'."\n";
2845: } elsif ($numlib == 1) {
2846: my $hostid;
2847: foreach my $item (keys(%servers)) {
2848: $hostid = $item;
2849: }
2850: $result .= '<input type="hidden" name="'.$name.'" value="'.
2851: $hostid.'" />';
2852: if (!$hide) {
2853: $result .= $hostid.' '.$servers{$hostid};
2854: }
2855: $result .= "\n";
2856: } elsif ($default) {
2857: $result .= '<input type="hidden" name="'.$name.
2858: '" value="default" />';
2859: if (!$hide) {
2860: $result .= &mt('default');
2861: }
2862: $result .= "\n";
1.33 matthew 2863: }
1.586 raeburn 2864: return ($result,$numlib);
1.33 matthew 2865: }
1.112 bowersj2 2866:
2867: =pod
2868:
1.534 albertel 2869: =back
2870:
1.112 bowersj2 2871: =cut
1.87 matthew 2872:
2873: ###############################################################
1.112 bowersj2 2874: ## Decoding User Agent ##
1.87 matthew 2875: ###############################################################
2876:
2877: =pod
2878:
1.112 bowersj2 2879: =head1 Decoding the User Agent
2880:
2881: =over 4
2882:
2883: =item * &decode_user_agent()
1.87 matthew 2884:
2885: Inputs: $r
2886:
2887: Outputs:
2888:
2889: =over 4
2890:
1.112 bowersj2 2891: =item * $httpbrowser
1.87 matthew 2892:
1.112 bowersj2 2893: =item * $clientbrowser
1.87 matthew 2894:
1.112 bowersj2 2895: =item * $clientversion
1.87 matthew 2896:
1.112 bowersj2 2897: =item * $clientmathml
1.87 matthew 2898:
1.112 bowersj2 2899: =item * $clientunicode
1.87 matthew 2900:
1.112 bowersj2 2901: =item * $clientos
1.87 matthew 2902:
1.1137 raeburn 2903: =item * $clientmobile
2904:
1.1141 raeburn 2905: =item * $clientinfo
2906:
1.1194 raeburn 2907: =item * $clientosversion
2908:
1.87 matthew 2909: =back
2910:
1.157 matthew 2911: =back
2912:
1.87 matthew 2913: =cut
2914:
2915: ###############################################################
2916: ###############################################################
2917: sub decode_user_agent {
1.247 albertel 2918: my ($r)=@_;
1.87 matthew 2919: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2920: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2921: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2922: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2923: my $clientbrowser='unknown';
2924: my $clientversion='0';
2925: my $clientmathml='';
2926: my $clientunicode='0';
1.1137 raeburn 2927: my $clientmobile=0;
1.1194 raeburn 2928: my $clientosversion='';
1.87 matthew 2929: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2930: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2931: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2932: $clientbrowser=$bname;
2933: $httpbrowser=~/$vreg/i;
2934: $clientversion=$1;
2935: $clientmathml=($clientversion>=$minv);
2936: $clientunicode=($clientversion>=$univ);
2937: }
2938: }
2939: my $clientos='unknown';
1.1141 raeburn 2940: my $clientinfo;
1.87 matthew 2941: if (($httpbrowser=~/linux/i) ||
2942: ($httpbrowser=~/unix/i) ||
2943: ($httpbrowser=~/ux/i) ||
2944: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2945: if (($httpbrowser=~/vax/i) ||
2946: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2947: if ($httpbrowser=~/next/i) { $clientos='next'; }
2948: if (($httpbrowser=~/mac/i) ||
2949: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2950: if ($httpbrowser=~/win/i) {
2951: $clientos='win';
2952: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2953: $clientosversion = $1;
2954: }
2955: }
1.87 matthew 2956: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2957: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2958: $clientmobile=lc($1);
2959: }
1.1141 raeburn 2960: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2961: $clientinfo = 'firefox-'.$1;
2962: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2963: $clientinfo = 'chromeframe-'.$1;
2964: }
1.87 matthew 2965: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2966: $clientunicode,$clientos,$clientmobile,$clientinfo,
2967: $clientosversion);
1.87 matthew 2968: }
2969:
1.32 matthew 2970: ###############################################################
2971: ## Authentication changing form generation subroutines ##
2972: ###############################################################
2973: ##
2974: ## All of the authform_xxxxxxx subroutines take their inputs in a
2975: ## hash, and have reasonable default values.
2976: ##
2977: ## formname = the name given in the <form> tag.
1.35 matthew 2978: #-------------------------------------------
2979:
1.45 matthew 2980: =pod
2981:
1.112 bowersj2 2982: =head1 Authentication Routines
2983:
2984: =over 4
2985:
1.648 raeburn 2986: =item * &authform_xxxxxx()
1.35 matthew 2987:
2988: The authform_xxxxxx subroutines provide javascript and html forms which
2989: handle some of the conveniences required for authentication forms.
2990: This is not an optimal method, but it works.
2991:
2992: =over 4
2993:
1.112 bowersj2 2994: =item * authform_header
1.35 matthew 2995:
1.112 bowersj2 2996: =item * authform_authorwarning
1.35 matthew 2997:
1.112 bowersj2 2998: =item * authform_nochange
1.35 matthew 2999:
1.112 bowersj2 3000: =item * authform_kerberos
1.35 matthew 3001:
1.112 bowersj2 3002: =item * authform_internal
1.35 matthew 3003:
1.112 bowersj2 3004: =item * authform_filesystem
1.35 matthew 3005:
3006: =back
3007:
1.648 raeburn 3008: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3009:
1.35 matthew 3010: =cut
3011:
3012: #-------------------------------------------
1.32 matthew 3013: sub authform_header{
3014: my %in = (
3015: formname => 'cu',
1.80 albertel 3016: kerb_def_dom => '',
1.32 matthew 3017: @_,
3018: );
3019: $in{'formname'} = 'document.' . $in{'formname'};
3020: my $result='';
1.80 albertel 3021:
3022: #---------------------------------------------- Code for upper case translation
3023: my $Javascript_toUpperCase;
3024: unless ($in{kerb_def_dom}) {
3025: $Javascript_toUpperCase =<<"END";
3026: switch (choice) {
3027: case 'krb': currentform.elements[choicearg].value =
3028: currentform.elements[choicearg].value.toUpperCase();
3029: break;
3030: default:
3031: }
3032: END
3033: } else {
3034: $Javascript_toUpperCase = "";
3035: }
3036:
1.165 raeburn 3037: my $radioval = "'nochange'";
1.591 raeburn 3038: if (defined($in{'curr_authtype'})) {
3039: if ($in{'curr_authtype'} ne '') {
3040: $radioval = "'".$in{'curr_authtype'}."arg'";
3041: }
1.174 matthew 3042: }
1.165 raeburn 3043: my $argfield = 'null';
1.591 raeburn 3044: if (defined($in{'mode'})) {
1.165 raeburn 3045: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3046: if (defined($in{'curr_autharg'})) {
3047: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3048: $argfield = "'$in{'curr_autharg'}'";
3049: }
3050: }
3051: }
3052: }
3053:
1.32 matthew 3054: $result.=<<"END";
3055: var current = new Object();
1.165 raeburn 3056: current.radiovalue = $radioval;
3057: current.argfield = $argfield;
1.32 matthew 3058:
3059: function changed_radio(choice,currentform) {
3060: var choicearg = choice + 'arg';
3061: // If a radio button in changed, we need to change the argfield
3062: if (current.radiovalue != choice) {
3063: current.radiovalue = choice;
3064: if (current.argfield != null) {
3065: currentform.elements[current.argfield].value = '';
3066: }
3067: if (choice == 'nochange') {
3068: current.argfield = null;
3069: } else {
3070: current.argfield = choicearg;
3071: switch(choice) {
3072: case 'krb':
3073: currentform.elements[current.argfield].value =
3074: "$in{'kerb_def_dom'}";
3075: break;
3076: default:
3077: break;
3078: }
3079: }
3080: }
3081: return;
3082: }
1.22 www 3083:
1.32 matthew 3084: function changed_text(choice,currentform) {
3085: var choicearg = choice + 'arg';
3086: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3087: $Javascript_toUpperCase
1.32 matthew 3088: // clear old field
3089: if ((current.argfield != choicearg) && (current.argfield != null)) {
3090: currentform.elements[current.argfield].value = '';
3091: }
3092: current.argfield = choicearg;
3093: }
3094: set_auth_radio_buttons(choice,currentform);
3095: return;
1.20 www 3096: }
1.32 matthew 3097:
3098: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3099: var numauthchoices = currentform.login.length;
3100: if (typeof numauthchoices == "undefined") {
3101: return;
3102: }
1.32 matthew 3103: var i=0;
1.986 raeburn 3104: while (i < numauthchoices) {
1.32 matthew 3105: if (currentform.login[i].value == newvalue) { break; }
3106: i++;
3107: }
1.986 raeburn 3108: if (i == numauthchoices) {
1.32 matthew 3109: return;
3110: }
3111: current.radiovalue = newvalue;
3112: currentform.login[i].checked = true;
3113: return;
3114: }
3115: END
3116: return $result;
3117: }
3118:
1.1106 raeburn 3119: sub authform_authorwarning {
1.32 matthew 3120: my $result='';
1.144 matthew 3121: $result='<i>'.
3122: &mt('As a general rule, only authors or co-authors should be '.
3123: 'filesystem authenticated '.
3124: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3125: return $result;
3126: }
3127:
1.1106 raeburn 3128: sub authform_nochange {
1.32 matthew 3129: my %in = (
3130: formname => 'document.cu',
3131: kerb_def_dom => 'MSU.EDU',
3132: @_,
3133: );
1.1106 raeburn 3134: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3135: my $result;
1.1104 raeburn 3136: if (!$authnum) {
1.1105 raeburn 3137: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3138: } else {
3139: $result = '<label>'.&mt('[_1] Do not change login data',
3140: '<input type="radio" name="login" value="nochange" '.
3141: 'checked="checked" onclick="'.
1.281 albertel 3142: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3143: '</label>';
1.586 raeburn 3144: }
1.32 matthew 3145: return $result;
3146: }
3147:
1.591 raeburn 3148: sub authform_kerberos {
1.32 matthew 3149: my %in = (
3150: formname => 'document.cu',
3151: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3152: kerb_def_auth => 'krb4',
1.32 matthew 3153: @_,
3154: );
1.586 raeburn 3155: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
3156: $autharg,$jscall);
1.1106 raeburn 3157: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3158: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3159: $check5 = ' checked="checked"';
1.80 albertel 3160: } else {
1.772 bisitz 3161: $check4 = ' checked="checked"';
1.80 albertel 3162: }
1.165 raeburn 3163: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3164: if (defined($in{'curr_authtype'})) {
3165: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3166: $krbcheck = ' checked="checked"';
1.623 raeburn 3167: if (defined($in{'mode'})) {
3168: if ($in{'mode'} eq 'modifyuser') {
3169: $krbcheck = '';
3170: }
3171: }
1.591 raeburn 3172: if (defined($in{'curr_kerb_ver'})) {
3173: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3174: $check5 = ' checked="checked"';
1.591 raeburn 3175: $check4 = '';
3176: } else {
1.772 bisitz 3177: $check4 = ' checked="checked"';
1.591 raeburn 3178: $check5 = '';
3179: }
1.586 raeburn 3180: }
1.591 raeburn 3181: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3182: $krbarg = $in{'curr_autharg'};
3183: }
1.586 raeburn 3184: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3185: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3186: $result =
3187: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3188: $in{'curr_autharg'},$krbver);
3189: } else {
3190: $result =
3191: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3192: }
3193: return $result;
3194: }
3195: }
3196: } else {
3197: if ($authnum == 1) {
1.784 bisitz 3198: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3199: }
3200: }
1.586 raeburn 3201: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3202: return;
1.587 raeburn 3203: } elsif ($authtype eq '') {
1.591 raeburn 3204: if (defined($in{'mode'})) {
1.587 raeburn 3205: if ($in{'mode'} eq 'modifycourse') {
3206: if ($authnum == 1) {
1.1104 raeburn 3207: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 3208: }
3209: }
3210: }
1.586 raeburn 3211: }
3212: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3213: if ($authtype eq '') {
3214: $authtype = '<input type="radio" name="login" value="krb" '.
3215: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
3216: $krbcheck.' />';
3217: }
3218: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3219: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3220: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3221: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3222: $in{'curr_authtype'} eq 'krb4')) {
3223: $result .= &mt
1.144 matthew 3224: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3225: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3226: '<label>'.$authtype,
1.281 albertel 3227: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3228: 'value="'.$krbarg.'" '.
1.144 matthew 3229: 'onchange="'.$jscall.'" />',
1.281 albertel 3230: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
3231: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
3232: '</label>');
1.586 raeburn 3233: } elsif ($can_assign{'krb4'}) {
3234: $result .= &mt
3235: ('[_1] Kerberos authenticated with domain [_2] '.
3236: '[_3] Version 4 [_4]',
3237: '<label>'.$authtype,
3238: '</label><input type="text" size="10" name="krbarg" '.
3239: 'value="'.$krbarg.'" '.
3240: 'onchange="'.$jscall.'" />',
3241: '<label><input type="hidden" name="krbver" value="4" />',
3242: '</label>');
3243: } elsif ($can_assign{'krb5'}) {
3244: $result .= &mt
3245: ('[_1] Kerberos authenticated with domain [_2] '.
3246: '[_3] Version 5 [_4]',
3247: '<label>'.$authtype,
3248: '</label><input type="text" size="10" name="krbarg" '.
3249: 'value="'.$krbarg.'" '.
3250: 'onchange="'.$jscall.'" />',
3251: '<label><input type="hidden" name="krbver" value="5" />',
3252: '</label>');
3253: }
1.32 matthew 3254: return $result;
3255: }
3256:
1.1106 raeburn 3257: sub authform_internal {
1.586 raeburn 3258: my %in = (
1.32 matthew 3259: formname => 'document.cu',
3260: kerb_def_dom => 'MSU.EDU',
3261: @_,
3262: );
1.586 raeburn 3263: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3264: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3265: if (defined($in{'curr_authtype'})) {
3266: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3267: if ($can_assign{'int'}) {
1.772 bisitz 3268: $intcheck = 'checked="checked" ';
1.623 raeburn 3269: if (defined($in{'mode'})) {
3270: if ($in{'mode'} eq 'modifyuser') {
3271: $intcheck = '';
3272: }
3273: }
1.591 raeburn 3274: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3275: $intarg = $in{'curr_autharg'};
3276: }
3277: } else {
3278: $result = &mt('Currently internally authenticated.');
3279: return $result;
1.165 raeburn 3280: }
3281: }
1.586 raeburn 3282: } else {
3283: if ($authnum == 1) {
1.784 bisitz 3284: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3285: }
3286: }
3287: if (!$can_assign{'int'}) {
3288: return;
1.587 raeburn 3289: } elsif ($authtype eq '') {
1.591 raeburn 3290: if (defined($in{'mode'})) {
1.587 raeburn 3291: if ($in{'mode'} eq 'modifycourse') {
3292: if ($authnum == 1) {
1.1104 raeburn 3293: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 3294: }
3295: }
3296: }
1.165 raeburn 3297: }
1.586 raeburn 3298: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3299: if ($authtype eq '') {
3300: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
3301: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
3302: }
1.605 bisitz 3303: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 3304: $intarg.'" onchange="'.$jscall.'" />';
3305: $result = &mt
1.144 matthew 3306: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3307: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 3308: $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32 matthew 3309: return $result;
3310: }
3311:
1.1104 raeburn 3312: sub authform_local {
1.32 matthew 3313: my %in = (
3314: formname => 'document.cu',
3315: kerb_def_dom => 'MSU.EDU',
3316: @_,
3317: );
1.586 raeburn 3318: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3319: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3320: if (defined($in{'curr_authtype'})) {
3321: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3322: if ($can_assign{'loc'}) {
1.772 bisitz 3323: $loccheck = 'checked="checked" ';
1.623 raeburn 3324: if (defined($in{'mode'})) {
3325: if ($in{'mode'} eq 'modifyuser') {
3326: $loccheck = '';
3327: }
3328: }
1.591 raeburn 3329: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3330: $locarg = $in{'curr_autharg'};
3331: }
3332: } else {
3333: $result = &mt('Currently using local (institutional) authentication.');
3334: return $result;
1.165 raeburn 3335: }
3336: }
1.586 raeburn 3337: } else {
3338: if ($authnum == 1) {
1.784 bisitz 3339: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3340: }
3341: }
3342: if (!$can_assign{'loc'}) {
3343: return;
1.587 raeburn 3344: } elsif ($authtype eq '') {
1.591 raeburn 3345: if (defined($in{'mode'})) {
1.587 raeburn 3346: if ($in{'mode'} eq 'modifycourse') {
3347: if ($authnum == 1) {
1.1104 raeburn 3348: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 3349: }
3350: }
3351: }
1.165 raeburn 3352: }
1.586 raeburn 3353: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3354: if ($authtype eq '') {
3355: $authtype = '<input type="radio" name="login" value="loc" '.
3356: $loccheck.' onchange="'.$jscall.'" onclick="'.
3357: $jscall.'" />';
3358: }
3359: $autharg = '<input type="text" size="10" name="locarg" value="'.
3360: $locarg.'" onchange="'.$jscall.'" />';
3361: $result = &mt('[_1] Local Authentication with argument [_2]',
3362: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3363: return $result;
3364: }
3365:
1.1106 raeburn 3366: sub authform_filesystem {
1.32 matthew 3367: my %in = (
3368: formname => 'document.cu',
3369: kerb_def_dom => 'MSU.EDU',
3370: @_,
3371: );
1.586 raeburn 3372: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 3373: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 3374: if (defined($in{'curr_authtype'})) {
3375: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3376: if ($can_assign{'fsys'}) {
1.772 bisitz 3377: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3378: if (defined($in{'mode'})) {
3379: if ($in{'mode'} eq 'modifyuser') {
3380: $fsyscheck = '';
3381: }
3382: }
1.586 raeburn 3383: } else {
3384: $result = &mt('Currently Filesystem Authenticated.');
3385: return $result;
3386: }
3387: }
3388: } else {
3389: if ($authnum == 1) {
1.784 bisitz 3390: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3391: }
3392: }
3393: if (!$can_assign{'fsys'}) {
3394: return;
1.587 raeburn 3395: } elsif ($authtype eq '') {
1.591 raeburn 3396: if (defined($in{'mode'})) {
1.587 raeburn 3397: if ($in{'mode'} eq 'modifycourse') {
3398: if ($authnum == 1) {
1.1104 raeburn 3399: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 3400: }
3401: }
3402: }
1.586 raeburn 3403: }
3404: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3405: if ($authtype eq '') {
3406: $authtype = '<input type="radio" name="login" value="fsys" '.
3407: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
3408: $jscall.'" />';
3409: }
3410: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
3411: ' onchange="'.$jscall.'" />';
3412: $result = &mt
1.144 matthew 3413: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 3414: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 3415: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 3416: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 3417: 'onchange="'.$jscall.'" />');
1.32 matthew 3418: return $result;
3419: }
3420:
1.586 raeburn 3421: sub get_assignable_auth {
3422: my ($dom) = @_;
3423: if ($dom eq '') {
3424: $dom = $env{'request.role.domain'};
3425: }
3426: my %can_assign = (
3427: krb4 => 1,
3428: krb5 => 1,
3429: int => 1,
3430: loc => 1,
3431: );
3432: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3433: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3434: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3435: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3436: my $context;
3437: if ($env{'request.role'} =~ /^au/) {
3438: $context = 'author';
3439: } elsif ($env{'request.role'} =~ /^dc/) {
3440: $context = 'domain';
3441: } elsif ($env{'request.course.id'}) {
3442: $context = 'course';
3443: }
3444: if ($context) {
3445: if (ref($authhash->{$context}) eq 'HASH') {
3446: %can_assign = %{$authhash->{$context}};
3447: }
3448: }
3449: }
3450: }
3451: my $authnum = 0;
3452: foreach my $key (keys(%can_assign)) {
3453: if ($can_assign{$key}) {
3454: $authnum ++;
3455: }
3456: }
3457: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3458: $authnum --;
3459: }
3460: return ($authnum,%can_assign);
3461: }
3462:
1.80 albertel 3463: ###############################################################
3464: ## Get Kerberos Defaults for Domain ##
3465: ###############################################################
3466: ##
3467: ## Returns default kerberos version and an associated argument
3468: ## as listed in file domain.tab. If not listed, provides
3469: ## appropriate default domain and kerberos version.
3470: ##
3471: #-------------------------------------------
3472:
3473: =pod
3474:
1.648 raeburn 3475: =item * &get_kerberos_defaults()
1.80 albertel 3476:
3477: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3478: version and domain. If not found, it defaults to version 4 and the
3479: domain of the server.
1.80 albertel 3480:
1.648 raeburn 3481: =over 4
3482:
1.80 albertel 3483: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3484:
1.648 raeburn 3485: =back
3486:
3487: =back
3488:
1.80 albertel 3489: =cut
3490:
3491: #-------------------------------------------
3492: sub get_kerberos_defaults {
3493: my $domain=shift;
1.641 raeburn 3494: my ($krbdef,$krbdefdom);
3495: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3496: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3497: $krbdef = $domdefaults{'auth_def'};
3498: $krbdefdom = $domdefaults{'auth_arg_def'};
3499: } else {
1.80 albertel 3500: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3501: my $krbdefdom=$1;
3502: $krbdefdom=~tr/a-z/A-Z/;
3503: $krbdef = "krb4";
3504: }
3505: return ($krbdef,$krbdefdom);
3506: }
1.112 bowersj2 3507:
1.32 matthew 3508:
1.46 matthew 3509: ###############################################################
3510: ## Thesaurus Functions ##
3511: ###############################################################
1.20 www 3512:
1.46 matthew 3513: =pod
1.20 www 3514:
1.112 bowersj2 3515: =head1 Thesaurus Functions
3516:
3517: =over 4
3518:
1.648 raeburn 3519: =item * &initialize_keywords()
1.46 matthew 3520:
3521: Initializes the package variable %Keywords if it is empty. Uses the
3522: package variable $thesaurus_db_file.
3523:
3524: =cut
3525:
3526: ###################################################
3527:
3528: sub initialize_keywords {
3529: return 1 if (scalar keys(%Keywords));
3530: # If we are here, %Keywords is empty, so fill it up
3531: # Make sure the file we need exists...
3532: if (! -e $thesaurus_db_file) {
3533: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3534: " failed because it does not exist");
3535: return 0;
3536: }
3537: # Set up the hash as a database
3538: my %thesaurus_db;
3539: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3540: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3541: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3542: $thesaurus_db_file);
3543: return 0;
3544: }
3545: # Get the average number of appearances of a word.
3546: my $avecount = $thesaurus_db{'average.count'};
3547: # Put keywords (those that appear > average) into %Keywords
3548: while (my ($word,$data)=each (%thesaurus_db)) {
3549: my ($count,undef) = split /:/,$data;
3550: $Keywords{$word}++ if ($count > $avecount);
3551: }
3552: untie %thesaurus_db;
3553: # Remove special values from %Keywords.
1.356 albertel 3554: foreach my $value ('total.count','average.count') {
3555: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3556: }
1.46 matthew 3557: return 1;
3558: }
3559:
3560: ###################################################
3561:
3562: =pod
3563:
1.648 raeburn 3564: =item * &keyword($word)
1.46 matthew 3565:
3566: Returns true if $word is a keyword. A keyword is a word that appears more
3567: than the average number of times in the thesaurus database. Calls
3568: &initialize_keywords
3569:
3570: =cut
3571:
3572: ###################################################
1.20 www 3573:
3574: sub keyword {
1.46 matthew 3575: return if (!&initialize_keywords());
3576: my $word=lc(shift());
3577: $word=~s/\W//g;
3578: return exists($Keywords{$word});
1.20 www 3579: }
1.46 matthew 3580:
3581: ###############################################################
3582:
3583: =pod
1.20 www 3584:
1.648 raeburn 3585: =item * &get_related_words()
1.46 matthew 3586:
1.160 matthew 3587: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3588: an array of words. If the keyword is not in the thesaurus, an empty array
3589: will be returned. The order of the words returned is determined by the
3590: database which holds them.
3591:
3592: Uses global $thesaurus_db_file.
3593:
1.1057 foxr 3594:
1.46 matthew 3595: =cut
3596:
3597: ###############################################################
3598: sub get_related_words {
3599: my $keyword = shift;
3600: my %thesaurus_db;
3601: if (! -e $thesaurus_db_file) {
3602: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3603: "failed because the file does not exist");
3604: return ();
3605: }
3606: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3607: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3608: return ();
3609: }
3610: my @Words=();
1.429 www 3611: my $count=0;
1.46 matthew 3612: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3613: # The first element is the number of times
3614: # the word appears. We do not need it now.
1.429 www 3615: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3616: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3617: my $threshold=$mostfrequentcount/10;
3618: foreach my $possibleword (@RelatedWords) {
3619: my ($word,$wordcount)=split(/\,/,$possibleword);
3620: if ($wordcount>$threshold) {
3621: push(@Words,$word);
3622: $count++;
3623: if ($count>10) { last; }
3624: }
1.20 www 3625: }
3626: }
1.46 matthew 3627: untie %thesaurus_db;
3628: return @Words;
1.14 harris41 3629: }
1.1090 foxr 3630: ###############################################################
3631: #
3632: # Spell checking
3633: #
3634:
3635: =pod
3636:
1.1142 raeburn 3637: =back
3638:
1.1090 foxr 3639: =head1 Spell checking
3640:
3641: =over 4
3642:
3643: =item * &check_spelling($wordlist $language)
3644:
3645: Takes a string containing words and feeds it to an external
3646: spellcheck program via a pipeline. Returns a string containing
3647: them mis-spelled words.
3648:
3649: Parameters:
3650:
3651: =over 4
3652:
3653: =item - $wordlist
3654:
3655: String that will be fed into the spellcheck program.
3656:
3657: =item - $language
3658:
3659: Language string that specifies the language for which the spell
3660: check will be performed.
3661:
3662: =back
3663:
3664: =back
3665:
3666: Note: This sub assumes that aspell is installed.
3667:
3668:
3669: =cut
3670:
1.46 matthew 3671:
1.1090 foxr 3672: sub check_spelling {
3673: my ($wordlist, $language) = @_;
1.1091 foxr 3674: my @misspellings;
3675:
3676: # Generate the speller and set the langauge.
3677: # if explicitly selected:
1.1090 foxr 3678:
1.1091 foxr 3679: my $speller = Text::Aspell->new;
1.1090 foxr 3680: if ($language) {
1.1091 foxr 3681: $speller->set_option('lang', $language);
1.1090 foxr 3682: }
3683:
1.1091 foxr 3684: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3685:
1.1091 foxr 3686: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3687:
1.1091 foxr 3688: foreach my $word (@words) {
3689: if(! $speller->check($word)) {
3690: push(@misspellings, $word);
1.1090 foxr 3691: }
3692: }
1.1091 foxr 3693: return join(' ', @misspellings);
3694:
1.1090 foxr 3695: }
3696:
1.61 www 3697: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3698: =pod
3699:
1.112 bowersj2 3700: =head1 User Name Functions
3701:
3702: =over 4
3703:
1.648 raeburn 3704: =item * &plainname($uname,$udom,$first)
1.81 albertel 3705:
1.112 bowersj2 3706: Takes a users logon name and returns it as a string in
1.226 albertel 3707: "first middle last generation" form
3708: if $first is set to 'lastname' then it returns it as
3709: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3710:
3711: =cut
1.61 www 3712:
1.295 www 3713:
1.81 albertel 3714: ###############################################################
1.61 www 3715: sub plainname {
1.226 albertel 3716: my ($uname,$udom,$first)=@_;
1.537 albertel 3717: return if (!defined($uname) || !defined($udom));
1.295 www 3718: my %names=&getnames($uname,$udom);
1.226 albertel 3719: my $name=&Apache::lonnet::format_name($names{'firstname'},
3720: $names{'middlename'},
3721: $names{'lastname'},
3722: $names{'generation'},$first);
3723: $name=~s/^\s+//;
1.62 www 3724: $name=~s/\s+$//;
3725: $name=~s/\s+/ /g;
1.353 albertel 3726: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3727: return $name;
1.61 www 3728: }
1.66 www 3729:
3730: # -------------------------------------------------------------------- Nickname
1.81 albertel 3731: =pod
3732:
1.648 raeburn 3733: =item * &nickname($uname,$udom)
1.81 albertel 3734:
3735: Gets a users name and returns it as a string as
3736:
3737: ""nickname""
1.66 www 3738:
1.81 albertel 3739: if the user has a nickname or
3740:
3741: "first middle last generation"
3742:
3743: if the user does not
3744:
3745: =cut
1.66 www 3746:
3747: sub nickname {
3748: my ($uname,$udom)=@_;
1.537 albertel 3749: return if (!defined($uname) || !defined($udom));
1.295 www 3750: my %names=&getnames($uname,$udom);
1.68 albertel 3751: my $name=$names{'nickname'};
1.66 www 3752: if ($name) {
3753: $name='"'.$name.'"';
3754: } else {
3755: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3756: $names{'lastname'}.' '.$names{'generation'};
3757: $name=~s/\s+$//;
3758: $name=~s/\s+/ /g;
3759: }
3760: return $name;
3761: }
3762:
1.295 www 3763: sub getnames {
3764: my ($uname,$udom)=@_;
1.537 albertel 3765: return if (!defined($uname) || !defined($udom));
1.433 albertel 3766: if ($udom eq 'public' && $uname eq 'public') {
3767: return ('lastname' => &mt('Public'));
3768: }
1.295 www 3769: my $id=$uname.':'.$udom;
3770: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3771: if ($cached) {
3772: return %{$names};
3773: } else {
3774: my %loadnames=&Apache::lonnet::get('environment',
3775: ['firstname','middlename','lastname','generation','nickname'],
3776: $udom,$uname);
3777: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3778: return %loadnames;
3779: }
3780: }
1.61 www 3781:
1.542 raeburn 3782: # -------------------------------------------------------------------- getemails
1.648 raeburn 3783:
1.542 raeburn 3784: =pod
3785:
1.648 raeburn 3786: =item * &getemails($uname,$udom)
1.542 raeburn 3787:
3788: Gets a user's email information and returns it as a hash with keys:
3789: notification, critnotification, permanentemail
3790:
3791: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3792: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3793:
1.648 raeburn 3794:
1.542 raeburn 3795: =cut
3796:
1.648 raeburn 3797:
1.466 albertel 3798: sub getemails {
3799: my ($uname,$udom)=@_;
3800: if ($udom eq 'public' && $uname eq 'public') {
3801: return;
3802: }
1.467 www 3803: if (!$udom) { $udom=$env{'user.domain'}; }
3804: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3805: my $id=$uname.':'.$udom;
3806: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3807: if ($cached) {
3808: return %{$names};
3809: } else {
3810: my %loadnames=&Apache::lonnet::get('environment',
3811: ['notification','critnotification',
3812: 'permanentemail'],
3813: $udom,$uname);
3814: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3815: return %loadnames;
3816: }
3817: }
3818:
1.551 albertel 3819: sub flush_email_cache {
3820: my ($uname,$udom)=@_;
3821: if (!$udom) { $udom =$env{'user.domain'}; }
3822: if (!$uname) { $uname=$env{'user.name'}; }
3823: return if ($udom eq 'public' && $uname eq 'public');
3824: my $id=$uname.':'.$udom;
3825: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3826: }
3827:
1.728 raeburn 3828: # -------------------------------------------------------------------- getlangs
3829:
3830: =pod
3831:
3832: =item * &getlangs($uname,$udom)
3833:
3834: Gets a user's language preference and returns it as a hash with key:
3835: language.
3836:
3837: =cut
3838:
3839:
3840: sub getlangs {
3841: my ($uname,$udom) = @_;
3842: if (!$udom) { $udom =$env{'user.domain'}; }
3843: if (!$uname) { $uname=$env{'user.name'}; }
3844: my $id=$uname.':'.$udom;
3845: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3846: if ($cached) {
3847: return %{$langs};
3848: } else {
3849: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3850: $udom,$uname);
3851: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3852: return %loadlangs;
3853: }
3854: }
3855:
3856: sub flush_langs_cache {
3857: my ($uname,$udom)=@_;
3858: if (!$udom) { $udom =$env{'user.domain'}; }
3859: if (!$uname) { $uname=$env{'user.name'}; }
3860: return if ($udom eq 'public' && $uname eq 'public');
3861: my $id=$uname.':'.$udom;
3862: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3863: }
3864:
1.61 www 3865: # ------------------------------------------------------------------ Screenname
1.81 albertel 3866:
3867: =pod
3868:
1.648 raeburn 3869: =item * &screenname($uname,$udom)
1.81 albertel 3870:
3871: Gets a users screenname and returns it as a string
3872:
3873: =cut
1.61 www 3874:
3875: sub screenname {
3876: my ($uname,$udom)=@_;
1.258 albertel 3877: if ($uname eq $env{'user.name'} &&
3878: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3879: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3880: return $names{'screenname'};
1.62 www 3881: }
3882:
1.212 albertel 3883:
1.802 bisitz 3884: # ------------------------------------------------------------- Confirm Wrapper
3885: =pod
3886:
1.1142 raeburn 3887: =item * &confirmwrapper($message)
1.802 bisitz 3888:
3889: Wrap messages about completion of operation in box
3890:
3891: =cut
3892:
3893: sub confirmwrapper {
3894: my ($message)=@_;
3895: if ($message) {
3896: return "\n".'<div class="LC_confirm_box">'."\n"
3897: .$message."\n"
3898: .'</div>'."\n";
3899: } else {
3900: return $message;
3901: }
3902: }
3903:
1.62 www 3904: # ------------------------------------------------------------- Message Wrapper
3905:
3906: sub messagewrapper {
1.369 www 3907: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3908: return
1.441 albertel 3909: '<a href="/adm/email?compose=individual&'.
3910: 'recname='.$username.'&recdom='.$domain.
3911: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3912: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3913: }
1.802 bisitz 3914:
1.74 www 3915: # --------------------------------------------------------------- Notes Wrapper
3916:
3917: sub noteswrapper {
3918: my ($link,$un,$do)=@_;
3919: return
1.896 amueller 3920: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3921: }
1.802 bisitz 3922:
1.62 www 3923: # ------------------------------------------------------------- Aboutme Wrapper
3924:
3925: sub aboutmewrapper {
1.1070 raeburn 3926: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3927: if (!defined($username) && !defined($domain)) {
3928: return;
3929: }
1.1096 raeburn 3930: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3931: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3932: }
3933:
3934: # ------------------------------------------------------------ Syllabus Wrapper
3935:
3936: sub syllabuswrapper {
1.707 bisitz 3937: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3938: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3939: }
1.14 harris41 3940:
1.802 bisitz 3941: # -----------------------------------------------------------------------------
3942:
1.208 matthew 3943: sub track_student_link {
1.887 raeburn 3944: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3945: my $link ="/adm/trackstudent?";
1.208 matthew 3946: my $title = 'View recent activity';
3947: if (defined($sname) && $sname !~ /^\s*$/ &&
3948: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3949: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3950: $title .= ' of this student';
1.268 albertel 3951: }
1.208 matthew 3952: if (defined($target) && $target !~ /^\s*$/) {
3953: $target = qq{target="$target"};
3954: } else {
3955: $target = '';
3956: }
1.268 albertel 3957: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3958: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3959: $title = &mt($title);
3960: $linktext = &mt($linktext);
1.448 albertel 3961: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3962: &help_open_topic('View_recent_activity');
1.208 matthew 3963: }
3964:
1.781 raeburn 3965: sub slot_reservations_link {
3966: my ($linktext,$sname,$sdom,$target) = @_;
3967: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3968: my $title = 'View slot reservation history';
3969: if (defined($sname) && $sname !~ /^\s*$/ &&
3970: defined($sdom) && $sdom !~ /^\s*$/) {
3971: $link .= "&uname=$sname&udom=$sdom";
3972: $title .= ' of this student';
3973: }
3974: if (defined($target) && $target !~ /^\s*$/) {
3975: $target = qq{target="$target"};
3976: } else {
3977: $target = '';
3978: }
3979: $title = &mt($title);
3980: $linktext = &mt($linktext);
3981: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3982: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3983:
3984: }
3985:
1.508 www 3986: # ===================================================== Display a student photo
3987:
3988:
1.509 albertel 3989: sub student_image_tag {
1.508 www 3990: my ($domain,$user)=@_;
3991: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3992: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3993: return '<img src="'.$imgsrc.'" align="right" />';
3994: } else {
3995: return '';
3996: }
3997: }
3998:
1.112 bowersj2 3999: =pod
4000:
4001: =back
4002:
4003: =head1 Access .tab File Data
4004:
4005: =over 4
4006:
1.648 raeburn 4007: =item * &languageids()
1.112 bowersj2 4008:
4009: returns list of all language ids
4010:
4011: =cut
4012:
1.14 harris41 4013: sub languageids {
1.16 harris41 4014: return sort(keys(%language));
1.14 harris41 4015: }
4016:
1.112 bowersj2 4017: =pod
4018:
1.648 raeburn 4019: =item * &languagedescription()
1.112 bowersj2 4020:
4021: returns description of a specified language id
4022:
4023: =cut
4024:
1.14 harris41 4025: sub languagedescription {
1.125 www 4026: my $code=shift;
4027: return ($supported_language{$code}?'* ':'').
4028: $language{$code}.
1.126 www 4029: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4030: }
4031:
1.1048 foxr 4032: =pod
4033:
4034: =item * &plainlanguagedescription
4035:
4036: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4037: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4038:
4039: =cut
4040:
1.145 www 4041: sub plainlanguagedescription {
4042: my $code=shift;
4043: return $language{$code};
4044: }
4045:
1.1048 foxr 4046: =pod
4047:
4048: =item * &supportedlanguagecode
4049:
4050: Returns the supported language code (e.g. sptutf maps to pt) given a language
4051: code.
4052:
4053: =cut
4054:
1.145 www 4055: sub supportedlanguagecode {
4056: my $code=shift;
4057: return $supported_language{$code};
1.97 www 4058: }
4059:
1.112 bowersj2 4060: =pod
4061:
1.1048 foxr 4062: =item * &latexlanguage()
4063:
4064: Given a language key code returns the correspondnig language to use
4065: to select the correct hyphenation on LaTeX printouts. This is undef if there
4066: is no supported hyphenation for the language code.
4067:
4068: =cut
4069:
4070: sub latexlanguage {
4071: my $code = shift;
4072: return $latex_language{$code};
4073: }
4074:
4075: =pod
4076:
4077: =item * &latexhyphenation()
4078:
4079: Same as above but what's supplied is the language as it might be stored
4080: in the metadata.
4081:
4082: =cut
4083:
4084: sub latexhyphenation {
4085: my $key = shift;
4086: return $latex_language_bykey{$key};
4087: }
4088:
4089: =pod
4090:
1.648 raeburn 4091: =item * ©rightids()
1.112 bowersj2 4092:
4093: returns list of all copyrights
4094:
4095: =cut
4096:
4097: sub copyrightids {
4098: return sort(keys(%cprtag));
4099: }
4100:
4101: =pod
4102:
1.648 raeburn 4103: =item * ©rightdescription()
1.112 bowersj2 4104:
4105: returns description of a specified copyright id
4106:
4107: =cut
4108:
4109: sub copyrightdescription {
1.166 www 4110: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4111: }
1.197 matthew 4112:
4113: =pod
4114:
1.648 raeburn 4115: =item * &source_copyrightids()
1.192 taceyjo1 4116:
4117: returns list of all source copyrights
4118:
4119: =cut
4120:
4121: sub source_copyrightids {
4122: return sort(keys(%scprtag));
4123: }
4124:
4125: =pod
4126:
1.648 raeburn 4127: =item * &source_copyrightdescription()
1.192 taceyjo1 4128:
4129: returns description of a specified source copyright id
4130:
4131: =cut
4132:
4133: sub source_copyrightdescription {
4134: return &mt($scprtag{shift(@_)});
4135: }
1.112 bowersj2 4136:
4137: =pod
4138:
1.648 raeburn 4139: =item * &filecategories()
1.112 bowersj2 4140:
4141: returns list of all file categories
4142:
4143: =cut
4144:
4145: sub filecategories {
4146: return sort(keys(%category_extensions));
4147: }
4148:
4149: =pod
4150:
1.648 raeburn 4151: =item * &filecategorytypes()
1.112 bowersj2 4152:
4153: returns list of file types belonging to a given file
4154: category
4155:
4156: =cut
4157:
4158: sub filecategorytypes {
1.356 albertel 4159: my ($cat) = @_;
1.1248 raeburn 4160: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4161: return @{$category_extensions{lc($cat)}};
4162: } else {
4163: return ();
4164: }
1.112 bowersj2 4165: }
4166:
4167: =pod
4168:
1.648 raeburn 4169: =item * &fileembstyle()
1.112 bowersj2 4170:
4171: returns embedding style for a specified file type
4172:
4173: =cut
4174:
4175: sub fileembstyle {
4176: return $fe{lc(shift(@_))};
1.169 www 4177: }
4178:
1.351 www 4179: sub filemimetype {
4180: return $fm{lc(shift(@_))};
4181: }
4182:
1.169 www 4183:
4184: sub filecategoryselect {
4185: my ($name,$value)=@_;
1.189 matthew 4186: return &select_form($value,$name,
1.970 raeburn 4187: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4188: }
4189:
4190: =pod
4191:
1.648 raeburn 4192: =item * &filedescription()
1.112 bowersj2 4193:
4194: returns description for a specified file type
4195:
4196: =cut
4197:
4198: sub filedescription {
1.188 matthew 4199: my $file_description = $fd{lc(shift())};
4200: $file_description =~ s:([\[\]]):~$1:g;
4201: return &mt($file_description);
1.112 bowersj2 4202: }
4203:
4204: =pod
4205:
1.648 raeburn 4206: =item * &filedescriptionex()
1.112 bowersj2 4207:
4208: returns description for a specified file type with
4209: extra formatting
4210:
4211: =cut
4212:
4213: sub filedescriptionex {
4214: my $ex=shift;
1.188 matthew 4215: my $file_description = $fd{lc($ex)};
4216: $file_description =~ s:([\[\]]):~$1:g;
4217: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4218: }
4219:
4220: # End of .tab access
4221: =pod
4222:
4223: =back
4224:
4225: =cut
4226:
4227: # ------------------------------------------------------------------ File Types
4228: sub fileextensions {
4229: return sort(keys(%fe));
4230: }
4231:
1.97 www 4232: # ----------------------------------------------------------- Display Languages
4233: # returns a hash with all desired display languages
4234: #
4235:
4236: sub display_languages {
4237: my %languages=();
1.695 raeburn 4238: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4239: $languages{$lang}=1;
1.97 www 4240: }
4241: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4242: if ($env{'form.displaylanguage'}) {
1.356 albertel 4243: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4244: $languages{$lang}=1;
1.97 www 4245: }
4246: }
4247: return %languages;
1.14 harris41 4248: }
4249:
1.582 albertel 4250: sub languages {
4251: my ($possible_langs) = @_;
1.695 raeburn 4252: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4253: if (!ref($possible_langs)) {
4254: if( wantarray ) {
4255: return @preferred_langs;
4256: } else {
4257: return $preferred_langs[0];
4258: }
4259: }
4260: my %possibilities = map { $_ => 1 } (@$possible_langs);
4261: my @preferred_possibilities;
4262: foreach my $preferred_lang (@preferred_langs) {
4263: if (exists($possibilities{$preferred_lang})) {
4264: push(@preferred_possibilities, $preferred_lang);
4265: }
4266: }
4267: if( wantarray ) {
4268: return @preferred_possibilities;
4269: }
4270: return $preferred_possibilities[0];
4271: }
4272:
1.742 raeburn 4273: sub user_lang {
4274: my ($touname,$toudom,$fromcid) = @_;
4275: my @userlangs;
4276: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4277: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4278: $env{'course.'.$fromcid.'.languages'}));
4279: } else {
4280: my %langhash = &getlangs($touname,$toudom);
4281: if ($langhash{'languages'} ne '') {
4282: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4283: } else {
4284: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4285: if ($domdefs{'lang_def'} ne '') {
4286: @userlangs = ($domdefs{'lang_def'});
4287: }
4288: }
4289: }
4290: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4291: my $user_lh = Apache::localize->get_handle(@languages);
4292: return $user_lh;
4293: }
4294:
4295:
1.112 bowersj2 4296: ###############################################################
4297: ## Student Answer Attempts ##
4298: ###############################################################
4299:
4300: =pod
4301:
4302: =head1 Alternate Problem Views
4303:
4304: =over 4
4305:
1.648 raeburn 4306: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4307: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4308:
4309: Return string with previous attempt on problem. Arguments:
4310:
4311: =over 4
4312:
4313: =item * $symb: Problem, including path
4314:
4315: =item * $username: username of the desired student
4316:
4317: =item * $domain: domain of the desired student
1.14 harris41 4318:
1.112 bowersj2 4319: =item * $course: Course ID
1.14 harris41 4320:
1.112 bowersj2 4321: =item * $getattempt: Leave blank for all attempts, otherwise put
4322: something
1.14 harris41 4323:
1.112 bowersj2 4324: =item * $regexp: if string matches this regexp, the string will be
4325: sent to $gradesub
1.14 harris41 4326:
1.112 bowersj2 4327: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4328:
1.1199 raeburn 4329: =item * $usec: section of the desired student
4330:
4331: =item * $identifier: counter for student (multiple students one problem) or
4332: problem (one student; whole sequence).
4333:
1.112 bowersj2 4334: =back
1.14 harris41 4335:
1.112 bowersj2 4336: The output string is a table containing all desired attempts, if any.
1.16 harris41 4337:
1.112 bowersj2 4338: =cut
1.1 albertel 4339:
4340: sub get_previous_attempt {
1.1199 raeburn 4341: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4342: my $prevattempts='';
1.43 ng 4343: no strict 'refs';
1.1 albertel 4344: if ($symb) {
1.3 albertel 4345: my (%returnhash)=
4346: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4347: if ($returnhash{'version'}) {
4348: my %lasthash=();
4349: my $version;
4350: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4351: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4352: if ($key =~ /\.rawrndseed$/) {
4353: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4354: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4355: } else {
4356: $lasthash{$key}=$returnhash{$version.':'.$key};
4357: }
1.19 harris41 4358: }
1.1 albertel 4359: }
1.596 albertel 4360: $prevattempts=&start_data_table().&start_data_table_header_row();
4361: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4362: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4363: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4364: foreach my $key (sort(keys(%lasthash))) {
4365: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4366: if ($#parts > 0) {
1.31 albertel 4367: my $data=$parts[-1];
1.989 raeburn 4368: next if ($data eq 'foilorder');
1.31 albertel 4369: pop(@parts);
1.1010 www 4370: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4371: if ($data eq 'type') {
4372: unless ($showsurv) {
4373: my $id = join(',',@parts);
4374: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4375: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4376: $lasthidden{$ign.'.'.$id} = 1;
4377: }
1.945 raeburn 4378: }
1.1199 raeburn 4379: if ($identifier ne '') {
4380: my $id = join(',',@parts);
4381: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4382: $domain,$username,$usec,undef,$course) =~ /^no/) {
4383: $hidestatus{$ign.'.'.$id} = 1;
4384: }
4385: }
4386: } elsif ($data eq 'regrader') {
4387: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4388: my $id = join(',',@parts);
4389: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4390: }
1.1010 www 4391: }
1.31 albertel 4392: } else {
1.41 ng 4393: if ($#parts == 0) {
4394: $prevattempts.='<th>'.$parts[0].'</th>';
4395: } else {
4396: $prevattempts.='<th>'.$ign.'</th>';
4397: }
1.31 albertel 4398: }
1.16 harris41 4399: }
1.596 albertel 4400: $prevattempts.=&end_data_table_header_row();
1.40 ng 4401: if ($getattempt eq '') {
1.1199 raeburn 4402: my (%solved,%resets,%probstatus);
1.1200 raeburn 4403: if (($identifier ne '') && (keys(%regraded) > 0)) {
4404: for ($version=1;$version<=$returnhash{'version'};$version++) {
4405: foreach my $id (keys(%regraded)) {
4406: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4407: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4408: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4409: push(@{$resets{$id}},$version);
1.1199 raeburn 4410: }
4411: }
4412: }
1.1200 raeburn 4413: }
4414: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4415: my (@hidden,@unsolved);
1.945 raeburn 4416: if (%typeparts) {
4417: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4418: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4419: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4420: push(@hidden,$id);
1.1199 raeburn 4421: } elsif ($identifier ne '') {
4422: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4423: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4424: ($hidestatus{$id})) {
1.1200 raeburn 4425: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4426: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4427: push(@{$solved{$id}},$version);
4428: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4429: (ref($solved{$id}) eq 'ARRAY')) {
4430: my $skip;
4431: if (ref($resets{$id}) eq 'ARRAY') {
4432: foreach my $reset (@{$resets{$id}}) {
4433: if ($reset > $solved{$id}[-1]) {
4434: $skip=1;
4435: last;
4436: }
4437: }
4438: }
4439: unless ($skip) {
4440: my ($ign,$partslist) = split(/\./,$id,2);
4441: push(@unsolved,$partslist);
4442: }
4443: }
4444: }
1.945 raeburn 4445: }
4446: }
4447: }
4448: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4449: '<td>'.&mt('Transaction [_1]',$version);
4450: if (@unsolved) {
4451: $prevattempts .= '<span class="LC_nobreak"><label>'.
4452: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4453: &mt('Hide').'</label></span>';
4454: }
4455: $prevattempts .= '</td>';
1.945 raeburn 4456: if (@hidden) {
4457: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4458: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4459: my $hide;
4460: foreach my $id (@hidden) {
4461: if ($key =~ /^\Q$id\E/) {
4462: $hide = 1;
4463: last;
4464: }
4465: }
4466: if ($hide) {
4467: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4468: if (($data eq 'award') || ($data eq 'awarddetail')) {
4469: my $value = &format_previous_attempt_value($key,
4470: $returnhash{$version.':'.$key});
1.1173 kruse 4471: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4472: } else {
4473: $prevattempts.='<td> </td>';
4474: }
4475: } else {
4476: if ($key =~ /\./) {
1.1212 raeburn 4477: my $value = $returnhash{$version.':'.$key};
4478: if ($key =~ /\.rndseed$/) {
4479: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4480: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4481: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4482: }
4483: }
4484: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4485: ' </td>';
1.945 raeburn 4486: } else {
4487: $prevattempts.='<td> </td>';
4488: }
4489: }
4490: }
4491: } else {
4492: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4493: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4494: my $value = $returnhash{$version.':'.$key};
4495: if ($key =~ /\.rndseed$/) {
4496: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4497: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4498: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4499: }
4500: }
4501: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4502: ' </td>';
1.945 raeburn 4503: }
4504: }
4505: $prevattempts.=&end_data_table_row();
1.40 ng 4506: }
1.1 albertel 4507: }
1.945 raeburn 4508: my @currhidden = keys(%lasthidden);
1.596 albertel 4509: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4510: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4511: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4512: if (%typeparts) {
4513: my $hidden;
4514: foreach my $id (@currhidden) {
4515: if ($key =~ /^\Q$id\E/) {
4516: $hidden = 1;
4517: last;
4518: }
4519: }
4520: if ($hidden) {
4521: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4522: if (($data eq 'award') || ($data eq 'awarddetail')) {
4523: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4524: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4525: $value = &$gradesub($value);
4526: }
1.1173 kruse 4527: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4528: } else {
4529: $prevattempts.='<td> </td>';
4530: }
4531: } else {
4532: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4533: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4534: $value = &$gradesub($value);
4535: }
1.1173 kruse 4536: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4537: }
4538: } else {
4539: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4540: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4541: $value = &$gradesub($value);
4542: }
1.1173 kruse 4543: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4544: }
1.16 harris41 4545: }
1.596 albertel 4546: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4547: } else {
1.596 albertel 4548: $prevattempts=
4549: &start_data_table().&start_data_table_row().
4550: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4551: &end_data_table_row().&end_data_table();
1.1 albertel 4552: }
4553: } else {
1.596 albertel 4554: $prevattempts=
4555: &start_data_table().&start_data_table_row().
4556: '<td>'.&mt('No data.').'</td>'.
4557: &end_data_table_row().&end_data_table();
1.1 albertel 4558: }
1.10 albertel 4559: }
4560:
1.581 albertel 4561: sub format_previous_attempt_value {
4562: my ($key,$value) = @_;
1.1011 www 4563: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4564: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4565: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4566: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4567: } elsif ($key =~ /answerstring$/) {
4568: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4569: my @answer = %answers;
4570: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4571: my @anskeys = sort(keys(%answers));
4572: if (@anskeys == 1) {
4573: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4574: if ($answer =~ m{\0}) {
4575: $answer =~ s{\0}{,}g;
1.988 raeburn 4576: }
4577: my $tag_internal_answer_name = 'INTERNAL';
4578: if ($anskeys[0] eq $tag_internal_answer_name) {
4579: $value = $answer;
4580: } else {
4581: $value = $anskeys[0].'='.$answer;
4582: }
4583: } else {
4584: foreach my $ans (@anskeys) {
4585: my $answer = $answers{$ans};
1.1001 raeburn 4586: if ($answer =~ m{\0}) {
4587: $answer =~ s{\0}{,}g;
1.988 raeburn 4588: }
4589: $value .= $ans.'='.$answer.'<br />';;
4590: }
4591: }
1.581 albertel 4592: } else {
1.1173 kruse 4593: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4594: }
4595: return $value;
4596: }
4597:
4598:
1.107 albertel 4599: sub relative_to_absolute {
4600: my ($url,$output)=@_;
4601: my $parser=HTML::TokeParser->new(\$output);
4602: my $token;
4603: my $thisdir=$url;
4604: my @rlinks=();
4605: while ($token=$parser->get_token) {
4606: if ($token->[0] eq 'S') {
4607: if ($token->[1] eq 'a') {
4608: if ($token->[2]->{'href'}) {
4609: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4610: }
4611: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4612: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4613: } elsif ($token->[1] eq 'base') {
4614: $thisdir=$token->[2]->{'href'};
4615: }
4616: }
4617: }
4618: $thisdir=~s-/[^/]*$--;
1.356 albertel 4619: foreach my $link (@rlinks) {
1.726 raeburn 4620: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4621: ($link=~/^\//) ||
4622: ($link=~/^javascript:/i) ||
4623: ($link=~/^mailto:/i) ||
4624: ($link=~/^\#/)) {
4625: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4626: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4627: }
4628: }
4629: # -------------------------------------------------- Deal with Applet codebases
4630: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4631: return $output;
4632: }
4633:
1.112 bowersj2 4634: =pod
4635:
1.648 raeburn 4636: =item * &get_student_view()
1.112 bowersj2 4637:
4638: show a snapshot of what student was looking at
4639:
4640: =cut
4641:
1.10 albertel 4642: sub get_student_view {
1.186 albertel 4643: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4644: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4645: my (%form);
1.10 albertel 4646: my @elements=('symb','courseid','domain','username');
4647: foreach my $element (@elements) {
1.186 albertel 4648: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4649: }
1.186 albertel 4650: if (defined($moreenv)) {
4651: %form=(%form,%{$moreenv});
4652: }
1.236 albertel 4653: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4654: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4655: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4656: $userview=~s/\<body[^\>]*\>//gi;
4657: $userview=~s/\<\/body\>//gi;
4658: $userview=~s/\<html\>//gi;
4659: $userview=~s/\<\/html\>//gi;
4660: $userview=~s/\<head\>//gi;
4661: $userview=~s/\<\/head\>//gi;
4662: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4663: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4664: if (wantarray) {
4665: return ($userview,$response);
4666: } else {
4667: return $userview;
4668: }
4669: }
4670:
4671: sub get_student_view_with_retries {
4672: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4673:
4674: my $ok = 0; # True if we got a good response.
4675: my $content;
4676: my $response;
4677:
4678: # Try to get the student_view done. within the retries count:
4679:
4680: do {
4681: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4682: $ok = $response->is_success;
4683: if (!$ok) {
4684: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4685: }
4686: $retries--;
4687: } while (!$ok && ($retries > 0));
4688:
4689: if (!$ok) {
4690: $content = ''; # On error return an empty content.
4691: }
1.651 www 4692: if (wantarray) {
4693: return ($content, $response);
4694: } else {
4695: return $content;
4696: }
1.11 albertel 4697: }
4698:
1.112 bowersj2 4699: =pod
4700:
1.648 raeburn 4701: =item * &get_student_answers()
1.112 bowersj2 4702:
4703: show a snapshot of how student was answering problem
4704:
4705: =cut
4706:
1.11 albertel 4707: sub get_student_answers {
1.100 sakharuk 4708: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4709: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4710: my (%moreenv);
1.11 albertel 4711: my @elements=('symb','courseid','domain','username');
4712: foreach my $element (@elements) {
1.186 albertel 4713: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4714: }
1.186 albertel 4715: $moreenv{'grade_target'}='answer';
4716: %moreenv=(%form,%moreenv);
1.497 raeburn 4717: $feedurl = &Apache::lonnet::clutter($feedurl);
4718: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4719: return $userview;
1.1 albertel 4720: }
1.116 albertel 4721:
4722: =pod
4723:
4724: =item * &submlink()
4725:
1.242 albertel 4726: Inputs: $text $uname $udom $symb $target
1.116 albertel 4727:
4728: Returns: A link to grades.pm such as to see the SUBM view of a student
4729:
4730: =cut
4731:
4732: ###############################################
4733: sub submlink {
1.242 albertel 4734: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4735: if (!($uname && $udom)) {
4736: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4737: &Apache::lonnet::whichuser($symb);
1.116 albertel 4738: if (!$symb) { $symb=$cursymb; }
4739: }
1.254 matthew 4740: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4741: $symb=&escape($symb);
1.960 bisitz 4742: if ($target) { $target=" target=\"$target\""; }
4743: return
4744: '<a href="/adm/grades?command=submission'.
4745: '&symb='.$symb.
4746: '&student='.$uname.
4747: '&userdom='.$udom.'"'.
4748: $target.'>'.$text.'</a>';
1.242 albertel 4749: }
4750: ##############################################
4751:
4752: =pod
4753:
4754: =item * &pgrdlink()
4755:
4756: Inputs: $text $uname $udom $symb $target
4757:
4758: Returns: A link to grades.pm such as to see the PGRD view of a student
4759:
4760: =cut
4761:
4762: ###############################################
4763: sub pgrdlink {
4764: my $link=&submlink(@_);
4765: $link=~s/(&command=submission)/$1&showgrading=yes/;
4766: return $link;
4767: }
4768: ##############################################
4769:
4770: =pod
4771:
4772: =item * &pprmlink()
4773:
4774: Inputs: $text $uname $udom $symb $target
4775:
4776: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4777: student and a specific resource
1.242 albertel 4778:
4779: =cut
4780:
4781: ###############################################
4782: sub pprmlink {
4783: my ($text,$uname,$udom,$symb,$target)=@_;
4784: if (!($uname && $udom)) {
4785: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4786: &Apache::lonnet::whichuser($symb);
1.242 albertel 4787: if (!$symb) { $symb=$cursymb; }
4788: }
1.254 matthew 4789: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4790: $symb=&escape($symb);
1.242 albertel 4791: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4792: return '<a href="/adm/parmset?command=set&'.
4793: 'symb='.$symb.'&uname='.$uname.
4794: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4795: }
4796: ##############################################
1.37 matthew 4797:
1.112 bowersj2 4798: =pod
4799:
4800: =back
4801:
4802: =cut
4803:
1.37 matthew 4804: ###############################################
1.51 www 4805:
4806:
4807: sub timehash {
1.687 raeburn 4808: my ($thistime) = @_;
4809: my $timezone = &Apache::lonlocal::gettimezone();
4810: my $dt = DateTime->from_epoch(epoch => $thistime)
4811: ->set_time_zone($timezone);
4812: my $wday = $dt->day_of_week();
4813: if ($wday == 7) { $wday = 0; }
4814: return ( 'second' => $dt->second(),
4815: 'minute' => $dt->minute(),
4816: 'hour' => $dt->hour(),
4817: 'day' => $dt->day_of_month(),
4818: 'month' => $dt->month(),
4819: 'year' => $dt->year(),
4820: 'weekday' => $wday,
4821: 'dayyear' => $dt->day_of_year(),
4822: 'dlsav' => $dt->is_dst() );
1.51 www 4823: }
4824:
1.370 www 4825: sub utc_string {
4826: my ($date)=@_;
1.371 www 4827: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4828: }
4829:
1.51 www 4830: sub maketime {
4831: my %th=@_;
1.687 raeburn 4832: my ($epoch_time,$timezone,$dt);
4833: $timezone = &Apache::lonlocal::gettimezone();
4834: eval {
4835: $dt = DateTime->new( year => $th{'year'},
4836: month => $th{'month'},
4837: day => $th{'day'},
4838: hour => $th{'hour'},
4839: minute => $th{'minute'},
4840: second => $th{'second'},
4841: time_zone => $timezone,
4842: );
4843: };
4844: if (!$@) {
4845: $epoch_time = $dt->epoch;
4846: if ($epoch_time) {
4847: return $epoch_time;
4848: }
4849: }
1.51 www 4850: return POSIX::mktime(
4851: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4852: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4853: }
4854:
4855: #########################################
1.51 www 4856:
4857: sub findallcourses {
1.482 raeburn 4858: my ($roles,$uname,$udom) = @_;
1.355 albertel 4859: my %roles;
4860: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4861: my %courses;
1.51 www 4862: my $now=time;
1.482 raeburn 4863: if (!defined($uname)) {
4864: $uname = $env{'user.name'};
4865: }
4866: if (!defined($udom)) {
4867: $udom = $env{'user.domain'};
4868: }
4869: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4870: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4871: if (!%roles) {
4872: %roles = (
4873: cc => 1,
1.907 raeburn 4874: co => 1,
1.482 raeburn 4875: in => 1,
4876: ep => 1,
4877: ta => 1,
4878: cr => 1,
4879: st => 1,
4880: );
4881: }
4882: foreach my $entry (keys(%roleshash)) {
4883: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4884: if ($trole =~ /^cr/) {
4885: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4886: } else {
4887: next if (!exists($roles{$trole}));
4888: }
4889: if ($tend) {
4890: next if ($tend < $now);
4891: }
4892: if ($tstart) {
4893: next if ($tstart > $now);
4894: }
1.1058 raeburn 4895: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4896: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4897: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4898: if ($secpart eq '') {
4899: ($cnum,$role) = split(/_/,$cnumpart);
4900: $sec = 'none';
1.1058 raeburn 4901: $value .= $cnum.'/';
1.482 raeburn 4902: } else {
4903: $cnum = $cnumpart;
4904: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4905: $value .= $cnum.'/'.$sec;
4906: }
4907: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4908: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4909: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4910: }
4911: } else {
4912: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4913: }
1.482 raeburn 4914: }
4915: } else {
4916: foreach my $key (keys(%env)) {
1.483 albertel 4917: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4918: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4919: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4920: next if ($role eq 'ca' || $role eq 'aa');
4921: next if (%roles && !exists($roles{$role}));
4922: my ($starttime,$endtime)=split(/\./,$env{$key});
4923: my $active=1;
4924: if ($starttime) {
4925: if ($now<$starttime) { $active=0; }
4926: }
4927: if ($endtime) {
4928: if ($now>$endtime) { $active=0; }
4929: }
4930: if ($active) {
1.1058 raeburn 4931: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4932: if ($sec eq '') {
4933: $sec = 'none';
1.1058 raeburn 4934: } else {
4935: $value .= $sec;
4936: }
4937: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4938: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4939: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4940: }
4941: } else {
4942: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4943: }
1.474 raeburn 4944: }
4945: }
1.51 www 4946: }
4947: }
1.474 raeburn 4948: return %courses;
1.51 www 4949: }
1.37 matthew 4950:
1.54 www 4951: ###############################################
1.474 raeburn 4952:
4953: sub blockcheck {
1.1189 raeburn 4954: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4955:
1.1189 raeburn 4956: if (defined($udom) && defined($uname)) {
4957: # If uname and udom are for a course, check for blocks in the course.
4958: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4959: my ($startblock,$endblock,$triggerblock) =
4960: &get_blocks($setters,$activity,$udom,$uname,$url);
4961: return ($startblock,$endblock,$triggerblock);
4962: }
4963: } else {
1.490 raeburn 4964: $udom = $env{'user.domain'};
4965: $uname = $env{'user.name'};
4966: }
4967:
1.502 raeburn 4968: my $startblock = 0;
4969: my $endblock = 0;
1.1062 raeburn 4970: my $triggerblock = '';
1.482 raeburn 4971: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4972:
1.490 raeburn 4973: # If uname is for a user, and activity is course-specific, i.e.,
4974: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4975:
1.490 raeburn 4976: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4977: $activity eq 'groups' || $activity eq 'printout') &&
4978: ($env{'request.course.id'})) {
1.490 raeburn 4979: foreach my $key (keys(%live_courses)) {
4980: if ($key ne $env{'request.course.id'}) {
4981: delete($live_courses{$key});
4982: }
4983: }
4984: }
4985:
4986: my $otheruser = 0;
4987: my %own_courses;
4988: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4989: # Resource belongs to user other than current user.
4990: $otheruser = 1;
4991: # Gather courses for current user
4992: %own_courses =
4993: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4994: }
4995:
4996: # Gather active course roles - course coordinator, instructor,
4997: # exam proctor, ta, student, or custom role.
1.474 raeburn 4998:
4999: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5000: my ($cdom,$cnum);
5001: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5002: $cdom = $env{'course.'.$course.'.domain'};
5003: $cnum = $env{'course.'.$course.'.num'};
5004: } else {
1.490 raeburn 5005: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5006: }
5007: my $no_ownblock = 0;
5008: my $no_userblock = 0;
1.533 raeburn 5009: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5010: # Check if current user has 'evb' priv for this
5011: if (defined($own_courses{$course})) {
5012: foreach my $sec (keys(%{$own_courses{$course}})) {
5013: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5014: if ($sec ne 'none') {
5015: $checkrole .= '/'.$sec;
5016: }
5017: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5018: $no_ownblock = 1;
5019: last;
5020: }
5021: }
5022: }
5023: # if they have 'evb' priv and are currently not playing student
5024: next if (($no_ownblock) &&
5025: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5026: }
1.474 raeburn 5027: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5028: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5029: if ($sec ne 'none') {
1.482 raeburn 5030: $checkrole .= '/'.$sec;
1.474 raeburn 5031: }
1.490 raeburn 5032: if ($otheruser) {
5033: # Resource belongs to user other than current user.
5034: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5035: my (%allroles,%userroles);
5036: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5037: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5038: my ($trole,$tdom,$tnum,$tsec);
5039: if ($entry =~ /^cr/) {
5040: ($trole,$tdom,$tnum,$tsec) =
5041: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5042: } else {
5043: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5044: }
5045: my ($spec,$area,$trest);
5046: $area = '/'.$tdom.'/'.$tnum;
5047: $trest = $tnum;
5048: if ($tsec ne '') {
5049: $area .= '/'.$tsec;
5050: $trest .= '/'.$tsec;
5051: }
5052: $spec = $trole.'.'.$area;
5053: if ($trole =~ /^cr/) {
5054: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5055: $tdom,$spec,$trest,$area);
5056: } else {
5057: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5058: $tdom,$spec,$trest,$area);
5059: }
5060: }
5061: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
5062: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5063: if ($1) {
5064: $no_userblock = 1;
5065: last;
5066: }
1.486 raeburn 5067: }
5068: }
1.490 raeburn 5069: } else {
5070: # Resource belongs to current user
5071: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5072: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5073: $no_ownblock = 1;
5074: last;
5075: }
1.474 raeburn 5076: }
5077: }
5078: # if they have the evb priv and are currently not playing student
1.482 raeburn 5079: next if (($no_ownblock) &&
1.491 albertel 5080: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5081: next if ($no_userblock);
1.474 raeburn 5082:
1.866 kalberla 5083: # Retrieve blocking times and identity of locker for course
1.490 raeburn 5084: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 5085:
1.1062 raeburn 5086: my ($start,$end,$trigger) =
5087: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5088: if (($start != 0) &&
5089: (($startblock == 0) || ($startblock > $start))) {
5090: $startblock = $start;
1.1062 raeburn 5091: if ($trigger ne '') {
5092: $triggerblock = $trigger;
5093: }
1.502 raeburn 5094: }
5095: if (($end != 0) &&
5096: (($endblock == 0) || ($endblock < $end))) {
5097: $endblock = $end;
1.1062 raeburn 5098: if ($trigger ne '') {
5099: $triggerblock = $trigger;
5100: }
1.502 raeburn 5101: }
1.490 raeburn 5102: }
1.1062 raeburn 5103: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5104: }
5105:
5106: sub get_blocks {
1.1062 raeburn 5107: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5108: my $startblock = 0;
5109: my $endblock = 0;
1.1062 raeburn 5110: my $triggerblock = '';
1.490 raeburn 5111: my $course = $cdom.'_'.$cnum;
5112: $setters->{$course} = {};
5113: $setters->{$course}{'staff'} = [];
5114: $setters->{$course}{'times'} = [];
1.1062 raeburn 5115: $setters->{$course}{'triggers'} = [];
5116: my (@blockers,%triggered);
5117: my $now = time;
5118: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5119: if ($activity eq 'docs') {
5120: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5121: foreach my $block (@blockers) {
5122: if ($block =~ /^firstaccess____(.+)$/) {
5123: my $item = $1;
5124: my $type = 'map';
5125: my $timersymb = $item;
5126: if ($item eq 'course') {
5127: $type = 'course';
5128: } elsif ($item =~ /___\d+___/) {
5129: $type = 'resource';
5130: } else {
5131: $timersymb = &Apache::lonnet::symbread($item);
5132: }
5133: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5134: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5135: $triggered{$block} = {
5136: start => $start,
5137: end => $end,
5138: type => $type,
5139: };
5140: }
5141: }
5142: } else {
5143: foreach my $block (keys(%commblocks)) {
5144: if ($block =~ m/^(\d+)____(\d+)$/) {
5145: my ($start,$end) = ($1,$2);
5146: if ($start <= time && $end >= time) {
5147: if (ref($commblocks{$block}) eq 'HASH') {
5148: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5149: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5150: unless(grep(/^\Q$block\E$/,@blockers)) {
5151: push(@blockers,$block);
5152: }
5153: }
5154: }
5155: }
5156: }
5157: } elsif ($block =~ /^firstaccess____(.+)$/) {
5158: my $item = $1;
5159: my $timersymb = $item;
5160: my $type = 'map';
5161: if ($item eq 'course') {
5162: $type = 'course';
5163: } elsif ($item =~ /___\d+___/) {
5164: $type = 'resource';
5165: } else {
5166: $timersymb = &Apache::lonnet::symbread($item);
5167: }
5168: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5169: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5170: if ($start && $end) {
5171: if (($start <= time) && ($end >= time)) {
5172: unless (grep(/^\Q$block\E$/,@blockers)) {
5173: push(@blockers,$block);
5174: $triggered{$block} = {
5175: start => $start,
5176: end => $end,
5177: type => $type,
5178: };
5179: }
5180: }
1.490 raeburn 5181: }
1.1062 raeburn 5182: }
5183: }
5184: }
5185: foreach my $blocker (@blockers) {
5186: my ($staff_name,$staff_dom,$title,$blocks) =
5187: &parse_block_record($commblocks{$blocker});
5188: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5189: my ($start,$end,$triggertype);
5190: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5191: ($start,$end) = ($1,$2);
5192: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5193: $start = $triggered{$blocker}{'start'};
5194: $end = $triggered{$blocker}{'end'};
5195: $triggertype = $triggered{$blocker}{'type'};
5196: }
5197: if ($start) {
5198: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5199: if ($triggertype) {
5200: push(@{$$setters{$course}{'triggers'}},$triggertype);
5201: } else {
5202: push(@{$$setters{$course}{'triggers'}},0);
5203: }
5204: if ( ($startblock == 0) || ($startblock > $start) ) {
5205: $startblock = $start;
5206: if ($triggertype) {
5207: $triggerblock = $blocker;
1.474 raeburn 5208: }
5209: }
1.1062 raeburn 5210: if ( ($endblock == 0) || ($endblock < $end) ) {
5211: $endblock = $end;
5212: if ($triggertype) {
5213: $triggerblock = $blocker;
5214: }
5215: }
1.474 raeburn 5216: }
5217: }
1.1062 raeburn 5218: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5219: }
5220:
5221: sub parse_block_record {
5222: my ($record) = @_;
5223: my ($setuname,$setudom,$title,$blocks);
5224: if (ref($record) eq 'HASH') {
5225: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5226: $title = &unescape($record->{'event'});
5227: $blocks = $record->{'blocks'};
5228: } else {
5229: my @data = split(/:/,$record,3);
5230: if (scalar(@data) eq 2) {
5231: $title = $data[1];
5232: ($setuname,$setudom) = split(/@/,$data[0]);
5233: } else {
5234: ($setuname,$setudom,$title) = @data;
5235: }
5236: $blocks = { 'com' => 'on' };
5237: }
5238: return ($setuname,$setudom,$title,$blocks);
5239: }
5240:
1.854 kalberla 5241: sub blocking_status {
1.1189 raeburn 5242: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5243: my %setters;
1.890 droeschl 5244:
1.1061 raeburn 5245: # check for active blocking
1.1062 raeburn 5246: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5247: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5248: my $blocked = 0;
5249: if ($startblock && $endblock) {
5250: $blocked = 1;
5251: }
1.890 droeschl 5252:
1.1061 raeburn 5253: # caller just wants to know whether a block is active
5254: if (!wantarray) { return $blocked; }
5255:
5256: # build a link to a popup window containing the details
5257: my $querystring = "?activity=$activity";
5258: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5259: if (($activity eq 'port') || ($activity eq 'passwd')) {
5260: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5261: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5262: } elsif ($activity eq 'docs') {
5263: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5264: }
1.1061 raeburn 5265:
5266: my $output .= <<'END_MYBLOCK';
5267: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5268: var options = "width=" + w + ",height=" + h + ",";
5269: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5270: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5271: var newWin = window.open(url, wdwName, options);
5272: newWin.focus();
5273: }
1.890 droeschl 5274: END_MYBLOCK
1.854 kalberla 5275:
1.1061 raeburn 5276: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5277:
1.1061 raeburn 5278: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5279: my $text = &mt('Communication Blocked');
1.1217 raeburn 5280: my $class = 'LC_comblock';
1.1062 raeburn 5281: if ($activity eq 'docs') {
5282: $text = &mt('Content Access Blocked');
1.1217 raeburn 5283: $class = '';
1.1063 raeburn 5284: } elsif ($activity eq 'printout') {
5285: $text = &mt('Printing Blocked');
1.1232 raeburn 5286: } elsif ($activity eq 'passwd') {
5287: $text = &mt('Password Changing Blocked');
1.1062 raeburn 5288: }
1.1061 raeburn 5289: $output .= <<"END_BLOCK";
1.1217 raeburn 5290: <div class='$class'>
1.869 kalberla 5291: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5292: title='$text'>
5293: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5294: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5295: title='$text'>$text</a>
1.867 kalberla 5296: </div>
5297:
5298: END_BLOCK
1.474 raeburn 5299:
1.1061 raeburn 5300: return ($blocked, $output);
1.854 kalberla 5301: }
1.490 raeburn 5302:
1.60 matthew 5303: ###############################################
5304:
1.682 raeburn 5305: sub check_ip_acc {
1.1201 raeburn 5306: my ($acc,$clientip)=@_;
1.682 raeburn 5307: &Apache::lonxml::debug("acc is $acc");
5308: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5309: return 1;
5310: }
1.1219 raeburn 5311: my $allowed;
1.1252 raeburn 5312: my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682 raeburn 5313:
5314: my $name;
1.1219 raeburn 5315: my %access = (
5316: allowfrom => 1,
5317: denyfrom => 0,
5318: );
5319: my @allows;
5320: my @denies;
5321: foreach my $item (split(',',$acc)) {
5322: $item =~ s/^\s*//;
5323: $item =~ s/\s*$//;
5324: my $pattern;
5325: if ($item =~ /^\!(.+)$/) {
5326: push(@denies,$1);
5327: } else {
5328: push(@allows,$item);
5329: }
5330: }
5331: my $numdenies = scalar(@denies);
5332: my $numallows = scalar(@allows);
5333: my $count = 0;
5334: foreach my $pattern (@denies,@allows) {
5335: $count ++;
5336: my $acctype = 'allowfrom';
5337: if ($count <= $numdenies) {
5338: $acctype = 'denyfrom';
5339: }
1.682 raeburn 5340: if ($pattern =~ /\*$/) {
5341: #35.8.*
5342: $pattern=~s/\*//;
1.1219 raeburn 5343: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5344: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5345: #35.8.3.[34-56]
5346: my $low=$2;
5347: my $high=$3;
5348: $pattern=$1;
5349: if ($ip =~ /^\Q$pattern\E/) {
5350: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5351: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5352: }
5353: } elsif ($pattern =~ /^\*/) {
5354: #*.msu.edu
5355: $pattern=~s/\*//;
5356: if (!defined($name)) {
5357: use Socket;
5358: my $netaddr=inet_aton($ip);
5359: ($name)=gethostbyaddr($netaddr,AF_INET);
5360: }
1.1219 raeburn 5361: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5362: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5363: #127.0.0.1
1.1219 raeburn 5364: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5365: } else {
5366: #some.name.com
5367: if (!defined($name)) {
5368: use Socket;
5369: my $netaddr=inet_aton($ip);
5370: ($name)=gethostbyaddr($netaddr,AF_INET);
5371: }
1.1219 raeburn 5372: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5373: }
5374: if ($allowed =~ /^(0|1)$/) { last; }
5375: }
5376: if ($allowed eq '') {
5377: if ($numdenies && !$numallows) {
5378: $allowed = 1;
5379: } else {
5380: $allowed = 0;
1.682 raeburn 5381: }
5382: }
5383: return $allowed;
5384: }
5385:
5386: ###############################################
5387:
1.60 matthew 5388: =pod
5389:
1.112 bowersj2 5390: =head1 Domain Template Functions
5391:
5392: =over 4
5393:
5394: =item * &determinedomain()
1.60 matthew 5395:
5396: Inputs: $domain (usually will be undef)
5397:
1.63 www 5398: Returns: Determines which domain should be used for designs
1.60 matthew 5399:
5400: =cut
1.54 www 5401:
1.60 matthew 5402: ###############################################
1.63 www 5403: sub determinedomain {
5404: my $domain=shift;
1.531 albertel 5405: if (! $domain) {
1.60 matthew 5406: # Determine domain if we have not been given one
1.893 raeburn 5407: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5408: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5409: if ($env{'request.role.domain'}) {
5410: $domain=$env{'request.role.domain'};
1.60 matthew 5411: }
5412: }
1.63 www 5413: return $domain;
5414: }
5415: ###############################################
1.517 raeburn 5416:
1.518 albertel 5417: sub devalidate_domconfig_cache {
5418: my ($udom)=@_;
5419: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5420: }
5421:
5422: # ---------------------- Get domain configuration for a domain
5423: sub get_domainconf {
5424: my ($udom) = @_;
5425: my $cachetime=1800;
5426: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5427: if (defined($cached)) { return %{$result}; }
5428:
5429: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5430: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5431: my (%designhash,%legacy);
1.518 albertel 5432: if (keys(%domconfig) > 0) {
5433: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5434: if (keys(%{$domconfig{'login'}})) {
5435: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5436: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5437: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5438: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5439: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5440: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5441: if ($key eq 'loginvia') {
5442: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5443: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5444: $designhash{$udom.'.login.loginvia'} = $server;
5445: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5446:
5447: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5448: } else {
5449: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5450: }
1.948 raeburn 5451: }
1.1208 raeburn 5452: } elsif ($key eq 'headtag') {
5453: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5454: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5455: }
1.946 raeburn 5456: }
1.1208 raeburn 5457: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5458: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5459: }
1.946 raeburn 5460: }
5461: }
5462: }
5463: } else {
5464: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5465: $designhash{$udom.'.login.'.$key.'_'.$img} =
5466: $domconfig{'login'}{$key}{$img};
5467: }
1.699 raeburn 5468: }
5469: } else {
5470: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5471: }
1.632 raeburn 5472: }
5473: } else {
5474: $legacy{'login'} = 1;
1.518 albertel 5475: }
1.632 raeburn 5476: } else {
5477: $legacy{'login'} = 1;
1.518 albertel 5478: }
5479: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5480: if (keys(%{$domconfig{'rolecolors'}})) {
5481: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5482: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5483: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5484: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5485: }
1.518 albertel 5486: }
5487: }
1.632 raeburn 5488: } else {
5489: $legacy{'rolecolors'} = 1;
1.518 albertel 5490: }
1.632 raeburn 5491: } else {
5492: $legacy{'rolecolors'} = 1;
1.518 albertel 5493: }
1.948 raeburn 5494: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5495: if ($domconfig{'autoenroll'}{'co-owners'}) {
5496: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5497: }
5498: }
1.632 raeburn 5499: if (keys(%legacy) > 0) {
5500: my %legacyhash = &get_legacy_domconf($udom);
5501: foreach my $item (keys(%legacyhash)) {
5502: if ($item =~ /^\Q$udom\E\.login/) {
5503: if ($legacy{'login'}) {
5504: $designhash{$item} = $legacyhash{$item};
5505: }
5506: } else {
5507: if ($legacy{'rolecolors'}) {
5508: $designhash{$item} = $legacyhash{$item};
5509: }
1.518 albertel 5510: }
5511: }
5512: }
1.632 raeburn 5513: } else {
5514: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5515: }
5516: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5517: $cachetime);
5518: return %designhash;
5519: }
5520:
1.632 raeburn 5521: sub get_legacy_domconf {
5522: my ($udom) = @_;
5523: my %legacyhash;
5524: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5525: my $designfile = $designdir.'/'.$udom.'.tab';
5526: if (-e $designfile) {
5527: if ( open (my $fh,"<$designfile") ) {
5528: while (my $line = <$fh>) {
5529: next if ($line =~ /^\#/);
5530: chomp($line);
5531: my ($key,$val)=(split(/\=/,$line));
5532: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5533: }
5534: close($fh);
5535: }
5536: }
1.1026 raeburn 5537: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5538: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5539: }
5540: return %legacyhash;
5541: }
5542:
1.63 www 5543: =pod
5544:
1.112 bowersj2 5545: =item * &domainlogo()
1.63 www 5546:
5547: Inputs: $domain (usually will be undef)
5548:
5549: Returns: A link to a domain logo, if the domain logo exists.
5550: If the domain logo does not exist, a description of the domain.
5551:
5552: =cut
1.112 bowersj2 5553:
1.63 www 5554: ###############################################
5555: sub domainlogo {
1.517 raeburn 5556: my $domain = &determinedomain(shift);
1.518 albertel 5557: my %designhash = &get_domainconf($domain);
1.517 raeburn 5558: # See if there is a logo
5559: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5560: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5561: if ($imgsrc =~ m{^/(adm|res)/}) {
5562: if ($imgsrc =~ m{^/res/}) {
5563: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5564: &Apache::lonnet::repcopy($local_name);
5565: }
5566: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5567: }
5568: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5569: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5570: return &Apache::lonnet::domain($domain,'description');
1.59 www 5571: } else {
1.60 matthew 5572: return '';
1.59 www 5573: }
5574: }
1.63 www 5575: ##############################################
5576:
5577: =pod
5578:
1.112 bowersj2 5579: =item * &designparm()
1.63 www 5580:
5581: Inputs: $which parameter; $domain (usually will be undef)
5582:
5583: Returns: value of designparamter $which
5584:
5585: =cut
1.112 bowersj2 5586:
1.397 albertel 5587:
1.400 albertel 5588: ##############################################
1.397 albertel 5589: sub designparm {
5590: my ($which,$domain)=@_;
5591: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5592: return $env{'environment.color.'.$which};
1.96 www 5593: }
1.63 www 5594: $domain=&determinedomain($domain);
1.1016 raeburn 5595: my %domdesign;
5596: unless ($domain eq 'public') {
5597: %domdesign = &get_domainconf($domain);
5598: }
1.520 raeburn 5599: my $output;
1.517 raeburn 5600: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5601: $output = $domdesign{$domain.'.'.$which};
1.63 www 5602: } else {
1.520 raeburn 5603: $output = $defaultdesign{$which};
5604: }
5605: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5606: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5607: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5608: if ($output =~ m{^/res/}) {
5609: my $local_name = &Apache::lonnet::filelocation('',$output);
5610: &Apache::lonnet::repcopy($local_name);
5611: }
1.520 raeburn 5612: $output = &lonhttpdurl($output);
5613: }
1.63 www 5614: }
1.520 raeburn 5615: return $output;
1.63 www 5616: }
1.59 www 5617:
1.822 bisitz 5618: ##############################################
5619: =pod
5620:
1.832 bisitz 5621: =item * &authorspace()
5622:
1.1028 raeburn 5623: Inputs: $url (usually will be undef).
1.832 bisitz 5624:
1.1132 raeburn 5625: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5626: directory being viewed (or for which action is being taken).
5627: If $url is provided, and begins /priv/<domain>/<uname>
5628: the path will be that portion of the $context argument.
5629: Otherwise the path will be for the author space of the current
5630: user when the current role is author, or for that of the
5631: co-author/assistant co-author space when the current role
5632: is co-author or assistant co-author.
1.832 bisitz 5633:
5634: =cut
5635:
5636: sub authorspace {
1.1028 raeburn 5637: my ($url) = @_;
5638: if ($url ne '') {
5639: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5640: return $1;
5641: }
5642: }
1.832 bisitz 5643: my $caname = '';
1.1024 www 5644: my $cadom = '';
1.1028 raeburn 5645: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5646: ($cadom,$caname) =
1.832 bisitz 5647: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5648: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5649: $caname = $env{'user.name'};
1.1024 www 5650: $cadom = $env{'user.domain'};
1.832 bisitz 5651: }
1.1028 raeburn 5652: if (($caname ne '') && ($cadom ne '')) {
5653: return "/priv/$cadom/$caname/";
5654: }
5655: return;
1.832 bisitz 5656: }
5657:
5658: ##############################################
5659: =pod
5660:
1.822 bisitz 5661: =item * &head_subbox()
5662:
5663: Inputs: $content (contains HTML code with page functions, etc.)
5664:
5665: Returns: HTML div with $content
5666: To be included in page header
5667:
5668: =cut
5669:
5670: sub head_subbox {
5671: my ($content)=@_;
5672: my $output =
1.993 raeburn 5673: '<div class="LC_head_subbox">'
1.822 bisitz 5674: .$content
5675: .'</div>'
5676: }
5677:
5678: ##############################################
5679: =pod
5680:
5681: =item * &CSTR_pageheader()
5682:
1.1026 raeburn 5683: Input: (optional) filename from which breadcrumb trail is built.
5684: In most cases no input as needed, as $env{'request.filename'}
5685: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5686:
5687: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5688: To be included on Authoring Space pages
1.822 bisitz 5689:
5690: =cut
5691:
5692: sub CSTR_pageheader {
1.1026 raeburn 5693: my ($trailfile) = @_;
5694: if ($trailfile eq '') {
5695: $trailfile = $env{'request.filename'};
5696: }
5697:
5698: # this is for resources; directories have customtitle, and crumbs
5699: # and select recent are created in lonpubdir.pm
5700:
5701: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5702: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5703: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5704: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5705: $formaction =~ s{/+}{/}g;
1.822 bisitz 5706:
5707: my $parentpath = '';
5708: my $lastitem = '';
5709: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5710: $parentpath = $1;
5711: $lastitem = $2;
5712: } else {
5713: $lastitem = $thisdisfn;
5714: }
1.921 bisitz 5715:
1.1246 raeburn 5716: my ($crsauthor,$title);
5717: if (($env{'request.course.id'}) &&
5718: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5719: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5720: $crsauthor = 1;
5721: $title = &mt('Course Authoring Space');
5722: } else {
5723: $title = &mt('Authoring Space');
5724: }
5725:
1.921 bisitz 5726: my $output =
1.822 bisitz 5727: '<div>'
5728: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5729: .'<b>'.$title.'</b> '
1.822 bisitz 5730: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5731: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5732: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5733:
5734: if ($lastitem) {
5735: $output .=
5736: '<span class="LC_filename">'
5737: .$lastitem
5738: .'</span>';
5739: }
1.1245 raeburn 5740:
1.1246 raeburn 5741: if ($crsauthor) {
5742: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5743: } else {
5744: $output .=
5745: '<br />'
5746: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5747: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5748: .'</form>'
5749: .&Apache::lonmenu::constspaceform();
5750: }
5751: $output .= '</div>';
1.921 bisitz 5752:
5753: return $output;
1.822 bisitz 5754: }
5755:
1.60 matthew 5756: ###############################################
5757: ###############################################
5758:
5759: =pod
5760:
1.112 bowersj2 5761: =back
5762:
1.549 albertel 5763: =head1 HTML Helpers
1.112 bowersj2 5764:
5765: =over 4
5766:
5767: =item * &bodytag()
1.60 matthew 5768:
5769: Returns a uniform header for LON-CAPA web pages.
5770:
5771: Inputs:
5772:
1.112 bowersj2 5773: =over 4
5774:
5775: =item * $title, A title to be displayed on the page.
5776:
5777: =item * $function, the current role (can be undef).
5778:
5779: =item * $addentries, extra parameters for the <body> tag.
5780:
5781: =item * $bodyonly, if defined, only return the <body> tag.
5782:
5783: =item * $domain, if defined, force a given domain.
5784:
5785: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5786: text interface only)
1.60 matthew 5787:
1.814 bisitz 5788: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5789: navigational links
1.317 albertel 5790:
1.338 albertel 5791: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5792:
1.460 albertel 5793: =item * $args, optional argument valid values are
5794: no_auto_mt_title -> prevents &mt()ing the title arg
5795:
1.1096 raeburn 5796: =item * $advtoolsref, optional argument, ref to an array containing
5797: inlineremote items to be added in "Functions" menu below
5798: breadcrumbs.
5799:
1.112 bowersj2 5800: =back
5801:
1.60 matthew 5802: Returns: A uniform header for LON-CAPA web pages.
5803: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5804: If $bodyonly is undef or zero, an html string containing a <body> tag and
5805: other decorations will be returned.
5806:
5807: =cut
5808:
1.54 www 5809: sub bodytag {
1.831 bisitz 5810: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5811: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5812:
1.954 raeburn 5813: my $public;
5814: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5815: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5816: $public = 1;
5817: }
1.460 albertel 5818: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5819: my $httphost = $args->{'use_absolute'};
1.339 albertel 5820:
1.183 matthew 5821: $function = &get_users_function() if (!$function);
1.339 albertel 5822: my $img = &designparm($function.'.img',$domain);
5823: my $font = &designparm($function.'.font',$domain);
5824: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5825:
1.803 bisitz 5826: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5827: 'bgcolor' => $pgbg,
1.339 albertel 5828: 'text' => $font,
5829: 'alink' => &designparm($function.'.alink',$domain),
5830: 'vlink' => &designparm($function.'.vlink',$domain),
5831: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5832: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5833:
1.63 www 5834: # role and realm
1.1178 raeburn 5835: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5836: if ($realm) {
5837: $realm = '/'.$realm;
5838: }
1.378 raeburn 5839: if ($role eq 'ca') {
1.479 albertel 5840: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5841: $realm = &plainname($rname,$rdom);
1.378 raeburn 5842: }
1.55 www 5843: # realm
1.258 albertel 5844: if ($env{'request.course.id'}) {
1.378 raeburn 5845: if ($env{'request.role'} !~ /^cr/) {
5846: $role = &Apache::lonnet::plaintext($role,&course_type());
5847: }
1.898 raeburn 5848: if ($env{'request.course.sec'}) {
5849: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5850: }
1.359 albertel 5851: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5852: } else {
5853: $role = &Apache::lonnet::plaintext($role);
1.54 www 5854: }
1.433 albertel 5855:
1.359 albertel 5856: if (!$realm) { $realm=' '; }
1.330 albertel 5857:
1.438 albertel 5858: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5859:
1.101 www 5860: # construct main body tag
1.359 albertel 5861: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 5862: &Apache::lontexconvert::init_math_support();
1.252 albertel 5863:
1.1131 raeburn 5864: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5865:
1.1130 raeburn 5866: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5867: return $bodytag;
1.1130 raeburn 5868: }
1.359 albertel 5869:
1.954 raeburn 5870: if ($public) {
1.433 albertel 5871: undef($role);
5872: }
1.359 albertel 5873:
1.762 bisitz 5874: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5875: #
5876: # Extra info if you are the DC
5877: my $dc_info = '';
5878: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5879: $env{'course.'.$env{'request.course.id'}.
5880: '.domain'}.'/'})) {
5881: my $cid = $env{'request.course.id'};
1.917 raeburn 5882: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5883: $dc_info =~ s/\s+$//;
1.359 albertel 5884: }
5885:
1.1237 raeburn 5886: my $crstype;
5887: if ($env{'request.course.id'}) {
5888: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5889: } elsif ($args->{'crstype'}) {
5890: $crstype = $args->{'crstype'};
5891: }
5892: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
5893: undef($role);
5894: } else {
1.1242 raeburn 5895: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 5896: }
1.853 droeschl 5897:
1.903 droeschl 5898: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5899:
5900: # if ($env{'request.state'} eq 'construct') {
5901: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5902: # }
5903:
1.1130 raeburn 5904: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5905: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5906:
1.1237 raeburn 5907: my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359 albertel 5908:
1.916 droeschl 5909: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5910: if ($dc_info) {
5911: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5912: }
1.1130 raeburn 5913: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5914: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5915: return $bodytag;
5916: }
1.894 droeschl 5917:
1.927 raeburn 5918: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5919: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5920: }
1.916 droeschl 5921:
1.1130 raeburn 5922: $bodytag .= $right;
1.852 droeschl 5923:
1.917 raeburn 5924: if ($dc_info) {
5925: $dc_info = &dc_courseid_toggle($dc_info);
5926: }
5927: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5928:
1.1169 raeburn 5929: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5930: if ($args->{'no_secondary_menu'}) {
5931: return $bodytag;
5932: }
1.1169 raeburn 5933: #don't show menus for public users
1.954 raeburn 5934: if (!$public){
1.1154 raeburn 5935: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5936: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5937: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5938: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5939: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5940: $args->{'bread_crumbs'});
1.1096 raeburn 5941: } elsif ($forcereg) {
5942: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5943: $args->{'group'});
5944: } else {
5945: $bodytag .=
5946: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5947: $forcereg,$args->{'group'},
5948: $args->{'bread_crumbs'},
5949: $advtoolsref);
1.920 raeburn 5950: }
1.903 droeschl 5951: }else{
5952: # this is to seperate menu from content when there's no secondary
5953: # menu. Especially needed for public accessible ressources.
5954: $bodytag .= '<hr style="clear:both" />';
5955: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5956: }
1.903 droeschl 5957:
1.235 raeburn 5958: return $bodytag;
1.182 matthew 5959: }
5960:
1.917 raeburn 5961: sub dc_courseid_toggle {
5962: my ($dc_info) = @_;
1.980 raeburn 5963: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5964: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5965: &mt('(More ...)').'</a></span>'.
5966: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5967: }
5968:
1.330 albertel 5969: sub make_attr_string {
5970: my ($register,$attr_ref) = @_;
5971:
5972: if ($attr_ref && !ref($attr_ref)) {
5973: die("addentries Must be a hash ref ".
5974: join(':',caller(1))." ".
5975: join(':',caller(0))." ");
5976: }
5977:
5978: if ($register) {
1.339 albertel 5979: my ($on_load,$on_unload);
5980: foreach my $key (keys(%{$attr_ref})) {
5981: if (lc($key) eq 'onload') {
5982: $on_load.=$attr_ref->{$key}.';';
5983: delete($attr_ref->{$key});
5984:
5985: } elsif (lc($key) eq 'onunload') {
5986: $on_unload.=$attr_ref->{$key}.';';
5987: delete($attr_ref->{$key});
5988: }
5989: }
1.953 droeschl 5990: $attr_ref->{'onload'} = $on_load;
5991: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5992: }
1.339 albertel 5993:
1.330 albertel 5994: my $attr_string;
1.1159 raeburn 5995: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5996: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5997: }
5998: return $attr_string;
5999: }
6000:
6001:
1.182 matthew 6002: ###############################################
1.251 albertel 6003: ###############################################
6004:
6005: =pod
6006:
6007: =item * &endbodytag()
6008:
6009: Returns a uniform footer for LON-CAPA web pages.
6010:
1.635 raeburn 6011: Inputs: 1 - optional reference to an args hash
6012: If in the hash, key for noredirectlink has a value which evaluates to true,
6013: a 'Continue' link is not displayed if the page contains an
6014: internal redirect in the <head></head> section,
6015: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6016:
6017: =cut
6018:
6019: sub endbodytag {
1.635 raeburn 6020: my ($args) = @_;
1.1080 raeburn 6021: my $endbodytag;
6022: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6023: $endbodytag='</body>';
6024: }
1.315 albertel 6025: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6026: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6027: $endbodytag=
6028: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6029: &mt('Continue').'</a>'.
6030: $endbodytag;
6031: }
1.315 albertel 6032: }
1.251 albertel 6033: return $endbodytag;
6034: }
6035:
1.352 albertel 6036: =pod
6037:
6038: =item * &standard_css()
6039:
6040: Returns a style sheet
6041:
6042: Inputs: (all optional)
6043: domain -> force to color decorate a page for a specific
6044: domain
6045: function -> force usage of a specific rolish color scheme
6046: bgcolor -> override the default page bgcolor
6047:
6048: =cut
6049:
1.343 albertel 6050: sub standard_css {
1.345 albertel 6051: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6052: $function = &get_users_function() if (!$function);
6053: my $img = &designparm($function.'.img', $domain);
6054: my $tabbg = &designparm($function.'.tabbg', $domain);
6055: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6056: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6057: #second colour for later usage
1.345 albertel 6058: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6059: my $pgbg_or_bgcolor =
6060: $bgcolor ||
1.352 albertel 6061: &designparm($function.'.pgbg', $domain);
1.382 albertel 6062: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6063: my $alink = &designparm($function.'.alink', $domain);
6064: my $vlink = &designparm($function.'.vlink', $domain);
6065: my $link = &designparm($function.'.link', $domain);
6066:
1.602 albertel 6067: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6068: my $mono = 'monospace';
1.850 bisitz 6069: my $data_table_head = $sidebg;
6070: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6071: my $data_table_dark = '#E0E0E0';
1.470 banghart 6072: my $data_table_darker = '#CCCCCC';
1.349 albertel 6073: my $data_table_highlight = '#FFFF00';
1.352 albertel 6074: my $mail_new = '#FFBB77';
6075: my $mail_new_hover = '#DD9955';
6076: my $mail_read = '#BBBB77';
6077: my $mail_read_hover = '#999944';
6078: my $mail_replied = '#AAAA88';
6079: my $mail_replied_hover = '#888855';
6080: my $mail_other = '#99BBBB';
6081: my $mail_other_hover = '#669999';
1.391 albertel 6082: my $table_header = '#DDDDDD';
1.489 raeburn 6083: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6084: my $lg_border_color = '#C8C8C8';
1.952 onken 6085: my $button_hover = '#BF2317';
1.392 albertel 6086:
1.608 albertel 6087: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6088: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6089: : '0 3px 0 4px';
1.448 albertel 6090:
1.523 albertel 6091:
1.343 albertel 6092: return <<END;
1.947 droeschl 6093:
6094: /* needed for iframe to allow 100% height in FF */
6095: body, html {
6096: margin: 0;
6097: padding: 0 0.5%;
6098: height: 99%; /* to avoid scrollbars */
6099: }
6100:
1.795 www 6101: body {
1.911 bisitz 6102: font-family: $sans;
6103: line-height:130%;
6104: font-size:0.83em;
6105: color:$font;
1.795 www 6106: }
6107:
1.959 onken 6108: a:focus,
6109: a:focus img {
1.795 www 6110: color: red;
6111: }
1.698 harmsja 6112:
1.911 bisitz 6113: form, .inline {
6114: display: inline;
1.795 www 6115: }
1.721 harmsja 6116:
1.795 www 6117: .LC_right {
1.911 bisitz 6118: text-align:right;
1.795 www 6119: }
6120:
6121: .LC_middle {
1.911 bisitz 6122: vertical-align:middle;
1.795 www 6123: }
1.721 harmsja 6124:
1.1130 raeburn 6125: .LC_floatleft {
6126: float: left;
6127: }
6128:
6129: .LC_floatright {
6130: float: right;
6131: }
6132:
1.911 bisitz 6133: .LC_400Box {
6134: width:400px;
6135: }
1.721 harmsja 6136:
1.947 droeschl 6137: .LC_iframecontainer {
6138: width: 98%;
6139: margin: 0;
6140: position: fixed;
6141: top: 8.5em;
6142: bottom: 0;
6143: }
6144:
6145: .LC_iframecontainer iframe{
6146: border: none;
6147: width: 100%;
6148: height: 100%;
6149: }
6150:
1.778 bisitz 6151: .LC_filename {
6152: font-family: $mono;
6153: white-space:pre;
1.921 bisitz 6154: font-size: 120%;
1.778 bisitz 6155: }
6156:
6157: .LC_fileicon {
6158: border: none;
6159: height: 1.3em;
6160: vertical-align: text-bottom;
6161: margin-right: 0.3em;
6162: text-decoration:none;
6163: }
6164:
1.1008 www 6165: .LC_setting {
6166: text-decoration:underline;
6167: }
6168:
1.350 albertel 6169: .LC_error {
6170: color: red;
6171: }
1.795 www 6172:
1.1097 bisitz 6173: .LC_warning {
6174: color: darkorange;
6175: }
6176:
1.457 albertel 6177: .LC_diff_removed {
1.733 bisitz 6178: color: red;
1.394 albertel 6179: }
1.532 albertel 6180:
6181: .LC_info,
1.457 albertel 6182: .LC_success,
6183: .LC_diff_added {
1.350 albertel 6184: color: green;
6185: }
1.795 www 6186:
1.802 bisitz 6187: div.LC_confirm_box {
6188: background-color: #FAFAFA;
6189: border: 1px solid $lg_border_color;
6190: margin-right: 0;
6191: padding: 5px;
6192: }
6193:
6194: div.LC_confirm_box .LC_error img,
6195: div.LC_confirm_box .LC_success img {
6196: vertical-align: middle;
6197: }
6198:
1.1242 raeburn 6199: .LC_maxwidth {
6200: max-width: 100%;
6201: height: auto;
6202: }
6203:
1.1243 raeburn 6204: .LC_textsize_mobile {
6205: \@media only screen and (max-device-width: 480px) {
6206: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6207: }
6208: }
6209:
1.440 albertel 6210: .LC_icon {
1.771 droeschl 6211: border: none;
1.790 droeschl 6212: vertical-align: middle;
1.771 droeschl 6213: }
6214:
1.543 albertel 6215: .LC_docs_spacer {
6216: width: 25px;
6217: height: 1px;
1.771 droeschl 6218: border: none;
1.543 albertel 6219: }
1.346 albertel 6220:
1.532 albertel 6221: .LC_internal_info {
1.735 bisitz 6222: color: #999999;
1.532 albertel 6223: }
6224:
1.794 www 6225: .LC_discussion {
1.1050 www 6226: background: $data_table_dark;
1.911 bisitz 6227: border: 1px solid black;
6228: margin: 2px;
1.794 www 6229: }
6230:
6231: .LC_disc_action_left {
1.1050 www 6232: background: $sidebg;
1.911 bisitz 6233: text-align: left;
1.1050 www 6234: padding: 4px;
6235: margin: 2px;
1.794 www 6236: }
6237:
6238: .LC_disc_action_right {
1.1050 www 6239: background: $sidebg;
1.911 bisitz 6240: text-align: right;
1.1050 www 6241: padding: 4px;
6242: margin: 2px;
1.794 www 6243: }
6244:
6245: .LC_disc_new_item {
1.911 bisitz 6246: background: white;
6247: border: 2px solid red;
1.1050 www 6248: margin: 4px;
6249: padding: 4px;
1.794 www 6250: }
6251:
6252: .LC_disc_old_item {
1.911 bisitz 6253: background: white;
1.1050 www 6254: margin: 4px;
6255: padding: 4px;
1.794 www 6256: }
6257:
1.458 albertel 6258: table.LC_pastsubmission {
6259: border: 1px solid black;
6260: margin: 2px;
6261: }
6262:
1.924 bisitz 6263: table#LC_menubuttons {
1.345 albertel 6264: width: 100%;
6265: background: $pgbg;
1.392 albertel 6266: border: 2px;
1.402 albertel 6267: border-collapse: separate;
1.803 bisitz 6268: padding: 0;
1.345 albertel 6269: }
1.392 albertel 6270:
1.801 tempelho 6271: table#LC_title_bar a {
6272: color: $fontmenu;
6273: }
1.836 bisitz 6274:
1.807 droeschl 6275: table#LC_title_bar {
1.819 tempelho 6276: clear: both;
1.836 bisitz 6277: display: none;
1.807 droeschl 6278: }
6279:
1.795 www 6280: table#LC_title_bar,
1.933 droeschl 6281: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6282: table#LC_title_bar.LC_with_remote {
1.359 albertel 6283: width: 100%;
1.392 albertel 6284: border-color: $pgbg;
6285: border-style: solid;
6286: border-width: $border;
1.379 albertel 6287: background: $pgbg;
1.801 tempelho 6288: color: $fontmenu;
1.392 albertel 6289: border-collapse: collapse;
1.803 bisitz 6290: padding: 0;
1.819 tempelho 6291: margin: 0;
1.359 albertel 6292: }
1.795 www 6293:
1.933 droeschl 6294: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6295: margin: 0;
6296: padding: 0;
1.933 droeschl 6297: position: relative;
6298: list-style: none;
1.913 droeschl 6299: }
1.933 droeschl 6300: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6301: display: inline;
6302: }
1.933 droeschl 6303:
6304: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6305: padding: 0;
1.933 droeschl 6306: margin: 0;
6307: float: left;
1.913 droeschl 6308: }
1.933 droeschl 6309: .LC_breadcrumb_tools_tools {
6310: padding: 0;
6311: margin: 0;
1.913 droeschl 6312: float: right;
6313: }
6314:
1.1240 raeburn 6315: .LC_placement_prog {
6316: padding-right: 20px;
6317: font-weight: bold;
6318: font-size: 90%;
6319: }
6320:
1.359 albertel 6321: table#LC_title_bar td {
6322: background: $tabbg;
6323: }
1.795 www 6324:
1.911 bisitz 6325: table#LC_menubuttons img {
1.803 bisitz 6326: border: none;
1.346 albertel 6327: }
1.795 www 6328:
1.842 droeschl 6329: .LC_breadcrumbs_component {
1.911 bisitz 6330: float: right;
6331: margin: 0 1em;
1.357 albertel 6332: }
1.842 droeschl 6333: .LC_breadcrumbs_component img {
1.911 bisitz 6334: vertical-align: middle;
1.777 tempelho 6335: }
1.795 www 6336:
1.1243 raeburn 6337: .LC_breadcrumbs_hoverable {
6338: background: $sidebg;
6339: }
6340:
1.383 albertel 6341: td.LC_table_cell_checkbox {
6342: text-align: center;
6343: }
1.795 www 6344:
6345: .LC_fontsize_small {
1.911 bisitz 6346: font-size: 70%;
1.705 tempelho 6347: }
6348:
1.844 bisitz 6349: #LC_breadcrumbs {
1.911 bisitz 6350: clear:both;
6351: background: $sidebg;
6352: border-bottom: 1px solid $lg_border_color;
6353: line-height: 2.5em;
1.933 droeschl 6354: overflow: hidden;
1.911 bisitz 6355: margin: 0;
6356: padding: 0;
1.995 raeburn 6357: text-align: left;
1.819 tempelho 6358: }
1.862 bisitz 6359:
1.1098 bisitz 6360: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6361: clear:both;
6362: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6363: border: 1px solid $sidebg;
1.1098 bisitz 6364: margin: 0 0 10px 0;
1.966 bisitz 6365: padding: 3px;
1.995 raeburn 6366: text-align: left;
1.822 bisitz 6367: }
6368:
1.795 www 6369: .LC_fontsize_medium {
1.911 bisitz 6370: font-size: 85%;
1.705 tempelho 6371: }
6372:
1.795 www 6373: .LC_fontsize_large {
1.911 bisitz 6374: font-size: 120%;
1.705 tempelho 6375: }
6376:
1.346 albertel 6377: .LC_menubuttons_inline_text {
6378: color: $font;
1.698 harmsja 6379: font-size: 90%;
1.701 harmsja 6380: padding-left:3px;
1.346 albertel 6381: }
6382:
1.934 droeschl 6383: .LC_menubuttons_inline_text img{
6384: vertical-align: middle;
6385: }
6386:
1.1051 www 6387: li.LC_menubuttons_inline_text img {
1.951 onken 6388: cursor:pointer;
1.1002 droeschl 6389: text-decoration: none;
1.951 onken 6390: }
6391:
1.526 www 6392: .LC_menubuttons_link {
6393: text-decoration: none;
6394: }
1.795 www 6395:
1.522 albertel 6396: .LC_menubuttons_category {
1.521 www 6397: color: $font;
1.526 www 6398: background: $pgbg;
1.521 www 6399: font-size: larger;
6400: font-weight: bold;
6401: }
6402:
1.346 albertel 6403: td.LC_menubuttons_text {
1.911 bisitz 6404: color: $font;
1.346 albertel 6405: }
1.706 harmsja 6406:
1.346 albertel 6407: .LC_current_location {
6408: background: $tabbg;
6409: }
1.795 www 6410:
1.938 bisitz 6411: table.LC_data_table {
1.347 albertel 6412: border: 1px solid #000000;
1.402 albertel 6413: border-collapse: separate;
1.426 albertel 6414: border-spacing: 1px;
1.610 albertel 6415: background: $pgbg;
1.347 albertel 6416: }
1.795 www 6417:
1.422 albertel 6418: .LC_data_table_dense {
6419: font-size: small;
6420: }
1.795 www 6421:
1.507 raeburn 6422: table.LC_nested_outer {
6423: border: 1px solid #000000;
1.589 raeburn 6424: border-collapse: collapse;
1.803 bisitz 6425: border-spacing: 0;
1.507 raeburn 6426: width: 100%;
6427: }
1.795 www 6428:
1.879 raeburn 6429: table.LC_innerpickbox,
1.507 raeburn 6430: table.LC_nested {
1.803 bisitz 6431: border: none;
1.589 raeburn 6432: border-collapse: collapse;
1.803 bisitz 6433: border-spacing: 0;
1.507 raeburn 6434: width: 100%;
6435: }
1.795 www 6436:
1.911 bisitz 6437: table.LC_data_table tr th,
6438: table.LC_calendar tr th,
1.879 raeburn 6439: table.LC_prior_tries tr th,
6440: table.LC_innerpickbox tr th {
1.349 albertel 6441: font-weight: bold;
6442: background-color: $data_table_head;
1.801 tempelho 6443: color:$fontmenu;
1.701 harmsja 6444: font-size:90%;
1.347 albertel 6445: }
1.795 www 6446:
1.879 raeburn 6447: table.LC_innerpickbox tr th,
6448: table.LC_innerpickbox tr td {
6449: vertical-align: top;
6450: }
6451:
1.711 raeburn 6452: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6453: background-color: #CCCCCC;
1.711 raeburn 6454: font-weight: bold;
6455: text-align: left;
6456: }
1.795 www 6457:
1.912 bisitz 6458: table.LC_data_table tr.LC_odd_row > td {
6459: background-color: $data_table_light;
6460: padding: 2px;
6461: vertical-align: top;
6462: }
6463:
1.809 bisitz 6464: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6465: background-color: $data_table_light;
1.912 bisitz 6466: vertical-align: top;
6467: }
6468:
6469: table.LC_data_table tr.LC_even_row > td {
6470: background-color: $data_table_dark;
1.425 albertel 6471: padding: 2px;
1.900 bisitz 6472: vertical-align: top;
1.347 albertel 6473: }
1.795 www 6474:
1.809 bisitz 6475: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6476: background-color: $data_table_dark;
1.900 bisitz 6477: vertical-align: top;
1.347 albertel 6478: }
1.795 www 6479:
1.425 albertel 6480: table.LC_data_table tr.LC_data_table_highlight td {
6481: background-color: $data_table_darker;
6482: }
1.795 www 6483:
1.639 raeburn 6484: table.LC_data_table tr td.LC_leftcol_header {
6485: background-color: $data_table_head;
6486: font-weight: bold;
6487: }
1.795 www 6488:
1.451 albertel 6489: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6490: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6491: font-weight: bold;
6492: font-style: italic;
6493: text-align: center;
6494: padding: 8px;
1.347 albertel 6495: }
1.795 www 6496:
1.1114 raeburn 6497: table.LC_data_table tr.LC_empty_row td,
6498: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6499: background-color: $sidebg;
6500: }
6501:
6502: table.LC_nested tr.LC_empty_row td {
6503: background-color: #FFFFFF;
6504: }
6505:
1.890 droeschl 6506: table.LC_caption {
6507: }
6508:
1.507 raeburn 6509: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6510: padding: 4ex
6511: }
1.795 www 6512:
1.507 raeburn 6513: table.LC_nested_outer tr th {
6514: font-weight: bold;
1.801 tempelho 6515: color:$fontmenu;
1.507 raeburn 6516: background-color: $data_table_head;
1.701 harmsja 6517: font-size: small;
1.507 raeburn 6518: border-bottom: 1px solid #000000;
6519: }
1.795 www 6520:
1.507 raeburn 6521: table.LC_nested_outer tr td.LC_subheader {
6522: background-color: $data_table_head;
6523: font-weight: bold;
6524: font-size: small;
6525: border-bottom: 1px solid #000000;
6526: text-align: right;
1.451 albertel 6527: }
1.795 www 6528:
1.507 raeburn 6529: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6530: background-color: #CCCCCC;
1.451 albertel 6531: font-weight: bold;
6532: font-size: small;
1.507 raeburn 6533: text-align: center;
6534: }
1.795 www 6535:
1.589 raeburn 6536: table.LC_nested tr.LC_info_row td.LC_left_item,
6537: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6538: text-align: left;
1.451 albertel 6539: }
1.795 www 6540:
1.507 raeburn 6541: table.LC_nested td {
1.735 bisitz 6542: background-color: #FFFFFF;
1.451 albertel 6543: font-size: small;
1.507 raeburn 6544: }
1.795 www 6545:
1.507 raeburn 6546: table.LC_nested_outer tr th.LC_right_item,
6547: table.LC_nested tr.LC_info_row td.LC_right_item,
6548: table.LC_nested tr.LC_odd_row td.LC_right_item,
6549: table.LC_nested tr td.LC_right_item {
1.451 albertel 6550: text-align: right;
6551: }
6552:
1.507 raeburn 6553: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6554: background-color: #EEEEEE;
1.451 albertel 6555: }
6556:
1.473 raeburn 6557: table.LC_createuser {
6558: }
6559:
6560: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6561: font-size: small;
1.473 raeburn 6562: }
6563:
6564: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6565: background-color: #CCCCCC;
1.473 raeburn 6566: font-weight: bold;
6567: text-align: center;
6568: }
6569:
1.349 albertel 6570: table.LC_calendar {
6571: border: 1px solid #000000;
6572: border-collapse: collapse;
1.917 raeburn 6573: width: 98%;
1.349 albertel 6574: }
1.795 www 6575:
1.349 albertel 6576: table.LC_calendar_pickdate {
6577: font-size: xx-small;
6578: }
1.795 www 6579:
1.349 albertel 6580: table.LC_calendar tr td {
6581: border: 1px solid #000000;
6582: vertical-align: top;
1.917 raeburn 6583: width: 14%;
1.349 albertel 6584: }
1.795 www 6585:
1.349 albertel 6586: table.LC_calendar tr td.LC_calendar_day_empty {
6587: background-color: $data_table_dark;
6588: }
1.795 www 6589:
1.779 bisitz 6590: table.LC_calendar tr td.LC_calendar_day_current {
6591: background-color: $data_table_highlight;
1.777 tempelho 6592: }
1.795 www 6593:
1.938 bisitz 6594: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6595: background-color: $mail_new;
6596: }
1.795 www 6597:
1.938 bisitz 6598: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6599: background-color: $mail_new_hover;
6600: }
1.795 www 6601:
1.938 bisitz 6602: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6603: background-color: $mail_read;
6604: }
1.795 www 6605:
1.938 bisitz 6606: /*
6607: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6608: background-color: $mail_read_hover;
6609: }
1.938 bisitz 6610: */
1.795 www 6611:
1.938 bisitz 6612: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6613: background-color: $mail_replied;
6614: }
1.795 www 6615:
1.938 bisitz 6616: /*
6617: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6618: background-color: $mail_replied_hover;
6619: }
1.938 bisitz 6620: */
1.795 www 6621:
1.938 bisitz 6622: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6623: background-color: $mail_other;
6624: }
1.795 www 6625:
1.938 bisitz 6626: /*
6627: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6628: background-color: $mail_other_hover;
6629: }
1.938 bisitz 6630: */
1.494 raeburn 6631:
1.777 tempelho 6632: table.LC_data_table tr > td.LC_browser_file,
6633: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6634: background: #AAEE77;
1.389 albertel 6635: }
1.795 www 6636:
1.777 tempelho 6637: table.LC_data_table tr > td.LC_browser_file_locked,
6638: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6639: background: #FFAA99;
1.387 albertel 6640: }
1.795 www 6641:
1.777 tempelho 6642: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6643: background: #888888;
1.779 bisitz 6644: }
1.795 www 6645:
1.777 tempelho 6646: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6647: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6648: background: #F8F866;
1.777 tempelho 6649: }
1.795 www 6650:
1.696 bisitz 6651: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6652: background: #E0E8FF;
1.387 albertel 6653: }
1.696 bisitz 6654:
1.707 bisitz 6655: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6656: /* background: #77FF77; */
1.707 bisitz 6657: }
1.795 www 6658:
1.707 bisitz 6659: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6660: border-right: 8px solid #FFFF77;
1.707 bisitz 6661: }
1.795 www 6662:
1.707 bisitz 6663: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6664: border-right: 8px solid #FFAA77;
1.707 bisitz 6665: }
1.795 www 6666:
1.707 bisitz 6667: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6668: border-right: 8px solid #FF7777;
1.707 bisitz 6669: }
1.795 www 6670:
1.707 bisitz 6671: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6672: border-right: 8px solid #AAFF77;
1.707 bisitz 6673: }
1.795 www 6674:
1.707 bisitz 6675: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6676: border-right: 8px solid #11CC55;
1.707 bisitz 6677: }
6678:
1.388 albertel 6679: span.LC_current_location {
1.701 harmsja 6680: font-size:larger;
1.388 albertel 6681: background: $pgbg;
6682: }
1.387 albertel 6683:
1.1029 www 6684: span.LC_current_nav_location {
6685: font-weight:bold;
6686: background: $sidebg;
6687: }
6688:
1.395 albertel 6689: span.LC_parm_menu_item {
6690: font-size: larger;
6691: }
1.795 www 6692:
1.395 albertel 6693: span.LC_parm_scope_all {
6694: color: red;
6695: }
1.795 www 6696:
1.395 albertel 6697: span.LC_parm_scope_folder {
6698: color: green;
6699: }
1.795 www 6700:
1.395 albertel 6701: span.LC_parm_scope_resource {
6702: color: orange;
6703: }
1.795 www 6704:
1.395 albertel 6705: span.LC_parm_part {
6706: color: blue;
6707: }
1.795 www 6708:
1.911 bisitz 6709: span.LC_parm_folder,
6710: span.LC_parm_symb {
1.395 albertel 6711: font-size: x-small;
6712: font-family: $mono;
6713: color: #AAAAAA;
6714: }
6715:
1.977 bisitz 6716: ul.LC_parm_parmlist li {
6717: display: inline-block;
6718: padding: 0.3em 0.8em;
6719: vertical-align: top;
6720: width: 150px;
6721: border-top:1px solid $lg_border_color;
6722: }
6723:
1.795 www 6724: td.LC_parm_overview_level_menu,
6725: td.LC_parm_overview_map_menu,
6726: td.LC_parm_overview_parm_selectors,
6727: td.LC_parm_overview_restrictions {
1.396 albertel 6728: border: 1px solid black;
6729: border-collapse: collapse;
6730: }
1.795 www 6731:
1.396 albertel 6732: table.LC_parm_overview_restrictions td {
6733: border-width: 1px 4px 1px 4px;
6734: border-style: solid;
6735: border-color: $pgbg;
6736: text-align: center;
6737: }
1.795 www 6738:
1.396 albertel 6739: table.LC_parm_overview_restrictions th {
6740: background: $tabbg;
6741: border-width: 1px 4px 1px 4px;
6742: border-style: solid;
6743: border-color: $pgbg;
6744: }
1.795 www 6745:
1.398 albertel 6746: table#LC_helpmenu {
1.803 bisitz 6747: border: none;
1.398 albertel 6748: height: 55px;
1.803 bisitz 6749: border-spacing: 0;
1.398 albertel 6750: }
6751:
6752: table#LC_helpmenu fieldset legend {
6753: font-size: larger;
6754: }
1.795 www 6755:
1.397 albertel 6756: table#LC_helpmenu_links {
6757: width: 100%;
6758: border: 1px solid black;
6759: background: $pgbg;
1.803 bisitz 6760: padding: 0;
1.397 albertel 6761: border-spacing: 1px;
6762: }
1.795 www 6763:
1.397 albertel 6764: table#LC_helpmenu_links tr td {
6765: padding: 1px;
6766: background: $tabbg;
1.399 albertel 6767: text-align: center;
6768: font-weight: bold;
1.397 albertel 6769: }
1.396 albertel 6770:
1.795 www 6771: table#LC_helpmenu_links a:link,
6772: table#LC_helpmenu_links a:visited,
1.397 albertel 6773: table#LC_helpmenu_links a:active {
6774: text-decoration: none;
6775: color: $font;
6776: }
1.795 www 6777:
1.397 albertel 6778: table#LC_helpmenu_links a:hover {
6779: text-decoration: underline;
6780: color: $vlink;
6781: }
1.396 albertel 6782:
1.417 albertel 6783: .LC_chrt_popup_exists {
6784: border: 1px solid #339933;
6785: margin: -1px;
6786: }
1.795 www 6787:
1.417 albertel 6788: .LC_chrt_popup_up {
6789: border: 1px solid yellow;
6790: margin: -1px;
6791: }
1.795 www 6792:
1.417 albertel 6793: .LC_chrt_popup {
6794: border: 1px solid #8888FF;
6795: background: #CCCCFF;
6796: }
1.795 www 6797:
1.421 albertel 6798: table.LC_pick_box {
6799: border-collapse: separate;
6800: background: white;
6801: border: 1px solid black;
6802: border-spacing: 1px;
6803: }
1.795 www 6804:
1.421 albertel 6805: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6806: background: $sidebg;
1.421 albertel 6807: font-weight: bold;
1.900 bisitz 6808: text-align: left;
1.740 bisitz 6809: vertical-align: top;
1.421 albertel 6810: width: 184px;
6811: padding: 8px;
6812: }
1.795 www 6813:
1.579 raeburn 6814: table.LC_pick_box td.LC_pick_box_value {
6815: text-align: left;
6816: padding: 8px;
6817: }
1.795 www 6818:
1.579 raeburn 6819: table.LC_pick_box td.LC_pick_box_select {
6820: text-align: left;
6821: padding: 8px;
6822: }
1.795 www 6823:
1.424 albertel 6824: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6825: padding: 0;
1.421 albertel 6826: height: 1px;
6827: background: black;
6828: }
1.795 www 6829:
1.421 albertel 6830: table.LC_pick_box td.LC_pick_box_submit {
6831: text-align: right;
6832: }
1.795 www 6833:
1.579 raeburn 6834: table.LC_pick_box td.LC_evenrow_value {
6835: text-align: left;
6836: padding: 8px;
6837: background-color: $data_table_light;
6838: }
1.795 www 6839:
1.579 raeburn 6840: table.LC_pick_box td.LC_oddrow_value {
6841: text-align: left;
6842: padding: 8px;
6843: background-color: $data_table_light;
6844: }
1.795 www 6845:
1.579 raeburn 6846: span.LC_helpform_receipt_cat {
6847: font-weight: bold;
6848: }
1.795 www 6849:
1.424 albertel 6850: table.LC_group_priv_box {
6851: background: white;
6852: border: 1px solid black;
6853: border-spacing: 1px;
6854: }
1.795 www 6855:
1.424 albertel 6856: table.LC_group_priv_box td.LC_pick_box_title {
6857: background: $tabbg;
6858: font-weight: bold;
6859: text-align: right;
6860: width: 184px;
6861: }
1.795 www 6862:
1.424 albertel 6863: table.LC_group_priv_box td.LC_groups_fixed {
6864: background: $data_table_light;
6865: text-align: center;
6866: }
1.795 www 6867:
1.424 albertel 6868: table.LC_group_priv_box td.LC_groups_optional {
6869: background: $data_table_dark;
6870: text-align: center;
6871: }
1.795 www 6872:
1.424 albertel 6873: table.LC_group_priv_box td.LC_groups_functionality {
6874: background: $data_table_darker;
6875: text-align: center;
6876: font-weight: bold;
6877: }
1.795 www 6878:
1.424 albertel 6879: table.LC_group_priv td {
6880: text-align: left;
1.803 bisitz 6881: padding: 0;
1.424 albertel 6882: }
6883:
6884: .LC_navbuttons {
6885: margin: 2ex 0ex 2ex 0ex;
6886: }
1.795 www 6887:
1.423 albertel 6888: .LC_topic_bar {
6889: font-weight: bold;
6890: background: $tabbg;
1.918 wenzelju 6891: margin: 1em 0em 1em 2em;
1.805 bisitz 6892: padding: 3px;
1.918 wenzelju 6893: font-size: 1.2em;
1.423 albertel 6894: }
1.795 www 6895:
1.423 albertel 6896: .LC_topic_bar span {
1.918 wenzelju 6897: left: 0.5em;
6898: position: absolute;
1.423 albertel 6899: vertical-align: middle;
1.918 wenzelju 6900: font-size: 1.2em;
1.423 albertel 6901: }
1.795 www 6902:
1.423 albertel 6903: table.LC_course_group_status {
6904: margin: 20px;
6905: }
1.795 www 6906:
1.423 albertel 6907: table.LC_status_selector td {
6908: vertical-align: top;
6909: text-align: center;
1.424 albertel 6910: padding: 4px;
6911: }
1.795 www 6912:
1.599 albertel 6913: div.LC_feedback_link {
1.616 albertel 6914: clear: both;
1.829 kalberla 6915: background: $sidebg;
1.779 bisitz 6916: width: 100%;
1.829 kalberla 6917: padding-bottom: 10px;
6918: border: 1px $tabbg solid;
1.833 kalberla 6919: height: 22px;
6920: line-height: 22px;
6921: padding-top: 5px;
6922: }
6923:
6924: div.LC_feedback_link img {
6925: height: 22px;
1.867 kalberla 6926: vertical-align:middle;
1.829 kalberla 6927: }
6928:
1.911 bisitz 6929: div.LC_feedback_link a {
1.829 kalberla 6930: text-decoration: none;
1.489 raeburn 6931: }
1.795 www 6932:
1.867 kalberla 6933: div.LC_comblock {
1.911 bisitz 6934: display:inline;
1.867 kalberla 6935: color:$font;
6936: font-size:90%;
6937: }
6938:
6939: div.LC_feedback_link div.LC_comblock {
6940: padding-left:5px;
6941: }
6942:
6943: div.LC_feedback_link div.LC_comblock a {
6944: color:$font;
6945: }
6946:
1.489 raeburn 6947: span.LC_feedback_link {
1.858 bisitz 6948: /* background: $feedback_link_bg; */
1.599 albertel 6949: font-size: larger;
6950: }
1.795 www 6951:
1.599 albertel 6952: span.LC_message_link {
1.858 bisitz 6953: /* background: $feedback_link_bg; */
1.599 albertel 6954: font-size: larger;
6955: position: absolute;
6956: right: 1em;
1.489 raeburn 6957: }
1.421 albertel 6958:
1.515 albertel 6959: table.LC_prior_tries {
1.524 albertel 6960: border: 1px solid #000000;
6961: border-collapse: separate;
6962: border-spacing: 1px;
1.515 albertel 6963: }
1.523 albertel 6964:
1.515 albertel 6965: table.LC_prior_tries td {
1.524 albertel 6966: padding: 2px;
1.515 albertel 6967: }
1.523 albertel 6968:
6969: .LC_answer_correct {
1.795 www 6970: background: lightgreen;
6971: color: darkgreen;
6972: padding: 6px;
1.523 albertel 6973: }
1.795 www 6974:
1.523 albertel 6975: .LC_answer_charged_try {
1.797 www 6976: background: #FFAAAA;
1.795 www 6977: color: darkred;
6978: padding: 6px;
1.523 albertel 6979: }
1.795 www 6980:
1.779 bisitz 6981: .LC_answer_not_charged_try,
1.523 albertel 6982: .LC_answer_no_grade,
6983: .LC_answer_late {
1.795 www 6984: background: lightyellow;
1.523 albertel 6985: color: black;
1.795 www 6986: padding: 6px;
1.523 albertel 6987: }
1.795 www 6988:
1.523 albertel 6989: .LC_answer_previous {
1.795 www 6990: background: lightblue;
6991: color: darkblue;
6992: padding: 6px;
1.523 albertel 6993: }
1.795 www 6994:
1.779 bisitz 6995: .LC_answer_no_message {
1.777 tempelho 6996: background: #FFFFFF;
6997: color: black;
1.795 www 6998: padding: 6px;
1.779 bisitz 6999: }
1.795 www 7000:
1.779 bisitz 7001: .LC_answer_unknown {
7002: background: orange;
7003: color: black;
1.795 www 7004: padding: 6px;
1.777 tempelho 7005: }
1.795 www 7006:
1.529 albertel 7007: span.LC_prior_numerical,
7008: span.LC_prior_string,
7009: span.LC_prior_custom,
7010: span.LC_prior_reaction,
7011: span.LC_prior_math {
1.925 bisitz 7012: font-family: $mono;
1.523 albertel 7013: white-space: pre;
7014: }
7015:
1.525 albertel 7016: span.LC_prior_string {
1.925 bisitz 7017: font-family: $mono;
1.525 albertel 7018: white-space: pre;
7019: }
7020:
1.523 albertel 7021: table.LC_prior_option {
7022: width: 100%;
7023: border-collapse: collapse;
7024: }
1.795 www 7025:
1.911 bisitz 7026: table.LC_prior_rank,
1.795 www 7027: table.LC_prior_match {
1.528 albertel 7028: border-collapse: collapse;
7029: }
1.795 www 7030:
1.528 albertel 7031: table.LC_prior_option tr td,
7032: table.LC_prior_rank tr td,
7033: table.LC_prior_match tr td {
1.524 albertel 7034: border: 1px solid #000000;
1.515 albertel 7035: }
7036:
1.855 bisitz 7037: .LC_nobreak {
1.544 albertel 7038: white-space: nowrap;
1.519 raeburn 7039: }
7040:
1.576 raeburn 7041: span.LC_cusr_emph {
7042: font-style: italic;
7043: }
7044:
1.633 raeburn 7045: span.LC_cusr_subheading {
7046: font-weight: normal;
7047: font-size: 85%;
7048: }
7049:
1.861 bisitz 7050: div.LC_docs_entry_move {
1.859 bisitz 7051: border: 1px solid #BBBBBB;
1.545 albertel 7052: background: #DDDDDD;
1.861 bisitz 7053: width: 22px;
1.859 bisitz 7054: padding: 1px;
7055: margin: 0;
1.545 albertel 7056: }
7057:
1.861 bisitz 7058: table.LC_data_table tr > td.LC_docs_entry_commands,
7059: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7060: font-size: x-small;
7061: }
1.795 www 7062:
1.861 bisitz 7063: .LC_docs_entry_parameter {
7064: white-space: nowrap;
7065: }
7066:
1.544 albertel 7067: .LC_docs_copy {
1.545 albertel 7068: color: #000099;
1.544 albertel 7069: }
1.795 www 7070:
1.544 albertel 7071: .LC_docs_cut {
1.545 albertel 7072: color: #550044;
1.544 albertel 7073: }
1.795 www 7074:
1.544 albertel 7075: .LC_docs_rename {
1.545 albertel 7076: color: #009900;
1.544 albertel 7077: }
1.795 www 7078:
1.544 albertel 7079: .LC_docs_remove {
1.545 albertel 7080: color: #990000;
7081: }
7082:
1.547 albertel 7083: .LC_docs_reinit_warn,
7084: .LC_docs_ext_edit {
7085: font-size: x-small;
7086: }
7087:
1.545 albertel 7088: table.LC_docs_adddocs td,
7089: table.LC_docs_adddocs th {
7090: border: 1px solid #BBBBBB;
7091: padding: 4px;
7092: background: #DDDDDD;
1.543 albertel 7093: }
7094:
1.584 albertel 7095: table.LC_sty_begin {
7096: background: #BBFFBB;
7097: }
1.795 www 7098:
1.584 albertel 7099: table.LC_sty_end {
7100: background: #FFBBBB;
7101: }
7102:
1.589 raeburn 7103: table.LC_double_column {
1.803 bisitz 7104: border-width: 0;
1.589 raeburn 7105: border-collapse: collapse;
7106: width: 100%;
7107: padding: 2px;
7108: }
7109:
7110: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7111: top: 2px;
1.589 raeburn 7112: left: 2px;
7113: width: 47%;
7114: vertical-align: top;
7115: }
7116:
7117: table.LC_double_column tr td.LC_right_col {
7118: top: 2px;
1.779 bisitz 7119: right: 2px;
1.589 raeburn 7120: width: 47%;
7121: vertical-align: top;
7122: }
7123:
1.591 raeburn 7124: div.LC_left_float {
7125: float: left;
7126: padding-right: 5%;
1.597 albertel 7127: padding-bottom: 4px;
1.591 raeburn 7128: }
7129:
7130: div.LC_clear_float_header {
1.597 albertel 7131: padding-bottom: 2px;
1.591 raeburn 7132: }
7133:
7134: div.LC_clear_float_footer {
1.597 albertel 7135: padding-top: 10px;
1.591 raeburn 7136: clear: both;
7137: }
7138:
1.597 albertel 7139: div.LC_grade_show_user {
1.941 bisitz 7140: /* border-left: 5px solid $sidebg; */
7141: border-top: 5px solid #000000;
7142: margin: 50px 0 0 0;
1.936 bisitz 7143: padding: 15px 0 5px 10px;
1.597 albertel 7144: }
1.795 www 7145:
1.936 bisitz 7146: div.LC_grade_show_user_odd_row {
1.941 bisitz 7147: /* border-left: 5px solid #000000; */
7148: }
7149:
7150: div.LC_grade_show_user div.LC_Box {
7151: margin-right: 50px;
1.597 albertel 7152: }
7153:
7154: div.LC_grade_submissions,
7155: div.LC_grade_message_center,
1.936 bisitz 7156: div.LC_grade_info_links {
1.597 albertel 7157: margin: 5px;
7158: width: 99%;
7159: background: #FFFFFF;
7160: }
1.795 www 7161:
1.597 albertel 7162: div.LC_grade_submissions_header,
1.936 bisitz 7163: div.LC_grade_message_center_header {
1.705 tempelho 7164: font-weight: bold;
7165: font-size: large;
1.597 albertel 7166: }
1.795 www 7167:
1.597 albertel 7168: div.LC_grade_submissions_body,
1.936 bisitz 7169: div.LC_grade_message_center_body {
1.597 albertel 7170: border: 1px solid black;
7171: width: 99%;
7172: background: #FFFFFF;
7173: }
1.795 www 7174:
1.613 albertel 7175: table.LC_scantron_action {
7176: width: 100%;
7177: }
1.795 www 7178:
1.613 albertel 7179: table.LC_scantron_action tr th {
1.698 harmsja 7180: font-weight:bold;
7181: font-style:normal;
1.613 albertel 7182: }
1.795 www 7183:
1.779 bisitz 7184: .LC_edit_problem_header,
1.614 albertel 7185: div.LC_edit_problem_footer {
1.705 tempelho 7186: font-weight: normal;
7187: font-size: medium;
1.602 albertel 7188: margin: 2px;
1.1060 bisitz 7189: background-color: $sidebg;
1.600 albertel 7190: }
1.795 www 7191:
1.600 albertel 7192: div.LC_edit_problem_header,
1.602 albertel 7193: div.LC_edit_problem_header div,
1.614 albertel 7194: div.LC_edit_problem_footer,
7195: div.LC_edit_problem_footer div,
1.602 albertel 7196: div.LC_edit_problem_editxml_header,
7197: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7198: z-index: 100;
1.600 albertel 7199: }
1.795 www 7200:
1.600 albertel 7201: div.LC_edit_problem_header_title {
1.705 tempelho 7202: font-weight: bold;
7203: font-size: larger;
1.602 albertel 7204: background: $tabbg;
7205: padding: 3px;
1.1060 bisitz 7206: margin: 0 0 5px 0;
1.602 albertel 7207: }
1.795 www 7208:
1.602 albertel 7209: table.LC_edit_problem_header_title {
7210: width: 100%;
1.600 albertel 7211: background: $tabbg;
1.602 albertel 7212: }
7213:
1.1205 golterma 7214: div.LC_edit_actionbar {
7215: background-color: $sidebg;
1.1218 droeschl 7216: margin: 0;
7217: padding: 0;
7218: line-height: 200%;
1.602 albertel 7219: }
1.795 www 7220:
1.1218 droeschl 7221: div.LC_edit_actionbar div{
7222: padding: 0;
7223: margin: 0;
7224: display: inline-block;
1.600 albertel 7225: }
1.795 www 7226:
1.1124 bisitz 7227: .LC_edit_opt {
7228: padding-left: 1em;
7229: white-space: nowrap;
7230: }
7231:
1.1152 golterma 7232: .LC_edit_problem_latexhelper{
7233: text-align: right;
7234: }
7235:
7236: #LC_edit_problem_colorful div{
7237: margin-left: 40px;
7238: }
7239:
1.1205 golterma 7240: #LC_edit_problem_codemirror div{
7241: margin-left: 0px;
7242: }
7243:
1.911 bisitz 7244: img.stift {
1.803 bisitz 7245: border-width: 0;
7246: vertical-align: middle;
1.677 riegler 7247: }
1.680 riegler 7248:
1.923 bisitz 7249: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7250: vertical-align: top;
1.777 tempelho 7251: }
1.795 www 7252:
1.716 raeburn 7253: div.LC_createcourse {
1.911 bisitz 7254: margin: 10px 10px 10px 10px;
1.716 raeburn 7255: }
7256:
1.917 raeburn 7257: .LC_dccid {
1.1130 raeburn 7258: float: right;
1.917 raeburn 7259: margin: 0.2em 0 0 0;
7260: padding: 0;
7261: font-size: 90%;
7262: display:none;
7263: }
7264:
1.897 wenzelju 7265: ol.LC_primary_menu a:hover,
1.721 harmsja 7266: ol#LC_MenuBreadcrumbs a:hover,
7267: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7268: ul#LC_secondary_menu a:hover,
1.721 harmsja 7269: .LC_FormSectionClearButton input:hover
1.795 www 7270: ul.LC_TabContent li:hover a {
1.952 onken 7271: color:$button_hover;
1.911 bisitz 7272: text-decoration:none;
1.693 droeschl 7273: }
7274:
1.779 bisitz 7275: h1 {
1.911 bisitz 7276: padding: 0;
7277: line-height:130%;
1.693 droeschl 7278: }
1.698 harmsja 7279:
1.911 bisitz 7280: h2,
7281: h3,
7282: h4,
7283: h5,
7284: h6 {
7285: margin: 5px 0 5px 0;
7286: padding: 0;
7287: line-height:130%;
1.693 droeschl 7288: }
1.795 www 7289:
7290: .LC_hcell {
1.911 bisitz 7291: padding:3px 15px 3px 15px;
7292: margin: 0;
7293: background-color:$tabbg;
7294: color:$fontmenu;
7295: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7296: }
1.795 www 7297:
1.840 bisitz 7298: .LC_Box > .LC_hcell {
1.911 bisitz 7299: margin: 0 -10px 10px -10px;
1.835 bisitz 7300: }
7301:
1.721 harmsja 7302: .LC_noBorder {
1.911 bisitz 7303: border: 0;
1.698 harmsja 7304: }
1.693 droeschl 7305:
1.721 harmsja 7306: .LC_FormSectionClearButton input {
1.911 bisitz 7307: background-color:transparent;
7308: border: none;
7309: cursor:pointer;
7310: text-decoration:underline;
1.693 droeschl 7311: }
1.763 bisitz 7312:
7313: .LC_help_open_topic {
1.911 bisitz 7314: color: #FFFFFF;
7315: background-color: #EEEEFF;
7316: margin: 1px;
7317: padding: 4px;
7318: border: 1px solid #000033;
7319: white-space: nowrap;
7320: /* vertical-align: middle; */
1.759 neumanie 7321: }
1.693 droeschl 7322:
1.911 bisitz 7323: dl,
7324: ul,
7325: div,
7326: fieldset {
7327: margin: 10px 10px 10px 0;
7328: /* overflow: hidden; */
1.693 droeschl 7329: }
1.795 www 7330:
1.1211 raeburn 7331: article.geogebraweb div {
7332: margin: 0;
7333: }
7334:
1.838 bisitz 7335: fieldset > legend {
1.911 bisitz 7336: font-weight: bold;
7337: padding: 0 5px 0 5px;
1.838 bisitz 7338: }
7339:
1.813 bisitz 7340: #LC_nav_bar {
1.911 bisitz 7341: float: left;
1.995 raeburn 7342: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7343: margin: 0 0 2px 0;
1.807 droeschl 7344: }
7345:
1.916 droeschl 7346: #LC_realm {
7347: margin: 0.2em 0 0 0;
7348: padding: 0;
7349: font-weight: bold;
7350: text-align: center;
1.995 raeburn 7351: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7352: }
7353:
1.911 bisitz 7354: #LC_nav_bar em {
7355: font-weight: bold;
7356: font-style: normal;
1.807 droeschl 7357: }
7358:
1.897 wenzelju 7359: ol.LC_primary_menu {
1.934 droeschl 7360: margin: 0;
1.1076 raeburn 7361: padding: 0;
1.807 droeschl 7362: }
7363:
1.852 droeschl 7364: ol#LC_PathBreadcrumbs {
1.911 bisitz 7365: margin: 0;
1.693 droeschl 7366: }
7367:
1.897 wenzelju 7368: ol.LC_primary_menu li {
1.1076 raeburn 7369: color: RGB(80, 80, 80);
7370: vertical-align: middle;
7371: text-align: left;
7372: list-style: none;
1.1205 golterma 7373: position: relative;
1.1076 raeburn 7374: float: left;
1.1205 golterma 7375: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7376: line-height: 1.5em;
1.1076 raeburn 7377: }
7378:
1.1205 golterma 7379: ol.LC_primary_menu li a,
7380: ol.LC_primary_menu li p {
1.1076 raeburn 7381: display: block;
7382: margin: 0;
7383: padding: 0 5px 0 10px;
7384: text-decoration: none;
7385: }
7386:
1.1205 golterma 7387: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7388: display: inline-block;
7389: width: 95%;
7390: text-align: left;
7391: }
7392:
7393: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7394: display: inline-block;
7395: width: 5%;
7396: float: right;
7397: text-align: right;
7398: font-size: 70%;
7399: }
7400:
7401: ol.LC_primary_menu ul {
1.1076 raeburn 7402: display: none;
1.1205 golterma 7403: width: 15em;
1.1076 raeburn 7404: background-color: $data_table_light;
1.1205 golterma 7405: position: absolute;
7406: top: 100%;
1.1076 raeburn 7407: }
7408:
1.1205 golterma 7409: ol.LC_primary_menu ul ul {
7410: left: 100%;
7411: top: 0;
7412: }
7413:
7414: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7415: display: block;
7416: position: absolute;
7417: margin: 0;
7418: padding: 0;
1.1078 raeburn 7419: z-index: 2;
1.1076 raeburn 7420: }
7421:
7422: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7423: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7424: font-size: 90%;
1.911 bisitz 7425: vertical-align: top;
1.1076 raeburn 7426: float: none;
1.1079 raeburn 7427: border-left: 1px solid black;
7428: border-right: 1px solid black;
1.1205 golterma 7429: /* A dark bottom border to visualize different menu options;
7430: overwritten in the create_submenu routine for the last border-bottom of the menu */
7431: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7432: }
7433:
1.1205 golterma 7434: ol.LC_primary_menu li li p:hover {
7435: color:$button_hover;
7436: text-decoration:none;
7437: background-color:$data_table_dark;
1.1076 raeburn 7438: }
7439:
7440: ol.LC_primary_menu li li a:hover {
7441: color:$button_hover;
7442: background-color:$data_table_dark;
1.693 droeschl 7443: }
7444:
1.1205 golterma 7445: /* Font-size equal to the size of the predecessors*/
7446: ol.LC_primary_menu li:hover li li {
7447: font-size: 100%;
7448: }
7449:
1.897 wenzelju 7450: ol.LC_primary_menu li img {
1.911 bisitz 7451: vertical-align: bottom;
1.934 droeschl 7452: height: 1.1em;
1.1077 raeburn 7453: margin: 0.2em 0 0 0;
1.693 droeschl 7454: }
7455:
1.897 wenzelju 7456: ol.LC_primary_menu a {
1.911 bisitz 7457: color: RGB(80, 80, 80);
7458: text-decoration: none;
1.693 droeschl 7459: }
1.795 www 7460:
1.949 droeschl 7461: ol.LC_primary_menu a.LC_new_message {
7462: font-weight:bold;
7463: color: darkred;
7464: }
7465:
1.975 raeburn 7466: ol.LC_docs_parameters {
7467: margin-left: 0;
7468: padding: 0;
7469: list-style: none;
7470: }
7471:
7472: ol.LC_docs_parameters li {
7473: margin: 0;
7474: padding-right: 20px;
7475: display: inline;
7476: }
7477:
1.976 raeburn 7478: ol.LC_docs_parameters li:before {
7479: content: "\\002022 \\0020";
7480: }
7481:
7482: li.LC_docs_parameters_title {
7483: font-weight: bold;
7484: }
7485:
7486: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7487: content: "";
7488: }
7489:
1.897 wenzelju 7490: ul#LC_secondary_menu {
1.1107 raeburn 7491: clear: right;
1.911 bisitz 7492: color: $fontmenu;
7493: background: $tabbg;
7494: list-style: none;
7495: padding: 0;
7496: margin: 0;
7497: width: 100%;
1.995 raeburn 7498: text-align: left;
1.1107 raeburn 7499: float: left;
1.808 droeschl 7500: }
7501:
1.897 wenzelju 7502: ul#LC_secondary_menu li {
1.911 bisitz 7503: font-weight: bold;
7504: line-height: 1.8em;
1.1107 raeburn 7505: border-right: 1px solid black;
7506: float: left;
7507: }
7508:
7509: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7510: background-color: $data_table_light;
7511: }
7512:
7513: ul#LC_secondary_menu li a {
1.911 bisitz 7514: padding: 0 0.8em;
1.1107 raeburn 7515: }
7516:
7517: ul#LC_secondary_menu li ul {
7518: display: none;
7519: }
7520:
7521: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7522: display: block;
7523: position: absolute;
7524: margin: 0;
7525: padding: 0;
7526: list-style:none;
7527: float: none;
7528: background-color: $data_table_light;
7529: z-index: 2;
7530: margin-left: -1px;
7531: }
7532:
7533: ul#LC_secondary_menu li ul li {
7534: font-size: 90%;
7535: vertical-align: top;
7536: border-left: 1px solid black;
1.911 bisitz 7537: border-right: 1px solid black;
1.1119 raeburn 7538: background-color: $data_table_light;
1.1107 raeburn 7539: list-style:none;
7540: float: none;
7541: }
7542:
7543: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7544: background-color: $data_table_dark;
1.807 droeschl 7545: }
7546:
1.847 tempelho 7547: ul.LC_TabContent {
1.911 bisitz 7548: display:block;
7549: background: $sidebg;
7550: border-bottom: solid 1px $lg_border_color;
7551: list-style:none;
1.1020 raeburn 7552: margin: -1px -10px 0 -10px;
1.911 bisitz 7553: padding: 0;
1.693 droeschl 7554: }
7555:
1.795 www 7556: ul.LC_TabContent li,
7557: ul.LC_TabContentBigger li {
1.911 bisitz 7558: float:left;
1.741 harmsja 7559: }
1.795 www 7560:
1.897 wenzelju 7561: ul#LC_secondary_menu li a {
1.911 bisitz 7562: color: $fontmenu;
7563: text-decoration: none;
1.693 droeschl 7564: }
1.795 www 7565:
1.721 harmsja 7566: ul.LC_TabContent {
1.952 onken 7567: min-height:20px;
1.721 harmsja 7568: }
1.795 www 7569:
7570: ul.LC_TabContent li {
1.911 bisitz 7571: vertical-align:middle;
1.959 onken 7572: padding: 0 16px 0 10px;
1.911 bisitz 7573: background-color:$tabbg;
7574: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7575: border-left: solid 1px $font;
1.721 harmsja 7576: }
1.795 www 7577:
1.847 tempelho 7578: ul.LC_TabContent .right {
1.911 bisitz 7579: float:right;
1.847 tempelho 7580: }
7581:
1.911 bisitz 7582: ul.LC_TabContent li a,
7583: ul.LC_TabContent li {
7584: color:rgb(47,47,47);
7585: text-decoration:none;
7586: font-size:95%;
7587: font-weight:bold;
1.952 onken 7588: min-height:20px;
7589: }
7590:
1.959 onken 7591: ul.LC_TabContent li a:hover,
7592: ul.LC_TabContent li a:focus {
1.952 onken 7593: color: $button_hover;
1.959 onken 7594: background:none;
7595: outline:none;
1.952 onken 7596: }
7597:
7598: ul.LC_TabContent li:hover {
7599: color: $button_hover;
7600: cursor:pointer;
1.721 harmsja 7601: }
1.795 www 7602:
1.911 bisitz 7603: ul.LC_TabContent li.active {
1.952 onken 7604: color: $font;
1.911 bisitz 7605: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7606: border-bottom:solid 1px #FFFFFF;
7607: cursor: default;
1.744 ehlerst 7608: }
1.795 www 7609:
1.959 onken 7610: ul.LC_TabContent li.active a {
7611: color:$font;
7612: background:#FFFFFF;
7613: outline: none;
7614: }
1.1047 raeburn 7615:
7616: ul.LC_TabContent li.goback {
7617: float: left;
7618: border-left: none;
7619: }
7620:
1.870 tempelho 7621: #maincoursedoc {
1.911 bisitz 7622: clear:both;
1.870 tempelho 7623: }
7624:
7625: ul.LC_TabContentBigger {
1.911 bisitz 7626: display:block;
7627: list-style:none;
7628: padding: 0;
1.870 tempelho 7629: }
7630:
1.795 www 7631: ul.LC_TabContentBigger li {
1.911 bisitz 7632: vertical-align:bottom;
7633: height: 30px;
7634: font-size:110%;
7635: font-weight:bold;
7636: color: #737373;
1.841 tempelho 7637: }
7638:
1.957 onken 7639: ul.LC_TabContentBigger li.active {
7640: position: relative;
7641: top: 1px;
7642: }
7643:
1.870 tempelho 7644: ul.LC_TabContentBigger li a {
1.911 bisitz 7645: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7646: height: 30px;
7647: line-height: 30px;
7648: text-align: center;
7649: display: block;
7650: text-decoration: none;
1.958 onken 7651: outline: none;
1.741 harmsja 7652: }
1.795 www 7653:
1.870 tempelho 7654: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7655: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7656: color:$font;
1.744 ehlerst 7657: }
1.795 www 7658:
1.870 tempelho 7659: ul.LC_TabContentBigger li b {
1.911 bisitz 7660: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7661: display: block;
7662: float: left;
7663: padding: 0 30px;
1.957 onken 7664: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7665: }
7666:
1.956 onken 7667: ul.LC_TabContentBigger li:hover b {
7668: color:$button_hover;
7669: }
7670:
1.870 tempelho 7671: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7672: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7673: color:$font;
1.957 onken 7674: border: 0;
1.741 harmsja 7675: }
1.693 droeschl 7676:
1.870 tempelho 7677:
1.862 bisitz 7678: ul.LC_CourseBreadcrumbs {
7679: background: $sidebg;
1.1020 raeburn 7680: height: 2em;
1.862 bisitz 7681: padding-left: 10px;
1.1020 raeburn 7682: margin: 0;
1.862 bisitz 7683: list-style-position: inside;
7684: }
7685:
1.911 bisitz 7686: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7687: ol#LC_PathBreadcrumbs {
1.911 bisitz 7688: padding-left: 10px;
7689: margin: 0;
1.933 droeschl 7690: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7691: }
7692:
1.911 bisitz 7693: ol#LC_MenuBreadcrumbs li,
7694: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7695: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7696: display: inline;
1.933 droeschl 7697: white-space: normal;
1.693 droeschl 7698: }
7699:
1.823 bisitz 7700: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7701: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7702: text-decoration: none;
7703: font-size:90%;
1.693 droeschl 7704: }
1.795 www 7705:
1.969 droeschl 7706: ol#LC_MenuBreadcrumbs h1 {
7707: display: inline;
7708: font-size: 90%;
7709: line-height: 2.5em;
7710: margin: 0;
7711: padding: 0;
7712: }
7713:
1.795 www 7714: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7715: text-decoration:none;
7716: font-size:100%;
7717: font-weight:bold;
1.693 droeschl 7718: }
1.795 www 7719:
1.840 bisitz 7720: .LC_Box {
1.911 bisitz 7721: border: solid 1px $lg_border_color;
7722: padding: 0 10px 10px 10px;
1.746 neumanie 7723: }
1.795 www 7724:
1.1020 raeburn 7725: .LC_DocsBox {
7726: border: solid 1px $lg_border_color;
7727: padding: 0 0 10px 10px;
7728: }
7729:
1.795 www 7730: .LC_AboutMe_Image {
1.911 bisitz 7731: float:left;
7732: margin-right:10px;
1.747 neumanie 7733: }
1.795 www 7734:
7735: .LC_Clear_AboutMe_Image {
1.911 bisitz 7736: clear:left;
1.747 neumanie 7737: }
1.795 www 7738:
1.721 harmsja 7739: dl.LC_ListStyleClean dt {
1.911 bisitz 7740: padding-right: 5px;
7741: display: table-header-group;
1.693 droeschl 7742: }
7743:
1.721 harmsja 7744: dl.LC_ListStyleClean dd {
1.911 bisitz 7745: display: table-row;
1.693 droeschl 7746: }
7747:
1.721 harmsja 7748: .LC_ListStyleClean,
7749: .LC_ListStyleSimple,
7750: .LC_ListStyleNormal,
1.795 www 7751: .LC_ListStyleSpecial {
1.911 bisitz 7752: /* display:block; */
7753: list-style-position: inside;
7754: list-style-type: none;
7755: overflow: hidden;
7756: padding: 0;
1.693 droeschl 7757: }
7758:
1.721 harmsja 7759: .LC_ListStyleSimple li,
7760: .LC_ListStyleSimple dd,
7761: .LC_ListStyleNormal li,
7762: .LC_ListStyleNormal dd,
7763: .LC_ListStyleSpecial li,
1.795 www 7764: .LC_ListStyleSpecial dd {
1.911 bisitz 7765: margin: 0;
7766: padding: 5px 5px 5px 10px;
7767: clear: both;
1.693 droeschl 7768: }
7769:
1.721 harmsja 7770: .LC_ListStyleClean li,
7771: .LC_ListStyleClean dd {
1.911 bisitz 7772: padding-top: 0;
7773: padding-bottom: 0;
1.693 droeschl 7774: }
7775:
1.721 harmsja 7776: .LC_ListStyleSimple dd,
1.795 www 7777: .LC_ListStyleSimple li {
1.911 bisitz 7778: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7779: }
7780:
1.721 harmsja 7781: .LC_ListStyleSpecial li,
7782: .LC_ListStyleSpecial dd {
1.911 bisitz 7783: list-style-type: none;
7784: background-color: RGB(220, 220, 220);
7785: margin-bottom: 4px;
1.693 droeschl 7786: }
7787:
1.721 harmsja 7788: table.LC_SimpleTable {
1.911 bisitz 7789: margin:5px;
7790: border:solid 1px $lg_border_color;
1.795 www 7791: }
1.693 droeschl 7792:
1.721 harmsja 7793: table.LC_SimpleTable tr {
1.911 bisitz 7794: padding: 0;
7795: border:solid 1px $lg_border_color;
1.693 droeschl 7796: }
1.795 www 7797:
7798: table.LC_SimpleTable thead {
1.911 bisitz 7799: background:rgb(220,220,220);
1.693 droeschl 7800: }
7801:
1.721 harmsja 7802: div.LC_columnSection {
1.911 bisitz 7803: display: block;
7804: clear: both;
7805: overflow: hidden;
7806: margin: 0;
1.693 droeschl 7807: }
7808:
1.721 harmsja 7809: div.LC_columnSection>* {
1.911 bisitz 7810: float: left;
7811: margin: 10px 20px 10px 0;
7812: overflow:hidden;
1.693 droeschl 7813: }
1.721 harmsja 7814:
1.795 www 7815: table em {
1.911 bisitz 7816: font-weight: bold;
7817: font-style: normal;
1.748 schulted 7818: }
1.795 www 7819:
1.779 bisitz 7820: table.LC_tableBrowseRes,
1.795 www 7821: table.LC_tableOfContent {
1.911 bisitz 7822: border:none;
7823: border-spacing: 1px;
7824: padding: 3px;
7825: background-color: #FFFFFF;
7826: font-size: 90%;
1.753 droeschl 7827: }
1.789 droeschl 7828:
1.911 bisitz 7829: table.LC_tableOfContent {
7830: border-collapse: collapse;
1.789 droeschl 7831: }
7832:
1.771 droeschl 7833: table.LC_tableBrowseRes a,
1.768 schulted 7834: table.LC_tableOfContent a {
1.911 bisitz 7835: background-color: transparent;
7836: text-decoration: none;
1.753 droeschl 7837: }
7838:
1.795 www 7839: table.LC_tableOfContent img {
1.911 bisitz 7840: border: none;
7841: height: 1.3em;
7842: vertical-align: text-bottom;
7843: margin-right: 0.3em;
1.753 droeschl 7844: }
1.757 schulted 7845:
1.795 www 7846: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7847: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7848: }
7849:
1.795 www 7850: a#LC_content_toolbar_everything {
1.911 bisitz 7851: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7852: }
7853:
1.795 www 7854: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7855: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7856: }
7857:
1.795 www 7858: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7859: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7860: }
7861:
1.795 www 7862: a#LC_content_toolbar_changefolder {
1.911 bisitz 7863: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7864: }
7865:
1.795 www 7866: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7867: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7868: }
7869:
1.1043 raeburn 7870: a#LC_content_toolbar_edittoplevel {
7871: background-image:url(/res/adm/pages/edittoplevel.gif);
7872: }
7873:
1.795 www 7874: ul#LC_toolbar li a:hover {
1.911 bisitz 7875: background-position: bottom center;
1.757 schulted 7876: }
7877:
1.795 www 7878: ul#LC_toolbar {
1.911 bisitz 7879: padding: 0;
7880: margin: 2px;
7881: list-style:none;
7882: position:relative;
7883: background-color:white;
1.1082 raeburn 7884: overflow: auto;
1.757 schulted 7885: }
7886:
1.795 www 7887: ul#LC_toolbar li {
1.911 bisitz 7888: border:1px solid white;
7889: padding: 0;
7890: margin: 0;
7891: float: left;
7892: display:inline;
7893: vertical-align:middle;
1.1082 raeburn 7894: white-space: nowrap;
1.911 bisitz 7895: }
1.757 schulted 7896:
1.783 amueller 7897:
1.795 www 7898: a.LC_toolbarItem {
1.911 bisitz 7899: display:block;
7900: padding: 0;
7901: margin: 0;
7902: height: 32px;
7903: width: 32px;
7904: color:white;
7905: border: none;
7906: background-repeat:no-repeat;
7907: background-color:transparent;
1.757 schulted 7908: }
7909:
1.915 droeschl 7910: ul.LC_funclist {
7911: margin: 0;
7912: padding: 0.5em 1em 0.5em 0;
7913: }
7914:
1.933 droeschl 7915: ul.LC_funclist > li:first-child {
7916: font-weight:bold;
7917: margin-left:0.8em;
7918: }
7919:
1.915 droeschl 7920: ul.LC_funclist + ul.LC_funclist {
7921: /*
7922: left border as a seperator if we have more than
7923: one list
7924: */
7925: border-left: 1px solid $sidebg;
7926: /*
7927: this hides the left border behind the border of the
7928: outer box if element is wrapped to the next 'line'
7929: */
7930: margin-left: -1px;
7931: }
7932:
1.843 bisitz 7933: ul.LC_funclist li {
1.915 droeschl 7934: display: inline;
1.782 bisitz 7935: white-space: nowrap;
1.915 droeschl 7936: margin: 0 0 0 25px;
7937: line-height: 150%;
1.782 bisitz 7938: }
7939:
1.974 wenzelju 7940: .LC_hidden {
7941: display: none;
7942: }
7943:
1.1030 www 7944: .LCmodal-overlay {
7945: position:fixed;
7946: top:0;
7947: right:0;
7948: bottom:0;
7949: left:0;
7950: height:100%;
7951: width:100%;
7952: margin:0;
7953: padding:0;
7954: background:#999;
7955: opacity:.75;
7956: filter: alpha(opacity=75);
7957: -moz-opacity: 0.75;
7958: z-index:101;
7959: }
7960:
7961: * html .LCmodal-overlay {
7962: position: absolute;
7963: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7964: }
7965:
7966: .LCmodal-window {
7967: position:fixed;
7968: top:50%;
7969: left:50%;
7970: margin:0;
7971: padding:0;
7972: z-index:102;
7973: }
7974:
7975: * html .LCmodal-window {
7976: position:absolute;
7977: }
7978:
7979: .LCclose-window {
7980: position:absolute;
7981: width:32px;
7982: height:32px;
7983: right:8px;
7984: top:8px;
7985: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7986: text-indent:-99999px;
7987: overflow:hidden;
7988: cursor:pointer;
7989: }
7990:
1.1100 raeburn 7991: /*
1.1231 damieng 7992: styles used for response display
7993: */
7994: div.LC_radiofoil, div.LC_rankfoil {
7995: margin: .5em 0em .5em 0em;
7996: }
7997: table.LC_itemgroup {
7998: margin-top: 1em;
7999: }
8000:
8001: /*
1.1100 raeburn 8002: styles used by TTH when "Default set of options to pass to tth/m
8003: when converting TeX" in course settings has been set
8004:
8005: option passed: -t
8006:
8007: */
8008:
8009: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8010: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8011: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8012: td div.norm {line-height:normal;}
8013:
8014: /*
8015: option passed -y3
8016: */
8017:
8018: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8019: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8020: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8021:
1.1230 damieng 8022: /*
8023: sections with roles, for content only
8024: */
8025: section[class^="role-"] {
8026: padding-left: 10px;
8027: padding-right: 5px;
8028: margin-top: 8px;
8029: margin-bottom: 8px;
8030: border: 1px solid #2A4;
8031: border-radius: 5px;
8032: box-shadow: 0px 1px 1px #BBB;
8033: }
8034: section[class^="role-"]>h1 {
8035: position: relative;
8036: margin: 0px;
8037: padding-top: 10px;
8038: padding-left: 40px;
8039: }
8040: section[class^="role-"]>h1:before {
8041: position: absolute;
8042: left: -5px;
8043: top: 5px;
8044: }
8045: section.role-activity>h1:before {
8046: content:url('/adm/daxe/images/section_icons/activity.png');
8047: }
8048: section.role-advice>h1:before {
8049: content:url('/adm/daxe/images/section_icons/advice.png');
8050: }
8051: section.role-bibliography>h1:before {
8052: content:url('/adm/daxe/images/section_icons/bibliography.png');
8053: }
8054: section.role-citation>h1:before {
8055: content:url('/adm/daxe/images/section_icons/citation.png');
8056: }
8057: section.role-conclusion>h1:before {
8058: content:url('/adm/daxe/images/section_icons/conclusion.png');
8059: }
8060: section.role-definition>h1:before {
8061: content:url('/adm/daxe/images/section_icons/definition.png');
8062: }
8063: section.role-demonstration>h1:before {
8064: content:url('/adm/daxe/images/section_icons/demonstration.png');
8065: }
8066: section.role-example>h1:before {
8067: content:url('/adm/daxe/images/section_icons/example.png');
8068: }
8069: section.role-explanation>h1:before {
8070: content:url('/adm/daxe/images/section_icons/explanation.png');
8071: }
8072: section.role-introduction>h1:before {
8073: content:url('/adm/daxe/images/section_icons/introduction.png');
8074: }
8075: section.role-method>h1:before {
8076: content:url('/adm/daxe/images/section_icons/method.png');
8077: }
8078: section.role-more_information>h1:before {
8079: content:url('/adm/daxe/images/section_icons/more_information.png');
8080: }
8081: section.role-objectives>h1:before {
8082: content:url('/adm/daxe/images/section_icons/objectives.png');
8083: }
8084: section.role-prerequisites>h1:before {
8085: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8086: }
8087: section.role-remark>h1:before {
8088: content:url('/adm/daxe/images/section_icons/remark.png');
8089: }
8090: section.role-reminder>h1:before {
8091: content:url('/adm/daxe/images/section_icons/reminder.png');
8092: }
8093: section.role-summary>h1:before {
8094: content:url('/adm/daxe/images/section_icons/summary.png');
8095: }
8096: section.role-syntax>h1:before {
8097: content:url('/adm/daxe/images/section_icons/syntax.png');
8098: }
8099: section.role-warning>h1:before {
8100: content:url('/adm/daxe/images/section_icons/warning.png');
8101: }
8102:
1.343 albertel 8103: END
8104: }
8105:
1.306 albertel 8106: =pod
8107:
8108: =item * &headtag()
8109:
8110: Returns a uniform footer for LON-CAPA web pages.
8111:
1.307 albertel 8112: Inputs: $title - optional title for the head
8113: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8114: $args - optional arguments
1.319 albertel 8115: force_register - if is true call registerurl so the remote is
8116: informed
1.415 albertel 8117: redirect -> array ref of
8118: 1- seconds before redirect occurs
8119: 2- url to redirect to
8120: 3- whether the side effect should occur
1.315 albertel 8121: (side effect of setting
8122: $env{'internal.head.redirect'} to the url
8123: redirected too)
1.352 albertel 8124: domain -> force to color decorate a page for a specific
8125: domain
8126: function -> force usage of a specific rolish color scheme
8127: bgcolor -> override the default page bgcolor
1.460 albertel 8128: no_auto_mt_title
8129: -> prevent &mt()ing the title arg
1.464 albertel 8130:
1.306 albertel 8131: =cut
8132:
8133: sub headtag {
1.313 albertel 8134: my ($title,$head_extra,$args) = @_;
1.306 albertel 8135:
1.363 albertel 8136: my $function = $args->{'function'} || &get_users_function();
8137: my $domain = $args->{'domain'} || &determinedomain();
8138: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8139: my $httphost = $args->{'use_absolute'};
1.418 albertel 8140: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8141: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8142: #time(),
1.418 albertel 8143: $env{'environment.color.timestamp'},
1.363 albertel 8144: $function,$domain,$bgcolor);
8145:
1.369 www 8146: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8147:
1.308 albertel 8148: my $result =
8149: '<head>'.
1.1160 raeburn 8150: &font_settings($args);
1.319 albertel 8151:
1.1188 raeburn 8152: my $inhibitprint;
8153: if ($args->{'print_suppress'}) {
8154: $inhibitprint = &print_suppression();
8155: }
1.1064 raeburn 8156:
1.461 albertel 8157: if (!$args->{'frameset'}) {
8158: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8159: }
1.962 droeschl 8160: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8161: $result .= Apache::lonxml::display_title();
1.319 albertel 8162: }
1.436 albertel 8163: if (!$args->{'no_nav_bar'}
8164: && !$args->{'only_body'}
8165: && !$args->{'frameset'}) {
1.1154 raeburn 8166: $result .= &help_menu_js($httphost);
1.1032 www 8167: $result.=&modal_window();
1.1038 www 8168: $result.=&togglebox_script();
1.1034 www 8169: $result.=&wishlist_window();
1.1041 www 8170: $result.=&LCprogressbarUpdate_script();
1.1034 www 8171: } else {
8172: if ($args->{'add_modal'}) {
8173: $result.=&modal_window();
8174: }
8175: if ($args->{'add_wishlist'}) {
8176: $result.=&wishlist_window();
8177: }
1.1038 www 8178: if ($args->{'add_togglebox'}) {
8179: $result.=&togglebox_script();
8180: }
1.1041 www 8181: if ($args->{'add_progressbar'}) {
8182: $result.=&LCprogressbarUpdate_script();
8183: }
1.436 albertel 8184: }
1.314 albertel 8185: if (ref($args->{'redirect'})) {
1.414 albertel 8186: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8187: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8188: if (!$inhibit_continue) {
8189: $env{'internal.head.redirect'} = $url;
8190: }
1.313 albertel 8191: $result.=<<ADDMETA
8192: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8193: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8194: ADDMETA
1.1210 raeburn 8195: } else {
8196: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8197: my $requrl = $env{'request.uri'};
8198: if ($requrl eq '') {
8199: $requrl = $ENV{'REQUEST_URI'};
8200: $requrl =~ s/\?.+$//;
8201: }
8202: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8203: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8204: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8205: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8206: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8207: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
8208: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8209: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8210: if ($domdefs{'offloadnow'}{$lonhost}) {
8211: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8212: if (($newserver) && ($newserver ne $lonhost)) {
8213: my $numsec = 5;
8214: my $timeout = $numsec * 1000;
8215: my ($newurl,$locknum,%locks,$msg);
8216: if ($env{'request.role.adv'}) {
8217: ($locknum,%locks) = &Apache::lonnet::get_locks();
8218: }
8219: my $disable_submit = 0;
8220: if ($requrl =~ /$LONCAPA::assess_re/) {
8221: $disable_submit = 1;
8222: }
8223: if ($locknum) {
8224: my @lockinfo = sort(values(%locks));
8225: $msg = &mt('Once the following tasks are complete: ')."\\n".
8226: join(", ",sort(values(%locks)))."\\n".
8227: &mt('your session will be transferred to a different server, after you click "Roles".');
8228: } else {
8229: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8230: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
8231: }
8232: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8233: $newurl = '/adm/switchserver?otherserver='.$newserver;
8234: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8235: $newurl .= '&role='.$env{'request.role'};
8236: }
8237: if ($env{'request.symb'}) {
8238: $newurl .= '&symb='.$env{'request.symb'};
8239: } else {
8240: $newurl .= '&origurl='.$requrl;
8241: }
8242: }
1.1222 damieng 8243: &js_escape(\$msg);
1.1210 raeburn 8244: $result.=<<OFFLOAD
8245: <meta http-equiv="pragma" content="no-cache" />
8246: <script type="text/javascript">
1.1215 raeburn 8247: // <![CDATA[
1.1210 raeburn 8248: function LC_Offload_Now() {
8249: var dest = "$newurl";
8250: if (dest != '') {
8251: window.location.href="$newurl";
8252: }
8253: }
1.1214 raeburn 8254: \$(document).ready(function () {
8255: window.alert('$msg');
8256: if ($disable_submit) {
1.1210 raeburn 8257: \$(".LC_hwk_submit").prop("disabled", true);
8258: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8259: }
8260: setTimeout('LC_Offload_Now()', $timeout);
8261: });
1.1215 raeburn 8262: // ]]>
1.1210 raeburn 8263: </script>
8264: OFFLOAD
8265: }
8266: }
8267: }
8268: }
8269: }
8270: }
1.313 albertel 8271: }
1.306 albertel 8272: if (!defined($title)) {
8273: $title = 'The LearningOnline Network with CAPA';
8274: }
1.460 albertel 8275: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8276: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8277: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8278: if (!$args->{'frameset'}) {
8279: $result .= ' /';
8280: }
8281: $result .= '>'
1.1064 raeburn 8282: .$inhibitprint
1.414 albertel 8283: .$head_extra;
1.1242 raeburn 8284: my $clientmobile;
8285: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8286: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8287: } else {
8288: $clientmobile = $env{'browser.mobile'};
8289: }
8290: if ($clientmobile) {
1.1137 raeburn 8291: $result .= '
8292: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8293: <meta name="apple-mobile-web-app-capable" content="yes" />';
8294: }
1.962 droeschl 8295: return $result.'</head>';
1.306 albertel 8296: }
8297:
8298: =pod
8299:
1.340 albertel 8300: =item * &font_settings()
8301:
8302: Returns neccessary <meta> to set the proper encoding
8303:
1.1160 raeburn 8304: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8305:
8306: =cut
8307:
8308: sub font_settings {
1.1160 raeburn 8309: my ($args) = @_;
1.340 albertel 8310: my $headerstring='';
1.1160 raeburn 8311: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8312: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8313: $headerstring.=
8314: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8315: if (!$args->{'frameset'}) {
8316: $headerstring.= ' /';
8317: }
8318: $headerstring .= '>'."\n";
1.340 albertel 8319: }
8320: return $headerstring;
8321: }
8322:
1.341 albertel 8323: =pod
8324:
1.1064 raeburn 8325: =item * &print_suppression()
8326:
8327: In course context returns css which causes the body to be blank when media="print",
8328: if printout generation is unavailable for the current resource.
8329:
8330: This could be because:
8331:
8332: (a) printstartdate is in the future
8333:
8334: (b) printenddate is in the past
8335:
8336: (c) there is an active exam block with "printout"
8337: functionality blocked
8338:
8339: Users with pav, pfo or evb privileges are exempt.
8340:
8341: Inputs: none
8342:
8343: =cut
8344:
8345:
8346: sub print_suppression {
8347: my $noprint;
8348: if ($env{'request.course.id'}) {
8349: my $scope = $env{'request.course.id'};
8350: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8351: (&Apache::lonnet::allowed('pfo',$scope))) {
8352: return;
8353: }
8354: if ($env{'request.course.sec'} ne '') {
8355: $scope .= "/$env{'request.course.sec'}";
8356: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8357: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8358: return;
1.1064 raeburn 8359: }
8360: }
8361: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8362: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8363: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8364: if ($blocked) {
8365: my $checkrole = "cm./$cdom/$cnum";
8366: if ($env{'request.course.sec'} ne '') {
8367: $checkrole .= "/$env{'request.course.sec'}";
8368: }
8369: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8370: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8371: $noprint = 1;
8372: }
8373: }
8374: unless ($noprint) {
8375: my $symb = &Apache::lonnet::symbread();
8376: if ($symb ne '') {
8377: my $navmap = Apache::lonnavmaps::navmap->new();
8378: if (ref($navmap)) {
8379: my $res = $navmap->getBySymb($symb);
8380: if (ref($res)) {
8381: if (!$res->resprintable()) {
8382: $noprint = 1;
8383: }
8384: }
8385: }
8386: }
8387: }
8388: if ($noprint) {
8389: return <<"ENDSTYLE";
8390: <style type="text/css" media="print">
8391: body { display:none }
8392: </style>
8393: ENDSTYLE
8394: }
8395: }
8396: return;
8397: }
8398:
8399: =pod
8400:
1.341 albertel 8401: =item * &xml_begin()
8402:
8403: Returns the needed doctype and <html>
8404:
8405: Inputs: none
8406:
8407: =cut
8408:
8409: sub xml_begin {
1.1168 raeburn 8410: my ($is_frameset) = @_;
1.341 albertel 8411: my $output='';
8412:
8413: if ($env{'browser.mathml'}) {
8414: $output='<?xml version="1.0"?>'
8415: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8416: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8417:
8418: # .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
8419: .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
8420: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8421: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8422: } elsif ($is_frameset) {
8423: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8424: '<html>'."\n";
1.341 albertel 8425: } else {
1.1168 raeburn 8426: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8427: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8428: }
8429: return $output;
8430: }
1.340 albertel 8431:
8432: =pod
8433:
1.306 albertel 8434: =item * &start_page()
8435:
8436: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8437:
1.648 raeburn 8438: Inputs:
8439:
8440: =over 4
8441:
8442: $title - optional title for the page
8443:
8444: $head_extra - optional extra HTML to incude inside the <head>
8445:
8446: $args - additional optional args supported are:
8447:
8448: =over 8
8449:
8450: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8451: arg on
1.814 bisitz 8452: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8453: add_entries -> additional attributes to add to the <body>
8454: domain -> force to color decorate a page for a
1.317 albertel 8455: specific domain
1.648 raeburn 8456: function -> force usage of a specific rolish color
1.317 albertel 8457: scheme
1.648 raeburn 8458: redirect -> see &headtag()
8459: bgcolor -> override the default page bg color
8460: js_ready -> return a string ready for being used in
1.317 albertel 8461: a javascript writeln
1.648 raeburn 8462: html_encode -> return a string ready for being used in
1.320 albertel 8463: a html attribute
1.648 raeburn 8464: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8465: $forcereg arg
1.648 raeburn 8466: frameset -> if true will start with a <frameset>
1.330 albertel 8467: rather than <body>
1.648 raeburn 8468: skip_phases -> hash ref of
1.338 albertel 8469: head -> skip the <html><head> generation
8470: body -> skip all <body> generation
1.648 raeburn 8471: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8472: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8473: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 8474: group -> includes the current group, if page is for a
8475: specific group
1.361 albertel 8476:
1.648 raeburn 8477: =back
1.460 albertel 8478:
1.648 raeburn 8479: =back
1.562 albertel 8480:
1.306 albertel 8481: =cut
8482:
8483: sub start_page {
1.309 albertel 8484: my ($title,$head_extra,$args) = @_;
1.318 albertel 8485: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8486:
1.315 albertel 8487: $env{'internal.start_page'}++;
1.1096 raeburn 8488: my ($result,@advtools);
1.964 droeschl 8489:
1.338 albertel 8490: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8491: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8492: }
8493:
8494: if (! exists($args->{'skip_phases'}{'body'}) ) {
8495: if ($args->{'frameset'}) {
8496: my $attr_string = &make_attr_string($args->{'force_register'},
8497: $args->{'add_entries'});
8498: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8499: } else {
8500: $result .=
8501: &bodytag($title,
8502: $args->{'function'}, $args->{'add_entries'},
8503: $args->{'only_body'}, $args->{'domain'},
8504: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8505: $args->{'bgcolor'}, $args,
8506: \@advtools);
1.831 bisitz 8507: }
1.330 albertel 8508: }
1.338 albertel 8509:
1.315 albertel 8510: if ($args->{'js_ready'}) {
1.713 kaisler 8511: $result = &js_ready($result);
1.315 albertel 8512: }
1.320 albertel 8513: if ($args->{'html_encode'}) {
1.713 kaisler 8514: $result = &html_encode($result);
8515: }
8516:
1.813 bisitz 8517: # Preparation for new and consistent functionlist at top of screen
8518: # if ($args->{'functionlist'}) {
8519: # $result .= &build_functionlist();
8520: #}
8521:
1.964 droeschl 8522: # Don't add anything more if only_body wanted or in const space
8523: return $result if $args->{'only_body'}
8524: || $env{'request.state'} eq 'construct';
1.813 bisitz 8525:
8526: #Breadcrumbs
1.758 kaisler 8527: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8528: &Apache::lonhtmlcommon::clear_breadcrumbs();
8529: #if any br links exists, add them to the breadcrumbs
8530: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8531: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8532: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8533: }
8534: }
1.1096 raeburn 8535: # if @advtools array contains items add then to the breadcrumbs
8536: if (@advtools > 0) {
8537: &Apache::lonmenu::advtools_crumbs(@advtools);
8538: }
1.758 kaisler 8539:
8540: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8541: if(exists($args->{'bread_crumbs_component'})){
8542: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
1.1237 raeburn 8543: } elsif ($args->{'crstype'} eq 'Placement') {
8544: $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
8545: $args->{'crstype'});
8546: } else {
1.758 kaisler 8547: $result .= &Apache::lonhtmlcommon::breadcrumbs();
8548: }
1.320 albertel 8549: }
1.315 albertel 8550: return $result;
1.306 albertel 8551: }
8552:
8553: sub end_page {
1.315 albertel 8554: my ($args) = @_;
8555: $env{'internal.end_page'}++;
1.330 albertel 8556: my $result;
1.335 albertel 8557: if ($args->{'discussion'}) {
8558: my ($target,$parser);
8559: if (ref($args->{'discussion'})) {
8560: ($target,$parser) =($args->{'discussion'}{'target'},
8561: $args->{'discussion'}{'parser'});
8562: }
8563: $result .= &Apache::lonxml::xmlend($target,$parser);
8564: }
1.330 albertel 8565: if ($args->{'frameset'}) {
8566: $result .= '</frameset>';
8567: } else {
1.635 raeburn 8568: $result .= &endbodytag($args);
1.330 albertel 8569: }
1.1080 raeburn 8570: unless ($args->{'notbody'}) {
8571: $result .= "\n</html>";
8572: }
1.330 albertel 8573:
1.315 albertel 8574: if ($args->{'js_ready'}) {
1.317 albertel 8575: $result = &js_ready($result);
1.315 albertel 8576: }
1.335 albertel 8577:
1.320 albertel 8578: if ($args->{'html_encode'}) {
8579: $result = &html_encode($result);
8580: }
1.335 albertel 8581:
1.315 albertel 8582: return $result;
8583: }
8584:
1.1034 www 8585: sub wishlist_window {
8586: return(<<'ENDWISHLIST');
1.1046 raeburn 8587: <script type="text/javascript">
1.1034 www 8588: // <![CDATA[
8589: // <!-- BEGIN LON-CAPA Internal
8590: function set_wishlistlink(title, path) {
8591: if (!title) {
8592: title = document.title;
8593: title = title.replace(/^LON-CAPA /,'');
8594: }
1.1175 raeburn 8595: title = encodeURIComponent(title);
1.1203 raeburn 8596: title = title.replace("'","\\\'");
1.1034 www 8597: if (!path) {
8598: path = location.pathname;
8599: }
1.1175 raeburn 8600: path = encodeURIComponent(path);
1.1203 raeburn 8601: path = path.replace("'","\\\'");
1.1034 www 8602: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8603: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8604: }
8605: // END LON-CAPA Internal -->
8606: // ]]>
8607: </script>
8608: ENDWISHLIST
8609: }
8610:
1.1030 www 8611: sub modal_window {
8612: return(<<'ENDMODAL');
1.1046 raeburn 8613: <script type="text/javascript">
1.1030 www 8614: // <![CDATA[
8615: // <!-- BEGIN LON-CAPA Internal
8616: var modalWindow = {
8617: parent:"body",
8618: windowId:null,
8619: content:null,
8620: width:null,
8621: height:null,
8622: close:function()
8623: {
8624: $(".LCmodal-window").remove();
8625: $(".LCmodal-overlay").remove();
8626: },
8627: open:function()
8628: {
8629: var modal = "";
8630: modal += "<div class=\"LCmodal-overlay\"></div>";
8631: modal += "<div id=\"" + this.windowId + "\" class=\"LCmodal-window\" style=\"width:" + this.width + "px; height:" + this.height + "px; margin-top:-" + (this.height / 2) + "px; margin-left:-" + (this.width / 2) + "px;\">";
8632: modal += this.content;
8633: modal += "</div>";
8634:
8635: $(this.parent).append(modal);
8636:
8637: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8638: $(".LCclose-window").click(function(){modalWindow.close();});
8639: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8640: }
8641: };
1.1140 raeburn 8642: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8643: {
1.1203 raeburn 8644: source = source.replace("'","'");
1.1030 www 8645: modalWindow.windowId = "myModal";
8646: modalWindow.width = width;
8647: modalWindow.height = height;
1.1196 raeburn 8648: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8649: modalWindow.open();
1.1208 raeburn 8650: };
1.1030 www 8651: // END LON-CAPA Internal -->
8652: // ]]>
8653: </script>
8654: ENDMODAL
8655: }
8656:
8657: sub modal_link {
1.1140 raeburn 8658: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8659: unless ($width) { $width=480; }
8660: unless ($height) { $height=400; }
1.1031 www 8661: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 8662: unless ($transparency) { $transparency='true'; }
8663:
1.1074 raeburn 8664: my $target_attr;
8665: if (defined($target)) {
8666: $target_attr = 'target="'.$target.'"';
8667: }
8668: return <<"ENDLINK";
1.1140 raeburn 8669: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 8670: $linktext</a>
8671: ENDLINK
1.1030 www 8672: }
8673:
1.1032 www 8674: sub modal_adhoc_script {
8675: my ($funcname,$width,$height,$content)=@_;
8676: return (<<ENDADHOC);
1.1046 raeburn 8677: <script type="text/javascript">
1.1032 www 8678: // <![CDATA[
8679: var $funcname = function()
8680: {
8681: modalWindow.windowId = "myModal";
8682: modalWindow.width = $width;
8683: modalWindow.height = $height;
8684: modalWindow.content = '$content';
8685: modalWindow.open();
8686: };
8687: // ]]>
8688: </script>
8689: ENDADHOC
8690: }
8691:
1.1041 www 8692: sub modal_adhoc_inner {
8693: my ($funcname,$width,$height,$content)=@_;
8694: my $innerwidth=$width-20;
8695: $content=&js_ready(
1.1140 raeburn 8696: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
8697: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8698: $content.
1.1041 www 8699: &end_scrollbox().
1.1140 raeburn 8700: &end_page()
1.1041 www 8701: );
8702: return &modal_adhoc_script($funcname,$width,$height,$content);
8703: }
8704:
8705: sub modal_adhoc_window {
8706: my ($funcname,$width,$height,$content,$linktext)=@_;
8707: return &modal_adhoc_inner($funcname,$width,$height,$content).
8708: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8709: }
8710:
8711: sub modal_adhoc_launch {
8712: my ($funcname,$width,$height,$content)=@_;
8713: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8714: <script type="text/javascript">
8715: // <![CDATA[
8716: $funcname();
8717: // ]]>
8718: </script>
8719: ENDLAUNCH
8720: }
8721:
8722: sub modal_adhoc_close {
8723: return (<<ENDCLOSE);
8724: <script type="text/javascript">
8725: // <![CDATA[
8726: modalWindow.close();
8727: // ]]>
8728: </script>
8729: ENDCLOSE
8730: }
8731:
1.1038 www 8732: sub togglebox_script {
8733: return(<<ENDTOGGLE);
8734: <script type="text/javascript">
8735: // <![CDATA[
8736: function LCtoggleDisplay(id,hidetext,showtext) {
8737: link = document.getElementById(id + "link").childNodes[0];
8738: with (document.getElementById(id).style) {
8739: if (display == "none" ) {
8740: display = "inline";
8741: link.nodeValue = hidetext;
8742: } else {
8743: display = "none";
8744: link.nodeValue = showtext;
8745: }
8746: }
8747: }
8748: // ]]>
8749: </script>
8750: ENDTOGGLE
8751: }
8752:
1.1039 www 8753: sub start_togglebox {
8754: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8755: unless ($heading) { $heading=''; } else { $heading.=' '; }
8756: unless ($showtext) { $showtext=&mt('show'); }
8757: unless ($hidetext) { $hidetext=&mt('hide'); }
8758: unless ($headerbg) { $headerbg='#FFFFFF'; }
8759: return &start_data_table().
8760: &start_data_table_header_row().
8761: '<td bgcolor="'.$headerbg.'">'.$heading.
8762: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8763: $showtext.'\')">'.$showtext.'</a>]</td>'.
8764: &end_data_table_header_row().
8765: '<tr id="'.$id.'" style="display:none""><td>';
8766: }
8767:
8768: sub end_togglebox {
8769: return '</td></tr>'.&end_data_table();
8770: }
8771:
1.1041 www 8772: sub LCprogressbar_script {
1.1045 www 8773: my ($id)=@_;
1.1041 www 8774: return(<<ENDPROGRESS);
8775: <script type="text/javascript">
8776: // <![CDATA[
1.1045 www 8777: \$('#progressbar$id').progressbar({
1.1041 www 8778: value: 0,
8779: change: function(event, ui) {
8780: var newVal = \$(this).progressbar('option', 'value');
8781: \$('.pblabel', this).text(LCprogressTxt);
8782: }
8783: });
8784: // ]]>
8785: </script>
8786: ENDPROGRESS
8787: }
8788:
8789: sub LCprogressbarUpdate_script {
8790: return(<<ENDPROGRESSUPDATE);
8791: <style type="text/css">
8792: .ui-progressbar { position:relative; }
8793: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8794: </style>
8795: <script type="text/javascript">
8796: // <![CDATA[
1.1045 www 8797: var LCprogressTxt='---';
8798:
8799: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8800: LCprogressTxt=progresstext;
1.1045 www 8801: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8802: }
8803: // ]]>
8804: </script>
8805: ENDPROGRESSUPDATE
8806: }
8807:
1.1042 www 8808: my $LClastpercent;
1.1045 www 8809: my $LCidcnt;
8810: my $LCcurrentid;
1.1042 www 8811:
1.1041 www 8812: sub LCprogressbar {
1.1042 www 8813: my ($r)=(@_);
8814: $LClastpercent=0;
1.1045 www 8815: $LCidcnt++;
8816: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8817: my $starting=&mt('Starting');
8818: my $content=(<<ENDPROGBAR);
1.1045 www 8819: <div id="progressbar$LCcurrentid">
1.1041 www 8820: <span class="pblabel">$starting</span>
8821: </div>
8822: ENDPROGBAR
1.1045 www 8823: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8824: }
8825:
8826: sub LCprogressbarUpdate {
1.1042 www 8827: my ($r,$val,$text)=@_;
8828: unless ($val) {
8829: if ($LClastpercent) {
8830: $val=$LClastpercent;
8831: } else {
8832: $val=0;
8833: }
8834: }
1.1041 www 8835: if ($val<0) { $val=0; }
8836: if ($val>100) { $val=0; }
1.1042 www 8837: $LClastpercent=$val;
1.1041 www 8838: unless ($text) { $text=$val.'%'; }
8839: $text=&js_ready($text);
1.1044 www 8840: &r_print($r,<<ENDUPDATE);
1.1041 www 8841: <script type="text/javascript">
8842: // <![CDATA[
1.1045 www 8843: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8844: // ]]>
8845: </script>
8846: ENDUPDATE
1.1035 www 8847: }
8848:
1.1042 www 8849: sub LCprogressbarClose {
8850: my ($r)=@_;
8851: $LClastpercent=0;
1.1044 www 8852: &r_print($r,<<ENDCLOSE);
1.1042 www 8853: <script type="text/javascript">
8854: // <![CDATA[
1.1045 www 8855: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8856: // ]]>
8857: </script>
8858: ENDCLOSE
1.1044 www 8859: }
8860:
8861: sub r_print {
8862: my ($r,$to_print)=@_;
8863: if ($r) {
8864: $r->print($to_print);
8865: $r->rflush();
8866: } else {
8867: print($to_print);
8868: }
1.1042 www 8869: }
8870:
1.320 albertel 8871: sub html_encode {
8872: my ($result) = @_;
8873:
1.322 albertel 8874: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8875:
8876: return $result;
8877: }
1.1044 www 8878:
1.317 albertel 8879: sub js_ready {
8880: my ($result) = @_;
8881:
1.323 albertel 8882: $result =~ s/[\n\r]/ /xmsg;
8883: $result =~ s/\\/\\\\/xmsg;
8884: $result =~ s/'/\\'/xmsg;
1.372 albertel 8885: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8886:
8887: return $result;
8888: }
8889:
1.315 albertel 8890: sub validate_page {
8891: if ( exists($env{'internal.start_page'})
1.316 albertel 8892: && $env{'internal.start_page'} > 1) {
8893: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8894: $env{'internal.start_page'}.' '.
1.316 albertel 8895: $ENV{'request.filename'});
1.315 albertel 8896: }
8897: if ( exists($env{'internal.end_page'})
1.316 albertel 8898: && $env{'internal.end_page'} > 1) {
8899: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8900: $env{'internal.end_page'}.' '.
1.316 albertel 8901: $env{'request.filename'});
1.315 albertel 8902: }
8903: if ( exists($env{'internal.start_page'})
8904: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8905: &Apache::lonnet::logthis('start_page called without end_page '.
8906: $env{'request.filename'});
1.315 albertel 8907: }
8908: if ( ! exists($env{'internal.start_page'})
8909: && exists($env{'internal.end_page'})) {
1.316 albertel 8910: &Apache::lonnet::logthis('end_page called without start_page'.
8911: $env{'request.filename'});
1.315 albertel 8912: }
1.306 albertel 8913: }
1.315 albertel 8914:
1.996 www 8915:
8916: sub start_scrollbox {
1.1140 raeburn 8917: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8918: unless ($outerwidth) { $outerwidth='520px'; }
8919: unless ($width) { $width='500px'; }
8920: unless ($height) { $height='200px'; }
1.1075 raeburn 8921: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8922: if ($id ne '') {
1.1140 raeburn 8923: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8924: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8925: }
1.1075 raeburn 8926: if ($bgcolor ne '') {
8927: $tdcol = "background-color: $bgcolor;";
8928: }
1.1137 raeburn 8929: my $nicescroll_js;
8930: if ($env{'browser.mobile'}) {
1.1140 raeburn 8931: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8932: }
8933: return <<"END";
8934: $nicescroll_js
8935:
8936: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8937: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8938: END
8939: }
8940:
8941: sub end_scrollbox {
8942: return '</div></td></tr></table>';
8943: }
8944:
8945: sub nicescroll_javascript {
8946: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8947: my %options;
8948: if (ref($cursor) eq 'HASH') {
8949: %options = %{$cursor};
8950: }
8951: unless ($options{'railalign'} =~ /^left|right$/) {
8952: $options{'railalign'} = 'left';
8953: }
8954: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8955: my $function = &get_users_function();
8956: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8957: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8958: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8959: }
1.1140 raeburn 8960: }
8961: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8962: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8963: $options{'cursoropacity'}='1.0';
8964: }
1.1140 raeburn 8965: } else {
8966: $options{'cursoropacity'}='1.0';
8967: }
8968: if ($options{'cursorfixedheight'} eq 'none') {
8969: delete($options{'cursorfixedheight'});
8970: } else {
8971: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8972: }
8973: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8974: delete($options{'railoffset'});
8975: }
8976: my @niceoptions;
8977: while (my($key,$value) = each(%options)) {
8978: if ($value =~ /^\{.+\}$/) {
8979: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8980: } else {
1.1140 raeburn 8981: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8982: }
1.1140 raeburn 8983: }
8984: my $nicescroll_js = '
1.1137 raeburn 8985: $(document).ready(
1.1140 raeburn 8986: function() {
8987: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8988: }
1.1137 raeburn 8989: );
8990: ';
1.1140 raeburn 8991: if ($framecheck) {
8992: $nicescroll_js .= '
8993: function expand_div(caller) {
8994: if (top === self) {
8995: document.getElementById("'.$id.'").style.width = "auto";
8996: document.getElementById("'.$id.'").style.height = "auto";
8997: } else {
8998: try {
8999: if (parent.frames) {
9000: if (parent.frames.length > 1) {
9001: var framesrc = parent.frames[1].location.href;
9002: var currsrc = framesrc.replace(/\#.*$/,"");
9003: if ((caller == "search") || (currsrc == "'.$location.'")) {
9004: document.getElementById("'.$id.'").style.width = "auto";
9005: document.getElementById("'.$id.'").style.height = "auto";
9006: }
9007: }
9008: }
9009: } catch (e) {
9010: return;
9011: }
1.1137 raeburn 9012: }
1.1140 raeburn 9013: return;
1.996 www 9014: }
1.1140 raeburn 9015: ';
9016: }
9017: if ($needjsready) {
9018: $nicescroll_js = '
9019: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9020: } else {
9021: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9022: }
9023: return $nicescroll_js;
1.996 www 9024: }
9025:
1.318 albertel 9026: sub simple_error_page {
1.1150 bisitz 9027: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 9028: if (ref($args) eq 'HASH') {
9029: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
9030: } else {
9031: $msg = &mt($msg);
9032: }
1.1150 bisitz 9033:
1.318 albertel 9034: my $page =
9035: &Apache::loncommon::start_page($title).
1.1150 bisitz 9036: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9037: &Apache::loncommon::end_page();
9038: if (ref($r)) {
9039: $r->print($page);
1.327 albertel 9040: return;
1.318 albertel 9041: }
9042: return $page;
9043: }
1.347 albertel 9044:
9045: {
1.610 albertel 9046: my @row_count;
1.961 onken 9047:
9048: sub start_data_table_count {
9049: unshift(@row_count, 0);
9050: return;
9051: }
9052:
9053: sub end_data_table_count {
9054: shift(@row_count);
9055: return;
9056: }
9057:
1.347 albertel 9058: sub start_data_table {
1.1018 raeburn 9059: my ($add_class,$id) = @_;
1.422 albertel 9060: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9061: my $table_id;
9062: if (defined($id)) {
9063: $table_id = ' id="'.$id.'"';
9064: }
1.961 onken 9065: &start_data_table_count();
1.1018 raeburn 9066: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9067: }
9068:
9069: sub end_data_table {
1.961 onken 9070: &end_data_table_count();
1.389 albertel 9071: return '</table>'."\n";;
1.347 albertel 9072: }
9073:
9074: sub start_data_table_row {
1.974 wenzelju 9075: my ($add_class, $id) = @_;
1.610 albertel 9076: $row_count[0]++;
9077: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9078: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9079: $id = (' id="'.$id.'"') unless ($id eq '');
9080: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9081: }
1.471 banghart 9082:
9083: sub continue_data_table_row {
1.974 wenzelju 9084: my ($add_class, $id) = @_;
1.610 albertel 9085: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9086: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9087: $id = (' id="'.$id.'"') unless ($id eq '');
9088: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9089: }
1.347 albertel 9090:
9091: sub end_data_table_row {
1.389 albertel 9092: return '</tr>'."\n";;
1.347 albertel 9093: }
1.367 www 9094:
1.421 albertel 9095: sub start_data_table_empty_row {
1.707 bisitz 9096: # $row_count[0]++;
1.421 albertel 9097: return '<tr class="LC_empty_row" >'."\n";;
9098: }
9099:
9100: sub end_data_table_empty_row {
9101: return '</tr>'."\n";;
9102: }
9103:
1.367 www 9104: sub start_data_table_header_row {
1.389 albertel 9105: return '<tr class="LC_header_row">'."\n";;
1.367 www 9106: }
9107:
9108: sub end_data_table_header_row {
1.389 albertel 9109: return '</tr>'."\n";;
1.367 www 9110: }
1.890 droeschl 9111:
9112: sub data_table_caption {
9113: my $caption = shift;
9114: return "<caption class=\"LC_caption\">$caption</caption>";
9115: }
1.347 albertel 9116: }
9117:
1.548 albertel 9118: =pod
9119:
9120: =item * &inhibit_menu_check($arg)
9121:
9122: Checks for a inhibitmenu state and generates output to preserve it
9123:
9124: Inputs: $arg - can be any of
9125: - undef - in which case the return value is a string
9126: to add into arguments list of a uri
9127: - 'input' - in which case the return value is a HTML
9128: <form> <input> field of type hidden to
9129: preserve the value
9130: - a url - in which case the return value is the url with
9131: the neccesary cgi args added to preserve the
9132: inhibitmenu state
9133: - a ref to a url - no return value, but the string is
9134: updated to include the neccessary cgi
9135: args to preserve the inhibitmenu state
9136:
9137: =cut
9138:
9139: sub inhibit_menu_check {
9140: my ($arg) = @_;
9141: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9142: if ($arg eq 'input') {
9143: if ($env{'form.inhibitmenu'}) {
9144: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9145: } else {
9146: return
9147: }
9148: }
9149: if ($env{'form.inhibitmenu'}) {
9150: if (ref($arg)) {
9151: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9152: } elsif ($arg eq '') {
9153: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9154: } else {
9155: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9156: }
9157: }
9158: if (!ref($arg)) {
9159: return $arg;
9160: }
9161: }
9162:
1.251 albertel 9163: ###############################################
1.182 matthew 9164:
9165: =pod
9166:
1.549 albertel 9167: =back
9168:
9169: =head1 User Information Routines
9170:
9171: =over 4
9172:
1.405 albertel 9173: =item * &get_users_function()
1.182 matthew 9174:
9175: Used by &bodytag to determine the current users primary role.
9176: Returns either 'student','coordinator','admin', or 'author'.
9177:
9178: =cut
9179:
9180: ###############################################
9181: sub get_users_function {
1.815 tempelho 9182: my $function = 'norole';
1.818 tempelho 9183: if ($env{'request.role'}=~/^(st)/) {
9184: $function='student';
9185: }
1.907 raeburn 9186: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9187: $function='coordinator';
9188: }
1.258 albertel 9189: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9190: $function='admin';
9191: }
1.826 bisitz 9192: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9193: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9194: $function='author';
9195: }
9196: return $function;
1.54 www 9197: }
1.99 www 9198:
9199: ###############################################
9200:
1.233 raeburn 9201: =pod
9202:
1.821 raeburn 9203: =item * &show_course()
9204:
9205: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9206: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9207:
9208: Inputs:
9209: None
9210:
9211: Outputs:
9212: Scalar: 1 if 'Course' to be used, 0 otherwise.
9213:
9214: =cut
9215:
9216: ###############################################
9217: sub show_course {
9218: my $course = !$env{'user.adv'};
9219: if (!$env{'user.adv'}) {
9220: foreach my $env (keys(%env)) {
9221: next if ($env !~ m/^user\.priv\./);
9222: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9223: $course = 0;
9224: last;
9225: }
9226: }
9227: }
9228: return $course;
9229: }
9230:
9231: ###############################################
9232:
9233: =pod
9234:
1.542 raeburn 9235: =item * &check_user_status()
1.274 raeburn 9236:
9237: Determines current status of supplied role for a
9238: specific user. Roles can be active, previous or future.
9239:
9240: Inputs:
9241: user's domain, user's username, course's domain,
1.375 raeburn 9242: course's number, optional section ID.
1.274 raeburn 9243:
9244: Outputs:
9245: role status: active, previous or future.
9246:
9247: =cut
9248:
9249: sub check_user_status {
1.412 raeburn 9250: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9251: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9252: my @uroles = keys(%userinfo);
1.274 raeburn 9253: my $srchstr;
9254: my $active_chk = 'none';
1.412 raeburn 9255: my $now = time;
1.274 raeburn 9256: if (@uroles > 0) {
1.908 raeburn 9257: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9258: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9259: } else {
1.412 raeburn 9260: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9261: }
9262: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9263: my $role_end = 0;
9264: my $role_start = 0;
9265: $active_chk = 'active';
1.412 raeburn 9266: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9267: $role_end = $1;
9268: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9269: $role_start = $1;
1.274 raeburn 9270: }
9271: }
9272: if ($role_start > 0) {
1.412 raeburn 9273: if ($now < $role_start) {
1.274 raeburn 9274: $active_chk = 'future';
9275: }
9276: }
9277: if ($role_end > 0) {
1.412 raeburn 9278: if ($now > $role_end) {
1.274 raeburn 9279: $active_chk = 'previous';
9280: }
9281: }
9282: }
9283: }
9284: return $active_chk;
9285: }
9286:
9287: ###############################################
9288:
9289: =pod
9290:
1.405 albertel 9291: =item * &get_sections()
1.233 raeburn 9292:
9293: Determines all the sections for a course including
9294: sections with students and sections containing other roles.
1.419 raeburn 9295: Incoming parameters:
9296:
9297: 1. domain
9298: 2. course number
9299: 3. reference to array containing roles for which sections should
9300: be gathered (optional).
9301: 4. reference to array containing status types for which sections
9302: should be gathered (optional).
9303:
9304: If the third argument is undefined, sections are gathered for any role.
9305: If the fourth argument is undefined, sections are gathered for any status.
9306: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9307:
1.374 raeburn 9308: Returns section hash (keys are section IDs, values are
9309: number of users in each section), subject to the
1.419 raeburn 9310: optional roles filter, optional status filter
1.233 raeburn 9311:
9312: =cut
9313:
9314: ###############################################
9315: sub get_sections {
1.419 raeburn 9316: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9317: if (!defined($cdom) || !defined($cnum)) {
9318: my $cid = $env{'request.course.id'};
9319:
9320: return if (!defined($cid));
9321:
9322: $cdom = $env{'course.'.$cid.'.domain'};
9323: $cnum = $env{'course.'.$cid.'.num'};
9324: }
9325:
9326: my %sectioncount;
1.419 raeburn 9327: my $now = time;
1.240 albertel 9328:
1.1118 raeburn 9329: my $check_students = 1;
9330: my $only_students = 0;
9331: if (ref($possible_roles) eq 'ARRAY') {
9332: if (grep(/^st$/,@{$possible_roles})) {
9333: if (@{$possible_roles} == 1) {
9334: $only_students = 1;
9335: }
9336: } else {
9337: $check_students = 0;
9338: }
9339: }
9340:
9341: if ($check_students) {
1.276 albertel 9342: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9343: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9344: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9345: my $start_index = &Apache::loncoursedata::CL_START();
9346: my $end_index = &Apache::loncoursedata::CL_END();
9347: my $status;
1.366 albertel 9348: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9349: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9350: $data->[$status_index],
9351: $data->[$start_index],
9352: $data->[$end_index]);
9353: if ($stu_status eq 'Active') {
9354: $status = 'active';
9355: } elsif ($end < $now) {
9356: $status = 'previous';
9357: } elsif ($start > $now) {
9358: $status = 'future';
9359: }
9360: if ($section ne '-1' && $section !~ /^\s*$/) {
9361: if ((!defined($possible_status)) || (($status ne '') &&
9362: (grep/^\Q$status\E$/,@{$possible_status}))) {
9363: $sectioncount{$section}++;
9364: }
1.240 albertel 9365: }
9366: }
9367: }
1.1118 raeburn 9368: if ($only_students) {
9369: return %sectioncount;
9370: }
1.240 albertel 9371: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9372: foreach my $user (sort(keys(%courseroles))) {
9373: if ($user !~ /^(\w{2})/) { next; }
9374: my ($role) = ($user =~ /^(\w{2})/);
9375: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9376: my ($section,$status);
1.240 albertel 9377: if ($role eq 'cr' &&
9378: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9379: $section=$1;
9380: }
9381: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9382: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9383: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9384: if ($end == -1 && $start == -1) {
9385: next; #deleted role
9386: }
9387: if (!defined($possible_status)) {
9388: $sectioncount{$section}++;
9389: } else {
9390: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9391: $status = 'active';
9392: } elsif ($end < $now) {
9393: $status = 'future';
9394: } elsif ($start > $now) {
9395: $status = 'previous';
9396: }
9397: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9398: $sectioncount{$section}++;
9399: }
9400: }
1.233 raeburn 9401: }
1.366 albertel 9402: return %sectioncount;
1.233 raeburn 9403: }
9404:
1.274 raeburn 9405: ###############################################
1.294 raeburn 9406:
9407: =pod
1.405 albertel 9408:
9409: =item * &get_course_users()
9410:
1.275 raeburn 9411: Retrieves usernames:domains for users in the specified course
9412: with specific role(s), and access status.
9413:
9414: Incoming parameters:
1.277 albertel 9415: 1. course domain
9416: 2. course number
9417: 3. access status: users must have - either active,
1.275 raeburn 9418: previous, future, or all.
1.277 albertel 9419: 4. reference to array of permissible roles
1.288 raeburn 9420: 5. reference to array of section restrictions (optional)
9421: 6. reference to results object (hash of hashes).
9422: 7. reference to optional userdata hash
1.609 raeburn 9423: 8. reference to optional statushash
1.630 raeburn 9424: 9. flag if privileged users (except those set to unhide in
9425: course settings) should be excluded
1.609 raeburn 9426: Keys of top level results hash are roles.
1.275 raeburn 9427: Keys of inner hashes are username:domain, with
9428: values set to access type.
1.288 raeburn 9429: Optional userdata hash returns an array with arguments in the
9430: same order as loncoursedata::get_classlist() for student data.
9431:
1.609 raeburn 9432: Optional statushash returns
9433:
1.288 raeburn 9434: Entries for end, start, section and status are blank because
9435: of the possibility of multiple values for non-student roles.
9436:
1.275 raeburn 9437: =cut
1.405 albertel 9438:
1.275 raeburn 9439: ###############################################
1.405 albertel 9440:
1.275 raeburn 9441: sub get_course_users {
1.630 raeburn 9442: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9443: my %idx = ();
1.419 raeburn 9444: my %seclists;
1.288 raeburn 9445:
9446: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9447: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9448: $idx{end} = &Apache::loncoursedata::CL_END();
9449: $idx{start} = &Apache::loncoursedata::CL_START();
9450: $idx{id} = &Apache::loncoursedata::CL_ID();
9451: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9452: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9453: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9454:
1.290 albertel 9455: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9456: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9457: my $now = time;
1.277 albertel 9458: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9459: my $match = 0;
1.412 raeburn 9460: my $secmatch = 0;
1.419 raeburn 9461: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9462: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9463: if ($section eq '') {
9464: $section = 'none';
9465: }
1.291 albertel 9466: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9467: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9468: $secmatch = 1;
9469: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9470: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9471: $secmatch = 1;
9472: }
9473: } else {
1.419 raeburn 9474: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9475: $secmatch = 1;
9476: }
1.290 albertel 9477: }
1.412 raeburn 9478: if (!$secmatch) {
9479: next;
9480: }
1.419 raeburn 9481: }
1.275 raeburn 9482: if (defined($$types{'active'})) {
1.288 raeburn 9483: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9484: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9485: $match = 1;
1.275 raeburn 9486: }
9487: }
9488: if (defined($$types{'previous'})) {
1.609 raeburn 9489: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9490: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9491: $match = 1;
1.275 raeburn 9492: }
9493: }
9494: if (defined($$types{'future'})) {
1.609 raeburn 9495: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9496: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9497: $match = 1;
1.275 raeburn 9498: }
9499: }
1.609 raeburn 9500: if ($match) {
9501: push(@{$seclists{$student}},$section);
9502: if (ref($userdata) eq 'HASH') {
9503: $$userdata{$student} = $$classlist{$student};
9504: }
9505: if (ref($statushash) eq 'HASH') {
9506: $statushash->{$student}{'st'}{$section} = $status;
9507: }
1.288 raeburn 9508: }
1.275 raeburn 9509: }
9510: }
1.412 raeburn 9511: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9512: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9513: my $now = time;
1.609 raeburn 9514: my %displaystatus = ( previous => 'Expired',
9515: active => 'Active',
9516: future => 'Future',
9517: );
1.1121 raeburn 9518: my (%nothide,@possdoms);
1.630 raeburn 9519: if ($hidepriv) {
9520: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9521: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9522: if ($user !~ /:/) {
9523: $nothide{join(':',split(/[\@]/,$user))}=1;
9524: } else {
9525: $nothide{$user} = 1;
9526: }
9527: }
1.1121 raeburn 9528: my @possdoms = ($cdom);
9529: if ($coursehash{'checkforpriv'}) {
9530: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9531: }
1.630 raeburn 9532: }
1.439 raeburn 9533: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9534: my $match = 0;
1.412 raeburn 9535: my $secmatch = 0;
1.439 raeburn 9536: my $status;
1.412 raeburn 9537: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9538: $user =~ s/:$//;
1.439 raeburn 9539: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9540: if ($end == -1 || $start == -1) {
9541: next;
9542: }
9543: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9544: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9545: my ($uname,$udom) = split(/:/,$user);
9546: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9547: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9548: $secmatch = 1;
9549: } elsif ($usec eq '') {
1.420 albertel 9550: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9551: $secmatch = 1;
9552: }
9553: } else {
9554: if (grep(/^\Q$usec\E$/,@{$sections})) {
9555: $secmatch = 1;
9556: }
9557: }
9558: if (!$secmatch) {
9559: next;
9560: }
1.288 raeburn 9561: }
1.419 raeburn 9562: if ($usec eq '') {
9563: $usec = 'none';
9564: }
1.275 raeburn 9565: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9566: if ($hidepriv) {
1.1121 raeburn 9567: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9568: (!$nothide{$uname.':'.$udom})) {
9569: next;
9570: }
9571: }
1.503 raeburn 9572: if ($end > 0 && $end < $now) {
1.439 raeburn 9573: $status = 'previous';
9574: } elsif ($start > $now) {
9575: $status = 'future';
9576: } else {
9577: $status = 'active';
9578: }
1.277 albertel 9579: foreach my $type (keys(%{$types})) {
1.275 raeburn 9580: if ($status eq $type) {
1.420 albertel 9581: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9582: push(@{$$users{$role}{$user}},$type);
9583: }
1.288 raeburn 9584: $match = 1;
9585: }
9586: }
1.419 raeburn 9587: if (($match) && (ref($userdata) eq 'HASH')) {
9588: if (!exists($$userdata{$uname.':'.$udom})) {
9589: &get_user_info($udom,$uname,\%idx,$userdata);
9590: }
1.420 albertel 9591: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9592: push(@{$seclists{$uname.':'.$udom}},$usec);
9593: }
1.609 raeburn 9594: if (ref($statushash) eq 'HASH') {
9595: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9596: }
1.275 raeburn 9597: }
9598: }
9599: }
9600: }
1.290 albertel 9601: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9602: if ((defined($cdom)) && (defined($cnum))) {
9603: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9604: if ( defined($csettings{'internal.courseowner'}) ) {
9605: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9606: next if ($owner eq '');
9607: my ($ownername,$ownerdom);
9608: if ($owner =~ /^([^:]+):([^:]+)$/) {
9609: $ownername = $1;
9610: $ownerdom = $2;
9611: } else {
9612: $ownername = $owner;
9613: $ownerdom = $cdom;
9614: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9615: }
9616: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9617: if (defined($userdata) &&
1.609 raeburn 9618: !exists($$userdata{$owner})) {
9619: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9620: if (!grep(/^none$/,@{$seclists{$owner}})) {
9621: push(@{$seclists{$owner}},'none');
9622: }
9623: if (ref($statushash) eq 'HASH') {
9624: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9625: }
1.290 albertel 9626: }
1.279 raeburn 9627: }
9628: }
9629: }
1.419 raeburn 9630: foreach my $user (keys(%seclists)) {
9631: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9632: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9633: }
1.275 raeburn 9634: }
9635: return;
9636: }
9637:
1.288 raeburn 9638: sub get_user_info {
9639: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9640: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9641: &plainname($uname,$udom,'lastname');
1.291 albertel 9642: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9643: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9644: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9645: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9646: return;
9647: }
1.275 raeburn 9648:
1.472 raeburn 9649: ###############################################
9650:
9651: =pod
9652:
9653: =item * &get_user_quota()
9654:
1.1134 raeburn 9655: Retrieves quota assigned for storage of user files.
9656: Default is to report quota for portfolio files.
1.472 raeburn 9657:
9658: Incoming parameters:
9659: 1. user's username
9660: 2. user's domain
1.1134 raeburn 9661: 3. quota name - portfolio, author, or course
1.1136 raeburn 9662: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 9663: 4. crstype - official, unofficial, textbook, placement or community,
9664: if quota name is course
1.472 raeburn 9665:
9666: Returns:
1.1163 raeburn 9667: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9668: 2. (Optional) Type of setting: custom or default
9669: (individually assigned or default for user's
9670: institutional status).
9671: 3. (Optional) - User's institutional status (e.g., faculty, staff
9672: or student - types as defined in localenroll::inst_usertypes
9673: for user's domain, which determines default quota for user.
9674: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9675:
9676: If a value has been stored in the user's environment,
1.536 raeburn 9677: it will return that, otherwise it returns the maximal default
1.1134 raeburn 9678: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9679:
9680: =cut
9681:
9682: ###############################################
9683:
9684:
9685: sub get_user_quota {
1.1136 raeburn 9686: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9687: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9688: if (!defined($udom)) {
9689: $udom = $env{'user.domain'};
9690: }
9691: if (!defined($uname)) {
9692: $uname = $env{'user.name'};
9693: }
9694: if (($udom eq '' || $uname eq '') ||
9695: ($udom eq 'public') && ($uname eq 'public')) {
9696: $quota = 0;
1.536 raeburn 9697: $quotatype = 'default';
9698: $defquota = 0;
1.472 raeburn 9699: } else {
1.536 raeburn 9700: my $inststatus;
1.1134 raeburn 9701: if ($quotaname eq 'course') {
9702: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9703: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9704: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9705: } else {
9706: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9707: $quota = $cenv{'internal.uploadquota'};
9708: }
1.536 raeburn 9709: } else {
1.1134 raeburn 9710: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9711: if ($quotaname eq 'author') {
9712: $quota = $env{'environment.authorquota'};
9713: } else {
9714: $quota = $env{'environment.portfolioquota'};
9715: }
9716: $inststatus = $env{'environment.inststatus'};
9717: } else {
9718: my %userenv =
9719: &Apache::lonnet::get('environment',['portfolioquota',
9720: 'authorquota','inststatus'],$udom,$uname);
9721: my ($tmp) = keys(%userenv);
9722: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9723: if ($quotaname eq 'author') {
9724: $quota = $userenv{'authorquota'};
9725: } else {
9726: $quota = $userenv{'portfolioquota'};
9727: }
9728: $inststatus = $userenv{'inststatus'};
9729: } else {
9730: undef(%userenv);
9731: }
9732: }
9733: }
9734: if ($quota eq '' || wantarray) {
9735: if ($quotaname eq 'course') {
9736: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 9737: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 9738: ($crstype eq 'community') || ($crstype eq 'textbook') ||
9739: ($crstype eq 'placement')) {
1.1136 raeburn 9740: $defquota = $domdefs{$crstype.'quota'};
9741: }
9742: if ($defquota eq '') {
9743: $defquota = 500;
9744: }
1.1134 raeburn 9745: } else {
9746: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9747: }
9748: if ($quota eq '') {
9749: $quota = $defquota;
9750: $quotatype = 'default';
9751: } else {
9752: $quotatype = 'custom';
9753: }
1.472 raeburn 9754: }
9755: }
1.536 raeburn 9756: if (wantarray) {
9757: return ($quota,$quotatype,$settingstatus,$defquota);
9758: } else {
9759: return $quota;
9760: }
1.472 raeburn 9761: }
9762:
9763: ###############################################
9764:
9765: =pod
9766:
9767: =item * &default_quota()
9768:
1.536 raeburn 9769: Retrieves default quota assigned for storage of user portfolio files,
9770: given an (optional) user's institutional status.
1.472 raeburn 9771:
9772: Incoming parameters:
1.1142 raeburn 9773:
1.472 raeburn 9774: 1. domain
1.536 raeburn 9775: 2. (Optional) institutional status(es). This is a : separated list of
9776: status types (e.g., faculty, staff, student etc.)
9777: which apply to the user for whom the default is being retrieved.
9778: If the institutional status string in undefined, the domain
1.1134 raeburn 9779: default quota will be returned.
9780: 3. quota name - portfolio, author, or course
9781: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9782:
9783: Returns:
1.1142 raeburn 9784:
1.1163 raeburn 9785: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9786: 2. (Optional) institutional type which determined the value of the
9787: default quota.
1.472 raeburn 9788:
9789: If a value has been stored in the domain's configuration db,
9790: it will return that, otherwise it returns 20 (for backwards
9791: compatibility with domains which have not set up a configuration
1.1163 raeburn 9792: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9793:
1.536 raeburn 9794: If the user's status includes multiple types (e.g., staff and student),
9795: the largest default quota which applies to the user determines the
9796: default quota returned.
9797:
1.472 raeburn 9798: =cut
9799:
9800: ###############################################
9801:
9802:
9803: sub default_quota {
1.1134 raeburn 9804: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9805: my ($defquota,$settingstatus);
9806: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9807: ['quotas'],$udom);
1.1134 raeburn 9808: my $key = 'defaultquota';
9809: if ($quotaname eq 'author') {
9810: $key = 'authorquota';
9811: }
1.622 raeburn 9812: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9813: if ($inststatus ne '') {
1.765 raeburn 9814: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9815: foreach my $item (@statuses) {
1.1134 raeburn 9816: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9817: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9818: if ($defquota eq '') {
1.1134 raeburn 9819: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9820: $settingstatus = $item;
1.1134 raeburn 9821: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9822: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9823: $settingstatus = $item;
9824: }
9825: }
1.1134 raeburn 9826: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9827: if ($quotahash{'quotas'}{$item} ne '') {
9828: if ($defquota eq '') {
9829: $defquota = $quotahash{'quotas'}{$item};
9830: $settingstatus = $item;
9831: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9832: $defquota = $quotahash{'quotas'}{$item};
9833: $settingstatus = $item;
9834: }
1.536 raeburn 9835: }
9836: }
9837: }
9838: }
9839: if ($defquota eq '') {
1.1134 raeburn 9840: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9841: $defquota = $quotahash{'quotas'}{$key}{'default'};
9842: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9843: $defquota = $quotahash{'quotas'}{'default'};
9844: }
1.536 raeburn 9845: $settingstatus = 'default';
1.1139 raeburn 9846: if ($defquota eq '') {
9847: if ($quotaname eq 'author') {
9848: $defquota = 500;
9849: }
9850: }
1.536 raeburn 9851: }
9852: } else {
9853: $settingstatus = 'default';
1.1134 raeburn 9854: if ($quotaname eq 'author') {
9855: $defquota = 500;
9856: } else {
9857: $defquota = 20;
9858: }
1.536 raeburn 9859: }
9860: if (wantarray) {
9861: return ($defquota,$settingstatus);
1.472 raeburn 9862: } else {
1.536 raeburn 9863: return $defquota;
1.472 raeburn 9864: }
9865: }
9866:
1.1135 raeburn 9867: ###############################################
9868:
9869: =pod
9870:
1.1136 raeburn 9871: =item * &excess_filesize_warning()
1.1135 raeburn 9872:
9873: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9874: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9875: space to be exceeded.
1.1136 raeburn 9876:
9877: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9878: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9879:
1.1165 raeburn 9880: Inputs: 7
1.1136 raeburn 9881: 1. username or coursenum
1.1135 raeburn 9882: 2. domain
1.1136 raeburn 9883: 3. context ('author' or 'course')
1.1135 raeburn 9884: 4. filename of file for which action is being requested
9885: 5. filesize (kB) of file
9886: 6. action being taken: copy or upload.
1.1237 raeburn 9887: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 9888:
9889: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9890: otherwise return null.
9891:
9892: =back
1.1135 raeburn 9893:
9894: =cut
9895:
1.1136 raeburn 9896: sub excess_filesize_warning {
1.1165 raeburn 9897: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9898: my $current_disk_usage = 0;
1.1165 raeburn 9899: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9900: if ($context eq 'author') {
9901: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9902: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9903: } else {
9904: foreach my $subdir ('docs','supplemental') {
9905: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9906: }
9907: }
1.1135 raeburn 9908: $disk_quota = int($disk_quota * 1000);
9909: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9910: return '<p class="LC_warning">'.
1.1135 raeburn 9911: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9912: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9913: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9914: $disk_quota,$current_disk_usage).
9915: '</p>';
9916: }
9917: return;
9918: }
9919:
9920: ###############################################
9921:
9922:
1.1136 raeburn 9923:
9924:
1.384 raeburn 9925: sub get_secgrprole_info {
9926: my ($cdom,$cnum,$needroles,$type) = @_;
9927: my %sections_count = &get_sections($cdom,$cnum);
9928: my @sections = (sort {$a <=> $b} keys(%sections_count));
9929: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9930: my @groups = sort(keys(%curr_groups));
9931: my $allroles = [];
9932: my $rolehash;
9933: my $accesshash = {
9934: active => 'Currently has access',
9935: future => 'Will have future access',
9936: previous => 'Previously had access',
9937: };
9938: if ($needroles) {
9939: $rolehash = {'all' => 'all'};
1.385 albertel 9940: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9941: if (&Apache::lonnet::error(%user_roles)) {
9942: undef(%user_roles);
9943: }
9944: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9945: my ($role)=split(/\:/,$item,2);
9946: if ($role eq 'cr') { next; }
9947: if ($role =~ /^cr/) {
9948: $$rolehash{$role} = (split('/',$role))[3];
9949: } else {
9950: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9951: }
9952: }
9953: foreach my $key (sort(keys(%{$rolehash}))) {
9954: push(@{$allroles},$key);
9955: }
9956: push (@{$allroles},'st');
9957: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9958: }
9959: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9960: }
9961:
1.555 raeburn 9962: sub user_picker {
1.994 raeburn 9963: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9964: my $currdom = $dom;
1.1253 raeburn 9965: my @alldoms = &Apache::lonnet::all_domains();
9966: if (@alldoms == 1) {
9967: my %domsrch = &Apache::lonnet::get_dom('configuration',
9968: ['directorysrch'],$alldoms[0]);
9969: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
9970: my $showdom = $domdesc;
9971: if ($showdom eq '') {
9972: $showdom = $dom;
9973: }
9974: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
9975: if ((!$domsrch{'directorysrch'}{'available'}) &&
9976: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
9977: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
9978: }
9979: }
9980: }
1.555 raeburn 9981: my %curr_selected = (
9982: srchin => 'dom',
1.580 raeburn 9983: srchby => 'lastname',
1.555 raeburn 9984: );
9985: my $srchterm;
1.625 raeburn 9986: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9987: if ($srch->{'srchby'} ne '') {
9988: $curr_selected{'srchby'} = $srch->{'srchby'};
9989: }
9990: if ($srch->{'srchin'} ne '') {
9991: $curr_selected{'srchin'} = $srch->{'srchin'};
9992: }
9993: if ($srch->{'srchtype'} ne '') {
9994: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9995: }
9996: if ($srch->{'srchdomain'} ne '') {
9997: $currdom = $srch->{'srchdomain'};
9998: }
9999: $srchterm = $srch->{'srchterm'};
10000: }
1.1222 damieng 10001: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10002: 'usr' => 'Search criteria',
1.563 raeburn 10003: 'doma' => 'Domain/institution to search',
1.558 albertel 10004: 'uname' => 'username',
10005: 'lastname' => 'last name',
1.555 raeburn 10006: 'lastfirst' => 'last name, first name',
1.558 albertel 10007: 'crs' => 'in this course',
1.576 raeburn 10008: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10009: 'alc' => 'all LON-CAPA',
1.573 raeburn 10010: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10011: 'exact' => 'is',
10012: 'contains' => 'contains',
1.569 raeburn 10013: 'begins' => 'begins with',
1.1222 damieng 10014: );
10015: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10016: 'youm' => "You must include some text to search for.",
10017: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10018: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10019: 'yomc' => "You must choose a domain when using an institutional directory search.",
10020: 'ymcd' => "You must choose a domain when using a domain search.",
10021: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10022: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10023: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10024: );
1.1222 damieng 10025: &html_escape(\%html_lt);
10026: &js_escape(\%js_lt);
1.563 raeburn 10027: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
10028: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10029:
10030: my @srchins = ('crs','dom','alc','instd');
10031:
10032: foreach my $option (@srchins) {
10033: # FIXME 'alc' option unavailable until
10034: # loncreateuser::print_user_query_page()
10035: # has been completed.
10036: next if ($option eq 'alc');
1.880 raeburn 10037: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10038: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 10039: if ($curr_selected{'srchin'} eq $option) {
10040: $srchinsel .= '
1.1222 damieng 10041: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10042: } else {
10043: $srchinsel .= '
1.1222 damieng 10044: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10045: }
1.555 raeburn 10046: }
1.563 raeburn 10047: $srchinsel .= "\n </select>\n";
1.555 raeburn 10048:
10049: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10050: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10051: if ($curr_selected{'srchby'} eq $option) {
10052: $srchbysel .= '
1.1222 damieng 10053: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10054: } else {
10055: $srchbysel .= '
1.1222 damieng 10056: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10057: }
10058: }
10059: $srchbysel .= "\n </select>\n";
10060:
10061: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10062: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10063: if ($curr_selected{'srchtype'} eq $option) {
10064: $srchtypesel .= '
1.1222 damieng 10065: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10066: } else {
10067: $srchtypesel .= '
1.1222 damieng 10068: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10069: }
10070: }
10071: $srchtypesel .= "\n </select>\n";
10072:
1.558 albertel 10073: my ($newuserscript,$new_user_create);
1.994 raeburn 10074: my $context_dom = $env{'request.role.domain'};
10075: if ($context eq 'requestcrs') {
10076: if ($env{'form.coursedom'} ne '') {
10077: $context_dom = $env{'form.coursedom'};
10078: }
10079: }
1.556 raeburn 10080: if ($forcenewuser) {
1.576 raeburn 10081: if (ref($srch) eq 'HASH') {
1.994 raeburn 10082: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10083: if ($cancreate) {
10084: $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>';
10085: } else {
1.799 bisitz 10086: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10087: my %usertypetext = (
10088: official => 'institutional',
10089: unofficial => 'non-institutional',
10090: );
1.799 bisitz 10091: $new_user_create = '<p class="LC_warning">'
10092: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10093: .' '
10094: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10095: ,'<a href="'.$helplink.'">','</a>')
10096: .'</p><br />';
1.627 raeburn 10097: }
1.576 raeburn 10098: }
10099: }
10100:
1.556 raeburn 10101: $newuserscript = <<"ENDSCRIPT";
10102:
1.570 raeburn 10103: function setSearch(createnew,callingForm) {
1.556 raeburn 10104: if (createnew == 1) {
1.570 raeburn 10105: for (var i=0; i<callingForm.srchby.length; i++) {
10106: if (callingForm.srchby.options[i].value == 'uname') {
10107: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10108: }
10109: }
1.570 raeburn 10110: for (var i=0; i<callingForm.srchin.length; i++) {
10111: if ( callingForm.srchin.options[i].value == 'dom') {
10112: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10113: }
10114: }
1.570 raeburn 10115: for (var i=0; i<callingForm.srchtype.length; i++) {
10116: if (callingForm.srchtype.options[i].value == 'exact') {
10117: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10118: }
10119: }
1.570 raeburn 10120: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10121: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10122: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10123: }
10124: }
10125: }
10126: }
10127: ENDSCRIPT
1.558 albertel 10128:
1.556 raeburn 10129: }
10130:
1.555 raeburn 10131: my $output = <<"END_BLOCK";
1.556 raeburn 10132: <script type="text/javascript">
1.824 bisitz 10133: // <![CDATA[
1.570 raeburn 10134: function validateEntry(callingForm) {
1.558 albertel 10135:
1.556 raeburn 10136: var checkok = 1;
1.558 albertel 10137: var srchin;
1.570 raeburn 10138: for (var i=0; i<callingForm.srchin.length; i++) {
10139: if ( callingForm.srchin[i].checked ) {
10140: srchin = callingForm.srchin[i].value;
1.558 albertel 10141: }
10142: }
10143:
1.570 raeburn 10144: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10145: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10146: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10147: var srchterm = callingForm.srchterm.value;
10148: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10149: var msg = "";
10150:
10151: if (srchterm == "") {
10152: checkok = 0;
1.1222 damieng 10153: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10154: }
10155:
1.569 raeburn 10156: if (srchtype== 'begins') {
10157: if (srchterm.length < 2) {
10158: checkok = 0;
1.1222 damieng 10159: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10160: }
10161: }
10162:
1.556 raeburn 10163: if (srchtype== 'contains') {
10164: if (srchterm.length < 3) {
10165: checkok = 0;
1.1222 damieng 10166: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10167: }
10168: }
10169: if (srchin == 'instd') {
10170: if (srchdomain == '') {
10171: checkok = 0;
1.1222 damieng 10172: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10173: }
10174: }
10175: if (srchin == 'dom') {
10176: if (srchdomain == '') {
10177: checkok = 0;
1.1222 damieng 10178: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10179: }
10180: }
10181: if (srchby == 'lastfirst') {
10182: if (srchterm.indexOf(",") == -1) {
10183: checkok = 0;
1.1222 damieng 10184: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10185: }
10186: if (srchterm.indexOf(",") == srchterm.length -1) {
10187: checkok = 0;
1.1222 damieng 10188: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10189: }
10190: }
10191: if (checkok == 0) {
1.1222 damieng 10192: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10193: return;
10194: }
10195: if (checkok == 1) {
1.570 raeburn 10196: callingForm.submit();
1.556 raeburn 10197: }
10198: }
10199:
10200: $newuserscript
10201:
1.824 bisitz 10202: // ]]>
1.556 raeburn 10203: </script>
1.558 albertel 10204:
10205: $new_user_create
10206:
1.555 raeburn 10207: END_BLOCK
1.558 albertel 10208:
1.876 raeburn 10209: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10210: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10211: $domform.
10212: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10213: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10214: $srchbysel.
10215: $srchtypesel.
10216: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10217: $srchinsel.
10218: &Apache::lonhtmlcommon::row_closure(1).
10219: &Apache::lonhtmlcommon::end_pick_box().
10220: '<br />';
1.1253 raeburn 10221: return ($output,1);
1.555 raeburn 10222: }
10223:
1.612 raeburn 10224: sub user_rule_check {
1.615 raeburn 10225: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10226: my ($response,%inst_response);
1.612 raeburn 10227: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10228: if (keys(%{$usershash}) > 1) {
10229: my (%by_username,%by_id,%userdoms);
10230: my $checkid;
10231: if (ref($checks) eq 'HASH') {
10232: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10233: $checkid = 1;
10234: }
10235: }
10236: foreach my $user (keys(%{$usershash})) {
10237: my ($uname,$udom) = split(/:/,$user);
10238: if ($checkid) {
10239: if (ref($usershash->{$user}) eq 'HASH') {
10240: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10241: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10242: $userdoms{$udom} = 1;
1.1227 raeburn 10243: if (ref($inst_results) eq 'HASH') {
10244: $inst_results->{$uname.':'.$udom} = {};
10245: }
1.1226 raeburn 10246: }
10247: }
10248: } else {
10249: $by_username{$udom}{$uname} = 1;
10250: $userdoms{$udom} = 1;
1.1227 raeburn 10251: if (ref($inst_results) eq 'HASH') {
10252: $inst_results->{$uname.':'.$udom} = {};
10253: }
1.1226 raeburn 10254: }
10255: }
10256: foreach my $udom (keys(%userdoms)) {
10257: if (!$got_rules->{$udom}) {
10258: my %domconfig = &Apache::lonnet::get_dom('configuration',
10259: ['usercreation'],$udom);
10260: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10261: foreach my $item ('username','id') {
10262: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10263: $$curr_rules{$udom}{$item} =
10264: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10265: }
10266: }
10267: }
10268: $got_rules->{$udom} = 1;
10269: }
1.612 raeburn 10270: }
1.1226 raeburn 10271: if ($checkid) {
10272: foreach my $udom (keys(%by_id)) {
10273: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10274: if ($outcome eq 'ok') {
1.1227 raeburn 10275: foreach my $id (keys(%{$by_id{$udom}})) {
10276: my $uname = $by_id{$udom}{$id};
10277: $inst_response{$uname.':'.$udom} = $outcome;
10278: }
1.1226 raeburn 10279: if (ref($results) eq 'HASH') {
10280: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10281: if (exists($inst_response{$uname.':'.$udom})) {
10282: $inst_response{$uname.':'.$udom} = $outcome;
10283: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10284: }
1.1226 raeburn 10285: }
10286: }
10287: }
1.612 raeburn 10288: }
1.615 raeburn 10289: } else {
1.1226 raeburn 10290: foreach my $udom (keys(%by_username)) {
10291: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10292: if ($outcome eq 'ok') {
1.1227 raeburn 10293: foreach my $uname (keys(%{$by_username{$udom}})) {
10294: $inst_response{$uname.':'.$udom} = $outcome;
10295: }
1.1226 raeburn 10296: if (ref($results) eq 'HASH') {
10297: foreach my $uname (keys(%{$results})) {
10298: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10299: }
10300: }
10301: }
10302: }
1.612 raeburn 10303: }
1.1226 raeburn 10304: } elsif (keys(%{$usershash}) == 1) {
10305: my $user = (keys(%{$usershash}))[0];
10306: my ($uname,$udom) = split(/:/,$user);
10307: if (($udom ne '') && ($uname ne '')) {
10308: if (ref($usershash->{$user}) eq 'HASH') {
10309: if (ref($checks) eq 'HASH') {
10310: if (defined($checks->{'username'})) {
10311: ($inst_response{$user},%{$inst_results->{$user}}) =
10312: &Apache::lonnet::get_instuser($udom,$uname);
10313: } elsif (defined($checks->{'id'})) {
10314: if ($usershash->{$user}->{'id'} ne '') {
10315: ($inst_response{$user},%{$inst_results->{$user}}) =
10316: &Apache::lonnet::get_instuser($udom,undef,
10317: $usershash->{$user}->{'id'});
10318: } else {
10319: ($inst_response{$user},%{$inst_results->{$user}}) =
10320: &Apache::lonnet::get_instuser($udom,$uname);
10321: }
1.585 raeburn 10322: }
1.1226 raeburn 10323: } else {
10324: ($inst_response{$user},%{$inst_results->{$user}}) =
10325: &Apache::lonnet::get_instuser($udom,$uname);
10326: return;
10327: }
10328: if (!$got_rules->{$udom}) {
10329: my %domconfig = &Apache::lonnet::get_dom('configuration',
10330: ['usercreation'],$udom);
10331: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10332: foreach my $item ('username','id') {
10333: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10334: $$curr_rules{$udom}{$item} =
10335: $domconfig{'usercreation'}{$item.'_rule'};
10336: }
10337: }
10338: }
10339: $got_rules->{$udom} = 1;
1.585 raeburn 10340: }
10341: }
1.1226 raeburn 10342: } else {
10343: return;
10344: }
10345: } else {
10346: return;
10347: }
10348: foreach my $user (keys(%{$usershash})) {
10349: my ($uname,$udom) = split(/:/,$user);
10350: next if (($udom eq '') || ($uname eq ''));
10351: my $id;
1.1227 raeburn 10352: if (ref($inst_results) eq 'HASH') {
10353: if (ref($inst_results->{$user}) eq 'HASH') {
10354: $id = $inst_results->{$user}->{'id'};
10355: }
10356: }
10357: if ($id eq '') {
10358: if (ref($usershash->{$user})) {
10359: $id = $usershash->{$user}->{'id'};
10360: }
1.585 raeburn 10361: }
1.612 raeburn 10362: foreach my $item (keys(%{$checks})) {
10363: if (ref($$curr_rules{$udom}) eq 'HASH') {
10364: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10365: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10366: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10367: $$curr_rules{$udom}{$item});
1.612 raeburn 10368: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10369: if ($rule_check{$rule}) {
10370: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10371: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10372: if (ref($inst_results) eq 'HASH') {
10373: if (ref($inst_results->{$user}) eq 'HASH') {
10374: if (keys(%{$inst_results->{$user}}) == 0) {
10375: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10376: } elsif ($item eq 'id') {
10377: if ($inst_results->{$user}->{'id'} eq '') {
10378: $$alerts{$item}{$udom}{$uname} = 1;
10379: }
1.615 raeburn 10380: }
1.612 raeburn 10381: }
10382: }
1.615 raeburn 10383: }
10384: last;
1.585 raeburn 10385: }
10386: }
10387: }
10388: }
10389: }
10390: }
10391: }
10392: }
1.612 raeburn 10393: return;
10394: }
10395:
10396: sub user_rule_formats {
10397: my ($domain,$domdesc,$curr_rules,$check) = @_;
10398: my %text = (
10399: 'username' => 'Usernames',
10400: 'id' => 'IDs',
10401: );
10402: my $output;
10403: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10404: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10405: if (@{$ruleorder} > 0) {
1.1102 raeburn 10406: $output = '<br />'.
10407: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10408: '<span class="LC_cusr_emph">','</span>',$domdesc).
10409: ' <ul>';
1.612 raeburn 10410: foreach my $rule (@{$ruleorder}) {
10411: if (ref($curr_rules) eq 'ARRAY') {
10412: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10413: if (ref($rules->{$rule}) eq 'HASH') {
10414: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10415: $rules->{$rule}{'desc'}.'</li>';
10416: }
10417: }
10418: }
10419: }
10420: $output .= '</ul>';
10421: }
10422: }
10423: return $output;
10424: }
10425:
10426: sub instrule_disallow_msg {
1.615 raeburn 10427: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10428: my $response;
10429: my %text = (
10430: item => 'username',
10431: items => 'usernames',
10432: match => 'matches',
10433: do => 'does',
10434: action => 'a username',
10435: one => 'one',
10436: );
10437: if ($count > 1) {
10438: $text{'item'} = 'usernames';
10439: $text{'match'} ='match';
10440: $text{'do'} = 'do';
10441: $text{'action'} = 'usernames',
10442: $text{'one'} = 'ones';
10443: }
10444: if ($checkitem eq 'id') {
10445: $text{'items'} = 'IDs';
10446: $text{'item'} = 'ID';
10447: $text{'action'} = 'an ID';
1.615 raeburn 10448: if ($count > 1) {
10449: $text{'item'} = 'IDs';
10450: $text{'action'} = 'IDs';
10451: }
1.612 raeburn 10452: }
1.674 bisitz 10453: $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 10454: if ($mode eq 'upload') {
10455: if ($checkitem eq 'username') {
10456: $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'}.");
10457: } elsif ($checkitem eq 'id') {
1.674 bisitz 10458: $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 10459: }
1.669 raeburn 10460: } elsif ($mode eq 'selfcreate') {
10461: if ($checkitem eq 'id') {
10462: $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.");
10463: }
1.615 raeburn 10464: } else {
10465: if ($checkitem eq 'username') {
10466: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10467: } elsif ($checkitem eq 'id') {
10468: $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.");
10469: }
1.612 raeburn 10470: }
10471: return $response;
1.585 raeburn 10472: }
10473:
1.624 raeburn 10474: sub personal_data_fieldtitles {
10475: my %fieldtitles = &Apache::lonlocal::texthash (
10476: id => 'Student/Employee ID',
10477: permanentemail => 'E-mail address',
10478: lastname => 'Last Name',
10479: firstname => 'First Name',
10480: middlename => 'Middle Name',
10481: generation => 'Generation',
10482: gen => 'Generation',
1.765 raeburn 10483: inststatus => 'Affiliation',
1.624 raeburn 10484: );
10485: return %fieldtitles;
10486: }
10487:
1.642 raeburn 10488: sub sorted_inst_types {
10489: my ($dom) = @_;
1.1185 raeburn 10490: my ($usertypes,$order);
10491: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10492: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10493: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10494: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10495: } else {
10496: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10497: }
1.642 raeburn 10498: my $othertitle = &mt('All users');
10499: if ($env{'request.course.id'}) {
1.668 raeburn 10500: $othertitle = &mt('Any users');
1.642 raeburn 10501: }
10502: my @types;
10503: if (ref($order) eq 'ARRAY') {
10504: @types = @{$order};
10505: }
10506: if (@types == 0) {
10507: if (ref($usertypes) eq 'HASH') {
10508: @types = sort(keys(%{$usertypes}));
10509: }
10510: }
10511: if (keys(%{$usertypes}) > 0) {
10512: $othertitle = &mt('Other users');
10513: }
10514: return ($othertitle,$usertypes,\@types);
10515: }
10516:
1.645 raeburn 10517: sub get_institutional_codes {
10518: my ($settings,$allcourses,$LC_code) = @_;
10519: # Get complete list of course sections to update
10520: my @currsections = ();
10521: my @currxlists = ();
10522: my $coursecode = $$settings{'internal.coursecode'};
10523:
10524: if ($$settings{'internal.sectionnums'} ne '') {
10525: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10526: }
10527:
10528: if ($$settings{'internal.crosslistings'} ne '') {
10529: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10530: }
10531:
10532: if (@currxlists > 0) {
10533: foreach (@currxlists) {
10534: if (m/^([^:]+):(\w*)$/) {
10535: unless (grep/^$1$/,@{$allcourses}) {
10536: push @{$allcourses},$1;
10537: $$LC_code{$1} = $2;
10538: }
10539: }
10540: }
10541: }
10542:
10543: if (@currsections > 0) {
10544: foreach (@currsections) {
10545: if (m/^(\w+):(\w*)$/) {
10546: my $sec = $coursecode.$1;
10547: my $lc_sec = $2;
10548: unless (grep/^$sec$/,@{$allcourses}) {
10549: push @{$allcourses},$sec;
10550: $$LC_code{$sec} = $lc_sec;
10551: }
10552: }
10553: }
10554: }
10555: return;
10556: }
10557:
1.971 raeburn 10558: sub get_standard_codeitems {
10559: return ('Year','Semester','Department','Number','Section');
10560: }
10561:
1.112 bowersj2 10562: =pod
10563:
1.780 raeburn 10564: =head1 Slot Helpers
10565:
10566: =over 4
10567:
10568: =item * sorted_slots()
10569:
1.1040 raeburn 10570: Sorts an array of slot names in order of an optional sort key,
10571: default sort is by slot start time (earliest first).
1.780 raeburn 10572:
10573: Inputs:
10574:
10575: =over 4
10576:
10577: slotsarr - Reference to array of unsorted slot names.
10578:
10579: slots - Reference to hash of hash, where outer hash keys are slot names.
10580:
1.1040 raeburn 10581: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10582:
1.549 albertel 10583: =back
10584:
1.780 raeburn 10585: Returns:
10586:
10587: =over 4
10588:
1.1040 raeburn 10589: sorted - An array of slot names sorted by a specified sort key
10590: (default sort key is start time of the slot).
1.780 raeburn 10591:
10592: =back
10593:
10594: =cut
10595:
10596:
10597: sub sorted_slots {
1.1040 raeburn 10598: my ($slotsarr,$slots,$sortkey) = @_;
10599: if ($sortkey eq '') {
10600: $sortkey = 'starttime';
10601: }
1.780 raeburn 10602: my @sorted;
10603: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10604: @sorted =
10605: sort {
10606: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10607: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10608: }
10609: if (ref($slots->{$a})) { return -1;}
10610: if (ref($slots->{$b})) { return 1;}
10611: return 0;
10612: } @{$slotsarr};
10613: }
10614: return @sorted;
10615: }
10616:
1.1040 raeburn 10617: =pod
10618:
10619: =item * get_future_slots()
10620:
10621: Inputs:
10622:
10623: =over 4
10624:
10625: cnum - course number
10626:
10627: cdom - course domain
10628:
10629: now - current UNIX time
10630:
10631: symb - optional symb
10632:
10633: =back
10634:
10635: Returns:
10636:
10637: =over 4
10638:
10639: sorted_reservable - ref to array of student_schedulable slots currently
10640: reservable, ordered by end date of reservation period.
10641:
10642: reservable_now - ref to hash of student_schedulable slots currently
10643: reservable.
10644:
10645: Keys in inner hash are:
10646: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10647: (b) endreserve: end date of reservation period.
10648: (c) uniqueperiod: start,end dates when slot is to be uniquely
10649: selected.
1.1040 raeburn 10650:
10651: sorted_future - ref to array of student_schedulable slots reservable in
10652: the future, ordered by start date of reservation period.
10653:
10654: future_reservable - ref to hash of student_schedulable slots reservable
10655: in the future.
10656:
10657: Keys in inner hash are:
10658: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 10659: (b) startreserve: start date of reservation period.
10660: (c) uniqueperiod: start,end dates when slot is to be uniquely
10661: selected.
1.1040 raeburn 10662:
10663: =back
10664:
10665: =cut
10666:
10667: sub get_future_slots {
10668: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 10669: my $map;
10670: if ($symb) {
10671: ($map) = &Apache::lonnet::decode_symb($symb);
10672: }
1.1040 raeburn 10673: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10674: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10675: foreach my $slot (keys(%slots)) {
10676: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10677: if ($symb) {
1.1229 raeburn 10678: if ($slots{$slot}->{'symb'} ne '') {
10679: my $canuse;
10680: my %oksymbs;
10681: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
10682: map { $oksymbs{$_} = 1; } @slotsymbs;
10683: if ($oksymbs{$symb}) {
10684: $canuse = 1;
10685: } else {
10686: foreach my $item (@slotsymbs) {
10687: if ($item =~ /\.(page|sequence)$/) {
10688: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
10689: if (($map ne '') && ($map eq $sloturl)) {
10690: $canuse = 1;
10691: last;
10692: }
10693: }
10694: }
10695: }
10696: next unless ($canuse);
10697: }
1.1040 raeburn 10698: }
10699: if (($slots{$slot}->{'starttime'} > $now) &&
10700: ($slots{$slot}->{'endtime'} > $now)) {
10701: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10702: my $userallowed = 0;
10703: if ($slots{$slot}->{'allowedsections'}) {
10704: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10705: if (!defined($env{'request.role.sec'})
10706: && grep(/^No section assigned$/,@allowed_sec)) {
10707: $userallowed=1;
10708: } else {
10709: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10710: $userallowed=1;
10711: }
10712: }
10713: unless ($userallowed) {
10714: if (defined($env{'request.course.groups'})) {
10715: my @groups = split(/:/,$env{'request.course.groups'});
10716: foreach my $group (@groups) {
10717: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10718: $userallowed=1;
10719: last;
10720: }
10721: }
10722: }
10723: }
10724: }
10725: if ($slots{$slot}->{'allowedusers'}) {
10726: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10727: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10728: if (grep(/^\Q$user\E$/,@allowed_users)) {
10729: $userallowed = 1;
10730: }
10731: }
10732: next unless($userallowed);
10733: }
10734: my $startreserve = $slots{$slot}->{'startreserve'};
10735: my $endreserve = $slots{$slot}->{'endreserve'};
10736: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 10737: my $uniqueperiod;
10738: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10739: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10740: }
1.1040 raeburn 10741: if (($startreserve < $now) &&
10742: (!$endreserve || $endreserve > $now)) {
10743: my $lastres = $endreserve;
10744: if (!$lastres) {
10745: $lastres = $slots{$slot}->{'starttime'};
10746: }
10747: $reservable_now{$slot} = {
10748: symb => $symb,
1.1250 raeburn 10749: endreserve => $lastres,
10750: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10751: };
10752: } elsif (($startreserve > $now) &&
10753: (!$endreserve || $endreserve > $startreserve)) {
10754: $future_reservable{$slot} = {
10755: symb => $symb,
1.1250 raeburn 10756: startreserve => $startreserve,
10757: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10758: };
10759: }
10760: }
10761: }
10762: my @unsorted_reservable = keys(%reservable_now);
10763: if (@unsorted_reservable > 0) {
10764: @sorted_reservable =
10765: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10766: }
10767: my @unsorted_future = keys(%future_reservable);
10768: if (@unsorted_future > 0) {
10769: @sorted_future =
10770: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10771: }
10772: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10773: }
1.780 raeburn 10774:
10775: =pod
10776:
1.1057 foxr 10777: =back
10778:
1.549 albertel 10779: =head1 HTTP Helpers
10780:
10781: =over 4
10782:
1.648 raeburn 10783: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10784:
1.258 albertel 10785: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10786: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10787: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10788:
10789: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10790: $possible_names is an ref to an array of form element names. As an example:
10791: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10792: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10793:
10794: =cut
1.1 albertel 10795:
1.6 albertel 10796: sub get_unprocessed_cgi {
1.25 albertel 10797: my ($query,$possible_names)= @_;
1.26 matthew 10798: # $Apache::lonxml::debug=1;
1.356 albertel 10799: foreach my $pair (split(/&/,$query)) {
10800: my ($name, $value) = split(/=/,$pair);
1.369 www 10801: $name = &unescape($name);
1.25 albertel 10802: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10803: $value =~ tr/+/ /;
10804: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10805: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10806: }
1.16 harris41 10807: }
1.6 albertel 10808: }
10809:
1.112 bowersj2 10810: =pod
10811:
1.648 raeburn 10812: =item * &cacheheader()
1.112 bowersj2 10813:
10814: returns cache-controlling header code
10815:
10816: =cut
10817:
1.7 albertel 10818: sub cacheheader {
1.258 albertel 10819: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10820: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10821: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10822: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10823: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10824: return $output;
1.7 albertel 10825: }
10826:
1.112 bowersj2 10827: =pod
10828:
1.648 raeburn 10829: =item * &no_cache($r)
1.112 bowersj2 10830:
10831: specifies header code to not have cache
10832:
10833: =cut
10834:
1.9 albertel 10835: sub no_cache {
1.216 albertel 10836: my ($r) = @_;
10837: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10838: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10839: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10840: $r->no_cache(1);
10841: $r->header_out("Expires" => $date);
10842: $r->header_out("Pragma" => "no-cache");
1.123 www 10843: }
10844:
10845: sub content_type {
1.181 albertel 10846: my ($r,$type,$charset) = @_;
1.299 foxr 10847: if ($r) {
10848: # Note that printout.pl calls this with undef for $r.
10849: &no_cache($r);
10850: }
1.258 albertel 10851: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10852: unless ($charset) {
10853: $charset=&Apache::lonlocal::current_encoding;
10854: }
10855: if ($charset) { $type.='; charset='.$charset; }
10856: if ($r) {
10857: $r->content_type($type);
10858: } else {
10859: print("Content-type: $type\n\n");
10860: }
1.9 albertel 10861: }
1.25 albertel 10862:
1.112 bowersj2 10863: =pod
10864:
1.648 raeburn 10865: =item * &add_to_env($name,$value)
1.112 bowersj2 10866:
1.258 albertel 10867: adds $name to the %env hash with value
1.112 bowersj2 10868: $value, if $name already exists, the entry is converted to an array
10869: reference and $value is added to the array.
10870:
10871: =cut
10872:
1.25 albertel 10873: sub add_to_env {
10874: my ($name,$value)=@_;
1.258 albertel 10875: if (defined($env{$name})) {
10876: if (ref($env{$name})) {
1.25 albertel 10877: #already have multiple values
1.258 albertel 10878: push(@{ $env{$name} },$value);
1.25 albertel 10879: } else {
10880: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10881: my $first=$env{$name};
10882: undef($env{$name});
10883: push(@{ $env{$name} },$first,$value);
1.25 albertel 10884: }
10885: } else {
1.258 albertel 10886: $env{$name}=$value;
1.25 albertel 10887: }
1.31 albertel 10888: }
1.149 albertel 10889:
10890: =pod
10891:
1.648 raeburn 10892: =item * &get_env_multiple($name)
1.149 albertel 10893:
1.258 albertel 10894: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10895: values may be defined and end up as an array ref.
10896:
10897: returns an array of values
10898:
10899: =cut
10900:
10901: sub get_env_multiple {
10902: my ($name) = @_;
10903: my @values;
1.258 albertel 10904: if (defined($env{$name})) {
1.149 albertel 10905: # exists is it an array
1.258 albertel 10906: if (ref($env{$name})) {
10907: @values=@{ $env{$name} };
1.149 albertel 10908: } else {
1.258 albertel 10909: $values[0]=$env{$name};
1.149 albertel 10910: }
10911: }
10912: return(@values);
10913: }
10914:
1.1249 damieng 10915: # Looks at given dependencies, and returns something depending on the context.
10916: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
10917: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
10918: # For all other contexts, returns ($output, $counter, $numpathchg).
10919: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
10920: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
10921: # $numpathchg: integer with the number of cleaned up dependency paths.
10922: # \%existing: hash reference clean path -> 1 only for existing dependencies.
10923: # \%mapping: hash reference clean path -> original path for all dependencies.
10924: # @param {string} actionurl - The path to the handler, indicative of the context.
10925: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
10926: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
10927: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
10928: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
10929: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 10930: sub ask_for_embedded_content {
1.1249 damieng 10931: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 10932: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10933: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 10934: %currsubfile,%unused,$rem);
1.1071 raeburn 10935: my $counter = 0;
10936: my $numnew = 0;
1.987 raeburn 10937: my $numremref = 0;
10938: my $numinvalid = 0;
10939: my $numpathchg = 0;
10940: my $numexisting = 0;
1.1071 raeburn 10941: my $numunused = 0;
10942: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 10943: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10944: my $heading = &mt('Upload embedded files');
10945: my $buttontext = &mt('Upload');
10946:
1.1249 damieng 10947: # fills these variables based on the context:
10948: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
10949: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 10950: if ($env{'request.course.id'}) {
1.1123 raeburn 10951: if ($actionurl eq '/adm/dependencies') {
10952: $navmap = Apache::lonnavmaps::navmap->new();
10953: }
10954: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10955: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 10956: }
1.1123 raeburn 10957: if (($actionurl eq '/adm/portfolio') ||
10958: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10959: my $current_path='/';
10960: if ($env{'form.currentpath'}) {
10961: $current_path = $env{'form.currentpath'};
10962: }
10963: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 10964: $udom = $cdom;
10965: $uname = $cnum;
1.984 raeburn 10966: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10967: } else {
10968: $udom = $env{'user.domain'};
10969: $uname = $env{'user.name'};
10970: $url = '/userfiles/portfolio';
10971: }
1.987 raeburn 10972: $toplevel = $url.'/';
1.984 raeburn 10973: $url .= $current_path;
10974: $getpropath = 1;
1.987 raeburn 10975: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10976: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10977: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10978: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10979: $toplevel = $url;
1.984 raeburn 10980: if ($rest ne '') {
1.987 raeburn 10981: $url .= $rest;
10982: }
10983: } elsif ($actionurl eq '/adm/coursedocs') {
10984: if (ref($args) eq 'HASH') {
1.1071 raeburn 10985: $url = $args->{'docs_url'};
10986: $toplevel = $url;
1.1084 raeburn 10987: if ($args->{'context'} eq 'paste') {
10988: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10989: ($path) =
10990: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10991: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10992: $fileloc =~ s{^/}{};
10993: }
1.1071 raeburn 10994: }
1.1084 raeburn 10995: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 10996: if ($env{'request.course.id'} ne '') {
10997: if (ref($args) eq 'HASH') {
10998: $url = $args->{'docs_url'};
10999: $title = $args->{'docs_title'};
1.1126 raeburn 11000: $toplevel = $url;
11001: unless ($toplevel =~ m{^/}) {
11002: $toplevel = "/$url";
11003: }
1.1085 raeburn 11004: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11005: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11006: $path = $1;
11007: } else {
11008: ($path) =
11009: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11010: }
1.1195 raeburn 11011: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11012: $fileloc = $toplevel;
11013: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11014: my ($udom,$uname,$fname) =
11015: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11016: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11017: } else {
11018: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11019: }
1.1071 raeburn 11020: $fileloc =~ s{^/}{};
11021: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11022: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11023: }
1.987 raeburn 11024: }
1.1123 raeburn 11025: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11026: $udom = $cdom;
11027: $uname = $cnum;
11028: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11029: $toplevel = $url;
11030: $path = $url;
11031: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11032: $fileloc =~ s{^/}{};
1.987 raeburn 11033: }
1.1249 damieng 11034:
11035: # parses the dependency paths to get some info
11036: # fills $newfiles, $mapping, $subdependencies, $dependencies
11037: # $newfiles: hash URL -> 1 for new files or external URLs
11038: # (will be completed later)
11039: # $mapping:
11040: # for external URLs: external URL -> external URL
11041: # for relative paths: clean path -> original path
11042: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11043: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11044: foreach my $file (keys(%{$allfiles})) {
11045: my $embed_file;
11046: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11047: $embed_file = $1;
11048: } else {
11049: $embed_file = $file;
11050: }
1.1158 raeburn 11051: my ($absolutepath,$cleaned_file);
11052: if ($embed_file =~ m{^\w+://}) {
11053: $cleaned_file = $embed_file;
1.1147 raeburn 11054: $newfiles{$cleaned_file} = 1;
11055: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11056: } else {
1.1158 raeburn 11057: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11058: if ($embed_file =~ m{^/}) {
11059: $absolutepath = $embed_file;
11060: }
1.1147 raeburn 11061: if ($cleaned_file =~ m{/}) {
11062: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11063: $path = &check_for_traversal($path,$url,$toplevel);
11064: my $item = $fname;
11065: if ($path ne '') {
11066: $item = $path.'/'.$fname;
11067: $subdependencies{$path}{$fname} = 1;
11068: } else {
11069: $dependencies{$item} = 1;
11070: }
11071: if ($absolutepath) {
11072: $mapping{$item} = $absolutepath;
11073: } else {
11074: $mapping{$item} = $embed_file;
11075: }
11076: } else {
11077: $dependencies{$embed_file} = 1;
11078: if ($absolutepath) {
1.1147 raeburn 11079: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11080: } else {
1.1147 raeburn 11081: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11082: }
11083: }
1.984 raeburn 11084: }
11085: }
1.1249 damieng 11086:
11087: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11088: # and lists
11089: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11090: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11091: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11092: # the path had to be cleaned up
11093: # $existing: hash clean path -> 1 if the file exists
11094: # $numexisting: number of keys in $existing
11095: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11096: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11097: # dependency subdirectories that are
11098: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11099: my $dirptr = 16384;
1.984 raeburn 11100: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11101: $currsubfile{$path} = {};
1.1123 raeburn 11102: if (($actionurl eq '/adm/portfolio') ||
11103: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11104: my ($sublistref,$listerror) =
11105: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11106: if (ref($sublistref) eq 'ARRAY') {
11107: foreach my $line (@{$sublistref}) {
11108: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11109: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11110: }
1.984 raeburn 11111: }
1.987 raeburn 11112: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11113: if (opendir(my $dir,$url.'/'.$path)) {
11114: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11115: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11116: }
1.1084 raeburn 11117: } elsif (($actionurl eq '/adm/dependencies') ||
11118: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11119: ($args->{'context'} eq 'paste')) ||
11120: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11121: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11122: my $dir;
11123: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11124: $dir = $fileloc;
11125: } else {
11126: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11127: }
1.1071 raeburn 11128: if ($dir ne '') {
11129: my ($sublistref,$listerror) =
11130: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11131: if (ref($sublistref) eq 'ARRAY') {
11132: foreach my $line (@{$sublistref}) {
11133: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11134: undef,$mtime)=split(/\&/,$line,12);
11135: unless (($testdir&$dirptr) ||
11136: ($file_name =~ /^\.\.?$/)) {
11137: $currsubfile{$path}{$file_name} = [$size,$mtime];
11138: }
11139: }
11140: }
11141: }
1.984 raeburn 11142: }
11143: }
11144: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11145: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11146: my $item = $path.'/'.$file;
11147: unless ($mapping{$item} eq $item) {
11148: $pathchanges{$item} = 1;
11149: }
11150: $existing{$item} = 1;
11151: $numexisting ++;
11152: } else {
11153: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11154: }
11155: }
1.1071 raeburn 11156: if ($actionurl eq '/adm/dependencies') {
11157: foreach my $path (keys(%currsubfile)) {
11158: if (ref($currsubfile{$path}) eq 'HASH') {
11159: foreach my $file (keys(%{$currsubfile{$path}})) {
11160: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11161: next if (($rem ne '') &&
11162: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11163: (ref($navmap) &&
11164: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11165: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11166: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11167: $unused{$path.'/'.$file} = 1;
11168: }
11169: }
11170: }
11171: }
11172: }
1.984 raeburn 11173: }
1.1249 damieng 11174:
11175: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11176: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11177: my %currfile;
1.1123 raeburn 11178: if (($actionurl eq '/adm/portfolio') ||
11179: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11180: my ($dirlistref,$listerror) =
11181: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11182: if (ref($dirlistref) eq 'ARRAY') {
11183: foreach my $line (@{$dirlistref}) {
11184: my ($file_name,$rest) = split(/\&/,$line,2);
11185: $currfile{$file_name} = 1;
11186: }
1.984 raeburn 11187: }
1.987 raeburn 11188: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11189: if (opendir(my $dir,$url)) {
1.987 raeburn 11190: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11191: map {$currfile{$_} = 1;} @dir_list;
11192: }
1.1084 raeburn 11193: } elsif (($actionurl eq '/adm/dependencies') ||
11194: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11195: ($args->{'context'} eq 'paste')) ||
11196: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11197: if ($env{'request.course.id'} ne '') {
11198: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11199: if ($dir ne '') {
11200: my ($dirlistref,$listerror) =
11201: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11202: if (ref($dirlistref) eq 'ARRAY') {
11203: foreach my $line (@{$dirlistref}) {
11204: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11205: $size,undef,$mtime)=split(/\&/,$line,12);
11206: unless (($testdir&$dirptr) ||
11207: ($file_name =~ /^\.\.?$/)) {
11208: $currfile{$file_name} = [$size,$mtime];
11209: }
11210: }
11211: }
11212: }
11213: }
1.984 raeburn 11214: }
1.1249 damieng 11215: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11216: # are not in subdirectories, using $currfile
1.984 raeburn 11217: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11218: if (exists($currfile{$file})) {
1.987 raeburn 11219: unless ($mapping{$file} eq $file) {
11220: $pathchanges{$file} = 1;
11221: }
11222: $existing{$file} = 1;
11223: $numexisting ++;
11224: } else {
1.984 raeburn 11225: $newfiles{$file} = 1;
11226: }
11227: }
1.1071 raeburn 11228: foreach my $file (keys(%currfile)) {
11229: unless (($file eq $filename) ||
11230: ($file eq $filename.'.bak') ||
11231: ($dependencies{$file})) {
1.1085 raeburn 11232: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11233: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11234: next if (($rem ne '') &&
11235: (($env{"httpref.$rem".$file} ne '') ||
11236: (ref($navmap) &&
11237: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11238: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11239: ($navmap->getResourceByUrl($rem.$1)))))));
11240: }
1.1085 raeburn 11241: }
1.1071 raeburn 11242: $unused{$file} = 1;
11243: }
11244: }
1.1249 damieng 11245:
11246: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11247: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11248: ($args->{'context'} eq 'paste')) {
11249: $counter = scalar(keys(%existing));
11250: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11251: return ($output,$counter,$numpathchg,\%existing);
11252: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11253: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11254: $counter = scalar(keys(%existing));
11255: $numpathchg = scalar(keys(%pathchanges));
11256: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11257: }
1.1249 damieng 11258:
11259: # returns HTML otherwise, with dependency results and to ask for more uploads
11260:
11261: # $upload_output: missing dependencies (with upload form)
11262: # $modify_output: uploaded dependencies (in use)
11263: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11264: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11265: if ($actionurl eq '/adm/dependencies') {
11266: next if ($embed_file =~ m{^\w+://});
11267: }
1.660 raeburn 11268: $upload_output .= &start_data_table_row().
1.1123 raeburn 11269: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11270: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11271: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11272: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11273: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11274: }
1.1123 raeburn 11275: $upload_output .= '</td>';
1.1071 raeburn 11276: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11277: $upload_output.='<td align="right">'.
11278: '<span class="LC_info LC_fontsize_medium">'.
11279: &mt("URL points to web address").'</span>';
1.987 raeburn 11280: $numremref++;
1.660 raeburn 11281: } elsif ($args->{'error_on_invalid_names'}
11282: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11283: $upload_output.='<td align="right"><span class="LC_warning">'.
11284: &mt('Invalid characters').'</span>';
1.987 raeburn 11285: $numinvalid++;
1.660 raeburn 11286: } else {
1.1123 raeburn 11287: $upload_output .= '<td>'.
11288: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11289: $embed_file,\%mapping,
1.1071 raeburn 11290: $allfiles,$codebase,'upload');
11291: $counter ++;
11292: $numnew ++;
1.987 raeburn 11293: }
11294: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11295: }
11296: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11297: if ($actionurl eq '/adm/dependencies') {
11298: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11299: $modify_output .= &start_data_table_row().
11300: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11301: '<img src="'.&icon($embed_file).'" border="0" />'.
11302: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11303: '<td>'.$size.'</td>'.
11304: '<td>'.$mtime.'</td>'.
11305: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11306: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11307: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11308: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11309: &embedded_file_element('upload_embedded',$counter,
11310: $embed_file,\%mapping,
11311: $allfiles,$codebase,'modify').
11312: '</div></td>'.
11313: &end_data_table_row()."\n";
11314: $counter ++;
11315: } else {
11316: $upload_output .= &start_data_table_row().
1.1123 raeburn 11317: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11318: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11319: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11320: &Apache::loncommon::end_data_table_row()."\n";
11321: }
11322: }
11323: my $delidx = $counter;
11324: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11325: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11326: $delete_output .= &start_data_table_row().
11327: '<td><img src="'.&icon($oldfile).'" />'.
11328: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11329: '<td>'.$size.'</td>'.
11330: '<td>'.$mtime.'</td>'.
11331: '<td><label><input type="checkbox" name="del_upload_dep" '.
11332: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11333: &embedded_file_element('upload_embedded',$delidx,
11334: $oldfile,\%mapping,$allfiles,
11335: $codebase,'delete').'</td>'.
11336: &end_data_table_row()."\n";
11337: $numunused ++;
11338: $delidx ++;
1.987 raeburn 11339: }
11340: if ($upload_output) {
11341: $upload_output = &start_data_table().
11342: $upload_output.
11343: &end_data_table()."\n";
11344: }
1.1071 raeburn 11345: if ($modify_output) {
11346: $modify_output = &start_data_table().
11347: &start_data_table_header_row().
11348: '<th>'.&mt('File').'</th>'.
11349: '<th>'.&mt('Size (KB)').'</th>'.
11350: '<th>'.&mt('Modified').'</th>'.
11351: '<th>'.&mt('Upload replacement?').'</th>'.
11352: &end_data_table_header_row().
11353: $modify_output.
11354: &end_data_table()."\n";
11355: }
11356: if ($delete_output) {
11357: $delete_output = &start_data_table().
11358: &start_data_table_header_row().
11359: '<th>'.&mt('File').'</th>'.
11360: '<th>'.&mt('Size (KB)').'</th>'.
11361: '<th>'.&mt('Modified').'</th>'.
11362: '<th>'.&mt('Delete?').'</th>'.
11363: &end_data_table_header_row().
11364: $delete_output.
11365: &end_data_table()."\n";
11366: }
1.987 raeburn 11367: my $applies = 0;
11368: if ($numremref) {
11369: $applies ++;
11370: }
11371: if ($numinvalid) {
11372: $applies ++;
11373: }
11374: if ($numexisting) {
11375: $applies ++;
11376: }
1.1071 raeburn 11377: if ($counter || $numunused) {
1.987 raeburn 11378: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11379: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11380: $state.'<h3>'.$heading.'</h3>';
11381: if ($actionurl eq '/adm/dependencies') {
11382: if ($numnew) {
11383: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11384: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11385: $upload_output.'<br />'."\n";
11386: }
11387: if ($numexisting) {
11388: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11389: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11390: $modify_output.'<br />'."\n";
11391: $buttontext = &mt('Save changes');
11392: }
11393: if ($numunused) {
11394: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11395: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11396: $delete_output.'<br />'."\n";
11397: $buttontext = &mt('Save changes');
11398: }
11399: } else {
11400: $output .= $upload_output.'<br />'."\n";
11401: }
11402: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11403: $counter.'" />'."\n";
11404: if ($actionurl eq '/adm/dependencies') {
11405: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11406: $numnew.'" />'."\n";
11407: } elsif ($actionurl eq '') {
1.987 raeburn 11408: $output .= '<input type="hidden" name="phase" value="three" />';
11409: }
11410: } elsif ($applies) {
11411: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11412: if ($applies > 1) {
11413: $output .=
1.1123 raeburn 11414: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11415: if ($numremref) {
11416: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11417: }
11418: if ($numinvalid) {
11419: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11420: }
11421: if ($numexisting) {
11422: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11423: }
11424: $output .= '</ul><br />';
11425: } elsif ($numremref) {
11426: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11427: } elsif ($numinvalid) {
11428: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11429: } elsif ($numexisting) {
11430: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11431: }
11432: $output .= $upload_output.'<br />';
11433: }
11434: my ($pathchange_output,$chgcount);
1.1071 raeburn 11435: $chgcount = $counter;
1.987 raeburn 11436: if (keys(%pathchanges) > 0) {
11437: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11438: if ($counter) {
1.987 raeburn 11439: $output .= &embedded_file_element('pathchange',$chgcount,
11440: $embed_file,\%mapping,
1.1071 raeburn 11441: $allfiles,$codebase,'change');
1.987 raeburn 11442: } else {
11443: $pathchange_output .=
11444: &start_data_table_row().
11445: '<td><input type ="checkbox" name="namechange" value="'.
11446: $chgcount.'" checked="checked" /></td>'.
11447: '<td>'.$mapping{$embed_file}.'</td>'.
11448: '<td>'.$embed_file.
11449: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11450: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11451: '</td>'.&end_data_table_row();
1.660 raeburn 11452: }
1.987 raeburn 11453: $numpathchg ++;
11454: $chgcount ++;
1.660 raeburn 11455: }
11456: }
1.1127 raeburn 11457: if (($counter) || ($numunused)) {
1.987 raeburn 11458: if ($numpathchg) {
11459: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11460: $numpathchg.'" />'."\n";
11461: }
11462: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11463: ($actionurl eq '/adm/imsimport')) {
11464: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11465: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11466: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11467: } elsif ($actionurl eq '/adm/dependencies') {
11468: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11469: }
1.1123 raeburn 11470: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11471: } elsif ($numpathchg) {
11472: my %pathchange = ();
11473: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11474: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11475: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11476: }
1.987 raeburn 11477: }
1.1071 raeburn 11478: return ($output,$counter,$numpathchg);
1.987 raeburn 11479: }
11480:
1.1147 raeburn 11481: =pod
11482:
11483: =item * clean_path($name)
11484:
11485: Performs clean-up of directories, subdirectories and filename in an
11486: embedded object, referenced in an HTML file which is being uploaded
11487: to a course or portfolio, where
11488: "Upload embedded images/multimedia files if HTML file" checkbox was
11489: checked.
11490:
11491: Clean-up is similar to replacements in lonnet::clean_filename()
11492: except each / between sub-directory and next level is preserved.
11493:
11494: =cut
11495:
11496: sub clean_path {
11497: my ($embed_file) = @_;
11498: $embed_file =~s{^/+}{};
11499: my @contents;
11500: if ($embed_file =~ m{/}) {
11501: @contents = split(/\//,$embed_file);
11502: } else {
11503: @contents = ($embed_file);
11504: }
11505: my $lastidx = scalar(@contents)-1;
11506: for (my $i=0; $i<=$lastidx; $i++) {
11507: $contents[$i]=~s{\\}{/}g;
11508: $contents[$i]=~s/\s+/\_/g;
11509: $contents[$i]=~s{[^/\w\.\-]}{}g;
11510: if ($i == $lastidx) {
11511: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11512: }
11513: }
11514: if ($lastidx > 0) {
11515: return join('/',@contents);
11516: } else {
11517: return $contents[0];
11518: }
11519: }
11520:
1.987 raeburn 11521: sub embedded_file_element {
1.1071 raeburn 11522: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11523: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11524: (ref($codebase) eq 'HASH'));
11525: my $output;
1.1071 raeburn 11526: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11527: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11528: }
11529: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11530: &escape($embed_file).'" />';
11531: unless (($context eq 'upload_embedded') &&
11532: ($mapping->{$embed_file} eq $embed_file)) {
11533: $output .='
11534: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11535: }
11536: my $attrib;
11537: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11538: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11539: }
11540: $output .=
11541: "\n\t\t".
11542: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11543: $attrib.'" />';
11544: if (exists($codebase->{$mapping->{$embed_file}})) {
11545: $output .=
11546: "\n\t\t".
11547: '<input name="codebase_'.$num.'" type="hidden" value="'.
11548: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11549: }
1.987 raeburn 11550: return $output;
1.660 raeburn 11551: }
11552:
1.1071 raeburn 11553: sub get_dependency_details {
11554: my ($currfile,$currsubfile,$embed_file) = @_;
11555: my ($size,$mtime,$showsize,$showmtime);
11556: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11557: if ($embed_file =~ m{/}) {
11558: my ($path,$fname) = split(/\//,$embed_file);
11559: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11560: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11561: }
11562: } else {
11563: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11564: ($size,$mtime) = @{$currfile->{$embed_file}};
11565: }
11566: }
11567: $showsize = $size/1024.0;
11568: $showsize = sprintf("%.1f",$showsize);
11569: if ($mtime > 0) {
11570: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11571: }
11572: }
11573: return ($showsize,$showmtime);
11574: }
11575:
11576: sub ask_embedded_js {
11577: return <<"END";
11578: <script type="text/javascript"">
11579: // <![CDATA[
11580: function toggleBrowse(counter) {
11581: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11582: var fileid = document.getElementById('embedded_item_'+counter);
11583: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11584: if (chkboxid.checked == true) {
11585: uploaddivid.style.display='block';
11586: } else {
11587: uploaddivid.style.display='none';
11588: fileid.value = '';
11589: }
11590: }
11591: // ]]>
11592: </script>
11593:
11594: END
11595: }
11596:
1.661 raeburn 11597: sub upload_embedded {
11598: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11599: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11600: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11601: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11602: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11603: my $orig_uploaded_filename =
11604: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11605: foreach my $type ('orig','ref','attrib','codebase') {
11606: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11607: $env{'form.embedded_'.$type.'_'.$i} =
11608: &unescape($env{'form.embedded_'.$type.'_'.$i});
11609: }
11610: }
1.661 raeburn 11611: my ($path,$fname) =
11612: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11613: # no path, whole string is fname
11614: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11615: $fname = &Apache::lonnet::clean_filename($fname);
11616: # See if there is anything left
11617: next if ($fname eq '');
11618:
11619: # Check if file already exists as a file or directory.
11620: my ($state,$msg);
11621: if ($context eq 'portfolio') {
11622: my $port_path = $dirpath;
11623: if ($group ne '') {
11624: $port_path = "groups/$group/$port_path";
11625: }
1.987 raeburn 11626: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11627: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11628: $dir_root,$port_path,$disk_quota,
11629: $current_disk_usage,$uname,$udom);
11630: if ($state eq 'will_exceed_quota'
1.984 raeburn 11631: || $state eq 'file_locked') {
1.661 raeburn 11632: $output .= $msg;
11633: next;
11634: }
11635: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11636: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11637: if ($state eq 'exists') {
11638: $output .= $msg;
11639: next;
11640: }
11641: }
11642: # Check if extension is valid
11643: if (($fname =~ /\.(\w+)$/) &&
11644: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 11645: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11646: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11647: next;
11648: } elsif (($fname =~ /\.(\w+)$/) &&
11649: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11650: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11651: next;
11652: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 11653: $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 11654: next;
11655: }
11656: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 11657: my $subdir = $path;
11658: $subdir =~ s{/+$}{};
1.661 raeburn 11659: if ($context eq 'portfolio') {
1.984 raeburn 11660: my $result;
11661: if ($state eq 'existingfile') {
11662: $result=
11663: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 11664: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11665: } else {
1.984 raeburn 11666: $result=
11667: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11668: $dirpath.
1.1123 raeburn 11669: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11670: if ($result !~ m|^/uploaded/|) {
11671: $output .= '<span class="LC_error">'
11672: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11673: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11674: .'</span><br />';
11675: next;
11676: } else {
1.987 raeburn 11677: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11678: $path.$fname.'</span>').'<br />';
1.984 raeburn 11679: }
1.661 raeburn 11680: }
1.1123 raeburn 11681: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 11682: my $extendedsubdir = $dirpath.'/'.$subdir;
11683: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11684: my $result =
1.1126 raeburn 11685: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11686: if ($result !~ m|^/uploaded/|) {
11687: $output .= '<span class="LC_error">'
11688: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11689: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11690: .'</span><br />';
11691: next;
11692: } else {
11693: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11694: $path.$fname.'</span>').'<br />';
1.1125 raeburn 11695: if ($context eq 'syllabus') {
11696: &Apache::lonnet::make_public_indefinitely($result);
11697: }
1.987 raeburn 11698: }
1.661 raeburn 11699: } else {
11700: # Save the file
11701: my $target = $env{'form.embedded_item_'.$i};
11702: my $fullpath = $dir_root.$dirpath.'/'.$path;
11703: my $dest = $fullpath.$fname;
11704: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11705: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11706: my $count;
11707: my $filepath = $dir_root;
1.1027 raeburn 11708: foreach my $subdir (@parts) {
11709: $filepath .= "/$subdir";
11710: if (!-e $filepath) {
1.661 raeburn 11711: mkdir($filepath,0770);
11712: }
11713: }
11714: my $fh;
11715: if (!open($fh,'>'.$dest)) {
11716: &Apache::lonnet::logthis('Failed to create '.$dest);
11717: $output .= '<span class="LC_error">'.
1.1071 raeburn 11718: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11719: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11720: '</span><br />';
11721: } else {
11722: if (!print $fh $env{'form.embedded_item_'.$i}) {
11723: &Apache::lonnet::logthis('Failed to write to '.$dest);
11724: $output .= '<span class="LC_error">'.
1.1071 raeburn 11725: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11726: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11727: '</span><br />';
11728: } else {
1.987 raeburn 11729: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11730: $url.'</span>').'<br />';
11731: unless ($context eq 'testbank') {
11732: $footer .= &mt('View embedded file: [_1]',
11733: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11734: }
11735: }
11736: close($fh);
11737: }
11738: }
11739: if ($env{'form.embedded_ref_'.$i}) {
11740: $pathchange{$i} = 1;
11741: }
11742: }
11743: if ($output) {
11744: $output = '<p>'.$output.'</p>';
11745: }
11746: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11747: $returnflag = 'ok';
1.1071 raeburn 11748: my $numpathchgs = scalar(keys(%pathchange));
11749: if ($numpathchgs > 0) {
1.987 raeburn 11750: if ($context eq 'portfolio') {
11751: $output .= '<p>'.&mt('or').'</p>';
11752: } elsif ($context eq 'testbank') {
1.1071 raeburn 11753: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11754: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11755: $returnflag = 'modify_orightml';
11756: }
11757: }
1.1071 raeburn 11758: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11759: }
11760:
11761: sub modify_html_form {
11762: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11763: my $end = 0;
11764: my $modifyform;
11765: if ($context eq 'upload_embedded') {
11766: return unless (ref($pathchange) eq 'HASH');
11767: if ($env{'form.number_embedded_items'}) {
11768: $end += $env{'form.number_embedded_items'};
11769: }
11770: if ($env{'form.number_pathchange_items'}) {
11771: $end += $env{'form.number_pathchange_items'};
11772: }
11773: if ($end) {
11774: for (my $i=0; $i<$end; $i++) {
11775: if ($i < $env{'form.number_embedded_items'}) {
11776: next unless($pathchange->{$i});
11777: }
11778: $modifyform .=
11779: &start_data_table_row().
11780: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11781: 'checked="checked" /></td>'.
11782: '<td>'.$env{'form.embedded_ref_'.$i}.
11783: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11784: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11785: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11786: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11787: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11788: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11789: '<td>'.$env{'form.embedded_orig_'.$i}.
11790: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11791: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11792: &end_data_table_row();
1.1071 raeburn 11793: }
1.987 raeburn 11794: }
11795: } else {
11796: $modifyform = $pathchgtable;
11797: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11798: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11799: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11800: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11801: }
11802: }
11803: if ($modifyform) {
1.1071 raeburn 11804: if ($actionurl eq '/adm/dependencies') {
11805: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11806: }
1.987 raeburn 11807: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11808: '<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".
11809: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11810: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11811: '</ol></p>'."\n".'<p>'.
11812: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11813: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11814: &start_data_table()."\n".
11815: &start_data_table_header_row().
11816: '<th>'.&mt('Change?').'</th>'.
11817: '<th>'.&mt('Current reference').'</th>'.
11818: '<th>'.&mt('Required reference').'</th>'.
11819: &end_data_table_header_row()."\n".
11820: $modifyform.
11821: &end_data_table().'<br />'."\n".$hiddenstate.
11822: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11823: '</form>'."\n";
11824: }
11825: return;
11826: }
11827:
11828: sub modify_html_refs {
1.1123 raeburn 11829: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11830: my $container;
11831: if ($context eq 'portfolio') {
11832: $container = $env{'form.container'};
11833: } elsif ($context eq 'coursedoc') {
11834: $container = $env{'form.primaryurl'};
1.1071 raeburn 11835: } elsif ($context eq 'manage_dependencies') {
11836: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11837: $container = "/$container";
1.1123 raeburn 11838: } elsif ($context eq 'syllabus') {
11839: $container = $url;
1.987 raeburn 11840: } else {
1.1027 raeburn 11841: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11842: }
11843: my (%allfiles,%codebase,$output,$content);
11844: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 11845: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11846: if (wantarray) {
11847: return ('',0,0);
11848: } else {
11849: return;
11850: }
11851: }
11852: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11853: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11854: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11855: if (wantarray) {
11856: return ('',0,0);
11857: } else {
11858: return;
11859: }
11860: }
1.987 raeburn 11861: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11862: if ($content eq '-1') {
11863: if (wantarray) {
11864: return ('',0,0);
11865: } else {
11866: return;
11867: }
11868: }
1.987 raeburn 11869: } else {
1.1071 raeburn 11870: unless ($container =~ /^\Q$dir_root\E/) {
11871: if (wantarray) {
11872: return ('',0,0);
11873: } else {
11874: return;
11875: }
11876: }
1.987 raeburn 11877: if (open(my $fh,"<$container")) {
11878: $content = join('', <$fh>);
11879: close($fh);
11880: } else {
1.1071 raeburn 11881: if (wantarray) {
11882: return ('',0,0);
11883: } else {
11884: return;
11885: }
1.987 raeburn 11886: }
11887: }
11888: my ($count,$codebasecount) = (0,0);
11889: my $mm = new File::MMagic;
11890: my $mime_type = $mm->checktype_contents($content);
11891: if ($mime_type eq 'text/html') {
11892: my $parse_result =
11893: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11894: \%codebase,\$content);
11895: if ($parse_result eq 'ok') {
11896: foreach my $i (@changes) {
11897: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11898: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11899: if ($allfiles{$ref}) {
11900: my $newname = $orig;
11901: my ($attrib_regexp,$codebase);
1.1006 raeburn 11902: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11903: if ($attrib_regexp =~ /:/) {
11904: $attrib_regexp =~ s/\:/|/g;
11905: }
11906: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11907: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11908: $count += $numchg;
1.1123 raeburn 11909: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 11910: delete($allfiles{$ref});
1.987 raeburn 11911: }
11912: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11913: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11914: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11915: $codebasecount ++;
11916: }
11917: }
11918: }
1.1123 raeburn 11919: my $skiprewrites;
1.987 raeburn 11920: if ($count || $codebasecount) {
11921: my $saveresult;
1.1071 raeburn 11922: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 11923: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11924: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11925: if ($url eq $container) {
11926: my ($fname) = ($container =~ m{/([^/]+)$});
11927: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11928: $count,'<span class="LC_filename">'.
1.1071 raeburn 11929: $fname.'</span>').'</p>';
1.987 raeburn 11930: } else {
11931: $output = '<p class="LC_error">'.
11932: &mt('Error: update failed for: [_1].',
11933: '<span class="LC_filename">'.
11934: $container.'</span>').'</p>';
11935: }
1.1123 raeburn 11936: if ($context eq 'syllabus') {
11937: unless ($saveresult eq 'ok') {
11938: $skiprewrites = 1;
11939: }
11940: }
1.987 raeburn 11941: } else {
11942: if (open(my $fh,">$container")) {
11943: print $fh $content;
11944: close($fh);
11945: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11946: $count,'<span class="LC_filename">'.
11947: $container.'</span>').'</p>';
1.661 raeburn 11948: } else {
1.987 raeburn 11949: $output = '<p class="LC_error">'.
11950: &mt('Error: could not update [_1].',
11951: '<span class="LC_filename">'.
11952: $container.'</span>').'</p>';
1.661 raeburn 11953: }
11954: }
11955: }
1.1123 raeburn 11956: if (($context eq 'syllabus') && (!$skiprewrites)) {
11957: my ($actionurl,$state);
11958: $actionurl = "/public/$udom/$uname/syllabus";
11959: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11960: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11961: \%codebase,
11962: {'context' => 'rewrites',
11963: 'ignore_remote_references' => 1,});
11964: if (ref($mapping) eq 'HASH') {
11965: my $rewrites = 0;
11966: foreach my $key (keys(%{$mapping})) {
11967: next if ($key =~ m{^https?://});
11968: my $ref = $mapping->{$key};
11969: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11970: my $attrib;
11971: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11972: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11973: }
11974: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11975: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11976: $rewrites += $numchg;
11977: }
11978: }
11979: if ($rewrites) {
11980: my $saveresult;
11981: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11982: if ($url eq $container) {
11983: my ($fname) = ($container =~ m{/([^/]+)$});
11984: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11985: $count,'<span class="LC_filename">'.
11986: $fname.'</span>').'</p>';
11987: } else {
11988: $output .= '<p class="LC_error">'.
11989: &mt('Error: could not update links in [_1].',
11990: '<span class="LC_filename">'.
11991: $container.'</span>').'</p>';
11992:
11993: }
11994: }
11995: }
11996: }
1.987 raeburn 11997: } else {
11998: &logthis('Failed to parse '.$container.
11999: ' to modify references: '.$parse_result);
1.661 raeburn 12000: }
12001: }
1.1071 raeburn 12002: if (wantarray) {
12003: return ($output,$count,$codebasecount);
12004: } else {
12005: return $output;
12006: }
1.661 raeburn 12007: }
12008:
12009: sub check_for_existing {
12010: my ($path,$fname,$element) = @_;
12011: my ($state,$msg);
12012: if (-d $path.'/'.$fname) {
12013: $state = 'exists';
12014: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12015: } elsif (-e $path.'/'.$fname) {
12016: $state = 'exists';
12017: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12018: }
12019: if ($state eq 'exists') {
12020: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12021: }
12022: return ($state,$msg);
12023: }
12024:
12025: sub check_for_upload {
12026: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12027: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12028: my $filesize = length($env{'form.'.$element});
12029: if (!$filesize) {
12030: my $msg = '<span class="LC_error">'.
12031: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12032: '<span class="LC_filename">'.$fname.'</span>',
12033: $filesize).'<br />'.
1.1007 raeburn 12034: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12035: '</span>';
12036: return ('zero_bytes',$msg);
12037: }
12038: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12039: my $getpropath = 1;
1.1021 raeburn 12040: my ($dirlistref,$listerror) =
12041: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12042: my $found_file = 0;
12043: my $locked_file = 0;
1.991 raeburn 12044: my @lockers;
12045: my $navmap;
12046: if ($env{'request.course.id'}) {
12047: $navmap = Apache::lonnavmaps::navmap->new();
12048: }
1.1021 raeburn 12049: if (ref($dirlistref) eq 'ARRAY') {
12050: foreach my $line (@{$dirlistref}) {
12051: my ($file_name,$rest)=split(/\&/,$line,2);
12052: if ($file_name eq $fname){
12053: $file_name = $path.$file_name;
12054: if ($group ne '') {
12055: $file_name = $group.$file_name;
12056: }
12057: $found_file = 1;
12058: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12059: foreach my $lock (@lockers) {
12060: if (ref($lock) eq 'ARRAY') {
12061: my ($symb,$crsid) = @{$lock};
12062: if ($crsid eq $env{'request.course.id'}) {
12063: if (ref($navmap)) {
12064: my $res = $navmap->getBySymb($symb);
12065: foreach my $part (@{$res->parts()}) {
12066: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12067: unless (($slot_status == $res->RESERVED) ||
12068: ($slot_status == $res->RESERVED_LOCATION)) {
12069: $locked_file = 1;
12070: }
1.991 raeburn 12071: }
1.1021 raeburn 12072: } else {
12073: $locked_file = 1;
1.991 raeburn 12074: }
12075: } else {
12076: $locked_file = 1;
12077: }
12078: }
1.1021 raeburn 12079: }
12080: } else {
12081: my @info = split(/\&/,$rest);
12082: my $currsize = $info[6]/1000;
12083: if ($currsize < $filesize) {
12084: my $extra = $filesize - $currsize;
12085: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12086: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12087: &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 12088: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12089: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12090: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12091: return ('will_exceed_quota',$msg);
12092: }
1.984 raeburn 12093: }
12094: }
1.661 raeburn 12095: }
12096: }
12097: }
12098: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12099: my $msg = '<p class="LC_warning">'.
12100: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12101: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12102: return ('will_exceed_quota',$msg);
12103: } elsif ($found_file) {
12104: if ($locked_file) {
1.1179 bisitz 12105: my $msg = '<p class="LC_warning">';
1.661 raeburn 12106: $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 12107: $msg .= '</p>';
1.661 raeburn 12108: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12109: return ('file_locked',$msg);
12110: } else {
1.1179 bisitz 12111: my $msg = '<p class="LC_error">';
1.984 raeburn 12112: $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 12113: $msg .= '</p>';
1.984 raeburn 12114: return ('existingfile',$msg);
1.661 raeburn 12115: }
12116: }
12117: }
12118:
1.987 raeburn 12119: sub check_for_traversal {
12120: my ($path,$url,$toplevel) = @_;
12121: my @parts=split(/\//,$path);
12122: my $cleanpath;
12123: my $fullpath = $url;
12124: for (my $i=0;$i<@parts;$i++) {
12125: next if ($parts[$i] eq '.');
12126: if ($parts[$i] eq '..') {
12127: $fullpath =~ s{([^/]+/)$}{};
12128: } else {
12129: $fullpath .= $parts[$i].'/';
12130: }
12131: }
12132: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12133: $cleanpath = $1;
12134: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12135: my $curr_toprel = $1;
12136: my @parts = split(/\//,$curr_toprel);
12137: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12138: my @urlparts = split(/\//,$url_toprel);
12139: my $doubledots;
12140: my $startdiff = -1;
12141: for (my $i=0; $i<@urlparts; $i++) {
12142: if ($startdiff == -1) {
12143: unless ($urlparts[$i] eq $parts[$i]) {
12144: $startdiff = $i;
12145: $doubledots .= '../';
12146: }
12147: } else {
12148: $doubledots .= '../';
12149: }
12150: }
12151: if ($startdiff > -1) {
12152: $cleanpath = $doubledots;
12153: for (my $i=$startdiff; $i<@parts; $i++) {
12154: $cleanpath .= $parts[$i].'/';
12155: }
12156: }
12157: }
12158: $cleanpath =~ s{(/)$}{};
12159: return $cleanpath;
12160: }
1.31 albertel 12161:
1.1053 raeburn 12162: sub is_archive_file {
12163: my ($mimetype) = @_;
12164: if (($mimetype eq 'application/octet-stream') ||
12165: ($mimetype eq 'application/x-stuffit') ||
12166: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12167: return 1;
12168: }
12169: return;
12170: }
12171:
12172: sub decompress_form {
1.1065 raeburn 12173: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12174: my %lt = &Apache::lonlocal::texthash (
12175: this => 'This file is an archive file.',
1.1067 raeburn 12176: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12177: itsc => 'Its contents are as follows:',
1.1053 raeburn 12178: youm => 'You may wish to extract its contents.',
12179: extr => 'Extract contents',
1.1067 raeburn 12180: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12181: proa => 'Process automatically?',
1.1053 raeburn 12182: yes => 'Yes',
12183: no => 'No',
1.1067 raeburn 12184: fold => 'Title for folder containing movie',
12185: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12186: );
1.1065 raeburn 12187: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12188: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12189: my $info = &list_archive_contents($fileloc,\@paths);
12190: if (@paths) {
12191: foreach my $path (@paths) {
12192: $path =~ s{^/}{};
1.1067 raeburn 12193: if ($path =~ m{^([^/]+)/$}) {
12194: $topdir = $1;
12195: }
1.1065 raeburn 12196: if ($path =~ m{^([^/]+)/}) {
12197: $toplevel{$1} = $path;
12198: } else {
12199: $toplevel{$path} = $path;
12200: }
12201: }
12202: }
1.1067 raeburn 12203: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12204: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12205: "$topdir/media/",
12206: "$topdir/media/$topdir.mp4",
12207: "$topdir/media/FirstFrame.png",
12208: "$topdir/media/player.swf",
12209: "$topdir/media/swfobject.js",
12210: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12211: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12212: "$topdir/$topdir.mp4",
12213: "$topdir/$topdir\_config.xml",
12214: "$topdir/$topdir\_controller.swf",
12215: "$topdir/$topdir\_embed.css",
12216: "$topdir/$topdir\_First_Frame.png",
12217: "$topdir/$topdir\_player.html",
12218: "$topdir/$topdir\_Thumbnails.png",
12219: "$topdir/playerProductInstall.swf",
12220: "$topdir/scripts/",
12221: "$topdir/scripts/config_xml.js",
12222: "$topdir/scripts/handlebars.js",
12223: "$topdir/scripts/jquery-1.7.1.min.js",
12224: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12225: "$topdir/scripts/modernizr.js",
12226: "$topdir/scripts/player-min.js",
12227: "$topdir/scripts/swfobject.js",
12228: "$topdir/skins/",
12229: "$topdir/skins/configuration_express.xml",
12230: "$topdir/skins/express_show/",
12231: "$topdir/skins/express_show/player-min.css",
12232: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12233: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12234: "$topdir/$topdir.mp4",
12235: "$topdir/$topdir\_config.xml",
12236: "$topdir/$topdir\_controller.swf",
12237: "$topdir/$topdir\_embed.css",
12238: "$topdir/$topdir\_First_Frame.png",
12239: "$topdir/$topdir\_player.html",
12240: "$topdir/$topdir\_Thumbnails.png",
12241: "$topdir/playerProductInstall.swf",
12242: "$topdir/scripts/",
12243: "$topdir/scripts/config_xml.js",
12244: "$topdir/scripts/techsmith-smart-player.min.js",
12245: "$topdir/skins/",
12246: "$topdir/skins/configuration_express.xml",
12247: "$topdir/skins/express_show/",
12248: "$topdir/skins/express_show/spritesheet.min.css",
12249: "$topdir/skins/express_show/spritesheet.png",
12250: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12251: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12252: if (@diffs == 0) {
1.1164 raeburn 12253: $is_camtasia = 6;
12254: } else {
1.1197 raeburn 12255: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12256: if (@diffs == 0) {
12257: $is_camtasia = 8;
1.1197 raeburn 12258: } else {
12259: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12260: if (@diffs == 0) {
12261: $is_camtasia = 8;
12262: }
1.1164 raeburn 12263: }
1.1067 raeburn 12264: }
12265: }
12266: my $output;
12267: if ($is_camtasia) {
12268: $output = <<"ENDCAM";
12269: <script type="text/javascript" language="Javascript">
12270: // <![CDATA[
12271:
12272: function camtasiaToggle() {
12273: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12274: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12275: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12276: document.getElementById('camtasia_titles').style.display='block';
12277: } else {
12278: document.getElementById('camtasia_titles').style.display='none';
12279: }
12280: }
12281: }
12282: return;
12283: }
12284:
12285: // ]]>
12286: </script>
12287: <p>$lt{'camt'}</p>
12288: ENDCAM
1.1065 raeburn 12289: } else {
1.1067 raeburn 12290: $output = '<p>'.$lt{'this'};
12291: if ($info eq '') {
12292: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12293: } else {
12294: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12295: '<div><pre>'.$info.'</pre></div>';
12296: }
1.1065 raeburn 12297: }
1.1067 raeburn 12298: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12299: my $duplicates;
12300: my $num = 0;
12301: if (ref($dirlist) eq 'ARRAY') {
12302: foreach my $item (@{$dirlist}) {
12303: if (ref($item) eq 'ARRAY') {
12304: if (exists($toplevel{$item->[0]})) {
12305: $duplicates .=
12306: &start_data_table_row().
12307: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12308: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12309: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12310: 'value="1" />'.&mt('Yes').'</label>'.
12311: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12312: '<td>'.$item->[0].'</td>';
12313: if ($item->[2]) {
12314: $duplicates .= '<td>'.&mt('Directory').'</td>';
12315: } else {
12316: $duplicates .= '<td>'.&mt('File').'</td>';
12317: }
12318: $duplicates .= '<td>'.$item->[3].'</td>'.
12319: '<td>'.
12320: &Apache::lonlocal::locallocaltime($item->[4]).
12321: '</td>'.
12322: &end_data_table_row();
12323: $num ++;
12324: }
12325: }
12326: }
12327: }
12328: my $itemcount;
12329: if (@paths > 0) {
12330: $itemcount = scalar(@paths);
12331: } else {
12332: $itemcount = 1;
12333: }
1.1067 raeburn 12334: if ($is_camtasia) {
12335: $output .= $lt{'auto'}.'<br />'.
12336: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12337: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12338: $lt{'yes'}.'</label> <label>'.
12339: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12340: $lt{'no'}.'</label></span><br />'.
12341: '<div id="camtasia_titles" style="display:block">'.
12342: &Apache::lonhtmlcommon::start_pick_box().
12343: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12344: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12345: &Apache::lonhtmlcommon::row_closure().
12346: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12347: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12348: &Apache::lonhtmlcommon::row_closure(1).
12349: &Apache::lonhtmlcommon::end_pick_box().
12350: '</div>';
12351: }
1.1065 raeburn 12352: $output .=
12353: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12354: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12355: "\n";
1.1065 raeburn 12356: if ($duplicates ne '') {
12357: $output .= '<p><span class="LC_warning">'.
12358: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12359: &start_data_table().
12360: &start_data_table_header_row().
12361: '<th>'.&mt('Overwrite?').'</th>'.
12362: '<th>'.&mt('Name').'</th>'.
12363: '<th>'.&mt('Type').'</th>'.
12364: '<th>'.&mt('Size').'</th>'.
12365: '<th>'.&mt('Last modified').'</th>'.
12366: &end_data_table_header_row().
12367: $duplicates.
12368: &end_data_table().
12369: '</p>';
12370: }
1.1067 raeburn 12371: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12372: if (ref($hiddenelements) eq 'HASH') {
12373: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12374: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12375: }
12376: }
12377: $output .= <<"END";
1.1067 raeburn 12378: <br />
1.1053 raeburn 12379: <input type="submit" name="decompress" value="$lt{'extr'}" />
12380: </form>
12381: $noextract
12382: END
12383: return $output;
12384: }
12385:
1.1065 raeburn 12386: sub decompression_utility {
12387: my ($program) = @_;
12388: my @utilities = ('tar','gunzip','bunzip2','unzip');
12389: my $location;
12390: if (grep(/^\Q$program\E$/,@utilities)) {
12391: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12392: '/usr/sbin/') {
12393: if (-x $dir.$program) {
12394: $location = $dir.$program;
12395: last;
12396: }
12397: }
12398: }
12399: return $location;
12400: }
12401:
12402: sub list_archive_contents {
12403: my ($file,$pathsref) = @_;
12404: my (@cmd,$output);
12405: my $needsregexp;
12406: if ($file =~ /\.zip$/) {
12407: @cmd = (&decompression_utility('unzip'),"-l");
12408: $needsregexp = 1;
12409: } elsif (($file =~ m/\.tar\.gz$/) ||
12410: ($file =~ /\.tgz$/)) {
12411: @cmd = (&decompression_utility('tar'),"-ztf");
12412: } elsif ($file =~ /\.tar\.bz2$/) {
12413: @cmd = (&decompression_utility('tar'),"-jtf");
12414: } elsif ($file =~ m|\.tar$|) {
12415: @cmd = (&decompression_utility('tar'),"-tf");
12416: }
12417: if (@cmd) {
12418: undef($!);
12419: undef($@);
12420: if (open(my $fh,"-|", @cmd, $file)) {
12421: while (my $line = <$fh>) {
12422: $output .= $line;
12423: chomp($line);
12424: my $item;
12425: if ($needsregexp) {
12426: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12427: } else {
12428: $item = $line;
12429: }
12430: if ($item ne '') {
12431: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12432: push(@{$pathsref},$item);
12433: }
12434: }
12435: }
12436: close($fh);
12437: }
12438: }
12439: return $output;
12440: }
12441:
1.1053 raeburn 12442: sub decompress_uploaded_file {
12443: my ($file,$dir) = @_;
12444: &Apache::lonnet::appenv({'cgi.file' => $file});
12445: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12446: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12447: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12448: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12449: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12450: my $decompressed = $env{'cgi.decompressed'};
12451: &Apache::lonnet::delenv('cgi.file');
12452: &Apache::lonnet::delenv('cgi.dir');
12453: &Apache::lonnet::delenv('cgi.decompressed');
12454: return ($decompressed,$result);
12455: }
12456:
1.1055 raeburn 12457: sub process_decompression {
12458: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
12459: my ($dir,$error,$warning,$output);
1.1180 raeburn 12460: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12461: $error = &mt('Filename not a supported archive file type.').
12462: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12463: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12464: } else {
12465: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12466: if ($docuhome eq 'no_host') {
12467: $error = &mt('Could not determine home server for course.');
12468: } else {
12469: my @ids=&Apache::lonnet::current_machine_ids();
12470: my $currdir = "$dir_root/$destination";
12471: if (grep(/^\Q$docuhome\E$/,@ids)) {
12472: $dir = &LONCAPA::propath($docudom,$docuname).
12473: "$dir_root/$destination";
12474: } else {
12475: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12476: "$dir_root/$docudom/$docuname/$destination";
12477: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12478: $error = &mt('Archive file not found.');
12479: }
12480: }
1.1065 raeburn 12481: my (@to_overwrite,@to_skip);
12482: if ($env{'form.archive_overwrite_total'} > 0) {
12483: my $total = $env{'form.archive_overwrite_total'};
12484: for (my $i=0; $i<$total; $i++) {
12485: if ($env{'form.archive_overwrite_'.$i} == 1) {
12486: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12487: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12488: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12489: }
12490: }
12491: }
12492: my $numskip = scalar(@to_skip);
12493: if (($numskip > 0) &&
12494: ($numskip == $env{'form.archive_itemcount'})) {
12495: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12496: } elsif ($dir eq '') {
1.1055 raeburn 12497: $error = &mt('Directory containing archive file unavailable.');
12498: } elsif (!$error) {
1.1065 raeburn 12499: my ($decompressed,$display);
12500: if ($numskip > 0) {
12501: my $tempdir = time.'_'.$$.int(rand(10000));
12502: mkdir("$dir/$tempdir",0755);
12503: system("mv $dir/$file $dir/$tempdir/$file");
12504: ($decompressed,$display) =
12505: &decompress_uploaded_file($file,"$dir/$tempdir");
12506: foreach my $item (@to_skip) {
12507: if (($item ne '') && ($item !~ /\.\./)) {
12508: if (-f "$dir/$tempdir/$item") {
12509: unlink("$dir/$tempdir/$item");
12510: } elsif (-d "$dir/$tempdir/$item") {
12511: system("rm -rf $dir/$tempdir/$item");
12512: }
12513: }
12514: }
12515: system("mv $dir/$tempdir/* $dir");
12516: rmdir("$dir/$tempdir");
12517: } else {
12518: ($decompressed,$display) =
12519: &decompress_uploaded_file($file,$dir);
12520: }
1.1055 raeburn 12521: if ($decompressed eq 'ok') {
1.1065 raeburn 12522: $output = '<p class="LC_info">'.
12523: &mt('Files extracted successfully from archive.').
12524: '</p>'."\n";
1.1055 raeburn 12525: my ($warning,$result,@contents);
12526: my ($newdirlistref,$newlisterror) =
12527: &Apache::lonnet::dirlist($currdir,$docudom,
12528: $docuname,1);
12529: my (%is_dir,%changes,@newitems);
12530: my $dirptr = 16384;
1.1065 raeburn 12531: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12532: foreach my $dir_line (@{$newdirlistref}) {
12533: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 12534: unless (($item =~ /^\.+$/) || ($item eq $file) ||
12535: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 12536: push(@newitems,$item);
12537: if ($dirptr&$testdir) {
12538: $is_dir{$item} = 1;
12539: }
12540: $changes{$item} = 1;
12541: }
12542: }
12543: }
12544: if (keys(%changes) > 0) {
12545: foreach my $item (sort(@newitems)) {
12546: if ($changes{$item}) {
12547: push(@contents,$item);
12548: }
12549: }
12550: }
12551: if (@contents > 0) {
1.1067 raeburn 12552: my $wantform;
12553: unless ($env{'form.autoextract_camtasia'}) {
12554: $wantform = 1;
12555: }
1.1056 raeburn 12556: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12557: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12558: $currdir,\%is_dir,
12559: \%children,\%parent,
1.1056 raeburn 12560: \@contents,\%dirorder,
12561: \%titles,$wantform);
1.1055 raeburn 12562: if ($datatable ne '') {
12563: $output .= &archive_options_form('decompressed',$datatable,
12564: $count,$hiddenelem);
1.1065 raeburn 12565: my $startcount = 6;
1.1055 raeburn 12566: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12567: \%titles,\%children);
1.1055 raeburn 12568: }
1.1067 raeburn 12569: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 12570: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12571: my %displayed;
12572: my $total = 1;
12573: $env{'form.archive_directory'} = [];
12574: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12575: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12576: $path =~ s{/$}{};
12577: my $item;
12578: if ($path ne '') {
12579: $item = "$path/$titles{$i}";
12580: } else {
12581: $item = $titles{$i};
12582: }
12583: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12584: if ($item eq $contents[0]) {
12585: push(@{$env{'form.archive_directory'}},$i);
12586: $env{'form.archive_'.$i} = 'display';
12587: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12588: $displayed{'folder'} = $i;
1.1164 raeburn 12589: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12590: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12591: $env{'form.archive_'.$i} = 'display';
12592: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12593: $displayed{'web'} = $i;
12594: } else {
1.1164 raeburn 12595: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12596: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12597: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12598: push(@{$env{'form.archive_directory'}},$i);
12599: }
12600: $env{'form.archive_'.$i} = 'dependency';
12601: }
12602: $total ++;
12603: }
12604: for (my $i=1; $i<$total; $i++) {
12605: next if ($i == $displayed{'web'});
12606: next if ($i == $displayed{'folder'});
12607: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12608: }
12609: $env{'form.phase'} = 'decompress_cleanup';
12610: $env{'form.archivedelete'} = 1;
12611: $env{'form.archive_count'} = $total-1;
12612: $output .=
12613: &process_extracted_files('coursedocs',$docudom,
12614: $docuname,$destination,
12615: $dir_root,$hiddenelem);
12616: }
1.1055 raeburn 12617: } else {
12618: $warning = &mt('No new items extracted from archive file.');
12619: }
12620: } else {
12621: $output = $display;
12622: $error = &mt('An error occurred during extraction from the archive file.');
12623: }
12624: }
12625: }
12626: }
12627: if ($error) {
12628: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12629: $error.'</p>'."\n";
12630: }
12631: if ($warning) {
12632: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12633: }
12634: return $output;
12635: }
12636:
12637: sub get_extracted {
1.1056 raeburn 12638: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12639: $titles,$wantform) = @_;
1.1055 raeburn 12640: my $count = 0;
12641: my $depth = 0;
12642: my $datatable;
1.1056 raeburn 12643: my @hierarchy;
1.1055 raeburn 12644: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12645: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12646: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12647: foreach my $item (@{$contents}) {
12648: $count ++;
1.1056 raeburn 12649: @{$dirorder->{$count}} = @hierarchy;
12650: $titles->{$count} = $item;
1.1055 raeburn 12651: &archive_hierarchy($depth,$count,$parent,$children);
12652: if ($wantform) {
12653: $datatable .= &archive_row($is_dir->{$item},$item,
12654: $currdir,$depth,$count);
12655: }
12656: if ($is_dir->{$item}) {
12657: $depth ++;
1.1056 raeburn 12658: push(@hierarchy,$count);
12659: $parent->{$depth} = $count;
1.1055 raeburn 12660: $datatable .=
12661: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12662: \$depth,\$count,\@hierarchy,$dirorder,
12663: $children,$parent,$titles,$wantform);
1.1055 raeburn 12664: $depth --;
1.1056 raeburn 12665: pop(@hierarchy);
1.1055 raeburn 12666: }
12667: }
12668: return ($count,$datatable);
12669: }
12670:
12671: sub recurse_extracted_archive {
1.1056 raeburn 12672: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12673: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12674: my $result='';
1.1056 raeburn 12675: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12676: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12677: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12678: return $result;
12679: }
12680: my $dirptr = 16384;
12681: my ($newdirlistref,$newlisterror) =
12682: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12683: if (ref($newdirlistref) eq 'ARRAY') {
12684: foreach my $dir_line (@{$newdirlistref}) {
12685: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12686: unless ($item =~ /^\.+$/) {
12687: $$count ++;
1.1056 raeburn 12688: @{$dirorder->{$$count}} = @{$hierarchy};
12689: $titles->{$$count} = $item;
1.1055 raeburn 12690: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12691:
1.1055 raeburn 12692: my $is_dir;
12693: if ($dirptr&$testdir) {
12694: $is_dir = 1;
12695: }
12696: if ($wantform) {
12697: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12698: }
12699: if ($is_dir) {
12700: $$depth ++;
1.1056 raeburn 12701: push(@{$hierarchy},$$count);
12702: $parent->{$$depth} = $$count;
1.1055 raeburn 12703: $result .=
12704: &recurse_extracted_archive("$currdir/$item",$docudom,
12705: $docuname,$depth,$count,
1.1056 raeburn 12706: $hierarchy,$dirorder,$children,
12707: $parent,$titles,$wantform);
1.1055 raeburn 12708: $$depth --;
1.1056 raeburn 12709: pop(@{$hierarchy});
1.1055 raeburn 12710: }
12711: }
12712: }
12713: }
12714: return $result;
12715: }
12716:
12717: sub archive_hierarchy {
12718: my ($depth,$count,$parent,$children) =@_;
12719: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12720: if (exists($parent->{$depth})) {
12721: $children->{$parent->{$depth}} .= $count.':';
12722: }
12723: }
12724: return;
12725: }
12726:
12727: sub archive_row {
12728: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12729: my ($name) = ($item =~ m{([^/]+)$});
12730: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12731: 'display' => 'Add as file',
1.1055 raeburn 12732: 'dependency' => 'Include as dependency',
12733: 'discard' => 'Discard',
12734: );
12735: if ($is_dir) {
1.1059 raeburn 12736: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12737: }
1.1056 raeburn 12738: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12739: my $offset = 0;
1.1055 raeburn 12740: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12741: $offset ++;
1.1065 raeburn 12742: if ($action ne 'display') {
12743: $offset ++;
12744: }
1.1055 raeburn 12745: $output .= '<td><span class="LC_nobreak">'.
12746: '<label><input type="radio" name="archive_'.$count.
12747: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12748: my $text = $choices{$action};
12749: if ($is_dir) {
12750: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12751: if ($action eq 'display') {
1.1059 raeburn 12752: $text = &mt('Add as folder');
1.1055 raeburn 12753: }
1.1056 raeburn 12754: } else {
12755: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12756:
12757: }
12758: $output .= ' /> '.$choices{$action}.'</label></span>';
12759: if ($action eq 'dependency') {
12760: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12761: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12762: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12763: '<option value=""></option>'."\n".
12764: '</select>'."\n".
12765: '</div>';
1.1059 raeburn 12766: } elsif ($action eq 'display') {
12767: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12768: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12769: '</div>';
1.1055 raeburn 12770: }
1.1056 raeburn 12771: $output .= '</td>';
1.1055 raeburn 12772: }
12773: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12774: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12775: for (my $i=0; $i<$depth; $i++) {
12776: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12777: }
12778: if ($is_dir) {
12779: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12780: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12781: } else {
12782: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12783: }
12784: $output .= ' '.$name.'</td>'."\n".
12785: &end_data_table_row();
12786: return $output;
12787: }
12788:
12789: sub archive_options_form {
1.1065 raeburn 12790: my ($form,$display,$count,$hiddenelem) = @_;
12791: my %lt = &Apache::lonlocal::texthash(
12792: perm => 'Permanently remove archive file?',
12793: hows => 'How should each extracted item be incorporated in the course?',
12794: cont => 'Content actions for all',
12795: addf => 'Add as folder/file',
12796: incd => 'Include as dependency for a displayed file',
12797: disc => 'Discard',
12798: no => 'No',
12799: yes => 'Yes',
12800: save => 'Save',
12801: );
12802: my $output = <<"END";
12803: <form name="$form" method="post" action="">
12804: <p><span class="LC_nobreak">$lt{'perm'}
12805: <label>
12806: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12807: </label>
12808:
12809: <label>
12810: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12811: </span>
12812: </p>
12813: <input type="hidden" name="phase" value="decompress_cleanup" />
12814: <br />$lt{'hows'}
12815: <div class="LC_columnSection">
12816: <fieldset>
12817: <legend>$lt{'cont'}</legend>
12818: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12819: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12820: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12821: </fieldset>
12822: </div>
12823: END
12824: return $output.
1.1055 raeburn 12825: &start_data_table()."\n".
1.1065 raeburn 12826: $display."\n".
1.1055 raeburn 12827: &end_data_table()."\n".
12828: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12829: $hiddenelem.
1.1065 raeburn 12830: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12831: '</form>';
12832: }
12833:
12834: sub archive_javascript {
1.1056 raeburn 12835: my ($startcount,$numitems,$titles,$children) = @_;
12836: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12837: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12838: my $scripttag = <<START;
12839: <script type="text/javascript">
12840: // <![CDATA[
12841:
12842: function checkAll(form,prefix) {
12843: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12844: for (var i=0; i < form.elements.length; i++) {
12845: var id = form.elements[i].id;
12846: if ((id != '') && (id != undefined)) {
12847: if (idstr.test(id)) {
12848: if (form.elements[i].type == 'radio') {
12849: form.elements[i].checked = true;
1.1056 raeburn 12850: var nostart = i-$startcount;
1.1059 raeburn 12851: var offset = nostart%7;
12852: var count = (nostart-offset)/7;
1.1056 raeburn 12853: dependencyCheck(form,count,offset);
1.1055 raeburn 12854: }
12855: }
12856: }
12857: }
12858: }
12859:
12860: function propagateCheck(form,count) {
12861: if (count > 0) {
1.1059 raeburn 12862: var startelement = $startcount + ((count-1) * 7);
12863: for (var j=1; j<6; j++) {
12864: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12865: var item = startelement + j;
12866: if (form.elements[item].type == 'radio') {
12867: if (form.elements[item].checked) {
12868: containerCheck(form,count,j);
12869: break;
12870: }
1.1055 raeburn 12871: }
12872: }
12873: }
12874: }
12875: }
12876:
12877: numitems = $numitems
1.1056 raeburn 12878: var titles = new Array(numitems);
12879: var parents = new Array(numitems);
1.1055 raeburn 12880: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12881: parents[i] = new Array;
1.1055 raeburn 12882: }
1.1059 raeburn 12883: var maintitle = '$maintitle';
1.1055 raeburn 12884:
12885: START
12886:
1.1056 raeburn 12887: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12888: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12889: for (my $i=0; $i<@contents; $i ++) {
12890: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12891: }
12892: }
12893:
1.1056 raeburn 12894: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12895: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12896: }
12897:
1.1055 raeburn 12898: $scripttag .= <<END;
12899:
12900: function containerCheck(form,count,offset) {
12901: if (count > 0) {
1.1056 raeburn 12902: dependencyCheck(form,count,offset);
1.1059 raeburn 12903: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12904: form.elements[item].checked = true;
12905: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12906: if (parents[count].length > 0) {
12907: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12908: containerCheck(form,parents[count][j],offset);
12909: }
12910: }
12911: }
12912: }
12913: }
12914:
12915: function dependencyCheck(form,count,offset) {
12916: if (count > 0) {
1.1059 raeburn 12917: var chosen = (offset+$startcount)+7*(count-1);
12918: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12919: var currtype = form.elements[depitem].type;
12920: if (form.elements[chosen].value == 'dependency') {
12921: document.getElementById('arc_depon_'+count).style.display='block';
12922: form.elements[depitem].options.length = 0;
12923: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 12924: for (var i=1; i<=numitems; i++) {
12925: if (i == count) {
12926: continue;
12927: }
1.1059 raeburn 12928: var startelement = $startcount + (i-1) * 7;
12929: for (var j=1; j<6; j++) {
12930: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12931: var item = startelement + j;
12932: if (form.elements[item].type == 'radio') {
12933: if (form.elements[item].checked) {
12934: if (form.elements[item].value == 'display') {
12935: var n = form.elements[depitem].options.length;
12936: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12937: }
12938: }
12939: }
12940: }
12941: }
12942: }
12943: } else {
12944: document.getElementById('arc_depon_'+count).style.display='none';
12945: form.elements[depitem].options.length = 0;
12946: form.elements[depitem].options[0] = new Option('Select','',true,true);
12947: }
1.1059 raeburn 12948: titleCheck(form,count,offset);
1.1056 raeburn 12949: }
12950: }
12951:
12952: function propagateSelect(form,count,offset) {
12953: if (count > 0) {
1.1065 raeburn 12954: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12955: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12956: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12957: if (parents[count].length > 0) {
12958: for (var j=0; j<parents[count].length; j++) {
12959: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12960: }
12961: }
12962: }
12963: }
12964: }
1.1056 raeburn 12965:
12966: function containerSelect(form,count,offset,picked) {
12967: if (count > 0) {
1.1065 raeburn 12968: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12969: if (form.elements[item].type == 'radio') {
12970: if (form.elements[item].value == 'dependency') {
12971: if (form.elements[item+1].type == 'select-one') {
12972: for (var i=0; i<form.elements[item+1].options.length; i++) {
12973: if (form.elements[item+1].options[i].value == picked) {
12974: form.elements[item+1].selectedIndex = i;
12975: break;
12976: }
12977: }
12978: }
12979: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12980: if (parents[count].length > 0) {
12981: for (var j=0; j<parents[count].length; j++) {
12982: containerSelect(form,parents[count][j],offset,picked);
12983: }
12984: }
12985: }
12986: }
12987: }
12988: }
12989: }
12990:
1.1059 raeburn 12991: function titleCheck(form,count,offset) {
12992: if (count > 0) {
12993: var chosen = (offset+$startcount)+7*(count-1);
12994: var depitem = $startcount + ((count-1) * 7) + 2;
12995: var currtype = form.elements[depitem].type;
12996: if (form.elements[chosen].value == 'display') {
12997: document.getElementById('arc_title_'+count).style.display='block';
12998: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12999: document.getElementById('archive_title_'+count).value=maintitle;
13000: }
13001: } else {
13002: document.getElementById('arc_title_'+count).style.display='none';
13003: if (currtype == 'text') {
13004: document.getElementById('archive_title_'+count).value='';
13005: }
13006: }
13007: }
13008: return;
13009: }
13010:
1.1055 raeburn 13011: // ]]>
13012: </script>
13013: END
13014: return $scripttag;
13015: }
13016:
13017: sub process_extracted_files {
1.1067 raeburn 13018: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13019: my $numitems = $env{'form.archive_count'};
13020: return unless ($numitems);
13021: my @ids=&Apache::lonnet::current_machine_ids();
13022: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13023: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13024: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13025: if (grep(/^\Q$docuhome\E$/,@ids)) {
13026: $prefix = &LONCAPA::propath($docudom,$docuname);
13027: $pathtocheck = "$dir_root/$destination";
13028: $dir = $dir_root;
13029: $ishome = 1;
13030: } else {
13031: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13032: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
13033: $dir = "$dir_root/$docudom/$docuname";
13034: }
13035: my $currdir = "$dir_root/$destination";
13036: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13037: if ($env{'form.folderpath'}) {
13038: my @items = split('&',$env{'form.folderpath'});
13039: $folders{'0'} = $items[-2];
1.1099 raeburn 13040: if ($env{'form.folderpath'} =~ /\:1$/) {
13041: $containers{'0'}='page';
13042: } else {
13043: $containers{'0'}='sequence';
13044: }
1.1055 raeburn 13045: }
13046: my @archdirs = &get_env_multiple('form.archive_directory');
13047: if ($numitems) {
13048: for (my $i=1; $i<=$numitems; $i++) {
13049: my $path = $env{'form.archive_content_'.$i};
13050: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13051: my $item = $1;
13052: $toplevelitems{$item} = $i;
13053: if (grep(/^\Q$i\E$/,@archdirs)) {
13054: $is_dir{$item} = 1;
13055: }
13056: }
13057: }
13058: }
1.1067 raeburn 13059: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13060: if (keys(%toplevelitems) > 0) {
13061: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13062: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13063: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13064: }
1.1066 raeburn 13065: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13066: if ($numitems) {
13067: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13068: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13069: my $path = $env{'form.archive_content_'.$i};
13070: if ($path =~ /^\Q$pathtocheck\E/) {
13071: if ($env{'form.archive_'.$i} eq 'discard') {
13072: if ($prefix ne '' && $path ne '') {
13073: if (-e $prefix.$path) {
1.1066 raeburn 13074: if ((@archdirs > 0) &&
13075: (grep(/^\Q$i\E$/,@archdirs))) {
13076: $todeletedir{$prefix.$path} = 1;
13077: } else {
13078: $todelete{$prefix.$path} = 1;
13079: }
1.1055 raeburn 13080: }
13081: }
13082: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13083: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13084: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13085: $docstitle = $env{'form.archive_title_'.$i};
13086: if ($docstitle eq '') {
13087: $docstitle = $title;
13088: }
1.1055 raeburn 13089: $outer = 0;
1.1056 raeburn 13090: if (ref($dirorder{$i}) eq 'ARRAY') {
13091: if (@{$dirorder{$i}} > 0) {
13092: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13093: if ($env{'form.archive_'.$item} eq 'display') {
13094: $outer = $item;
13095: last;
13096: }
13097: }
13098: }
13099: }
13100: my ($errtext,$fatal) =
13101: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13102: '/'.$folders{$outer}.'.'.
13103: $containers{$outer});
13104: next if ($fatal);
13105: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13106: if ($context eq 'coursedocs') {
1.1056 raeburn 13107: $mapinner{$i} = time;
1.1055 raeburn 13108: $folders{$i} = 'default_'.$mapinner{$i};
13109: $containers{$i} = 'sequence';
13110: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13111: $folders{$i}.'.'.$containers{$i};
13112: my $newidx = &LONCAPA::map::getresidx();
13113: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13114: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13115: push(@LONCAPA::map::order,$newidx);
13116: my ($outtext,$errtext) =
13117: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13118: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13119: '.'.$containers{$outer},1,1);
1.1056 raeburn 13120: $newseqid{$i} = $newidx;
1.1067 raeburn 13121: unless ($errtext) {
13122: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
13123: }
1.1055 raeburn 13124: }
13125: } else {
13126: if ($context eq 'coursedocs') {
13127: my $newidx=&LONCAPA::map::getresidx();
13128: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13129: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13130: $title;
13131: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13132: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13133: }
13134: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13135: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13136: }
13137: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13138: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 13139: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 13140: unless ($ishome) {
13141: my $fetch = "$newdest{$i}/$title";
13142: $fetch =~ s/^\Q$prefix$dir\E//;
13143: $prompttofetch{$fetch} = 1;
13144: }
1.1055 raeburn 13145: }
13146: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13147: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13148: push(@LONCAPA::map::order, $newidx);
13149: my ($outtext,$errtext)=
13150: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13151: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13152: '.'.$containers{$outer},1,1);
1.1067 raeburn 13153: unless ($errtext) {
13154: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13155: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
13156: }
13157: }
1.1055 raeburn 13158: }
13159: }
1.1086 raeburn 13160: }
13161: } else {
13162: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13163: }
13164: }
13165: for (my $i=1; $i<=$numitems; $i++) {
13166: next unless ($env{'form.archive_'.$i} eq 'dependency');
13167: my $path = $env{'form.archive_content_'.$i};
13168: if ($path =~ /^\Q$pathtocheck\E/) {
13169: my ($title) = ($path =~ m{/([^/]+)$});
13170: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13171: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13172: if (ref($dirorder{$i}) eq 'ARRAY') {
13173: my ($itemidx,$fullpath,$relpath);
13174: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13175: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13176: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13177: if ($dirorder{$i}->[$j] eq $container) {
13178: $itemidx = $j;
1.1056 raeburn 13179: }
13180: }
1.1086 raeburn 13181: }
13182: if ($itemidx eq '') {
13183: $itemidx = 0;
13184: }
13185: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13186: if ($mapinner{$referrer{$i}}) {
13187: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13188: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13189: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13190: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13191: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13192: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13193: if (!-e $fullpath) {
13194: mkdir($fullpath,0755);
1.1056 raeburn 13195: }
13196: }
1.1086 raeburn 13197: } else {
13198: last;
1.1056 raeburn 13199: }
1.1086 raeburn 13200: }
13201: }
13202: } elsif ($newdest{$referrer{$i}}) {
13203: $fullpath = $newdest{$referrer{$i}};
13204: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13205: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13206: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13207: last;
13208: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13209: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13210: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13211: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13212: if (!-e $fullpath) {
13213: mkdir($fullpath,0755);
1.1056 raeburn 13214: }
13215: }
1.1086 raeburn 13216: } else {
13217: last;
1.1056 raeburn 13218: }
1.1055 raeburn 13219: }
13220: }
1.1086 raeburn 13221: if ($fullpath ne '') {
13222: if (-e "$prefix$path") {
13223: system("mv $prefix$path $fullpath/$title");
13224: }
13225: if (-e "$fullpath/$title") {
13226: my $showpath;
13227: if ($relpath ne '') {
13228: $showpath = "$relpath/$title";
13229: } else {
13230: $showpath = "/$title";
13231: }
13232: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
13233: }
13234: unless ($ishome) {
13235: my $fetch = "$fullpath/$title";
13236: $fetch =~ s/^\Q$prefix$dir\E//;
13237: $prompttofetch{$fetch} = 1;
13238: }
13239: }
1.1055 raeburn 13240: }
1.1086 raeburn 13241: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13242: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
13243: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 13244: }
13245: } else {
13246: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
13247: }
13248: }
13249: if (keys(%todelete)) {
13250: foreach my $key (keys(%todelete)) {
13251: unlink($key);
1.1066 raeburn 13252: }
13253: }
13254: if (keys(%todeletedir)) {
13255: foreach my $key (keys(%todeletedir)) {
13256: rmdir($key);
13257: }
13258: }
13259: foreach my $dir (sort(keys(%is_dir))) {
13260: if (($pathtocheck ne '') && ($dir ne '')) {
13261: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13262: }
13263: }
1.1067 raeburn 13264: if ($result ne '') {
13265: $output .= '<ul>'."\n".
13266: $result."\n".
13267: '</ul>';
13268: }
13269: unless ($ishome) {
13270: my $replicationfail;
13271: foreach my $item (keys(%prompttofetch)) {
13272: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13273: unless ($fetchresult eq 'ok') {
13274: $replicationfail .= '<li>'.$item.'</li>'."\n";
13275: }
13276: }
13277: if ($replicationfail) {
13278: $output .= '<p class="LC_error">'.
13279: &mt('Course home server failed to retrieve:').'<ul>'.
13280: $replicationfail.
13281: '</ul></p>';
13282: }
13283: }
1.1055 raeburn 13284: } else {
13285: $warning = &mt('No items found in archive.');
13286: }
13287: if ($error) {
13288: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13289: $error.'</p>'."\n";
13290: }
13291: if ($warning) {
13292: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13293: }
13294: return $output;
13295: }
13296:
1.1066 raeburn 13297: sub cleanup_empty_dirs {
13298: my ($path) = @_;
13299: if (($path ne '') && (-d $path)) {
13300: if (opendir(my $dirh,$path)) {
13301: my @dircontents = grep(!/^\./,readdir($dirh));
13302: my $numitems = 0;
13303: foreach my $item (@dircontents) {
13304: if (-d "$path/$item") {
1.1111 raeburn 13305: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13306: if (-e "$path/$item") {
13307: $numitems ++;
13308: }
13309: } else {
13310: $numitems ++;
13311: }
13312: }
13313: if ($numitems == 0) {
13314: rmdir($path);
13315: }
13316: closedir($dirh);
13317: }
13318: }
13319: return;
13320: }
13321:
1.41 ng 13322: =pod
1.45 matthew 13323:
1.1162 raeburn 13324: =item * &get_folder_hierarchy()
1.1068 raeburn 13325:
13326: Provides hierarchy of names of folders/sub-folders containing the current
13327: item,
13328:
13329: Inputs: 3
13330: - $navmap - navmaps object
13331:
13332: - $map - url for map (either the trigger itself, or map containing
13333: the resource, which is the trigger).
13334:
13335: - $showitem - 1 => show title for map itself; 0 => do not show.
13336:
13337: Outputs: 1 @pathitems - array of folder/subfolder names.
13338:
13339: =cut
13340:
13341: sub get_folder_hierarchy {
13342: my ($navmap,$map,$showitem) = @_;
13343: my @pathitems;
13344: if (ref($navmap)) {
13345: my $mapres = $navmap->getResourceByUrl($map);
13346: if (ref($mapres)) {
13347: my $pcslist = $mapres->map_hierarchy();
13348: if ($pcslist ne '') {
13349: my @pcs = split(/,/,$pcslist);
13350: foreach my $pc (@pcs) {
13351: if ($pc == 1) {
1.1129 raeburn 13352: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13353: } else {
13354: my $res = $navmap->getByMapPc($pc);
13355: if (ref($res)) {
13356: my $title = $res->compTitle();
13357: $title =~ s/\W+/_/g;
13358: if ($title ne '') {
13359: push(@pathitems,$title);
13360: }
13361: }
13362: }
13363: }
13364: }
1.1071 raeburn 13365: if ($showitem) {
13366: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13367: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13368: } else {
13369: my $maptitle = $mapres->compTitle();
13370: $maptitle =~ s/\W+/_/g;
13371: if ($maptitle ne '') {
13372: push(@pathitems,$maptitle);
13373: }
1.1068 raeburn 13374: }
13375: }
13376: }
13377: }
13378: return @pathitems;
13379: }
13380:
13381: =pod
13382:
1.1015 raeburn 13383: =item * &get_turnedin_filepath()
13384:
13385: Determines path in a user's portfolio file for storage of files uploaded
13386: to a specific essayresponse or dropbox item.
13387:
13388: Inputs: 3 required + 1 optional.
13389: $symb is symb for resource, $uname and $udom are for current user (required).
13390: $caller is optional (can be "submission", if routine is called when storing
13391: an upoaded file when "Submit Answer" button was pressed).
13392:
13393: Returns array containing $path and $multiresp.
13394: $path is path in portfolio. $multiresp is 1 if this resource contains more
13395: than one file upload item. Callers of routine should append partid as a
13396: subdirectory to $path in cases where $multiresp is 1.
13397:
13398: Called by: homework/essayresponse.pm and homework/structuretags.pm
13399:
13400: =cut
13401:
13402: sub get_turnedin_filepath {
13403: my ($symb,$uname,$udom,$caller) = @_;
13404: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13405: my $turnindir;
13406: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13407: $turnindir = $userhash{'turnindir'};
13408: my ($path,$multiresp);
13409: if ($turnindir eq '') {
13410: if ($caller eq 'submission') {
13411: $turnindir = &mt('turned in');
13412: $turnindir =~ s/\W+/_/g;
13413: my %newhash = (
13414: 'turnindir' => $turnindir,
13415: );
13416: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13417: }
13418: }
13419: if ($turnindir ne '') {
13420: $path = '/'.$turnindir.'/';
13421: my ($multipart,$turnin,@pathitems);
13422: my $navmap = Apache::lonnavmaps::navmap->new();
13423: if (defined($navmap)) {
13424: my $mapres = $navmap->getResourceByUrl($map);
13425: if (ref($mapres)) {
13426: my $pcslist = $mapres->map_hierarchy();
13427: if ($pcslist ne '') {
13428: foreach my $pc (split(/,/,$pcslist)) {
13429: my $res = $navmap->getByMapPc($pc);
13430: if (ref($res)) {
13431: my $title = $res->compTitle();
13432: $title =~ s/\W+/_/g;
13433: if ($title ne '') {
1.1149 raeburn 13434: if (($pc > 1) && (length($title) > 12)) {
13435: $title = substr($title,0,12);
13436: }
1.1015 raeburn 13437: push(@pathitems,$title);
13438: }
13439: }
13440: }
13441: }
13442: my $maptitle = $mapres->compTitle();
13443: $maptitle =~ s/\W+/_/g;
13444: if ($maptitle ne '') {
1.1149 raeburn 13445: if (length($maptitle) > 12) {
13446: $maptitle = substr($maptitle,0,12);
13447: }
1.1015 raeburn 13448: push(@pathitems,$maptitle);
13449: }
13450: unless ($env{'request.state'} eq 'construct') {
13451: my $res = $navmap->getBySymb($symb);
13452: if (ref($res)) {
13453: my $partlist = $res->parts();
13454: my $totaluploads = 0;
13455: if (ref($partlist) eq 'ARRAY') {
13456: foreach my $part (@{$partlist}) {
13457: my @types = $res->responseType($part);
13458: my @ids = $res->responseIds($part);
13459: for (my $i=0; $i < scalar(@ids); $i++) {
13460: if ($types[$i] eq 'essay') {
13461: my $partid = $part.'_'.$ids[$i];
13462: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13463: $totaluploads ++;
13464: }
13465: }
13466: }
13467: }
13468: if ($totaluploads > 1) {
13469: $multiresp = 1;
13470: }
13471: }
13472: }
13473: }
13474: } else {
13475: return;
13476: }
13477: } else {
13478: return;
13479: }
13480: my $restitle=&Apache::lonnet::gettitle($symb);
13481: $restitle =~ s/\W+/_/g;
13482: if ($restitle eq '') {
13483: $restitle = ($resurl =~ m{/[^/]+$});
13484: if ($restitle eq '') {
13485: $restitle = time;
13486: }
13487: }
1.1149 raeburn 13488: if (length($restitle) > 12) {
13489: $restitle = substr($restitle,0,12);
13490: }
1.1015 raeburn 13491: push(@pathitems,$restitle);
13492: $path .= join('/',@pathitems);
13493: }
13494: return ($path,$multiresp);
13495: }
13496:
13497: =pod
13498:
1.464 albertel 13499: =back
1.41 ng 13500:
1.112 bowersj2 13501: =head1 CSV Upload/Handling functions
1.38 albertel 13502:
1.41 ng 13503: =over 4
13504:
1.648 raeburn 13505: =item * &upfile_store($r)
1.41 ng 13506:
13507: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13508: needs $env{'form.upfile'}
1.41 ng 13509: returns $datatoken to be put into hidden field
13510:
13511: =cut
1.31 albertel 13512:
13513: sub upfile_store {
13514: my $r=shift;
1.258 albertel 13515: $env{'form.upfile'}=~s/\r/\n/gs;
13516: $env{'form.upfile'}=~s/\f/\n/gs;
13517: $env{'form.upfile'}=~s/\n+/\n/gs;
13518: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13519:
1.258 albertel 13520: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
13521: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 13522: {
1.158 raeburn 13523: my $datafile = $r->dir_config('lonDaemons').
13524: '/tmp/'.$datatoken.'.tmp';
13525: if ( open(my $fh,">$datafile") ) {
1.258 albertel 13526: print $fh $env{'form.upfile'};
1.158 raeburn 13527: close($fh);
13528: }
1.31 albertel 13529: }
13530: return $datatoken;
13531: }
13532:
1.56 matthew 13533: =pod
13534:
1.648 raeburn 13535: =item * &load_tmp_file($r)
1.41 ng 13536:
13537: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 13538: needs $env{'form.datatoken'},
13539: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13540:
13541: =cut
1.31 albertel 13542:
13543: sub load_tmp_file {
13544: my $r=shift;
13545: my @studentdata=();
13546: {
1.158 raeburn 13547: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 13548: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 13549: if ( open(my $fh,"<$studentfile") ) {
13550: @studentdata=<$fh>;
13551: close($fh);
13552: }
1.31 albertel 13553: }
1.258 albertel 13554: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13555: }
13556:
1.56 matthew 13557: =pod
13558:
1.648 raeburn 13559: =item * &upfile_record_sep()
1.41 ng 13560:
13561: Separate uploaded file into records
13562: returns array of records,
1.258 albertel 13563: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13564:
13565: =cut
1.31 albertel 13566:
13567: sub upfile_record_sep {
1.258 albertel 13568: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13569: } else {
1.248 albertel 13570: my @records;
1.258 albertel 13571: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13572: if ($line=~/^\s*$/) { next; }
13573: push(@records,$line);
13574: }
13575: return @records;
1.31 albertel 13576: }
13577: }
13578:
1.56 matthew 13579: =pod
13580:
1.648 raeburn 13581: =item * &record_sep($record)
1.41 ng 13582:
1.258 albertel 13583: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13584:
13585: =cut
13586:
1.263 www 13587: sub takeleft {
13588: my $index=shift;
13589: return substr('0000'.$index,-4,4);
13590: }
13591:
1.31 albertel 13592: sub record_sep {
13593: my $record=shift;
13594: my %components=();
1.258 albertel 13595: if ($env{'form.upfiletype'} eq 'xml') {
13596: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13597: my $i=0;
1.356 albertel 13598: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13599: $field=~s/^(\"|\')//;
13600: $field=~s/(\"|\')$//;
1.263 www 13601: $components{&takeleft($i)}=$field;
1.31 albertel 13602: $i++;
13603: }
1.258 albertel 13604: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13605: my $i=0;
1.356 albertel 13606: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13607: $field=~s/^(\"|\')//;
13608: $field=~s/(\"|\')$//;
1.263 www 13609: $components{&takeleft($i)}=$field;
1.31 albertel 13610: $i++;
13611: }
13612: } else {
1.561 www 13613: my $separator=',';
1.480 banghart 13614: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13615: $separator=';';
1.480 banghart 13616: }
1.31 albertel 13617: my $i=0;
1.561 www 13618: # the character we are looking for to indicate the end of a quote or a record
13619: my $looking_for=$separator;
13620: # do not add the characters to the fields
13621: my $ignore=0;
13622: # we just encountered a separator (or the beginning of the record)
13623: my $just_found_separator=1;
13624: # store the field we are working on here
13625: my $field='';
13626: # work our way through all characters in record
13627: foreach my $character ($record=~/(.)/g) {
13628: if ($character eq $looking_for) {
13629: if ($character ne $separator) {
13630: # Found the end of a quote, again looking for separator
13631: $looking_for=$separator;
13632: $ignore=1;
13633: } else {
13634: # Found a separator, store away what we got
13635: $components{&takeleft($i)}=$field;
13636: $i++;
13637: $just_found_separator=1;
13638: $ignore=0;
13639: $field='';
13640: }
13641: next;
13642: }
13643: # single or double quotation marks after a separator indicate beginning of a quote
13644: # we are now looking for the end of the quote and need to ignore separators
13645: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13646: $looking_for=$character;
13647: next;
13648: }
13649: # ignore would be true after we reached the end of a quote
13650: if ($ignore) { next; }
13651: if (($just_found_separator) && ($character=~/\s/)) { next; }
13652: $field.=$character;
13653: $just_found_separator=0;
1.31 albertel 13654: }
1.561 www 13655: # catch the very last entry, since we never encountered the separator
13656: $components{&takeleft($i)}=$field;
1.31 albertel 13657: }
13658: return %components;
13659: }
13660:
1.144 matthew 13661: ######################################################
13662: ######################################################
13663:
1.56 matthew 13664: =pod
13665:
1.648 raeburn 13666: =item * &upfile_select_html()
1.41 ng 13667:
1.144 matthew 13668: Return HTML code to select a file from the users machine and specify
13669: the file type.
1.41 ng 13670:
13671: =cut
13672:
1.144 matthew 13673: ######################################################
13674: ######################################################
1.31 albertel 13675: sub upfile_select_html {
1.144 matthew 13676: my %Types = (
13677: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13678: semisv => &mt('Semicolon separated values'),
1.144 matthew 13679: space => &mt('Space separated'),
13680: tab => &mt('Tabulator separated'),
13681: # xml => &mt('HTML/XML'),
13682: );
13683: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13684: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13685: foreach my $type (sort(keys(%Types))) {
13686: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13687: }
13688: $Str .= "</select>\n";
13689: return $Str;
1.31 albertel 13690: }
13691:
1.301 albertel 13692: sub get_samples {
13693: my ($records,$toget) = @_;
13694: my @samples=({});
13695: my $got=0;
13696: foreach my $rec (@$records) {
13697: my %temp = &record_sep($rec);
13698: if (! grep(/\S/, values(%temp))) { next; }
13699: if (%temp) {
13700: $samples[$got]=\%temp;
13701: $got++;
13702: if ($got == $toget) { last; }
13703: }
13704: }
13705: return \@samples;
13706: }
13707:
1.144 matthew 13708: ######################################################
13709: ######################################################
13710:
1.56 matthew 13711: =pod
13712:
1.648 raeburn 13713: =item * &csv_print_samples($r,$records)
1.41 ng 13714:
13715: Prints a table of sample values from each column uploaded $r is an
13716: Apache Request ref, $records is an arrayref from
13717: &Apache::loncommon::upfile_record_sep
13718:
13719: =cut
13720:
1.144 matthew 13721: ######################################################
13722: ######################################################
1.31 albertel 13723: sub csv_print_samples {
13724: my ($r,$records) = @_;
1.662 bisitz 13725: my $samples = &get_samples($records,5);
1.301 albertel 13726:
1.594 raeburn 13727: $r->print(&mt('Samples').'<br />'.&start_data_table().
13728: &start_data_table_header_row());
1.356 albertel 13729: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13730: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13731: $r->print(&end_data_table_header_row());
1.301 albertel 13732: foreach my $hash (@$samples) {
1.594 raeburn 13733: $r->print(&start_data_table_row());
1.356 albertel 13734: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13735: $r->print('<td>');
1.356 albertel 13736: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13737: $r->print('</td>');
13738: }
1.594 raeburn 13739: $r->print(&end_data_table_row());
1.31 albertel 13740: }
1.594 raeburn 13741: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13742: }
13743:
1.144 matthew 13744: ######################################################
13745: ######################################################
13746:
1.56 matthew 13747: =pod
13748:
1.648 raeburn 13749: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13750:
13751: Prints a table to create associations between values and table columns.
1.144 matthew 13752:
1.41 ng 13753: $r is an Apache Request ref,
13754: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13755: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13756:
13757: =cut
13758:
1.144 matthew 13759: ######################################################
13760: ######################################################
1.31 albertel 13761: sub csv_print_select_table {
13762: my ($r,$records,$d) = @_;
1.301 albertel 13763: my $i=0;
13764: my $samples = &get_samples($records,1);
1.144 matthew 13765: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13766: &start_data_table().&start_data_table_header_row().
1.144 matthew 13767: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13768: '<th>'.&mt('Column').'</th>'.
13769: &end_data_table_header_row()."\n");
1.356 albertel 13770: foreach my $array_ref (@$d) {
13771: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13772: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13773:
1.875 bisitz 13774: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13775: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13776: $r->print('<option value="none"></option>');
1.356 albertel 13777: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13778: $r->print('<option value="'.$sample.'"'.
13779: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13780: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13781: }
1.594 raeburn 13782: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13783: $i++;
13784: }
1.594 raeburn 13785: $r->print(&end_data_table());
1.31 albertel 13786: $i--;
13787: return $i;
13788: }
1.56 matthew 13789:
1.144 matthew 13790: ######################################################
13791: ######################################################
13792:
1.56 matthew 13793: =pod
1.31 albertel 13794:
1.648 raeburn 13795: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13796:
13797: Prints a table of sample values from the upload and can make associate samples to internal names.
13798:
13799: $r is an Apache Request ref,
13800: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13801: $d is an array of 2 element arrays (internal name, displayed name)
13802:
13803: =cut
13804:
1.144 matthew 13805: ######################################################
13806: ######################################################
1.31 albertel 13807: sub csv_samples_select_table {
13808: my ($r,$records,$d) = @_;
13809: my $i=0;
1.144 matthew 13810: #
1.662 bisitz 13811: my $max_samples = 5;
13812: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13813: $r->print(&start_data_table().
13814: &start_data_table_header_row().'<th>'.
13815: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13816: &end_data_table_header_row());
1.301 albertel 13817:
13818: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13819: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13820: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13821: foreach my $option (@$d) {
13822: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13823: $r->print('<option value="'.$value.'"'.
1.253 albertel 13824: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13825: $display.'</option>');
1.31 albertel 13826: }
13827: $r->print('</select></td><td>');
1.662 bisitz 13828: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13829: if (defined($samples->[$line]{$key})) {
13830: $r->print($samples->[$line]{$key}."<br />\n");
13831: }
13832: }
1.594 raeburn 13833: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13834: $i++;
13835: }
1.594 raeburn 13836: $r->print(&end_data_table());
1.31 albertel 13837: $i--;
13838: return($i);
1.115 matthew 13839: }
13840:
1.144 matthew 13841: ######################################################
13842: ######################################################
13843:
1.115 matthew 13844: =pod
13845:
1.648 raeburn 13846: =item * &clean_excel_name($name)
1.115 matthew 13847:
13848: Returns a replacement for $name which does not contain any illegal characters.
13849:
13850: =cut
13851:
1.144 matthew 13852: ######################################################
13853: ######################################################
1.115 matthew 13854: sub clean_excel_name {
13855: my ($name) = @_;
13856: $name =~ s/[:\*\?\/\\]//g;
13857: if (length($name) > 31) {
13858: $name = substr($name,0,31);
13859: }
13860: return $name;
1.25 albertel 13861: }
1.84 albertel 13862:
1.85 albertel 13863: =pod
13864:
1.648 raeburn 13865: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13866:
13867: Returns either 1 or undef
13868:
13869: 1 if the part is to be hidden, undef if it is to be shown
13870:
13871: Arguments are:
13872:
13873: $id the id of the part to be checked
13874: $symb, optional the symb of the resource to check
13875: $udom, optional the domain of the user to check for
13876: $uname, optional the username of the user to check for
13877:
13878: =cut
1.84 albertel 13879:
13880: sub check_if_partid_hidden {
13881: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13882: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13883: $symb,$udom,$uname);
1.141 albertel 13884: my $truth=1;
13885: #if the string starts with !, then the list is the list to show not hide
13886: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13887: my @hiddenlist=split(/,/,$hiddenparts);
13888: foreach my $checkid (@hiddenlist) {
1.141 albertel 13889: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13890: }
1.141 albertel 13891: return !$truth;
1.84 albertel 13892: }
1.127 matthew 13893:
1.138 matthew 13894:
13895: ############################################################
13896: ############################################################
13897:
13898: =pod
13899:
1.157 matthew 13900: =back
13901:
1.138 matthew 13902: =head1 cgi-bin script and graphing routines
13903:
1.157 matthew 13904: =over 4
13905:
1.648 raeburn 13906: =item * &get_cgi_id()
1.138 matthew 13907:
13908: Inputs: none
13909:
13910: Returns an id which can be used to pass environment variables
13911: to various cgi-bin scripts. These environment variables will
13912: be removed from the users environment after a given time by
13913: the routine &Apache::lonnet::transfer_profile_to_env.
13914:
13915: =cut
13916:
13917: ############################################################
13918: ############################################################
1.152 albertel 13919: my $uniq=0;
1.136 matthew 13920: sub get_cgi_id {
1.154 albertel 13921: $uniq=($uniq+1)%100000;
1.280 albertel 13922: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13923: }
13924:
1.127 matthew 13925: ############################################################
13926: ############################################################
13927:
13928: =pod
13929:
1.648 raeburn 13930: =item * &DrawBarGraph()
1.127 matthew 13931:
1.138 matthew 13932: Facilitates the plotting of data in a (stacked) bar graph.
13933: Puts plot definition data into the users environment in order for
13934: graph.png to plot it. Returns an <img> tag for the plot.
13935: The bars on the plot are labeled '1','2',...,'n'.
13936:
13937: Inputs:
13938:
13939: =over 4
13940:
13941: =item $Title: string, the title of the plot
13942:
13943: =item $xlabel: string, text describing the X-axis of the plot
13944:
13945: =item $ylabel: string, text describing the Y-axis of the plot
13946:
13947: =item $Max: scalar, the maximum Y value to use in the plot
13948: If $Max is < any data point, the graph will not be rendered.
13949:
1.140 matthew 13950: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13951: they are plotted. If undefined, default values will be used.
13952:
1.178 matthew 13953: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13954:
1.138 matthew 13955: =item @Values: An array of array references. Each array reference holds data
13956: to be plotted in a stacked bar chart.
13957:
1.239 matthew 13958: =item If the final element of @Values is a hash reference the key/value
13959: pairs will be added to the graph definition.
13960:
1.138 matthew 13961: =back
13962:
13963: Returns:
13964:
13965: An <img> tag which references graph.png and the appropriate identifying
13966: information for the plot.
13967:
1.127 matthew 13968: =cut
13969:
13970: ############################################################
13971: ############################################################
1.134 matthew 13972: sub DrawBarGraph {
1.178 matthew 13973: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13974: #
13975: if (! defined($colors)) {
13976: $colors = ['#33ff00',
13977: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13978: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13979: ];
13980: }
1.228 matthew 13981: my $extra_settings = {};
13982: if (ref($Values[-1]) eq 'HASH') {
13983: $extra_settings = pop(@Values);
13984: }
1.127 matthew 13985: #
1.136 matthew 13986: my $identifier = &get_cgi_id();
13987: my $id = 'cgi.'.$identifier;
1.129 matthew 13988: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13989: return '';
13990: }
1.225 matthew 13991: #
13992: my @Labels;
13993: if (defined($labels)) {
13994: @Labels = @$labels;
13995: } else {
13996: for (my $i=0;$i<@{$Values[0]};$i++) {
13997: push (@Labels,$i+1);
13998: }
13999: }
14000: #
1.129 matthew 14001: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14002: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14003: my %ValuesHash;
14004: my $NumSets=1;
14005: foreach my $array (@Values) {
14006: next if (! ref($array));
1.136 matthew 14007: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14008: join(',',@$array);
1.129 matthew 14009: }
1.127 matthew 14010: #
1.136 matthew 14011: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14012: if ($NumBars < 3) {
14013: $width = 120+$NumBars*32;
1.220 matthew 14014: $xskip = 1;
1.225 matthew 14015: $bar_width = 30;
14016: } elsif ($NumBars < 5) {
14017: $width = 120+$NumBars*20;
14018: $xskip = 1;
14019: $bar_width = 20;
1.220 matthew 14020: } elsif ($NumBars < 10) {
1.136 matthew 14021: $width = 120+$NumBars*15;
14022: $xskip = 1;
14023: $bar_width = 15;
14024: } elsif ($NumBars <= 25) {
14025: $width = 120+$NumBars*11;
14026: $xskip = 5;
14027: $bar_width = 8;
14028: } elsif ($NumBars <= 50) {
14029: $width = 120+$NumBars*8;
14030: $xskip = 5;
14031: $bar_width = 4;
14032: } else {
14033: $width = 120+$NumBars*8;
14034: $xskip = 5;
14035: $bar_width = 4;
14036: }
14037: #
1.137 matthew 14038: $Max = 1 if ($Max < 1);
14039: if ( int($Max) < $Max ) {
14040: $Max++;
14041: $Max = int($Max);
14042: }
1.127 matthew 14043: $Title = '' if (! defined($Title));
14044: $xlabel = '' if (! defined($xlabel));
14045: $ylabel = '' if (! defined($ylabel));
1.369 www 14046: $ValuesHash{$id.'.title'} = &escape($Title);
14047: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14048: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14049: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14050: $ValuesHash{$id.'.NumBars'} = $NumBars;
14051: $ValuesHash{$id.'.NumSets'} = $NumSets;
14052: $ValuesHash{$id.'.PlotType'} = 'bar';
14053: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14054: $ValuesHash{$id.'.height'} = $height;
14055: $ValuesHash{$id.'.width'} = $width;
14056: $ValuesHash{$id.'.xskip'} = $xskip;
14057: $ValuesHash{$id.'.bar_width'} = $bar_width;
14058: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14059: #
1.228 matthew 14060: # Deal with other parameters
14061: while (my ($key,$value) = each(%$extra_settings)) {
14062: $ValuesHash{$id.'.'.$key} = $value;
14063: }
14064: #
1.646 raeburn 14065: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14066: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14067: }
14068:
14069: ############################################################
14070: ############################################################
14071:
14072: =pod
14073:
1.648 raeburn 14074: =item * &DrawXYGraph()
1.137 matthew 14075:
1.138 matthew 14076: Facilitates the plotting of data in an XY graph.
14077: Puts plot definition data into the users environment in order for
14078: graph.png to plot it. Returns an <img> tag for the plot.
14079:
14080: Inputs:
14081:
14082: =over 4
14083:
14084: =item $Title: string, the title of the plot
14085:
14086: =item $xlabel: string, text describing the X-axis of the plot
14087:
14088: =item $ylabel: string, text describing the Y-axis of the plot
14089:
14090: =item $Max: scalar, the maximum Y value to use in the plot
14091: If $Max is < any data point, the graph will not be rendered.
14092:
14093: =item $colors: Array ref containing the hex color codes for the data to be
14094: plotted in. If undefined, default values will be used.
14095:
14096: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14097:
14098: =item $Ydata: Array ref containing Array refs.
1.185 www 14099: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14100:
14101: =item %Values: hash indicating or overriding any default values which are
14102: passed to graph.png.
14103: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14104:
14105: =back
14106:
14107: Returns:
14108:
14109: An <img> tag which references graph.png and the appropriate identifying
14110: information for the plot.
14111:
1.137 matthew 14112: =cut
14113:
14114: ############################################################
14115: ############################################################
14116: sub DrawXYGraph {
14117: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14118: #
14119: # Create the identifier for the graph
14120: my $identifier = &get_cgi_id();
14121: my $id = 'cgi.'.$identifier;
14122: #
14123: $Title = '' if (! defined($Title));
14124: $xlabel = '' if (! defined($xlabel));
14125: $ylabel = '' if (! defined($ylabel));
14126: my %ValuesHash =
14127: (
1.369 www 14128: $id.'.title' => &escape($Title),
14129: $id.'.xlabel' => &escape($xlabel),
14130: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14131: $id.'.y_max_value'=> $Max,
14132: $id.'.labels' => join(',',@$Xlabels),
14133: $id.'.PlotType' => 'XY',
14134: );
14135: #
14136: if (defined($colors) && ref($colors) eq 'ARRAY') {
14137: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14138: }
14139: #
14140: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14141: return '';
14142: }
14143: my $NumSets=1;
1.138 matthew 14144: foreach my $array (@{$Ydata}){
1.137 matthew 14145: next if (! ref($array));
14146: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14147: }
1.138 matthew 14148: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14149: #
14150: # Deal with other parameters
14151: while (my ($key,$value) = each(%Values)) {
14152: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14153: }
14154: #
1.646 raeburn 14155: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14156: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14157: }
14158:
14159: ############################################################
14160: ############################################################
14161:
14162: =pod
14163:
1.648 raeburn 14164: =item * &DrawXYYGraph()
1.138 matthew 14165:
14166: Facilitates the plotting of data in an XY graph with two Y axes.
14167: Puts plot definition data into the users environment in order for
14168: graph.png to plot it. Returns an <img> tag for the plot.
14169:
14170: Inputs:
14171:
14172: =over 4
14173:
14174: =item $Title: string, the title of the plot
14175:
14176: =item $xlabel: string, text describing the X-axis of the plot
14177:
14178: =item $ylabel: string, text describing the Y-axis of the plot
14179:
14180: =item $colors: Array ref containing the hex color codes for the data to be
14181: plotted in. If undefined, default values will be used.
14182:
14183: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14184:
14185: =item $Ydata1: The first data set
14186:
14187: =item $Min1: The minimum value of the left Y-axis
14188:
14189: =item $Max1: The maximum value of the left Y-axis
14190:
14191: =item $Ydata2: The second data set
14192:
14193: =item $Min2: The minimum value of the right Y-axis
14194:
14195: =item $Max2: The maximum value of the left Y-axis
14196:
14197: =item %Values: hash indicating or overriding any default values which are
14198: passed to graph.png.
14199: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14200:
14201: =back
14202:
14203: Returns:
14204:
14205: An <img> tag which references graph.png and the appropriate identifying
14206: information for the plot.
1.136 matthew 14207:
14208: =cut
14209:
14210: ############################################################
14211: ############################################################
1.137 matthew 14212: sub DrawXYYGraph {
14213: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14214: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14215: #
14216: # Create the identifier for the graph
14217: my $identifier = &get_cgi_id();
14218: my $id = 'cgi.'.$identifier;
14219: #
14220: $Title = '' if (! defined($Title));
14221: $xlabel = '' if (! defined($xlabel));
14222: $ylabel = '' if (! defined($ylabel));
14223: my %ValuesHash =
14224: (
1.369 www 14225: $id.'.title' => &escape($Title),
14226: $id.'.xlabel' => &escape($xlabel),
14227: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14228: $id.'.labels' => join(',',@$Xlabels),
14229: $id.'.PlotType' => 'XY',
14230: $id.'.NumSets' => 2,
1.137 matthew 14231: $id.'.two_axes' => 1,
14232: $id.'.y1_max_value' => $Max1,
14233: $id.'.y1_min_value' => $Min1,
14234: $id.'.y2_max_value' => $Max2,
14235: $id.'.y2_min_value' => $Min2,
1.136 matthew 14236: );
14237: #
1.137 matthew 14238: if (defined($colors) && ref($colors) eq 'ARRAY') {
14239: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14240: }
14241: #
14242: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14243: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14244: return '';
14245: }
14246: my $NumSets=1;
1.137 matthew 14247: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14248: next if (! ref($array));
14249: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14250: }
14251: #
14252: # Deal with other parameters
14253: while (my ($key,$value) = each(%Values)) {
14254: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14255: }
14256: #
1.646 raeburn 14257: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14258: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14259: }
14260:
14261: ############################################################
14262: ############################################################
14263:
14264: =pod
14265:
1.157 matthew 14266: =back
14267:
1.139 matthew 14268: =head1 Statistics helper routines?
14269:
14270: Bad place for them but what the hell.
14271:
1.157 matthew 14272: =over 4
14273:
1.648 raeburn 14274: =item * &chartlink()
1.139 matthew 14275:
14276: Returns a link to the chart for a specific student.
14277:
14278: Inputs:
14279:
14280: =over 4
14281:
14282: =item $linktext: The text of the link
14283:
14284: =item $sname: The students username
14285:
14286: =item $sdomain: The students domain
14287:
14288: =back
14289:
1.157 matthew 14290: =back
14291:
1.139 matthew 14292: =cut
14293:
14294: ############################################################
14295: ############################################################
14296: sub chartlink {
14297: my ($linktext, $sname, $sdomain) = @_;
14298: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14299: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14300: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14301: '">'.$linktext.'</a>';
1.153 matthew 14302: }
14303:
14304: #######################################################
14305: #######################################################
14306:
14307: =pod
14308:
14309: =head1 Course Environment Routines
1.157 matthew 14310:
14311: =over 4
1.153 matthew 14312:
1.648 raeburn 14313: =item * &restore_course_settings()
1.153 matthew 14314:
1.648 raeburn 14315: =item * &store_course_settings()
1.153 matthew 14316:
14317: Restores/Store indicated form parameters from the course environment.
14318: Will not overwrite existing values of the form parameters.
14319:
14320: Inputs:
14321: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14322:
14323: a hash ref describing the data to be stored. For example:
14324:
14325: %Save_Parameters = ('Status' => 'scalar',
14326: 'chartoutputmode' => 'scalar',
14327: 'chartoutputdata' => 'scalar',
14328: 'Section' => 'array',
1.373 raeburn 14329: 'Group' => 'array',
1.153 matthew 14330: 'StudentData' => 'array',
14331: 'Maps' => 'array');
14332:
14333: Returns: both routines return nothing
14334:
1.631 raeburn 14335: =back
14336:
1.153 matthew 14337: =cut
14338:
14339: #######################################################
14340: #######################################################
14341: sub store_course_settings {
1.496 albertel 14342: return &store_settings($env{'request.course.id'},@_);
14343: }
14344:
14345: sub store_settings {
1.153 matthew 14346: # save to the environment
14347: # appenv the same items, just to be safe
1.300 albertel 14348: my $udom = $env{'user.domain'};
14349: my $uname = $env{'user.name'};
1.496 albertel 14350: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14351: my %SaveHash;
14352: my %AppHash;
14353: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14354: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14355: my $envname = 'environment.'.$basename;
1.258 albertel 14356: if (exists($env{'form.'.$setting})) {
1.153 matthew 14357: # Save this value away
14358: if ($type eq 'scalar' &&
1.258 albertel 14359: (! exists($env{$envname}) ||
14360: $env{$envname} ne $env{'form.'.$setting})) {
14361: $SaveHash{$basename} = $env{'form.'.$setting};
14362: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14363: } elsif ($type eq 'array') {
14364: my $stored_form;
1.258 albertel 14365: if (ref($env{'form.'.$setting})) {
1.153 matthew 14366: $stored_form = join(',',
14367: map {
1.369 www 14368: &escape($_);
1.258 albertel 14369: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14370: } else {
14371: $stored_form =
1.369 www 14372: &escape($env{'form.'.$setting});
1.153 matthew 14373: }
14374: # Determine if the array contents are the same.
1.258 albertel 14375: if ($stored_form ne $env{$envname}) {
1.153 matthew 14376: $SaveHash{$basename} = $stored_form;
14377: $AppHash{$envname} = $stored_form;
14378: }
14379: }
14380: }
14381: }
14382: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14383: $udom,$uname);
1.153 matthew 14384: if ($put_result !~ /^(ok|delayed)/) {
14385: &Apache::lonnet::logthis('unable to save form parameters, '.
14386: 'got error:'.$put_result);
14387: }
14388: # Make sure these settings stick around in this session, too
1.646 raeburn 14389: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14390: return;
14391: }
14392:
14393: sub restore_course_settings {
1.499 albertel 14394: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14395: }
14396:
14397: sub restore_settings {
14398: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14399: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14400: next if (exists($env{'form.'.$setting}));
1.496 albertel 14401: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14402: '.'.$setting;
1.258 albertel 14403: if (exists($env{$envname})) {
1.153 matthew 14404: if ($type eq 'scalar') {
1.258 albertel 14405: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14406: } elsif ($type eq 'array') {
1.258 albertel 14407: $env{'form.'.$setting} = [
1.153 matthew 14408: map {
1.369 www 14409: &unescape($_);
1.258 albertel 14410: } split(',',$env{$envname})
1.153 matthew 14411: ];
14412: }
14413: }
14414: }
1.127 matthew 14415: }
14416:
1.618 raeburn 14417: #######################################################
14418: #######################################################
14419:
14420: =pod
14421:
14422: =head1 Domain E-mail Routines
14423:
14424: =over 4
14425:
1.648 raeburn 14426: =item * &build_recipient_list()
1.618 raeburn 14427:
1.1144 raeburn 14428: Build recipient lists for following types of e-mail:
1.766 raeburn 14429: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14430: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14431: module change checking, student/employee ID conflict checks, as
14432: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14433: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14434:
14435: Inputs:
1.619 raeburn 14436: defmail (scalar - email address of default recipient),
1.1144 raeburn 14437: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14438: requestsmail, updatesmail, or idconflictsmail).
14439:
1.619 raeburn 14440: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14441:
1.619 raeburn 14442: origmail (scalar - email address of recipient from loncapa.conf,
14443: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14444:
1.655 raeburn 14445: Returns: comma separated list of addresses to which to send e-mail.
14446:
14447: =back
1.618 raeburn 14448:
14449: =cut
14450:
14451: ############################################################
14452: ############################################################
14453: sub build_recipient_list {
1.619 raeburn 14454: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 14455: my @recipients;
14456: my $otheremails;
14457: my %domconfig =
14458: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
14459: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14460: if (exists($domconfig{'contacts'}{$mailing})) {
14461: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14462: my @contacts = ('adminemail','supportemail');
14463: foreach my $item (@contacts) {
14464: if ($domconfig{'contacts'}{$mailing}{$item}) {
14465: my $addr = $domconfig{'contacts'}{$item};
14466: if (!grep(/^\Q$addr\E$/,@recipients)) {
14467: push(@recipients,$addr);
14468: }
1.619 raeburn 14469: }
1.766 raeburn 14470: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 14471: }
14472: }
1.766 raeburn 14473: } elsif ($origmail ne '') {
14474: push(@recipients,$origmail);
1.618 raeburn 14475: }
1.619 raeburn 14476: } elsif ($origmail ne '') {
14477: push(@recipients,$origmail);
1.618 raeburn 14478: }
1.688 raeburn 14479: if (defined($defmail)) {
14480: if ($defmail ne '') {
14481: push(@recipients,$defmail);
14482: }
1.618 raeburn 14483: }
14484: if ($otheremails) {
1.619 raeburn 14485: my @others;
14486: if ($otheremails =~ /,/) {
14487: @others = split(/,/,$otheremails);
1.618 raeburn 14488: } else {
1.619 raeburn 14489: push(@others,$otheremails);
14490: }
14491: foreach my $addr (@others) {
14492: if (!grep(/^\Q$addr\E$/,@recipients)) {
14493: push(@recipients,$addr);
14494: }
1.618 raeburn 14495: }
14496: }
1.619 raeburn 14497: my $recipientlist = join(',',@recipients);
1.618 raeburn 14498: return $recipientlist;
14499: }
14500:
1.127 matthew 14501: ############################################################
14502: ############################################################
1.154 albertel 14503:
1.655 raeburn 14504: =pod
14505:
1.1224 musolffc 14506: =over 4
14507:
1.1223 musolffc 14508: =item * &mime_email()
14509:
14510: Sends an email with a possible attachment
14511:
14512: Inputs:
14513:
14514: =over 4
14515:
14516: from - Sender's email address
14517:
14518: to - Email address of recipient
14519:
14520: subject - Subject of email
14521:
14522: body - Body of email
14523:
14524: cc_string - Carbon copy email address
14525:
14526: bcc - Blind carbon copy email address
14527:
14528: type - File type of attachment
14529:
14530: attachment_path - Path of file to be attached
14531:
14532: file_name - Name of file to be attached
14533:
14534: attachment_text - The body of an attachment of type "TEXT"
14535:
14536: =back
14537:
14538: =back
14539:
14540: =cut
14541:
14542: ############################################################
14543: ############################################################
14544:
14545: sub mime_email {
14546: my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
14547: $file_name, $attachment_text) = @_;
14548: my $msg = MIME::Lite->new(
14549: From => $from,
14550: To => $to,
14551: Subject => $subject,
14552: Type =>'TEXT',
14553: Data => $body,
14554: );
14555: if ($cc_string ne '') {
14556: $msg->add("Cc" => $cc_string);
14557: }
14558: if ($bcc ne '') {
14559: $msg->add("Bcc" => $bcc);
14560: }
14561: $msg->attr("content-type" => "text/plain");
14562: $msg->attr("content-type.charset" => "UTF-8");
14563: # Attach file if given
14564: if ($attachment_path) {
14565: unless ($file_name) {
14566: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
14567: }
14568: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
14569: $msg->attach(Type => $type,
14570: Path => $attachment_path,
14571: Filename => $file_name
14572: );
14573: # Otherwise attach text if given
14574: } elsif ($attachment_text) {
14575: $msg->attach(Type => 'TEXT',
14576: Data => $attachment_text);
14577: }
14578: # Send it
14579: $msg->send('sendmail');
14580: }
14581:
14582: ############################################################
14583: ############################################################
14584:
14585: =pod
14586:
1.655 raeburn 14587: =head1 Course Catalog Routines
14588:
14589: =over 4
14590:
14591: =item * &gather_categories()
14592:
14593: Converts category definitions - keys of categories hash stored in
14594: coursecategories in configuration.db on the primary library server in a
14595: domain - to an array. Also generates javascript and idx hash used to
14596: generate Domain Coordinator interface for editing Course Categories.
14597:
14598: Inputs:
1.663 raeburn 14599:
1.655 raeburn 14600: categories (reference to hash of category definitions).
1.663 raeburn 14601:
1.655 raeburn 14602: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14603: categories and subcategories).
1.663 raeburn 14604:
1.655 raeburn 14605: idx (reference to hash of counters used in Domain Coordinator interface for
14606: editing Course Categories).
1.663 raeburn 14607:
1.655 raeburn 14608: jsarray (reference to array of categories used to create Javascript arrays for
14609: Domain Coordinator interface for editing Course Categories).
14610:
14611: Returns: nothing
14612:
14613: Side effects: populates cats, idx and jsarray.
14614:
14615: =cut
14616:
14617: sub gather_categories {
14618: my ($categories,$cats,$idx,$jsarray) = @_;
14619: my %counters;
14620: my $num = 0;
14621: foreach my $item (keys(%{$categories})) {
14622: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14623: if ($container eq '' && $depth == 0) {
14624: $cats->[$depth][$categories->{$item}] = $cat;
14625: } else {
14626: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14627: }
14628: my ($escitem,$tail) = split(/:/,$item,2);
14629: if ($counters{$tail} eq '') {
14630: $counters{$tail} = $num;
14631: $num ++;
14632: }
14633: if (ref($idx) eq 'HASH') {
14634: $idx->{$item} = $counters{$tail};
14635: }
14636: if (ref($jsarray) eq 'ARRAY') {
14637: push(@{$jsarray->[$counters{$tail}]},$item);
14638: }
14639: }
14640: return;
14641: }
14642:
14643: =pod
14644:
14645: =item * &extract_categories()
14646:
14647: Used to generate breadcrumb trails for course categories.
14648:
14649: Inputs:
1.663 raeburn 14650:
1.655 raeburn 14651: categories (reference to hash of category definitions).
1.663 raeburn 14652:
1.655 raeburn 14653: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14654: categories and subcategories).
1.663 raeburn 14655:
1.655 raeburn 14656: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14657:
1.655 raeburn 14658: allitems (reference to hash - key is category key
14659: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14660:
1.655 raeburn 14661: idx (reference to hash of counters used in Domain Coordinator interface for
14662: editing Course Categories).
1.663 raeburn 14663:
1.655 raeburn 14664: jsarray (reference to array of categories used to create Javascript arrays for
14665: Domain Coordinator interface for editing Course Categories).
14666:
1.665 raeburn 14667: subcats (reference to hash of arrays containing all subcategories within each
14668: category, -recursive)
14669:
1.655 raeburn 14670: Returns: nothing
14671:
14672: Side effects: populates trails and allitems hash references.
14673:
14674: =cut
14675:
14676: sub extract_categories {
1.665 raeburn 14677: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 14678: if (ref($categories) eq 'HASH') {
14679: &gather_categories($categories,$cats,$idx,$jsarray);
14680: if (ref($cats->[0]) eq 'ARRAY') {
14681: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14682: my $name = $cats->[0][$i];
14683: my $item = &escape($name).'::0';
14684: my $trailstr;
14685: if ($name eq 'instcode') {
14686: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14687: } elsif ($name eq 'communities') {
14688: $trailstr = &mt('Communities');
1.1239 raeburn 14689: } elsif ($name eq 'placement') {
14690: $trailstr = &mt('Placement Tests');
1.655 raeburn 14691: } else {
14692: $trailstr = $name;
14693: }
14694: if ($allitems->{$item} eq '') {
14695: push(@{$trails},$trailstr);
14696: $allitems->{$item} = scalar(@{$trails})-1;
14697: }
14698: my @parents = ($name);
14699: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14700: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14701: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14702: if (ref($subcats) eq 'HASH') {
14703: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14704: }
14705: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
14706: }
14707: } else {
14708: if (ref($subcats) eq 'HASH') {
14709: $subcats->{$item} = [];
1.655 raeburn 14710: }
14711: }
14712: }
14713: }
14714: }
14715: return;
14716: }
14717:
14718: =pod
14719:
1.1162 raeburn 14720: =item * &recurse_categories()
1.655 raeburn 14721:
14722: Recursively used to generate breadcrumb trails for course categories.
14723:
14724: Inputs:
1.663 raeburn 14725:
1.655 raeburn 14726: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14727: categories and subcategories).
1.663 raeburn 14728:
1.655 raeburn 14729: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14730:
14731: category (current course category, for which breadcrumb trail is being generated).
14732:
14733: trails (reference to array of breadcrumb trails for each category).
14734:
1.655 raeburn 14735: allitems (reference to hash - key is category key
14736: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14737:
1.655 raeburn 14738: parents (array containing containers directories for current category,
14739: back to top level).
14740:
14741: Returns: nothing
14742:
14743: Side effects: populates trails and allitems hash references
14744:
14745: =cut
14746:
14747: sub recurse_categories {
1.665 raeburn 14748: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 14749: my $shallower = $depth - 1;
14750: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14751: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14752: my $name = $cats->[$depth]{$category}[$k];
14753: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14754: my $trailstr = join(' -> ',(@{$parents},$category));
14755: if ($allitems->{$item} eq '') {
14756: push(@{$trails},$trailstr);
14757: $allitems->{$item} = scalar(@{$trails})-1;
14758: }
14759: my $deeper = $depth+1;
14760: push(@{$parents},$category);
1.665 raeburn 14761: if (ref($subcats) eq 'HASH') {
14762: my $subcat = &escape($name).':'.$category.':'.$depth;
14763: for (my $j=@{$parents}; $j>=0; $j--) {
14764: my $higher;
14765: if ($j > 0) {
14766: $higher = &escape($parents->[$j]).':'.
14767: &escape($parents->[$j-1]).':'.$j;
14768: } else {
14769: $higher = &escape($parents->[$j]).'::'.$j;
14770: }
14771: push(@{$subcats->{$higher}},$subcat);
14772: }
14773: }
14774: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
14775: $subcats);
1.655 raeburn 14776: pop(@{$parents});
14777: }
14778: } else {
14779: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
14780: my $trailstr = join(' -> ',(@{$parents},$category));
14781: if ($allitems->{$item} eq '') {
14782: push(@{$trails},$trailstr);
14783: $allitems->{$item} = scalar(@{$trails})-1;
14784: }
14785: }
14786: return;
14787: }
14788:
1.663 raeburn 14789: =pod
14790:
1.1162 raeburn 14791: =item * &assign_categories_table()
1.663 raeburn 14792:
14793: Create a datatable for display of hierarchical categories in a domain,
14794: with checkboxes to allow a course to be categorized.
14795:
14796: Inputs:
14797:
14798: cathash - reference to hash of categories defined for the domain (from
14799: configuration.db)
14800:
14801: currcat - scalar with an & separated list of categories assigned to a course.
14802:
1.919 raeburn 14803: type - scalar contains course type (Course or Community).
14804:
1.663 raeburn 14805: Returns: $output (markup to be displayed)
14806:
14807: =cut
14808:
14809: sub assign_categories_table {
1.919 raeburn 14810: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 14811: my $output;
14812: if (ref($cathash) eq 'HASH') {
14813: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
14814: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
14815: $maxdepth = scalar(@cats);
14816: if (@cats > 0) {
14817: my $itemcount = 0;
14818: if (ref($cats[0]) eq 'ARRAY') {
14819: my @currcategories;
14820: if ($currcat ne '') {
14821: @currcategories = split('&',$currcat);
14822: }
1.919 raeburn 14823: my $table;
1.663 raeburn 14824: for (my $i=0; $i<@{$cats[0]}; $i++) {
14825: my $parent = $cats[0][$i];
1.919 raeburn 14826: next if ($parent eq 'instcode');
14827: if ($type eq 'Community') {
14828: next unless ($parent eq 'communities');
1.1239 raeburn 14829: } elsif ($type eq 'Placement') {
14830: next unless ($parent eq 'placement');
1.919 raeburn 14831: } else {
1.1239 raeburn 14832: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 14833: }
1.663 raeburn 14834: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
14835: my $item = &escape($parent).'::0';
14836: my $checked = '';
14837: if (@currcategories > 0) {
14838: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 14839: $checked = ' checked="checked"';
1.663 raeburn 14840: }
14841: }
1.919 raeburn 14842: my $parent_title = $parent;
14843: if ($parent eq 'communities') {
14844: $parent_title = &mt('Communities');
1.1239 raeburn 14845: } elsif ($parent eq 'placement') {
14846: $parent_title = &mt('Placement Tests');
1.919 raeburn 14847: }
14848: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
14849: '<input type="checkbox" name="usecategory" value="'.
14850: $item.'"'.$checked.' />'.$parent_title.'</span>'.
14851: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 14852: my $depth = 1;
14853: push(@path,$parent);
1.919 raeburn 14854: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 14855: pop(@path);
1.919 raeburn 14856: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 14857: $itemcount ++;
14858: }
1.919 raeburn 14859: if ($itemcount) {
14860: $output = &Apache::loncommon::start_data_table().
14861: $table.
14862: &Apache::loncommon::end_data_table();
14863: }
1.663 raeburn 14864: }
14865: }
14866: }
14867: return $output;
14868: }
14869:
14870: =pod
14871:
1.1162 raeburn 14872: =item * &assign_category_rows()
1.663 raeburn 14873:
14874: Create a datatable row for display of nested categories in a domain,
14875: with checkboxes to allow a course to be categorized,called recursively.
14876:
14877: Inputs:
14878:
14879: itemcount - track row number for alternating colors
14880:
14881: cats - reference to array of arrays/hashes which encapsulates hierarchy of
14882: categories and subcategories.
14883:
14884: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
14885:
14886: parent - parent of current category item
14887:
14888: path - Array containing all categories back up through the hierarchy from the
14889: current category to the top level.
14890:
14891: currcategories - reference to array of current categories assigned to the course
14892:
14893: Returns: $output (markup to be displayed).
14894:
14895: =cut
14896:
14897: sub assign_category_rows {
14898: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
14899: my ($text,$name,$item,$chgstr);
14900: if (ref($cats) eq 'ARRAY') {
14901: my $maxdepth = scalar(@{$cats});
14902: if (ref($cats->[$depth]) eq 'HASH') {
14903: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
14904: my $numchildren = @{$cats->[$depth]{$parent}};
14905: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 14906: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 14907: for (my $j=0; $j<$numchildren; $j++) {
14908: $name = $cats->[$depth]{$parent}[$j];
14909: $item = &escape($name).':'.&escape($parent).':'.$depth;
14910: my $deeper = $depth+1;
14911: my $checked = '';
14912: if (ref($currcategories) eq 'ARRAY') {
14913: if (@{$currcategories} > 0) {
14914: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 14915: $checked = ' checked="checked"';
1.663 raeburn 14916: }
14917: }
14918: }
1.664 raeburn 14919: $text .= '<tr><td><span class="LC_nobreak"><label>'.
14920: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 14921: $item.'"'.$checked.' />'.$name.'</label></span>'.
14922: '<input type="hidden" name="catname" value="'.$name.'" />'.
14923: '</td><td>';
1.663 raeburn 14924: if (ref($path) eq 'ARRAY') {
14925: push(@{$path},$name);
14926: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
14927: pop(@{$path});
14928: }
14929: $text .= '</td></tr>';
14930: }
14931: $text .= '</table></td>';
14932: }
14933: }
14934: }
14935: return $text;
14936: }
14937:
1.1181 raeburn 14938: =pod
14939:
14940: =back
14941:
14942: =cut
14943:
1.655 raeburn 14944: ############################################################
14945: ############################################################
14946:
14947:
1.443 albertel 14948: sub commit_customrole {
1.664 raeburn 14949: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14950: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14951: ($start?', '.&mt('starting').' '.localtime($start):'').
14952: ($end?', ending '.localtime($end):'').': <b>'.
14953: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14954: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14955: '</b><br />';
14956: return $output;
14957: }
14958:
14959: sub commit_standardrole {
1.1116 raeburn 14960: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14961: my ($output,$logmsg,$linefeed);
14962: if ($context eq 'auto') {
14963: $linefeed = "\n";
14964: } else {
14965: $linefeed = "<br />\n";
14966: }
1.443 albertel 14967: if ($three eq 'st') {
1.541 raeburn 14968: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 14969: $one,$two,$sec,$context,$credits);
1.541 raeburn 14970: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14971: ($result eq 'unknown_course') || ($result eq 'refused')) {
14972: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14973: } else {
1.541 raeburn 14974: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14975: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14976: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14977: if ($context eq 'auto') {
14978: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14979: } else {
14980: $output .= '<b>'.$result.'</b>'.$linefeed.
14981: &mt('Add to classlist').': <b>ok</b>';
14982: }
14983: $output .= $linefeed;
1.443 albertel 14984: }
14985: } else {
14986: $output = &mt('Assigning').' '.$three.' in '.$url.
14987: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14988: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14989: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14990: if ($context eq 'auto') {
14991: $output .= $result.$linefeed;
14992: } else {
14993: $output .= '<b>'.$result.'</b>'.$linefeed;
14994: }
1.443 albertel 14995: }
14996: return $output;
14997: }
14998:
14999: sub commit_studentrole {
1.1116 raeburn 15000: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15001: $credits) = @_;
1.626 raeburn 15002: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15003: if ($context eq 'auto') {
15004: $linefeed = "\n";
15005: } else {
15006: $linefeed = '<br />'."\n";
15007: }
1.443 albertel 15008: if (defined($one) && defined($two)) {
15009: my $cid=$one.'_'.$two;
15010: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15011: my $secchange = 0;
15012: my $expire_role_result;
15013: my $modify_section_result;
1.628 raeburn 15014: if ($oldsec ne '-1') {
15015: if ($oldsec ne $sec) {
1.443 albertel 15016: $secchange = 1;
1.628 raeburn 15017: my $now = time;
1.443 albertel 15018: my $uurl='/'.$cid;
15019: $uurl=~s/\_/\//g;
15020: if ($oldsec) {
15021: $uurl.='/'.$oldsec;
15022: }
1.626 raeburn 15023: $oldsecurl = $uurl;
1.628 raeburn 15024: $expire_role_result =
1.652 raeburn 15025: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15026: if ($env{'request.course.sec'} ne '') {
15027: if ($expire_role_result eq 'refused') {
15028: my @roles = ('st');
15029: my @statuses = ('previous');
15030: my @roledoms = ($one);
15031: my $withsec = 1;
15032: my %roleshash =
15033: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15034: \@statuses,\@roles,\@roledoms,$withsec);
15035: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15036: my ($oldstart,$oldend) =
15037: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15038: if ($oldend > 0 && $oldend <= $now) {
15039: $expire_role_result = 'ok';
15040: }
15041: }
15042: }
15043: }
1.443 albertel 15044: $result = $expire_role_result;
15045: }
15046: }
15047: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15048: $modify_section_result =
15049: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15050: undef,undef,undef,$sec,
15051: $end,$start,'','',$cid,
15052: '',$context,$credits);
1.443 albertel 15053: if ($modify_section_result =~ /^ok/) {
15054: if ($secchange == 1) {
1.628 raeburn 15055: if ($sec eq '') {
15056: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15057: } else {
15058: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15059: }
1.443 albertel 15060: } elsif ($oldsec eq '-1') {
1.628 raeburn 15061: if ($sec eq '') {
15062: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15063: } else {
15064: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15065: }
1.443 albertel 15066: } else {
1.628 raeburn 15067: if ($sec eq '') {
15068: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15069: } else {
15070: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15071: }
1.443 albertel 15072: }
15073: } else {
1.1115 raeburn 15074: if ($secchange) {
1.628 raeburn 15075: $$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;
15076: } else {
15077: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15078: }
1.443 albertel 15079: }
15080: $result = $modify_section_result;
15081: } elsif ($secchange == 1) {
1.628 raeburn 15082: if ($oldsec eq '') {
1.1103 raeburn 15083: $$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 15084: } else {
15085: $$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;
15086: }
1.626 raeburn 15087: if ($expire_role_result eq 'refused') {
15088: my $newsecurl = '/'.$cid;
15089: $newsecurl =~ s/\_/\//g;
15090: if ($sec ne '') {
15091: $newsecurl.='/'.$sec;
15092: }
15093: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15094: if ($sec eq '') {
15095: $$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;
15096: } else {
15097: $$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;
15098: }
15099: }
15100: }
1.443 albertel 15101: }
15102: } else {
1.626 raeburn 15103: $$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 15104: $result = "error: incomplete course id\n";
15105: }
15106: return $result;
15107: }
15108:
1.1108 raeburn 15109: sub show_role_extent {
15110: my ($scope,$context,$role) = @_;
15111: $scope =~ s{^/}{};
15112: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15113: push(@courseroles,'co');
15114: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15115: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15116: $scope =~ s{/}{_};
15117: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15118: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15119: my ($audom,$auname) = split(/\//,$scope);
15120: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15121: &Apache::loncommon::plainname($auname,$audom).'</span>');
15122: } else {
15123: $scope =~ s{/$}{};
15124: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15125: &Apache::lonnet::domain($scope,'description').'</span>');
15126: }
15127: }
15128:
1.443 albertel 15129: ############################################################
15130: ############################################################
15131:
1.566 albertel 15132: sub check_clone {
1.578 raeburn 15133: my ($args,$linefeed) = @_;
1.566 albertel 15134: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15135: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15136: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15137: my $clonemsg;
15138: my $can_clone = 0;
1.944 raeburn 15139: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15140: if ($lctype ne 'community') {
15141: $lctype = 'course';
15142: }
1.566 albertel 15143: if ($clonehome eq 'no_host') {
1.944 raeburn 15144: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15145: $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'});
15146: } else {
15147: $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'});
15148: }
1.566 albertel 15149: } else {
15150: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15151: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15152: if ($clonedesc{'type'} ne 'Community') {
15153: $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'});
15154: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15155: }
15156: }
1.882 raeburn 15157: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
15158: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15159: $can_clone = 1;
15160: } else {
1.1221 raeburn 15161: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15162: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15163: if ($clonehash{'cloners'} eq '') {
15164: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15165: if ($domdefs{'canclone'}) {
15166: unless ($domdefs{'canclone'} eq 'none') {
15167: if ($domdefs{'canclone'} eq 'domain') {
15168: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15169: $can_clone = 1;
15170: }
15171: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15172: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15173: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15174: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15175: $can_clone = 1;
15176: }
15177: }
15178: }
15179: }
1.578 raeburn 15180: } else {
1.1221 raeburn 15181: my @cloners = split(/,/,$clonehash{'cloners'});
15182: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15183: $can_clone = 1;
1.1221 raeburn 15184: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15185: $can_clone = 1;
1.1225 raeburn 15186: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15187: $can_clone = 1;
1.1221 raeburn 15188: }
15189: unless ($can_clone) {
1.1225 raeburn 15190: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15191: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15192: my (%gotdomdefaults,%gotcodedefaults);
15193: foreach my $cloner (@cloners) {
15194: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15195: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15196: my (%codedefaults,@code_order);
15197: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15198: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15199: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15200: }
15201: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15202: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15203: }
15204: } else {
15205: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15206: \%codedefaults,
15207: \@code_order);
15208: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15209: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15210: }
15211: if (@code_order > 0) {
15212: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15213: $cloner,$clonehash{'internal.coursecode'},
15214: $args->{'crscode'})) {
15215: $can_clone = 1;
15216: last;
15217: }
15218: }
15219: }
15220: }
15221: }
1.1225 raeburn 15222: }
15223: }
15224: unless ($can_clone) {
15225: my $ccrole = 'cc';
15226: if ($args->{'crstype'} eq 'Community') {
15227: $ccrole = 'co';
15228: }
15229: my %roleshash =
15230: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15231: $args->{'ccdomain'},
15232: 'userroles',['active'],[$ccrole],
15233: [$args->{'clonedomain'}]);
15234: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15235: $can_clone = 1;
15236: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15237: $args->{'ccuname'},$args->{'ccdomain'})) {
15238: $can_clone = 1;
1.1221 raeburn 15239: }
15240: }
15241: unless ($can_clone) {
15242: if ($args->{'crstype'} eq 'Community') {
15243: $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 15244: } else {
1.1221 raeburn 15245: $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'});
15246: }
1.566 albertel 15247: }
1.578 raeburn 15248: }
1.566 albertel 15249: }
15250: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15251: }
15252:
1.444 albertel 15253: sub construct_course {
1.1166 raeburn 15254: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 15255: my $outcome;
1.541 raeburn 15256: my $linefeed = '<br />'."\n";
15257: if ($context eq 'auto') {
15258: $linefeed = "\n";
15259: }
1.566 albertel 15260:
15261: #
15262: # Are we cloning?
15263: #
15264: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15265: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15266: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15267: if ($context ne 'auto') {
1.578 raeburn 15268: if ($clonemsg ne '') {
15269: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15270: }
1.566 albertel 15271: }
15272: $outcome .= $clonemsg.$linefeed;
15273:
15274: if (!$can_clone) {
15275: return (0,$outcome);
15276: }
15277: }
15278:
1.444 albertel 15279: #
15280: # Open course
15281: #
1.1239 raeburn 15282: my $showncrstype;
15283: if ($args->{'crstype'} eq 'Placement') {
15284: $showncrstype = 'placement test';
15285: } else {
15286: $showncrstype = lc($args->{'crstype'});
15287: }
1.444 albertel 15288: my %cenv=();
15289: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15290: $args->{'cdescr'},
15291: $args->{'curl'},
15292: $args->{'course_home'},
15293: $args->{'nonstandard'},
15294: $args->{'crscode'},
15295: $args->{'ccuname'}.':'.
15296: $args->{'ccdomain'},
1.882 raeburn 15297: $args->{'crstype'},
1.885 raeburn 15298: $cnum,$context,$category);
1.444 albertel 15299:
15300: # Note: The testing routines depend on this being output; see
15301: # Utils::Course. This needs to at least be output as a comment
15302: # if anyone ever decides to not show this, and Utils::Course::new
15303: # will need to be suitably modified.
1.1239 raeburn 15304: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943 raeburn 15305: if ($$courseid =~ /^error:/) {
15306: return (0,$outcome);
15307: }
15308:
1.444 albertel 15309: #
15310: # Check if created correctly
15311: #
1.479 albertel 15312: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15313: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15314: if ($crsuhome eq 'no_host') {
15315: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15316: return (0,$outcome);
15317: }
1.541 raeburn 15318: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15319:
1.444 albertel 15320: #
1.566 albertel 15321: # Do the cloning
15322: #
15323: if ($can_clone && $cloneid) {
1.1239 raeburn 15324: $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566 albertel 15325: if ($context ne 'auto') {
15326: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15327: }
15328: $outcome .= $clonemsg.$linefeed;
15329: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15330: # Copy all files
1.637 www 15331: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15332: # Restore URL
1.566 albertel 15333: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15334: # Restore title
1.566 albertel 15335: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15336: # Restore creation date, creator and creation context.
15337: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15338: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15339: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15340: # Mark as cloned
1.566 albertel 15341: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15342: # Need to clone grading mode
15343: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15344: $cenv{'grading'}=$newenv{'grading'};
15345: # Do not clone these environment entries
15346: &Apache::lonnet::del('environment',
15347: ['default_enrollment_start_date',
15348: 'default_enrollment_end_date',
15349: 'question.email',
15350: 'policy.email',
15351: 'comment.email',
15352: 'pch.users.denied',
1.725 raeburn 15353: 'plc.users.denied',
15354: 'hidefromcat',
1.1121 raeburn 15355: 'checkforpriv',
1.1166 raeburn 15356: 'categories',
15357: 'internal.uniquecode'],
1.638 www 15358: $$crsudom,$$crsunum);
1.1170 raeburn 15359: if ($args->{'textbook'}) {
15360: $cenv{'internal.textbook'} = $args->{'textbook'};
15361: }
1.444 albertel 15362: }
1.566 albertel 15363:
1.444 albertel 15364: #
15365: # Set environment (will override cloned, if existing)
15366: #
15367: my @sections = ();
15368: my @xlists = ();
15369: if ($args->{'crstype'}) {
15370: $cenv{'type'}=$args->{'crstype'};
15371: }
15372: if ($args->{'crsid'}) {
15373: $cenv{'courseid'}=$args->{'crsid'};
15374: }
15375: if ($args->{'crscode'}) {
15376: $cenv{'internal.coursecode'}=$args->{'crscode'};
15377: }
15378: if ($args->{'crsquota'} ne '') {
15379: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15380: } else {
15381: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15382: }
15383: if ($args->{'ccuname'}) {
15384: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15385: ':'.$args->{'ccdomain'};
15386: } else {
15387: $cenv{'internal.courseowner'} = $args->{'curruser'};
15388: }
1.1116 raeburn 15389: if ($args->{'defaultcredits'}) {
15390: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15391: }
1.444 albertel 15392: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
15393: if ($args->{'crssections'}) {
15394: $cenv{'internal.sectionnums'} = '';
15395: if ($args->{'crssections'} =~ m/,/) {
15396: @sections = split/,/,$args->{'crssections'};
15397: } else {
15398: $sections[0] = $args->{'crssections'};
15399: }
15400: if (@sections > 0) {
15401: foreach my $item (@sections) {
15402: my ($sec,$gp) = split/:/,$item;
15403: my $class = $args->{'crscode'}.$sec;
15404: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15405: $cenv{'internal.sectionnums'} .= $item.',';
15406: unless ($addcheck eq 'ok') {
15407: push @badclasses, $class;
15408: }
15409: }
15410: $cenv{'internal.sectionnums'} =~ s/,$//;
15411: }
15412: }
15413: # do not hide course coordinator from staff listing,
15414: # even if privileged
15415: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 15416: # add course coordinator's domain to domains to check for privileged users
15417: # if different to course domain
15418: if ($$crsudom ne $args->{'ccdomain'}) {
15419: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15420: }
1.444 albertel 15421: # add crosslistings
15422: if ($args->{'crsxlist'}) {
15423: $cenv{'internal.crosslistings'}='';
15424: if ($args->{'crsxlist'} =~ m/,/) {
15425: @xlists = split/,/,$args->{'crsxlist'};
15426: } else {
15427: $xlists[0] = $args->{'crsxlist'};
15428: }
15429: if (@xlists > 0) {
15430: foreach my $item (@xlists) {
15431: my ($xl,$gp) = split/:/,$item;
15432: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15433: $cenv{'internal.crosslistings'} .= $item.',';
15434: unless ($addcheck eq 'ok') {
15435: push @badclasses, $xl;
15436: }
15437: }
15438: $cenv{'internal.crosslistings'} =~ s/,$//;
15439: }
15440: }
15441: if ($args->{'autoadds'}) {
15442: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15443: }
15444: if ($args->{'autodrops'}) {
15445: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15446: }
15447: # check for notification of enrollment changes
15448: my @notified = ();
15449: if ($args->{'notify_owner'}) {
15450: if ($args->{'ccuname'} ne '') {
15451: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15452: }
15453: }
15454: if ($args->{'notify_dc'}) {
15455: if ($uname ne '') {
1.630 raeburn 15456: push(@notified,$uname.':'.$udom);
1.444 albertel 15457: }
15458: }
15459: if (@notified > 0) {
15460: my $notifylist;
15461: if (@notified > 1) {
15462: $notifylist = join(',',@notified);
15463: } else {
15464: $notifylist = $notified[0];
15465: }
15466: $cenv{'internal.notifylist'} = $notifylist;
15467: }
15468: if (@badclasses > 0) {
15469: my %lt=&Apache::lonlocal::texthash(
15470: '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',
15471: 'dnhr' => 'does not have rights to access enrollment in these classes',
15472: 'adby' => 'as determined by the policies of your institution on access to official classlists'
15473: );
1.541 raeburn 15474: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
15475: ' ('.$lt{'adby'}.')';
15476: if ($context eq 'auto') {
15477: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 15478: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 15479: foreach my $item (@badclasses) {
15480: if ($context eq 'auto') {
15481: $outcome .= " - $item\n";
15482: } else {
15483: $outcome .= "<li>$item</li>\n";
15484: }
15485: }
15486: if ($context eq 'auto') {
15487: $outcome .= $linefeed;
15488: } else {
1.566 albertel 15489: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 15490: }
15491: }
1.444 albertel 15492: }
15493: if ($args->{'no_end_date'}) {
15494: $args->{'endaccess'} = 0;
15495: }
15496: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15497: $cenv{'internal.autoend'}=$args->{'enrollend'};
15498: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15499: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15500: if ($args->{'showphotos'}) {
15501: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15502: }
15503: $cenv{'internal.authtype'} = $args->{'authtype'};
15504: $cenv{'internal.autharg'} = $args->{'autharg'};
15505: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15506: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15507: 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');
15508: if ($context eq 'auto') {
15509: $outcome .= $krb_msg;
15510: } else {
1.566 albertel 15511: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15512: }
15513: $outcome .= $linefeed;
1.444 albertel 15514: }
15515: }
15516: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15517: if ($args->{'setpolicy'}) {
15518: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15519: }
15520: if ($args->{'setcontent'}) {
15521: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15522: }
1.1251 raeburn 15523: if ($args->{'setcomment'}) {
15524: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15525: }
1.444 albertel 15526: }
15527: if ($args->{'reshome'}) {
15528: $cenv{'reshome'}=$args->{'reshome'}.'/';
15529: $cenv{'reshome'}=~s/\/+$/\//;
15530: }
15531: #
15532: # course has keyed access
15533: #
15534: if ($args->{'setkeys'}) {
15535: $cenv{'keyaccess'}='yes';
15536: }
15537: # if specified, key authority is not course, but user
15538: # only active if keyaccess is yes
15539: if ($args->{'keyauth'}) {
1.487 albertel 15540: my ($user,$domain) = split(':',$args->{'keyauth'});
15541: $user = &LONCAPA::clean_username($user);
15542: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15543: if ($user ne '' && $domain ne '') {
1.487 albertel 15544: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15545: }
15546: }
15547:
1.1166 raeburn 15548: #
1.1167 raeburn 15549: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 15550: #
15551: if ($args->{'uniquecode'}) {
15552: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15553: if ($code) {
15554: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 15555: my %crsinfo =
15556: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15557: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15558: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15559: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15560: }
1.1166 raeburn 15561: if (ref($coderef)) {
15562: $$coderef = $code;
15563: }
15564: }
15565: }
15566:
1.444 albertel 15567: if ($args->{'disresdis'}) {
15568: $cenv{'pch.roles.denied'}='st';
15569: }
15570: if ($args->{'disablechat'}) {
15571: $cenv{'plc.roles.denied'}='st';
15572: }
15573:
15574: # Record we've not yet viewed the Course Initialization Helper for this
15575: # course
15576: $cenv{'course.helper.not.run'} = 1;
15577: #
15578: # Use new Randomseed
15579: #
15580: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15581: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15582: #
15583: # The encryption code and receipt prefix for this course
15584: #
15585: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15586: $cenv{'internal.encpref'}=100+int(9*rand(99));
15587: #
15588: # By default, use standard grading
15589: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15590:
1.541 raeburn 15591: $outcome .= $linefeed.&mt('Setting environment').': '.
15592: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15593: #
15594: # Open all assignments
15595: #
15596: if ($args->{'openall'}) {
15597: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
15598: my %storecontent = ($storeunder => time,
15599: $storeunder.'.type' => 'date_start');
15600:
15601: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 15602: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15603: }
15604: #
15605: # Set first page
15606: #
15607: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15608: || ($cloneid)) {
1.445 albertel 15609: use LONCAPA::map;
1.444 albertel 15610: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15611:
15612: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15613: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15614:
1.444 albertel 15615: $outcome .= ($fatal?$errtext:'read ok').' - ';
15616: my $title; my $url;
15617: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15618: $title=&mt('Syllabus');
1.444 albertel 15619: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15620: } else {
1.963 raeburn 15621: $title=&mt('Table of Contents');
1.444 albertel 15622: $url='/adm/navmaps';
15623: }
1.445 albertel 15624:
15625: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15626: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15627:
15628: if ($errtext) { $fatal=2; }
1.541 raeburn 15629: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15630: }
1.566 albertel 15631:
1.1237 raeburn 15632: #
15633: # Set params for Placement Tests
15634: #
1.1239 raeburn 15635: if ($args->{'crstype'} eq 'Placement') {
15636: my %storecontent;
15637: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
15638: my %defaults = (
15639: buttonshide => { value => 'yes',
15640: type => 'string_yesno',},
15641: type => { value => 'randomizetry',
15642: type => 'string_questiontype',},
15643: maxtries => { value => 1,
15644: type => 'int_pos',},
15645: problemstatus => { value => 'no',
15646: type => 'string_problemstatus',},
15647: );
15648: foreach my $key (keys(%defaults)) {
15649: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
15650: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
15651: }
1.1237 raeburn 15652: &Apache::lonnet::cput
15653: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
15654: }
15655:
1.566 albertel 15656: return (1,$outcome);
1.444 albertel 15657: }
15658:
1.1166 raeburn 15659: sub make_unique_code {
15660: my ($cdom,$cnum) = @_;
15661: # get lock on uniquecodes db
15662: my $lockhash = {
15663: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15664: ':'.$env{'user.domain'},
15665: };
15666: my $tries = 0;
15667: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15668: my ($code,$error);
15669:
15670: while (($gotlock ne 'ok') && ($tries<3)) {
15671: $tries ++;
15672: sleep 1;
15673: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15674: }
15675: if ($gotlock eq 'ok') {
15676: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15677: my $gotcode;
15678: my $attempts = 0;
15679: while ((!$gotcode) && ($attempts < 100)) {
15680: $code = &generate_code();
15681: if (!exists($currcodes{$code})) {
15682: $gotcode = 1;
15683: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15684: $error = 'nostore';
15685: }
15686: }
15687: $attempts ++;
15688: }
15689: my @del_lock = ($cnum."\0".'uniquecodes');
15690: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15691: } else {
15692: $error = 'nolock';
15693: }
15694: return ($code,$error);
15695: }
15696:
15697: sub generate_code {
15698: my $code;
15699: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15700: for (my $i=0; $i<6; $i++) {
15701: my $lettnum = int (rand 2);
15702: my $item = '';
15703: if ($lettnum) {
15704: $item = $letts[int( rand(18) )];
15705: } else {
15706: $item = 1+int( rand(8) );
15707: }
15708: $code .= $item;
15709: }
15710: return $code;
15711: }
15712:
1.444 albertel 15713: ############################################################
15714: ############################################################
15715:
1.1237 raeburn 15716: # Community, Course and Placement Test
1.378 raeburn 15717: sub course_type {
15718: my ($cid) = @_;
15719: if (!defined($cid)) {
15720: $cid = $env{'request.course.id'};
15721: }
1.404 albertel 15722: if (defined($env{'course.'.$cid.'.type'})) {
15723: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15724: } else {
15725: return 'Course';
1.377 raeburn 15726: }
15727: }
1.156 albertel 15728:
1.406 raeburn 15729: sub group_term {
15730: my $crstype = &course_type();
15731: my %names = (
15732: 'Course' => 'group',
1.865 raeburn 15733: 'Community' => 'group',
1.1237 raeburn 15734: 'Placement' => 'group',
1.406 raeburn 15735: );
15736: return $names{$crstype};
15737: }
15738:
1.902 raeburn 15739: sub course_types {
1.1237 raeburn 15740: my @types = ('official','unofficial','community','textbook','placement');
1.902 raeburn 15741: my %typename = (
15742: official => 'Official course',
15743: unofficial => 'Unofficial course',
15744: community => 'Community',
1.1165 raeburn 15745: textbook => 'Textbook course',
1.1237 raeburn 15746: placement => 'Placement test',
1.902 raeburn 15747: );
15748: return (\@types,\%typename);
15749: }
15750:
1.156 albertel 15751: sub icon {
15752: my ($file)=@_;
1.505 albertel 15753: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 15754: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 15755: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 15756: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
15757: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
15758: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15759: $curfext.".gif") {
15760: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
15761: $curfext.".gif";
15762: }
15763: }
1.249 albertel 15764: return &lonhttpdurl($iconname);
1.154 albertel 15765: }
1.84 albertel 15766:
1.575 albertel 15767: sub lonhttpdurl {
1.692 www 15768: #
15769: # Had been used for "small fry" static images on separate port 8080.
15770: # Modify here if lightweight http functionality desired again.
15771: # Currently eliminated due to increasing firewall issues.
15772: #
1.575 albertel 15773: my ($url)=@_;
1.692 www 15774: return $url;
1.215 albertel 15775: }
15776:
1.213 albertel 15777: sub connection_aborted {
15778: my ($r)=@_;
15779: $r->print(" ");$r->rflush();
15780: my $c = $r->connection;
15781: return $c->aborted();
15782: }
15783:
1.221 foxr 15784: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 15785: # strings as 'strings'.
15786: sub escape_single {
1.221 foxr 15787: my ($input) = @_;
1.223 albertel 15788: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 15789: $input =~ s/\'/\\\'/g; # Esacpe the 's....
15790: return $input;
15791: }
1.223 albertel 15792:
1.222 foxr 15793: # Same as escape_single, but escape's "'s This
15794: # can be used for "strings"
15795: sub escape_double {
15796: my ($input) = @_;
15797: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
15798: $input =~ s/\"/\\\"/g; # Esacpe the "s....
15799: return $input;
15800: }
1.223 albertel 15801:
1.222 foxr 15802: # Escapes the last element of a full URL.
15803: sub escape_url {
15804: my ($url) = @_;
1.238 raeburn 15805: my @urlslices = split(/\//, $url,-1);
1.369 www 15806: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 15807: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 15808: }
1.462 albertel 15809:
1.820 raeburn 15810: sub compare_arrays {
15811: my ($arrayref1,$arrayref2) = @_;
15812: my (@difference,%count);
15813: @difference = ();
15814: %count = ();
15815: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
15816: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
15817: foreach my $element (keys(%count)) {
15818: if ($count{$element} == 1) {
15819: push(@difference,$element);
15820: }
15821: }
15822: }
15823: return @difference;
15824: }
15825:
1.817 bisitz 15826: # -------------------------------------------------------- Initialize user login
1.462 albertel 15827: sub init_user_environment {
1.463 albertel 15828: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 15829: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
15830:
15831: my $public=($username eq 'public' && $domain eq 'public');
15832:
15833: # See if old ID present, if so, remove
15834:
1.1062 raeburn 15835: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 15836: my $now=time;
15837:
15838: if ($public) {
15839: my $max_public=100;
15840: my $oldest;
15841: my $oldest_time=0;
15842: for(my $next=1;$next<=$max_public;$next++) {
15843: if (-e $lonids."/publicuser_$next.id") {
15844: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
15845: if ($mtime<$oldest_time || !$oldest_time) {
15846: $oldest_time=$mtime;
15847: $oldest=$next;
15848: }
15849: } else {
15850: $cookie="publicuser_$next";
15851: last;
15852: }
15853: }
15854: if (!$cookie) { $cookie="publicuser_$oldest"; }
15855: } else {
1.463 albertel 15856: # if this isn't a robot, kill any existing non-robot sessions
15857: if (!$args->{'robot'}) {
15858: opendir(DIR,$lonids);
15859: while ($filename=readdir(DIR)) {
15860: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
15861: unlink($lonids.'/'.$filename);
15862: }
1.462 albertel 15863: }
1.463 albertel 15864: closedir(DIR);
1.1204 raeburn 15865: # If there is a undeleted lockfile for the user's paste buffer remove it.
15866: my $namespace = 'nohist_courseeditor';
15867: my $lockingkey = 'paste'."\0".'locked_num';
15868: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
15869: $domain,$username);
15870: if (exists($lockhash{$lockingkey})) {
15871: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
15872: unless ($delresult eq 'ok') {
15873: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
15874: }
15875: }
1.462 albertel 15876: }
15877: # Give them a new cookie
1.463 albertel 15878: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 15879: : $now.$$.int(rand(10000)));
1.463 albertel 15880: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 15881:
15882: # Initialize roles
15883:
1.1062 raeburn 15884: ($userroles,$firstaccenv,$timerintenv) =
15885: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 15886: }
15887: # ------------------------------------ Check browser type and MathML capability
15888:
1.1194 raeburn 15889: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
15890: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 15891:
15892: # ------------------------------------------------------------- Get environment
15893:
15894: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
15895: my ($tmp) = keys(%userenv);
15896: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
15897: } else {
15898: undef(%userenv);
15899: }
15900: if (($userenv{'interface'}) && (!$form->{'interface'})) {
15901: $form->{'interface'}=$userenv{'interface'};
15902: }
15903: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
15904:
15905: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 15906: foreach my $option ('interface','localpath','localres') {
15907: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 15908: }
15909: # --------------------------------------------------------- Write first profile
15910:
15911: {
15912: my %initial_env =
15913: ("user.name" => $username,
15914: "user.domain" => $domain,
15915: "user.home" => $authhost,
15916: "browser.type" => $clientbrowser,
15917: "browser.version" => $clientversion,
15918: "browser.mathml" => $clientmathml,
15919: "browser.unicode" => $clientunicode,
15920: "browser.os" => $clientos,
1.1137 raeburn 15921: "browser.mobile" => $clientmobile,
1.1141 raeburn 15922: "browser.info" => $clientinfo,
1.1194 raeburn 15923: "browser.osversion" => $clientosversion,
1.462 albertel 15924: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
15925: "request.course.fn" => '',
15926: "request.course.uri" => '',
15927: "request.course.sec" => '',
15928: "request.role" => 'cm',
15929: "request.role.adv" => $env{'user.adv'},
15930: "request.host" => $ENV{'REMOTE_ADDR'},);
15931:
15932: if ($form->{'localpath'}) {
15933: $initial_env{"browser.localpath"} = $form->{'localpath'};
15934: $initial_env{"browser.localres"} = $form->{'localres'};
15935: }
15936:
15937: if ($form->{'interface'}) {
15938: $form->{'interface'}=~s/\W//gs;
15939: $initial_env{"browser.interface"} = $form->{'interface'};
15940: $env{'browser.interface'}=$form->{'interface'};
15941: }
15942:
1.1157 raeburn 15943: if ($form->{'iptoken'}) {
15944: my $lonhost = $r->dir_config('lonHostID');
15945: $initial_env{"user.noloadbalance"} = $lonhost;
15946: $env{'user.noloadbalance'} = $lonhost;
15947: }
15948:
1.981 raeburn 15949: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 15950: my %domdef;
15951: unless ($domain eq 'public') {
15952: %domdef = &Apache::lonnet::get_domain_defaults($domain);
15953: }
1.980 raeburn 15954:
1.1081 raeburn 15955: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 15956: $userenv{'availabletools.'.$tool} =
1.980 raeburn 15957: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
15958: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 15959: }
15960:
1.1237 raeburn 15961: foreach my $crstype ('official','unofficial','community','textbook','placement') {
1.765 raeburn 15962: $userenv{'canrequest.'.$crstype} =
15963: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 15964: 'reload','requestcourses',
15965: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 15966: }
15967:
1.1092 raeburn 15968: $userenv{'canrequest.author'} =
15969: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15970: 'reload','requestauthor',
15971: \%userenv,\%domdef,\%is_adv);
15972: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15973: $domain,$username);
15974: my $reqstatus = $reqauthor{'author_status'};
15975: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15976: if (ref($reqauthor{'author'}) eq 'HASH') {
15977: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15978: $reqauthor{'author'}{'timestamp'};
15979: }
15980: }
15981:
1.462 albertel 15982: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15983:
1.462 albertel 15984: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15985: &GDBM_WRCREAT(),0640)) {
15986: &_add_to_env(\%disk_env,\%initial_env);
15987: &_add_to_env(\%disk_env,\%userenv,'environment.');
15988: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15989: if (ref($firstaccenv) eq 'HASH') {
15990: &_add_to_env(\%disk_env,$firstaccenv);
15991: }
15992: if (ref($timerintenv) eq 'HASH') {
15993: &_add_to_env(\%disk_env,$timerintenv);
15994: }
1.463 albertel 15995: if (ref($args->{'extra_env'})) {
15996: &_add_to_env(\%disk_env,$args->{'extra_env'});
15997: }
1.462 albertel 15998: untie(%disk_env);
15999: } else {
1.705 tempelho 16000: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16001: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16002: return 'error: '.$!;
16003: }
16004: }
16005: $env{'request.role'}='cm';
16006: $env{'request.role.adv'}=$env{'user.adv'};
16007: $env{'browser.type'}=$clientbrowser;
16008:
16009: return $cookie;
16010:
16011: }
16012:
16013: sub _add_to_env {
16014: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16015: if (ref($env_data) eq 'HASH') {
16016: while (my ($key,$value) = each(%$env_data)) {
16017: $idf->{$prefix.$key} = $value;
16018: $env{$prefix.$key} = $value;
16019: }
1.462 albertel 16020: }
16021: }
16022:
1.685 tempelho 16023: # --- Get the symbolic name of a problem and the url
16024: sub get_symb {
16025: my ($request,$silent) = @_;
1.726 raeburn 16026: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16027: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16028: if ($symb eq '') {
16029: if (!$silent) {
1.1071 raeburn 16030: if (ref($request)) {
16031: $request->print("Unable to handle ambiguous references:$url:.");
16032: }
1.685 tempelho 16033: return ();
16034: }
16035: }
16036: &Apache::lonenc::check_decrypt(\$symb);
16037: return ($symb);
16038: }
16039:
16040: # --------------------------------------------------------------Get annotation
16041:
16042: sub get_annotation {
16043: my ($symb,$enc) = @_;
16044:
16045: my $key = $symb;
16046: if (!$enc) {
16047: $key =
16048: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16049: }
16050: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16051: return $annotation{$key};
16052: }
16053:
16054: sub clean_symb {
1.731 raeburn 16055: my ($symb,$delete_enc) = @_;
1.685 tempelho 16056:
16057: &Apache::lonenc::check_decrypt(\$symb);
16058: my $enc = $env{'request.enc'};
1.731 raeburn 16059: if ($delete_enc) {
1.730 raeburn 16060: delete($env{'request.enc'});
16061: }
1.685 tempelho 16062:
16063: return ($symb,$enc);
16064: }
1.462 albertel 16065:
1.1181 raeburn 16066: ############################################################
16067: ############################################################
16068:
16069: =pod
16070:
16071: =head1 Routines for building display used to search for courses
16072:
16073:
16074: =over 4
16075:
16076: =item * &build_filters()
16077:
16078: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16079: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16080: and quotacheck.pl
16081:
1.1181 raeburn 16082:
16083: Inputs:
16084:
16085: filterlist - anonymous array of fields to include as potential filters
16086:
16087: crstype - course type
16088:
16089: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16090: to pop-open a course selector (will contain "extra element").
16091:
16092: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16093:
16094: filter - anonymous hash of criteria and their values
16095:
16096: action - form action
16097:
16098: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16099:
1.1182 raeburn 16100: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16101:
16102: cloneruname - username of owner of new course who wants to clone
16103:
16104: clonerudom - domain of owner of new course who wants to clone
16105:
16106: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16107:
16108: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16109:
16110: codedom - domain
16111:
16112: formname - value of form element named "form".
16113:
16114: fixeddom - domain, if fixed.
16115:
16116: prevphase - value to assign to form element named "phase" when going back to the previous screen
16117:
16118: cnameelement - name of form element in form on opener page which will receive title of selected course
16119:
16120: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16121:
16122: cdomelement - name of form element in form on opener page which will receive domain of selected course
16123:
16124: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16125:
16126: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16127:
16128: clonewarning - warning message about missing information for intended course owner when DC creates a course
16129:
1.1182 raeburn 16130:
1.1181 raeburn 16131: Returns: $output - HTML for display of search criteria, and hidden form elements.
16132:
1.1182 raeburn 16133:
1.1181 raeburn 16134: Side Effects: None
16135:
16136: =cut
16137:
16138: # ---------------------------------------------- search for courses based on last activity etc.
16139:
16140: sub build_filters {
16141: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16142: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16143: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16144: $cnameelement,$cnumelement,$cdomelement,$setroles,
16145: $clonetext,$clonewarning) = @_;
1.1182 raeburn 16146: my ($list,$jscript);
1.1181 raeburn 16147: my $onchange = 'javascript:updateFilters(this)';
16148: my ($domainselectform,$sincefilterform,$createdfilterform,
16149: $ownerdomselectform,$persondomselectform,$instcodeform,
16150: $typeselectform,$instcodetitle);
16151: if ($formname eq '') {
16152: $formname = $caller;
16153: }
16154: foreach my $item (@{$filterlist}) {
16155: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16156: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16157: if ($item eq 'domainfilter') {
16158: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16159: } elsif ($item eq 'coursefilter') {
16160: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16161: } elsif ($item eq 'ownerfilter') {
16162: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16163: } elsif ($item eq 'ownerdomfilter') {
16164: $filter->{'ownerdomfilter'} =
16165: &LONCAPA::clean_domain($filter->{$item});
16166: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16167: 'ownerdomfilter',1);
16168: } elsif ($item eq 'personfilter') {
16169: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16170: } elsif ($item eq 'persondomfilter') {
16171: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16172: 'persondomfilter',1);
16173: } else {
16174: $filter->{$item} =~ s/\W//g;
16175: }
16176: if (!$filter->{$item}) {
16177: $filter->{$item} = '';
16178: }
16179: }
16180: if ($item eq 'domainfilter') {
16181: my $allow_blank = 1;
16182: if ($formname eq 'portform') {
16183: $allow_blank=0;
16184: } elsif ($formname eq 'studentform') {
16185: $allow_blank=0;
16186: }
16187: if ($fixeddom) {
16188: $domainselectform = '<input type="hidden" name="domainfilter"'.
16189: ' value="'.$codedom.'" />'.
16190: &Apache::lonnet::domain($codedom,'description');
16191: } else {
16192: $domainselectform = &select_dom_form($filter->{$item},
16193: 'domainfilter',
16194: $allow_blank,'',$onchange);
16195: }
16196: } else {
16197: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16198: }
16199: }
16200:
16201: # last course activity filter and selection
16202: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16203:
16204: # course created filter and selection
16205: if (exists($filter->{'createdfilter'})) {
16206: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16207: }
16208:
1.1239 raeburn 16209: my $prefix = $crstype;
16210: if ($crstype eq 'Placement') {
16211: $prefix = 'Placement Test'
16212: }
1.1181 raeburn 16213: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 16214: 'cac' => "$prefix Activity",
16215: 'ccr' => "$prefix Created",
16216: 'cde' => "$prefix Title",
16217: 'cdo' => "$prefix Domain",
1.1181 raeburn 16218: 'ins' => 'Institutional Code',
16219: 'inc' => 'Institutional Categorization',
1.1239 raeburn 16220: 'cow' => "$prefix Owner/Co-owner",
16221: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 16222: 'cog' => 'Type',
16223: );
16224:
16225: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16226: my $typeval = 'Course';
16227: if ($crstype eq 'Community') {
16228: $typeval = 'Community';
1.1239 raeburn 16229: } elsif ($crstype eq 'Placement') {
16230: $typeval = 'Placement';
1.1181 raeburn 16231: }
16232: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16233: } else {
16234: $typeselectform = '<select name="type" size="1"';
16235: if ($onchange) {
16236: $typeselectform .= ' onchange="'.$onchange.'"';
16237: }
16238: $typeselectform .= '>'."\n";
1.1237 raeburn 16239: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 16240: my $shown;
16241: if ($posstype eq 'Placement') {
16242: $shown = &mt('Placement Test');
16243: } else {
16244: $shown = &mt($posstype);
16245: }
1.1181 raeburn 16246: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 16247: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 16248: }
16249: $typeselectform.="</select>";
16250: }
16251:
16252: my ($cloneableonlyform,$cloneabletitle);
16253: if (exists($filter->{'cloneableonly'})) {
16254: my $cloneableon = '';
16255: my $cloneableoff = ' checked="checked"';
16256: if ($filter->{'cloneableonly'}) {
16257: $cloneableon = $cloneableoff;
16258: $cloneableoff = '';
16259: }
16260: $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>';
16261: if ($formname eq 'ccrs') {
1.1187 bisitz 16262: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 16263: } else {
16264: $cloneabletitle = &mt('Cloneable by you');
16265: }
16266: }
16267: my $officialjs;
16268: if ($crstype eq 'Course') {
16269: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 16270: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16271: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16272: if ($codedom) {
1.1181 raeburn 16273: $officialjs = 1;
16274: ($instcodeform,$jscript,$$numtitlesref) =
16275: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16276: $officialjs,$codetitlesref);
16277: if ($jscript) {
1.1182 raeburn 16278: $jscript = '<script type="text/javascript">'."\n".
16279: '// <![CDATA['."\n".
16280: $jscript."\n".
16281: '// ]]>'."\n".
16282: '</script>'."\n";
1.1181 raeburn 16283: }
16284: }
16285: if ($instcodeform eq '') {
16286: $instcodeform =
16287: '<input type="text" name="instcodefilter" size="10" value="'.
16288: $list->{'instcodefilter'}.'" />';
16289: $instcodetitle = $lt{'ins'};
16290: } else {
16291: $instcodetitle = $lt{'inc'};
16292: }
16293: if ($fixeddom) {
16294: $instcodetitle .= '<br />('.$codedom.')';
16295: }
16296: }
16297: }
16298: my $output = qq|
16299: <form method="post" name="filterpicker" action="$action">
16300: <input type="hidden" name="form" value="$formname" />
16301: |;
16302: if ($formname eq 'modifycourse') {
16303: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16304: '<input type="hidden" name="prevphase" value="'.
16305: $prevphase.'" />'."\n";
1.1198 musolffc 16306: } elsif ($formname eq 'quotacheck') {
16307: $output .= qq|
16308: <input type="hidden" name="sortby" value="" />
16309: <input type="hidden" name="sortorder" value="" />
16310: |;
16311: } else {
1.1181 raeburn 16312: my $name_input;
16313: if ($cnameelement ne '') {
16314: $name_input = '<input type="hidden" name="cnameelement" value="'.
16315: $cnameelement.'" />';
16316: }
16317: $output .= qq|
1.1182 raeburn 16318: <input type="hidden" name="cnumelement" value="$cnumelement" />
16319: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 16320: $name_input
16321: $roleelement
16322: $multelement
16323: $typeelement
16324: |;
16325: if ($formname eq 'portform') {
16326: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16327: }
16328: }
16329: if ($fixeddom) {
16330: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16331: }
16332: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16333: if ($sincefilterform) {
16334: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16335: .$sincefilterform
16336: .&Apache::lonhtmlcommon::row_closure();
16337: }
16338: if ($createdfilterform) {
16339: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16340: .$createdfilterform
16341: .&Apache::lonhtmlcommon::row_closure();
16342: }
16343: if ($domainselectform) {
16344: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16345: .$domainselectform
16346: .&Apache::lonhtmlcommon::row_closure();
16347: }
16348: if ($typeselectform) {
16349: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16350: $output .= $typeselectform;
16351: } else {
16352: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16353: .$typeselectform
16354: .&Apache::lonhtmlcommon::row_closure();
16355: }
16356: }
16357: if ($instcodeform) {
16358: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16359: .$instcodeform
16360: .&Apache::lonhtmlcommon::row_closure();
16361: }
16362: if (exists($filter->{'ownerfilter'})) {
16363: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16364: '<table><tr><td>'.&mt('Username').'<br />'.
16365: '<input type="text" name="ownerfilter" size="20" value="'.
16366: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16367: $ownerdomselectform.'</td></tr></table>'.
16368: &Apache::lonhtmlcommon::row_closure();
16369: }
16370: if (exists($filter->{'personfilter'})) {
16371: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16372: '<table><tr><td>'.&mt('Username').'<br />'.
16373: '<input type="text" name="personfilter" size="20" value="'.
16374: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16375: $persondomselectform.'</td></tr></table>'.
16376: &Apache::lonhtmlcommon::row_closure();
16377: }
16378: if (exists($filter->{'coursefilter'})) {
16379: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16380: .'<input type="text" name="coursefilter" size="25" value="'
16381: .$list->{'coursefilter'}.'" />'
16382: .&Apache::lonhtmlcommon::row_closure();
16383: }
16384: if ($cloneableonlyform) {
16385: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16386: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16387: }
16388: if (exists($filter->{'descriptfilter'})) {
16389: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16390: .'<input type="text" name="descriptfilter" size="40" value="'
16391: .$list->{'descriptfilter'}.'" />'
16392: .&Apache::lonhtmlcommon::row_closure(1);
16393: }
16394: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16395: '<input type="hidden" name="updater" value="" />'."\n".
16396: '<input type="submit" name="gosearch" value="'.
16397: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16398: return $jscript.$clonewarning.$output;
16399: }
16400:
16401: =pod
16402:
16403: =item * &timebased_select_form()
16404:
1.1182 raeburn 16405: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 16406: filter e.g., Course Activity, Course Created, when searching for courses
16407: or communities
16408:
16409: Inputs:
16410:
16411: item - name of form element (sincefilter or createdfilter)
16412:
16413: filter - anonymous hash of criteria and their values
16414:
16415: Returns: HTML for a select box contained a blank, then six time selections,
16416: with value set in incoming form variables currently selected.
16417:
16418: Side Effects: None
16419:
16420: =cut
16421:
16422: sub timebased_select_form {
16423: my ($item,$filter) = @_;
16424: if (ref($filter) eq 'HASH') {
16425: $filter->{$item} =~ s/[^\d-]//g;
16426: if (!$filter->{$item}) { $filter->{$item}=-1; }
16427: return &select_form(
16428: $filter->{$item},
16429: $item,
16430: { '-1' => '',
16431: '86400' => &mt('today'),
16432: '604800' => &mt('last week'),
16433: '2592000' => &mt('last month'),
16434: '7776000' => &mt('last three months'),
16435: '15552000' => &mt('last six months'),
16436: '31104000' => &mt('last year'),
16437: 'select_form_order' =>
16438: ['-1','86400','604800','2592000','7776000',
16439: '15552000','31104000']});
16440: }
16441: }
16442:
16443: =pod
16444:
16445: =item * &js_changer()
16446:
16447: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 16448: when course type or domain is changed, and also to hide 'Searching ...' on
16449: page load completion for page showing search result.
1.1181 raeburn 16450:
16451: Inputs: None
16452:
1.1183 raeburn 16453: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 16454:
16455: Side Effects: None
16456:
16457: =cut
16458:
16459: sub js_changer {
16460: return <<ENDJS;
16461: <script type="text/javascript">
16462: // <![CDATA[
16463: function updateFilters(caller) {
16464: if (typeof(caller) != "undefined") {
16465: document.filterpicker.updater.value = caller.name;
16466: }
16467: document.filterpicker.submit();
16468: }
1.1183 raeburn 16469:
16470: function hideSearching() {
16471: if (document.getElementById('searching')) {
16472: document.getElementById('searching').style.display = 'none';
16473: }
16474: return;
16475: }
16476:
1.1181 raeburn 16477: // ]]>
16478: </script>
16479:
16480: ENDJS
16481: }
16482:
16483: =pod
16484:
1.1182 raeburn 16485: =item * &search_courses()
16486:
16487: Process selected filters form course search form and pass to lonnet::courseiddump
16488: to retrieve a hash for which keys are courseIDs which match the selected filters.
16489:
16490: Inputs:
16491:
16492: dom - domain being searched
16493:
16494: type - course type ('Course' or 'Community' or '.' if any).
16495:
16496: filter - anonymous hash of criteria and their values
16497:
16498: numtitles - for institutional codes - number of categories
16499:
16500: cloneruname - optional username of new course owner
16501:
16502: clonerudom - optional domain of new course owner
16503:
1.1221 raeburn 16504: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 16505: (used when DC is using course creation form)
16506:
16507: codetitles - reference to array of titles of components in institutional codes (official courses).
16508:
1.1221 raeburn 16509: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16510: (and so can clone automatically)
16511:
16512: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16513:
16514: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16515: courses to clone
1.1182 raeburn 16516:
16517: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16518:
16519:
16520: Side Effects: None
16521:
16522: =cut
16523:
16524:
16525: sub search_courses {
1.1221 raeburn 16526: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16527: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 16528: my (%courses,%showcourses,$cloner);
16529: if (($filter->{'ownerfilter'} ne '') ||
16530: ($filter->{'ownerdomfilter'} ne '')) {
16531: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16532: $filter->{'ownerdomfilter'};
16533: }
16534: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16535: if (!$filter->{$item}) {
16536: $filter->{$item}='.';
16537: }
16538: }
16539: my $now = time;
16540: my $timefilter =
16541: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16542: my ($createdbefore,$createdafter);
16543: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16544: $createdbefore = $now;
16545: $createdafter = $now-$filter->{'createdfilter'};
16546: }
16547: my ($instcodefilter,$regexpok);
16548: if ($numtitles) {
16549: if ($env{'form.official'} eq 'on') {
16550: $instcodefilter =
16551: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16552: $regexpok = 1;
16553: } elsif ($env{'form.official'} eq 'off') {
16554: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16555: unless ($instcodefilter eq '') {
16556: $regexpok = -1;
16557: }
16558: }
16559: } else {
16560: $instcodefilter = $filter->{'instcodefilter'};
16561: }
16562: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16563: if ($type eq '') { $type = '.'; }
16564:
16565: if (($clonerudom ne '') && ($cloneruname ne '')) {
16566: $cloner = $cloneruname.':'.$clonerudom;
16567: }
16568: %courses = &Apache::lonnet::courseiddump($dom,
16569: $filter->{'descriptfilter'},
16570: $timefilter,
16571: $instcodefilter,
16572: $filter->{'combownerfilter'},
16573: $filter->{'coursefilter'},
16574: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 16575: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 16576: $filter->{'cloneableonly'},
16577: $createdbefore,$createdafter,undef,
1.1221 raeburn 16578: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 16579: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16580: my $ccrole;
16581: if ($type eq 'Community') {
16582: $ccrole = 'co';
16583: } else {
16584: $ccrole = 'cc';
16585: }
16586: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16587: $filter->{'persondomfilter'},
16588: 'userroles',undef,
16589: [$ccrole,'in','ad','ep','ta','cr'],
16590: $dom);
16591: foreach my $role (keys(%rolehash)) {
16592: my ($cnum,$cdom,$courserole) = split(':',$role);
16593: my $cid = $cdom.'_'.$cnum;
16594: if (exists($courses{$cid})) {
16595: if (ref($courses{$cid}) eq 'HASH') {
16596: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16597: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
16598: push (@{$courses{$cid}{roles}},$courserole);
16599: }
16600: } else {
16601: $courses{$cid}{roles} = [$courserole];
16602: }
16603: $showcourses{$cid} = $courses{$cid};
16604: }
16605: }
16606: }
16607: %courses = %showcourses;
16608: }
16609: return %courses;
16610: }
16611:
16612: =pod
16613:
1.1181 raeburn 16614: =back
16615:
1.1207 raeburn 16616: =head1 Routines for version requirements for current course.
16617:
16618: =over 4
16619:
16620: =item * &check_release_required()
16621:
16622: Compares required LON-CAPA version with version on server, and
16623: if required version is newer looks for a server with the required version.
16624:
16625: Looks first at servers in user's owen domain; if none suitable, looks at
16626: servers in course's domain are permitted to host sessions for user's domain.
16627:
16628: Inputs:
16629:
16630: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16631:
16632: $courseid - Course ID of current course
16633:
16634: $rolecode - User's current role in course (for switchserver query string).
16635:
16636: $required - LON-CAPA version needed by course (format: Major.Minor).
16637:
16638:
16639: Returns:
16640:
16641: $switchserver - query string tp append to /adm/switchserver call (if
16642: current server's LON-CAPA version is too old.
16643:
16644: $warning - Message is displayed if no suitable server could be found.
16645:
16646: =cut
16647:
16648: sub check_release_required {
16649: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16650: my ($switchserver,$warning);
16651: if ($required ne '') {
16652: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16653: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16654: if ($reqdmajor ne '' && $reqdminor ne '') {
16655: my $otherserver;
16656: if (($major eq '' && $minor eq '') ||
16657: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16658: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16659: my $switchlcrev =
16660: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16661: $userdomserver);
16662: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16663: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16664: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16665: my $cdom = $env{'course.'.$courseid.'.domain'};
16666: if ($cdom ne $env{'user.domain'}) {
16667: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16668: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16669: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16670: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16671: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16672: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16673: my $canhost =
16674: &Apache::lonnet::can_host_session($env{'user.domain'},
16675: $coursedomserver,
16676: $remoterev,
16677: $udomdefaults{'remotesessions'},
16678: $defdomdefaults{'hostedsessions'});
16679:
16680: if ($canhost) {
16681: $otherserver = $coursedomserver;
16682: } else {
16683: $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.");
16684: }
16685: } else {
16686: $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).");
16687: }
16688: } else {
16689: $otherserver = $userdomserver;
16690: }
16691: }
16692: if ($otherserver ne '') {
16693: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16694: }
16695: }
16696: }
16697: return ($switchserver,$warning);
16698: }
16699:
16700: =pod
16701:
16702: =item * &check_release_result()
16703:
16704: Inputs:
16705:
16706: $switchwarning - Warning message if no suitable server found to host session.
16707:
16708: $switchserver - query string to append to /adm/switchserver containing lonHostID
16709: and current role.
16710:
16711: Returns: HTML to display with information about requirement to switch server.
16712: Either displaying warning with link to Roles/Courses screen or
16713: display link to switchserver.
16714:
1.1181 raeburn 16715: =cut
16716:
1.1207 raeburn 16717: sub check_release_result {
16718: my ($switchwarning,$switchserver) = @_;
16719: my $output = &start_page('Selected course unavailable on this server').
16720: '<p class="LC_warning">';
16721: if ($switchwarning) {
16722: $output .= $switchwarning.'<br /><a href="/adm/roles">';
16723: if (&show_course()) {
16724: $output .= &mt('Display courses');
16725: } else {
16726: $output .= &mt('Display roles');
16727: }
16728: $output .= '</a>';
16729: } elsif ($switchserver) {
16730: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
16731: '<br />'.
16732: '<a href="/adm/switchserver?'.$switchserver.'">'.
16733: &mt('Switch Server').
16734: '</a>';
16735: }
16736: $output .= '</p>'.&end_page();
16737: return $output;
16738: }
16739:
16740: =pod
16741:
16742: =item * &needs_coursereinit()
16743:
16744: Determine if course contents stored for user's session needs to be
16745: refreshed, because content has changed since "Big Hash" last tied.
16746:
16747: Check for change is made if time last checked is more than 10 minutes ago
16748: (by default).
16749:
16750: Inputs:
16751:
16752: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16753:
16754: $interval (optional) - Time which may elapse (in s) between last check for content
16755: change in current course. (default: 600 s).
16756:
16757: Returns: an array; first element is:
16758:
16759: =over 4
16760:
16761: 'switch' - if content updates mean user's session
16762: needs to be switched to a server running a newer LON-CAPA version
16763:
16764: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
16765: on current server hosting user's session
16766:
16767: '' - if no action required.
16768:
16769: =back
16770:
16771: If first item element is 'switch':
16772:
16773: second item is $switchwarning - Warning message if no suitable server found to host session.
16774:
16775: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
16776: and current role.
16777:
16778: otherwise: no other elements returned.
16779:
16780: =back
16781:
16782: =cut
16783:
16784: sub needs_coursereinit {
16785: my ($loncaparev,$interval) = @_;
16786: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
16787: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
16788: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
16789: my $now = time;
16790: if ($interval eq '') {
16791: $interval = 600;
16792: }
16793: if (($now-$env{'request.course.timechecked'})>$interval) {
16794: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
16795: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
16796: if ($lastchange > $env{'request.course.tied'}) {
16797: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16798: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
16799: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
16800: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
16801: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
16802: $curr_reqd_hash{'internal.releaserequired'}});
16803: my ($switchserver,$switchwarning) =
16804: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
16805: $curr_reqd_hash{'internal.releaserequired'});
16806: if ($switchwarning ne '' || $switchserver ne '') {
16807: return ('switch',$switchwarning,$switchserver);
16808: }
16809: }
16810: }
16811: return ('update');
16812: }
16813: }
16814: return ();
16815: }
1.1181 raeburn 16816:
1.1083 raeburn 16817: sub update_content_constraints {
16818: my ($cdom,$cnum,$chome,$cid) = @_;
16819: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
16820: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
16821: my %checkresponsetypes;
16822: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 16823: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 16824: if ($item eq 'resourcetag') {
16825: if ($name eq 'responsetype') {
16826: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
16827: }
16828: }
16829: }
16830: my $navmap = Apache::lonnavmaps::navmap->new();
16831: if (defined($navmap)) {
16832: my %allresponses;
16833: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
16834: my %responses = $res->responseTypes();
16835: foreach my $key (keys(%responses)) {
16836: next unless(exists($checkresponsetypes{$key}));
16837: $allresponses{$key} += $responses{$key};
16838: }
16839: }
16840: foreach my $key (keys(%allresponses)) {
16841: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
16842: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
16843: ($reqdmajor,$reqdminor) = ($major,$minor);
16844: }
16845: }
16846: undef($navmap);
16847: }
16848: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
16849: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
16850: }
16851: return;
16852: }
16853:
1.1110 raeburn 16854: sub allmaps_incourse {
16855: my ($cdom,$cnum,$chome,$cid) = @_;
16856: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
16857: $cid = $env{'request.course.id'};
16858: $cdom = $env{'course.'.$cid.'.domain'};
16859: $cnum = $env{'course.'.$cid.'.num'};
16860: $chome = $env{'course.'.$cid.'.home'};
16861: }
16862: my %allmaps = ();
16863: my $lastchange =
16864: &Apache::lonnet::get_coursechange($cdom,$cnum);
16865: if ($lastchange > $env{'request.course.tied'}) {
16866: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
16867: unless ($ferr) {
16868: &update_content_constraints($cdom,$cnum,$chome,$cid);
16869: }
16870: }
16871: my $navmap = Apache::lonnavmaps::navmap->new();
16872: if (defined($navmap)) {
16873: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
16874: $allmaps{$res->src()} = 1;
16875: }
16876: }
16877: return \%allmaps;
16878: }
16879:
1.1083 raeburn 16880: sub parse_supplemental_title {
16881: my ($title) = @_;
16882:
16883: my ($foldertitle,$renametitle);
16884: if ($title =~ /&&&/) {
16885: $title = &HTML::Entites::decode($title);
16886: }
16887: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
16888: $renametitle=$4;
16889: my ($time,$uname,$udom) = ($1,$2,$3);
16890: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
16891: my $name = &plainname($uname,$udom);
16892: $name = &HTML::Entities::encode($name,'"<>&\'');
16893: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
16894: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
16895: $name.': <br />'.$foldertitle;
16896: }
16897: if (wantarray) {
16898: return ($title,$foldertitle,$renametitle);
16899: }
16900: return $title;
16901: }
16902:
1.1143 raeburn 16903: sub recurse_supplemental {
16904: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
16905: if ($suppmap) {
16906: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
16907: if ($fatal) {
16908: $errors ++;
16909: } else {
16910: if ($#LONCAPA::map::resources > 0) {
16911: foreach my $res (@LONCAPA::map::resources) {
16912: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
16913: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 16914: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
16915: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 16916: } else {
16917: $numfiles ++;
16918: }
16919: }
16920: }
16921: }
16922: }
16923: }
16924: return ($numfiles,$errors);
16925: }
16926:
1.1101 raeburn 16927: sub symb_to_docspath {
16928: my ($symb) = @_;
16929: return unless ($symb);
16930: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
16931: if ($resurl=~/\.(sequence|page)$/) {
16932: $mapurl=$resurl;
16933: } elsif ($resurl eq 'adm/navmaps') {
16934: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
16935: }
16936: my $mapresobj;
16937: my $navmap = Apache::lonnavmaps::navmap->new();
16938: if (ref($navmap)) {
16939: $mapresobj = $navmap->getResourceByUrl($mapurl);
16940: }
16941: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
16942: my $type=$2;
16943: my $path;
16944: if (ref($mapresobj)) {
16945: my $pcslist = $mapresobj->map_hierarchy();
16946: if ($pcslist ne '') {
16947: foreach my $pc (split(/,/,$pcslist)) {
16948: next if ($pc <= 1);
16949: my $res = $navmap->getByMapPc($pc);
16950: if (ref($res)) {
16951: my $thisurl = $res->src();
16952: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
16953: my $thistitle = $res->title();
16954: $path .= '&'.
16955: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 16956: &escape($thistitle).
1.1101 raeburn 16957: ':'.$res->randompick().
16958: ':'.$res->randomout().
16959: ':'.$res->encrypted().
16960: ':'.$res->randomorder().
16961: ':'.$res->is_page();
16962: }
16963: }
16964: }
16965: $path =~ s/^\&//;
16966: my $maptitle = $mapresobj->title();
16967: if ($mapurl eq 'default') {
1.1129 raeburn 16968: $maptitle = 'Main Content';
1.1101 raeburn 16969: }
16970: $path .= (($path ne '')? '&' : '').
16971: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16972: &escape($maptitle).
1.1101 raeburn 16973: ':'.$mapresobj->randompick().
16974: ':'.$mapresobj->randomout().
16975: ':'.$mapresobj->encrypted().
16976: ':'.$mapresobj->randomorder().
16977: ':'.$mapresobj->is_page();
16978: } else {
16979: my $maptitle = &Apache::lonnet::gettitle($mapurl);
16980: my $ispage = (($type eq 'page')? 1 : '');
16981: if ($mapurl eq 'default') {
1.1129 raeburn 16982: $maptitle = 'Main Content';
1.1101 raeburn 16983: }
16984: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 16985: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 16986: }
16987: unless ($mapurl eq 'default') {
16988: $path = 'default&'.
1.1146 raeburn 16989: &escape('Main Content').
1.1101 raeburn 16990: ':::::&'.$path;
16991: }
16992: return $path;
16993: }
16994:
1.1094 raeburn 16995: sub captcha_display {
16996: my ($context,$lonhost) = @_;
16997: my ($output,$error);
1.1234 raeburn 16998: my ($captcha,$pubkey,$privkey,$version) =
16999: &get_captcha_config($context,$lonhost);
1.1095 raeburn 17000: if ($captcha eq 'original') {
1.1094 raeburn 17001: $output = &create_captcha();
17002: unless ($output) {
1.1172 raeburn 17003: $error = 'captcha';
1.1094 raeburn 17004: }
17005: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17006: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17007: unless ($output) {
1.1172 raeburn 17008: $error = 'recaptcha';
1.1094 raeburn 17009: }
17010: }
1.1234 raeburn 17011: return ($output,$error,$captcha,$version);
1.1094 raeburn 17012: }
17013:
17014: sub captcha_response {
17015: my ($context,$lonhost) = @_;
17016: my ($captcha_chk,$captcha_error);
1.1234 raeburn 17017: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 17018: if ($captcha eq 'original') {
1.1094 raeburn 17019: ($captcha_chk,$captcha_error) = &check_captcha();
17020: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17021: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17022: } else {
17023: $captcha_chk = 1;
17024: }
17025: return ($captcha_chk,$captcha_error);
17026: }
17027:
17028: sub get_captcha_config {
17029: my ($context,$lonhost) = @_;
1.1234 raeburn 17030: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17031: my $hostname = &Apache::lonnet::hostname($lonhost);
17032: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17033: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17034: if ($context eq 'usercreation') {
17035: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17036: if (ref($domconfig{$context}) eq 'HASH') {
17037: $hashtocheck = $domconfig{$context}{'cancreate'};
17038: if (ref($hashtocheck) eq 'HASH') {
17039: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17040: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17041: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17042: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17043: }
17044: if ($privkey && $pubkey) {
17045: $captcha = 'recaptcha';
1.1234 raeburn 17046: $version = $hashtocheck->{'recaptchaversion'};
17047: if ($version ne '2') {
17048: $version = 1;
17049: }
1.1095 raeburn 17050: } else {
17051: $captcha = 'original';
17052: }
17053: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17054: $captcha = 'original';
17055: }
1.1094 raeburn 17056: }
1.1095 raeburn 17057: } else {
17058: $captcha = 'captcha';
17059: }
17060: } elsif ($context eq 'login') {
17061: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17062: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17063: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17064: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17065: if ($privkey && $pubkey) {
17066: $captcha = 'recaptcha';
1.1234 raeburn 17067: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17068: if ($version ne '2') {
17069: $version = 1;
17070: }
1.1095 raeburn 17071: } else {
17072: $captcha = 'original';
1.1094 raeburn 17073: }
1.1095 raeburn 17074: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17075: $captcha = 'original';
1.1094 raeburn 17076: }
17077: }
1.1234 raeburn 17078: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 17079: }
17080:
17081: sub create_captcha {
17082: my %captcha_params = &captcha_settings();
17083: my ($output,$maxtries,$tries) = ('',10,0);
17084: while ($tries < $maxtries) {
17085: $tries ++;
17086: my $captcha = Authen::Captcha->new (
17087: output_folder => $captcha_params{'output_dir'},
17088: data_folder => $captcha_params{'db_dir'},
17089: );
17090: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17091:
17092: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17093: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
17094: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 17095: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
17096: '<br />'.
17097: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 17098: last;
17099: }
17100: }
17101: return $output;
17102: }
17103:
17104: sub captcha_settings {
17105: my %captcha_params = (
17106: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17107: www_output_dir => "/captchaspool",
17108: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17109: numchars => '5',
17110: );
17111: return %captcha_params;
17112: }
17113:
17114: sub check_captcha {
17115: my ($captcha_chk,$captcha_error);
17116: my $code = $env{'form.code'};
17117: my $md5sum = $env{'form.crypt'};
17118: my %captcha_params = &captcha_settings();
17119: my $captcha = Authen::Captcha->new(
17120: output_folder => $captcha_params{'output_dir'},
17121: data_folder => $captcha_params{'db_dir'},
17122: );
1.1109 raeburn 17123: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 17124: my %captcha_hash = (
17125: 0 => 'Code not checked (file error)',
17126: -1 => 'Failed: code expired',
17127: -2 => 'Failed: invalid code (not in database)',
17128: -3 => 'Failed: invalid code (code does not match crypt)',
17129: );
17130: if ($captcha_chk != 1) {
17131: $captcha_error = $captcha_hash{$captcha_chk}
17132: }
17133: return ($captcha_chk,$captcha_error);
17134: }
17135:
17136: sub create_recaptcha {
1.1234 raeburn 17137: my ($pubkey,$version) = @_;
17138: if ($version >= 2) {
17139: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
17140: } else {
17141: my $use_ssl;
17142: if ($ENV{'SERVER_PORT'} == 443) {
17143: $use_ssl = 1;
17144: }
17145: my $captcha = Captcha::reCAPTCHA->new;
17146: return $captcha->get_options_setter({theme => 'white'})."\n".
17147: $captcha->get_html($pubkey,undef,$use_ssl).
17148: &mt('If the text is hard to read, [_1] will replace them.',
17149: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17150: '<br /><br />';
17151: }
1.1094 raeburn 17152: }
17153:
17154: sub check_recaptcha {
1.1234 raeburn 17155: my ($privkey,$version) = @_;
1.1094 raeburn 17156: my $captcha_chk;
1.1234 raeburn 17157: if ($version >= 2) {
17158: my $ua = LWP::UserAgent->new;
17159: $ua->timeout(10);
17160: my %info = (
17161: secret => $privkey,
17162: response => $env{'form.g-recaptcha-response'},
17163: remoteip => $ENV{'REMOTE_ADDR'},
17164: );
17165: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
17166: if ($response->is_success) {
17167: my $data = JSON::DWIW->from_json($response->decoded_content);
17168: if (ref($data) eq 'HASH') {
17169: if ($data->{'success'}) {
17170: $captcha_chk = 1;
17171: }
17172: }
17173: }
17174: } else {
17175: my $captcha = Captcha::reCAPTCHA->new;
17176: my $captcha_result =
17177: $captcha->check_answer(
17178: $privkey,
17179: $ENV{'REMOTE_ADDR'},
17180: $env{'form.recaptcha_challenge_field'},
17181: $env{'form.recaptcha_response_field'},
17182: );
17183: if ($captcha_result->{is_valid}) {
17184: $captcha_chk = 1;
17185: }
1.1094 raeburn 17186: }
17187: return $captcha_chk;
17188: }
17189:
1.1174 raeburn 17190: sub emailusername_info {
1.1244 raeburn 17191: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 17192: my %titles = &Apache::lonlocal::texthash (
17193: lastname => 'Last Name',
17194: firstname => 'First Name',
17195: institution => 'School/college/university',
17196: location => "School's city, state/province, country",
17197: web => "School's web address",
17198: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 17199: id => 'Student/Employee ID',
1.1174 raeburn 17200: );
17201: return (\@fields,\%titles);
17202: }
17203:
1.1161 raeburn 17204: sub cleanup_html {
17205: my ($incoming) = @_;
17206: my $outgoing;
17207: if ($incoming ne '') {
17208: $outgoing = $incoming;
17209: $outgoing =~ s/;/;/g;
17210: $outgoing =~ s/\#/#/g;
17211: $outgoing =~ s/\&/&/g;
17212: $outgoing =~ s/</</g;
17213: $outgoing =~ s/>/>/g;
17214: $outgoing =~ s/\(/(/g;
17215: $outgoing =~ s/\)/)/g;
17216: $outgoing =~ s/"/"/g;
17217: $outgoing =~ s/'/'/g;
17218: $outgoing =~ s/\$/$/g;
17219: $outgoing =~ s{/}{/}g;
17220: $outgoing =~ s/=/=/g;
17221: $outgoing =~ s/\\/\/g
17222: }
17223: return $outgoing;
17224: }
17225:
1.1190 musolffc 17226: # Checks for critical messages and returns a redirect url if one exists.
17227: # $interval indicates how often to check for messages.
17228: sub critical_redirect {
17229: my ($interval) = @_;
17230: if ((time-$env{'user.criticalcheck.time'})>$interval) {
17231: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17232: $env{'user.name'});
17233: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 17234: my $redirecturl;
1.1190 musolffc 17235: if ($what[0]) {
17236: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
17237: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 17238: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17239: return (1, $url);
1.1190 musolffc 17240: }
1.1191 raeburn 17241: }
17242: }
17243: return ();
1.1190 musolffc 17244: }
17245:
1.1174 raeburn 17246: # Use:
17247: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17248: #
17249: ##################################################
17250: # password associated functions #
17251: ##################################################
17252: sub des_keys {
17253: # Make a new key for DES encryption.
17254: # Each key has two parts which are returned separately.
17255: # Please note: Each key must be passed through the &hex function
17256: # before it is output to the web browser. The hex versions cannot
17257: # be used to decrypt.
17258: my @hexstr=('0','1','2','3','4','5','6','7',
17259: '8','9','a','b','c','d','e','f');
17260: my $lkey='';
17261: for (0..7) {
17262: $lkey.=$hexstr[rand(15)];
17263: }
17264: my $ukey='';
17265: for (0..7) {
17266: $ukey.=$hexstr[rand(15)];
17267: }
17268: return ($lkey,$ukey);
17269: }
17270:
17271: sub des_decrypt {
17272: my ($key,$cyphertext) = @_;
17273: my $keybin=pack("H16",$key);
17274: my $cypher;
17275: if ($Crypt::DES::VERSION>=2.03) {
17276: $cypher=new Crypt::DES $keybin;
17277: } else {
17278: $cypher=new DES $keybin;
17279: }
1.1233 raeburn 17280: my $plaintext='';
17281: my $cypherlength = length($cyphertext);
17282: my $numchunks = int($cypherlength/32);
17283: for (my $j=0; $j<$numchunks; $j++) {
17284: my $start = $j*32;
17285: my $cypherblock = substr($cyphertext,$start,32);
17286: my $chunk =
17287: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17288: $chunk .=
17289: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17290: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17291: $plaintext .= $chunk;
17292: }
1.1174 raeburn 17293: return $plaintext;
17294: }
17295:
1.112 bowersj2 17296: 1;
17297: __END__;
1.41 ng 17298:
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