Annotation of loncom/interface/loncommon.pm, revision 1.1419
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1419 ! raeburn 4: # $Id: loncommon.pm,v 1.1418 2023/11/17 17:02:20 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.1383 raeburn 64: use Apache::lonnavmaps();
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.1409 raeburn 74: use LONCAPA::ltiutils;
1.1280 raeburn 75: use LONCAPA::LWPReq;
1.1395 raeburn 76: use LONCAPA::map();
1.1328 raeburn 77: use HTTP::Request;
1.657 raeburn 78: use DateTime::TimeZone;
1.1241 raeburn 79: use DateTime::Locale;
1.1220 raeburn 80: use Encode();
1.1091 foxr 81: use Text::Aspell;
1.1094 raeburn 82: use Authen::Captcha;
83: use Captcha::reCAPTCHA;
1.1234 raeburn 84: use JSON::DWIW;
1.1174 raeburn 85: use Crypt::DES;
86: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 87: use MIME::Lite;
88: use MIME::Types;
1.1292 raeburn 89: use File::Copy();
1.1300 raeburn 90: use File::Path();
1.1309 raeburn 91: use String::CRC32();
92: use Short::URL();
1.117 www 93:
1.517 raeburn 94: # ---------------------------------------------- Designs
95: use vars qw(%defaultdesign);
96:
1.22 www 97: my $readit;
98:
1.517 raeburn 99:
1.157 matthew 100: ##
101: ## Global Variables
102: ##
1.46 matthew 103:
1.643 foxr 104:
105: # ----------------------------------------------- SSI with retries:
106: #
107:
108: =pod
109:
1.648 raeburn 110: =head1 Server Side include with retries:
1.643 foxr 111:
112: =over 4
113:
1.648 raeburn 114: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 115:
116: Performs an ssi with some number of retries. Retries continue either
117: until the result is ok or until the retry count supplied by the
118: caller is exhausted.
119:
120: Inputs:
1.648 raeburn 121:
122: =over 4
123:
1.643 foxr 124: resource - Identifies the resource to insert.
1.648 raeburn 125:
1.643 foxr 126: retries - Count of the number of retries allowed.
1.648 raeburn 127:
1.643 foxr 128: form - Hash that identifies the rendering options.
129:
1.648 raeburn 130: =back
131:
132: Returns:
133:
134: =over 4
135:
1.643 foxr 136: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 137:
1.643 foxr 138: response - The response from the last attempt (which may or may not have been successful.
139:
1.648 raeburn 140: =back
141:
142: =back
143:
1.643 foxr 144: =cut
145:
146: sub ssi_with_retries {
147: my ($resource, $retries, %form) = @_;
148:
149:
150: my $ok = 0; # True if we got a good response.
151: my $content;
152: my $response;
153:
154: # Try to get the ssi done. within the retries count:
155:
156: do {
157: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
158: $ok = $response->is_success;
1.650 www 159: if (!$ok) {
160: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
161: }
1.643 foxr 162: $retries--;
163: } while (!$ok && ($retries > 0));
164:
165: if (!$ok) {
166: $content = ''; # On error return an empty content.
167: }
168: return ($content, $response);
169:
170: }
171:
172:
173:
1.20 www 174: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 175: my %language;
1.124 www 176: my %supported_language;
1.1088 foxr 177: my %supported_codes;
1.1048 foxr 178: my %latex_language; # For choosing hyphenation in <transl..>
179: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 180: my %cprtag;
1.192 taceyjo1 181: my %scprtag;
1.351 www 182: my %fe; my %fd; my %fm;
1.41 ng 183: my %category_extensions;
1.12 harris41 184:
1.46 matthew 185: # ---------------------------------------------- Thesaurus variables
1.144 matthew 186: #
187: # %Keywords:
188: # A hash used by &keyword to determine if a word is considered a keyword.
189: # $thesaurus_db_file
190: # Scalar containing the full path to the thesaurus database.
1.46 matthew 191:
192: my %Keywords;
193: my $thesaurus_db_file;
194:
1.144 matthew 195: #
196: # Initialize values from language.tab, copyright.tab, filetypes.tab,
197: # thesaurus.tab, and filecategories.tab.
198: #
1.18 www 199: BEGIN {
1.46 matthew 200: # Variable initialization
201: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
202: #
1.22 www 203: unless ($readit) {
1.12 harris41 204: # ------------------------------------------------------------------- languages
205: {
1.158 raeburn 206: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
207: '/language.tab';
1.1317 raeburn 208: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 209: while (my $line = <$fh>) {
210: next if ($line=~/^\#/);
211: chomp($line);
1.1088 foxr 212: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 213: $language{$key}=$val.' - '.$enc;
214: if ($sup) {
215: $supported_language{$key}=$sup;
1.1088 foxr 216: $supported_codes{$key} = $code;
1.158 raeburn 217: }
1.1048 foxr 218: if ($latex) {
219: $latex_language_bykey{$key} = $latex;
1.1088 foxr 220: $latex_language{$code} = $latex;
1.1048 foxr 221: }
1.158 raeburn 222: }
223: close($fh);
224: }
1.12 harris41 225: }
226: # ------------------------------------------------------------------ copyrights
227: {
1.158 raeburn 228: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
229: '/copyright.tab';
1.1317 raeburn 230: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 231: while (my $line = <$fh>) {
232: next if ($line=~/^\#/);
233: chomp($line);
234: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 235: $cprtag{$key}=$val;
236: }
237: close($fh);
238: }
1.12 harris41 239: }
1.351 www 240: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 241: {
242: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
243: '/source_copyright.tab';
1.1317 raeburn 244: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 245: while (my $line = <$fh>) {
246: next if ($line =~ /^\#/);
247: chomp($line);
248: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 249: $scprtag{$key}=$val;
250: }
251: close($fh);
252: }
253: }
1.63 www 254:
1.517 raeburn 255: # -------------------------------------------------------------- default domain designs
1.63 www 256: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 257: my $designfile = $designdir.'/default.tab';
1.1317 raeburn 258: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 259: while (my $line = <$fh>) {
260: next if ($line =~ /^\#/);
261: chomp($line);
262: my ($key,$val)=(split(/\=/,$line));
263: if ($val) { $defaultdesign{$key}=$val; }
264: }
265: close($fh);
1.63 www 266: }
267:
1.15 harris41 268: # ------------------------------------------------------------- file categories
269: {
1.158 raeburn 270: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
271: '/filecategories.tab';
1.1317 raeburn 272: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 273: while (my $line = <$fh>) {
274: next if ($line =~ /^\#/);
275: chomp($line);
276: my ($extension,$category)=(split(/\s+/,$line,2));
1.1263 raeburn 277: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 278: }
279: close($fh);
280: }
281:
1.15 harris41 282: }
1.12 harris41 283: # ------------------------------------------------------------------ file types
284: {
1.158 raeburn 285: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
286: '/filetypes.tab';
1.1317 raeburn 287: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 288: while (my $line = <$fh>) {
289: next if ($line =~ /^\#/);
290: chomp($line);
291: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 292: if ($descr ne '') {
293: $fe{$ending}=lc($emb);
294: $fd{$ending}=$descr;
1.351 www 295: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 296: }
297: }
298: close($fh);
299: }
1.12 harris41 300: }
1.22 www 301: &Apache::lonnet::logthis(
1.705 tempelho 302: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 303: $readit=1;
1.46 matthew 304: } # end of unless($readit)
1.32 matthew 305:
306: }
1.112 bowersj2 307:
1.42 matthew 308: ###############################################################
309: ## HTML and Javascript Helper Functions ##
310: ###############################################################
311:
312: =pod
313:
1.112 bowersj2 314: =head1 HTML and Javascript Functions
1.42 matthew 315:
1.112 bowersj2 316: =over 4
317:
1.648 raeburn 318: =item * &browser_and_searcher_javascript()
1.112 bowersj2 319:
320: X<browsing, javascript>X<searching, javascript>Returns a string
321: containing javascript with two functions, C<openbrowser> and
322: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
323: tags.
1.42 matthew 324:
1.648 raeburn 325: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 326:
327: inputs: formname, elementname, only, omit
328:
329: formname and elementname indicate the name of the html form and name of
330: the element that the results of the browsing selection are to be placed in.
331:
332: Specifying 'only' will restrict the browser to displaying only files
1.185 www 333: with the given extension. Can be a comma separated list.
1.42 matthew 334:
335: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 336: with the given extension. Can be a comma separated list.
1.42 matthew 337:
1.648 raeburn 338: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 339:
340: Inputs: formname, elementname
341:
342: formname and elementname specify the name of the html form and the name
343: of the element the selection from the search results will be placed in.
1.542 raeburn 344:
1.42 matthew 345: =cut
346:
347: sub browser_and_searcher_javascript {
1.199 albertel 348: my ($mode)=@_;
349: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 350: my $resurl=&escape_single(&lastresurl());
1.42 matthew 351: return <<END;
1.219 albertel 352: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 353: var editbrowser = null;
1.135 albertel 354: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 355: var url = '$resurl/?';
1.42 matthew 356: if (editbrowser == null) {
357: url += 'launch=1&';
358: }
359: url += 'catalogmode=interactive&';
1.199 albertel 360: url += 'mode=$mode&';
1.611 albertel 361: url += 'inhibitmenu=yes&';
1.42 matthew 362: url += 'form=' + formname + '&';
363: if (only != null) {
364: url += 'only=' + only + '&';
1.217 albertel 365: } else {
366: url += 'only=&';
367: }
1.42 matthew 368: if (omit != null) {
369: url += 'omit=' + omit + '&';
1.217 albertel 370: } else {
371: url += 'omit=&';
372: }
1.135 albertel 373: if (titleelement != null) {
374: url += 'titleelement=' + titleelement + '&';
1.217 albertel 375: } else {
376: url += 'titleelement=&';
377: }
1.42 matthew 378: url += 'element=' + elementname + '';
379: var title = 'Browser';
1.435 albertel 380: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 381: options += ',width=700,height=600';
382: editbrowser = open(url,title,options,'1');
383: editbrowser.focus();
384: }
385: var editsearcher;
1.135 albertel 386: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 387: var url = '/adm/searchcat?';
388: if (editsearcher == null) {
389: url += 'launch=1&';
390: }
391: url += 'catalogmode=interactive&';
1.199 albertel 392: url += 'mode=$mode&';
1.42 matthew 393: url += 'form=' + formname + '&';
1.135 albertel 394: if (titleelement != null) {
395: url += 'titleelement=' + titleelement + '&';
1.217 albertel 396: } else {
397: url += 'titleelement=&';
398: }
1.42 matthew 399: url += 'element=' + elementname + '';
400: var title = 'Search';
1.435 albertel 401: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 402: options += ',width=700,height=600';
403: editsearcher = open(url,title,options,'1');
404: editsearcher.focus();
405: }
1.219 albertel 406: // END LON-CAPA Internal -->
1.42 matthew 407: END
1.170 www 408: }
409:
410: sub lastresurl {
1.258 albertel 411: if ($env{'environment.lastresurl'}) {
412: return $env{'environment.lastresurl'}
1.170 www 413: } else {
414: return '/res';
415: }
416: }
417:
418: sub storeresurl {
419: my $resurl=&Apache::lonnet::clutter(shift);
420: unless ($resurl=~/^\/res/) { return 0; }
421: $resurl=~s/\/$//;
422: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 423: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 424: return 1;
1.42 matthew 425: }
426:
1.74 www 427: sub studentbrowser_javascript {
1.111 www 428: unless (
1.258 albertel 429: (($env{'request.course.id'}) &&
1.302 albertel 430: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
431: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
432: '/'.$env{'request.course.sec'})
433: ))
1.258 albertel 434: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 435: ) { return ''; }
1.74 www 436: return (<<'ENDSTDBRW');
1.776 bisitz 437: <script type="text/javascript" language="Javascript">
1.824 bisitz 438: // <![CDATA[
1.74 www 439: var stdeditbrowser;
1.1413 raeburn 440: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv,uident) {
1.74 www 441: var url = '/adm/pickstudent?';
442: var filter;
1.558 albertel 443: if (!ignorefilter) {
444: eval('filter=document.'+formname+'.'+uname+'.value;');
445: }
1.74 www 446: if (filter != null) {
447: if (filter != '') {
448: url += 'filter='+filter+'&';
449: }
450: }
451: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 452: '&udomelement='+udom+
453: '&clicker='+clicker;
1.111 www 454: if (roleflag) { url+="&roles=1"; }
1.1337 raeburn 455: if (courseadv == 'condition') {
456: if (document.getElementById('courseadv')) {
457: courseadv = document.getElementById('courseadv').value;
458: }
459: }
460: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.1413 raeburn 461: if (uident !== '') { url+="&identelement="+uident; }
1.102 www 462: var title = 'Student_Browser';
1.74 www 463: var options = 'scrollbars=1,resizable=1,menubar=0';
464: options += ',width=700,height=600';
465: stdeditbrowser = open(url,title,options,'1');
466: stdeditbrowser.focus();
467: }
1.824 bisitz 468: // ]]>
1.74 www 469: </script>
470: ENDSTDBRW
471: }
1.42 matthew 472:
1.1003 www 473: sub resourcebrowser_javascript {
474: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 475: return (<<'ENDRESBRW');
1.1003 www 476: <script type="text/javascript" language="Javascript">
477: // <![CDATA[
478: var reseditbrowser;
1.1004 www 479: function openresbrowser(formname,reslink) {
1.1005 www 480: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 481: var title = 'Resource_Browser';
482: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 483: options += ',width=700,height=500';
1.1004 www 484: reseditbrowser = open(url,title,options,'1');
485: reseditbrowser.focus();
1.1003 www 486: }
487: // ]]>
488: </script>
1.1004 www 489: ENDRESBRW
1.1003 www 490: }
491:
1.74 www 492: sub selectstudent_link {
1.1413 raeburn 493: my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_;
1.999 www 494: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
495: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
496: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 497: if ($env{'request.course.id'}) {
1.302 albertel 498: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
499: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
500: '/'.$env{'request.course.sec'})) {
1.111 www 501: return '';
502: }
1.999 www 503: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1337 raeburn 504: if ($courseadv eq 'only') {
505: $callargs .= ",'',1,'$courseadv'";
506: } elsif ($courseadv eq 'none') {
507: $callargs .= ",'','','$courseadv'";
508: } elsif ($courseadv eq 'condition') {
509: $callargs .= ",'','','$courseadv'";
1.1413 raeburn 510: } elsif ($identelem ne '') {
511: $callargs .= ",'','',''";
512: }
513: if ($identelem ne '') {
514: $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'";
1.793 raeburn 515: }
516: return '<span class="LC_nobreak">'.
517: '<a href="javascript:openstdbrowser('.$callargs.');">'.
518: &mt('Select User').'</a></span>';
1.74 www 519: }
1.258 albertel 520: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 521: $callargs .= ",'',1";
1.793 raeburn 522: return '<span class="LC_nobreak">'.
523: '<a href="javascript:openstdbrowser('.$callargs.');">'.
524: &mt('Select User').'</a></span>';
1.111 www 525: }
526: return '';
1.91 www 527: }
528:
1.1004 www 529: sub selectresource_link {
530: my ($form,$reslink,$arg)=@_;
531:
532: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
533: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
534: unless ($env{'request.course.id'}) { return $arg; }
535: return '<span class="LC_nobreak">'.
536: '<a href="javascript:openresbrowser('.$callargs.');">'.
537: $arg.'</a></span>';
538: }
539:
540:
541:
1.653 raeburn 542: sub authorbrowser_javascript {
543: return <<"ENDAUTHORBRW";
1.776 bisitz 544: <script type="text/javascript" language="JavaScript">
1.824 bisitz 545: // <![CDATA[
1.653 raeburn 546: var stdeditbrowser;
547:
548: function openauthorbrowser(formname,udom) {
549: var url = '/adm/pickauthor?';
550: url += 'form='+formname+'&roledom='+udom;
551: var title = 'Author_Browser';
552: var options = 'scrollbars=1,resizable=1,menubar=0';
553: options += ',width=700,height=600';
554: stdeditbrowser = open(url,title,options,'1');
555: stdeditbrowser.focus();
556: }
557:
1.824 bisitz 558: // ]]>
1.653 raeburn 559: </script>
560: ENDAUTHORBRW
561: }
562:
1.91 www 563: sub coursebrowser_javascript {
1.1116 raeburn 564: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 565: $credits_element,$instcode) = @_;
1.932 raeburn 566: my $wintitle = 'Course_Browser';
1.931 raeburn 567: if ($crstype eq 'Community') {
1.932 raeburn 568: $wintitle = 'Community_Browser';
1.909 raeburn 569: }
1.876 raeburn 570: my $id_functions = &javascript_index_functions();
571: my $output = '
1.776 bisitz 572: <script type="text/javascript" language="JavaScript">
1.824 bisitz 573: // <![CDATA[
1.468 raeburn 574: var stdeditbrowser;'."\n";
1.876 raeburn 575:
576: $output .= <<"ENDSTDBRW";
1.909 raeburn 577: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 578: var url = '/adm/pickcourse?';
1.895 raeburn 579: var formid = getFormIdByName(formname);
1.876 raeburn 580: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 581: if (domainfilter != null) {
582: if (domainfilter != '') {
583: url += 'domainfilter='+domainfilter+'&';
584: }
585: }
1.91 www 586: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 587: '&cdomelement='+udom+
588: '&cnameelement='+desc;
1.468 raeburn 589: if (extra_element !=null && extra_element != '') {
1.594 raeburn 590: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 591: url += '&roleelement='+extra_element;
592: if (domainfilter == null || domainfilter == '') {
593: url += '&domainfilter='+extra_element;
594: }
1.234 raeburn 595: }
1.468 raeburn 596: else {
597: if (formname == 'portform') {
598: url += '&setroles='+extra_element;
1.800 raeburn 599: } else {
600: if (formname == 'rules') {
601: url += '&fixeddom='+extra_element;
602: }
1.468 raeburn 603: }
604: }
1.230 raeburn 605: }
1.909 raeburn 606: if (type != null && type != '') {
607: url += '&type='+type;
608: }
609: if (type_elem != null && type_elem != '') {
610: url += '&typeelement='+type_elem;
611: }
1.872 raeburn 612: if (formname == 'ccrs') {
613: var ownername = document.forms[formid].ccuname.value;
614: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 615: url += '&cloner='+ownername+':'+ownerdom;
616: if (type == 'Course') {
617: url += '&crscode='+document.forms[formid].crscode.value;
618: }
1.1221 raeburn 619: }
620: if (formname == 'requestcrs') {
621: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 622: }
1.293 raeburn 623: if (multflag !=null && multflag != '') {
624: url += '&multiple='+multflag;
625: }
1.909 raeburn 626: var title = '$wintitle';
1.91 www 627: var options = 'scrollbars=1,resizable=1,menubar=0';
628: options += ',width=700,height=600';
629: stdeditbrowser = open(url,title,options,'1');
630: stdeditbrowser.focus();
631: }
1.876 raeburn 632: $id_functions
633: ENDSTDBRW
1.1116 raeburn 634: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
635: $output .= &setsec_javascript($sec_element,$formname,$role_element,
636: $credits_element);
1.876 raeburn 637: }
638: $output .= '
639: // ]]>
640: </script>';
641: return $output;
642: }
643:
644: sub javascript_index_functions {
645: return <<"ENDJS";
646:
647: function getFormIdByName(formname) {
648: for (var i=0;i<document.forms.length;i++) {
649: if (document.forms[i].name == formname) {
650: return i;
651: }
652: }
653: return -1;
654: }
655:
656: function getIndexByName(formid,item) {
657: for (var i=0;i<document.forms[formid].elements.length;i++) {
658: if (document.forms[formid].elements[i].name == item) {
659: return i;
660: }
661: }
662: return -1;
663: }
1.468 raeburn 664:
1.876 raeburn 665: function getDomainFromSelectbox(formname,udom) {
666: var userdom;
667: var formid = getFormIdByName(formname);
668: if (formid > -1) {
669: var domid = getIndexByName(formid,udom);
670: if (domid > -1) {
671: if (document.forms[formid].elements[domid].type == 'select-one') {
672: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
673: }
674: if (document.forms[formid].elements[domid].type == 'hidden') {
675: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 676: }
677: }
678: }
1.876 raeburn 679: return userdom;
680: }
681:
682: ENDJS
1.468 raeburn 683:
1.876 raeburn 684: }
685:
1.1017 raeburn 686: sub javascript_array_indexof {
1.1018 raeburn 687: return <<ENDJS;
1.1017 raeburn 688: <script type="text/javascript" language="JavaScript">
689: // <![CDATA[
690:
691: if (!Array.prototype.indexOf) {
692: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
693: "use strict";
694: if (this === void 0 || this === null) {
695: throw new TypeError();
696: }
697: var t = Object(this);
698: var len = t.length >>> 0;
699: if (len === 0) {
700: return -1;
701: }
702: var n = 0;
703: if (arguments.length > 0) {
704: n = Number(arguments[1]);
1.1088 foxr 705: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 706: n = 0;
707: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
708: n = (n > 0 || -1) * Math.floor(Math.abs(n));
709: }
710: }
711: if (n >= len) {
712: return -1;
713: }
714: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
715: for (; k < len; k++) {
716: if (k in t && t[k] === searchElement) {
717: return k;
718: }
719: }
720: return -1;
721: }
722: }
723:
724: // ]]>
725: </script>
726:
727: ENDJS
728:
729: }
730:
1.876 raeburn 731: sub userbrowser_javascript {
732: my $id_functions = &javascript_index_functions();
733: return <<"ENDUSERBRW";
734:
1.888 raeburn 735: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 736: var url = '/adm/pickuser?';
737: var userdom = getDomainFromSelectbox(formname,udom);
738: if (userdom != null) {
739: if (userdom != '') {
740: url += 'srchdom='+userdom+'&';
741: }
742: }
743: url += 'form=' + formname + '&unameelement='+uname+
744: '&udomelement='+udom+
745: '&ulastelement='+ulast+
746: '&ufirstelement='+ufirst+
747: '&uemailelement='+uemail+
1.881 raeburn 748: '&hideudomelement='+hideudom+
749: '&coursedom='+crsdom;
1.888 raeburn 750: if ((caller != null) && (caller != undefined)) {
751: url += '&caller='+caller;
752: }
1.876 raeburn 753: var title = 'User_Browser';
754: var options = 'scrollbars=1,resizable=1,menubar=0';
755: options += ',width=700,height=600';
756: var stdeditbrowser = open(url,title,options,'1');
757: stdeditbrowser.focus();
758: }
759:
1.888 raeburn 760: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 761: var formid = getFormIdByName(formname);
762: if (formid > -1) {
1.888 raeburn 763: var unameid = getIndexByName(formid,uname);
1.876 raeburn 764: var domid = getIndexByName(formid,udom);
765: var hidedomid = getIndexByName(formid,origdom);
766: if (hidedomid > -1) {
767: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 768: var unameval = document.forms[formid].elements[unameid].value;
769: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
770: if (domid > -1) {
771: var slct = document.forms[formid].elements[domid];
772: if (slct.type == 'select-one') {
773: var i;
774: for (i=0;i<slct.length;i++) {
775: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
776: }
777: }
778: if (slct.type == 'hidden') {
779: slct.value = fixeddom;
1.876 raeburn 780: }
781: }
1.468 raeburn 782: }
783: }
784: }
1.876 raeburn 785: return;
786: }
787:
788: $id_functions
789: ENDUSERBRW
1.468 raeburn 790: }
791:
792: sub setsec_javascript {
1.1116 raeburn 793: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 794: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
795: $communityrolestr);
796: if ($role_element ne '') {
797: my @allroles = ('st','ta','ep','in','ad');
798: foreach my $crstype ('Course','Community') {
799: if ($crstype eq 'Community') {
800: foreach my $role (@allroles) {
801: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
802: }
803: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
804: } else {
805: foreach my $role (@allroles) {
806: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
807: }
808: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
809: }
810: }
811: $rolestr = '"'.join('","',@allroles).'"';
812: $courserolestr = '"'.join('","',@courserolenames).'"';
813: $communityrolestr = '"'.join('","',@communityrolenames).'"';
814: }
1.468 raeburn 815: my $setsections = qq|
816: function setSect(sectionlist) {
1.629 raeburn 817: var sectionsArray = new Array();
818: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
819: sectionsArray = sectionlist.split(",");
820: }
1.468 raeburn 821: var numSections = sectionsArray.length;
822: document.$formname.$sec_element.length = 0;
823: if (numSections == 0) {
824: document.$formname.$sec_element.multiple=false;
825: document.$formname.$sec_element.size=1;
826: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
827: } else {
828: if (numSections == 1) {
829: document.$formname.$sec_element.multiple=false;
830: document.$formname.$sec_element.size=1;
831: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
832: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
833: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
834: } else {
835: for (var i=0; i<numSections; i++) {
836: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
837: }
838: document.$formname.$sec_element.multiple=true
839: if (numSections < 3) {
840: document.$formname.$sec_element.size=numSections;
841: } else {
842: document.$formname.$sec_element.size=3;
843: }
844: document.$formname.$sec_element.options[0].selected = false
845: }
846: }
1.91 www 847: }
1.905 raeburn 848:
849: function setRole(crstype) {
1.468 raeburn 850: |;
1.905 raeburn 851: if ($role_element eq '') {
852: $setsections .= ' return;
853: }
854: ';
855: } else {
856: $setsections .= qq|
857: var elementLength = document.$formname.$role_element.length;
858: var allroles = Array($rolestr);
859: var courserolenames = Array($courserolestr);
860: var communityrolenames = Array($communityrolestr);
861: if (elementLength != undefined) {
862: if (document.$formname.$role_element.options[5].value == 'cc') {
863: if (crstype == 'Course') {
864: return;
865: } else {
866: allroles[5] = 'co';
867: for (var i=0; i<6; i++) {
868: document.$formname.$role_element.options[i].value = allroles[i];
869: document.$formname.$role_element.options[i].text = communityrolenames[i];
870: }
871: }
872: } else {
873: if (crstype == 'Community') {
874: return;
875: } else {
876: allroles[5] = 'cc';
877: for (var i=0; i<6; i++) {
878: document.$formname.$role_element.options[i].value = allroles[i];
879: document.$formname.$role_element.options[i].text = courserolenames[i];
880: }
881: }
882: }
883: }
884: return;
885: }
886: |;
887: }
1.1116 raeburn 888: if ($credits_element) {
889: $setsections .= qq|
890: function setCredits(defaultcredits) {
891: document.$formname.$credits_element.value = defaultcredits;
892: return;
893: }
894: |;
895: }
1.468 raeburn 896: return $setsections;
897: }
898:
1.91 www 899: sub selectcourse_link {
1.909 raeburn 900: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
901: $typeelement) = @_;
902: my $type = $selecttype;
1.871 raeburn 903: my $linktext = &mt('Select Course');
904: if ($selecttype eq 'Community') {
1.909 raeburn 905: $linktext = &mt('Select Community');
1.1239 raeburn 906: } elsif ($selecttype eq 'Placement') {
907: $linktext = &mt('Select Placement Test');
1.906 raeburn 908: } elsif ($selecttype eq 'Course/Community') {
909: $linktext = &mt('Select Course/Community');
1.909 raeburn 910: $type = '';
1.1019 raeburn 911: } elsif ($selecttype eq 'Select') {
912: $linktext = &mt('Select');
913: $type = '';
1.871 raeburn 914: }
1.787 bisitz 915: return '<span class="LC_nobreak">'
916: ."<a href='"
917: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
918: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 919: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 920: ."'>".$linktext.'</a>'
1.787 bisitz 921: .'</span>';
1.74 www 922: }
1.42 matthew 923:
1.653 raeburn 924: sub selectauthor_link {
925: my ($form,$udom)=@_;
926: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
927: &mt('Select Author').'</a>';
928: }
929:
1.876 raeburn 930: sub selectuser_link {
1.881 raeburn 931: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 932: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 933: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 934: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 935: ');">'.$linktext.'</a>';
1.876 raeburn 936: }
937:
1.273 raeburn 938: sub check_uncheck_jscript {
939: my $jscript = <<"ENDSCRT";
940: function checkAll(field) {
941: if (field.length > 0) {
942: for (i = 0; i < field.length; i++) {
1.1093 raeburn 943: if (!field[i].disabled) {
944: field[i].checked = true;
945: }
1.273 raeburn 946: }
947: } else {
1.1093 raeburn 948: if (!field.disabled) {
949: field.checked = true;
950: }
1.273 raeburn 951: }
952: }
953:
954: function uncheckAll(field) {
955: if (field.length > 0) {
956: for (i = 0; i < field.length; i++) {
957: field[i].checked = false ;
1.543 albertel 958: }
959: } else {
1.273 raeburn 960: field.checked = false ;
961: }
962: }
963: ENDSCRT
964: return $jscript;
965: }
966:
1.656 www 967: sub select_timezone {
1.1387 raeburn 968: my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
969: my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659 raeburn 970: if ($includeempty) {
971: $output .= '<option value=""';
972: if (($selected eq '') || ($selected eq 'local')) {
973: $output .= ' selected="selected" ';
974: }
975: $output .= '> </option>';
976: }
1.657 raeburn 977: my @timezones = DateTime::TimeZone->all_names;
978: foreach my $tzone (@timezones) {
979: $output.= '<option value="'.$tzone.'"';
980: if ($tzone eq $selected) {
981: $output.=' selected="selected"';
982: }
983: $output.=">$tzone</option>\n";
1.656 www 984: }
985: $output.="</select>";
986: return $output;
987: }
1.273 raeburn 988:
1.687 raeburn 989: sub select_datelocale {
1.1256 raeburn 990: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
991: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 992: if ($includeempty) {
993: $output .= '<option value=""';
994: if ($selected eq '') {
995: $output .= ' selected="selected" ';
996: }
997: $output .= '> </option>';
998: }
1.1241 raeburn 999: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 1000: my (@possibles,%locale_names);
1.1241 raeburn 1001: my @locales = DateTime::Locale->ids();
1002: foreach my $id (@locales) {
1003: if ($id ne '') {
1004: my ($en_terr,$native_terr);
1005: my $loc = DateTime::Locale->load($id);
1006: if (ref($loc)) {
1007: $en_terr = $loc->name();
1008: $native_terr = $loc->native_name();
1.687 raeburn 1009: if (grep(/^en$/,@languages) || !@languages) {
1010: if ($en_terr ne '') {
1011: $locale_names{$id} = '('.$en_terr.')';
1012: } elsif ($native_terr ne '') {
1013: $locale_names{$id} = $native_terr;
1014: }
1015: } else {
1016: if ($native_terr ne '') {
1017: $locale_names{$id} = $native_terr.' ';
1018: } elsif ($en_terr ne '') {
1019: $locale_names{$id} = '('.$en_terr.')';
1020: }
1021: }
1.1220 raeburn 1022: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1023: push(@possibles,$id);
1024: }
1.687 raeburn 1025: }
1026: }
1027: foreach my $item (sort(@possibles)) {
1028: $output.= '<option value="'.$item.'"';
1029: if ($item eq $selected) {
1030: $output.=' selected="selected"';
1031: }
1032: $output.=">$item";
1033: if ($locale_names{$item} ne '') {
1.1220 raeburn 1034: $output.=' '.$locale_names{$item};
1.687 raeburn 1035: }
1036: $output.="</option>\n";
1037: }
1038: $output.="</select>";
1039: return $output;
1040: }
1041:
1.792 raeburn 1042: sub select_language {
1.1256 raeburn 1043: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1044: my %langchoices;
1045: if ($includeempty) {
1.1117 raeburn 1046: %langchoices = ('' => 'No language preference');
1.792 raeburn 1047: }
1048: foreach my $id (&languageids()) {
1049: my $code = &supportedlanguagecode($id);
1050: if ($code) {
1051: $langchoices{$code} = &plainlanguagedescription($id);
1052: }
1053: }
1.1117 raeburn 1054: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256 raeburn 1055: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1056: }
1057:
1.42 matthew 1058: =pod
1.36 matthew 1059:
1.1088 foxr 1060:
1061: =item * &list_languages()
1062:
1063: Returns an array reference that is suitable for use in language prompters.
1064: Each array element is itself a two element array. The first element
1065: is the language code. The second element a descsriptiuon of the
1066: language itself. This is suitable for use in e.g.
1067: &Apache::edit::select_arg (once dereferenced that is).
1068:
1069: =cut
1070:
1071: sub list_languages {
1072: my @lang_choices;
1073:
1074: foreach my $id (&languageids()) {
1075: my $code = &supportedlanguagecode($id);
1076: if ($code) {
1077: my $selector = $supported_codes{$id};
1078: my $description = &plainlanguagedescription($id);
1.1263 raeburn 1079: push(@lang_choices, [$selector, $description]);
1.1088 foxr 1080: }
1081: }
1082: return \@lang_choices;
1083: }
1084:
1085: =pod
1086:
1.648 raeburn 1087: =item * &linked_select_forms(...)
1.36 matthew 1088:
1089: linked_select_forms returns a string containing a <script></script> block
1090: and html for two <select> menus. The select menus will be linked in that
1091: changing the value of the first menu will result in new values being placed
1092: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1093: order unless a defined order is provided.
1.36 matthew 1094:
1095: linked_select_forms takes the following ordered inputs:
1096:
1097: =over 4
1098:
1.112 bowersj2 1099: =item * $formname, the name of the <form> tag
1.36 matthew 1100:
1.112 bowersj2 1101: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1102:
1.112 bowersj2 1103: =item * $firstdefault, the default value for the first menu
1.36 matthew 1104:
1.112 bowersj2 1105: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1106:
1.112 bowersj2 1107: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1108:
1.112 bowersj2 1109: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1110:
1.609 raeburn 1111: =item * $menuorder, the order of values in the first menu
1112:
1.1115 raeburn 1113: =item * $onchangefirst, additional javascript call to execute for an onchange
1114: event for the first <select> tag
1115:
1116: =item * $onchangesecond, additional javascript call to execute for an onchange
1117: event for the second <select> tag
1118:
1.1245 raeburn 1119: =item * $suffix, to differentiate separate uses of select2data javascript
1120: objects in a page.
1121:
1.41 ng 1122: =back
1123:
1.36 matthew 1124: Below is an example of such a hash. Only the 'text', 'default', and
1125: 'select2' keys must appear as stated. keys(%menu) are the possible
1126: values for the first select menu. The text that coincides with the
1.41 ng 1127: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1128: and text for the second menu are given in the hash pointed to by
1129: $menu{$choice1}->{'select2'}.
1130:
1.112 bowersj2 1131: my %menu = ( A1 => { text =>"Choice A1" ,
1132: default => "B3",
1133: select2 => {
1134: B1 => "Choice B1",
1135: B2 => "Choice B2",
1136: B3 => "Choice B3",
1137: B4 => "Choice B4"
1.609 raeburn 1138: },
1139: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1140: },
1141: A2 => { text =>"Choice A2" ,
1142: default => "C2",
1143: select2 => {
1144: C1 => "Choice C1",
1145: C2 => "Choice C2",
1146: C3 => "Choice C3"
1.609 raeburn 1147: },
1148: order => ['C2','C1','C3'],
1.112 bowersj2 1149: },
1150: A3 => { text =>"Choice A3" ,
1151: default => "D6",
1152: select2 => {
1153: D1 => "Choice D1",
1154: D2 => "Choice D2",
1155: D3 => "Choice D3",
1156: D4 => "Choice D4",
1157: D5 => "Choice D5",
1158: D6 => "Choice D6",
1159: D7 => "Choice D7"
1.609 raeburn 1160: },
1161: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1162: }
1163: );
1.36 matthew 1164:
1165: =cut
1166:
1167: sub linked_select_forms {
1168: my ($formname,
1169: $middletext,
1170: $firstdefault,
1171: $firstselectname,
1172: $secondselectname,
1.609 raeburn 1173: $hashref,
1174: $menuorder,
1.1115 raeburn 1175: $onchangefirst,
1.1245 raeburn 1176: $onchangesecond,
1177: $suffix
1.36 matthew 1178: ) = @_;
1179: my $second = "document.$formname.$secondselectname";
1180: my $first = "document.$formname.$firstselectname";
1181: # output the javascript to do the changing
1182: my $result = '';
1.776 bisitz 1183: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1184: $result.="// <![CDATA[\n";
1.1245 raeburn 1185: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1186: $" = '","';
1187: my $debug = '';
1188: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1189: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1190: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1191: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1192: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1193: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1194: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1195: @s2values = @{$hashref->{$s1}->{'order'}};
1196: }
1.36 matthew 1197: $result.="\"@s2values\");\n";
1.1245 raeburn 1198: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1199: my @s2texts;
1200: foreach my $value (@s2values) {
1.1263 raeburn 1201: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1202: }
1203: $result.="\"@s2texts\");\n";
1204: }
1205: $"=' ';
1206: $result.= <<"END";
1207:
1.1245 raeburn 1208: function select1${suffix}_changed() {
1.36 matthew 1209: // Determine new choice
1.1245 raeburn 1210: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1211: // update select2
1.1245 raeburn 1212: var values = select2data${suffix}[newvalue].values;
1213: var texts = select2data${suffix}[newvalue].texts;
1214: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1215: var i;
1216: // out with the old
1.1245 raeburn 1217: $second.options.length = 0;
1218: // in with the new
1.36 matthew 1219: for (i=0;i<values.length; i++) {
1220: $second.options[i] = new Option(values[i]);
1.143 matthew 1221: $second.options[i].value = values[i];
1.36 matthew 1222: $second.options[i].text = texts[i];
1223: if (values[i] == select2def) {
1224: $second.options[i].selected = true;
1225: }
1226: }
1227: }
1.824 bisitz 1228: // ]]>
1.36 matthew 1229: </script>
1230: END
1231: # output the initial values for the selection lists
1.1245 raeburn 1232: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1233: my @order = sort(keys(%{$hashref}));
1234: if (ref($menuorder) eq 'ARRAY') {
1235: @order = @{$menuorder};
1236: }
1237: foreach my $value (@order) {
1.36 matthew 1238: $result.=" <option value=\"$value\" ";
1.253 albertel 1239: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1240: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1241: }
1242: $result .= "</select>\n";
1.1400 raeburn 1243: my %select2;
1244: if (ref($hashref->{$firstdefault}) eq 'HASH') {
1245: if (ref($hashref->{$firstdefault}->{'select2'}) eq 'HASH') {
1246: %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1247: }
1248: }
1.36 matthew 1249: $result .= $middletext;
1.1115 raeburn 1250: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1251: if ($onchangesecond) {
1252: $result .= ' onchange="'.$onchangesecond.'"';
1253: }
1254: $result .= ">\n";
1.36 matthew 1255: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1256:
1257: my @secondorder = sort(keys(%select2));
1258: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1259: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1260: }
1261: foreach my $value (@secondorder) {
1.36 matthew 1262: $result.=" <option value=\"$value\" ";
1.253 albertel 1263: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1264: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1265: }
1266: $result .= "</select>\n";
1267: # return $debug;
1268: return $result;
1269: } # end of sub linked_select_forms {
1270:
1.45 matthew 1271: =pod
1.44 bowersj2 1272:
1.1381 raeburn 1273: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44 bowersj2 1274:
1.112 bowersj2 1275: Returns a string corresponding to an HTML link to the given help
1276: $topic, where $topic corresponds to the name of a .tex file in
1277: /home/httpd/html/adm/help/tex, with underscores replaced by
1278: spaces.
1279:
1280: $text will optionally be linked to the same topic, allowing you to
1281: link text in addition to the graphic. If you do not want to link
1282: text, but wish to specify one of the later parameters, pass an
1283: empty string.
1284:
1285: $stayOnPage is a value that will be interpreted as a boolean. If true,
1286: the link will not open a new window. If false, the link will open
1287: a new window using Javascript. (Default is false.)
1288:
1289: $width and $height are optional numerical parameters that will
1290: override the width and height of the popped up window, which may
1.973 raeburn 1291: be useful for certain help topics with big pictures included.
1292:
1293: $imgid is the id of the img tag used for the help icon. This may be
1294: used in a javascript call to switch the image src. See
1295: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1296:
1.1381 raeburn 1297: $links_target will optionally be set to a target (_top, _parent or _self).
1298:
1.44 bowersj2 1299: =cut
1300:
1301: sub help_open_topic {
1.1381 raeburn 1302: my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48 bowersj2 1303: $text = "" if (not defined $text);
1.44 bowersj2 1304: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1305: $width = 500 if (not defined $width);
1.44 bowersj2 1306: $height = 400 if (not defined $height);
1307: my $filename = $topic;
1308: $filename =~ s/ /_/g;
1309:
1.48 bowersj2 1310: my $template = "";
1311: my $link;
1.572 banghart 1312:
1.159 www 1313: $topic=~s/\W/\_/g;
1.44 bowersj2 1314:
1.572 banghart 1315: if (!$stayOnPage) {
1.1033 www 1316: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1317: } elsif ($stayOnPage eq 'popup') {
1318: $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 1319: } else {
1.48 bowersj2 1320: $link = "/adm/help/${filename}.hlp";
1321: }
1322:
1323: # Add the text
1.1314 raeburn 1324: my $target = ' target="_top"';
1.1381 raeburn 1325: if ($links_target) {
1326: $target = ' target="'.$links_target.'"';
1327: } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1328: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1329: $target = '';
1.1378 raeburn 1330: }
1.1380 raeburn 1331: if ($text ne "") {
1.763 bisitz 1332: $template.='<span class="LC_help_open_topic">'
1.1314 raeburn 1333: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1334: .$text.'</a>';
1.48 bowersj2 1335: }
1336:
1.763 bisitz 1337: # (Always) Add the graphic
1.179 matthew 1338: my $title = &mt('Online Help');
1.667 raeburn 1339: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1340: if ($imgid ne '') {
1341: $imgid = ' id="'.$imgid.'"';
1342: }
1.1314 raeburn 1343: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1344: .'<img src="'.$helpicon.'" border="0"'
1345: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1346: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1347: .' /></a>';
1348: if ($text ne "") {
1349: $template.='</span>';
1350: }
1.44 bowersj2 1351: return $template;
1352:
1.106 bowersj2 1353: }
1354:
1355: # This is a quicky function for Latex cheatsheet editing, since it
1356: # appears in at least four places
1357: sub helpLatexCheatsheet {
1.1037 www 1358: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1359: my $out;
1.106 bowersj2 1360: my $addOther = '';
1.732 raeburn 1361: if ($topic) {
1.1037 www 1362: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1363: }
1364: $out = '<span>' # Start cheatsheet
1365: .$addOther
1366: .'<span>'
1.1037 www 1367: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1368: .'</span> <span>'
1.1037 www 1369: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1370: .'</span>';
1.732 raeburn 1371: unless ($not_author) {
1.1186 kruse 1372: $out .= '<span>'
1373: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1374: .'</span> <span>'
1375: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1376: .'</span>';
1.732 raeburn 1377: }
1.763 bisitz 1378: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1379: return $out;
1.172 www 1380: }
1381:
1.430 albertel 1382: sub general_help {
1383: my $helptopic='Student_Intro';
1384: if ($env{'request.role'}=~/^(ca|au)/) {
1385: $helptopic='Authoring_Intro';
1.907 raeburn 1386: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1387: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1388: } elsif ($env{'request.role'}=~/^dc/) {
1389: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1390: }
1391: return $helptopic;
1392: }
1393:
1394: sub update_help_link {
1395: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1396: my $origurl = $ENV{'REQUEST_URI'};
1397: $origurl=~s|^/~|/priv/|;
1398: my $timestamp = time;
1399: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1400: $$datum = &escape($$datum);
1401: }
1402:
1403: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1404: my $output .= <<"ENDOUTPUT";
1405: <script type="text/javascript">
1.824 bisitz 1406: // <![CDATA[
1.430 albertel 1407: banner_link = '$banner_link';
1.824 bisitz 1408: // ]]>
1.430 albertel 1409: </script>
1410: ENDOUTPUT
1411: return $output;
1412: }
1413:
1414: # now just updates the help link and generates a blue icon
1.193 raeburn 1415: sub help_open_menu {
1.1381 raeburn 1416: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)
1.552 banghart 1417: = @_;
1.949 droeschl 1418: $stayOnPage = 1;
1.430 albertel 1419: my $output;
1420: if ($component_help) {
1421: if (!$text) {
1422: $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1381 raeburn 1423: $width,$height,'',$links_target);
1.430 albertel 1424: } else {
1425: my $help_text;
1426: $help_text=&unescape($topic);
1427: $output='<table><tr><td>'.
1428: &help_open_topic($component_help,$help_text,$stayOnPage,
1.1381 raeburn 1429: $width,$height,'',$links_target).'</td></tr></table>';
1.430 albertel 1430: }
1431: }
1432: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1433: return $output.$banner_link;
1434: }
1435:
1436: sub top_nav_help {
1.1369 raeburn 1437: my ($text,$linkattr) = @_;
1.436 albertel 1438: $text = &mt($text);
1.949 droeschl 1439: my $stay_on_page = 1;
1440:
1.1168 raeburn 1441: my ($link,$banner_link);
1442: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1443: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1444: : "javascript:helpMenu('open')";
1445: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1446: }
1.201 raeburn 1447: my $title = &mt('Get help');
1.1168 raeburn 1448: if ($link) {
1449: return <<"END";
1.436 albertel 1450: $banner_link
1.1369 raeburn 1451: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1452: END
1.1168 raeburn 1453: } else {
1454: return ' '.$text.' ';
1455: }
1.436 albertel 1456: }
1457:
1458: sub help_menu_js {
1.1154 raeburn 1459: my ($httphost) = @_;
1.949 droeschl 1460: my $stayOnPage = 1;
1.436 albertel 1461: my $width = 620;
1462: my $height = 600;
1.430 albertel 1463: my $helptopic=&general_help();
1.1154 raeburn 1464: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1465: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1466: my $start_page =
1467: &Apache::loncommon::start_page('Help Menu', undef,
1468: {'frameset' => 1,
1469: 'js_ready' => 1,
1.1154 raeburn 1470: 'use_absolute' => $httphost,
1.331 albertel 1471: 'add_entries' => {
1.1168 raeburn 1472: 'border' => '0',
1.579 raeburn 1473: 'rows' => "110,*",},});
1.331 albertel 1474: my $end_page =
1475: &Apache::loncommon::end_page({'frameset' => 1,
1476: 'js_ready' => 1,});
1477:
1.436 albertel 1478: my $template .= <<"ENDTEMPLATE";
1479: <script type="text/javascript">
1.877 bisitz 1480: // <![CDATA[
1.253 albertel 1481: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1482: var banner_link = '';
1.243 raeburn 1483: function helpMenu(target) {
1484: var caller = this;
1485: if (target == 'open') {
1486: var newWindow = null;
1487: try {
1.262 albertel 1488: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1489: }
1490: catch(error) {
1491: writeHelp(caller);
1492: return;
1493: }
1494: if (newWindow) {
1495: caller = newWindow;
1496: }
1.193 raeburn 1497: }
1.243 raeburn 1498: writeHelp(caller);
1499: return;
1500: }
1501: function writeHelp(caller) {
1.1168 raeburn 1502: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1503: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1504: caller.document.close();
1505: caller.focus();
1.193 raeburn 1506: }
1.877 bisitz 1507: // END LON-CAPA Internal -->
1.253 albertel 1508: // ]]>
1.436 albertel 1509: </script>
1.193 raeburn 1510: ENDTEMPLATE
1511: return $template;
1512: }
1513:
1.172 www 1514: sub help_open_bug {
1515: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1516: unless ($env{'user.adv'}) { return ''; }
1.172 www 1517: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1518: $text = "" if (not defined $text);
1519: $stayOnPage=1;
1.184 albertel 1520: $width = 600 if (not defined $width);
1521: $height = 600 if (not defined $height);
1.172 www 1522:
1523: $topic=~s/\W+/\+/g;
1524: my $link='';
1525: my $template='';
1.379 albertel 1526: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1527: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1528: if (!$stayOnPage)
1529: {
1530: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1531: }
1532: else
1533: {
1534: $link = $url;
1535: }
1.1314 raeburn 1536:
1.1382 raeburn 1537: my $target = '_top';
1538: if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1539: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1540: $target = '_blank';
1.1378 raeburn 1541: }
1.1382 raeburn 1542:
1.172 www 1543: # Add the text
1544: if ($text ne "")
1545: {
1546: $template .=
1547: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1382 raeburn 1548: "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1549: }
1550:
1551: # Add the graphic
1.179 matthew 1552: my $title = &mt('Report a Bug');
1.215 albertel 1553: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1554: $template .= <<"ENDTEMPLATE";
1.1382 raeburn 1555: <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1556: ENDTEMPLATE
1557: if ($text ne '') { $template.='</td></tr></table>' };
1558: return $template;
1559:
1560: }
1561:
1562: sub help_open_faq {
1563: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1564: unless ($env{'user.adv'}) { return ''; }
1.172 www 1565: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1566: $text = "" if (not defined $text);
1567: $stayOnPage=1;
1568: $width = 350 if (not defined $width);
1569: $height = 400 if (not defined $height);
1570:
1571: $topic=~s/\W+/\+/g;
1572: my $link='';
1573: my $template='';
1574: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1575: if (!$stayOnPage)
1576: {
1577: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1578: }
1579: else
1580: {
1581: $link = $url;
1582: }
1583:
1584: # Add the text
1585: if ($text ne "")
1586: {
1587: $template .=
1.173 www 1588: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1589: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1590: }
1591:
1592: # Add the graphic
1.179 matthew 1593: my $title = &mt('View the FAQ');
1.215 albertel 1594: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1595: $template .= <<"ENDTEMPLATE";
1.436 albertel 1596: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1597: ENDTEMPLATE
1598: if ($text ne '') { $template.='</td></tr></table>' };
1599: return $template;
1600:
1.44 bowersj2 1601: }
1.37 matthew 1602:
1.180 matthew 1603: ###############################################################
1604: ###############################################################
1605:
1.45 matthew 1606: =pod
1607:
1.648 raeburn 1608: =item * &change_content_javascript():
1.256 matthew 1609:
1610: This and the next function allow you to create small sections of an
1611: otherwise static HTML page that you can update on the fly with
1612: Javascript, even in Netscape 4.
1613:
1614: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1615: must be written to the HTML page once. It will prove the Javascript
1616: function "change(name, content)". Calling the change function with the
1617: name of the section
1618: you want to update, matching the name passed to C<changable_area>, and
1619: the new content you want to put in there, will put the content into
1620: that area.
1621:
1622: B<Note>: Netscape 4 only reserves enough space for the changable area
1623: to contain room for the original contents. You need to "make space"
1624: for whatever changes you wish to make, and be B<sure> to check your
1625: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1626: it's adequate for updating a one-line status display, but little more.
1627: This script will set the space to 100% width, so you only need to
1628: worry about height in Netscape 4.
1629:
1630: Modern browsers are much less limiting, and if you can commit to the
1631: user not using Netscape 4, this feature may be used freely with
1632: pretty much any HTML.
1633:
1634: =cut
1635:
1636: sub change_content_javascript {
1637: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1638: if ($env{'browser.type'} eq 'netscape' &&
1639: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1640: return (<<NETSCAPE4);
1641: function change(name, content) {
1642: doc = document.layers[name+"___escape"].layers[0].document;
1643: doc.open();
1644: doc.write(content);
1645: doc.close();
1646: }
1647: NETSCAPE4
1648: } else {
1649: # Otherwise, we need to use semi-standards-compliant code
1650: # (technically, "innerHTML" isn't standard but the equivalent
1651: # is really scary, and every useful browser supports it
1652: return (<<DOMBASED);
1653: function change(name, content) {
1654: element = document.getElementById(name);
1655: element.innerHTML = content;
1656: }
1657: DOMBASED
1658: }
1659: }
1660:
1661: =pod
1662:
1.648 raeburn 1663: =item * &changable_area($name,$origContent):
1.256 matthew 1664:
1665: This provides a "changable area" that can be modified on the fly via
1666: the Javascript code provided in C<change_content_javascript>. $name is
1667: the name you will use to reference the area later; do not repeat the
1668: same name on a given HTML page more then once. $origContent is what
1669: the area will originally contain, which can be left blank.
1670:
1671: =cut
1672:
1673: sub changable_area {
1674: my ($name, $origContent) = @_;
1675:
1.258 albertel 1676: if ($env{'browser.type'} eq 'netscape' &&
1677: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1678: # If this is netscape 4, we need to use the Layer tag
1679: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1680: } else {
1681: return "<span id='$name'>$origContent</span>";
1682: }
1683: }
1684:
1685: =pod
1686:
1.648 raeburn 1687: =item * &viewport_geometry_js
1.590 raeburn 1688:
1689: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1690:
1691: =cut
1692:
1693:
1694: sub viewport_geometry_js {
1695: return <<"GEOMETRY";
1696: var Geometry = {};
1697: function init_geometry() {
1698: if (Geometry.init) { return };
1699: Geometry.init=1;
1700: if (window.innerHeight) {
1701: Geometry.getViewportHeight = function() { return window.innerHeight; };
1702: Geometry.getViewportWidth = function() { return window.innerWidth; };
1703: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1704: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1705: }
1706: else if (document.documentElement && document.documentElement.clientHeight) {
1707: Geometry.getViewportHeight =
1708: function() { return document.documentElement.clientHeight; };
1709: Geometry.getViewportWidth =
1710: function() { return document.documentElement.clientWidth; };
1711:
1712: Geometry.getHorizontalScroll =
1713: function() { return document.documentElement.scrollLeft; };
1714: Geometry.getVerticalScroll =
1715: function() { return document.documentElement.scrollTop; };
1716: }
1717: else if (document.body.clientHeight) {
1718: Geometry.getViewportHeight =
1719: function() { return document.body.clientHeight; };
1720: Geometry.getViewportWidth =
1721: function() { return document.body.clientWidth; };
1722: Geometry.getHorizontalScroll =
1723: function() { return document.body.scrollLeft; };
1724: Geometry.getVerticalScroll =
1725: function() { return document.body.scrollTop; };
1726: }
1727: }
1728:
1729: GEOMETRY
1730: }
1731:
1732: =pod
1733:
1.648 raeburn 1734: =item * &viewport_size_js()
1.590 raeburn 1735:
1736: 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.
1737:
1738: =cut
1739:
1740: sub viewport_size_js {
1741: my $geometry = &viewport_geometry_js();
1742: return <<"DIMS";
1743:
1744: $geometry
1745:
1746: function getViewportDims(width,height) {
1747: init_geometry();
1748: width.value = Geometry.getViewportWidth();
1749: height.value = Geometry.getViewportHeight();
1750: return;
1751: }
1752:
1753: DIMS
1754: }
1755:
1756: =pod
1757:
1.648 raeburn 1758: =item * &resize_textarea_js()
1.565 albertel 1759:
1760: emits the needed javascript to resize a textarea to be as big as possible
1761:
1762: creates a function resize_textrea that takes two IDs first should be
1763: the id of the element to resize, second should be the id of a div that
1764: surrounds everything that comes after the textarea, this routine needs
1765: to be attached to the <body> for the onload and onresize events.
1766:
1.648 raeburn 1767: =back
1.565 albertel 1768:
1769: =cut
1770:
1771: sub resize_textarea_js {
1.590 raeburn 1772: my $geometry = &viewport_geometry_js();
1.565 albertel 1773: return <<"RESIZE";
1774: <script type="text/javascript">
1.824 bisitz 1775: // <![CDATA[
1.590 raeburn 1776: $geometry
1.565 albertel 1777:
1.588 albertel 1778: function getX(element) {
1779: var x = 0;
1780: while (element) {
1781: x += element.offsetLeft;
1782: element = element.offsetParent;
1783: }
1784: return x;
1785: }
1786: function getY(element) {
1787: var y = 0;
1788: while (element) {
1789: y += element.offsetTop;
1790: element = element.offsetParent;
1791: }
1792: return y;
1793: }
1794:
1795:
1.565 albertel 1796: function resize_textarea(textarea_id,bottom_id) {
1797: init_geometry();
1798: var textarea = document.getElementById(textarea_id);
1799: //alert(textarea);
1800:
1.588 albertel 1801: var textarea_top = getY(textarea);
1.565 albertel 1802: var textarea_height = textarea.offsetHeight;
1803: var bottom = document.getElementById(bottom_id);
1.588 albertel 1804: var bottom_top = getY(bottom);
1.565 albertel 1805: var bottom_height = bottom.offsetHeight;
1806: var window_height = Geometry.getViewportHeight();
1.588 albertel 1807: var fudge = 23;
1.565 albertel 1808: var new_height = window_height-fudge-textarea_top-bottom_height;
1809: if (new_height < 300) {
1810: new_height = 300;
1811: }
1812: textarea.style.height=new_height+'px';
1813: }
1.824 bisitz 1814: // ]]>
1.565 albertel 1815: </script>
1816: RESIZE
1817:
1818: }
1819:
1.1205 golterma 1820: sub colorfuleditor_js {
1.1248 raeburn 1821: my $browse_or_search;
1822: my $respath;
1823: my ($cnum,$cdom) = &crsauthor_url();
1824: if ($cnum) {
1825: $respath = "/res/$cdom/$cnum/";
1826: my %js_lt = &Apache::lonlocal::texthash(
1827: sunm => 'Sub-directory name',
1828: save => 'Save page to make this permanent',
1829: );
1830: &js_escape(\%js_lt);
1.1400 raeburn 1831: my $showfile_js = &show_crsfiles_js();
1.1248 raeburn 1832: $browse_or_search = <<"END";
1833:
1.1400 raeburn 1834: $showfile_js
1835:
1.1248 raeburn 1836: function toggleChooser(form,element,titleid,only,search) {
1837: var disp = 'none';
1838: if (document.getElementById('chooser_'+element)) {
1839: var curr = document.getElementById('chooser_'+element).style.display;
1840: if (curr == 'none') {
1841: disp='inline';
1842: if (form.elements['chooser_'+element].length) {
1843: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1844: form.elements['chooser_'+element][i].checked = false;
1845: }
1846: }
1847: toggleResImport(form,element);
1848: }
1849: document.getElementById('chooser_'+element).style.display = disp;
1.1400 raeburn 1850: var dirsel = '';
1851: var filesel = '';
1852: if (document.getElementById('chooser_'+element+'_crsres')) {
1853: var currcrsres = document.getElementById('chooser_'+element+'_crsres').style.display;
1854: if (currcrsres == 'none') {
1855: dirsel = 'coursepath_'+element;
1856: var filesel = 'coursefile_'+element;
1857: var include;
1858: if (document.getElementById('crsres_include_'+element)) {
1859: include = document.getElementById('crsres_include_'+element).value;
1860: }
1.1402 raeburn 1861: populateCrsSelects(form,dirsel,filesel,1,include,1,0,1,1,0);
1.1400 raeburn 1862: }
1863: }
1864: if (document.getElementById('chooser_'+element+'_upload')) {
1865: var currcrsupload = document.getElementById('chooser_'+element+'_upload').style.display;
1866: if (currcrsupload == 'none') {
1867: dirsel = 'crsauthorpath_'+element;
1868: filesel = '';
1.1402 raeburn 1869: populateCrsSelects(form,dirsel,filesel,0,'',1,0,1,0,1);
1.1400 raeburn 1870: }
1871: }
1.1248 raeburn 1872: }
1873: }
1874:
1.1400 raeburn 1875: function toggleCrsFile(form,element) {
1.1248 raeburn 1876: if (document.getElementById('chooser_'+element+'_crsres')) {
1877: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1878: if (curr == 'none') {
1.1400 raeburn 1879: if (document.getElementById('coursepath_'+element)) {
1880: var numdirs;
1881: if (document.getElementById('coursepath_'+element).length) {
1882: numdirs = document.getElementById('coursepath_'+element).length;
1883: }
1.1402 raeburn 1884: if ((document.getElementById('hascrsres_'+element)) &&
1885: (document.getElementById('nocrsres_'+element))) {
1886: if (numdirs) {
1887: document.getElementById('hascrsres_'+element).style.display='inline-block';
1888: document.getElementById('nocrsres_'+element).style.display='none';
1889: } else {
1890: document.getElementById('hascrsres_'+element).style.display='none';
1891: document.getElementById('nocrsres_'+element).style.display='inline-block';
1892: }
1893: }
1.1248 raeburn 1894: form.elements['coursepath_'+element].selectedIndex = 0;
1895: if (numdirs > 1) {
1.1400 raeburn 1896: var selelem = form.elements['coursefile_'+element];
1897: var i, len = selelem.options.length -1;
1898: if (len >=0) {
1899: for (i = len; i >= 0; i--) {
1900: selelem.remove(i);
1901: }
1902: selelem.options[0] = new Option('','');
1903: }
1.1248 raeburn 1904: }
1905: }
1.1400 raeburn 1906: }
1.1248 raeburn 1907: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1908: }
1909: if (document.getElementById('chooser_'+element+'_upload')) {
1910: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1911: if (document.getElementById('uploadcrsres_'+element)) {
1912: document.getElementById('uploadcrsres_'+element).value = '';
1913: }
1914: }
1915: return;
1916: }
1917:
1.1400 raeburn 1918: function toggleCrsUpload(form,element) {
1.1248 raeburn 1919: if (document.getElementById('chooser_'+element+'_crsres')) {
1920: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1921: }
1922: if (document.getElementById('chooser_'+element+'_upload')) {
1923: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1924: if (curr == 'none') {
1.1400 raeburn 1925: form.elements['newsubdir_'+element][0].checked = true;
1926: toggleNewsubdir(form,element);
1927: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1928: if (document.getElementById('uploadcrsres_'+element)) {
1929: document.getElementById('uploadcrsres_'+element).value = '';
1.1248 raeburn 1930: }
1931: }
1932: }
1933: return;
1934: }
1935:
1936: function toggleResImport(form,element) {
1937: var choices = new Array('crsres','upload');
1938: for (var i=0; i<choices.length; i++) {
1939: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1940: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1941: }
1942: }
1943: }
1944:
1945: function toggleNewsubdir(form,element) {
1946: var newsub = form.elements['newsubdir_'+element];
1947: if (newsub) {
1948: if (newsub.length) {
1949: for (var j=0; j<newsub.length; j++) {
1950: if (newsub[j].checked) {
1951: if (document.getElementById('newsubdirname_'+element)) {
1952: if (newsub[j].value == '1') {
1953: document.getElementById('newsubdirname_'+element).type = "text";
1954: if (document.getElementById('newsubdir_'+element)) {
1955: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1956: }
1957: } else {
1958: document.getElementById('newsubdirname_'+element).type = "hidden";
1959: document.getElementById('newsubdirname_'+element).value = "";
1960: document.getElementById('newsubdir_'+element).innerHTML = "";
1961: }
1962: }
1963: break;
1964: }
1965: }
1966: }
1967: }
1968: }
1969:
1970: function updateCrsFile(form,element) {
1971: var directory = form.elements['coursepath_'+element];
1972: var filename = form.elements['coursefile_'+element];
1973: var path = directory.options[directory.selectedIndex].value;
1974: var file = filename.options[filename.selectedIndex].value;
1.1400 raeburn 1975: if (file != '') {
1976: form.elements[element].value = '$respath';
1977: if (path == '/') {
1978: form.elements[element].value += file;
1979: } else {
1980: form.elements[element].value += path+'/'+file;
1981: }
1982: unClean();
1983: if (document.getElementById('previewimg_'+element)) {
1984: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1985: var newsrc = document.getElementById('previewimg_'+element).src;
1986: }
1987: if (document.getElementById('showimg_'+element)) {
1988: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1989: }
1.1248 raeburn 1990: }
1991: toggleChooser(form,element);
1992: return;
1993: }
1994:
1995: function uploadDone(suffix,name) {
1996: if (name) {
1997: document.forms["lonhomework"].elements[suffix].value = name;
1998: unClean();
1999: toggleChooser(document.forms["lonhomework"],suffix);
2000: }
2001: }
2002:
2003: \$(document).ready(function(){
2004:
2005: \$(document).delegate('form :submit', 'click', function( event ) {
2006: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
2007: var buttonId = this.id;
2008: var suffix = buttonId.toString();
2009: suffix = suffix.replace(/^crsupload_/,'');
2010: event.preventDefault();
2011: document.lonhomework.target = 'crsupload_target_'+suffix;
2012: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
2013: \$(this.form).submit();
2014: document.lonhomework.target = '';
2015: if (document.getElementById('crsuploadto_'+suffix)) {
2016: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
2017: }
2018: return false;
2019: }
2020: });
2021: });
2022: END
2023: }
1.1205 golterma 2024: return <<"COLORFULEDIT"
2025: <script type="text/javascript">
2026: // <![CDATA[>
2027: function fold_box(curDepth, lastresource){
2028:
2029: // we need a list because there can be several blocks you need to fold in one tag
2030: var block = document.getElementsByName('foldblock_'+curDepth);
2031: // but there is only one folding button per tag
2032: var foldbutton = document.getElementById('folding_btn_'+curDepth);
2033:
2034: if(block.item(0).style.display == 'none'){
2035:
2036: foldbutton.value = '@{[&mt("Hide")]}';
2037: for (i = 0; i < block.length; i++){
2038: block.item(i).style.display = '';
2039: }
2040: }else{
2041:
2042: foldbutton.value = '@{[&mt("Show")]}';
2043: for (i = 0; i < block.length; i++){
2044: // block.item(i).style.visibility = 'collapse';
2045: block.item(i).style.display = 'none';
2046: }
2047: };
2048: saveState(lastresource);
2049: }
2050:
2051: function saveState (lastresource) {
2052:
2053: var tag_list = getTagList();
2054: if(tag_list != null){
2055: var timestamp = new Date().getTime();
2056: var key = lastresource;
2057:
2058: // the value pattern is: 'time;key1,value1;key2,value2; ... '
2059: // starting with timestamp
2060: var value = timestamp+';';
2061:
2062: // building the list of key-value pairs
2063: for(var i = 0; i < tag_list.length; i++){
2064: value += tag_list[i]+',';
2065: value += document.getElementsByName(tag_list[i])[0].style.display+';';
2066: }
2067:
2068: // only iterate whole storage if nothing to override
2069: if(localStorage.getItem(key) == null){
2070:
2071: // prevent storage from growing large
2072: if(localStorage.length > 50){
2073: var regex_getTimestamp = /^(?:\d)+;/;
2074: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
2075: var oldest_key;
2076:
2077: for(var i = 1; i < localStorage.length; i++){
2078: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2079: oldest_key = localStorage.key(i);
2080: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2081: }
2082: }
2083: localStorage.removeItem(oldest_key);
2084: }
2085: }
2086: localStorage.setItem(key,value);
2087: }
2088: }
2089:
2090: // restore folding status of blocks (on page load)
2091: function restoreState (lastresource) {
2092: if(localStorage.getItem(lastresource) != null){
2093: var key = lastresource;
2094: var value = localStorage.getItem(key);
2095: var regex_delTimestamp = /^\d+;/;
2096:
2097: value.replace(regex_delTimestamp, '');
2098:
2099: var valueArr = value.split(';');
2100: var pairs;
2101: var elements;
2102: for (var i = 0; i < valueArr.length; i++){
2103: pairs = valueArr[i].split(',');
2104: elements = document.getElementsByName(pairs[0]);
2105:
2106: for (var j = 0; j < elements.length; j++){
2107: elements[j].style.display = pairs[1];
2108: if (pairs[1] == "none"){
2109: var regex_id = /([_\\d]+)\$/;
2110: regex_id.exec(pairs[0]);
2111: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2112: }
2113: }
2114: }
2115: }
2116: }
2117:
2118: function getTagList () {
2119:
2120: var stringToSearch = document.lonhomework.innerHTML;
2121:
2122: var ret = new Array();
2123: var regex_findBlock = /(foldblock_.*?)"/g;
2124: var tag_list = stringToSearch.match(regex_findBlock);
2125:
2126: if(tag_list != null){
2127: for(var i = 0; i < tag_list.length; i++){
2128: ret.push(tag_list[i].replace(/"/, ''));
2129: }
2130: }
2131: return ret;
2132: }
2133:
2134: function saveScrollPosition (resource) {
2135: var tag_list = getTagList();
2136:
2137: // we dont always want to jump to the first block
2138: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2139: if(\$(window).scrollTop() > 170){
2140: if(tag_list != null){
2141: var result;
2142: for(var i = 0; i < tag_list.length; i++){
2143: if(isElementInViewport(tag_list[i])){
2144: result += tag_list[i]+';';
2145: }
2146: }
2147: sessionStorage.setItem('anchor_'+resource, result);
2148: }
2149: } else {
2150: // we dont need to save zero, just delete the item to leave everything tidy
2151: sessionStorage.removeItem('anchor_'+resource);
2152: }
2153: }
2154:
2155: function restoreScrollPosition(resource){
2156:
2157: var elem = sessionStorage.getItem('anchor_'+resource);
2158: if(elem != null){
2159: var tag_list = elem.split(';');
2160: var elem_list;
2161:
2162: for(var i = 0; i < tag_list.length; i++){
2163: elem_list = document.getElementsByName(tag_list[i]);
2164:
2165: if(elem_list.length > 0){
2166: elem = elem_list[0];
2167: break;
2168: }
2169: }
2170: elem.scrollIntoView();
2171: }
2172: }
2173:
2174: function isElementInViewport(el) {
2175:
2176: // change to last element instead of first
2177: var elem = document.getElementsByName(el);
2178: var rect = elem[0].getBoundingClientRect();
2179:
2180: return (
2181: rect.top >= 0 &&
2182: rect.left >= 0 &&
2183: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2184: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2185: );
2186: }
2187:
2188: function autosize(depth){
2189: var cmInst = window['cm'+depth];
2190: var fitsizeButton = document.getElementById('fitsize'+depth);
2191:
2192: // is fixed size, switching to dynamic
2193: if (sessionStorage.getItem("autosized_"+depth) == null) {
2194: cmInst.setSize("","auto");
2195: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2196: sessionStorage.setItem("autosized_"+depth, "yes");
2197:
2198: // is dynamic size, switching to fixed
2199: } else {
2200: cmInst.setSize("","300px");
2201: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2202: sessionStorage.removeItem("autosized_"+depth);
2203: }
2204: }
2205:
1.1248 raeburn 2206: $browse_or_search
1.1205 golterma 2207:
2208: // ]]>
2209: </script>
2210: COLORFULEDIT
2211: }
2212:
2213: sub xmleditor_js {
2214: return <<XMLEDIT
2215: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2216: <script type="text/javascript">
2217: // <![CDATA[>
2218:
2219: function saveScrollPosition (resource) {
2220:
2221: var scrollPos = \$(window).scrollTop();
2222: sessionStorage.setItem(resource,scrollPos);
2223: }
2224:
2225: function restoreScrollPosition(resource){
2226:
2227: var scrollPos = sessionStorage.getItem(resource);
2228: \$(window).scrollTop(scrollPos);
2229: }
2230:
2231: // unless internet explorer
2232: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2233:
2234: \$(document).ready(function() {
2235: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2236: });
2237: }
2238:
2239: // inserts text at cursor position into codemirror (xml editor only)
2240: function insertText(text){
2241: cm.focus();
2242: var curPos = cm.getCursor();
2243: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2244: }
2245: // ]]>
2246: </script>
2247: XMLEDIT
2248: }
2249:
2250: sub insert_folding_button {
2251: my $curDepth = $Apache::lonxml::curdepth;
2252: my $lastresource = $env{'request.ambiguous'};
2253:
2254: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2255: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2256: }
2257:
1.1248 raeburn 2258: sub crsauthor_url {
2259: my ($url) = @_;
2260: if ($url eq '') {
2261: $url = $ENV{'REQUEST_URI'};
2262: }
2263: my ($cnum,$cdom);
2264: if ($env{'request.course.id'}) {
2265: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2266: if ($audom ne '' && $auname ne '') {
2267: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2268: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2269: $cnum = $auname;
2270: $cdom = $audom;
2271: }
2272: }
2273: }
2274: return ($cnum,$cdom);
2275: }
2276:
2277: sub import_crsauthor_form {
1.1400 raeburn 2278: my ($firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2279: return (0) unless ($env{'request.course.id'});
2280: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2281: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2282: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2283: return (0) unless (($cnum ne '') && ($cdom ne ''));
2284: my @ids=&Apache::lonnet::current_machine_ids();
1.1400 raeburn 2285: my ($output,$is_home,$toppath,%subdirs,%files,%selimport_menus,$include,$exclude);
1.1402 raeburn 2286:
1.1248 raeburn 2287: if (grep(/^\Q$crshome\E$/,@ids)) {
2288: $is_home = 1;
2289: }
1.1400 raeburn 2290: $toppath = "/priv/$cdom/$cnum";
2291: my $nonemptydir = 1;
2292: my $js_only;
2293: if ($only) {
2294: map { $include->{$_} = 1; } split(/\s*,\s*/,$only);
2295: $js_only = join(',',map { &js_escape($_); } sort(keys(%{$include})));
2296: }
2297: $exclude = &Apache::lonnet::priv_exclude();
1.1402 raeburn 2298: &Apache::lonnet::recursedirs($is_home,1,$include,$exclude,1,0,$toppath,'',\%subdirs,\%files);
1.1400 raeburn 2299: my $numdirs = scalar(keys(%files));
1.1248 raeburn 2300: my %lt = &Apache::lonlocal::texthash (
2301: fnam => 'Filename',
2302: dire => 'Directory',
1.1400 raeburn 2303: se => 'Select',
1.1248 raeburn 2304: );
1.1402 raeburn 2305: $output = $lt{'dire'}.': '.
1.1400 raeburn 2306: '<select id="'.$firstselectname.'" name="'.$firstselectname.'" '.
1.1402 raeburn 2307: 'onchange="populateCrsSelects(this.form,'."'$firstselectname','$secondselectname',1,'$js_only',0,1,0,0,0".');">'.
1.1400 raeburn 2308: '<option value="" selected="selected">'.$lt{'se'}.'</option>';
1.1402 raeburn 2309: if ($files{'/'}) {
2310: $output .= '<option value="/">/</option>'."\n";
2311: }
1.1400 raeburn 2312: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
1.1402 raeburn 2313: next if ($key eq '/');
1.1400 raeburn 2314: $output .= '<option value="'.$key.'">'.$key.'</option>'."\n";
2315: }
2316: $output .= '</select><br />'."\n".
1.1402 raeburn 2317: $lt{'fnam'}.': <select id="'.$secondselectname.'" name="'.$secondselectname.'">'."\n".
1.1400 raeburn 2318: '<option value="" selected="selected"></option>'."\n".
1.1402 raeburn 2319: '</select>'."\n".
2320: '<input type="hidden" id="crsres_include_'.$suffix.'" value="'.$only.'" />';
1.1400 raeburn 2321: return ($numdirs,$output);
2322: }
2323:
2324: sub show_crsfiles_js {
2325: my $excluderef = &Apache::lonnet::priv_exclude();
2326: my $se = &js_escape(&mt('Select'));
2327: my $exclude;
2328: if (ref($excluderef) eq 'HASH') {
2329: $exclude = join(',', map { &js_escape($_); } sort(keys(%{$excluderef})));
2330: }
2331: my $js = <<"END";
2332:
2333:
1.1402 raeburn 2334: function populateCrsSelects (form,dirsel,filesel,exc,include,setdir,setfile,recurse,nonemptydir,addtopdir) {
1.1400 raeburn 2335: var relpath = '';
2336: if ((setfile) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
2337: var currdir = form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value;
2338: if (currdir == '') {
2339: if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2340: selelem = form.elements[filesel];
2341: var j, numfiles = selelem.options.length -1;
2342: if (numfiles >=0) {
2343: for (j = numfiles; j >= 0; j--) {
2344: selelem.remove(j);
2345: }
2346: }
2347: if (selelem.options.length == 0) {
2348: selelem.options[selelem.options.length] = new Option('','');
2349: selelem.selectedIndex = 0;
1.1248 raeburn 2350: }
2351: }
1.1400 raeburn 2352: return;
2353: } else {
2354: relpath = encodeURIComponent(form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value);
1.1248 raeburn 2355: }
2356: }
1.1400 raeburn 2357: var http = new XMLHttpRequest();
2358: var url = "/adm/courseauthor";
2359: var crsrole = "$env{'request.role'}";
2360: var exclude = '';
2361: if (exc) {
2362: exclude = '$exclude';
2363: }
1.1402 raeburn 2364: var params = "role=course&files=1&rec="+recurse+"&nonempty="+nonemptydir+"&exc="+exclude+"&inc="+include+"&addtop="+addtopdir+"&path="+relpath;
1.1400 raeburn 2365: http.open("POST", url, true);
2366: http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
2367: http.onreadystatechange = function() {
2368: if (http.readyState == 4 && http.status == 200) {
2369: var data = JSON.parse(http.responseText);
2370: var selelem;
2371: if ((setdir) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
2372: if (Array.isArray(data.dirs)) {
2373: selelem = form.elements[dirsel];
2374: var i, numdirs = selelem.options.length -1;
2375: if (numdirs >=0) {
2376: for (i = numdirs; i >= 0; i--) {
2377: selelem.remove(i);
2378: }
2379: }
2380: var len = data.dirs.length;
2381: if (len) {
1.1402 raeburn 2382: selelem.options[selelem.options.length] = new Option('$se','');
1.1400 raeburn 2383: var j;
2384: for (j = 0; j < len; j++) {
2385: selelem.options[selelem.options.length] = new Option(data.dirs[j],data.dirs[j]);
2386: }
2387: selelem.selectedIndex = 0;
2388: }
2389: if (!setfile) {
2390: if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2391: selelem = form.elements[filesel];
2392: var j, numfiles = selelem.options.length -1;
2393: if (numfiles >=0) {
2394: for (j = numfiles; j >= 0; j--) {
2395: selelem.remove(j);
2396: }
2397: }
2398: if (selelem.options.length == 0) {
2399: selelem.options[selelem.options.length] = new Option('','');
2400: selelem.selectedIndex = 0;
2401: }
2402: }
2403: }
2404: }
2405: }
2406: if ((setfile) && (filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2407: selelem = form.elements[filesel];
2408: var i, numfiles = selelem.options.length -1;
2409: if (numfiles >=0) {
2410: for (i = numfiles; i >= 0; i--) {
2411: selelem.remove(i);
2412: }
2413: }
2414: var x;
2415: for (x in data.files) {
2416: if (Array.isArray(data.files[x])) {
2417: if (data.files[x].length > 1) {
2418: selelem.options[selelem.options.length] = new Option('$se','');
2419: }
2420: var len = data.files[x].length;
2421: if (len) {
2422: var k;
2423: for (k = 0; k < len; k++) {
2424: selelem.options[selelem.options.length] = new Option(data.files[x][k],data.files[x][k]);
2425: }
2426: selelem.selectedIndex = 0;
2427: }
2428: }
2429: }
2430: if (selelem.options.length == 0) {
2431: selelem.options[selelem.options.length] = new Option('','');
2432: selelem.selectedIndex = 0;
2433: }
1.1248 raeburn 2434: }
2435: }
2436: }
1.1400 raeburn 2437: http.send(params);
1.1248 raeburn 2438: }
1.1400 raeburn 2439: END
1.1248 raeburn 2440: }
2441:
1.565 albertel 2442: =pod
2443:
1.256 matthew 2444: =head1 Excel and CSV file utility routines
2445:
2446: =cut
2447:
2448: ###############################################################
2449: ###############################################################
2450:
2451: =pod
2452:
1.1162 raeburn 2453: =over 4
2454:
1.648 raeburn 2455: =item * &csv_translate($text)
1.37 matthew 2456:
1.185 www 2457: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2458: format.
2459:
2460: =cut
2461:
1.180 matthew 2462: ###############################################################
2463: ###############################################################
1.37 matthew 2464: sub csv_translate {
2465: my $text = shift;
2466: $text =~ s/\"/\"\"/g;
1.209 albertel 2467: $text =~ s/\n/ /g;
1.37 matthew 2468: return $text;
2469: }
1.180 matthew 2470:
2471: ###############################################################
2472: ###############################################################
2473:
2474: =pod
2475:
1.648 raeburn 2476: =item * &define_excel_formats()
1.180 matthew 2477:
2478: Define some commonly used Excel cell formats.
2479:
2480: Currently supported formats:
2481:
2482: =over 4
2483:
2484: =item header
2485:
2486: =item bold
2487:
2488: =item h1
2489:
2490: =item h2
2491:
2492: =item h3
2493:
1.256 matthew 2494: =item h4
2495:
2496: =item i
2497:
1.180 matthew 2498: =item date
2499:
2500: =back
2501:
2502: Inputs: $workbook
2503:
2504: Returns: $format, a hash reference.
2505:
1.1057 foxr 2506:
1.180 matthew 2507: =cut
2508:
2509: ###############################################################
2510: ###############################################################
2511: sub define_excel_formats {
2512: my ($workbook) = @_;
2513: my $format;
2514: $format->{'header'} = $workbook->add_format(bold => 1,
2515: bottom => 1,
2516: align => 'center');
2517: $format->{'bold'} = $workbook->add_format(bold=>1);
2518: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2519: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2520: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2521: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2522: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2523: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2524: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2525: return $format;
2526: }
2527:
2528: ###############################################################
2529: ###############################################################
1.113 bowersj2 2530:
2531: =pod
2532:
1.648 raeburn 2533: =item * &create_workbook()
1.255 matthew 2534:
2535: Create an Excel worksheet. If it fails, output message on the
2536: request object and return undefs.
2537:
2538: Inputs: Apache request object
2539:
2540: Returns (undef) on failure,
2541: Excel worksheet object, scalar with filename, and formats
2542: from &Apache::loncommon::define_excel_formats on success
2543:
2544: =cut
2545:
2546: ###############################################################
2547: ###############################################################
2548: sub create_workbook {
2549: my ($r) = @_;
2550: #
2551: # Create the excel spreadsheet
2552: my $filename = '/prtspool/'.
1.258 albertel 2553: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2554: time.'_'.rand(1000000000).'.xls';
2555: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2556: if (! defined($workbook)) {
2557: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2558: $r->print(
2559: '<p class="LC_error">'
2560: .&mt('Problems occurred in creating the new Excel file.')
2561: .' '.&mt('This error has been logged.')
2562: .' '.&mt('Please alert your LON-CAPA administrator.')
2563: .'</p>'
2564: );
1.255 matthew 2565: return (undef);
2566: }
2567: #
1.1014 foxr 2568: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2569: #
2570: my $format = &Apache::loncommon::define_excel_formats($workbook);
2571: return ($workbook,$filename,$format);
2572: }
2573:
2574: ###############################################################
2575: ###############################################################
2576:
2577: =pod
2578:
1.648 raeburn 2579: =item * &create_text_file()
1.113 bowersj2 2580:
1.542 raeburn 2581: Create a file to write to and eventually make available to the user.
1.256 matthew 2582: If file creation fails, outputs an error message on the request object and
2583: return undefs.
1.113 bowersj2 2584:
1.256 matthew 2585: Inputs: Apache request object, and file suffix
1.113 bowersj2 2586:
1.256 matthew 2587: Returns (undef) on failure,
2588: Filehandle and filename on success.
1.113 bowersj2 2589:
2590: =cut
2591:
1.256 matthew 2592: ###############################################################
2593: ###############################################################
2594: sub create_text_file {
2595: my ($r,$suffix) = @_;
2596: if (! defined($suffix)) { $suffix = 'txt'; };
2597: my $fh;
2598: my $filename = '/prtspool/'.
1.258 albertel 2599: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2600: time.'_'.rand(1000000000).'.'.$suffix;
2601: $fh = Apache::File->new('>/home/httpd'.$filename);
2602: if (! defined($fh)) {
2603: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2604: $r->print(
2605: '<p class="LC_error">'
2606: .&mt('Problems occurred in creating the output file.')
2607: .' '.&mt('This error has been logged.')
2608: .' '.&mt('Please alert your LON-CAPA administrator.')
2609: .'</p>'
2610: );
1.113 bowersj2 2611: }
1.256 matthew 2612: return ($fh,$filename)
1.113 bowersj2 2613: }
2614:
2615:
1.256 matthew 2616: =pod
1.113 bowersj2 2617:
2618: =back
2619:
2620: =cut
1.37 matthew 2621:
2622: ###############################################################
1.33 matthew 2623: ## Home server <option> list generating code ##
2624: ###############################################################
1.35 matthew 2625:
1.169 www 2626: # ------------------------------------------
2627:
2628: sub domain_select {
1.1289 raeburn 2629: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2630: my @possdoms;
2631: if (ref($incdoms) eq 'ARRAY') {
2632: @possdoms = @{$incdoms};
2633: } else {
2634: @possdoms = &Apache::lonnet::all_domains();
2635: }
2636:
1.169 www 2637: my %domains=map {
1.514 albertel 2638: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2639: } @possdoms;
2640:
2641: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2642: foreach my $dom (@{$excdoms}) {
2643: delete($domains{$dom});
2644: }
2645: }
2646:
1.169 www 2647: if ($multiple) {
2648: $domains{''}=&mt('Any domain');
1.550 albertel 2649: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2650: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2651: } else {
1.550 albertel 2652: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2653: return &select_form($name,$value,\%domains);
1.169 www 2654: }
2655: }
2656:
1.282 albertel 2657: #-------------------------------------------
2658:
2659: =pod
2660:
1.519 raeburn 2661: =head1 Routines for form select boxes
2662:
2663: =over 4
2664:
1.648 raeburn 2665: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2666:
2667: Returns a string containing a <select> element int multiple mode
2668:
2669:
2670: Args:
2671: $name - name of the <select> element
1.506 raeburn 2672: $value - scalar or array ref of values that should already be selected
1.282 albertel 2673: $size - number of rows long the select element is
1.283 albertel 2674: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2675: (shown text should already have been &mt())
1.506 raeburn 2676: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2677:
1.282 albertel 2678: =cut
2679:
2680: #-------------------------------------------
1.169 www 2681: sub multiple_select_form {
1.284 albertel 2682: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2683: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2684: my $output='';
1.191 matthew 2685: if (! defined($size)) {
2686: $size = 4;
1.283 albertel 2687: if (scalar(keys(%$hash))<4) {
2688: $size = scalar(keys(%$hash));
1.191 matthew 2689: }
2690: }
1.734 bisitz 2691: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2692: my @order;
1.506 raeburn 2693: if (ref($order) eq 'ARRAY') {
2694: @order = @{$order};
2695: } else {
2696: @order = sort(keys(%$hash));
1.501 banghart 2697: }
2698: if (exists($$hash{'select_form_order'})) {
2699: @order = @{$$hash{'select_form_order'}};
2700: }
2701:
1.284 albertel 2702: foreach my $key (@order) {
1.356 albertel 2703: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2704: $output.='selected="selected" ' if ($selected{$key});
2705: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2706: }
2707: $output.="</select>\n";
2708: return $output;
2709: }
2710:
1.88 www 2711: #-------------------------------------------
2712:
2713: =pod
2714:
1.1254 raeburn 2715: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2716:
2717: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2718: allow a user to select options from a ref to a hash containing:
2719: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2720: a javascript onchange item, e.g., onchange="this.form.submit();".
2721: An optional arg -- $readonly -- if true will cause the select form
2722: to be disabled, e.g., for the case where an instructor has a section-
2723: specific role, and is viewing/modifying parameters.
1.970 raeburn 2724:
1.88 www 2725: See lonrights.pm for an example invocation and use.
2726:
2727: =cut
2728:
2729: #-------------------------------------------
2730: sub select_form {
1.1228 raeburn 2731: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2732: return unless (ref($hashref) eq 'HASH');
2733: if ($onchange) {
2734: $onchange = ' onchange="'.$onchange.'"';
2735: }
1.1228 raeburn 2736: my $disabled;
2737: if ($readonly) {
2738: $disabled = ' disabled="disabled"';
2739: }
2740: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2741: my @keys;
1.970 raeburn 2742: if (exists($hashref->{'select_form_order'})) {
2743: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2744: } else {
1.970 raeburn 2745: @keys=sort(keys(%{$hashref}));
1.128 albertel 2746: }
1.356 albertel 2747: foreach my $key (@keys) {
2748: $selectform.=
2749: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2750: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2751: ">".$hashref->{$key}."</option>\n";
1.88 www 2752: }
2753: $selectform.="</select>";
2754: return $selectform;
2755: }
2756:
1.475 www 2757: # For display filters
2758:
2759: sub display_filter {
1.1074 raeburn 2760: my ($context) = @_;
1.475 www 2761: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2762: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2763: my $phraseinput = 'hidden';
2764: my $includeinput = 'hidden';
2765: my ($checked,$includetypestext);
2766: if ($env{'form.displayfilter'} eq 'containing') {
2767: $phraseinput = 'text';
2768: if ($context eq 'parmslog') {
2769: $includeinput = 'checkbox';
2770: if ($env{'form.includetypes'}) {
2771: $checked = ' checked="checked"';
2772: }
2773: $includetypestext = &mt('Include parameter types');
2774: }
2775: } else {
2776: $includetypestext = ' ';
2777: }
2778: my ($additional,$secondid,$thirdid);
2779: if ($context eq 'parmslog') {
2780: $additional =
2781: '<label><input type="'.$includeinput.'" name="includetypes"'.
2782: $checked.' name="includetypes" value="1" id="includetypes" />'.
2783: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2784: '</label>';
2785: $secondid = 'includetypes';
2786: $thirdid = 'includetypestext';
2787: }
2788: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2789: '$secondid','$thirdid')";
2790: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.1403 raeburn 2791: &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
1.475 www 2792: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2793: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2794: &mt('Filter: [_1]',
1.477 www 2795: &select_form($env{'form.displayfilter'},
2796: 'displayfilter',
1.970 raeburn 2797: {'currentfolder' => 'Current folder/page',
1.477 www 2798: 'containing' => 'Containing phrase',
1.1074 raeburn 2799: 'none' => 'None'},$onchange)).' '.
2800: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2801: &HTML::Entities::encode($env{'form.containingphrase'}).
2802: '" />'.$additional;
2803: }
2804:
2805: sub display_filter_js {
2806: my $includetext = &mt('Include parameter types');
2807: return <<"ENDJS";
2808:
2809: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2810: var firstType = 'hidden';
2811: if (setter.options[setter.selectedIndex].value == 'containing') {
2812: firstType = 'text';
2813: }
2814: firstObject = document.getElementById(firstid);
2815: if (typeof(firstObject) == 'object') {
2816: if (firstObject.type != firstType) {
2817: changeInputType(firstObject,firstType);
2818: }
2819: }
2820: if (context == 'parmslog') {
2821: var secondType = 'hidden';
2822: if (firstType == 'text') {
2823: secondType = 'checkbox';
2824: }
2825: secondObject = document.getElementById(secondid);
2826: if (typeof(secondObject) == 'object') {
2827: if (secondObject.type != secondType) {
2828: changeInputType(secondObject,secondType);
2829: }
2830: }
2831: var textItem = document.getElementById(thirdid);
2832: var currtext = textItem.innerHTML;
2833: var newtext;
2834: if (firstType == 'text') {
2835: newtext = '$includetext';
2836: } else {
2837: newtext = ' ';
2838: }
2839: if (currtext != newtext) {
2840: textItem.innerHTML = newtext;
2841: }
2842: }
2843: return;
2844: }
2845:
2846: function changeInputType(oldObject,newType) {
2847: var newObject = document.createElement('input');
2848: newObject.type = newType;
2849: if (oldObject.size) {
2850: newObject.size = oldObject.size;
2851: }
2852: if (oldObject.value) {
2853: newObject.value = oldObject.value;
2854: }
2855: if (oldObject.name) {
2856: newObject.name = oldObject.name;
2857: }
2858: if (oldObject.id) {
2859: newObject.id = oldObject.id;
2860: }
2861: oldObject.parentNode.replaceChild(newObject,oldObject);
2862: return;
2863: }
2864:
2865: ENDJS
1.475 www 2866: }
2867:
1.167 www 2868: sub gradeleveldescription {
2869: my $gradelevel=shift;
2870: my %gradelevels=(0 => 'Not specified',
2871: 1 => 'Grade 1',
2872: 2 => 'Grade 2',
2873: 3 => 'Grade 3',
2874: 4 => 'Grade 4',
2875: 5 => 'Grade 5',
2876: 6 => 'Grade 6',
2877: 7 => 'Grade 7',
2878: 8 => 'Grade 8',
2879: 9 => 'Grade 9',
2880: 10 => 'Grade 10',
2881: 11 => 'Grade 11',
2882: 12 => 'Grade 12',
2883: 13 => 'Grade 13',
2884: 14 => '100 Level',
2885: 15 => '200 Level',
2886: 16 => '300 Level',
2887: 17 => '400 Level',
2888: 18 => 'Graduate Level');
2889: return &mt($gradelevels{$gradelevel});
2890: }
2891:
1.163 www 2892: sub select_level_form {
2893: my ($deflevel,$name)=@_;
2894: unless ($deflevel) { $deflevel=0; }
1.167 www 2895: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2896: for (my $i=0; $i<=18; $i++) {
2897: $selectform.="<option value=\"$i\" ".
1.253 albertel 2898: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2899: ">".&gradeleveldescription($i)."</option>\n";
2900: }
2901: $selectform.="</select>";
2902: return $selectform;
1.163 www 2903: }
1.167 www 2904:
1.35 matthew 2905: #-------------------------------------------
2906:
1.45 matthew 2907: =pod
2908:
1.1256 raeburn 2909: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2910:
2911: Returns a string containing a <select name='$name' size='1'> form to
2912: allow a user to select the domain to preform an operation in.
2913: See loncreateuser.pm for an example invocation and use.
2914:
1.90 www 2915: If the $includeempty flag is set, it also includes an empty choice ("no domain
2916: selected");
2917:
1.743 raeburn 2918: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2919:
1.910 raeburn 2920: 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.
2921:
1.1121 raeburn 2922: The optional $incdoms is a reference to an array of domains which will be the only available options.
2923:
2924: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2925:
1.1256 raeburn 2926: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2927:
1.35 matthew 2928: =cut
2929:
2930: #-------------------------------------------
1.34 matthew 2931: sub select_dom_form {
1.1256 raeburn 2932: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2933: if ($onchange) {
1.874 raeburn 2934: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2935: }
1.1256 raeburn 2936: if ($disabled) {
2937: $disabled = ' disabled="disabled"';
2938: }
1.1121 raeburn 2939: my (@domains,%exclude);
1.910 raeburn 2940: if (ref($incdoms) eq 'ARRAY') {
2941: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2942: } else {
2943: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2944: }
1.90 www 2945: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2946: if (ref($excdoms) eq 'ARRAY') {
2947: map { $exclude{$_} = 1; } @{$excdoms};
2948: }
1.1256 raeburn 2949: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2950: foreach my $dom (@domains) {
1.1121 raeburn 2951: next if ($exclude{$dom});
1.356 albertel 2952: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2953: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2954: if ($showdomdesc) {
2955: if ($dom ne '') {
2956: my $domdesc = &Apache::lonnet::domain($dom,'description');
2957: if ($domdesc ne '') {
2958: $selectdomain .= ' ('.$domdesc.')';
2959: }
2960: }
2961: }
2962: $selectdomain .= "</option>\n";
1.34 matthew 2963: }
2964: $selectdomain.="</select>";
2965: return $selectdomain;
2966: }
2967:
1.35 matthew 2968: #-------------------------------------------
2969:
1.45 matthew 2970: =pod
2971:
1.648 raeburn 2972: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2973:
1.586 raeburn 2974: input: 4 arguments (two required, two optional) -
2975: $domain - domain of new user
2976: $name - name of form element
2977: $default - Value of 'default' causes a default item to be first
2978: option, and selected by default.
2979: $hide - Value of 'hide' causes hiding of the name of the server,
2980: if 1 server found, or default, if 0 found.
1.594 raeburn 2981: output: returns 2 items:
1.586 raeburn 2982: (a) form element which contains either:
2983: (i) <select name="$name">
2984: <option value="$hostid1">$hostid $servers{$hostid}</option>
2985: <option value="$hostid2">$hostid $servers{$hostid}</option>
2986: </select>
2987: form item if there are multiple library servers in $domain, or
2988: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2989: if there is only one library server in $domain.
2990:
2991: (b) number of library servers found.
2992:
2993: See loncreateuser.pm for example of use.
1.35 matthew 2994:
2995: =cut
2996:
2997: #-------------------------------------------
1.586 raeburn 2998: sub home_server_form_item {
2999: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 3000: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 3001: my $result;
3002: my $numlib = keys(%servers);
3003: if ($numlib > 1) {
3004: $result .= '<select name="'.$name.'" />'."\n";
3005: if ($default) {
1.804 bisitz 3006: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 3007: '</option>'."\n";
3008: }
3009: foreach my $hostid (sort(keys(%servers))) {
3010: $result.= '<option value="'.$hostid.'">'.
3011: $hostid.' '.$servers{$hostid}."</option>\n";
3012: }
3013: $result .= '</select>'."\n";
3014: } elsif ($numlib == 1) {
3015: my $hostid;
3016: foreach my $item (keys(%servers)) {
3017: $hostid = $item;
3018: }
3019: $result .= '<input type="hidden" name="'.$name.'" value="'.
3020: $hostid.'" />';
3021: if (!$hide) {
3022: $result .= $hostid.' '.$servers{$hostid};
3023: }
3024: $result .= "\n";
3025: } elsif ($default) {
3026: $result .= '<input type="hidden" name="'.$name.
3027: '" value="default" />';
3028: if (!$hide) {
3029: $result .= &mt('default');
3030: }
3031: $result .= "\n";
1.33 matthew 3032: }
1.586 raeburn 3033: return ($result,$numlib);
1.33 matthew 3034: }
1.112 bowersj2 3035:
3036: =pod
3037:
1.534 albertel 3038: =back
3039:
1.112 bowersj2 3040: =cut
1.87 matthew 3041:
3042: ###############################################################
1.112 bowersj2 3043: ## Decoding User Agent ##
1.87 matthew 3044: ###############################################################
3045:
3046: =pod
3047:
1.112 bowersj2 3048: =head1 Decoding the User Agent
3049:
3050: =over 4
3051:
3052: =item * &decode_user_agent()
1.87 matthew 3053:
3054: Inputs: $r
3055:
3056: Outputs:
3057:
3058: =over 4
3059:
1.112 bowersj2 3060: =item * $httpbrowser
1.87 matthew 3061:
1.112 bowersj2 3062: =item * $clientbrowser
1.87 matthew 3063:
1.112 bowersj2 3064: =item * $clientversion
1.87 matthew 3065:
1.112 bowersj2 3066: =item * $clientmathml
1.87 matthew 3067:
1.112 bowersj2 3068: =item * $clientunicode
1.87 matthew 3069:
1.112 bowersj2 3070: =item * $clientos
1.87 matthew 3071:
1.1137 raeburn 3072: =item * $clientmobile
3073:
1.1141 raeburn 3074: =item * $clientinfo
3075:
1.1194 raeburn 3076: =item * $clientosversion
3077:
1.87 matthew 3078: =back
3079:
1.157 matthew 3080: =back
3081:
1.87 matthew 3082: =cut
3083:
3084: ###############################################################
3085: ###############################################################
3086: sub decode_user_agent {
1.247 albertel 3087: my ($r)=@_;
1.87 matthew 3088: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
3089: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
3090: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 3091: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 3092: my $clientbrowser='unknown';
3093: my $clientversion='0';
3094: my $clientmathml='';
3095: my $clientunicode='0';
1.1137 raeburn 3096: my $clientmobile=0;
1.1194 raeburn 3097: my $clientosversion='';
1.87 matthew 3098: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 3099: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 3100: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
3101: $clientbrowser=$bname;
3102: $httpbrowser=~/$vreg/i;
3103: $clientversion=$1;
3104: $clientmathml=($clientversion>=$minv);
3105: $clientunicode=($clientversion>=$univ);
3106: }
3107: }
3108: my $clientos='unknown';
1.1141 raeburn 3109: my $clientinfo;
1.87 matthew 3110: if (($httpbrowser=~/linux/i) ||
3111: ($httpbrowser=~/unix/i) ||
3112: ($httpbrowser=~/ux/i) ||
3113: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
3114: if (($httpbrowser=~/vax/i) ||
3115: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
3116: if ($httpbrowser=~/next/i) { $clientos='next'; }
3117: if (($httpbrowser=~/mac/i) ||
3118: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 3119: if ($httpbrowser=~/win/i) {
3120: $clientos='win';
3121: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
3122: $clientosversion = $1;
3123: }
3124: }
1.87 matthew 3125: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3126: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3127: $clientmobile=lc($1);
3128: }
1.1141 raeburn 3129: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3130: $clientinfo = 'firefox-'.$1;
3131: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3132: $clientinfo = 'chromeframe-'.$1;
3133: }
1.87 matthew 3134: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3135: $clientunicode,$clientos,$clientmobile,$clientinfo,
3136: $clientosversion);
1.87 matthew 3137: }
3138:
1.32 matthew 3139: ###############################################################
3140: ## Authentication changing form generation subroutines ##
3141: ###############################################################
3142: ##
3143: ## All of the authform_xxxxxxx subroutines take their inputs in a
3144: ## hash, and have reasonable default values.
3145: ##
3146: ## formname = the name given in the <form> tag.
1.35 matthew 3147: #-------------------------------------------
3148:
1.45 matthew 3149: =pod
3150:
1.112 bowersj2 3151: =head1 Authentication Routines
3152:
3153: =over 4
3154:
1.648 raeburn 3155: =item * &authform_xxxxxx()
1.35 matthew 3156:
3157: The authform_xxxxxx subroutines provide javascript and html forms which
3158: handle some of the conveniences required for authentication forms.
3159: This is not an optimal method, but it works.
3160:
3161: =over 4
3162:
1.112 bowersj2 3163: =item * authform_header
1.35 matthew 3164:
1.112 bowersj2 3165: =item * authform_authorwarning
1.35 matthew 3166:
1.112 bowersj2 3167: =item * authform_nochange
1.35 matthew 3168:
1.112 bowersj2 3169: =item * authform_kerberos
1.35 matthew 3170:
1.112 bowersj2 3171: =item * authform_internal
1.35 matthew 3172:
1.112 bowersj2 3173: =item * authform_filesystem
1.35 matthew 3174:
1.1310 raeburn 3175: =item * authform_lti
3176:
1.35 matthew 3177: =back
3178:
1.648 raeburn 3179: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3180:
1.35 matthew 3181: =cut
3182:
3183: #-------------------------------------------
1.32 matthew 3184: sub authform_header{
3185: my %in = (
3186: formname => 'cu',
1.80 albertel 3187: kerb_def_dom => '',
1.32 matthew 3188: @_,
3189: );
3190: $in{'formname'} = 'document.' . $in{'formname'};
3191: my $result='';
1.80 albertel 3192:
3193: #---------------------------------------------- Code for upper case translation
3194: my $Javascript_toUpperCase;
3195: unless ($in{kerb_def_dom}) {
3196: $Javascript_toUpperCase =<<"END";
3197: switch (choice) {
3198: case 'krb': currentform.elements[choicearg].value =
3199: currentform.elements[choicearg].value.toUpperCase();
3200: break;
3201: default:
3202: }
3203: END
3204: } else {
3205: $Javascript_toUpperCase = "";
3206: }
3207:
1.165 raeburn 3208: my $radioval = "'nochange'";
1.591 raeburn 3209: if (defined($in{'curr_authtype'})) {
3210: if ($in{'curr_authtype'} ne '') {
3211: $radioval = "'".$in{'curr_authtype'}."arg'";
3212: }
1.174 matthew 3213: }
1.165 raeburn 3214: my $argfield = 'null';
1.591 raeburn 3215: if (defined($in{'mode'})) {
1.165 raeburn 3216: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3217: if (defined($in{'curr_autharg'})) {
3218: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3219: $argfield = "'$in{'curr_autharg'}'";
3220: }
3221: }
3222: }
3223: }
3224:
1.32 matthew 3225: $result.=<<"END";
3226: var current = new Object();
1.165 raeburn 3227: current.radiovalue = $radioval;
3228: current.argfield = $argfield;
1.32 matthew 3229:
3230: function changed_radio(choice,currentform) {
3231: var choicearg = choice + 'arg';
3232: // If a radio button in changed, we need to change the argfield
3233: if (current.radiovalue != choice) {
3234: current.radiovalue = choice;
3235: if (current.argfield != null) {
3236: currentform.elements[current.argfield].value = '';
3237: }
3238: if (choice == 'nochange') {
3239: current.argfield = null;
3240: } else {
3241: current.argfield = choicearg;
3242: switch(choice) {
3243: case 'krb':
3244: currentform.elements[current.argfield].value =
3245: "$in{'kerb_def_dom'}";
3246: break;
3247: default:
3248: break;
3249: }
3250: }
3251: }
3252: return;
3253: }
1.22 www 3254:
1.32 matthew 3255: function changed_text(choice,currentform) {
3256: var choicearg = choice + 'arg';
3257: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3258: $Javascript_toUpperCase
1.32 matthew 3259: // clear old field
3260: if ((current.argfield != choicearg) && (current.argfield != null)) {
3261: currentform.elements[current.argfield].value = '';
3262: }
3263: current.argfield = choicearg;
3264: }
3265: set_auth_radio_buttons(choice,currentform);
3266: return;
1.20 www 3267: }
1.32 matthew 3268:
3269: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3270: var numauthchoices = currentform.login.length;
3271: if (typeof numauthchoices == "undefined") {
3272: return;
3273: }
1.32 matthew 3274: var i=0;
1.986 raeburn 3275: while (i < numauthchoices) {
1.32 matthew 3276: if (currentform.login[i].value == newvalue) { break; }
3277: i++;
3278: }
1.986 raeburn 3279: if (i == numauthchoices) {
1.32 matthew 3280: return;
3281: }
3282: current.radiovalue = newvalue;
3283: currentform.login[i].checked = true;
3284: return;
3285: }
3286: END
3287: return $result;
3288: }
3289:
1.1106 raeburn 3290: sub authform_authorwarning {
1.32 matthew 3291: my $result='';
1.144 matthew 3292: $result='<i>'.
3293: &mt('As a general rule, only authors or co-authors should be '.
3294: 'filesystem authenticated '.
3295: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3296: return $result;
3297: }
3298:
1.1106 raeburn 3299: sub authform_nochange {
1.32 matthew 3300: my %in = (
3301: formname => 'document.cu',
3302: kerb_def_dom => 'MSU.EDU',
3303: @_,
3304: );
1.1106 raeburn 3305: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3306: my $result;
1.1104 raeburn 3307: if (!$authnum) {
1.1105 raeburn 3308: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3309: } else {
3310: $result = '<label>'.&mt('[_1] Do not change login data',
3311: '<input type="radio" name="login" value="nochange" '.
3312: 'checked="checked" onclick="'.
1.281 albertel 3313: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3314: '</label>';
1.586 raeburn 3315: }
1.32 matthew 3316: return $result;
3317: }
3318:
1.591 raeburn 3319: sub authform_kerberos {
1.32 matthew 3320: my %in = (
3321: formname => 'document.cu',
3322: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3323: kerb_def_auth => 'krb4',
1.32 matthew 3324: @_,
3325: );
1.586 raeburn 3326: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3327: $autharg,$jscall,$disabled);
1.1106 raeburn 3328: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3329: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3330: $check5 = ' checked="checked"';
1.80 albertel 3331: } else {
1.772 bisitz 3332: $check4 = ' checked="checked"';
1.80 albertel 3333: }
1.1259 raeburn 3334: if ($in{'readonly'}) {
3335: $disabled = ' disabled="disabled"';
3336: }
1.165 raeburn 3337: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3338: if (defined($in{'curr_authtype'})) {
3339: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3340: $krbcheck = ' checked="checked"';
1.623 raeburn 3341: if (defined($in{'mode'})) {
3342: if ($in{'mode'} eq 'modifyuser') {
3343: $krbcheck = '';
3344: }
3345: }
1.591 raeburn 3346: if (defined($in{'curr_kerb_ver'})) {
3347: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3348: $check5 = ' checked="checked"';
1.591 raeburn 3349: $check4 = '';
3350: } else {
1.772 bisitz 3351: $check4 = ' checked="checked"';
1.591 raeburn 3352: $check5 = '';
3353: }
1.586 raeburn 3354: }
1.591 raeburn 3355: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3356: $krbarg = $in{'curr_autharg'};
3357: }
1.586 raeburn 3358: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3359: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3360: $result =
3361: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3362: $in{'curr_autharg'},$krbver);
3363: } else {
3364: $result =
3365: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3366: }
3367: return $result;
3368: }
3369: }
3370: } else {
3371: if ($authnum == 1) {
1.784 bisitz 3372: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3373: }
3374: }
1.586 raeburn 3375: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3376: return;
1.587 raeburn 3377: } elsif ($authtype eq '') {
1.591 raeburn 3378: if (defined($in{'mode'})) {
1.587 raeburn 3379: if ($in{'mode'} eq 'modifycourse') {
3380: if ($authnum == 1) {
1.1259 raeburn 3381: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3382: }
3383: }
3384: }
1.586 raeburn 3385: }
3386: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3387: if ($authtype eq '') {
3388: $authtype = '<input type="radio" name="login" value="krb" '.
3389: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3390: $krbcheck.$disabled.' />';
1.586 raeburn 3391: }
3392: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3393: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3394: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3395: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3396: $in{'curr_authtype'} eq 'krb4')) {
3397: $result .= &mt
1.144 matthew 3398: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3399: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3400: '<label>'.$authtype,
1.281 albertel 3401: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3402: 'value="'.$krbarg.'" '.
1.1259 raeburn 3403: 'onchange="'.$jscall.'"'.$disabled.' />',
3404: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3405: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3406: '</label>');
1.586 raeburn 3407: } elsif ($can_assign{'krb4'}) {
3408: $result .= &mt
3409: ('[_1] Kerberos authenticated with domain [_2] '.
3410: '[_3] Version 4 [_4]',
3411: '<label>'.$authtype,
3412: '</label><input type="text" size="10" name="krbarg" '.
3413: 'value="'.$krbarg.'" '.
1.1259 raeburn 3414: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3415: '<label><input type="hidden" name="krbver" value="4" />',
3416: '</label>');
3417: } elsif ($can_assign{'krb5'}) {
3418: $result .= &mt
3419: ('[_1] Kerberos authenticated with domain [_2] '.
3420: '[_3] Version 5 [_4]',
3421: '<label>'.$authtype,
3422: '</label><input type="text" size="10" name="krbarg" '.
3423: 'value="'.$krbarg.'" '.
1.1259 raeburn 3424: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3425: '<label><input type="hidden" name="krbver" value="5" />',
3426: '</label>');
3427: }
1.32 matthew 3428: return $result;
3429: }
3430:
1.1106 raeburn 3431: sub authform_internal {
1.586 raeburn 3432: my %in = (
1.32 matthew 3433: formname => 'document.cu',
3434: kerb_def_dom => 'MSU.EDU',
3435: @_,
3436: );
1.1259 raeburn 3437: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3438: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3439: if ($in{'readonly'}) {
3440: $disabled = ' disabled="disabled"';
3441: }
1.591 raeburn 3442: if (defined($in{'curr_authtype'})) {
3443: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3444: if ($can_assign{'int'}) {
1.772 bisitz 3445: $intcheck = 'checked="checked" ';
1.623 raeburn 3446: if (defined($in{'mode'})) {
3447: if ($in{'mode'} eq 'modifyuser') {
3448: $intcheck = '';
3449: }
3450: }
1.591 raeburn 3451: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3452: $intarg = $in{'curr_autharg'};
3453: }
3454: } else {
3455: $result = &mt('Currently internally authenticated.');
3456: return $result;
1.165 raeburn 3457: }
3458: }
1.586 raeburn 3459: } else {
3460: if ($authnum == 1) {
1.784 bisitz 3461: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3462: }
3463: }
3464: if (!$can_assign{'int'}) {
3465: return;
1.587 raeburn 3466: } elsif ($authtype eq '') {
1.591 raeburn 3467: if (defined($in{'mode'})) {
1.587 raeburn 3468: if ($in{'mode'} eq 'modifycourse') {
3469: if ($authnum == 1) {
1.1259 raeburn 3470: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3471: }
3472: }
3473: }
1.165 raeburn 3474: }
1.586 raeburn 3475: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3476: if ($authtype eq '') {
3477: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3478: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3479: }
1.605 bisitz 3480: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3481: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3482: $result = &mt
1.144 matthew 3483: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3484: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3485: $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
1.32 matthew 3486: return $result;
3487: }
3488:
1.1104 raeburn 3489: sub authform_local {
1.32 matthew 3490: my %in = (
3491: formname => 'document.cu',
3492: kerb_def_dom => 'MSU.EDU',
3493: @_,
3494: );
1.1259 raeburn 3495: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3496: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3497: if ($in{'readonly'}) {
3498: $disabled = ' disabled="disabled"';
3499: }
1.591 raeburn 3500: if (defined($in{'curr_authtype'})) {
3501: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3502: if ($can_assign{'loc'}) {
1.772 bisitz 3503: $loccheck = 'checked="checked" ';
1.623 raeburn 3504: if (defined($in{'mode'})) {
3505: if ($in{'mode'} eq 'modifyuser') {
3506: $loccheck = '';
3507: }
3508: }
1.591 raeburn 3509: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3510: $locarg = $in{'curr_autharg'};
3511: }
3512: } else {
3513: $result = &mt('Currently using local (institutional) authentication.');
3514: return $result;
1.165 raeburn 3515: }
3516: }
1.586 raeburn 3517: } else {
3518: if ($authnum == 1) {
1.784 bisitz 3519: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3520: }
3521: }
3522: if (!$can_assign{'loc'}) {
3523: return;
1.587 raeburn 3524: } elsif ($authtype eq '') {
1.591 raeburn 3525: if (defined($in{'mode'})) {
1.587 raeburn 3526: if ($in{'mode'} eq 'modifycourse') {
3527: if ($authnum == 1) {
1.1259 raeburn 3528: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3529: }
3530: }
3531: }
1.165 raeburn 3532: }
1.586 raeburn 3533: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3534: if ($authtype eq '') {
3535: $authtype = '<input type="radio" name="login" value="loc" '.
3536: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3537: $jscall.'"'.$disabled.' />';
1.586 raeburn 3538: }
3539: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3540: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3541: $result = &mt('[_1] Local Authentication with argument [_2]',
3542: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3543: return $result;
3544: }
3545:
1.1106 raeburn 3546: sub authform_filesystem {
1.32 matthew 3547: my %in = (
3548: formname => 'document.cu',
3549: kerb_def_dom => 'MSU.EDU',
3550: @_,
3551: );
1.1259 raeburn 3552: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3553: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3554: if ($in{'readonly'}) {
3555: $disabled = ' disabled="disabled"';
3556: }
1.591 raeburn 3557: if (defined($in{'curr_authtype'})) {
3558: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3559: if ($can_assign{'fsys'}) {
1.772 bisitz 3560: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3561: if (defined($in{'mode'})) {
3562: if ($in{'mode'} eq 'modifyuser') {
3563: $fsyscheck = '';
3564: }
3565: }
1.586 raeburn 3566: } else {
3567: $result = &mt('Currently Filesystem Authenticated.');
3568: return $result;
1.1259 raeburn 3569: }
1.586 raeburn 3570: }
3571: } else {
3572: if ($authnum == 1) {
1.784 bisitz 3573: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3574: }
3575: }
3576: if (!$can_assign{'fsys'}) {
3577: return;
1.587 raeburn 3578: } elsif ($authtype eq '') {
1.591 raeburn 3579: if (defined($in{'mode'})) {
1.587 raeburn 3580: if ($in{'mode'} eq 'modifycourse') {
3581: if ($authnum == 1) {
1.1259 raeburn 3582: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3583: }
3584: }
3585: }
1.586 raeburn 3586: }
3587: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3588: if ($authtype eq '') {
3589: $authtype = '<input type="radio" name="login" value="fsys" '.
3590: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3591: $jscall.'"'.$disabled.' />';
1.586 raeburn 3592: }
1.1310 raeburn 3593: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3594: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3595: $result = &mt
1.144 matthew 3596: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3597: '<label>'.$authtype,'</label>'.$autharg);
3598: return $result;
3599: }
3600:
3601: sub authform_lti {
3602: my %in = (
3603: formname => 'document.cu',
3604: kerb_def_dom => 'MSU.EDU',
3605: @_,
3606: );
3607: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3608: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3609: if ($in{'readonly'}) {
3610: $disabled = ' disabled="disabled"';
3611: }
3612: if (defined($in{'curr_authtype'})) {
3613: if ($in{'curr_authtype'} eq 'lti') {
3614: if ($can_assign{'lti'}) {
3615: $lticheck = 'checked="checked" ';
3616: if (defined($in{'mode'})) {
3617: if ($in{'mode'} eq 'modifyuser') {
3618: $lticheck = '';
3619: }
3620: }
3621: } else {
3622: $result = &mt('Currently LTI Authenticated.');
3623: return $result;
3624: }
3625: }
3626: } else {
3627: if ($authnum == 1) {
3628: $authtype = '<input type="hidden" name="login" value="lti" />';
3629: }
3630: }
3631: if (!$can_assign{'lti'}) {
3632: return;
3633: } elsif ($authtype eq '') {
3634: if (defined($in{'mode'})) {
3635: if ($in{'mode'} eq 'modifycourse') {
3636: if ($authnum == 1) {
3637: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3638: }
3639: }
3640: }
3641: }
3642: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3643: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3644: $authtype = '<input type="radio" name="login" value="lti" '.
3645: $lticheck.' onchange="'.$jscall.'" onclick="'.
3646: $jscall.'"'.$disabled.' />';
3647: }
3648: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3649: if ($authtype) {
3650: $result = &mt('[_1] LTI Authenticated',
3651: '<label>'.$authtype.'</label>'.$autharg);
3652: } else {
3653: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3654: $autharg;
3655: }
1.32 matthew 3656: return $result;
3657: }
3658:
1.586 raeburn 3659: sub get_assignable_auth {
3660: my ($dom) = @_;
3661: if ($dom eq '') {
3662: $dom = $env{'request.role.domain'};
3663: }
3664: my %can_assign = (
3665: krb4 => 1,
3666: krb5 => 1,
3667: int => 1,
3668: loc => 1,
1.1310 raeburn 3669: lti => 1,
1.586 raeburn 3670: );
3671: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3672: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3673: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3674: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3675: my $context;
3676: if ($env{'request.role'} =~ /^au/) {
3677: $context = 'author';
1.1259 raeburn 3678: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3679: $context = 'domain';
3680: } elsif ($env{'request.course.id'}) {
3681: $context = 'course';
3682: }
3683: if ($context) {
3684: if (ref($authhash->{$context}) eq 'HASH') {
3685: %can_assign = %{$authhash->{$context}};
3686: }
3687: }
3688: }
3689: }
3690: my $authnum = 0;
3691: foreach my $key (keys(%can_assign)) {
3692: if ($can_assign{$key}) {
3693: $authnum ++;
3694: }
3695: }
3696: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3697: $authnum --;
3698: }
3699: return ($authnum,%can_assign);
3700: }
3701:
1.1331 raeburn 3702: sub check_passwd_rules {
3703: my ($domain,$plainpass) = @_;
3704: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3705: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3706: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3707: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3708: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3709: if ($passwdconf{'min'} > $min) {
3710: $min = $passwdconf{'min'};
3711: }
1.1331 raeburn 3712: }
3713: if ($passwdconf{'max'} =~ /^\d+$/) {
3714: $max = $passwdconf{'max'};
3715: }
3716: @chars = @{$passwdconf{'chars'}};
3717: }
3718: if (($min) && (length($plainpass) < $min)) {
3719: push(@brokerule,'min');
3720: }
3721: if (($max) && (length($plainpass) > $max)) {
3722: push(@brokerule,'max');
3723: }
3724: if (@chars) {
3725: my %rules;
3726: map { $rules{$_} = 1; } @chars;
3727: if ($rules{'uc'}) {
3728: unless ($plainpass =~ /[A-Z]/) {
3729: push(@brokerule,'uc');
3730: }
3731: }
3732: if ($rules{'lc'}) {
1.1332 raeburn 3733: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3734: push(@brokerule,'lc');
3735: }
3736: }
3737: if ($rules{'num'}) {
3738: unless ($plainpass =~ /\d/) {
3739: push(@brokerule,'num');
3740: }
3741: }
3742: if ($rules{'spec'}) {
3743: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3744: push(@brokerule,'spec');
3745: }
3746: }
3747: }
3748: if (@brokerule) {
3749: my %rulenames = &Apache::lonlocal::texthash(
3750: uc => 'At least one upper case letter',
3751: lc => 'At least one lower case letter',
3752: num => 'At least one number',
3753: spec => 'At least one non-alphanumeric',
3754: );
3755: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3756: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3757: $rulenames{'num'} .= ': 0123456789';
3758: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3759: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3760: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3761: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3762: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3763: if (grep(/^$rule$/,@brokerule)) {
3764: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3765: }
3766: }
3767: $warning .= '</ul>';
3768: }
1.1332 raeburn 3769: if (wantarray) {
3770: return @brokerule;
3771: }
1.1331 raeburn 3772: return $warning;
3773: }
3774:
1.1376 raeburn 3775: sub passwd_validation_js {
1.1377 raeburn 3776: my ($currpasswdval,$domain,$context,$id) = @_;
3777: my (%passwdconf,$alertmsg);
3778: if ($context eq 'linkprot') {
3779: my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3780: if (ref($domconfig{'ltisec'}) eq 'HASH') {
3781: if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3782: %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3783: }
3784: }
3785: if ($id eq 'add') {
3786: $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3787: } elsif ($id =~ /^\d+$/) {
3788: my $pos = $id+1;
3789: $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3790: } else {
3791: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3792: }
3793: } else {
3794: %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3795: $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3796: }
1.1376 raeburn 3797: my ($min,$max,@chars,$numrules,$intargjs,%alert);
3798: $numrules = 0;
3799: $min = $Apache::lonnet::passwdmin;
3800: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3801: if ($passwdconf{'min'} =~ /^\d+$/) {
3802: if ($passwdconf{'min'} > $min) {
3803: $min = $passwdconf{'min'};
3804: }
3805: }
3806: if ($passwdconf{'max'} =~ /^\d+$/) {
3807: $max = $passwdconf{'max'};
3808: $numrules ++;
3809: }
3810: @chars = @{$passwdconf{'chars'}};
3811: if (@chars) {
3812: $numrules ++;
3813: }
3814: }
3815: if ($min > 0) {
3816: $numrules ++;
3817: }
3818: if (($min > 0) || ($max ne '') || (@chars > 0)) {
3819: if ($min) {
3820: $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3821: }
3822: if ($max) {
3823: $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3824: }
3825: my (@charalerts,@charrules);
3826: if (@chars) {
3827: if (grep(/^uc$/,@chars)) {
3828: push(@charalerts,&mt('contain at least one upper case letter'));
3829: push(@charrules,'uc');
3830: }
3831: if (grep(/^lc$/,@chars)) {
3832: push(@charalerts,&mt('contain at least one lower case letter'));
3833: push(@charrules,'lc');
3834: }
3835: if (grep(/^num$/,@chars)) {
3836: push(@charalerts,&mt('contain at least one number'));
3837: push(@charrules,'num');
3838: }
3839: if (grep(/^spec$/,@chars)) {
3840: push(@charalerts,&mt('contain at least one non-alphanumeric'));
3841: push(@charrules,'spec');
3842: }
3843: }
3844: $intargjs = qq| var rulesmsg = '';\n|.
3845: qq| var currpwval = $currpasswdval;\n|;
3846: if ($min) {
3847: $intargjs .= qq|
3848: if (currpwval.length < $min) {
3849: rulesmsg += ' - $alert{min}';
3850: }
3851: |;
3852: }
3853: if ($max) {
3854: $intargjs .= qq|
3855: if (currpwval.length > $max) {
3856: rulesmsg += ' - $alert{max}';
3857: }
3858: |;
3859: }
3860: if (@chars > 0) {
3861: my $charrulestr = '"'.join('","',@charrules).'"';
3862: my $charalertstr = '"'.join('","',@charalerts).'"';
3863: $intargjs .= qq| var brokerules = new Array();\n|.
3864: qq| var charrules = new Array($charrulestr);\n|.
3865: qq| var charalerts = new Array($charalertstr);\n|;
3866: my %rules;
3867: map { $rules{$_} = 1; } @chars;
3868: if ($rules{'uc'}) {
3869: $intargjs .= qq|
3870: var ucRegExp = /[A-Z]/;
3871: if (!ucRegExp.test(currpwval)) {
3872: brokerules.push('uc');
3873: }
3874: |;
3875: }
3876: if ($rules{'lc'}) {
3877: $intargjs .= qq|
3878: var lcRegExp = /[a-z]/;
3879: if (!lcRegExp.test(currpwval)) {
3880: brokerules.push('lc');
3881: }
3882: |;
3883: }
3884: if ($rules{'num'}) {
3885: $intargjs .= qq|
3886: var numRegExp = /[0-9]/;
3887: if (!numRegExp.test(currpwval)) {
3888: brokerules.push('num');
3889: }
3890: |;
3891: }
3892: if ($rules{'spec'}) {
3893: $intargjs .= q|
3894: var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3895: if (!specRegExp.test(currpwval)) {
3896: brokerules.push('spec');
3897: }
3898: |;
3899: }
3900: $intargjs .= qq|
3901: if (brokerules.length > 0) {
3902: for (var i=0; i<brokerules.length; i++) {
3903: for (var j=0; j<charrules.length; j++) {
3904: if (brokerules[i] == charrules[j]) {
3905: rulesmsg += ' - '+charalerts[j]+'\\n';
3906: break;
3907: }
3908: }
3909: }
3910: }
3911: |;
3912: }
3913: $intargjs .= qq|
3914: if (rulesmsg != '') {
3915: rulesmsg = '$alertmsg'+rulesmsg;
3916: alert(rulesmsg);
3917: return false;
3918: }
3919: |;
3920: }
3921: return ($numrules,$intargjs);
3922: }
3923:
1.80 albertel 3924: ###############################################################
3925: ## Get Kerberos Defaults for Domain ##
3926: ###############################################################
3927: ##
3928: ## Returns default kerberos version and an associated argument
3929: ## as listed in file domain.tab. If not listed, provides
3930: ## appropriate default domain and kerberos version.
3931: ##
3932: #-------------------------------------------
3933:
3934: =pod
3935:
1.648 raeburn 3936: =item * &get_kerberos_defaults()
1.80 albertel 3937:
3938: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3939: version and domain. If not found, it defaults to version 4 and the
3940: domain of the server.
1.80 albertel 3941:
1.648 raeburn 3942: =over 4
3943:
1.80 albertel 3944: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3945:
1.648 raeburn 3946: =back
3947:
3948: =back
3949:
1.80 albertel 3950: =cut
3951:
3952: #-------------------------------------------
3953: sub get_kerberos_defaults {
3954: my $domain=shift;
1.641 raeburn 3955: my ($krbdef,$krbdefdom);
3956: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3957: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3958: $krbdef = $domdefaults{'auth_def'};
3959: $krbdefdom = $domdefaults{'auth_arg_def'};
3960: } else {
1.80 albertel 3961: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3962: my $krbdefdom=$1;
3963: $krbdefdom=~tr/a-z/A-Z/;
3964: $krbdef = "krb4";
3965: }
3966: return ($krbdef,$krbdefdom);
3967: }
1.112 bowersj2 3968:
1.32 matthew 3969:
1.46 matthew 3970: ###############################################################
3971: ## Thesaurus Functions ##
3972: ###############################################################
1.20 www 3973:
1.46 matthew 3974: =pod
1.20 www 3975:
1.112 bowersj2 3976: =head1 Thesaurus Functions
3977:
3978: =over 4
3979:
1.648 raeburn 3980: =item * &initialize_keywords()
1.46 matthew 3981:
3982: Initializes the package variable %Keywords if it is empty. Uses the
3983: package variable $thesaurus_db_file.
3984:
3985: =cut
3986:
3987: ###################################################
3988:
3989: sub initialize_keywords {
3990: return 1 if (scalar keys(%Keywords));
3991: # If we are here, %Keywords is empty, so fill it up
3992: # Make sure the file we need exists...
3993: if (! -e $thesaurus_db_file) {
3994: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3995: " failed because it does not exist");
3996: return 0;
3997: }
3998: # Set up the hash as a database
3999: my %thesaurus_db;
4000: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4001: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4002: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
4003: $thesaurus_db_file);
4004: return 0;
4005: }
4006: # Get the average number of appearances of a word.
4007: my $avecount = $thesaurus_db{'average.count'};
4008: # Put keywords (those that appear > average) into %Keywords
4009: while (my ($word,$data)=each (%thesaurus_db)) {
4010: my ($count,undef) = split /:/,$data;
4011: $Keywords{$word}++ if ($count > $avecount);
4012: }
4013: untie %thesaurus_db;
4014: # Remove special values from %Keywords.
1.356 albertel 4015: foreach my $value ('total.count','average.count') {
4016: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 4017: }
1.46 matthew 4018: return 1;
4019: }
4020:
4021: ###################################################
4022:
4023: =pod
4024:
1.648 raeburn 4025: =item * &keyword($word)
1.46 matthew 4026:
4027: Returns true if $word is a keyword. A keyword is a word that appears more
4028: than the average number of times in the thesaurus database. Calls
4029: &initialize_keywords
4030:
4031: =cut
4032:
4033: ###################################################
1.20 www 4034:
4035: sub keyword {
1.46 matthew 4036: return if (!&initialize_keywords());
4037: my $word=lc(shift());
4038: $word=~s/\W//g;
4039: return exists($Keywords{$word});
1.20 www 4040: }
1.46 matthew 4041:
4042: ###############################################################
4043:
4044: =pod
1.20 www 4045:
1.648 raeburn 4046: =item * &get_related_words()
1.46 matthew 4047:
1.160 matthew 4048: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 4049: an array of words. If the keyword is not in the thesaurus, an empty array
4050: will be returned. The order of the words returned is determined by the
4051: database which holds them.
4052:
4053: Uses global $thesaurus_db_file.
4054:
1.1057 foxr 4055:
1.46 matthew 4056: =cut
4057:
4058: ###############################################################
4059: sub get_related_words {
4060: my $keyword = shift;
4061: my %thesaurus_db;
4062: if (! -e $thesaurus_db_file) {
4063: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
4064: "failed because the file does not exist");
4065: return ();
4066: }
4067: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4068: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4069: return ();
4070: }
4071: my @Words=();
1.429 www 4072: my $count=0;
1.46 matthew 4073: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 4074: # The first element is the number of times
4075: # the word appears. We do not need it now.
1.429 www 4076: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
4077: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
4078: my $threshold=$mostfrequentcount/10;
4079: foreach my $possibleword (@RelatedWords) {
4080: my ($word,$wordcount)=split(/\,/,$possibleword);
4081: if ($wordcount>$threshold) {
4082: push(@Words,$word);
4083: $count++;
4084: if ($count>10) { last; }
4085: }
1.20 www 4086: }
4087: }
1.46 matthew 4088: untie %thesaurus_db;
4089: return @Words;
1.14 harris41 4090: }
1.1090 foxr 4091: ###############################################################
4092: #
4093: # Spell checking
4094: #
4095:
4096: =pod
4097:
1.1142 raeburn 4098: =back
4099:
1.1090 foxr 4100: =head1 Spell checking
4101:
4102: =over 4
4103:
4104: =item * &check_spelling($wordlist $language)
4105:
4106: Takes a string containing words and feeds it to an external
4107: spellcheck program via a pipeline. Returns a string containing
4108: them mis-spelled words.
4109:
4110: Parameters:
4111:
4112: =over 4
4113:
4114: =item - $wordlist
4115:
4116: String that will be fed into the spellcheck program.
4117:
4118: =item - $language
4119:
4120: Language string that specifies the language for which the spell
4121: check will be performed.
4122:
4123: =back
4124:
4125: =back
4126:
4127: Note: This sub assumes that aspell is installed.
4128:
4129:
4130: =cut
4131:
1.46 matthew 4132:
1.1090 foxr 4133: sub check_spelling {
4134: my ($wordlist, $language) = @_;
1.1091 foxr 4135: my @misspellings;
4136:
4137: # Generate the speller and set the langauge.
4138: # if explicitly selected:
1.1090 foxr 4139:
1.1091 foxr 4140: my $speller = Text::Aspell->new;
1.1090 foxr 4141: if ($language) {
1.1091 foxr 4142: $speller->set_option('lang', $language);
1.1090 foxr 4143: }
4144:
1.1091 foxr 4145: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 4146:
1.1091 foxr 4147: my @words = split(/\s+/, $wordlist);
1.1090 foxr 4148:
1.1091 foxr 4149: foreach my $word (@words) {
4150: if(! $speller->check($word)) {
4151: push(@misspellings, $word);
1.1090 foxr 4152: }
4153: }
1.1091 foxr 4154: return join(' ', @misspellings);
4155:
1.1090 foxr 4156: }
4157:
1.61 www 4158: # -------------------------------------------------------------- Plaintext name
1.81 albertel 4159: =pod
4160:
1.112 bowersj2 4161: =head1 User Name Functions
4162:
4163: =over 4
4164:
1.648 raeburn 4165: =item * &plainname($uname,$udom,$first)
1.81 albertel 4166:
1.112 bowersj2 4167: Takes a users logon name and returns it as a string in
1.226 albertel 4168: "first middle last generation" form
4169: if $first is set to 'lastname' then it returns it as
4170: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 4171:
4172: =cut
1.61 www 4173:
1.295 www 4174:
1.81 albertel 4175: ###############################################################
1.61 www 4176: sub plainname {
1.226 albertel 4177: my ($uname,$udom,$first)=@_;
1.537 albertel 4178: return if (!defined($uname) || !defined($udom));
1.295 www 4179: my %names=&getnames($uname,$udom);
1.226 albertel 4180: my $name=&Apache::lonnet::format_name($names{'firstname'},
4181: $names{'middlename'},
4182: $names{'lastname'},
4183: $names{'generation'},$first);
4184: $name=~s/^\s+//;
1.62 www 4185: $name=~s/\s+$//;
4186: $name=~s/\s+/ /g;
1.353 albertel 4187: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 4188: return $name;
1.61 www 4189: }
1.66 www 4190:
4191: # -------------------------------------------------------------------- Nickname
1.81 albertel 4192: =pod
4193:
1.648 raeburn 4194: =item * &nickname($uname,$udom)
1.81 albertel 4195:
4196: Gets a users name and returns it as a string as
4197:
4198: ""nickname""
1.66 www 4199:
1.81 albertel 4200: if the user has a nickname or
4201:
4202: "first middle last generation"
4203:
4204: if the user does not
4205:
4206: =cut
1.66 www 4207:
4208: sub nickname {
4209: my ($uname,$udom)=@_;
1.537 albertel 4210: return if (!defined($uname) || !defined($udom));
1.295 www 4211: my %names=&getnames($uname,$udom);
1.68 albertel 4212: my $name=$names{'nickname'};
1.66 www 4213: if ($name) {
4214: $name='"'.$name.'"';
4215: } else {
4216: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
4217: $names{'lastname'}.' '.$names{'generation'};
4218: $name=~s/\s+$//;
4219: $name=~s/\s+/ /g;
4220: }
4221: return $name;
4222: }
4223:
1.295 www 4224: sub getnames {
4225: my ($uname,$udom)=@_;
1.537 albertel 4226: return if (!defined($uname) || !defined($udom));
1.433 albertel 4227: if ($udom eq 'public' && $uname eq 'public') {
4228: return ('lastname' => &mt('Public'));
4229: }
1.295 www 4230: my $id=$uname.':'.$udom;
4231: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
4232: if ($cached) {
4233: return %{$names};
4234: } else {
4235: my %loadnames=&Apache::lonnet::get('environment',
4236: ['firstname','middlename','lastname','generation','nickname'],
4237: $udom,$uname);
4238: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
4239: return %loadnames;
4240: }
4241: }
1.61 www 4242:
1.542 raeburn 4243: # -------------------------------------------------------------------- getemails
1.648 raeburn 4244:
1.542 raeburn 4245: =pod
4246:
1.648 raeburn 4247: =item * &getemails($uname,$udom)
1.542 raeburn 4248:
4249: Gets a user's email information and returns it as a hash with keys:
4250: notification, critnotification, permanentemail
4251:
4252: For notification and critnotification, values are comma-separated lists
1.648 raeburn 4253: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 4254:
1.648 raeburn 4255:
1.542 raeburn 4256: =cut
4257:
1.648 raeburn 4258:
1.466 albertel 4259: sub getemails {
4260: my ($uname,$udom)=@_;
4261: if ($udom eq 'public' && $uname eq 'public') {
4262: return;
4263: }
1.467 www 4264: if (!$udom) { $udom=$env{'user.domain'}; }
4265: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 4266: my $id=$uname.':'.$udom;
4267: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
4268: if ($cached) {
4269: return %{$names};
4270: } else {
4271: my %loadnames=&Apache::lonnet::get('environment',
4272: ['notification','critnotification',
4273: 'permanentemail'],
4274: $udom,$uname);
4275: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4276: return %loadnames;
4277: }
4278: }
4279:
1.551 albertel 4280: sub flush_email_cache {
4281: my ($uname,$udom)=@_;
4282: if (!$udom) { $udom =$env{'user.domain'}; }
4283: if (!$uname) { $uname=$env{'user.name'}; }
4284: return if ($udom eq 'public' && $uname eq 'public');
4285: my $id=$uname.':'.$udom;
4286: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4287: }
4288:
1.728 raeburn 4289: # -------------------------------------------------------------------- getlangs
4290:
4291: =pod
4292:
4293: =item * &getlangs($uname,$udom)
4294:
4295: Gets a user's language preference and returns it as a hash with key:
4296: language.
4297:
4298: =cut
4299:
4300:
4301: sub getlangs {
4302: my ($uname,$udom) = @_;
4303: if (!$udom) { $udom =$env{'user.domain'}; }
4304: if (!$uname) { $uname=$env{'user.name'}; }
4305: my $id=$uname.':'.$udom;
4306: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4307: if ($cached) {
4308: return %{$langs};
4309: } else {
4310: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4311: $udom,$uname);
4312: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4313: return %loadlangs;
4314: }
4315: }
4316:
4317: sub flush_langs_cache {
4318: my ($uname,$udom)=@_;
4319: if (!$udom) { $udom =$env{'user.domain'}; }
4320: if (!$uname) { $uname=$env{'user.name'}; }
4321: return if ($udom eq 'public' && $uname eq 'public');
4322: my $id=$uname.':'.$udom;
4323: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4324: }
4325:
1.61 www 4326: # ------------------------------------------------------------------ Screenname
1.81 albertel 4327:
4328: =pod
4329:
1.648 raeburn 4330: =item * &screenname($uname,$udom)
1.81 albertel 4331:
4332: Gets a users screenname and returns it as a string
4333:
4334: =cut
1.61 www 4335:
4336: sub screenname {
4337: my ($uname,$udom)=@_;
1.258 albertel 4338: if ($uname eq $env{'user.name'} &&
4339: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4340: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4341: return $names{'screenname'};
1.62 www 4342: }
4343:
1.212 albertel 4344:
1.802 bisitz 4345: # ------------------------------------------------------------- Confirm Wrapper
4346: =pod
4347:
1.1142 raeburn 4348: =item * &confirmwrapper($message)
1.802 bisitz 4349:
4350: Wrap messages about completion of operation in box
4351:
4352: =cut
4353:
4354: sub confirmwrapper {
4355: my ($message)=@_;
4356: if ($message) {
4357: return "\n".'<div class="LC_confirm_box">'."\n"
4358: .$message."\n"
4359: .'</div>'."\n";
4360: } else {
4361: return $message;
4362: }
4363: }
4364:
1.62 www 4365: # ------------------------------------------------------------- Message Wrapper
4366:
4367: sub messagewrapper {
1.369 www 4368: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4369: return
1.441 albertel 4370: '<a href="/adm/email?compose=individual&'.
4371: 'recname='.$username.'&recdom='.$domain.
4372: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4373: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4374: }
1.802 bisitz 4375:
1.74 www 4376: # --------------------------------------------------------------- Notes Wrapper
4377:
4378: sub noteswrapper {
4379: my ($link,$un,$do)=@_;
4380: return
1.896 amueller 4381: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4382: }
1.802 bisitz 4383:
1.62 www 4384: # ------------------------------------------------------------- Aboutme Wrapper
4385:
4386: sub aboutmewrapper {
1.1070 raeburn 4387: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4388: if (!defined($username) && !defined($domain)) {
4389: return;
4390: }
1.1096 raeburn 4391: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4392: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4393: }
4394:
4395: # ------------------------------------------------------------ Syllabus Wrapper
4396:
4397: sub syllabuswrapper {
1.707 bisitz 4398: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4399: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4400: }
1.14 harris41 4401:
1.1397 raeburn 4402: # -----------------------------------------------------------------------------
4403:
1.1396 raeburn 4404: sub aboutme_on {
4405: my ($uname,$udom)=@_;
4406: unless ($uname) { $uname=$env{'user.name'}; }
4407: unless ($udom) { $udom=$env{'user.domain'}; }
4408: return if ($udom eq 'public' && $uname eq 'public');
4409: my $hashkey=$uname.':'.$udom;
4410: my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
4411: if ($cached) {
4412: return $aboutme;
4413: }
4414: $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
4415: &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
4416: return $aboutme;
4417: }
4418:
4419: sub devalidate_aboutme_cache {
4420: my ($uname,$udom)=@_;
4421: if (!$udom) { $udom =$env{'user.domain'}; }
4422: if (!$uname) { $uname=$env{'user.name'}; }
4423: return if ($udom eq 'public' && $uname eq 'public');
4424: my $id=$uname.':'.$udom;
4425: &Apache::lonnet::devalidate_cache_new('aboutme',$id);
4426: }
4427:
1.208 matthew 4428: sub track_student_link {
1.887 raeburn 4429: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4430: my $link ="/adm/trackstudent?";
1.208 matthew 4431: my $title = 'View recent activity';
4432: if (defined($sname) && $sname !~ /^\s*$/ &&
4433: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4434: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4435: $title .= ' of this student';
1.268 albertel 4436: }
1.208 matthew 4437: if (defined($target) && $target !~ /^\s*$/) {
4438: $target = qq{target="$target"};
4439: } else {
4440: $target = '';
4441: }
1.268 albertel 4442: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4443: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4444: $title = &mt($title);
4445: $linktext = &mt($linktext);
1.448 albertel 4446: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4447: &help_open_topic('View_recent_activity');
1.208 matthew 4448: }
4449:
1.781 raeburn 4450: sub slot_reservations_link {
4451: my ($linktext,$sname,$sdom,$target) = @_;
4452: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4453: my $title = 'View slot reservation history';
4454: if (defined($sname) && $sname !~ /^\s*$/ &&
4455: defined($sdom) && $sdom !~ /^\s*$/) {
4456: $link .= "&uname=$sname&udom=$sdom";
4457: $title .= ' of this student';
4458: }
4459: if (defined($target) && $target !~ /^\s*$/) {
4460: $target = qq{target="$target"};
4461: } else {
4462: $target = '';
4463: }
4464: $title = &mt($title);
4465: $linktext = &mt($linktext);
4466: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4467: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4468:
4469: }
4470:
1.508 www 4471: # ===================================================== Display a student photo
4472:
4473:
1.509 albertel 4474: sub student_image_tag {
1.508 www 4475: my ($domain,$user)=@_;
4476: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4477: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4478: return '<img src="'.$imgsrc.'" align="right" />';
4479: } else {
4480: return '';
4481: }
4482: }
4483:
1.112 bowersj2 4484: =pod
4485:
4486: =back
4487:
4488: =head1 Access .tab File Data
4489:
4490: =over 4
4491:
1.648 raeburn 4492: =item * &languageids()
1.112 bowersj2 4493:
4494: returns list of all language ids
4495:
4496: =cut
4497:
1.14 harris41 4498: sub languageids {
1.16 harris41 4499: return sort(keys(%language));
1.14 harris41 4500: }
4501:
1.112 bowersj2 4502: =pod
4503:
1.648 raeburn 4504: =item * &languagedescription()
1.112 bowersj2 4505:
4506: returns description of a specified language id
4507:
4508: =cut
4509:
1.14 harris41 4510: sub languagedescription {
1.125 www 4511: my $code=shift;
4512: return ($supported_language{$code}?'* ':'').
4513: $language{$code}.
1.126 www 4514: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4515: }
4516:
1.1048 foxr 4517: =pod
4518:
4519: =item * &plainlanguagedescription
4520:
4521: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4522: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4523:
4524: =cut
4525:
1.145 www 4526: sub plainlanguagedescription {
4527: my $code=shift;
4528: return $language{$code};
4529: }
4530:
1.1048 foxr 4531: =pod
4532:
4533: =item * &supportedlanguagecode
4534:
4535: Returns the supported language code (e.g. sptutf maps to pt) given a language
4536: code.
4537:
4538: =cut
4539:
1.145 www 4540: sub supportedlanguagecode {
4541: my $code=shift;
4542: return $supported_language{$code};
1.97 www 4543: }
4544:
1.112 bowersj2 4545: =pod
4546:
1.1048 foxr 4547: =item * &latexlanguage()
4548:
4549: Given a language key code returns the correspondnig language to use
4550: to select the correct hyphenation on LaTeX printouts. This is undef if there
4551: is no supported hyphenation for the language code.
4552:
4553: =cut
4554:
4555: sub latexlanguage {
4556: my $code = shift;
4557: return $latex_language{$code};
4558: }
4559:
4560: =pod
4561:
4562: =item * &latexhyphenation()
4563:
4564: Same as above but what's supplied is the language as it might be stored
4565: in the metadata.
4566:
4567: =cut
4568:
4569: sub latexhyphenation {
4570: my $key = shift;
4571: return $latex_language_bykey{$key};
4572: }
4573:
4574: =pod
4575:
1.648 raeburn 4576: =item * ©rightids()
1.112 bowersj2 4577:
4578: returns list of all copyrights
4579:
4580: =cut
4581:
4582: sub copyrightids {
4583: return sort(keys(%cprtag));
4584: }
4585:
4586: =pod
4587:
1.648 raeburn 4588: =item * ©rightdescription()
1.112 bowersj2 4589:
4590: returns description of a specified copyright id
4591:
4592: =cut
4593:
4594: sub copyrightdescription {
1.166 www 4595: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4596: }
1.197 matthew 4597:
4598: =pod
4599:
1.648 raeburn 4600: =item * &source_copyrightids()
1.192 taceyjo1 4601:
4602: returns list of all source copyrights
4603:
4604: =cut
4605:
4606: sub source_copyrightids {
4607: return sort(keys(%scprtag));
4608: }
4609:
4610: =pod
4611:
1.648 raeburn 4612: =item * &source_copyrightdescription()
1.192 taceyjo1 4613:
4614: returns description of a specified source copyright id
4615:
4616: =cut
4617:
4618: sub source_copyrightdescription {
4619: return &mt($scprtag{shift(@_)});
4620: }
1.112 bowersj2 4621:
4622: =pod
4623:
1.648 raeburn 4624: =item * &filecategories()
1.112 bowersj2 4625:
4626: returns list of all file categories
4627:
4628: =cut
4629:
4630: sub filecategories {
4631: return sort(keys(%category_extensions));
4632: }
4633:
4634: =pod
4635:
1.648 raeburn 4636: =item * &filecategorytypes()
1.112 bowersj2 4637:
4638: returns list of file types belonging to a given file
4639: category
4640:
4641: =cut
4642:
4643: sub filecategorytypes {
1.356 albertel 4644: my ($cat) = @_;
1.1248 raeburn 4645: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4646: return @{$category_extensions{lc($cat)}};
4647: } else {
4648: return ();
4649: }
1.112 bowersj2 4650: }
4651:
4652: =pod
4653:
1.648 raeburn 4654: =item * &fileembstyle()
1.112 bowersj2 4655:
4656: returns embedding style for a specified file type
4657:
4658: =cut
4659:
4660: sub fileembstyle {
4661: return $fe{lc(shift(@_))};
1.169 www 4662: }
4663:
1.351 www 4664: sub filemimetype {
4665: return $fm{lc(shift(@_))};
4666: }
4667:
1.169 www 4668:
4669: sub filecategoryselect {
4670: my ($name,$value)=@_;
1.189 matthew 4671: return &select_form($value,$name,
1.970 raeburn 4672: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4673: }
4674:
4675: =pod
4676:
1.648 raeburn 4677: =item * &filedescription()
1.112 bowersj2 4678:
4679: returns description for a specified file type
4680:
4681: =cut
4682:
4683: sub filedescription {
1.188 matthew 4684: my $file_description = $fd{lc(shift())};
4685: $file_description =~ s:([\[\]]):~$1:g;
4686: return &mt($file_description);
1.112 bowersj2 4687: }
4688:
4689: =pod
4690:
1.648 raeburn 4691: =item * &filedescriptionex()
1.112 bowersj2 4692:
4693: returns description for a specified file type with
4694: extra formatting
4695:
4696: =cut
4697:
4698: sub filedescriptionex {
4699: my $ex=shift;
1.188 matthew 4700: my $file_description = $fd{lc($ex)};
4701: $file_description =~ s:([\[\]]):~$1:g;
4702: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4703: }
4704:
4705: # End of .tab access
4706: =pod
4707:
4708: =back
4709:
4710: =cut
4711:
4712: # ------------------------------------------------------------------ File Types
4713: sub fileextensions {
4714: return sort(keys(%fe));
4715: }
4716:
1.97 www 4717: # ----------------------------------------------------------- Display Languages
4718: # returns a hash with all desired display languages
4719: #
4720:
4721: sub display_languages {
4722: my %languages=();
1.695 raeburn 4723: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4724: $languages{$lang}=1;
1.97 www 4725: }
4726: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4727: if ($env{'form.displaylanguage'}) {
1.356 albertel 4728: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4729: $languages{$lang}=1;
1.97 www 4730: }
4731: }
4732: return %languages;
1.14 harris41 4733: }
4734:
1.582 albertel 4735: sub languages {
4736: my ($possible_langs) = @_;
1.695 raeburn 4737: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4738: if (!ref($possible_langs)) {
4739: if( wantarray ) {
4740: return @preferred_langs;
4741: } else {
4742: return $preferred_langs[0];
4743: }
4744: }
4745: my %possibilities = map { $_ => 1 } (@$possible_langs);
4746: my @preferred_possibilities;
4747: foreach my $preferred_lang (@preferred_langs) {
4748: if (exists($possibilities{$preferred_lang})) {
4749: push(@preferred_possibilities, $preferred_lang);
4750: }
4751: }
4752: if( wantarray ) {
4753: return @preferred_possibilities;
4754: }
4755: return $preferred_possibilities[0];
4756: }
4757:
1.742 raeburn 4758: sub user_lang {
4759: my ($touname,$toudom,$fromcid) = @_;
4760: my @userlangs;
4761: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4762: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4763: $env{'course.'.$fromcid.'.languages'}));
4764: } else {
4765: my %langhash = &getlangs($touname,$toudom);
4766: if ($langhash{'languages'} ne '') {
4767: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4768: } else {
4769: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4770: if ($domdefs{'lang_def'} ne '') {
4771: @userlangs = ($domdefs{'lang_def'});
4772: }
4773: }
4774: }
4775: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4776: my $user_lh = Apache::localize->get_handle(@languages);
4777: return $user_lh;
4778: }
4779:
4780:
1.112 bowersj2 4781: ###############################################################
4782: ## Student Answer Attempts ##
4783: ###############################################################
4784:
4785: =pod
4786:
4787: =head1 Alternate Problem Views
4788:
4789: =over 4
4790:
1.648 raeburn 4791: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4792: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4793:
4794: Return string with previous attempt on problem. Arguments:
4795:
4796: =over 4
4797:
4798: =item * $symb: Problem, including path
4799:
4800: =item * $username: username of the desired student
4801:
4802: =item * $domain: domain of the desired student
1.14 harris41 4803:
1.112 bowersj2 4804: =item * $course: Course ID
1.14 harris41 4805:
1.112 bowersj2 4806: =item * $getattempt: Leave blank for all attempts, otherwise put
4807: something
1.14 harris41 4808:
1.112 bowersj2 4809: =item * $regexp: if string matches this regexp, the string will be
4810: sent to $gradesub
1.14 harris41 4811:
1.112 bowersj2 4812: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4813:
1.1199 raeburn 4814: =item * $usec: section of the desired student
4815:
4816: =item * $identifier: counter for student (multiple students one problem) or
4817: problem (one student; whole sequence).
4818:
1.112 bowersj2 4819: =back
1.14 harris41 4820:
1.112 bowersj2 4821: The output string is a table containing all desired attempts, if any.
1.16 harris41 4822:
1.112 bowersj2 4823: =cut
1.1 albertel 4824:
4825: sub get_previous_attempt {
1.1199 raeburn 4826: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4827: my $prevattempts='';
1.43 ng 4828: no strict 'refs';
1.1 albertel 4829: if ($symb) {
1.3 albertel 4830: my (%returnhash)=
4831: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4832: if ($returnhash{'version'}) {
4833: my %lasthash=();
4834: my $version;
4835: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4836: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4837: if ($key =~ /\.rawrndseed$/) {
4838: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4839: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4840: } else {
4841: $lasthash{$key}=$returnhash{$version.':'.$key};
4842: }
1.19 harris41 4843: }
1.1 albertel 4844: }
1.596 albertel 4845: $prevattempts=&start_data_table().&start_data_table_header_row();
4846: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4847: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4848: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4849: foreach my $key (sort(keys(%lasthash))) {
4850: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4851: if ($#parts > 0) {
1.31 albertel 4852: my $data=$parts[-1];
1.989 raeburn 4853: next if ($data eq 'foilorder');
1.31 albertel 4854: pop(@parts);
1.1010 www 4855: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4856: if ($data eq 'type') {
4857: unless ($showsurv) {
4858: my $id = join(',',@parts);
4859: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4860: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4861: $lasthidden{$ign.'.'.$id} = 1;
4862: }
1.945 raeburn 4863: }
1.1199 raeburn 4864: if ($identifier ne '') {
4865: my $id = join(',',@parts);
4866: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4867: $domain,$username,$usec,undef,$course) =~ /^no/) {
4868: $hidestatus{$ign.'.'.$id} = 1;
4869: }
4870: }
4871: } elsif ($data eq 'regrader') {
4872: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4873: my $id = join(',',@parts);
4874: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4875: }
1.1010 www 4876: }
1.31 albertel 4877: } else {
1.41 ng 4878: if ($#parts == 0) {
4879: $prevattempts.='<th>'.$parts[0].'</th>';
4880: } else {
4881: $prevattempts.='<th>'.$ign.'</th>';
4882: }
1.31 albertel 4883: }
1.16 harris41 4884: }
1.596 albertel 4885: $prevattempts.=&end_data_table_header_row();
1.40 ng 4886: if ($getattempt eq '') {
1.1199 raeburn 4887: my (%solved,%resets,%probstatus);
1.1200 raeburn 4888: if (($identifier ne '') && (keys(%regraded) > 0)) {
4889: for ($version=1;$version<=$returnhash{'version'};$version++) {
4890: foreach my $id (keys(%regraded)) {
4891: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4892: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4893: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4894: push(@{$resets{$id}},$version);
1.1199 raeburn 4895: }
4896: }
4897: }
1.1200 raeburn 4898: }
4899: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4900: my (@hidden,@unsolved);
1.945 raeburn 4901: if (%typeparts) {
4902: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4903: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4904: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4905: push(@hidden,$id);
1.1199 raeburn 4906: } elsif ($identifier ne '') {
4907: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4908: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4909: ($hidestatus{$id})) {
1.1200 raeburn 4910: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4911: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4912: push(@{$solved{$id}},$version);
4913: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4914: (ref($solved{$id}) eq 'ARRAY')) {
4915: my $skip;
4916: if (ref($resets{$id}) eq 'ARRAY') {
4917: foreach my $reset (@{$resets{$id}}) {
4918: if ($reset > $solved{$id}[-1]) {
4919: $skip=1;
4920: last;
4921: }
4922: }
4923: }
4924: unless ($skip) {
4925: my ($ign,$partslist) = split(/\./,$id,2);
4926: push(@unsolved,$partslist);
4927: }
4928: }
4929: }
1.945 raeburn 4930: }
4931: }
4932: }
4933: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4934: '<td>'.&mt('Transaction [_1]',$version);
4935: if (@unsolved) {
4936: $prevattempts .= '<span class="LC_nobreak"><label>'.
4937: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4938: &mt('Hide').'</label></span>';
4939: }
4940: $prevattempts .= '</td>';
1.945 raeburn 4941: if (@hidden) {
4942: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4943: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4944: my $hide;
4945: foreach my $id (@hidden) {
4946: if ($key =~ /^\Q$id\E/) {
4947: $hide = 1;
4948: last;
4949: }
4950: }
4951: if ($hide) {
4952: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4953: if (($data eq 'award') || ($data eq 'awarddetail')) {
4954: my $value = &format_previous_attempt_value($key,
4955: $returnhash{$version.':'.$key});
1.1173 kruse 4956: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4957: } else {
4958: $prevattempts.='<td> </td>';
4959: }
4960: } else {
4961: if ($key =~ /\./) {
1.1212 raeburn 4962: my $value = $returnhash{$version.':'.$key};
4963: if ($key =~ /\.rndseed$/) {
4964: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4965: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4966: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4967: }
4968: }
4969: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4970: ' </td>';
1.945 raeburn 4971: } else {
4972: $prevattempts.='<td> </td>';
4973: }
4974: }
4975: }
4976: } else {
4977: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4978: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4979: my $value = $returnhash{$version.':'.$key};
4980: if ($key =~ /\.rndseed$/) {
4981: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4982: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4983: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4984: }
4985: }
4986: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4987: ' </td>';
1.945 raeburn 4988: }
4989: }
4990: $prevattempts.=&end_data_table_row();
1.40 ng 4991: }
1.1 albertel 4992: }
1.945 raeburn 4993: my @currhidden = keys(%lasthidden);
1.596 albertel 4994: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4995: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4996: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4997: if (%typeparts) {
4998: my $hidden;
4999: foreach my $id (@currhidden) {
5000: if ($key =~ /^\Q$id\E/) {
5001: $hidden = 1;
5002: last;
5003: }
5004: }
5005: if ($hidden) {
5006: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
5007: if (($data eq 'award') || ($data eq 'awarddetail')) {
5008: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5009: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5010: $value = &$gradesub($value);
5011: }
1.1173 kruse 5012: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 5013: } else {
5014: $prevattempts.='<td> </td>';
5015: }
5016: } else {
5017: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5018: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5019: $value = &$gradesub($value);
5020: }
1.1173 kruse 5021: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5022: }
5023: } else {
5024: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5025: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5026: $value = &$gradesub($value);
5027: }
1.1173 kruse 5028: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5029: }
1.16 harris41 5030: }
1.596 albertel 5031: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 5032: } else {
1.1305 raeburn 5033: my $msg;
5034: if ($symb =~ /ext\.tool$/) {
5035: $msg = &mt('No grade passed back.');
5036: } else {
5037: $msg = &mt('Nothing submitted - no attempts.');
5038: }
1.596 albertel 5039: $prevattempts=
5040: &start_data_table().&start_data_table_row().
1.1305 raeburn 5041: '<td>'.$msg.'</td>'.
1.596 albertel 5042: &end_data_table_row().&end_data_table();
1.1 albertel 5043: }
5044: } else {
1.596 albertel 5045: $prevattempts=
5046: &start_data_table().&start_data_table_row().
5047: '<td>'.&mt('No data.').'</td>'.
5048: &end_data_table_row().&end_data_table();
1.1 albertel 5049: }
1.10 albertel 5050: }
5051:
1.581 albertel 5052: sub format_previous_attempt_value {
5053: my ($key,$value) = @_;
1.1011 www 5054: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 5055: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 5056: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 5057: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 5058: } elsif ($key =~ /answerstring$/) {
5059: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 5060: my @answer = %answers;
5061: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 5062: my @anskeys = sort(keys(%answers));
5063: if (@anskeys == 1) {
5064: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 5065: if ($answer =~ m{\0}) {
5066: $answer =~ s{\0}{,}g;
1.988 raeburn 5067: }
5068: my $tag_internal_answer_name = 'INTERNAL';
5069: if ($anskeys[0] eq $tag_internal_answer_name) {
5070: $value = $answer;
5071: } else {
5072: $value = $anskeys[0].'='.$answer;
5073: }
5074: } else {
5075: foreach my $ans (@anskeys) {
5076: my $answer = $answers{$ans};
1.1001 raeburn 5077: if ($answer =~ m{\0}) {
5078: $answer =~ s{\0}{,}g;
1.988 raeburn 5079: }
5080: $value .= $ans.'='.$answer.'<br />';;
5081: }
5082: }
1.581 albertel 5083: } else {
1.1173 kruse 5084: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 5085: }
5086: return $value;
5087: }
5088:
5089:
1.107 albertel 5090: sub relative_to_absolute {
5091: my ($url,$output)=@_;
5092: my $parser=HTML::TokeParser->new(\$output);
5093: my $token;
5094: my $thisdir=$url;
5095: my @rlinks=();
5096: while ($token=$parser->get_token) {
5097: if ($token->[0] eq 'S') {
5098: if ($token->[1] eq 'a') {
5099: if ($token->[2]->{'href'}) {
5100: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
5101: }
5102: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
5103: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
5104: } elsif ($token->[1] eq 'base') {
5105: $thisdir=$token->[2]->{'href'};
5106: }
5107: }
5108: }
5109: $thisdir=~s-/[^/]*$--;
1.356 albertel 5110: foreach my $link (@rlinks) {
1.726 raeburn 5111: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 5112: ($link=~/^\//) ||
5113: ($link=~/^javascript:/i) ||
5114: ($link=~/^mailto:/i) ||
5115: ($link=~/^\#/)) {
5116: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
5117: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 5118: }
5119: }
5120: # -------------------------------------------------- Deal with Applet codebases
5121: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
5122: return $output;
5123: }
5124:
1.112 bowersj2 5125: =pod
5126:
1.648 raeburn 5127: =item * &get_student_view()
1.112 bowersj2 5128:
5129: show a snapshot of what student was looking at
5130:
5131: =cut
5132:
1.10 albertel 5133: sub get_student_view {
1.186 albertel 5134: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 5135: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5136: my (%form);
1.10 albertel 5137: my @elements=('symb','courseid','domain','username');
5138: foreach my $element (@elements) {
1.186 albertel 5139: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5140: }
1.186 albertel 5141: if (defined($moreenv)) {
5142: %form=(%form,%{$moreenv});
5143: }
1.236 albertel 5144: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 5145: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 5146: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
5147: $feedurl =~ s{^/adm/wrapper}{};
5148: }
1.650 www 5149: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 5150: $userview=~s/\<body[^\>]*\>//gi;
5151: $userview=~s/\<\/body\>//gi;
5152: $userview=~s/\<html\>//gi;
5153: $userview=~s/\<\/html\>//gi;
5154: $userview=~s/\<head\>//gi;
5155: $userview=~s/\<\/head\>//gi;
5156: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 5157: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 5158: if (wantarray) {
5159: return ($userview,$response);
5160: } else {
5161: return $userview;
5162: }
5163: }
5164:
5165: sub get_student_view_with_retries {
5166: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
5167:
5168: my $ok = 0; # True if we got a good response.
5169: my $content;
5170: my $response;
5171:
5172: # Try to get the student_view done. within the retries count:
5173:
5174: do {
5175: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
5176: $ok = $response->is_success;
5177: if (!$ok) {
5178: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
5179: }
5180: $retries--;
5181: } while (!$ok && ($retries > 0));
5182:
5183: if (!$ok) {
5184: $content = ''; # On error return an empty content.
5185: }
1.651 www 5186: if (wantarray) {
5187: return ($content, $response);
5188: } else {
5189: return $content;
5190: }
1.11 albertel 5191: }
5192:
1.1349 raeburn 5193: sub css_links {
5194: my ($currsymb,$level) = @_;
5195: my ($links,@symbs,%cssrefs,%httpref);
5196: if ($level eq 'map') {
5197: my $navmap = Apache::lonnavmaps::navmap->new();
5198: if (ref($navmap)) {
5199: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
5200: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
5201: foreach my $res (@resources) {
5202: if (ref($res) && $res->symb()) {
5203: push(@symbs,$res->symb());
5204: }
5205: }
5206: }
5207: } else {
5208: @symbs = ($currsymb);
5209: }
5210: foreach my $symb (@symbs) {
5211: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
5212: if ($css_href =~ /\S/) {
5213: unless ($css_href =~ m{https?://}) {
5214: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
5215: my $proburl = &Apache::lonnet::clutter($url);
5216: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
5217: unless ($css_href =~ m{^/}) {
5218: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
5219: }
5220: if ($css_href =~ m{^/(res|uploaded)/}) {
5221: unless (($httpref{'httpref.'.$css_href}) ||
5222: (&Apache::lonnet::is_on_map($css_href))) {
5223: my $thisurl = $proburl;
5224: if ($env{'httpref.'.$proburl}) {
5225: $thisurl = $env{'httpref.'.$proburl};
5226: }
5227: $httpref{'httpref.'.$css_href} = $thisurl;
5228: }
5229: }
5230: }
5231: $cssrefs{$css_href} = 1;
5232: }
5233: }
5234: if (keys(%httpref)) {
5235: &Apache::lonnet::appenv(\%httpref);
5236: }
5237: if (keys(%cssrefs)) {
5238: foreach my $css_href (keys(%cssrefs)) {
5239: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
5240: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
5241: }
5242: }
5243: return $links;
5244: }
5245:
1.112 bowersj2 5246: =pod
5247:
1.648 raeburn 5248: =item * &get_student_answers()
1.112 bowersj2 5249:
5250: show a snapshot of how student was answering problem
5251:
5252: =cut
5253:
1.11 albertel 5254: sub get_student_answers {
1.100 sakharuk 5255: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 5256: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5257: my (%moreenv);
1.11 albertel 5258: my @elements=('symb','courseid','domain','username');
5259: foreach my $element (@elements) {
1.186 albertel 5260: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5261: }
1.186 albertel 5262: $moreenv{'grade_target'}='answer';
5263: %moreenv=(%form,%moreenv);
1.497 raeburn 5264: $feedurl = &Apache::lonnet::clutter($feedurl);
5265: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 5266: return $userview;
1.1 albertel 5267: }
1.116 albertel 5268:
5269: =pod
5270:
5271: =item * &submlink()
5272:
1.242 albertel 5273: Inputs: $text $uname $udom $symb $target
1.116 albertel 5274:
5275: Returns: A link to grades.pm such as to see the SUBM view of a student
5276:
5277: =cut
5278:
5279: ###############################################
5280: sub submlink {
1.242 albertel 5281: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 5282: if (!($uname && $udom)) {
5283: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5284: &Apache::lonnet::whichuser($symb);
1.116 albertel 5285: if (!$symb) { $symb=$cursymb; }
5286: }
1.254 matthew 5287: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5288: $symb=&escape($symb);
1.960 bisitz 5289: if ($target) { $target=" target=\"$target\""; }
5290: return
5291: '<a href="/adm/grades?command=submission'.
5292: '&symb='.$symb.
5293: '&student='.$uname.
5294: '&userdom='.$udom.'"'.
5295: $target.'>'.$text.'</a>';
1.242 albertel 5296: }
5297: ##############################################
5298:
5299: =pod
5300:
5301: =item * &pgrdlink()
5302:
5303: Inputs: $text $uname $udom $symb $target
5304:
5305: Returns: A link to grades.pm such as to see the PGRD view of a student
5306:
5307: =cut
5308:
5309: ###############################################
5310: sub pgrdlink {
5311: my $link=&submlink(@_);
5312: $link=~s/(&command=submission)/$1&showgrading=yes/;
5313: return $link;
5314: }
5315: ##############################################
5316:
5317: =pod
5318:
5319: =item * &pprmlink()
5320:
5321: Inputs: $text $uname $udom $symb $target
5322:
5323: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 5324: student and a specific resource
1.242 albertel 5325:
5326: =cut
5327:
5328: ###############################################
5329: sub pprmlink {
5330: my ($text,$uname,$udom,$symb,$target)=@_;
5331: if (!($uname && $udom)) {
5332: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5333: &Apache::lonnet::whichuser($symb);
1.242 albertel 5334: if (!$symb) { $symb=$cursymb; }
5335: }
1.254 matthew 5336: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5337: $symb=&escape($symb);
1.242 albertel 5338: if ($target) { $target="target=\"$target\""; }
1.595 albertel 5339: return '<a href="/adm/parmset?command=set&'.
5340: 'symb='.$symb.'&uname='.$uname.
5341: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 5342: }
5343: ##############################################
1.37 matthew 5344:
1.112 bowersj2 5345: =pod
5346:
5347: =back
5348:
5349: =cut
5350:
1.37 matthew 5351: ###############################################
1.51 www 5352:
5353:
5354: sub timehash {
1.687 raeburn 5355: my ($thistime) = @_;
5356: my $timezone = &Apache::lonlocal::gettimezone();
5357: my $dt = DateTime->from_epoch(epoch => $thistime)
5358: ->set_time_zone($timezone);
5359: my $wday = $dt->day_of_week();
5360: if ($wday == 7) { $wday = 0; }
5361: return ( 'second' => $dt->second(),
5362: 'minute' => $dt->minute(),
5363: 'hour' => $dt->hour(),
5364: 'day' => $dt->day_of_month(),
5365: 'month' => $dt->month(),
5366: 'year' => $dt->year(),
5367: 'weekday' => $wday,
5368: 'dayyear' => $dt->day_of_year(),
5369: 'dlsav' => $dt->is_dst() );
1.51 www 5370: }
5371:
1.370 www 5372: sub utc_string {
5373: my ($date)=@_;
1.371 www 5374: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5375: }
5376:
1.51 www 5377: sub maketime {
5378: my %th=@_;
1.687 raeburn 5379: my ($epoch_time,$timezone,$dt);
5380: $timezone = &Apache::lonlocal::gettimezone();
5381: eval {
5382: $dt = DateTime->new( year => $th{'year'},
5383: month => $th{'month'},
5384: day => $th{'day'},
5385: hour => $th{'hour'},
5386: minute => $th{'minute'},
5387: second => $th{'second'},
5388: time_zone => $timezone,
5389: );
5390: };
5391: if (!$@) {
5392: $epoch_time = $dt->epoch;
5393: if ($epoch_time) {
5394: return $epoch_time;
5395: }
5396: }
1.51 www 5397: return POSIX::mktime(
5398: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5399: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5400: }
5401:
5402: #########################################
1.51 www 5403:
5404: sub findallcourses {
1.482 raeburn 5405: my ($roles,$uname,$udom) = @_;
1.355 albertel 5406: my %roles;
5407: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5408: my %courses;
1.51 www 5409: my $now=time;
1.482 raeburn 5410: if (!defined($uname)) {
5411: $uname = $env{'user.name'};
5412: }
5413: if (!defined($udom)) {
5414: $udom = $env{'user.domain'};
5415: }
5416: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5417: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5418: if (!%roles) {
5419: %roles = (
5420: cc => 1,
1.907 raeburn 5421: co => 1,
1.482 raeburn 5422: in => 1,
5423: ep => 1,
5424: ta => 1,
5425: cr => 1,
5426: st => 1,
5427: );
5428: }
5429: foreach my $entry (keys(%roleshash)) {
5430: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5431: if ($trole =~ /^cr/) {
5432: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5433: } else {
5434: next if (!exists($roles{$trole}));
5435: }
5436: if ($tend) {
5437: next if ($tend < $now);
5438: }
5439: if ($tstart) {
5440: next if ($tstart > $now);
5441: }
1.1058 raeburn 5442: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5443: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5444: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5445: if ($secpart eq '') {
5446: ($cnum,$role) = split(/_/,$cnumpart);
5447: $sec = 'none';
1.1058 raeburn 5448: $value .= $cnum.'/';
1.482 raeburn 5449: } else {
5450: $cnum = $cnumpart;
5451: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5452: $value .= $cnum.'/'.$sec;
5453: }
5454: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5455: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5456: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5457: }
5458: } else {
5459: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5460: }
1.482 raeburn 5461: }
5462: } else {
5463: foreach my $key (keys(%env)) {
1.483 albertel 5464: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5465: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5466: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5467: next if ($role eq 'ca' || $role eq 'aa');
5468: next if (%roles && !exists($roles{$role}));
5469: my ($starttime,$endtime)=split(/\./,$env{$key});
5470: my $active=1;
5471: if ($starttime) {
5472: if ($now<$starttime) { $active=0; }
5473: }
5474: if ($endtime) {
5475: if ($now>$endtime) { $active=0; }
5476: }
5477: if ($active) {
1.1058 raeburn 5478: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5479: if ($sec eq '') {
5480: $sec = 'none';
1.1058 raeburn 5481: } else {
5482: $value .= $sec;
5483: }
5484: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5485: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5486: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5487: }
5488: } else {
5489: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5490: }
1.474 raeburn 5491: }
5492: }
1.51 www 5493: }
5494: }
1.474 raeburn 5495: return %courses;
1.51 www 5496: }
1.37 matthew 5497:
1.54 www 5498: ###############################################
1.474 raeburn 5499:
5500: sub blockcheck {
1.1372 raeburn 5501: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
5502: unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
5503: my ($has_evb,$check_ipaccess);
5504: my $dom = $env{'user.domain'};
5505: if ($env{'request.course.id'}) {
5506: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5507: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5508: my $checkrole = "cm./$cdom/$cnum";
5509: my $sec = $env{'request.course.sec'};
5510: if ($sec ne '') {
5511: $checkrole .= "/$sec";
5512: }
5513: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5514: ($env{'request.role'} !~ /^st/)) {
5515: $has_evb = 1;
5516: }
5517: unless ($has_evb) {
5518: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
5519: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
5520: if ($udom eq $cdom) {
5521: $check_ipaccess = 1;
5522: }
5523: }
5524: }
1.1375 raeburn 5525: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5526: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5527: my $checkrole;
5528: if ($env{'request.role.domain'} eq '') {
5529: $checkrole = "cm./$env{'user.domain'}/";
5530: } else {
5531: $checkrole = "cm./$env{'request.role.domain'}/";
5532: }
5533: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5534: $has_evb = 1;
5535: }
1.1372 raeburn 5536: }
5537: unless ($has_evb || $check_ipaccess) {
5538: my @machinedoms = &Apache::lonnet::current_machine_domains();
5539: if (($dom eq 'public') && ($activity eq 'port')) {
5540: $dom = $udom;
5541: }
5542: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5543: $check_ipaccess = 1;
5544: } else {
5545: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5546: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5547: my $prim = &Apache::lonnet::domain($dom,'primary');
5548: my $intdom = &Apache::lonnet::internet_dom($prim);
5549: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5550: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5551: $check_ipaccess = 1;
5552: }
5553: }
5554: }
5555: }
5556: if ($check_ipaccess) {
5557: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5558: unless (defined($cached)) {
5559: my %domconfig =
5560: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5561: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5562: }
5563: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5564: foreach my $id (keys(%{$ipaccessref})) {
5565: if (ref($ipaccessref->{$id}) eq 'HASH') {
5566: my $range = $ipaccessref->{$id}->{'ip'};
5567: if ($range) {
5568: if (&Apache::lonnet::ip_match($clientip,$range)) {
5569: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5570: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5571: return ('','','',$id,$dom);
5572: last;
5573: }
5574: }
5575: }
5576: }
5577: }
5578: }
5579: }
5580: }
1.1373 raeburn 5581: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5582: return ();
5583: }
1.1372 raeburn 5584: }
1.1189 raeburn 5585: if (defined($udom) && defined($uname)) {
5586: # If uname and udom are for a course, check for blocks in the course.
5587: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5588: my ($startblock,$endblock,$triggerblock) =
1.1347 raeburn 5589: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189 raeburn 5590: return ($startblock,$endblock,$triggerblock);
5591: }
5592: } else {
1.490 raeburn 5593: $udom = $env{'user.domain'};
5594: $uname = $env{'user.name'};
5595: }
5596:
1.502 raeburn 5597: my $startblock = 0;
5598: my $endblock = 0;
1.1062 raeburn 5599: my $triggerblock = '';
1.1373 raeburn 5600: my %live_courses;
5601: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5602: %live_courses = &findallcourses(undef,$uname,$udom);
5603: }
1.474 raeburn 5604:
1.490 raeburn 5605: # If uname is for a user, and activity is course-specific, i.e.,
5606: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5607:
1.490 raeburn 5608: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5609: $activity eq 'groups' || $activity eq 'printout' ||
1.1346 raeburn 5610: $activity eq 'search' || $activity eq 'reinit' ||
5611: $activity eq 'alert') &&
1.1189 raeburn 5612: ($env{'request.course.id'})) {
1.490 raeburn 5613: foreach my $key (keys(%live_courses)) {
5614: if ($key ne $env{'request.course.id'}) {
5615: delete($live_courses{$key});
5616: }
5617: }
5618: }
5619:
5620: my $otheruser = 0;
5621: my %own_courses;
5622: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5623: # Resource belongs to user other than current user.
5624: $otheruser = 1;
5625: # Gather courses for current user
5626: %own_courses =
5627: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5628: }
5629:
5630: # Gather active course roles - course coordinator, instructor,
5631: # exam proctor, ta, student, or custom role.
1.474 raeburn 5632:
5633: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5634: my ($cdom,$cnum);
5635: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5636: $cdom = $env{'course.'.$course.'.domain'};
5637: $cnum = $env{'course.'.$course.'.num'};
5638: } else {
1.490 raeburn 5639: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5640: }
5641: my $no_ownblock = 0;
5642: my $no_userblock = 0;
1.533 raeburn 5643: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5644: # Check if current user has 'evb' priv for this
5645: if (defined($own_courses{$course})) {
5646: foreach my $sec (keys(%{$own_courses{$course}})) {
5647: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5648: if ($sec ne 'none') {
5649: $checkrole .= '/'.$sec;
5650: }
5651: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5652: $no_ownblock = 1;
5653: last;
5654: }
5655: }
5656: }
5657: # if they have 'evb' priv and are currently not playing student
5658: next if (($no_ownblock) &&
5659: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5660: }
1.474 raeburn 5661: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5662: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5663: if ($sec ne 'none') {
1.482 raeburn 5664: $checkrole .= '/'.$sec;
1.474 raeburn 5665: }
1.490 raeburn 5666: if ($otheruser) {
5667: # Resource belongs to user other than current user.
5668: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5669: my (%allroles,%userroles);
5670: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5671: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5672: my ($trole,$tdom,$tnum,$tsec);
5673: if ($entry =~ /^cr/) {
5674: ($trole,$tdom,$tnum,$tsec) =
5675: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5676: } else {
5677: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5678: }
5679: my ($spec,$area,$trest);
5680: $area = '/'.$tdom.'/'.$tnum;
5681: $trest = $tnum;
5682: if ($tsec ne '') {
5683: $area .= '/'.$tsec;
5684: $trest .= '/'.$tsec;
5685: }
5686: $spec = $trole.'.'.$area;
5687: if ($trole =~ /^cr/) {
5688: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5689: $tdom,$spec,$trest,$area);
5690: } else {
5691: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5692: $tdom,$spec,$trest,$area);
5693: }
5694: }
1.1276 raeburn 5695: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5696: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5697: if ($1) {
5698: $no_userblock = 1;
5699: last;
5700: }
1.486 raeburn 5701: }
5702: }
1.490 raeburn 5703: } else {
5704: # Resource belongs to current user
5705: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5706: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5707: $no_ownblock = 1;
5708: last;
5709: }
1.474 raeburn 5710: }
5711: }
5712: # if they have the evb priv and are currently not playing student
1.482 raeburn 5713: next if (($no_ownblock) &&
1.491 albertel 5714: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5715: next if ($no_userblock);
1.474 raeburn 5716:
1.1303 raeburn 5717: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5718: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5719:
1.1062 raeburn 5720: my ($start,$end,$trigger) =
1.1347 raeburn 5721: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5722: if (($start != 0) &&
5723: (($startblock == 0) || ($startblock > $start))) {
5724: $startblock = $start;
1.1062 raeburn 5725: if ($trigger ne '') {
5726: $triggerblock = $trigger;
5727: }
1.502 raeburn 5728: }
5729: if (($end != 0) &&
5730: (($endblock == 0) || ($endblock < $end))) {
5731: $endblock = $end;
1.1062 raeburn 5732: if ($trigger ne '') {
5733: $triggerblock = $trigger;
5734: }
1.502 raeburn 5735: }
1.490 raeburn 5736: }
1.1062 raeburn 5737: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5738: }
5739:
5740: sub get_blocks {
1.1347 raeburn 5741: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5742: my $startblock = 0;
5743: my $endblock = 0;
1.1062 raeburn 5744: my $triggerblock = '';
1.490 raeburn 5745: my $course = $cdom.'_'.$cnum;
5746: $setters->{$course} = {};
5747: $setters->{$course}{'staff'} = [];
5748: $setters->{$course}{'times'} = [];
1.1062 raeburn 5749: $setters->{$course}{'triggers'} = [];
5750: my (@blockers,%triggered);
5751: my $now = time;
5752: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5753: if ($activity eq 'docs') {
1.1348 raeburn 5754: my ($blocked,$nosymbcache,$noenccheck);
1.1347 raeburn 5755: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5756: $blocked = 1;
5757: $nosymbcache = 1;
1.1348 raeburn 5758: $noenccheck = 1;
1.1347 raeburn 5759: }
1.1348 raeburn 5760: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5761: foreach my $block (@blockers) {
5762: if ($block =~ /^firstaccess____(.+)$/) {
5763: my $item = $1;
5764: my $type = 'map';
5765: my $timersymb = $item;
5766: if ($item eq 'course') {
5767: $type = 'course';
5768: } elsif ($item =~ /___\d+___/) {
5769: $type = 'resource';
5770: } else {
5771: $timersymb = &Apache::lonnet::symbread($item);
5772: }
5773: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5774: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5775: $triggered{$block} = {
5776: start => $start,
5777: end => $end,
5778: type => $type,
5779: };
5780: }
5781: }
5782: } else {
5783: foreach my $block (keys(%commblocks)) {
5784: if ($block =~ m/^(\d+)____(\d+)$/) {
5785: my ($start,$end) = ($1,$2);
5786: if ($start <= time && $end >= time) {
5787: if (ref($commblocks{$block}) eq 'HASH') {
5788: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5789: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5790: unless(grep(/^\Q$block\E$/,@blockers)) {
5791: push(@blockers,$block);
5792: }
5793: }
5794: }
5795: }
5796: }
5797: } elsif ($block =~ /^firstaccess____(.+)$/) {
5798: my $item = $1;
5799: my $timersymb = $item;
5800: my $type = 'map';
5801: if ($item eq 'course') {
5802: $type = 'course';
5803: } elsif ($item =~ /___\d+___/) {
5804: $type = 'resource';
5805: } else {
5806: $timersymb = &Apache::lonnet::symbread($item);
5807: }
5808: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5809: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5810: if ($start && $end) {
5811: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5812: if (ref($commblocks{$block}) eq 'HASH') {
5813: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5814: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5815: unless(grep(/^\Q$block\E$/,@blockers)) {
5816: push(@blockers,$block);
5817: $triggered{$block} = {
5818: start => $start,
5819: end => $end,
5820: type => $type,
5821: };
5822: }
5823: }
5824: }
1.1062 raeburn 5825: }
5826: }
1.490 raeburn 5827: }
1.1062 raeburn 5828: }
5829: }
5830: }
5831: foreach my $blocker (@blockers) {
5832: my ($staff_name,$staff_dom,$title,$blocks) =
5833: &parse_block_record($commblocks{$blocker});
5834: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5835: my ($start,$end,$triggertype);
5836: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5837: ($start,$end) = ($1,$2);
5838: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5839: $start = $triggered{$blocker}{'start'};
5840: $end = $triggered{$blocker}{'end'};
5841: $triggertype = $triggered{$blocker}{'type'};
5842: }
5843: if ($start) {
5844: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5845: if ($triggertype) {
5846: push(@{$$setters{$course}{'triggers'}},$triggertype);
5847: } else {
5848: push(@{$$setters{$course}{'triggers'}},0);
5849: }
5850: if ( ($startblock == 0) || ($startblock > $start) ) {
5851: $startblock = $start;
5852: if ($triggertype) {
5853: $triggerblock = $blocker;
1.474 raeburn 5854: }
5855: }
1.1062 raeburn 5856: if ( ($endblock == 0) || ($endblock < $end) ) {
5857: $endblock = $end;
5858: if ($triggertype) {
5859: $triggerblock = $blocker;
5860: }
5861: }
1.474 raeburn 5862: }
5863: }
1.1062 raeburn 5864: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5865: }
5866:
5867: sub parse_block_record {
5868: my ($record) = @_;
5869: my ($setuname,$setudom,$title,$blocks);
5870: if (ref($record) eq 'HASH') {
5871: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5872: $title = &unescape($record->{'event'});
5873: $blocks = $record->{'blocks'};
5874: } else {
5875: my @data = split(/:/,$record,3);
5876: if (scalar(@data) eq 2) {
5877: $title = $data[1];
5878: ($setuname,$setudom) = split(/@/,$data[0]);
5879: } else {
5880: ($setuname,$setudom,$title) = @data;
5881: }
5882: $blocks = { 'com' => 'on' };
5883: }
5884: return ($setuname,$setudom,$title,$blocks);
5885: }
5886:
1.854 kalberla 5887: sub blocking_status {
1.1372 raeburn 5888: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5889: my %setters;
1.890 droeschl 5890:
1.1061 raeburn 5891: # check for active blocking
1.1372 raeburn 5892: if ($clientip eq '') {
5893: $clientip = &Apache::lonnet::get_requestor_ip();
5894: }
5895: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5896: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5897: my $blocked = 0;
1.1372 raeburn 5898: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5899: $blocked = 1;
5900: }
1.890 droeschl 5901:
1.1061 raeburn 5902: # caller just wants to know whether a block is active
5903: if (!wantarray) { return $blocked; }
5904:
5905: # build a link to a popup window containing the details
5906: my $querystring = "?activity=$activity";
1.1351 raeburn 5907: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5908: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232 raeburn 5909: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5910: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5911: } elsif ($activity eq 'docs') {
1.1347 raeburn 5912: my $showurl = &Apache::lonenc::check_encrypt($url);
5913: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5914: if ($symb) {
5915: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5916: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5917: }
1.1062 raeburn 5918: }
1.1061 raeburn 5919:
5920: my $output .= <<'END_MYBLOCK';
5921: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5922: var options = "width=" + w + ",height=" + h + ",";
5923: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5924: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5925: var newWin = window.open(url, wdwName, options);
5926: newWin.focus();
5927: }
1.890 droeschl 5928: END_MYBLOCK
1.854 kalberla 5929:
1.1061 raeburn 5930: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5931:
1.1061 raeburn 5932: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5933: my $text = &mt('Communication Blocked');
1.1217 raeburn 5934: my $class = 'LC_comblock';
1.1062 raeburn 5935: if ($activity eq 'docs') {
5936: $text = &mt('Content Access Blocked');
1.1217 raeburn 5937: $class = '';
1.1063 raeburn 5938: } elsif ($activity eq 'printout') {
5939: $text = &mt('Printing Blocked');
1.1232 raeburn 5940: } elsif ($activity eq 'passwd') {
5941: $text = &mt('Password Changing Blocked');
1.1345 raeburn 5942: } elsif ($activity eq 'grades') {
5943: $text = &mt('Gradebook Blocked');
1.1346 raeburn 5944: } elsif ($activity eq 'search') {
5945: $text = &mt('Search Blocked');
1.1282 raeburn 5946: } elsif ($activity eq 'alert') {
5947: $text = &mt('Checking Critical Messages Blocked');
5948: } elsif ($activity eq 'reinit') {
5949: $text = &mt('Checking Course Update Blocked');
1.1351 raeburn 5950: } elsif ($activity eq 'about') {
5951: $text = &mt('Access to User Information Pages Blocked');
1.1373 raeburn 5952: } elsif ($activity eq 'wishlist') {
5953: $text = &mt('Access to Stored Links Blocked');
5954: } elsif ($activity eq 'annotate') {
5955: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5956: }
1.1061 raeburn 5957: $output .= <<"END_BLOCK";
1.1217 raeburn 5958: <div class='$class'>
1.869 kalberla 5959: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5960: title='$text'>
5961: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5962: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5963: title='$text'>$text</a>
1.867 kalberla 5964: </div>
5965:
5966: END_BLOCK
1.474 raeburn 5967:
1.1061 raeburn 5968: return ($blocked, $output);
1.854 kalberla 5969: }
1.490 raeburn 5970:
1.60 matthew 5971: ###############################################
5972:
1.682 raeburn 5973: sub check_ip_acc {
1.1201 raeburn 5974: my ($acc,$clientip)=@_;
1.682 raeburn 5975: &Apache::lonxml::debug("acc is $acc");
5976: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5977: return 1;
5978: }
1.1339 raeburn 5979: my ($ip,$allowed);
5980: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5981: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5982: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5983: } else {
1.1350 raeburn 5984: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5985: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339 raeburn 5986: }
1.682 raeburn 5987:
5988: my $name;
1.1219 raeburn 5989: my %access = (
5990: allowfrom => 1,
5991: denyfrom => 0,
5992: );
5993: my @allows;
5994: my @denies;
5995: foreach my $item (split(',',$acc)) {
5996: $item =~ s/^\s*//;
5997: $item =~ s/\s*$//;
5998: my $pattern;
5999: if ($item =~ /^\!(.+)$/) {
6000: push(@denies,$1);
6001: } else {
6002: push(@allows,$item);
6003: }
6004: }
6005: my $numdenies = scalar(@denies);
6006: my $numallows = scalar(@allows);
6007: my $count = 0;
6008: foreach my $pattern (@denies,@allows) {
6009: $count ++;
6010: my $acctype = 'allowfrom';
6011: if ($count <= $numdenies) {
6012: $acctype = 'denyfrom';
6013: }
1.682 raeburn 6014: if ($pattern =~ /\*$/) {
6015: #35.8.*
6016: $pattern=~s/\*//;
1.1219 raeburn 6017: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6018: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
6019: #35.8.3.[34-56]
6020: my $low=$2;
6021: my $high=$3;
6022: $pattern=$1;
6023: if ($ip =~ /^\Q$pattern\E/) {
6024: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 6025: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 6026: }
6027: } elsif ($pattern =~ /^\*/) {
6028: #*.msu.edu
6029: $pattern=~s/\*//;
6030: if (!defined($name)) {
6031: use Socket;
6032: my $netaddr=inet_aton($ip);
6033: ($name)=gethostbyaddr($netaddr,AF_INET);
6034: }
1.1219 raeburn 6035: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 6036: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
6037: #127.0.0.1
1.1219 raeburn 6038: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6039: } else {
6040: #some.name.com
6041: if (!defined($name)) {
6042: use Socket;
6043: my $netaddr=inet_aton($ip);
6044: ($name)=gethostbyaddr($netaddr,AF_INET);
6045: }
1.1219 raeburn 6046: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
6047: }
6048: if ($allowed =~ /^(0|1)$/) { last; }
6049: }
6050: if ($allowed eq '') {
6051: if ($numdenies && !$numallows) {
6052: $allowed = 1;
6053: } else {
6054: $allowed = 0;
1.682 raeburn 6055: }
6056: }
6057: return $allowed;
6058: }
6059:
6060: ###############################################
6061:
1.60 matthew 6062: =pod
6063:
1.112 bowersj2 6064: =head1 Domain Template Functions
6065:
6066: =over 4
6067:
6068: =item * &determinedomain()
1.60 matthew 6069:
6070: Inputs: $domain (usually will be undef)
6071:
1.63 www 6072: Returns: Determines which domain should be used for designs
1.60 matthew 6073:
6074: =cut
1.54 www 6075:
1.60 matthew 6076: ###############################################
1.63 www 6077: sub determinedomain {
6078: my $domain=shift;
1.531 albertel 6079: if (! $domain) {
1.60 matthew 6080: # Determine domain if we have not been given one
1.893 raeburn 6081: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 6082: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
6083: if ($env{'request.role.domain'}) {
6084: $domain=$env{'request.role.domain'};
1.60 matthew 6085: }
6086: }
1.63 www 6087: return $domain;
6088: }
6089: ###############################################
1.517 raeburn 6090:
1.518 albertel 6091: sub devalidate_domconfig_cache {
6092: my ($udom)=@_;
6093: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
6094: }
6095:
6096: # ---------------------- Get domain configuration for a domain
6097: sub get_domainconf {
6098: my ($udom) = @_;
6099: my $cachetime=1800;
6100: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
6101: if (defined($cached)) { return %{$result}; }
6102:
6103: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 6104: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 6105: my (%designhash,%legacy);
1.518 albertel 6106: if (keys(%domconfig) > 0) {
6107: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 6108: if (keys(%{$domconfig{'login'}})) {
6109: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 6110: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 6111: if (($key eq 'loginvia') || ($key eq 'headtag')) {
6112: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6113: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
6114: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
6115: if ($key eq 'loginvia') {
6116: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
6117: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
6118: $designhash{$udom.'.login.loginvia'} = $server;
6119: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
6120:
6121: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
6122: } else {
6123: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
6124: }
1.948 raeburn 6125: }
1.1208 raeburn 6126: } elsif ($key eq 'headtag') {
6127: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
6128: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 6129: }
1.946 raeburn 6130: }
1.1208 raeburn 6131: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
6132: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
6133: }
1.946 raeburn 6134: }
6135: }
6136: }
1.1366 raeburn 6137: } elsif ($key eq 'saml') {
6138: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6139: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
6140: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
6141: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386 raeburn 6142: foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366 raeburn 6143: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
6144: }
6145: }
6146: }
6147: }
1.946 raeburn 6148: } else {
6149: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
6150: $designhash{$udom.'.login.'.$key.'_'.$img} =
6151: $domconfig{'login'}{$key}{$img};
6152: }
1.699 raeburn 6153: }
6154: } else {
6155: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
6156: }
1.632 raeburn 6157: }
6158: } else {
6159: $legacy{'login'} = 1;
1.518 albertel 6160: }
1.632 raeburn 6161: } else {
6162: $legacy{'login'} = 1;
1.518 albertel 6163: }
6164: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 6165: if (keys(%{$domconfig{'rolecolors'}})) {
6166: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
6167: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
6168: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
6169: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
6170: }
1.518 albertel 6171: }
6172: }
1.632 raeburn 6173: } else {
6174: $legacy{'rolecolors'} = 1;
1.518 albertel 6175: }
1.632 raeburn 6176: } else {
6177: $legacy{'rolecolors'} = 1;
1.518 albertel 6178: }
1.948 raeburn 6179: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
6180: if ($domconfig{'autoenroll'}{'co-owners'}) {
6181: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
6182: }
6183: }
1.632 raeburn 6184: if (keys(%legacy) > 0) {
6185: my %legacyhash = &get_legacy_domconf($udom);
6186: foreach my $item (keys(%legacyhash)) {
6187: if ($item =~ /^\Q$udom\E\.login/) {
6188: if ($legacy{'login'}) {
6189: $designhash{$item} = $legacyhash{$item};
6190: }
6191: } else {
6192: if ($legacy{'rolecolors'}) {
6193: $designhash{$item} = $legacyhash{$item};
6194: }
1.518 albertel 6195: }
6196: }
6197: }
1.632 raeburn 6198: } else {
6199: %designhash = &get_legacy_domconf($udom);
1.518 albertel 6200: }
6201: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
6202: $cachetime);
6203: return %designhash;
6204: }
6205:
1.632 raeburn 6206: sub get_legacy_domconf {
6207: my ($udom) = @_;
6208: my %legacyhash;
6209: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
6210: my $designfile = $designdir.'/'.$udom.'.tab';
6211: if (-e $designfile) {
1.1317 raeburn 6212: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 6213: while (my $line = <$fh>) {
6214: next if ($line =~ /^\#/);
6215: chomp($line);
6216: my ($key,$val)=(split(/\=/,$line));
6217: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
6218: }
6219: close($fh);
6220: }
6221: }
1.1026 raeburn 6222: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 6223: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
6224: }
6225: return %legacyhash;
6226: }
6227:
1.63 www 6228: =pod
6229:
1.112 bowersj2 6230: =item * &domainlogo()
1.63 www 6231:
6232: Inputs: $domain (usually will be undef)
6233:
6234: Returns: A link to a domain logo, if the domain logo exists.
6235: If the domain logo does not exist, a description of the domain.
6236:
6237: =cut
1.112 bowersj2 6238:
1.63 www 6239: ###############################################
6240: sub domainlogo {
1.517 raeburn 6241: my $domain = &determinedomain(shift);
1.518 albertel 6242: my %designhash = &get_domainconf($domain);
1.517 raeburn 6243: # See if there is a logo
6244: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 6245: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 6246: if ($imgsrc =~ m{^/(adm|res)/}) {
6247: if ($imgsrc =~ m{^/res/}) {
6248: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
6249: &Apache::lonnet::repcopy($local_name);
6250: }
6251: $imgsrc = &lonhttpdurl($imgsrc);
1.1374 raeburn 6252: }
6253: my $alttext = $domain;
6254: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
6255: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
6256: }
6257: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 6258: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
6259: return &Apache::lonnet::domain($domain,'description');
1.59 www 6260: } else {
1.60 matthew 6261: return '';
1.59 www 6262: }
6263: }
1.63 www 6264: ##############################################
6265:
6266: =pod
6267:
1.112 bowersj2 6268: =item * &designparm()
1.63 www 6269:
6270: Inputs: $which parameter; $domain (usually will be undef)
6271:
6272: Returns: value of designparamter $which
6273:
6274: =cut
1.112 bowersj2 6275:
1.397 albertel 6276:
1.400 albertel 6277: ##############################################
1.397 albertel 6278: sub designparm {
6279: my ($which,$domain)=@_;
6280: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 6281: return $env{'environment.color.'.$which};
1.96 www 6282: }
1.63 www 6283: $domain=&determinedomain($domain);
1.1016 raeburn 6284: my %domdesign;
6285: unless ($domain eq 'public') {
6286: %domdesign = &get_domainconf($domain);
6287: }
1.520 raeburn 6288: my $output;
1.517 raeburn 6289: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 6290: $output = $domdesign{$domain.'.'.$which};
1.63 www 6291: } else {
1.520 raeburn 6292: $output = $defaultdesign{$which};
6293: }
6294: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 6295: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 6296: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 6297: if ($output =~ m{^/res/}) {
6298: my $local_name = &Apache::lonnet::filelocation('',$output);
6299: &Apache::lonnet::repcopy($local_name);
6300: }
1.520 raeburn 6301: $output = &lonhttpdurl($output);
6302: }
1.63 www 6303: }
1.520 raeburn 6304: return $output;
1.63 www 6305: }
1.59 www 6306:
1.822 bisitz 6307: ##############################################
6308: =pod
6309:
1.832 bisitz 6310: =item * &authorspace()
6311:
1.1028 raeburn 6312: Inputs: $url (usually will be undef).
1.832 bisitz 6313:
1.1132 raeburn 6314: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 6315: directory being viewed (or for which action is being taken).
6316: If $url is provided, and begins /priv/<domain>/<uname>
6317: the path will be that portion of the $context argument.
6318: Otherwise the path will be for the author space of the current
6319: user when the current role is author, or for that of the
6320: co-author/assistant co-author space when the current role
6321: is co-author or assistant co-author.
1.832 bisitz 6322:
6323: =cut
6324:
6325: sub authorspace {
1.1028 raeburn 6326: my ($url) = @_;
6327: if ($url ne '') {
6328: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
6329: return $1;
6330: }
6331: }
1.832 bisitz 6332: my $caname = '';
1.1024 www 6333: my $cadom = '';
1.1028 raeburn 6334: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 6335: ($cadom,$caname) =
1.832 bisitz 6336: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 6337: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 6338: $caname = $env{'user.name'};
1.1024 www 6339: $cadom = $env{'user.domain'};
1.832 bisitz 6340: }
1.1028 raeburn 6341: if (($caname ne '') && ($cadom ne '')) {
6342: return "/priv/$cadom/$caname/";
6343: }
6344: return;
1.832 bisitz 6345: }
6346:
6347: ##############################################
6348: =pod
6349:
1.822 bisitz 6350: =item * &head_subbox()
6351:
6352: Inputs: $content (contains HTML code with page functions, etc.)
6353:
6354: Returns: HTML div with $content
6355: To be included in page header
6356:
6357: =cut
6358:
6359: sub head_subbox {
6360: my ($content)=@_;
6361: my $output =
1.993 raeburn 6362: '<div class="LC_head_subbox">'
1.822 bisitz 6363: .$content
6364: .'</div>'
6365: }
6366:
6367: ##############################################
6368: =pod
6369:
6370: =item * &CSTR_pageheader()
6371:
1.1026 raeburn 6372: Input: (optional) filename from which breadcrumb trail is built.
6373: In most cases no input as needed, as $env{'request.filename'}
6374: is appropriate for use in building the breadcrumb trail.
1.1379 raeburn 6375: frameset flag
6376: If page header is being requested for use in a frameset, then
6377: the second (option) argument -- frameset will be true, and
6378: the target attribute set for links should be target="_parent".
1.1407 raeburn 6379: If $title is supplied as the thitd arg, that will be used to
6380: the left of the breadcrumbs tail for the current path.
1.822 bisitz 6381:
6382: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6383: To be included on Authoring Space pages
1.822 bisitz 6384:
6385: =cut
6386:
6387: sub CSTR_pageheader {
1.1407 raeburn 6388: my ($trailfile,$frameset,$title) = @_;
1.1026 raeburn 6389: if ($trailfile eq '') {
6390: $trailfile = $env{'request.filename'};
6391: }
6392:
6393: # this is for resources; directories have customtitle, and crumbs
6394: # and select recent are created in lonpubdir.pm
6395:
6396: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6397: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6398: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6399: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6400: $formaction =~ s{/+}{/}g;
1.822 bisitz 6401:
6402: my $parentpath = '';
6403: my $lastitem = '';
6404: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6405: $parentpath = $1;
6406: $lastitem = $2;
6407: } else {
6408: $lastitem = $thisdisfn;
6409: }
1.921 bisitz 6410:
1.1406 raeburn 6411: my $crsauthor;
1.1246 raeburn 6412: if (($env{'request.course.id'}) &&
6413: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6414: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6415: $crsauthor = 1;
1.1406 raeburn 6416: if ($title eq '') {
6417: $title = &mt('Course Authoring Space');
6418: }
6419: } elsif ($title eq '') {
1.1246 raeburn 6420: $title = &mt('Authoring Space');
6421: }
6422:
1.1379 raeburn 6423: my ($target,$crumbtarget) = (' target="_top"','_top');
6424: if ($frameset) {
6425: $target = ' target="_parent"';
6426: $crumbtarget = '_parent';
6427: } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6428: $target = '';
6429: $crumbtarget = '';
1.1379 raeburn 6430: } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378 raeburn 6431: $target = ' target="'.$env{'request.deeplink.target'}.'"';
6432: $crumbtarget = $env{'request.deeplink.target'};
6433: }
1.1313 raeburn 6434:
1.921 bisitz 6435: my $output =
1.1407 raeburn 6436: '<div>'
1.822 bisitz 6437: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6438: .'<b>'.$title.'</b> '
1.1314 raeburn 6439: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6440: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6441:
6442: if ($lastitem) {
6443: $output .=
6444: '<span class="LC_filename">'
6445: .$lastitem
6446: .'</span>';
6447: }
1.1245 raeburn 6448:
1.1246 raeburn 6449: if ($crsauthor) {
1.1379 raeburn 6450: $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6451: } else {
6452: $output .=
6453: '<br />'
1.1314 raeburn 6454: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6455: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6456: .'</form>'
1.1379 raeburn 6457: .&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6458: }
1.1407 raeburn 6459: $output .= '</div>';
1.921 bisitz 6460:
6461: return $output;
1.822 bisitz 6462: }
6463:
1.1419 ! raeburn 6464: ##############################################
! 6465: =pod
! 6466:
! 6467: =item * &nocodemirror()
! 6468:
! 6469: Input: None
! 6470:
! 6471: Returns: 1 if CodeMirror is deactivated based on
! 6472: user's preference, or domain default,
! 6473: if user indicated use of default.
! 6474:
! 6475: =cut
! 6476:
1.1416 raeburn 6477: sub nocodemirror {
6478: my $nocodem = $env{'environment.nocodemirror'};
6479: unless ($nocodem) {
6480: my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
6481: if ($domdefs{'nocodemirror'}) {
6482: $nocodem = 'yes';
6483: }
6484: }
1.1417 raeburn 6485: if ($nocodem eq 'yes') {
6486: return 1;
6487: }
6488: return;
1.1416 raeburn 6489: }
6490:
1.1419 ! raeburn 6491: ##############################################
! 6492: =pod
! 6493:
! 6494: =item * &permitted_editors()
! 6495:
! 6496: Input: None
! 6497:
! 6498: Returns: %editors hash in which keys are editors
! 6499: permitted in current Authoring Space.
! 6500: Value for each key is 1. Possible keys
! 6501: are: edit, xml, and daxe. If no specific
! 6502: set of editors has been set for the Author
! 6503: who owns the Authoring Space, then the
! 6504: domain default will be used. If no domain
! 6505: default has been set, then the keys will be
! 6506: edit and xml.
! 6507:
! 6508: =cut
! 6509:
1.1418 raeburn 6510: sub permitted_editors {
6511: my ($is_author,$is_coauthor,$auname,$audom,%editors);
6512: if ($env{'request.role'} =~ m{^au\./}) {
6513: $is_author = 1;
6514: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
6515: ($audom,$auname) = ($1,$2);
6516: if (($audom ne '') && ($auname ne '')) {
6517: if (($env{'user.domain'} eq $audom) &&
6518: ($env{'user.name'} eq $auname)) {
6519: $is_author = 1;
6520: } else {
6521: $is_coauthor = 1;
6522: }
6523: }
6524: } elsif ($env{'request.course.id'}) {
6525: if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6526: ($audom,$auname) = ($1,$2);
6527: } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6528: ($audom,$auname) = ($1,$2);
6529: }
6530: if (($audom ne '') && ($auname ne '')) {
6531: if (($env{'user.domain'} eq $audom) &&
6532: ($env{'user.name'} eq $auname)) {
6533: $is_author = 1;
6534: } else {
6535: $is_coauthor = 1;
6536: }
6537: }
6538: }
6539: if ($is_author) {
6540: if (exists($env{'environment.editors'})) {
6541: map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
6542: } else {
6543: %editors = ( edit => 1,
6544: xml => 1,
6545: );
6546: }
6547: } elsif ($is_coauthor) {
6548: if (exists($env{"environment.internal.editors./$audom/$auname"})) {
6549: map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
6550: } else {
6551: %editors = ( edit => 1,
6552: xml => 1,
6553: );
6554: }
6555: } else {
6556: %editors = ( edit => 1,
6557: xml => 1,
6558: );
6559: }
6560: return %editors;
6561: }
6562:
1.60 matthew 6563: ###############################################
6564: ###############################################
6565:
6566: =pod
6567:
1.112 bowersj2 6568: =back
6569:
1.549 albertel 6570: =head1 HTML Helpers
1.112 bowersj2 6571:
6572: =over 4
6573:
6574: =item * &bodytag()
1.60 matthew 6575:
6576: Returns a uniform header for LON-CAPA web pages.
6577:
6578: Inputs:
6579:
1.112 bowersj2 6580: =over 4
6581:
6582: =item * $title, A title to be displayed on the page.
6583:
6584: =item * $function, the current role (can be undef).
6585:
6586: =item * $addentries, extra parameters for the <body> tag.
6587:
6588: =item * $bodyonly, if defined, only return the <body> tag.
6589:
6590: =item * $domain, if defined, force a given domain.
6591:
6592: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6593: text interface only)
1.60 matthew 6594:
1.814 bisitz 6595: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6596: navigational links
1.317 albertel 6597:
1.338 albertel 6598: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6599:
1.460 albertel 6600: =item * $args, optional argument valid values are
6601: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6602: use_absolute -> for external resource or syllabus, this will
6603: contain https://<hostname> if server uses
6604: https (as per hosts.tab), but request is for http
6605: hostname -> hostname, from $r->hostname().
1.460 albertel 6606:
1.1096 raeburn 6607: =item * $advtoolsref, optional argument, ref to an array containing
6608: inlineremote items to be added in "Functions" menu below
6609: breadcrumbs.
6610:
1.1316 raeburn 6611: =item * $ltiscope, optional argument, will be one of: resource, map or
6612: course, if LON-CAPA is in LTI Provider context. Value is
6613: the scope of use, i.e., launch was for access to a single, a map
6614: or the entire course.
6615:
6616: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6617: context, this will contain the URL for the landing item in
6618: the course, after launch from an LTI Consumer
6619:
1.1318 raeburn 6620: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6621: context, this will contain a reference to hash of items
6622: to be included in the page header and/or inline menu.
6623:
1.1385 raeburn 6624: =item * $menucoll, optional argument, if specific menu collection is in
6625: effect, either set as the default for the course, or set for
6626: the deeplink paramater for $env{'request.deeplink.login'}
6627: then $menucoll will be the number of that collection.
6628:
6629: =item * $menuref, optional argument, reference to a hash, containing the
6630: menu options included for the menu in effect, based on the
6631: configuration for the numbered menu collection in use.
6632:
6633: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
6634: within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
6635: if so, $showncrumbsref is set there to 1, and will propagate back
6636: via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
6637: being called a second time.
6638:
1.112 bowersj2 6639: =back
6640:
1.60 matthew 6641: Returns: A uniform header for LON-CAPA web pages.
6642: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6643: If $bodyonly is undef or zero, an html string containing a <body> tag and
6644: other decorations will be returned.
6645:
6646: =cut
6647:
1.54 www 6648: sub bodytag {
1.831 bisitz 6649: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6650: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385 raeburn 6651: $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339 albertel 6652:
1.954 raeburn 6653: my $public;
6654: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6655: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6656: $public = 1;
6657: }
1.460 albertel 6658: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6659: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6660: my $hostname = $args->{'hostname'};
1.339 albertel 6661:
1.183 matthew 6662: $function = &get_users_function() if (!$function);
1.339 albertel 6663: my $img = &designparm($function.'.img',$domain);
6664: my $font = &designparm($function.'.font',$domain);
6665: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6666:
1.803 bisitz 6667: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6668: 'bgcolor' => $pgbg,
1.339 albertel 6669: 'text' => $font,
6670: 'alink' => &designparm($function.'.alink',$domain),
6671: 'vlink' => &designparm($function.'.vlink',$domain),
6672: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6673: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6674:
1.63 www 6675: # role and realm
1.1178 raeburn 6676: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6677: if ($realm) {
6678: $realm = '/'.$realm;
6679: }
1.1357 raeburn 6680: if ($role eq 'ca') {
1.479 albertel 6681: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6682: $realm = &plainname($rname,$rdom);
1.378 raeburn 6683: }
1.55 www 6684: # realm
1.1357 raeburn 6685: my ($cid,$sec);
1.258 albertel 6686: if ($env{'request.course.id'}) {
1.1357 raeburn 6687: $cid = $env{'request.course.id'};
6688: if ($env{'request.course.sec'}) {
6689: $sec = $env{'request.course.sec'};
6690: }
6691: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6692: if (&Apache::lonnet::is_course($1,$2)) {
6693: $cid = $1.'_'.$2;
6694: $sec = $3;
6695: }
6696: }
6697: if ($cid) {
1.378 raeburn 6698: if ($env{'request.role'} !~ /^cr/) {
6699: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6700: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6701: if ($env{'request.role.desc'}) {
6702: $role = $env{'request.role.desc'};
6703: } else {
6704: $role = &mt('Helpdesk[_1]',' '.$2);
6705: }
1.1257 raeburn 6706: } else {
6707: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6708: }
1.1357 raeburn 6709: if ($sec) {
6710: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6711: }
1.1357 raeburn 6712: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6713: } else {
6714: $role = &Apache::lonnet::plaintext($role);
1.54 www 6715: }
1.433 albertel 6716:
1.359 albertel 6717: if (!$realm) { $realm=' '; }
1.330 albertel 6718:
1.438 albertel 6719: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6720:
1.101 www 6721: # construct main body tag
1.359 albertel 6722: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6723: &Apache::lontexconvert::init_math_support();
1.252 albertel 6724:
1.1131 raeburn 6725: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6726:
1.1130 raeburn 6727: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6728: return $bodytag;
1.1130 raeburn 6729: }
1.359 albertel 6730:
1.954 raeburn 6731: if ($public) {
1.433 albertel 6732: undef($role);
6733: }
1.1318 raeburn 6734:
1.1359 raeburn 6735: my $showcrstitle = 1;
1.1357 raeburn 6736: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6737: if (ref($ltimenu) eq 'HASH') {
6738: unless ($ltimenu->{'role'}) {
6739: undef($role);
6740: }
6741: unless ($ltimenu->{'coursetitle'}) {
6742: $realm=' ';
1.1359 raeburn 6743: $showcrstitle = 0;
6744: }
6745: }
6746: } elsif (($cid) && ($menucoll)) {
6747: if (ref($menuref) eq 'HASH') {
6748: unless ($menuref->{'role'}) {
6749: undef($role);
6750: }
6751: unless ($menuref->{'crs'}) {
6752: $realm=' ';
6753: $showcrstitle = 0;
1.1318 raeburn 6754: }
6755: }
6756: }
6757:
1.762 bisitz 6758: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6759: #
6760: # Extra info if you are the DC
6761: my $dc_info = '';
1.1359 raeburn 6762: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6763: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6764: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6765: $dc_info =~ s/\s+$//;
1.359 albertel 6766: }
6767:
1.1237 raeburn 6768: my $crstype;
1.1357 raeburn 6769: if ($cid) {
6770: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 6771: } elsif ($args->{'crstype'}) {
6772: $crstype = $args->{'crstype'};
6773: }
6774: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6775: undef($role);
6776: } else {
1.1242 raeburn 6777: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6778: }
1.853 droeschl 6779:
1.903 droeschl 6780: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6781:
6782: # if ($env{'request.state'} eq 'construct') {
6783: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6784: # }
6785:
1.1130 raeburn 6786: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6787: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6788:
1.1318 raeburn 6789: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 6790: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380 raeburn 6791: $args->{'links_disabled'},
6792: $args->{'links_target'});
1.359 albertel 6793:
1.1318 raeburn 6794: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6795: if ($dc_info) {
6796: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6797: }
6798: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6799: <em>$realm</em> $dc_info</div>|;
6800: return $bodytag;
6801: }
1.894 droeschl 6802:
1.1318 raeburn 6803: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6804: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6805: }
1.916 droeschl 6806:
1.1318 raeburn 6807: $bodytag .= $right;
1.852 droeschl 6808:
1.1318 raeburn 6809: if ($dc_info) {
6810: $dc_info = &dc_courseid_toggle($dc_info);
6811: }
6812: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6813: }
1.916 droeschl 6814:
1.1169 raeburn 6815: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6816: if ($args->{'no_secondary_menu'}) {
6817: return $bodytag;
6818: }
1.1169 raeburn 6819: #don't show menus for public users
1.954 raeburn 6820: if (!$public){
1.1318 raeburn 6821: unless ($args->{'no_inline_menu'}) {
6822: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 6823: $args->{'no_primary_menu'},
1.1369 raeburn 6824: $menucoll,$menuref,
1.1380 raeburn 6825: $args->{'links_disabled'},
6826: $args->{'links_target'});
1.1318 raeburn 6827: }
1.903 droeschl 6828: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6829: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6830: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6831: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385 raeburn 6832: $args->{'bread_crumbs'},'','',$hostname,
6833: $ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6834: } elsif ($forcereg) {
6835: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385 raeburn 6836: $args->{'group'},$args->{'hide_buttons'},
6837: $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6838: } else {
6839: $bodytag .=
6840: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6841: $forcereg,$args->{'group'},
6842: $args->{'bread_crumbs'},
1.1274 raeburn 6843: $advtoolsref,'',$hostname);
1.920 raeburn 6844: }
1.903 droeschl 6845: }else{
6846: # this is to seperate menu from content when there's no secondary
6847: # menu. Especially needed for public accessible ressources.
6848: $bodytag .= '<hr style="clear:both" />';
6849: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6850: }
1.903 droeschl 6851:
1.235 raeburn 6852: return $bodytag;
1.182 matthew 6853: }
6854:
1.917 raeburn 6855: sub dc_courseid_toggle {
6856: my ($dc_info) = @_;
1.980 raeburn 6857: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6858: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6859: &mt('(More ...)').'</a></span>'.
6860: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6861: }
6862:
1.330 albertel 6863: sub make_attr_string {
6864: my ($register,$attr_ref) = @_;
6865:
6866: if ($attr_ref && !ref($attr_ref)) {
6867: die("addentries Must be a hash ref ".
6868: join(':',caller(1))." ".
6869: join(':',caller(0))." ");
6870: }
6871:
6872: if ($register) {
1.339 albertel 6873: my ($on_load,$on_unload);
6874: foreach my $key (keys(%{$attr_ref})) {
6875: if (lc($key) eq 'onload') {
6876: $on_load.=$attr_ref->{$key}.';';
6877: delete($attr_ref->{$key});
6878:
6879: } elsif (lc($key) eq 'onunload') {
6880: $on_unload.=$attr_ref->{$key}.';';
6881: delete($attr_ref->{$key});
6882: }
6883: }
1.953 droeschl 6884: $attr_ref->{'onload'} = $on_load;
6885: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6886: }
1.339 albertel 6887:
1.330 albertel 6888: my $attr_string;
1.1159 raeburn 6889: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6890: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6891: }
6892: return $attr_string;
6893: }
6894:
6895:
1.182 matthew 6896: ###############################################
1.251 albertel 6897: ###############################################
6898:
6899: =pod
6900:
6901: =item * &endbodytag()
6902:
6903: Returns a uniform footer for LON-CAPA web pages.
6904:
1.635 raeburn 6905: Inputs: 1 - optional reference to an args hash
6906: If in the hash, key for noredirectlink has a value which evaluates to true,
6907: a 'Continue' link is not displayed if the page contains an
6908: internal redirect in the <head></head> section,
6909: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6910:
6911: =cut
6912:
6913: sub endbodytag {
1.635 raeburn 6914: my ($args) = @_;
1.1080 raeburn 6915: my $endbodytag;
6916: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6917: $endbodytag='</body>';
6918: }
1.315 albertel 6919: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6920: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386 raeburn 6921: my ($endbodyjs,$idattr);
6922: if ($env{'internal.head.to_opener'}) {
6923: my $linkid = 'LC_continue_link';
6924: $idattr = ' id="'.$linkid.'"';
6925: my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
6926: $endbodyjs=<<ENDJS;
6927: <script type="text/javascript">
6928: // <![CDATA[
6929: function ebFunction(evt) {
6930: evt.preventDefault();
6931: var dest = '$redirect_for_js';
6932: if (window.opener != null && !window.opener.closed) {
6933: window.opener.location.href=dest;
6934: window.close();
6935: } else {
6936: window.location.href=dest;
6937: }
6938: return false;
6939: }
6940:
6941: \$(document).ready(function () {
6942: if (document.getElementById('$linkid')) {
6943: var clickelem = document.getElementById('$linkid');
6944: clickelem.addEventListener('click',ebFunction,false);
6945: }
6946: });
6947: // ]]>
6948: </script>
6949: ENDJS
6950: }
1.635 raeburn 6951: $endbodytag=
1.1386 raeburn 6952: "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635 raeburn 6953: &mt('Continue').'</a>'.
6954: $endbodytag;
6955: }
1.315 albertel 6956: }
1.1411 raeburn 6957: if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
6958: $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
6959: }
1.251 albertel 6960: return $endbodytag;
6961: }
6962:
1.352 albertel 6963: =pod
6964:
6965: =item * &standard_css()
6966:
6967: Returns a style sheet
6968:
6969: Inputs: (all optional)
6970: domain -> force to color decorate a page for a specific
6971: domain
6972: function -> force usage of a specific rolish color scheme
6973: bgcolor -> override the default page bgcolor
6974:
6975: =cut
6976:
1.343 albertel 6977: sub standard_css {
1.345 albertel 6978: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6979: $function = &get_users_function() if (!$function);
6980: my $img = &designparm($function.'.img', $domain);
6981: my $tabbg = &designparm($function.'.tabbg', $domain);
6982: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6983: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6984: #second colour for later usage
1.345 albertel 6985: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6986: my $pgbg_or_bgcolor =
6987: $bgcolor ||
1.352 albertel 6988: &designparm($function.'.pgbg', $domain);
1.382 albertel 6989: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6990: my $alink = &designparm($function.'.alink', $domain);
6991: my $vlink = &designparm($function.'.vlink', $domain);
6992: my $link = &designparm($function.'.link', $domain);
6993:
1.602 albertel 6994: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6995: my $mono = 'monospace';
1.850 bisitz 6996: my $data_table_head = $sidebg;
6997: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6998: my $data_table_dark = '#E0E0E0';
1.470 banghart 6999: my $data_table_darker = '#CCCCCC';
1.349 albertel 7000: my $data_table_highlight = '#FFFF00';
1.352 albertel 7001: my $mail_new = '#FFBB77';
7002: my $mail_new_hover = '#DD9955';
7003: my $mail_read = '#BBBB77';
7004: my $mail_read_hover = '#999944';
7005: my $mail_replied = '#AAAA88';
7006: my $mail_replied_hover = '#888855';
7007: my $mail_other = '#99BBBB';
7008: my $mail_other_hover = '#669999';
1.391 albertel 7009: my $table_header = '#DDDDDD';
1.489 raeburn 7010: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 7011: my $lg_border_color = '#C8C8C8';
1.952 onken 7012: my $button_hover = '#BF2317';
1.392 albertel 7013:
1.608 albertel 7014: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 7015: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
7016: : '0 3px 0 4px';
1.448 albertel 7017:
1.523 albertel 7018:
1.343 albertel 7019: return <<END;
1.947 droeschl 7020:
7021: /* needed for iframe to allow 100% height in FF */
7022: body, html {
7023: margin: 0;
7024: padding: 0 0.5%;
7025: height: 99%; /* to avoid scrollbars */
7026: }
7027:
1.795 www 7028: body {
1.911 bisitz 7029: font-family: $sans;
7030: line-height:130%;
7031: font-size:0.83em;
7032: color:$font;
1.795 www 7033: }
7034:
1.959 onken 7035: a:focus,
7036: a:focus img {
1.795 www 7037: color: red;
7038: }
1.698 harmsja 7039:
1.911 bisitz 7040: form, .inline {
7041: display: inline;
1.795 www 7042: }
1.721 harmsja 7043:
1.795 www 7044: .LC_right {
1.911 bisitz 7045: text-align:right;
1.795 www 7046: }
7047:
7048: .LC_middle {
1.911 bisitz 7049: vertical-align:middle;
1.795 www 7050: }
1.721 harmsja 7051:
1.1130 raeburn 7052: .LC_floatleft {
7053: float: left;
7054: }
7055:
7056: .LC_floatright {
7057: float: right;
7058: }
7059:
1.911 bisitz 7060: .LC_400Box {
7061: width:400px;
7062: }
1.721 harmsja 7063:
1.947 droeschl 7064: .LC_iframecontainer {
7065: width: 98%;
7066: margin: 0;
7067: position: fixed;
7068: top: 8.5em;
7069: bottom: 0;
7070: }
7071:
7072: .LC_iframecontainer iframe{
7073: border: none;
7074: width: 100%;
7075: height: 100%;
7076: }
7077:
1.778 bisitz 7078: .LC_filename {
7079: font-family: $mono;
7080: white-space:pre;
1.921 bisitz 7081: font-size: 120%;
1.778 bisitz 7082: }
7083:
7084: .LC_fileicon {
7085: border: none;
7086: height: 1.3em;
7087: vertical-align: text-bottom;
7088: margin-right: 0.3em;
7089: text-decoration:none;
7090: }
7091:
1.1008 www 7092: .LC_setting {
7093: text-decoration:underline;
7094: }
7095:
1.350 albertel 7096: .LC_error {
7097: color: red;
7098: }
1.795 www 7099:
1.1097 bisitz 7100: .LC_warning {
7101: color: darkorange;
7102: }
7103:
1.457 albertel 7104: .LC_diff_removed {
1.733 bisitz 7105: color: red;
1.394 albertel 7106: }
1.532 albertel 7107:
7108: .LC_info,
1.457 albertel 7109: .LC_success,
7110: .LC_diff_added {
1.350 albertel 7111: color: green;
7112: }
1.795 www 7113:
1.802 bisitz 7114: div.LC_confirm_box {
7115: background-color: #FAFAFA;
7116: border: 1px solid $lg_border_color;
7117: margin-right: 0;
7118: padding: 5px;
7119: }
7120:
7121: div.LC_confirm_box .LC_error img,
7122: div.LC_confirm_box .LC_success img {
7123: vertical-align: middle;
7124: }
7125:
1.1242 raeburn 7126: .LC_maxwidth {
7127: max-width: 100%;
7128: height: auto;
7129: }
7130:
1.1243 raeburn 7131: .LC_textsize_mobile {
7132: \@media only screen and (max-device-width: 480px) {
7133: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
7134: }
7135: }
7136:
1.440 albertel 7137: .LC_icon {
1.771 droeschl 7138: border: none;
1.790 droeschl 7139: vertical-align: middle;
1.771 droeschl 7140: }
7141:
1.543 albertel 7142: .LC_docs_spacer {
7143: width: 25px;
7144: height: 1px;
1.771 droeschl 7145: border: none;
1.543 albertel 7146: }
1.346 albertel 7147:
1.532 albertel 7148: .LC_internal_info {
1.735 bisitz 7149: color: #999999;
1.532 albertel 7150: }
7151:
1.794 www 7152: .LC_discussion {
1.1050 www 7153: background: $data_table_dark;
1.911 bisitz 7154: border: 1px solid black;
7155: margin: 2px;
1.794 www 7156: }
7157:
7158: .LC_disc_action_left {
1.1050 www 7159: background: $sidebg;
1.911 bisitz 7160: text-align: left;
1.1050 www 7161: padding: 4px;
7162: margin: 2px;
1.794 www 7163: }
7164:
7165: .LC_disc_action_right {
1.1050 www 7166: background: $sidebg;
1.911 bisitz 7167: text-align: right;
1.1050 www 7168: padding: 4px;
7169: margin: 2px;
1.794 www 7170: }
7171:
7172: .LC_disc_new_item {
1.911 bisitz 7173: background: white;
7174: border: 2px solid red;
1.1050 www 7175: margin: 4px;
7176: padding: 4px;
1.794 www 7177: }
7178:
7179: .LC_disc_old_item {
1.911 bisitz 7180: background: white;
1.1050 www 7181: margin: 4px;
7182: padding: 4px;
1.794 www 7183: }
7184:
1.458 albertel 7185: table.LC_pastsubmission {
7186: border: 1px solid black;
7187: margin: 2px;
7188: }
7189:
1.924 bisitz 7190: table#LC_menubuttons {
1.345 albertel 7191: width: 100%;
7192: background: $pgbg;
1.392 albertel 7193: border: 2px;
1.402 albertel 7194: border-collapse: separate;
1.803 bisitz 7195: padding: 0;
1.345 albertel 7196: }
1.392 albertel 7197:
1.801 tempelho 7198: table#LC_title_bar a {
7199: color: $fontmenu;
7200: }
1.836 bisitz 7201:
1.807 droeschl 7202: table#LC_title_bar {
1.819 tempelho 7203: clear: both;
1.836 bisitz 7204: display: none;
1.807 droeschl 7205: }
7206:
1.795 www 7207: table#LC_title_bar,
1.933 droeschl 7208: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 7209: table#LC_title_bar.LC_with_remote {
1.359 albertel 7210: width: 100%;
1.392 albertel 7211: border-color: $pgbg;
7212: border-style: solid;
7213: border-width: $border;
1.379 albertel 7214: background: $pgbg;
1.801 tempelho 7215: color: $fontmenu;
1.392 albertel 7216: border-collapse: collapse;
1.803 bisitz 7217: padding: 0;
1.819 tempelho 7218: margin: 0;
1.359 albertel 7219: }
1.795 www 7220:
1.933 droeschl 7221: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 7222: margin: 0;
7223: padding: 0;
1.933 droeschl 7224: position: relative;
7225: list-style: none;
1.913 droeschl 7226: }
1.933 droeschl 7227: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 7228: display: inline;
7229: }
1.933 droeschl 7230:
7231: .LC_breadcrumb_tools_navigation {
1.913 droeschl 7232: padding: 0;
1.933 droeschl 7233: margin: 0;
7234: float: left;
1.913 droeschl 7235: }
1.933 droeschl 7236: .LC_breadcrumb_tools_tools {
7237: padding: 0;
7238: margin: 0;
1.913 droeschl 7239: float: right;
7240: }
7241:
1.1240 raeburn 7242: .LC_placement_prog {
7243: padding-right: 20px;
7244: font-weight: bold;
7245: font-size: 90%;
7246: }
7247:
1.359 albertel 7248: table#LC_title_bar td {
7249: background: $tabbg;
7250: }
1.795 www 7251:
1.911 bisitz 7252: table#LC_menubuttons img {
1.803 bisitz 7253: border: none;
1.346 albertel 7254: }
1.795 www 7255:
1.842 droeschl 7256: .LC_breadcrumbs_component {
1.911 bisitz 7257: float: right;
7258: margin: 0 1em;
1.357 albertel 7259: }
1.842 droeschl 7260: .LC_breadcrumbs_component img {
1.911 bisitz 7261: vertical-align: middle;
1.777 tempelho 7262: }
1.795 www 7263:
1.1243 raeburn 7264: .LC_breadcrumbs_hoverable {
7265: background: $sidebg;
7266: }
7267:
1.383 albertel 7268: td.LC_table_cell_checkbox {
7269: text-align: center;
7270: }
1.795 www 7271:
7272: .LC_fontsize_small {
1.911 bisitz 7273: font-size: 70%;
1.705 tempelho 7274: }
7275:
1.844 bisitz 7276: #LC_breadcrumbs {
1.911 bisitz 7277: clear:both;
7278: background: $sidebg;
7279: border-bottom: 1px solid $lg_border_color;
7280: line-height: 2.5em;
1.933 droeschl 7281: overflow: hidden;
1.911 bisitz 7282: margin: 0;
7283: padding: 0;
1.995 raeburn 7284: text-align: left;
1.819 tempelho 7285: }
1.862 bisitz 7286:
1.1098 bisitz 7287: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 7288: clear:both;
7289: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 7290: border: 1px solid $sidebg;
1.1098 bisitz 7291: margin: 0 0 10px 0;
1.966 bisitz 7292: padding: 3px;
1.995 raeburn 7293: text-align: left;
1.822 bisitz 7294: }
7295:
1.795 www 7296: .LC_fontsize_medium {
1.911 bisitz 7297: font-size: 85%;
1.705 tempelho 7298: }
7299:
1.795 www 7300: .LC_fontsize_large {
1.911 bisitz 7301: font-size: 120%;
1.705 tempelho 7302: }
7303:
1.346 albertel 7304: .LC_menubuttons_inline_text {
7305: color: $font;
1.698 harmsja 7306: font-size: 90%;
1.701 harmsja 7307: padding-left:3px;
1.346 albertel 7308: }
7309:
1.934 droeschl 7310: .LC_menubuttons_inline_text img{
7311: vertical-align: middle;
7312: }
7313:
1.1051 www 7314: li.LC_menubuttons_inline_text img {
1.951 onken 7315: cursor:pointer;
1.1002 droeschl 7316: text-decoration: none;
1.951 onken 7317: }
7318:
1.526 www 7319: .LC_menubuttons_link {
7320: text-decoration: none;
7321: }
1.795 www 7322:
1.522 albertel 7323: .LC_menubuttons_category {
1.521 www 7324: color: $font;
1.526 www 7325: background: $pgbg;
1.521 www 7326: font-size: larger;
7327: font-weight: bold;
7328: }
7329:
1.346 albertel 7330: td.LC_menubuttons_text {
1.911 bisitz 7331: color: $font;
1.346 albertel 7332: }
1.706 harmsja 7333:
1.346 albertel 7334: .LC_current_location {
7335: background: $tabbg;
7336: }
1.795 www 7337:
1.1286 raeburn 7338: td.LC_zero_height {
7339: line-height: 0;
7340: cellpadding: 0;
7341: }
7342:
1.938 bisitz 7343: table.LC_data_table {
1.347 albertel 7344: border: 1px solid #000000;
1.402 albertel 7345: border-collapse: separate;
1.426 albertel 7346: border-spacing: 1px;
1.610 albertel 7347: background: $pgbg;
1.347 albertel 7348: }
1.795 www 7349:
1.422 albertel 7350: .LC_data_table_dense {
7351: font-size: small;
7352: }
1.795 www 7353:
1.507 raeburn 7354: table.LC_nested_outer {
7355: border: 1px solid #000000;
1.589 raeburn 7356: border-collapse: collapse;
1.803 bisitz 7357: border-spacing: 0;
1.507 raeburn 7358: width: 100%;
7359: }
1.795 www 7360:
1.879 raeburn 7361: table.LC_innerpickbox,
1.507 raeburn 7362: table.LC_nested {
1.803 bisitz 7363: border: none;
1.589 raeburn 7364: border-collapse: collapse;
1.803 bisitz 7365: border-spacing: 0;
1.507 raeburn 7366: width: 100%;
7367: }
1.795 www 7368:
1.911 bisitz 7369: table.LC_data_table tr th,
7370: table.LC_calendar tr th,
1.879 raeburn 7371: table.LC_prior_tries tr th,
7372: table.LC_innerpickbox tr th {
1.349 albertel 7373: font-weight: bold;
7374: background-color: $data_table_head;
1.801 tempelho 7375: color:$fontmenu;
1.701 harmsja 7376: font-size:90%;
1.347 albertel 7377: }
1.795 www 7378:
1.879 raeburn 7379: table.LC_innerpickbox tr th,
7380: table.LC_innerpickbox tr td {
7381: vertical-align: top;
7382: }
7383:
1.711 raeburn 7384: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7385: background-color: #CCCCCC;
1.711 raeburn 7386: font-weight: bold;
7387: text-align: left;
7388: }
1.795 www 7389:
1.912 bisitz 7390: table.LC_data_table tr.LC_odd_row > td {
7391: background-color: $data_table_light;
7392: padding: 2px;
7393: vertical-align: top;
7394: }
7395:
1.809 bisitz 7396: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7397: background-color: $data_table_light;
1.912 bisitz 7398: vertical-align: top;
7399: }
7400:
7401: table.LC_data_table tr.LC_even_row > td {
7402: background-color: $data_table_dark;
1.425 albertel 7403: padding: 2px;
1.900 bisitz 7404: vertical-align: top;
1.347 albertel 7405: }
1.795 www 7406:
1.809 bisitz 7407: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7408: background-color: $data_table_dark;
1.900 bisitz 7409: vertical-align: top;
1.347 albertel 7410: }
1.795 www 7411:
1.425 albertel 7412: table.LC_data_table tr.LC_data_table_highlight td {
7413: background-color: $data_table_darker;
7414: }
1.795 www 7415:
1.639 raeburn 7416: table.LC_data_table tr td.LC_leftcol_header {
7417: background-color: $data_table_head;
7418: font-weight: bold;
7419: }
1.795 www 7420:
1.451 albertel 7421: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7422: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7423: font-weight: bold;
7424: font-style: italic;
7425: text-align: center;
7426: padding: 8px;
1.347 albertel 7427: }
1.795 www 7428:
1.1114 raeburn 7429: table.LC_data_table tr.LC_empty_row td,
7430: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7431: background-color: $sidebg;
7432: }
7433:
7434: table.LC_nested tr.LC_empty_row td {
7435: background-color: #FFFFFF;
7436: }
7437:
1.890 droeschl 7438: table.LC_caption {
7439: }
7440:
1.507 raeburn 7441: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7442: padding: 4ex
7443: }
1.795 www 7444:
1.507 raeburn 7445: table.LC_nested_outer tr th {
7446: font-weight: bold;
1.801 tempelho 7447: color:$fontmenu;
1.507 raeburn 7448: background-color: $data_table_head;
1.701 harmsja 7449: font-size: small;
1.507 raeburn 7450: border-bottom: 1px solid #000000;
7451: }
1.795 www 7452:
1.507 raeburn 7453: table.LC_nested_outer tr td.LC_subheader {
7454: background-color: $data_table_head;
7455: font-weight: bold;
7456: font-size: small;
7457: border-bottom: 1px solid #000000;
7458: text-align: right;
1.451 albertel 7459: }
1.795 www 7460:
1.507 raeburn 7461: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7462: background-color: #CCCCCC;
1.451 albertel 7463: font-weight: bold;
7464: font-size: small;
1.507 raeburn 7465: text-align: center;
7466: }
1.795 www 7467:
1.589 raeburn 7468: table.LC_nested tr.LC_info_row td.LC_left_item,
7469: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7470: text-align: left;
1.451 albertel 7471: }
1.795 www 7472:
1.507 raeburn 7473: table.LC_nested td {
1.735 bisitz 7474: background-color: #FFFFFF;
1.451 albertel 7475: font-size: small;
1.507 raeburn 7476: }
1.795 www 7477:
1.507 raeburn 7478: table.LC_nested_outer tr th.LC_right_item,
7479: table.LC_nested tr.LC_info_row td.LC_right_item,
7480: table.LC_nested tr.LC_odd_row td.LC_right_item,
7481: table.LC_nested tr td.LC_right_item {
1.451 albertel 7482: text-align: right;
7483: }
7484:
1.507 raeburn 7485: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7486: background-color: #EEEEEE;
1.451 albertel 7487: }
7488:
1.473 raeburn 7489: table.LC_createuser {
7490: }
7491:
7492: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7493: font-size: small;
1.473 raeburn 7494: }
7495:
7496: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7497: background-color: #CCCCCC;
1.473 raeburn 7498: font-weight: bold;
7499: text-align: center;
7500: }
7501:
1.349 albertel 7502: table.LC_calendar {
7503: border: 1px solid #000000;
7504: border-collapse: collapse;
1.917 raeburn 7505: width: 98%;
1.349 albertel 7506: }
1.795 www 7507:
1.349 albertel 7508: table.LC_calendar_pickdate {
7509: font-size: xx-small;
7510: }
1.795 www 7511:
1.349 albertel 7512: table.LC_calendar tr td {
7513: border: 1px solid #000000;
7514: vertical-align: top;
1.917 raeburn 7515: width: 14%;
1.349 albertel 7516: }
1.795 www 7517:
1.349 albertel 7518: table.LC_calendar tr td.LC_calendar_day_empty {
7519: background-color: $data_table_dark;
7520: }
1.795 www 7521:
1.779 bisitz 7522: table.LC_calendar tr td.LC_calendar_day_current {
7523: background-color: $data_table_highlight;
1.777 tempelho 7524: }
1.795 www 7525:
1.938 bisitz 7526: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7527: background-color: $mail_new;
7528: }
1.795 www 7529:
1.938 bisitz 7530: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7531: background-color: $mail_new_hover;
7532: }
1.795 www 7533:
1.938 bisitz 7534: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7535: background-color: $mail_read;
7536: }
1.795 www 7537:
1.938 bisitz 7538: /*
7539: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7540: background-color: $mail_read_hover;
7541: }
1.938 bisitz 7542: */
1.795 www 7543:
1.938 bisitz 7544: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7545: background-color: $mail_replied;
7546: }
1.795 www 7547:
1.938 bisitz 7548: /*
7549: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7550: background-color: $mail_replied_hover;
7551: }
1.938 bisitz 7552: */
1.795 www 7553:
1.938 bisitz 7554: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7555: background-color: $mail_other;
7556: }
1.795 www 7557:
1.938 bisitz 7558: /*
7559: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7560: background-color: $mail_other_hover;
7561: }
1.938 bisitz 7562: */
1.494 raeburn 7563:
1.777 tempelho 7564: table.LC_data_table tr > td.LC_browser_file,
7565: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7566: background: #AAEE77;
1.389 albertel 7567: }
1.795 www 7568:
1.777 tempelho 7569: table.LC_data_table tr > td.LC_browser_file_locked,
7570: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7571: background: #FFAA99;
1.387 albertel 7572: }
1.795 www 7573:
1.777 tempelho 7574: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7575: background: #888888;
1.779 bisitz 7576: }
1.795 www 7577:
1.777 tempelho 7578: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7579: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7580: background: #F8F866;
1.777 tempelho 7581: }
1.795 www 7582:
1.696 bisitz 7583: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7584: background: #E0E8FF;
1.387 albertel 7585: }
1.696 bisitz 7586:
1.707 bisitz 7587: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7588: /* background: #77FF77; */
1.707 bisitz 7589: }
1.795 www 7590:
1.707 bisitz 7591: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7592: border-right: 8px solid #FFFF77;
1.707 bisitz 7593: }
1.795 www 7594:
1.707 bisitz 7595: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7596: border-right: 8px solid #FFAA77;
1.707 bisitz 7597: }
1.795 www 7598:
1.707 bisitz 7599: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7600: border-right: 8px solid #FF7777;
1.707 bisitz 7601: }
1.795 www 7602:
1.707 bisitz 7603: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7604: border-right: 8px solid #AAFF77;
1.707 bisitz 7605: }
1.795 www 7606:
1.707 bisitz 7607: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7608: border-right: 8px solid #11CC55;
1.707 bisitz 7609: }
7610:
1.388 albertel 7611: span.LC_current_location {
1.701 harmsja 7612: font-size:larger;
1.388 albertel 7613: background: $pgbg;
7614: }
1.387 albertel 7615:
1.1029 www 7616: span.LC_current_nav_location {
7617: font-weight:bold;
7618: background: $sidebg;
7619: }
7620:
1.395 albertel 7621: span.LC_parm_menu_item {
7622: font-size: larger;
7623: }
1.795 www 7624:
1.395 albertel 7625: span.LC_parm_scope_all {
7626: color: red;
7627: }
1.795 www 7628:
1.395 albertel 7629: span.LC_parm_scope_folder {
7630: color: green;
7631: }
1.795 www 7632:
1.395 albertel 7633: span.LC_parm_scope_resource {
7634: color: orange;
7635: }
1.795 www 7636:
1.395 albertel 7637: span.LC_parm_part {
7638: color: blue;
7639: }
1.795 www 7640:
1.911 bisitz 7641: span.LC_parm_folder,
7642: span.LC_parm_symb {
1.395 albertel 7643: font-size: x-small;
7644: font-family: $mono;
7645: color: #AAAAAA;
7646: }
7647:
1.977 bisitz 7648: ul.LC_parm_parmlist li {
7649: display: inline-block;
7650: padding: 0.3em 0.8em;
7651: vertical-align: top;
7652: width: 150px;
7653: border-top:1px solid $lg_border_color;
7654: }
7655:
1.795 www 7656: td.LC_parm_overview_level_menu,
7657: td.LC_parm_overview_map_menu,
7658: td.LC_parm_overview_parm_selectors,
7659: td.LC_parm_overview_restrictions {
1.396 albertel 7660: border: 1px solid black;
7661: border-collapse: collapse;
7662: }
1.795 www 7663:
1.1285 raeburn 7664: span.LC_parm_recursive,
7665: td.LC_parm_recursive {
7666: font-weight: bold;
7667: font-size: smaller;
7668: }
7669:
1.396 albertel 7670: table.LC_parm_overview_restrictions td {
7671: border-width: 1px 4px 1px 4px;
7672: border-style: solid;
7673: border-color: $pgbg;
7674: text-align: center;
7675: }
1.795 www 7676:
1.396 albertel 7677: table.LC_parm_overview_restrictions th {
7678: background: $tabbg;
7679: border-width: 1px 4px 1px 4px;
7680: border-style: solid;
7681: border-color: $pgbg;
7682: }
1.795 www 7683:
1.398 albertel 7684: table#LC_helpmenu {
1.803 bisitz 7685: border: none;
1.398 albertel 7686: height: 55px;
1.803 bisitz 7687: border-spacing: 0;
1.398 albertel 7688: }
7689:
7690: table#LC_helpmenu fieldset legend {
7691: font-size: larger;
7692: }
1.795 www 7693:
1.397 albertel 7694: table#LC_helpmenu_links {
7695: width: 100%;
7696: border: 1px solid black;
7697: background: $pgbg;
1.803 bisitz 7698: padding: 0;
1.397 albertel 7699: border-spacing: 1px;
7700: }
1.795 www 7701:
1.397 albertel 7702: table#LC_helpmenu_links tr td {
7703: padding: 1px;
7704: background: $tabbg;
1.399 albertel 7705: text-align: center;
7706: font-weight: bold;
1.397 albertel 7707: }
1.396 albertel 7708:
1.795 www 7709: table#LC_helpmenu_links a:link,
7710: table#LC_helpmenu_links a:visited,
1.397 albertel 7711: table#LC_helpmenu_links a:active {
7712: text-decoration: none;
7713: color: $font;
7714: }
1.795 www 7715:
1.397 albertel 7716: table#LC_helpmenu_links a:hover {
7717: text-decoration: underline;
7718: color: $vlink;
7719: }
1.396 albertel 7720:
1.417 albertel 7721: .LC_chrt_popup_exists {
7722: border: 1px solid #339933;
7723: margin: -1px;
7724: }
1.795 www 7725:
1.417 albertel 7726: .LC_chrt_popup_up {
7727: border: 1px solid yellow;
7728: margin: -1px;
7729: }
1.795 www 7730:
1.417 albertel 7731: .LC_chrt_popup {
7732: border: 1px solid #8888FF;
7733: background: #CCCCFF;
7734: }
1.795 www 7735:
1.421 albertel 7736: table.LC_pick_box {
7737: border-collapse: separate;
7738: background: white;
7739: border: 1px solid black;
7740: border-spacing: 1px;
7741: }
1.795 www 7742:
1.421 albertel 7743: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7744: background: $sidebg;
1.421 albertel 7745: font-weight: bold;
1.900 bisitz 7746: text-align: left;
1.740 bisitz 7747: vertical-align: top;
1.421 albertel 7748: width: 184px;
7749: padding: 8px;
7750: }
1.795 www 7751:
1.579 raeburn 7752: table.LC_pick_box td.LC_pick_box_value {
7753: text-align: left;
7754: padding: 8px;
7755: }
1.795 www 7756:
1.579 raeburn 7757: table.LC_pick_box td.LC_pick_box_select {
7758: text-align: left;
7759: padding: 8px;
7760: }
1.795 www 7761:
1.424 albertel 7762: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7763: padding: 0;
1.421 albertel 7764: height: 1px;
7765: background: black;
7766: }
1.795 www 7767:
1.421 albertel 7768: table.LC_pick_box td.LC_pick_box_submit {
7769: text-align: right;
7770: }
1.795 www 7771:
1.579 raeburn 7772: table.LC_pick_box td.LC_evenrow_value {
7773: text-align: left;
7774: padding: 8px;
7775: background-color: $data_table_light;
7776: }
1.795 www 7777:
1.579 raeburn 7778: table.LC_pick_box td.LC_oddrow_value {
7779: text-align: left;
7780: padding: 8px;
7781: background-color: $data_table_light;
7782: }
1.795 www 7783:
1.579 raeburn 7784: span.LC_helpform_receipt_cat {
7785: font-weight: bold;
7786: }
1.795 www 7787:
1.424 albertel 7788: table.LC_group_priv_box {
7789: background: white;
7790: border: 1px solid black;
7791: border-spacing: 1px;
7792: }
1.795 www 7793:
1.424 albertel 7794: table.LC_group_priv_box td.LC_pick_box_title {
7795: background: $tabbg;
7796: font-weight: bold;
7797: text-align: right;
7798: width: 184px;
7799: }
1.795 www 7800:
1.424 albertel 7801: table.LC_group_priv_box td.LC_groups_fixed {
7802: background: $data_table_light;
7803: text-align: center;
7804: }
1.795 www 7805:
1.424 albertel 7806: table.LC_group_priv_box td.LC_groups_optional {
7807: background: $data_table_dark;
7808: text-align: center;
7809: }
1.795 www 7810:
1.424 albertel 7811: table.LC_group_priv_box td.LC_groups_functionality {
7812: background: $data_table_darker;
7813: text-align: center;
7814: font-weight: bold;
7815: }
1.795 www 7816:
1.424 albertel 7817: table.LC_group_priv td {
7818: text-align: left;
1.803 bisitz 7819: padding: 0;
1.424 albertel 7820: }
7821:
7822: .LC_navbuttons {
7823: margin: 2ex 0ex 2ex 0ex;
7824: }
1.795 www 7825:
1.423 albertel 7826: .LC_topic_bar {
7827: font-weight: bold;
7828: background: $tabbg;
1.918 wenzelju 7829: margin: 1em 0em 1em 2em;
1.805 bisitz 7830: padding: 3px;
1.918 wenzelju 7831: font-size: 1.2em;
1.423 albertel 7832: }
1.795 www 7833:
1.423 albertel 7834: .LC_topic_bar span {
1.918 wenzelju 7835: left: 0.5em;
7836: position: absolute;
1.423 albertel 7837: vertical-align: middle;
1.918 wenzelju 7838: font-size: 1.2em;
1.423 albertel 7839: }
1.795 www 7840:
1.423 albertel 7841: table.LC_course_group_status {
7842: margin: 20px;
7843: }
1.795 www 7844:
1.423 albertel 7845: table.LC_status_selector td {
7846: vertical-align: top;
7847: text-align: center;
1.424 albertel 7848: padding: 4px;
7849: }
1.795 www 7850:
1.599 albertel 7851: div.LC_feedback_link {
1.616 albertel 7852: clear: both;
1.829 kalberla 7853: background: $sidebg;
1.779 bisitz 7854: width: 100%;
1.829 kalberla 7855: padding-bottom: 10px;
7856: border: 1px $tabbg solid;
1.833 kalberla 7857: height: 22px;
7858: line-height: 22px;
7859: padding-top: 5px;
7860: }
7861:
7862: div.LC_feedback_link img {
7863: height: 22px;
1.867 kalberla 7864: vertical-align:middle;
1.829 kalberla 7865: }
7866:
1.911 bisitz 7867: div.LC_feedback_link a {
1.829 kalberla 7868: text-decoration: none;
1.489 raeburn 7869: }
1.795 www 7870:
1.867 kalberla 7871: div.LC_comblock {
1.911 bisitz 7872: display:inline;
1.867 kalberla 7873: color:$font;
7874: font-size:90%;
7875: }
7876:
7877: div.LC_feedback_link div.LC_comblock {
7878: padding-left:5px;
7879: }
7880:
7881: div.LC_feedback_link div.LC_comblock a {
7882: color:$font;
7883: }
7884:
1.489 raeburn 7885: span.LC_feedback_link {
1.858 bisitz 7886: /* background: $feedback_link_bg; */
1.599 albertel 7887: font-size: larger;
7888: }
1.795 www 7889:
1.599 albertel 7890: span.LC_message_link {
1.858 bisitz 7891: /* background: $feedback_link_bg; */
1.599 albertel 7892: font-size: larger;
7893: position: absolute;
7894: right: 1em;
1.489 raeburn 7895: }
1.421 albertel 7896:
1.515 albertel 7897: table.LC_prior_tries {
1.524 albertel 7898: border: 1px solid #000000;
7899: border-collapse: separate;
7900: border-spacing: 1px;
1.515 albertel 7901: }
1.523 albertel 7902:
1.515 albertel 7903: table.LC_prior_tries td {
1.524 albertel 7904: padding: 2px;
1.515 albertel 7905: }
1.523 albertel 7906:
7907: .LC_answer_correct {
1.795 www 7908: background: lightgreen;
7909: color: darkgreen;
7910: padding: 6px;
1.523 albertel 7911: }
1.795 www 7912:
1.523 albertel 7913: .LC_answer_charged_try {
1.797 www 7914: background: #FFAAAA;
1.795 www 7915: color: darkred;
7916: padding: 6px;
1.523 albertel 7917: }
1.795 www 7918:
1.779 bisitz 7919: .LC_answer_not_charged_try,
1.523 albertel 7920: .LC_answer_no_grade,
7921: .LC_answer_late {
1.795 www 7922: background: lightyellow;
1.523 albertel 7923: color: black;
1.795 www 7924: padding: 6px;
1.523 albertel 7925: }
1.795 www 7926:
1.523 albertel 7927: .LC_answer_previous {
1.795 www 7928: background: lightblue;
7929: color: darkblue;
7930: padding: 6px;
1.523 albertel 7931: }
1.795 www 7932:
1.779 bisitz 7933: .LC_answer_no_message {
1.777 tempelho 7934: background: #FFFFFF;
7935: color: black;
1.795 www 7936: padding: 6px;
1.779 bisitz 7937: }
1.795 www 7938:
1.1334 raeburn 7939: .LC_answer_unknown,
7940: .LC_answer_warning {
1.779 bisitz 7941: background: orange;
7942: color: black;
1.795 www 7943: padding: 6px;
1.777 tempelho 7944: }
1.795 www 7945:
1.529 albertel 7946: span.LC_prior_numerical,
7947: span.LC_prior_string,
7948: span.LC_prior_custom,
7949: span.LC_prior_reaction,
7950: span.LC_prior_math {
1.925 bisitz 7951: font-family: $mono;
1.523 albertel 7952: white-space: pre;
7953: }
7954:
1.525 albertel 7955: span.LC_prior_string {
1.925 bisitz 7956: font-family: $mono;
1.525 albertel 7957: white-space: pre;
7958: }
7959:
1.523 albertel 7960: table.LC_prior_option {
7961: width: 100%;
7962: border-collapse: collapse;
7963: }
1.795 www 7964:
1.911 bisitz 7965: table.LC_prior_rank,
1.795 www 7966: table.LC_prior_match {
1.528 albertel 7967: border-collapse: collapse;
7968: }
1.795 www 7969:
1.528 albertel 7970: table.LC_prior_option tr td,
7971: table.LC_prior_rank tr td,
7972: table.LC_prior_match tr td {
1.524 albertel 7973: border: 1px solid #000000;
1.515 albertel 7974: }
7975:
1.855 bisitz 7976: .LC_nobreak {
1.544 albertel 7977: white-space: nowrap;
1.519 raeburn 7978: }
7979:
1.576 raeburn 7980: span.LC_cusr_emph {
7981: font-style: italic;
7982: }
7983:
1.633 raeburn 7984: span.LC_cusr_subheading {
7985: font-weight: normal;
7986: font-size: 85%;
7987: }
7988:
1.861 bisitz 7989: div.LC_docs_entry_move {
1.859 bisitz 7990: border: 1px solid #BBBBBB;
1.545 albertel 7991: background: #DDDDDD;
1.861 bisitz 7992: width: 22px;
1.859 bisitz 7993: padding: 1px;
7994: margin: 0;
1.545 albertel 7995: }
7996:
1.861 bisitz 7997: table.LC_data_table tr > td.LC_docs_entry_commands,
7998: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7999: font-size: x-small;
8000: }
1.795 www 8001:
1.861 bisitz 8002: .LC_docs_entry_parameter {
8003: white-space: nowrap;
8004: }
8005:
1.544 albertel 8006: .LC_docs_copy {
1.545 albertel 8007: color: #000099;
1.544 albertel 8008: }
1.795 www 8009:
1.544 albertel 8010: .LC_docs_cut {
1.545 albertel 8011: color: #550044;
1.544 albertel 8012: }
1.795 www 8013:
1.544 albertel 8014: .LC_docs_rename {
1.545 albertel 8015: color: #009900;
1.544 albertel 8016: }
1.795 www 8017:
1.544 albertel 8018: .LC_docs_remove {
1.545 albertel 8019: color: #990000;
8020: }
8021:
1.1284 raeburn 8022: .LC_docs_alias {
8023: color: #440055;
8024: }
8025:
1.1286 raeburn 8026: .LC_domprefs_email,
1.1284 raeburn 8027: .LC_docs_alias_name,
1.547 albertel 8028: .LC_docs_reinit_warn,
8029: .LC_docs_ext_edit {
8030: font-size: x-small;
8031: }
8032:
1.545 albertel 8033: table.LC_docs_adddocs td,
8034: table.LC_docs_adddocs th {
8035: border: 1px solid #BBBBBB;
8036: padding: 4px;
8037: background: #DDDDDD;
1.543 albertel 8038: }
8039:
1.584 albertel 8040: table.LC_sty_begin {
8041: background: #BBFFBB;
8042: }
1.795 www 8043:
1.584 albertel 8044: table.LC_sty_end {
8045: background: #FFBBBB;
8046: }
8047:
1.589 raeburn 8048: table.LC_double_column {
1.803 bisitz 8049: border-width: 0;
1.589 raeburn 8050: border-collapse: collapse;
8051: width: 100%;
8052: padding: 2px;
8053: }
8054:
8055: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 8056: top: 2px;
1.589 raeburn 8057: left: 2px;
8058: width: 47%;
8059: vertical-align: top;
8060: }
8061:
8062: table.LC_double_column tr td.LC_right_col {
8063: top: 2px;
1.779 bisitz 8064: right: 2px;
1.589 raeburn 8065: width: 47%;
8066: vertical-align: top;
8067: }
8068:
1.591 raeburn 8069: div.LC_left_float {
8070: float: left;
8071: padding-right: 5%;
1.597 albertel 8072: padding-bottom: 4px;
1.591 raeburn 8073: }
8074:
8075: div.LC_clear_float_header {
1.597 albertel 8076: padding-bottom: 2px;
1.591 raeburn 8077: }
8078:
8079: div.LC_clear_float_footer {
1.597 albertel 8080: padding-top: 10px;
1.591 raeburn 8081: clear: both;
8082: }
8083:
1.597 albertel 8084: div.LC_grade_show_user {
1.941 bisitz 8085: /* border-left: 5px solid $sidebg; */
8086: border-top: 5px solid #000000;
8087: margin: 50px 0 0 0;
1.936 bisitz 8088: padding: 15px 0 5px 10px;
1.597 albertel 8089: }
1.795 www 8090:
1.936 bisitz 8091: div.LC_grade_show_user_odd_row {
1.941 bisitz 8092: /* border-left: 5px solid #000000; */
8093: }
8094:
8095: div.LC_grade_show_user div.LC_Box {
8096: margin-right: 50px;
1.597 albertel 8097: }
8098:
8099: div.LC_grade_submissions,
8100: div.LC_grade_message_center,
1.936 bisitz 8101: div.LC_grade_info_links {
1.597 albertel 8102: margin: 5px;
8103: width: 99%;
8104: background: #FFFFFF;
8105: }
1.795 www 8106:
1.597 albertel 8107: div.LC_grade_submissions_header,
1.936 bisitz 8108: div.LC_grade_message_center_header {
1.705 tempelho 8109: font-weight: bold;
8110: font-size: large;
1.597 albertel 8111: }
1.795 www 8112:
1.597 albertel 8113: div.LC_grade_submissions_body,
1.936 bisitz 8114: div.LC_grade_message_center_body {
1.597 albertel 8115: border: 1px solid black;
8116: width: 99%;
8117: background: #FFFFFF;
8118: }
1.795 www 8119:
1.613 albertel 8120: table.LC_scantron_action {
8121: width: 100%;
8122: }
1.795 www 8123:
1.613 albertel 8124: table.LC_scantron_action tr th {
1.698 harmsja 8125: font-weight:bold;
8126: font-style:normal;
1.613 albertel 8127: }
1.795 www 8128:
1.779 bisitz 8129: .LC_edit_problem_header,
1.614 albertel 8130: div.LC_edit_problem_footer {
1.705 tempelho 8131: font-weight: normal;
8132: font-size: medium;
1.602 albertel 8133: margin: 2px;
1.1060 bisitz 8134: background-color: $sidebg;
1.600 albertel 8135: }
1.795 www 8136:
1.600 albertel 8137: div.LC_edit_problem_header,
1.602 albertel 8138: div.LC_edit_problem_header div,
1.614 albertel 8139: div.LC_edit_problem_footer,
8140: div.LC_edit_problem_footer div,
1.602 albertel 8141: div.LC_edit_problem_editxml_header,
8142: div.LC_edit_problem_editxml_header div {
1.1205 golterma 8143: z-index: 100;
1.600 albertel 8144: }
1.795 www 8145:
1.600 albertel 8146: div.LC_edit_problem_header_title {
1.705 tempelho 8147: font-weight: bold;
8148: font-size: larger;
1.602 albertel 8149: background: $tabbg;
8150: padding: 3px;
1.1060 bisitz 8151: margin: 0 0 5px 0;
1.602 albertel 8152: }
1.795 www 8153:
1.602 albertel 8154: table.LC_edit_problem_header_title {
8155: width: 100%;
1.600 albertel 8156: background: $tabbg;
1.602 albertel 8157: }
8158:
1.1205 golterma 8159: div.LC_edit_actionbar {
8160: background-color: $sidebg;
1.1218 droeschl 8161: margin: 0;
8162: padding: 0;
8163: line-height: 200%;
1.602 albertel 8164: }
1.795 www 8165:
1.1218 droeschl 8166: div.LC_edit_actionbar div{
8167: padding: 0;
8168: margin: 0;
8169: display: inline-block;
1.600 albertel 8170: }
1.795 www 8171:
1.1124 bisitz 8172: .LC_edit_opt {
8173: padding-left: 1em;
8174: white-space: nowrap;
8175: }
8176:
1.1152 golterma 8177: .LC_edit_problem_latexhelper{
8178: text-align: right;
8179: }
8180:
8181: #LC_edit_problem_colorful div{
8182: margin-left: 40px;
8183: }
8184:
1.1205 golterma 8185: #LC_edit_problem_codemirror div{
8186: margin-left: 0px;
8187: }
8188:
1.911 bisitz 8189: img.stift {
1.803 bisitz 8190: border-width: 0;
8191: vertical-align: middle;
1.677 riegler 8192: }
1.680 riegler 8193:
1.923 bisitz 8194: table td.LC_mainmenu_col_fieldset {
1.680 riegler 8195: vertical-align: top;
1.777 tempelho 8196: }
1.795 www 8197:
1.716 raeburn 8198: div.LC_createcourse {
1.911 bisitz 8199: margin: 10px 10px 10px 10px;
1.716 raeburn 8200: }
8201:
1.917 raeburn 8202: .LC_dccid {
1.1130 raeburn 8203: float: right;
1.917 raeburn 8204: margin: 0.2em 0 0 0;
8205: padding: 0;
8206: font-size: 90%;
8207: display:none;
8208: }
8209:
1.897 wenzelju 8210: ol.LC_primary_menu a:hover,
1.721 harmsja 8211: ol#LC_MenuBreadcrumbs a:hover,
8212: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 8213: ul#LC_secondary_menu a:hover,
1.721 harmsja 8214: .LC_FormSectionClearButton input:hover
1.795 www 8215: ul.LC_TabContent li:hover a {
1.952 onken 8216: color:$button_hover;
1.911 bisitz 8217: text-decoration:none;
1.693 droeschl 8218: }
8219:
1.779 bisitz 8220: h1 {
1.911 bisitz 8221: padding: 0;
8222: line-height:130%;
1.693 droeschl 8223: }
1.698 harmsja 8224:
1.911 bisitz 8225: h2,
8226: h3,
8227: h4,
8228: h5,
8229: h6 {
8230: margin: 5px 0 5px 0;
8231: padding: 0;
8232: line-height:130%;
1.693 droeschl 8233: }
1.795 www 8234:
8235: .LC_hcell {
1.911 bisitz 8236: padding:3px 15px 3px 15px;
8237: margin: 0;
8238: background-color:$tabbg;
8239: color:$fontmenu;
8240: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 8241: }
1.795 www 8242:
1.840 bisitz 8243: .LC_Box > .LC_hcell {
1.911 bisitz 8244: margin: 0 -10px 10px -10px;
1.835 bisitz 8245: }
8246:
1.721 harmsja 8247: .LC_noBorder {
1.911 bisitz 8248: border: 0;
1.698 harmsja 8249: }
1.693 droeschl 8250:
1.721 harmsja 8251: .LC_FormSectionClearButton input {
1.911 bisitz 8252: background-color:transparent;
8253: border: none;
8254: cursor:pointer;
8255: text-decoration:underline;
1.693 droeschl 8256: }
1.763 bisitz 8257:
8258: .LC_help_open_topic {
1.911 bisitz 8259: color: #FFFFFF;
8260: background-color: #EEEEFF;
8261: margin: 1px;
8262: padding: 4px;
8263: border: 1px solid #000033;
8264: white-space: nowrap;
8265: /* vertical-align: middle; */
1.759 neumanie 8266: }
1.693 droeschl 8267:
1.911 bisitz 8268: dl,
8269: ul,
8270: div,
8271: fieldset {
8272: margin: 10px 10px 10px 0;
8273: /* overflow: hidden; */
1.693 droeschl 8274: }
1.795 www 8275:
1.1404 raeburn 8276: fieldset#LC_selectuser {
8277: margin: 0;
8278: padding: 0;
8279: }
8280:
1.1211 raeburn 8281: article.geogebraweb div {
8282: margin: 0;
8283: }
8284:
1.838 bisitz 8285: fieldset > legend {
1.911 bisitz 8286: font-weight: bold;
8287: padding: 0 5px 0 5px;
1.838 bisitz 8288: }
8289:
1.813 bisitz 8290: #LC_nav_bar {
1.911 bisitz 8291: float: left;
1.995 raeburn 8292: background-color: $pgbg_or_bgcolor;
1.966 bisitz 8293: margin: 0 0 2px 0;
1.807 droeschl 8294: }
8295:
1.916 droeschl 8296: #LC_realm {
8297: margin: 0.2em 0 0 0;
8298: padding: 0;
8299: font-weight: bold;
8300: text-align: center;
1.995 raeburn 8301: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8302: }
8303:
1.911 bisitz 8304: #LC_nav_bar em {
8305: font-weight: bold;
8306: font-style: normal;
1.807 droeschl 8307: }
8308:
1.897 wenzelju 8309: ol.LC_primary_menu {
1.934 droeschl 8310: margin: 0;
1.1076 raeburn 8311: padding: 0;
1.807 droeschl 8312: }
8313:
1.852 droeschl 8314: ol#LC_PathBreadcrumbs {
1.911 bisitz 8315: margin: 0;
1.693 droeschl 8316: }
8317:
1.897 wenzelju 8318: ol.LC_primary_menu li {
1.1076 raeburn 8319: color: RGB(80, 80, 80);
8320: vertical-align: middle;
8321: text-align: left;
8322: list-style: none;
1.1205 golterma 8323: position: relative;
1.1076 raeburn 8324: float: left;
1.1205 golterma 8325: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8326: line-height: 1.5em;
1.1076 raeburn 8327: }
8328:
1.1205 golterma 8329: ol.LC_primary_menu li a,
8330: ol.LC_primary_menu li p {
1.1076 raeburn 8331: display: block;
8332: margin: 0;
8333: padding: 0 5px 0 10px;
8334: text-decoration: none;
8335: }
8336:
1.1205 golterma 8337: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8338: display: inline-block;
8339: width: 95%;
8340: text-align: left;
8341: }
8342:
8343: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8344: display: inline-block;
8345: width: 5%;
8346: float: right;
8347: text-align: right;
8348: font-size: 70%;
8349: }
8350:
8351: ol.LC_primary_menu ul {
1.1076 raeburn 8352: display: none;
1.1205 golterma 8353: width: 15em;
1.1076 raeburn 8354: background-color: $data_table_light;
1.1205 golterma 8355: position: absolute;
8356: top: 100%;
1.1076 raeburn 8357: }
8358:
1.1205 golterma 8359: ol.LC_primary_menu ul ul {
8360: left: 100%;
8361: top: 0;
8362: }
8363:
8364: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8365: display: block;
8366: position: absolute;
8367: margin: 0;
8368: padding: 0;
1.1078 raeburn 8369: z-index: 2;
1.1076 raeburn 8370: }
8371:
8372: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8373: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8374: font-size: 90%;
1.911 bisitz 8375: vertical-align: top;
1.1076 raeburn 8376: float: none;
1.1079 raeburn 8377: border-left: 1px solid black;
8378: border-right: 1px solid black;
1.1205 golterma 8379: /* A dark bottom border to visualize different menu options;
8380: overwritten in the create_submenu routine for the last border-bottom of the menu */
8381: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8382: }
8383:
1.1205 golterma 8384: ol.LC_primary_menu li li p:hover {
8385: color:$button_hover;
8386: text-decoration:none;
8387: background-color:$data_table_dark;
1.1076 raeburn 8388: }
8389:
8390: ol.LC_primary_menu li li a:hover {
8391: color:$button_hover;
8392: background-color:$data_table_dark;
1.693 droeschl 8393: }
8394:
1.1205 golterma 8395: /* Font-size equal to the size of the predecessors*/
8396: ol.LC_primary_menu li:hover li li {
8397: font-size: 100%;
8398: }
8399:
1.897 wenzelju 8400: ol.LC_primary_menu li img {
1.911 bisitz 8401: vertical-align: bottom;
1.934 droeschl 8402: height: 1.1em;
1.1077 raeburn 8403: margin: 0.2em 0 0 0;
1.693 droeschl 8404: }
8405:
1.897 wenzelju 8406: ol.LC_primary_menu a {
1.911 bisitz 8407: color: RGB(80, 80, 80);
8408: text-decoration: none;
1.693 droeschl 8409: }
1.795 www 8410:
1.949 droeschl 8411: ol.LC_primary_menu a.LC_new_message {
8412: font-weight:bold;
8413: color: darkred;
8414: }
8415:
1.975 raeburn 8416: ol.LC_docs_parameters {
8417: margin-left: 0;
8418: padding: 0;
8419: list-style: none;
8420: }
8421:
8422: ol.LC_docs_parameters li {
8423: margin: 0;
8424: padding-right: 20px;
8425: display: inline;
8426: }
8427:
1.976 raeburn 8428: ol.LC_docs_parameters li:before {
8429: content: "\\002022 \\0020";
8430: }
8431:
8432: li.LC_docs_parameters_title {
8433: font-weight: bold;
8434: }
8435:
8436: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8437: content: "";
8438: }
8439:
1.897 wenzelju 8440: ul#LC_secondary_menu {
1.1107 raeburn 8441: clear: right;
1.911 bisitz 8442: color: $fontmenu;
8443: background: $tabbg;
8444: list-style: none;
8445: padding: 0;
8446: margin: 0;
8447: width: 100%;
1.995 raeburn 8448: text-align: left;
1.1107 raeburn 8449: float: left;
1.808 droeschl 8450: }
8451:
1.897 wenzelju 8452: ul#LC_secondary_menu li {
1.911 bisitz 8453: font-weight: bold;
8454: line-height: 1.8em;
1.1107 raeburn 8455: border-right: 1px solid black;
8456: float: left;
8457: }
8458:
8459: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8460: background-color: $data_table_light;
8461: }
8462:
8463: ul#LC_secondary_menu li a {
1.911 bisitz 8464: padding: 0 0.8em;
1.1107 raeburn 8465: }
8466:
8467: ul#LC_secondary_menu li ul {
8468: display: none;
8469: }
8470:
8471: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8472: display: block;
8473: position: absolute;
8474: margin: 0;
8475: padding: 0;
8476: list-style:none;
8477: float: none;
8478: background-color: $data_table_light;
8479: z-index: 2;
8480: margin-left: -1px;
8481: }
8482:
8483: ul#LC_secondary_menu li ul li {
8484: font-size: 90%;
8485: vertical-align: top;
8486: border-left: 1px solid black;
1.911 bisitz 8487: border-right: 1px solid black;
1.1119 raeburn 8488: background-color: $data_table_light;
1.1107 raeburn 8489: list-style:none;
8490: float: none;
8491: }
8492:
8493: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8494: background-color: $data_table_dark;
1.807 droeschl 8495: }
8496:
1.847 tempelho 8497: ul.LC_TabContent {
1.911 bisitz 8498: display:block;
8499: background: $sidebg;
8500: border-bottom: solid 1px $lg_border_color;
8501: list-style:none;
1.1020 raeburn 8502: margin: -1px -10px 0 -10px;
1.911 bisitz 8503: padding: 0;
1.693 droeschl 8504: }
8505:
1.795 www 8506: ul.LC_TabContent li,
8507: ul.LC_TabContentBigger li {
1.911 bisitz 8508: float:left;
1.741 harmsja 8509: }
1.795 www 8510:
1.897 wenzelju 8511: ul#LC_secondary_menu li a {
1.911 bisitz 8512: color: $fontmenu;
8513: text-decoration: none;
1.693 droeschl 8514: }
1.795 www 8515:
1.721 harmsja 8516: ul.LC_TabContent {
1.952 onken 8517: min-height:20px;
1.721 harmsja 8518: }
1.795 www 8519:
8520: ul.LC_TabContent li {
1.911 bisitz 8521: vertical-align:middle;
1.959 onken 8522: padding: 0 16px 0 10px;
1.911 bisitz 8523: background-color:$tabbg;
8524: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8525: border-left: solid 1px $font;
1.721 harmsja 8526: }
1.795 www 8527:
1.847 tempelho 8528: ul.LC_TabContent .right {
1.911 bisitz 8529: float:right;
1.847 tempelho 8530: }
8531:
1.911 bisitz 8532: ul.LC_TabContent li a,
8533: ul.LC_TabContent li {
8534: color:rgb(47,47,47);
8535: text-decoration:none;
8536: font-size:95%;
8537: font-weight:bold;
1.952 onken 8538: min-height:20px;
8539: }
8540:
1.959 onken 8541: ul.LC_TabContent li a:hover,
8542: ul.LC_TabContent li a:focus {
1.952 onken 8543: color: $button_hover;
1.959 onken 8544: background:none;
8545: outline:none;
1.952 onken 8546: }
8547:
8548: ul.LC_TabContent li:hover {
8549: color: $button_hover;
8550: cursor:pointer;
1.721 harmsja 8551: }
1.795 www 8552:
1.911 bisitz 8553: ul.LC_TabContent li.active {
1.952 onken 8554: color: $font;
1.911 bisitz 8555: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8556: border-bottom:solid 1px #FFFFFF;
8557: cursor: default;
1.744 ehlerst 8558: }
1.795 www 8559:
1.959 onken 8560: ul.LC_TabContent li.active a {
8561: color:$font;
8562: background:#FFFFFF;
8563: outline: none;
8564: }
1.1047 raeburn 8565:
8566: ul.LC_TabContent li.goback {
8567: float: left;
8568: border-left: none;
8569: }
8570:
1.870 tempelho 8571: #maincoursedoc {
1.911 bisitz 8572: clear:both;
1.870 tempelho 8573: }
8574:
8575: ul.LC_TabContentBigger {
1.911 bisitz 8576: display:block;
8577: list-style:none;
8578: padding: 0;
1.870 tempelho 8579: }
8580:
1.795 www 8581: ul.LC_TabContentBigger li {
1.911 bisitz 8582: vertical-align:bottom;
8583: height: 30px;
8584: font-size:110%;
8585: font-weight:bold;
8586: color: #737373;
1.841 tempelho 8587: }
8588:
1.957 onken 8589: ul.LC_TabContentBigger li.active {
8590: position: relative;
8591: top: 1px;
8592: }
8593:
1.870 tempelho 8594: ul.LC_TabContentBigger li a {
1.911 bisitz 8595: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8596: height: 30px;
8597: line-height: 30px;
8598: text-align: center;
8599: display: block;
8600: text-decoration: none;
1.958 onken 8601: outline: none;
1.741 harmsja 8602: }
1.795 www 8603:
1.870 tempelho 8604: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8605: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8606: color:$font;
1.744 ehlerst 8607: }
1.795 www 8608:
1.870 tempelho 8609: ul.LC_TabContentBigger li b {
1.911 bisitz 8610: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8611: display: block;
8612: float: left;
8613: padding: 0 30px;
1.957 onken 8614: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8615: }
8616:
1.956 onken 8617: ul.LC_TabContentBigger li:hover b {
8618: color:$button_hover;
8619: }
8620:
1.870 tempelho 8621: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8622: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8623: color:$font;
1.957 onken 8624: border: 0;
1.741 harmsja 8625: }
1.693 droeschl 8626:
1.870 tempelho 8627:
1.862 bisitz 8628: ul.LC_CourseBreadcrumbs {
8629: background: $sidebg;
1.1020 raeburn 8630: height: 2em;
1.862 bisitz 8631: padding-left: 10px;
1.1020 raeburn 8632: margin: 0;
1.862 bisitz 8633: list-style-position: inside;
8634: }
8635:
1.911 bisitz 8636: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8637: ol#LC_PathBreadcrumbs {
1.911 bisitz 8638: padding-left: 10px;
8639: margin: 0;
1.933 droeschl 8640: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8641: }
8642:
1.911 bisitz 8643: ol#LC_MenuBreadcrumbs li,
8644: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8645: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8646: display: inline;
1.933 droeschl 8647: white-space: normal;
1.693 droeschl 8648: }
8649:
1.823 bisitz 8650: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8651: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8652: text-decoration: none;
8653: font-size:90%;
1.693 droeschl 8654: }
1.795 www 8655:
1.969 droeschl 8656: ol#LC_MenuBreadcrumbs h1 {
8657: display: inline;
8658: font-size: 90%;
8659: line-height: 2.5em;
8660: margin: 0;
8661: padding: 0;
8662: }
8663:
1.795 www 8664: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8665: text-decoration:none;
8666: font-size:100%;
8667: font-weight:bold;
1.693 droeschl 8668: }
1.795 www 8669:
1.840 bisitz 8670: .LC_Box {
1.911 bisitz 8671: border: solid 1px $lg_border_color;
8672: padding: 0 10px 10px 10px;
1.746 neumanie 8673: }
1.795 www 8674:
1.1020 raeburn 8675: .LC_DocsBox {
8676: border: solid 1px $lg_border_color;
8677: padding: 0 0 10px 10px;
8678: }
8679:
1.795 www 8680: .LC_AboutMe_Image {
1.911 bisitz 8681: float:left;
8682: margin-right:10px;
1.747 neumanie 8683: }
1.795 www 8684:
8685: .LC_Clear_AboutMe_Image {
1.911 bisitz 8686: clear:left;
1.747 neumanie 8687: }
1.795 www 8688:
1.721 harmsja 8689: dl.LC_ListStyleClean dt {
1.911 bisitz 8690: padding-right: 5px;
8691: display: table-header-group;
1.693 droeschl 8692: }
8693:
1.721 harmsja 8694: dl.LC_ListStyleClean dd {
1.911 bisitz 8695: display: table-row;
1.693 droeschl 8696: }
8697:
1.721 harmsja 8698: .LC_ListStyleClean,
8699: .LC_ListStyleSimple,
8700: .LC_ListStyleNormal,
1.795 www 8701: .LC_ListStyleSpecial {
1.911 bisitz 8702: /* display:block; */
8703: list-style-position: inside;
8704: list-style-type: none;
8705: overflow: hidden;
8706: padding: 0;
1.693 droeschl 8707: }
8708:
1.721 harmsja 8709: .LC_ListStyleSimple li,
8710: .LC_ListStyleSimple dd,
8711: .LC_ListStyleNormal li,
8712: .LC_ListStyleNormal dd,
8713: .LC_ListStyleSpecial li,
1.795 www 8714: .LC_ListStyleSpecial dd {
1.911 bisitz 8715: margin: 0;
8716: padding: 5px 5px 5px 10px;
8717: clear: both;
1.693 droeschl 8718: }
8719:
1.721 harmsja 8720: .LC_ListStyleClean li,
8721: .LC_ListStyleClean dd {
1.911 bisitz 8722: padding-top: 0;
8723: padding-bottom: 0;
1.693 droeschl 8724: }
8725:
1.721 harmsja 8726: .LC_ListStyleSimple dd,
1.795 www 8727: .LC_ListStyleSimple li {
1.911 bisitz 8728: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8729: }
8730:
1.721 harmsja 8731: .LC_ListStyleSpecial li,
8732: .LC_ListStyleSpecial dd {
1.911 bisitz 8733: list-style-type: none;
8734: background-color: RGB(220, 220, 220);
8735: margin-bottom: 4px;
1.693 droeschl 8736: }
8737:
1.721 harmsja 8738: table.LC_SimpleTable {
1.911 bisitz 8739: margin:5px;
8740: border:solid 1px $lg_border_color;
1.795 www 8741: }
1.693 droeschl 8742:
1.721 harmsja 8743: table.LC_SimpleTable tr {
1.911 bisitz 8744: padding: 0;
8745: border:solid 1px $lg_border_color;
1.693 droeschl 8746: }
1.795 www 8747:
8748: table.LC_SimpleTable thead {
1.911 bisitz 8749: background:rgb(220,220,220);
1.693 droeschl 8750: }
8751:
1.721 harmsja 8752: div.LC_columnSection {
1.911 bisitz 8753: display: block;
8754: clear: both;
8755: overflow: hidden;
8756: margin: 0;
1.693 droeschl 8757: }
8758:
1.721 harmsja 8759: div.LC_columnSection>* {
1.911 bisitz 8760: float: left;
8761: margin: 10px 20px 10px 0;
8762: overflow:hidden;
1.693 droeschl 8763: }
1.721 harmsja 8764:
1.795 www 8765: table em {
1.911 bisitz 8766: font-weight: bold;
8767: font-style: normal;
1.748 schulted 8768: }
1.795 www 8769:
1.779 bisitz 8770: table.LC_tableBrowseRes,
1.795 www 8771: table.LC_tableOfContent {
1.911 bisitz 8772: border:none;
8773: border-spacing: 1px;
8774: padding: 3px;
8775: background-color: #FFFFFF;
8776: font-size: 90%;
1.753 droeschl 8777: }
1.789 droeschl 8778:
1.911 bisitz 8779: table.LC_tableOfContent {
8780: border-collapse: collapse;
1.789 droeschl 8781: }
8782:
1.771 droeschl 8783: table.LC_tableBrowseRes a,
1.768 schulted 8784: table.LC_tableOfContent a {
1.911 bisitz 8785: background-color: transparent;
8786: text-decoration: none;
1.753 droeschl 8787: }
8788:
1.795 www 8789: table.LC_tableOfContent img {
1.911 bisitz 8790: border: none;
8791: height: 1.3em;
8792: vertical-align: text-bottom;
8793: margin-right: 0.3em;
1.753 droeschl 8794: }
1.757 schulted 8795:
1.795 www 8796: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8797: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8798: }
8799:
1.795 www 8800: a#LC_content_toolbar_everything {
1.911 bisitz 8801: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8802: }
8803:
1.795 www 8804: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8805: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8806: }
8807:
1.795 www 8808: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8809: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8810: }
8811:
1.795 www 8812: a#LC_content_toolbar_changefolder {
1.911 bisitz 8813: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8814: }
8815:
1.795 www 8816: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8817: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8818: }
8819:
1.1043 raeburn 8820: a#LC_content_toolbar_edittoplevel {
8821: background-image:url(/res/adm/pages/edittoplevel.gif);
8822: }
8823:
1.1384 raeburn 8824: a#LC_content_toolbar_printout {
8825: background-image:url(/res/adm/pages/printout.gif);
8826: }
8827:
1.795 www 8828: ul#LC_toolbar li a:hover {
1.911 bisitz 8829: background-position: bottom center;
1.757 schulted 8830: }
8831:
1.795 www 8832: ul#LC_toolbar {
1.911 bisitz 8833: padding: 0;
8834: margin: 2px;
8835: list-style:none;
8836: position:relative;
8837: background-color:white;
1.1082 raeburn 8838: overflow: auto;
1.757 schulted 8839: }
8840:
1.795 www 8841: ul#LC_toolbar li {
1.911 bisitz 8842: border:1px solid white;
8843: padding: 0;
8844: margin: 0;
8845: float: left;
8846: display:inline;
8847: vertical-align:middle;
1.1082 raeburn 8848: white-space: nowrap;
1.911 bisitz 8849: }
1.757 schulted 8850:
1.783 amueller 8851:
1.795 www 8852: a.LC_toolbarItem {
1.911 bisitz 8853: display:block;
8854: padding: 0;
8855: margin: 0;
8856: height: 32px;
8857: width: 32px;
8858: color:white;
8859: border: none;
8860: background-repeat:no-repeat;
8861: background-color:transparent;
1.757 schulted 8862: }
8863:
1.915 droeschl 8864: ul.LC_funclist {
8865: margin: 0;
8866: padding: 0.5em 1em 0.5em 0;
8867: }
8868:
1.933 droeschl 8869: ul.LC_funclist > li:first-child {
8870: font-weight:bold;
8871: margin-left:0.8em;
8872: }
8873:
1.915 droeschl 8874: ul.LC_funclist + ul.LC_funclist {
8875: /*
8876: left border as a seperator if we have more than
8877: one list
8878: */
8879: border-left: 1px solid $sidebg;
8880: /*
8881: this hides the left border behind the border of the
8882: outer box if element is wrapped to the next 'line'
8883: */
8884: margin-left: -1px;
8885: }
8886:
1.843 bisitz 8887: ul.LC_funclist li {
1.915 droeschl 8888: display: inline;
1.782 bisitz 8889: white-space: nowrap;
1.915 droeschl 8890: margin: 0 0 0 25px;
8891: line-height: 150%;
1.782 bisitz 8892: }
8893:
1.974 wenzelju 8894: .LC_hidden {
8895: display: none;
8896: }
8897:
1.1030 www 8898: .LCmodal-overlay {
8899: position:fixed;
8900: top:0;
8901: right:0;
8902: bottom:0;
8903: left:0;
8904: height:100%;
8905: width:100%;
8906: margin:0;
8907: padding:0;
8908: background:#999;
8909: opacity:.75;
8910: filter: alpha(opacity=75);
8911: -moz-opacity: 0.75;
8912: z-index:101;
8913: }
8914:
8915: * html .LCmodal-overlay {
8916: position: absolute;
8917: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8918: }
8919:
8920: .LCmodal-window {
8921: position:fixed;
8922: top:50%;
8923: left:50%;
8924: margin:0;
8925: padding:0;
8926: z-index:102;
8927: }
8928:
8929: * html .LCmodal-window {
8930: position:absolute;
8931: }
8932:
8933: .LCclose-window {
8934: position:absolute;
8935: width:32px;
8936: height:32px;
8937: right:8px;
8938: top:8px;
8939: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8940: text-indent:-99999px;
8941: overflow:hidden;
8942: cursor:pointer;
8943: }
8944:
1.1369 raeburn 8945: .LCisDisabled {
8946: cursor: not-allowed;
8947: opacity: 0.5;
8948: }
8949:
8950: a[aria-disabled="true"] {
8951: color: currentColor;
8952: display: inline-block; /* For IE11/ MS Edge bug */
8953: pointer-events: none;
8954: text-decoration: none;
8955: }
8956:
1.1335 raeburn 8957: pre.LC_wordwrap {
8958: white-space: pre-wrap;
8959: white-space: -moz-pre-wrap;
8960: white-space: -pre-wrap;
8961: white-space: -o-pre-wrap;
8962: word-wrap: break-word;
8963: }
8964:
1.1100 raeburn 8965: /*
1.1231 damieng 8966: styles used for response display
8967: */
8968: div.LC_radiofoil, div.LC_rankfoil {
8969: margin: .5em 0em .5em 0em;
8970: }
8971: table.LC_itemgroup {
8972: margin-top: 1em;
8973: }
8974:
8975: /*
1.1100 raeburn 8976: styles used by TTH when "Default set of options to pass to tth/m
8977: when converting TeX" in course settings has been set
8978:
8979: option passed: -t
8980:
8981: */
8982:
8983: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8984: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8985: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8986: td div.norm {line-height:normal;}
8987:
8988: /*
8989: option passed -y3
8990: */
8991:
8992: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8993: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8994: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8995:
1.1230 damieng 8996: /*
8997: sections with roles, for content only
8998: */
8999: section[class^="role-"] {
9000: padding-left: 10px;
9001: padding-right: 5px;
9002: margin-top: 8px;
9003: margin-bottom: 8px;
9004: border: 1px solid #2A4;
9005: border-radius: 5px;
9006: box-shadow: 0px 1px 1px #BBB;
9007: }
9008: section[class^="role-"]>h1 {
9009: position: relative;
9010: margin: 0px;
9011: padding-top: 10px;
9012: padding-left: 40px;
9013: }
9014: section[class^="role-"]>h1:before {
9015: position: absolute;
9016: left: -5px;
9017: top: 5px;
9018: }
9019: section.role-activity>h1:before {
9020: content:url('/adm/daxe/images/section_icons/activity.png');
9021: }
9022: section.role-advice>h1:before {
9023: content:url('/adm/daxe/images/section_icons/advice.png');
9024: }
9025: section.role-bibliography>h1:before {
9026: content:url('/adm/daxe/images/section_icons/bibliography.png');
9027: }
9028: section.role-citation>h1:before {
9029: content:url('/adm/daxe/images/section_icons/citation.png');
9030: }
9031: section.role-conclusion>h1:before {
9032: content:url('/adm/daxe/images/section_icons/conclusion.png');
9033: }
9034: section.role-definition>h1:before {
9035: content:url('/adm/daxe/images/section_icons/definition.png');
9036: }
9037: section.role-demonstration>h1:before {
9038: content:url('/adm/daxe/images/section_icons/demonstration.png');
9039: }
9040: section.role-example>h1:before {
9041: content:url('/adm/daxe/images/section_icons/example.png');
9042: }
9043: section.role-explanation>h1:before {
9044: content:url('/adm/daxe/images/section_icons/explanation.png');
9045: }
9046: section.role-introduction>h1:before {
9047: content:url('/adm/daxe/images/section_icons/introduction.png');
9048: }
9049: section.role-method>h1:before {
9050: content:url('/adm/daxe/images/section_icons/method.png');
9051: }
9052: section.role-more_information>h1:before {
9053: content:url('/adm/daxe/images/section_icons/more_information.png');
9054: }
9055: section.role-objectives>h1:before {
9056: content:url('/adm/daxe/images/section_icons/objectives.png');
9057: }
9058: section.role-prerequisites>h1:before {
9059: content:url('/adm/daxe/images/section_icons/prerequisites.png');
9060: }
9061: section.role-remark>h1:before {
9062: content:url('/adm/daxe/images/section_icons/remark.png');
9063: }
9064: section.role-reminder>h1:before {
9065: content:url('/adm/daxe/images/section_icons/reminder.png');
9066: }
9067: section.role-summary>h1:before {
9068: content:url('/adm/daxe/images/section_icons/summary.png');
9069: }
9070: section.role-syntax>h1:before {
9071: content:url('/adm/daxe/images/section_icons/syntax.png');
9072: }
9073: section.role-warning>h1:before {
9074: content:url('/adm/daxe/images/section_icons/warning.png');
9075: }
9076:
1.1269 raeburn 9077: #LC_minitab_header {
9078: float:left;
9079: width:100%;
9080: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
9081: font-size:93%;
9082: line-height:normal;
9083: margin: 0.5em 0 0.5em 0;
9084: }
9085: #LC_minitab_header ul {
9086: margin:0;
9087: padding:10px 10px 0;
9088: list-style:none;
9089: }
9090: #LC_minitab_header li {
9091: float:left;
9092: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
9093: margin:0;
9094: padding:0 0 0 9px;
9095: }
9096: #LC_minitab_header a {
9097: display:block;
9098: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
9099: padding:5px 15px 4px 6px;
9100: }
9101: #LC_minitab_header #LC_current_minitab {
9102: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
9103: }
9104: #LC_minitab_header #LC_current_minitab a {
9105: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
9106: padding-bottom:5px;
9107: }
9108:
9109:
1.343 albertel 9110: END
9111: }
9112:
1.306 albertel 9113: =pod
9114:
9115: =item * &headtag()
9116:
9117: Returns a uniform footer for LON-CAPA web pages.
9118:
1.307 albertel 9119: Inputs: $title - optional title for the head
9120: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 9121: $args - optional arguments
1.319 albertel 9122: force_register - if is true call registerurl so the remote is
9123: informed
1.415 albertel 9124: redirect -> array ref of
9125: 1- seconds before redirect occurs
9126: 2- url to redirect to
9127: 3- whether the side effect should occur
1.315 albertel 9128: (side effect of setting
9129: $env{'internal.head.redirect'} to the url
1.1386 raeburn 9130: redirected to)
9131: 4- whether the redirect target should be
9132: the opener of the current (pop-up)
9133: window (side effect of setting
9134: $env{'internal.head.to_opener'} to
9135: 1, if true.
1.1388 raeburn 9136: 5- whether encrypt check should be skipped
1.352 albertel 9137: domain -> force to color decorate a page for a specific
9138: domain
9139: function -> force usage of a specific rolish color scheme
9140: bgcolor -> override the default page bgcolor
1.460 albertel 9141: no_auto_mt_title
9142: -> prevent &mt()ing the title arg
1.464 albertel 9143:
1.306 albertel 9144: =cut
9145:
9146: sub headtag {
1.313 albertel 9147: my ($title,$head_extra,$args) = @_;
1.306 albertel 9148:
1.363 albertel 9149: my $function = $args->{'function'} || &get_users_function();
9150: my $domain = $args->{'domain'} || &determinedomain();
9151: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 9152: my $httphost = $args->{'use_absolute'};
1.418 albertel 9153: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 9154: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 9155: #time(),
1.418 albertel 9156: $env{'environment.color.timestamp'},
1.363 albertel 9157: $function,$domain,$bgcolor);
9158:
1.369 www 9159: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 9160:
1.308 albertel 9161: my $result =
9162: '<head>'.
1.1160 raeburn 9163: &font_settings($args);
1.319 albertel 9164:
1.1188 raeburn 9165: my $inhibitprint;
9166: if ($args->{'print_suppress'}) {
9167: $inhibitprint = &print_suppression();
9168: }
1.1064 raeburn 9169:
1.461 albertel 9170: if (!$args->{'frameset'}) {
9171: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
9172: }
1.962 droeschl 9173: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
9174: $result .= Apache::lonxml::display_title();
1.319 albertel 9175: }
1.436 albertel 9176: if (!$args->{'no_nav_bar'}
9177: && !$args->{'only_body'}
9178: && !$args->{'frameset'}) {
1.1154 raeburn 9179: $result .= &help_menu_js($httphost);
1.1032 www 9180: $result.=&modal_window();
1.1038 www 9181: $result.=&togglebox_script();
1.1034 www 9182: $result.=&wishlist_window();
1.1041 www 9183: $result.=&LCprogressbarUpdate_script();
1.1034 www 9184: } else {
9185: if ($args->{'add_modal'}) {
9186: $result.=&modal_window();
9187: }
9188: if ($args->{'add_wishlist'}) {
9189: $result.=&wishlist_window();
9190: }
1.1038 www 9191: if ($args->{'add_togglebox'}) {
9192: $result.=&togglebox_script();
9193: }
1.1041 www 9194: if ($args->{'add_progressbar'}) {
9195: $result.=&LCprogressbarUpdate_script();
9196: }
1.436 albertel 9197: }
1.314 albertel 9198: if (ref($args->{'redirect'})) {
1.1388 raeburn 9199: my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
9200: if (!$skip_enc_check) {
9201: $url = &Apache::lonenc::check_encrypt($url);
9202: }
1.414 albertel 9203: if (!$inhibit_continue) {
9204: $env{'internal.head.redirect'} = $url;
9205: }
1.1386 raeburn 9206: $result.=<<"ADDMETA";
1.313 albertel 9207: <meta http-equiv="pragma" content="no-cache" />
1.1386 raeburn 9208: ADDMETA
9209: if ($to_opener) {
9210: $env{'internal.head.to_opener'} = 1;
9211: my $dest = &js_escape($url);
9212: my $timeout = int($time * 1000);
9213: $result .=<<"ENDJS";
9214: <script type="text/javascript">
9215: // <![CDATA[
9216: function LC_To_Opener() {
9217: var dest = '$dest';
9218: if (dest != '') {
9219: if (window.opener != null && !window.opener.closed) {
9220: window.opener.location.href=dest;
9221: window.close();
9222: } else {
9223: window.location.href=dest;
9224: }
9225: }
9226: }
9227: \$(document).ready(function () {
9228: setTimeout('LC_To_Opener()',$timeout);
9229: });
9230: // ]]>
9231: </script>
9232: ENDJS
9233: } else {
9234: $result.=<<"ADDMETA";
1.344 albertel 9235: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 9236: ADDMETA
1.1386 raeburn 9237: }
1.1210 raeburn 9238: } else {
9239: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
9240: my $requrl = $env{'request.uri'};
9241: if ($requrl eq '') {
9242: $requrl = $ENV{'REQUEST_URI'};
9243: $requrl =~ s/\?.+$//;
9244: }
9245: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
9246: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
9247: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
9248: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
9249: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
9250: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 9251: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 9252: my ($offload,$offloadoth);
1.1210 raeburn 9253: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
9254: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 9255: $offload = 1;
1.1353 raeburn 9256: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9257: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9258: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9259: $offloadoth = 1;
9260: $dom_in_use = $env{'user.domain'};
9261: }
9262: }
1.1340 raeburn 9263: }
9264: }
9265: unless ($offload) {
9266: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
9267: if ($domdefs{'offloadoth'}{$lonhost}) {
9268: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9269: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9270: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9271: $offload = 1;
1.1352 raeburn 9272: $offloadoth = 1;
1.1340 raeburn 9273: $dom_in_use = $env{'user.domain'};
9274: }
1.1210 raeburn 9275: }
1.1340 raeburn 9276: }
9277: }
9278: }
9279: if ($offload) {
1.1358 raeburn 9280: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 9281: if (($newserver eq '') && ($offloadoth)) {
9282: my @domains = &Apache::lonnet::current_machine_domains();
9283: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
9284: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
9285: }
9286: }
1.1340 raeburn 9287: if (($newserver) && ($newserver ne $lonhost)) {
9288: my $numsec = 5;
9289: my $timeout = $numsec * 1000;
9290: my ($newurl,$locknum,%locks,$msg);
9291: if ($env{'request.role.adv'}) {
9292: ($locknum,%locks) = &Apache::lonnet::get_locks();
9293: }
9294: my $disable_submit = 0;
9295: if ($requrl =~ /$LONCAPA::assess_re/) {
9296: $disable_submit = 1;
9297: }
9298: if ($locknum) {
9299: my @lockinfo = sort(values(%locks));
1.1354 raeburn 9300: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 9301: join(", ",sort(values(%locks)))."\n";
9302: if (&show_course()) {
9303: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
9304: } else {
9305: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 9306: }
1.1340 raeburn 9307: } else {
9308: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
9309: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
9310: }
9311: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
9312: $newurl = '/adm/switchserver?otherserver='.$newserver;
9313: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
9314: $newurl .= '&role='.$env{'request.role'};
9315: }
9316: if ($env{'request.symb'}) {
9317: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
9318: if ($shownsymb =~ m{^/enc/}) {
9319: my $reqdmajor = 2;
9320: my $reqdminor = 11;
9321: my $reqdsubminor = 3;
9322: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
9323: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
9324: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
9325: if (($major eq '' && $minor eq '') ||
9326: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
9327: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
9328: ($reqdsubminor > $subminor))))) {
9329: undef($shownsymb);
9330: }
1.1210 raeburn 9331: }
1.1340 raeburn 9332: if ($shownsymb) {
9333: &js_escape(\$shownsymb);
9334: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 9335: }
1.1340 raeburn 9336: } else {
9337: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
9338: &js_escape(\$shownurl);
9339: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 9340: }
1.1340 raeburn 9341: }
9342: &js_escape(\$msg);
9343: $result.=<<OFFLOAD
1.1210 raeburn 9344: <meta http-equiv="pragma" content="no-cache" />
9345: <script type="text/javascript">
1.1215 raeburn 9346: // <![CDATA[
1.1210 raeburn 9347: function LC_Offload_Now() {
9348: var dest = "$newurl";
9349: if (dest != '') {
9350: window.location.href="$newurl";
9351: }
9352: }
1.1214 raeburn 9353: \$(document).ready(function () {
9354: window.alert('$msg');
9355: if ($disable_submit) {
1.1210 raeburn 9356: \$(".LC_hwk_submit").prop("disabled", true);
9357: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9358: }
9359: setTimeout('LC_Offload_Now()', $timeout);
9360: });
1.1215 raeburn 9361: // ]]>
1.1210 raeburn 9362: </script>
9363: OFFLOAD
9364: }
9365: }
9366: }
9367: }
9368: }
1.313 albertel 9369: }
1.306 albertel 9370: if (!defined($title)) {
9371: $title = 'The LearningOnline Network with CAPA';
9372: }
1.460 albertel 9373: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
9374: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 9375: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
9376: if (!$args->{'frameset'}) {
9377: $result .= ' /';
9378: }
9379: $result .= '>'
1.1064 raeburn 9380: .$inhibitprint
1.414 albertel 9381: .$head_extra;
1.1242 raeburn 9382: my $clientmobile;
9383: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9384: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9385: } else {
9386: $clientmobile = $env{'browser.mobile'};
9387: }
9388: if ($clientmobile) {
1.1137 raeburn 9389: $result .= '
9390: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9391: <meta name="apple-mobile-web-app-capable" content="yes" />';
9392: }
1.1278 raeburn 9393: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9394: return $result.'</head>';
1.306 albertel 9395: }
9396:
9397: =pod
9398:
1.340 albertel 9399: =item * &font_settings()
9400:
9401: Returns neccessary <meta> to set the proper encoding
9402:
1.1160 raeburn 9403: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9404:
9405: =cut
9406:
9407: sub font_settings {
1.1160 raeburn 9408: my ($args) = @_;
1.340 albertel 9409: my $headerstring='';
1.1160 raeburn 9410: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9411: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9412: $headerstring.=
9413: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9414: if (!$args->{'frameset'}) {
9415: $headerstring.= ' /';
9416: }
9417: $headerstring .= '>'."\n";
1.340 albertel 9418: }
9419: return $headerstring;
9420: }
9421:
1.341 albertel 9422: =pod
9423:
1.1064 raeburn 9424: =item * &print_suppression()
9425:
9426: In course context returns css which causes the body to be blank when media="print",
9427: if printout generation is unavailable for the current resource.
9428:
9429: This could be because:
9430:
9431: (a) printstartdate is in the future
9432:
9433: (b) printenddate is in the past
9434:
9435: (c) there is an active exam block with "printout"
9436: functionality blocked
9437:
9438: Users with pav, pfo or evb privileges are exempt.
9439:
9440: Inputs: none
9441:
9442: =cut
9443:
9444:
9445: sub print_suppression {
9446: my $noprint;
9447: if ($env{'request.course.id'}) {
9448: my $scope = $env{'request.course.id'};
9449: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9450: (&Apache::lonnet::allowed('pfo',$scope))) {
9451: return;
9452: }
9453: if ($env{'request.course.sec'} ne '') {
9454: $scope .= "/$env{'request.course.sec'}";
9455: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9456: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9457: return;
1.1064 raeburn 9458: }
9459: }
9460: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9461: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9462: my $clientip = &Apache::lonnet::get_requestor_ip();
9463: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9464: if ($blocked) {
9465: my $checkrole = "cm./$cdom/$cnum";
9466: if ($env{'request.course.sec'} ne '') {
9467: $checkrole .= "/$env{'request.course.sec'}";
9468: }
9469: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9470: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9471: $noprint = 1;
9472: }
9473: }
9474: unless ($noprint) {
9475: my $symb = &Apache::lonnet::symbread();
9476: if ($symb ne '') {
9477: my $navmap = Apache::lonnavmaps::navmap->new();
9478: if (ref($navmap)) {
9479: my $res = $navmap->getBySymb($symb);
9480: if (ref($res)) {
9481: if (!$res->resprintable()) {
9482: $noprint = 1;
9483: }
9484: }
9485: }
9486: }
9487: }
9488: if ($noprint) {
9489: return <<"ENDSTYLE";
9490: <style type="text/css" media="print">
9491: body { display:none }
9492: </style>
9493: ENDSTYLE
9494: }
9495: }
9496: return;
9497: }
9498:
9499: =pod
9500:
1.341 albertel 9501: =item * &xml_begin()
9502:
9503: Returns the needed doctype and <html>
9504:
9505: Inputs: none
9506:
9507: =cut
9508:
9509: sub xml_begin {
1.1168 raeburn 9510: my ($is_frameset) = @_;
1.341 albertel 9511: my $output='';
9512:
9513: if ($env{'browser.mathml'}) {
9514: $output='<?xml version="1.0"?>'
9515: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9516: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9517:
9518: # .'<!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">] >'
9519: .'<!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">'
9520: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9521: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9522: } elsif ($is_frameset) {
9523: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9524: '<html>'."\n";
1.341 albertel 9525: } else {
1.1168 raeburn 9526: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9527: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9528: }
9529: return $output;
9530: }
1.340 albertel 9531:
9532: =pod
9533:
1.306 albertel 9534: =item * &start_page()
9535:
9536: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9537:
1.648 raeburn 9538: Inputs:
9539:
9540: =over 4
9541:
9542: $title - optional title for the page
9543:
9544: $head_extra - optional extra HTML to incude inside the <head>
9545:
9546: $args - additional optional args supported are:
9547:
9548: =over 8
9549:
9550: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9551: arg on
1.814 bisitz 9552: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9553: add_entries -> additional attributes to add to the <body>
9554: domain -> force to color decorate a page for a
1.317 albertel 9555: specific domain
1.648 raeburn 9556: function -> force usage of a specific rolish color
1.317 albertel 9557: scheme
1.648 raeburn 9558: redirect -> see &headtag()
9559: bgcolor -> override the default page bg color
9560: js_ready -> return a string ready for being used in
1.317 albertel 9561: a javascript writeln
1.648 raeburn 9562: html_encode -> return a string ready for being used in
1.320 albertel 9563: a html attribute
1.648 raeburn 9564: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9565: $forcereg arg
1.648 raeburn 9566: frameset -> if true will start with a <frameset>
1.330 albertel 9567: rather than <body>
1.648 raeburn 9568: skip_phases -> hash ref of
1.338 albertel 9569: head -> skip the <html><head> generation
9570: body -> skip all <body> generation
1.648 raeburn 9571: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9572: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9573: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 9574: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9575: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9576: group -> includes the current group, if page is for a
1.1274 raeburn 9577: specific group
9578: use_absolute -> for request for external resource or syllabus, this
9579: will contain https://<hostname> if server uses
9580: https (as per hosts.tab), but request is for http
9581: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9582: links_disabled -> Links in primary and secondary menus are disabled
9583: (Can enable them once page has loaded - see lonroles.pm
9584: for an example).
1.1380 raeburn 9585: links_target -> Target for links, e.g., _parent (optional).
1.361 albertel 9586:
1.648 raeburn 9587: =back
1.460 albertel 9588:
1.648 raeburn 9589: =back
1.562 albertel 9590:
1.306 albertel 9591: =cut
9592:
9593: sub start_page {
1.309 albertel 9594: my ($title,$head_extra,$args) = @_;
1.318 albertel 9595: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9596:
1.315 albertel 9597: $env{'internal.start_page'}++;
1.1359 raeburn 9598: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9599:
1.338 albertel 9600: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9601: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9602: }
1.1316 raeburn 9603:
9604: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9605: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9606: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9607: $args->{'no_primary_menu'} = 1;
9608: }
9609: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9610: $args->{'no_inline_menu'} = 1;
9611: }
9612: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9613: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9614: }
9615: } else {
9616: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9617: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9618: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9619: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9620: $args->{'no_primary_menu'} = 1;
9621: }
9622: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9623: $args->{'no_inline_menu'} = 1;
9624: }
9625: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9626: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9627: }
9628: }
9629: }
1.1316 raeburn 9630: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9631: $env{'course.'.$env{'request.course.id'}.'.domain'},
9632: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9633: } elsif ($env{'request.course.id'}) {
9634: my $expiretime=600;
9635: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9636: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9637: }
9638: my ($deeplinkmenu,$menuref);
9639: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9640: if ($menucoll) {
9641: if (ref($menuref) eq 'HASH') {
9642: %menu = %{$menuref};
9643: }
9644: if ($menu{'top'} eq 'n') {
9645: $args->{'no_primary_menu'} = 1;
9646: }
9647: if ($menu{'inline'} eq 'n') {
9648: unless (&Apache::lonnet::allowed('opa')) {
9649: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9650: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9651: my $crstype = &course_type();
9652: my $now = time;
9653: my $ccrole;
9654: if ($crstype eq 'Community') {
9655: $ccrole = 'co';
9656: } else {
9657: $ccrole = 'cc';
9658: }
9659: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9660: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9661: if ((($start) && ($start<0)) ||
9662: (($end) && ($end<$now)) ||
9663: (($start) && ($now<$start))) {
9664: $args->{'no_inline_menu'} = 1;
9665: }
9666: } else {
9667: $args->{'no_inline_menu'} = 1;
9668: }
9669: }
9670: }
9671: }
1.1316 raeburn 9672: }
1.1359 raeburn 9673:
1.1385 raeburn 9674: my $showncrumbs;
1.338 albertel 9675: if (! exists($args->{'skip_phases'}{'body'}) ) {
9676: if ($args->{'frameset'}) {
9677: my $attr_string = &make_attr_string($args->{'force_register'},
9678: $args->{'add_entries'});
9679: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9680: } else {
9681: $result .=
9682: &bodytag($title,
9683: $args->{'function'}, $args->{'add_entries'},
9684: $args->{'only_body'}, $args->{'domain'},
9685: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 9686: $args->{'bgcolor'}, $args,
1.1385 raeburn 9687: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
9688: \%menu,\$showncrumbs);
1.831 bisitz 9689: }
1.330 albertel 9690: }
1.338 albertel 9691:
1.315 albertel 9692: if ($args->{'js_ready'}) {
1.713 kaisler 9693: $result = &js_ready($result);
1.315 albertel 9694: }
1.320 albertel 9695: if ($args->{'html_encode'}) {
1.713 kaisler 9696: $result = &html_encode($result);
9697: }
9698:
1.813 bisitz 9699: # Preparation for new and consistent functionlist at top of screen
9700: # if ($args->{'functionlist'}) {
9701: # $result .= &build_functionlist();
9702: #}
9703:
1.964 droeschl 9704: # Don't add anything more if only_body wanted or in const space
9705: return $result if $args->{'only_body'}
9706: || $env{'request.state'} eq 'construct';
1.813 bisitz 9707:
9708: #Breadcrumbs
1.758 kaisler 9709: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385 raeburn 9710: unless ($showncrumbs) {
1.758 kaisler 9711: &Apache::lonhtmlcommon::clear_breadcrumbs();
9712: #if any br links exists, add them to the breadcrumbs
9713: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9714: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9715: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9716: }
9717: }
1.1096 raeburn 9718: # if @advtools array contains items add then to the breadcrumbs
9719: if (@advtools > 0) {
9720: &Apache::lonmenu::advtools_crumbs(@advtools);
9721: }
1.1272 raeburn 9722: my $menulink;
9723: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
9724: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 9725: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 9726: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
9727: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
9728: (!$env{'request.role.adv'}))) {
9729: $menulink = 0;
9730: } else {
9731: undef($menulink);
9732: }
1.1385 raeburn 9733: my $linkprotout;
9734: if ($env{'request.deeplink.login'}) {
9735: my $linkprotout = &Apache::lonmenu::linkprot_exit();
9736: if ($linkprotout) {
9737: &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
9738: }
9739: }
1.758 kaisler 9740: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9741: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 9742: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 9743: } else {
1.1272 raeburn 9744: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 9745: }
1.1385 raeburn 9746: }
1.320 albertel 9747: }
1.315 albertel 9748: return $result;
1.306 albertel 9749: }
9750:
9751: sub end_page {
1.315 albertel 9752: my ($args) = @_;
9753: $env{'internal.end_page'}++;
1.330 albertel 9754: my $result;
1.335 albertel 9755: if ($args->{'discussion'}) {
9756: my ($target,$parser);
9757: if (ref($args->{'discussion'})) {
9758: ($target,$parser) =($args->{'discussion'}{'target'},
9759: $args->{'discussion'}{'parser'});
9760: }
9761: $result .= &Apache::lonxml::xmlend($target,$parser);
9762: }
1.330 albertel 9763: if ($args->{'frameset'}) {
9764: $result .= '</frameset>';
9765: } else {
1.635 raeburn 9766: $result .= &endbodytag($args);
1.330 albertel 9767: }
1.1080 raeburn 9768: unless ($args->{'notbody'}) {
9769: $result .= "\n</html>";
9770: }
1.330 albertel 9771:
1.315 albertel 9772: if ($args->{'js_ready'}) {
1.317 albertel 9773: $result = &js_ready($result);
1.315 albertel 9774: }
1.335 albertel 9775:
1.320 albertel 9776: if ($args->{'html_encode'}) {
9777: $result = &html_encode($result);
9778: }
1.335 albertel 9779:
1.315 albertel 9780: return $result;
9781: }
9782:
1.1359 raeburn 9783: sub menucoll_in_effect {
9784: my ($menucoll,$deeplinkmenu,%menu);
9785: if ($env{'request.course.id'}) {
9786: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 9787: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 9788: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 9789: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9790: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9791: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9792: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9793: my $navmap = Apache::lonnavmaps::navmap->new();
9794: if (ref($navmap)) {
9795: $deeplink = $navmap->get_mapparam(undef,
9796: &Apache::lonnet::declutter($env{'request.noversionuri'}),
9797: '0.deeplink');
1.1370 raeburn 9798: } else {
9799: $check_login_symb = 1;
1.1362 raeburn 9800: }
9801: } else {
1.1370 raeburn 9802: my $symb = &Apache::lonnet::symbread();
9803: if ($symb) {
9804: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9805: } else {
9806: $check_login_symb = 1;
9807: }
1.1362 raeburn 9808: }
9809: } else {
1.1370 raeburn 9810: $check_login_symb = 1;
9811: }
9812: if ($check_login_symb) {
1.1362 raeburn 9813: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9814: if ($deeplink_symb =~ /\.(page|sequence)$/) {
9815: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9816: my $navmap = Apache::lonnavmaps::navmap->new();
9817: if (ref($navmap)) {
9818: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9819: }
9820: } else {
9821: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9822: }
9823: }
1.1359 raeburn 9824: if ($deeplink ne '') {
1.1378 raeburn 9825: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 9826: if ($display =~ /^\d+$/) {
9827: $deeplinkmenu = 1;
9828: $menucoll = $display;
9829: }
9830: }
9831: }
9832: if ($menucoll) {
9833: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9834: }
9835: }
9836: return ($menucoll,$deeplinkmenu,\%menu);
9837: }
9838:
1.1362 raeburn 9839: sub deeplink_login_symb {
9840: my ($cnum,$cdom) = @_;
9841: my $login_symb;
9842: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 9843: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9844: }
9845: return $login_symb;
9846: }
9847:
9848: sub symb_from_tinyurl {
9849: my ($url,$cnum,$cdom) = @_;
9850: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9851: my $key = $1;
9852: my ($tinyurl,$login);
9853: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9854: if (defined($cached)) {
9855: $tinyurl = $result;
9856: } else {
9857: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9858: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9859: if ($currtiny{$key} ne '') {
9860: $tinyurl = $currtiny{$key};
9861: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 9862: }
1.1364 raeburn 9863: }
9864: if ($tinyurl ne '') {
9865: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9866: if (wantarray) {
9867: return ($cnumreq,$symb);
9868: } elsif ($cnumreq eq $cnum) {
9869: return $symb;
1.1362 raeburn 9870: }
9871: }
9872: }
1.1364 raeburn 9873: if (wantarray) {
9874: return ();
9875: } else {
9876: return;
9877: }
1.1362 raeburn 9878: }
9879:
1.1405 raeburn 9880: sub usable_exttools {
9881: my %tooltypes;
9882: if ($env{'request.course.id'}) {
9883: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
9884: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
9885: %tooltypes = (
9886: crs => 1,
9887: dom => 1,
9888: );
9889: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
9890: $tooltypes{'crs'} = 1;
9891: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
9892: $tooltypes{'dom'} = 1;
9893: }
9894: } else {
9895: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9896: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9897: my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
9898: if ($crstype eq '') {
9899: $crstype = 'course';
9900: }
9901: if ($crstype eq 'course') {
9902: if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
9903: $crstype = 'official';
9904: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
9905: $crstype = 'textbook';
9906: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
9907: $crstype = 'lti';
9908: } else {
9909: $crstype = 'unofficial';
9910: }
9911: }
9912: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
9913: if ($domdefaults{$crstype.'domexttool'}) {
9914: $tooltypes{'dom'} = 1;
9915: }
9916: if ($domdefaults{$crstype.'exttool'}) {
9917: $tooltypes{'crs'} = 1;
9918: }
9919: }
9920: }
9921: return %tooltypes;
9922: }
9923:
1.1034 www 9924: sub wishlist_window {
9925: return(<<'ENDWISHLIST');
1.1046 raeburn 9926: <script type="text/javascript">
1.1034 www 9927: // <![CDATA[
9928: // <!-- BEGIN LON-CAPA Internal
9929: function set_wishlistlink(title, path) {
9930: if (!title) {
9931: title = document.title;
9932: title = title.replace(/^LON-CAPA /,'');
9933: }
1.1175 raeburn 9934: title = encodeURIComponent(title);
1.1203 raeburn 9935: title = title.replace("'","\\\'");
1.1034 www 9936: if (!path) {
9937: path = location.pathname;
9938: }
1.1175 raeburn 9939: path = encodeURIComponent(path);
1.1203 raeburn 9940: path = path.replace("'","\\\'");
1.1034 www 9941: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9942: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9943: }
9944: // END LON-CAPA Internal -->
9945: // ]]>
9946: </script>
9947: ENDWISHLIST
9948: }
9949:
1.1030 www 9950: sub modal_window {
9951: return(<<'ENDMODAL');
1.1046 raeburn 9952: <script type="text/javascript">
1.1030 www 9953: // <![CDATA[
9954: // <!-- BEGIN LON-CAPA Internal
9955: var modalWindow = {
9956: parent:"body",
9957: windowId:null,
9958: content:null,
9959: width:null,
9960: height:null,
9961: close:function()
9962: {
9963: $(".LCmodal-window").remove();
9964: $(".LCmodal-overlay").remove();
9965: },
9966: open:function()
9967: {
9968: var modal = "";
9969: modal += "<div class=\"LCmodal-overlay\"></div>";
9970: 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;\">";
9971: modal += this.content;
9972: modal += "</div>";
9973:
9974: $(this.parent).append(modal);
9975:
9976: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9977: $(".LCclose-window").click(function(){modalWindow.close();});
9978: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9979: }
9980: };
1.1140 raeburn 9981: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9982: {
1.1266 raeburn 9983: source = source.replace(/'/g,"'");
1.1030 www 9984: modalWindow.windowId = "myModal";
9985: modalWindow.width = width;
9986: modalWindow.height = height;
1.1196 raeburn 9987: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9988: modalWindow.open();
1.1208 raeburn 9989: };
1.1030 www 9990: // END LON-CAPA Internal -->
9991: // ]]>
9992: </script>
9993: ENDMODAL
9994: }
9995:
9996: sub modal_link {
1.1140 raeburn 9997: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9998: unless ($width) { $width=480; }
9999: unless ($height) { $height=400; }
1.1031 www 10000: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 10001: unless ($transparency) { $transparency='true'; }
10002:
1.1074 raeburn 10003: my $target_attr;
10004: if (defined($target)) {
10005: $target_attr = 'target="'.$target.'"';
10006: }
10007: return <<"ENDLINK";
1.1336 raeburn 10008: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 10009: ENDLINK
1.1030 www 10010: }
10011:
1.1032 www 10012: sub modal_adhoc_script {
1.1365 raeburn 10013: my ($funcname,$width,$height,$content,$possmathjax)=@_;
10014: my $mathjax;
10015: if ($possmathjax) {
10016: $mathjax = <<'ENDJAX';
10017: if (typeof MathJax == 'object') {
10018: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
10019: }
10020: ENDJAX
10021: }
1.1032 www 10022: return (<<ENDADHOC);
1.1046 raeburn 10023: <script type="text/javascript">
1.1032 www 10024: // <![CDATA[
10025: var $funcname = function()
10026: {
10027: modalWindow.windowId = "myModal";
10028: modalWindow.width = $width;
10029: modalWindow.height = $height;
10030: modalWindow.content = '$content';
10031: modalWindow.open();
1.1365 raeburn 10032: $mathjax
1.1032 www 10033: };
10034: // ]]>
10035: </script>
10036: ENDADHOC
10037: }
10038:
1.1041 www 10039: sub modal_adhoc_inner {
1.1365 raeburn 10040: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 10041: my $innerwidth=$width-20;
10042: $content=&js_ready(
1.1140 raeburn 10043: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
10044: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
10045: $content.
1.1041 www 10046: &end_scrollbox().
1.1140 raeburn 10047: &end_page()
1.1041 www 10048: );
1.1365 raeburn 10049: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 10050: }
10051:
10052: sub modal_adhoc_window {
1.1365 raeburn 10053: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
10054: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 10055: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
10056: }
10057:
10058: sub modal_adhoc_launch {
10059: my ($funcname,$width,$height,$content)=@_;
10060: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
10061: <script type="text/javascript">
10062: // <![CDATA[
10063: $funcname();
10064: // ]]>
10065: </script>
10066: ENDLAUNCH
10067: }
10068:
10069: sub modal_adhoc_close {
10070: return (<<ENDCLOSE);
10071: <script type="text/javascript">
10072: // <![CDATA[
10073: modalWindow.close();
10074: // ]]>
10075: </script>
10076: ENDCLOSE
10077: }
10078:
1.1038 www 10079: sub togglebox_script {
10080: return(<<ENDTOGGLE);
10081: <script type="text/javascript">
10082: // <![CDATA[
10083: function LCtoggleDisplay(id,hidetext,showtext) {
10084: link = document.getElementById(id + "link").childNodes[0];
10085: with (document.getElementById(id).style) {
10086: if (display == "none" ) {
10087: display = "inline";
10088: link.nodeValue = hidetext;
10089: } else {
10090: display = "none";
10091: link.nodeValue = showtext;
10092: }
10093: }
10094: }
10095: // ]]>
10096: </script>
10097: ENDTOGGLE
10098: }
10099:
1.1039 www 10100: sub start_togglebox {
10101: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
10102: unless ($heading) { $heading=''; } else { $heading.=' '; }
10103: unless ($showtext) { $showtext=&mt('show'); }
10104: unless ($hidetext) { $hidetext=&mt('hide'); }
10105: unless ($headerbg) { $headerbg='#FFFFFF'; }
10106: return &start_data_table().
10107: &start_data_table_header_row().
10108: '<td bgcolor="'.$headerbg.'">'.$heading.
10109: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
10110: $showtext.'\')">'.$showtext.'</a>]</td>'.
10111: &end_data_table_header_row().
10112: '<tr id="'.$id.'" style="display:none""><td>';
10113: }
10114:
10115: sub end_togglebox {
10116: return '</td></tr>'.&end_data_table();
10117: }
10118:
1.1041 www 10119: sub LCprogressbar_script {
1.1302 raeburn 10120: my ($id,$number_to_do)=@_;
10121: if ($number_to_do) {
10122: return(<<ENDPROGRESS);
1.1041 www 10123: <script type="text/javascript">
10124: // <![CDATA[
1.1045 www 10125: \$('#progressbar$id').progressbar({
1.1041 www 10126: value: 0,
10127: change: function(event, ui) {
10128: var newVal = \$(this).progressbar('option', 'value');
10129: \$('.pblabel', this).text(LCprogressTxt);
10130: }
10131: });
10132: // ]]>
10133: </script>
10134: ENDPROGRESS
1.1302 raeburn 10135: } else {
10136: return(<<ENDPROGRESS);
10137: <script type="text/javascript">
10138: // <![CDATA[
10139: \$('#progressbar$id').progressbar({
10140: value: false,
10141: create: function(event, ui) {
10142: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
10143: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
10144: }
10145: });
10146: // ]]>
10147: </script>
10148: ENDPROGRESS
10149: }
1.1041 www 10150: }
10151:
10152: sub LCprogressbarUpdate_script {
10153: return(<<ENDPROGRESSUPDATE);
10154: <style type="text/css">
10155: .ui-progressbar { position:relative; }
1.1302 raeburn 10156: .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
1.1041 www 10157: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
10158: </style>
10159: <script type="text/javascript">
10160: // <![CDATA[
1.1045 www 10161: var LCprogressTxt='---';
10162:
1.1302 raeburn 10163: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 10164: LCprogressTxt=progresstext;
1.1302 raeburn 10165: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
10166: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
10167: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 10168: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
10169: } else {
10170: \$('#progressbar'+id).progressbar('value',percent);
10171: }
1.1041 www 10172: }
10173: // ]]>
10174: </script>
10175: ENDPROGRESSUPDATE
10176: }
10177:
1.1042 www 10178: my $LClastpercent;
1.1045 www 10179: my $LCidcnt;
10180: my $LCcurrentid;
1.1042 www 10181:
1.1041 www 10182: sub LCprogressbar {
1.1302 raeburn 10183: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 10184: $LClastpercent=0;
1.1045 www 10185: $LCidcnt++;
10186: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 10187: my ($starting,$content);
10188: if ($number_to_do) {
10189: $starting=&mt('Starting');
10190: $content=(<<ENDPROGBAR);
10191: $preamble
1.1045 www 10192: <div id="progressbar$LCcurrentid">
1.1041 www 10193: <span class="pblabel">$starting</span>
10194: </div>
10195: ENDPROGBAR
1.1302 raeburn 10196: } else {
10197: $starting=&mt('Loading...');
10198: $LClastpercent='false';
10199: $content=(<<ENDPROGBAR);
10200: $preamble
10201: <div id="progressbar$LCcurrentid">
10202: <div class="progress-label">$starting</div>
10203: </div>
10204: ENDPROGBAR
10205: }
10206: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 10207: }
10208:
10209: sub LCprogressbarUpdate {
1.1302 raeburn 10210: my ($r,$val,$text,$number_to_do)=@_;
10211: if ($number_to_do) {
10212: unless ($val) {
10213: if ($LClastpercent) {
10214: $val=$LClastpercent;
10215: } else {
10216: $val=0;
10217: }
10218: }
10219: if ($val<0) { $val=0; }
10220: if ($val>100) { $val=0; }
10221: $LClastpercent=$val;
10222: unless ($text) { $text=$val.'%'; }
10223: } else {
10224: $val = 'false';
1.1042 www 10225: }
1.1041 www 10226: $text=&js_ready($text);
1.1044 www 10227: &r_print($r,<<ENDUPDATE);
1.1041 www 10228: <script type="text/javascript">
10229: // <![CDATA[
1.1302 raeburn 10230: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 10231: // ]]>
10232: </script>
10233: ENDUPDATE
1.1035 www 10234: }
10235:
1.1042 www 10236: sub LCprogressbarClose {
10237: my ($r)=@_;
10238: $LClastpercent=0;
1.1044 www 10239: &r_print($r,<<ENDCLOSE);
1.1042 www 10240: <script type="text/javascript">
10241: // <![CDATA[
1.1045 www 10242: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 10243: // ]]>
10244: </script>
10245: ENDCLOSE
1.1044 www 10246: }
10247:
10248: sub r_print {
10249: my ($r,$to_print)=@_;
10250: if ($r) {
10251: $r->print($to_print);
10252: $r->rflush();
10253: } else {
10254: print($to_print);
10255: }
1.1042 www 10256: }
10257:
1.320 albertel 10258: sub html_encode {
10259: my ($result) = @_;
10260:
1.322 albertel 10261: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 10262:
10263: return $result;
10264: }
1.1044 www 10265:
1.317 albertel 10266: sub js_ready {
10267: my ($result) = @_;
10268:
1.323 albertel 10269: $result =~ s/[\n\r]/ /xmsg;
10270: $result =~ s/\\/\\\\/xmsg;
10271: $result =~ s/'/\\'/xmsg;
1.372 albertel 10272: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 10273:
10274: return $result;
10275: }
10276:
1.315 albertel 10277: sub validate_page {
10278: if ( exists($env{'internal.start_page'})
1.316 albertel 10279: && $env{'internal.start_page'} > 1) {
10280: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 10281: $env{'internal.start_page'}.' '.
1.316 albertel 10282: $ENV{'request.filename'});
1.315 albertel 10283: }
10284: if ( exists($env{'internal.end_page'})
1.316 albertel 10285: && $env{'internal.end_page'} > 1) {
10286: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 10287: $env{'internal.end_page'}.' '.
1.316 albertel 10288: $env{'request.filename'});
1.315 albertel 10289: }
10290: if ( exists($env{'internal.start_page'})
10291: && ! exists($env{'internal.end_page'})) {
1.316 albertel 10292: &Apache::lonnet::logthis('start_page called without end_page '.
10293: $env{'request.filename'});
1.315 albertel 10294: }
10295: if ( ! exists($env{'internal.start_page'})
10296: && exists($env{'internal.end_page'})) {
1.316 albertel 10297: &Apache::lonnet::logthis('end_page called without start_page'.
10298: $env{'request.filename'});
1.315 albertel 10299: }
1.306 albertel 10300: }
1.315 albertel 10301:
1.996 www 10302:
10303: sub start_scrollbox {
1.1140 raeburn 10304: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 10305: unless ($outerwidth) { $outerwidth='520px'; }
10306: unless ($width) { $width='500px'; }
10307: unless ($height) { $height='200px'; }
1.1075 raeburn 10308: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 10309: if ($id ne '') {
1.1140 raeburn 10310: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 10311: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 10312: }
1.1075 raeburn 10313: if ($bgcolor ne '') {
10314: $tdcol = "background-color: $bgcolor;";
10315: }
1.1137 raeburn 10316: my $nicescroll_js;
10317: if ($env{'browser.mobile'}) {
1.1140 raeburn 10318: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
10319: }
10320: return <<"END";
10321: $nicescroll_js
10322:
10323: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
10324: <div style="overflow:auto; width:$width; height:$height;"$div_id>
10325: END
10326: }
10327:
10328: sub end_scrollbox {
10329: return '</div></td></tr></table>';
10330: }
10331:
10332: sub nicescroll_javascript {
10333: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
10334: my %options;
10335: if (ref($cursor) eq 'HASH') {
10336: %options = %{$cursor};
10337: }
10338: unless ($options{'railalign'} =~ /^left|right$/) {
10339: $options{'railalign'} = 'left';
10340: }
10341: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10342: my $function = &get_users_function();
10343: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 10344: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 10345: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 10346: }
1.1140 raeburn 10347: }
10348: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
10349: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 10350: $options{'cursoropacity'}='1.0';
10351: }
1.1140 raeburn 10352: } else {
10353: $options{'cursoropacity'}='1.0';
10354: }
10355: if ($options{'cursorfixedheight'} eq 'none') {
10356: delete($options{'cursorfixedheight'});
10357: } else {
10358: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
10359: }
10360: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
10361: delete($options{'railoffset'});
10362: }
10363: my @niceoptions;
10364: while (my($key,$value) = each(%options)) {
10365: if ($value =~ /^\{.+\}$/) {
10366: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 10367: } else {
1.1140 raeburn 10368: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 10369: }
1.1140 raeburn 10370: }
10371: my $nicescroll_js = '
1.1137 raeburn 10372: $(document).ready(
1.1140 raeburn 10373: function() {
10374: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
10375: }
1.1137 raeburn 10376: );
10377: ';
1.1140 raeburn 10378: if ($framecheck) {
10379: $nicescroll_js .= '
10380: function expand_div(caller) {
10381: if (top === self) {
10382: document.getElementById("'.$id.'").style.width = "auto";
10383: document.getElementById("'.$id.'").style.height = "auto";
10384: } else {
10385: try {
10386: if (parent.frames) {
10387: if (parent.frames.length > 1) {
10388: var framesrc = parent.frames[1].location.href;
10389: var currsrc = framesrc.replace(/\#.*$/,"");
10390: if ((caller == "search") || (currsrc == "'.$location.'")) {
10391: document.getElementById("'.$id.'").style.width = "auto";
10392: document.getElementById("'.$id.'").style.height = "auto";
10393: }
10394: }
10395: }
10396: } catch (e) {
10397: return;
10398: }
1.1137 raeburn 10399: }
1.1140 raeburn 10400: return;
1.996 www 10401: }
1.1140 raeburn 10402: ';
10403: }
10404: if ($needjsready) {
10405: $nicescroll_js = '
10406: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10407: } else {
10408: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10409: }
10410: return $nicescroll_js;
1.996 www 10411: }
10412:
1.318 albertel 10413: sub simple_error_page {
1.1150 bisitz 10414: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10415: my %displayargs;
1.1151 raeburn 10416: if (ref($args) eq 'HASH') {
10417: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10418: if ($args->{'only_body'}) {
10419: $displayargs{'only_body'} = 1;
10420: }
10421: if ($args->{'no_nav_bar'}) {
10422: $displayargs{'no_nav_bar'} = 1;
10423: }
1.1151 raeburn 10424: } else {
10425: $msg = &mt($msg);
10426: }
1.1150 bisitz 10427:
1.318 albertel 10428: my $page =
1.1304 raeburn 10429: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10430: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10431: &Apache::loncommon::end_page();
10432: if (ref($r)) {
10433: $r->print($page);
1.327 albertel 10434: return;
1.318 albertel 10435: }
10436: return $page;
10437: }
1.347 albertel 10438:
10439: {
1.610 albertel 10440: my @row_count;
1.961 onken 10441:
10442: sub start_data_table_count {
10443: unshift(@row_count, 0);
10444: return;
10445: }
10446:
10447: sub end_data_table_count {
10448: shift(@row_count);
10449: return;
10450: }
10451:
1.347 albertel 10452: sub start_data_table {
1.1018 raeburn 10453: my ($add_class,$id) = @_;
1.422 albertel 10454: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10455: my $table_id;
10456: if (defined($id)) {
10457: $table_id = ' id="'.$id.'"';
10458: }
1.961 onken 10459: &start_data_table_count();
1.1018 raeburn 10460: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10461: }
10462:
10463: sub end_data_table {
1.961 onken 10464: &end_data_table_count();
1.389 albertel 10465: return '</table>'."\n";;
1.347 albertel 10466: }
10467:
10468: sub start_data_table_row {
1.974 wenzelju 10469: my ($add_class, $id) = @_;
1.610 albertel 10470: $row_count[0]++;
10471: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10472: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10473: $id = (' id="'.$id.'"') unless ($id eq '');
10474: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10475: }
1.471 banghart 10476:
10477: sub continue_data_table_row {
1.974 wenzelju 10478: my ($add_class, $id) = @_;
1.610 albertel 10479: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10480: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10481: $id = (' id="'.$id.'"') unless ($id eq '');
10482: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10483: }
1.347 albertel 10484:
10485: sub end_data_table_row {
1.389 albertel 10486: return '</tr>'."\n";;
1.347 albertel 10487: }
1.367 www 10488:
1.421 albertel 10489: sub start_data_table_empty_row {
1.707 bisitz 10490: # $row_count[0]++;
1.421 albertel 10491: return '<tr class="LC_empty_row" >'."\n";;
10492: }
10493:
10494: sub end_data_table_empty_row {
10495: return '</tr>'."\n";;
10496: }
10497:
1.367 www 10498: sub start_data_table_header_row {
1.389 albertel 10499: return '<tr class="LC_header_row">'."\n";;
1.367 www 10500: }
10501:
10502: sub end_data_table_header_row {
1.389 albertel 10503: return '</tr>'."\n";;
1.367 www 10504: }
1.890 droeschl 10505:
10506: sub data_table_caption {
10507: my $caption = shift;
10508: return "<caption class=\"LC_caption\">$caption</caption>";
10509: }
1.347 albertel 10510: }
10511:
1.548 albertel 10512: =pod
10513:
10514: =item * &inhibit_menu_check($arg)
10515:
10516: Checks for a inhibitmenu state and generates output to preserve it
10517:
10518: Inputs: $arg - can be any of
10519: - undef - in which case the return value is a string
10520: to add into arguments list of a uri
10521: - 'input' - in which case the return value is a HTML
10522: <form> <input> field of type hidden to
10523: preserve the value
10524: - a url - in which case the return value is the url with
10525: the neccesary cgi args added to preserve the
10526: inhibitmenu state
10527: - a ref to a url - no return value, but the string is
10528: updated to include the neccessary cgi
10529: args to preserve the inhibitmenu state
10530:
10531: =cut
10532:
10533: sub inhibit_menu_check {
10534: my ($arg) = @_;
10535: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10536: if ($arg eq 'input') {
10537: if ($env{'form.inhibitmenu'}) {
10538: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10539: } else {
10540: return
10541: }
10542: }
10543: if ($env{'form.inhibitmenu'}) {
10544: if (ref($arg)) {
10545: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10546: } elsif ($arg eq '') {
10547: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10548: } else {
10549: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10550: }
10551: }
10552: if (!ref($arg)) {
10553: return $arg;
10554: }
10555: }
10556:
1.251 albertel 10557: ###############################################
1.182 matthew 10558:
10559: =pod
10560:
1.549 albertel 10561: =back
10562:
10563: =head1 User Information Routines
10564:
10565: =over 4
10566:
1.405 albertel 10567: =item * &get_users_function()
1.182 matthew 10568:
10569: Used by &bodytag to determine the current users primary role.
10570: Returns either 'student','coordinator','admin', or 'author'.
10571:
10572: =cut
10573:
10574: ###############################################
10575: sub get_users_function {
1.815 tempelho 10576: my $function = 'norole';
1.818 tempelho 10577: if ($env{'request.role'}=~/^(st)/) {
10578: $function='student';
10579: }
1.907 raeburn 10580: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10581: $function='coordinator';
10582: }
1.258 albertel 10583: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10584: $function='admin';
10585: }
1.826 bisitz 10586: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10587: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10588: $function='author';
10589: }
10590: return $function;
1.54 www 10591: }
1.99 www 10592:
10593: ###############################################
10594:
1.233 raeburn 10595: =pod
10596:
1.821 raeburn 10597: =item * &show_course()
10598:
10599: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10600: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10601:
10602: Inputs:
10603: None
10604:
10605: Outputs:
10606: Scalar: 1 if 'Course' to be used, 0 otherwise.
10607:
10608: =cut
10609:
10610: ###############################################
10611: sub show_course {
1.1408 raeburn 10612: my ($udom,$uname) = @_;
10613: if (($udom ne '') && ($uname ne '')) {
10614: if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
1.1410 raeburn 10615: if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
1.1408 raeburn 10616: return 0;
10617: } else {
10618: return 1;
10619: }
10620: }
10621: }
1.821 raeburn 10622: my $course = !$env{'user.adv'};
10623: if (!$env{'user.adv'}) {
10624: foreach my $env (keys(%env)) {
10625: next if ($env !~ m/^user\.priv\./);
10626: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10627: $course = 0;
10628: last;
10629: }
10630: }
10631: }
10632: return $course;
10633: }
10634:
10635: ###############################################
10636:
10637: =pod
10638:
1.542 raeburn 10639: =item * &check_user_status()
1.274 raeburn 10640:
10641: Determines current status of supplied role for a
10642: specific user. Roles can be active, previous or future.
10643:
10644: Inputs:
10645: user's domain, user's username, course's domain,
1.375 raeburn 10646: course's number, optional section ID.
1.274 raeburn 10647:
10648: Outputs:
10649: role status: active, previous or future.
10650:
10651: =cut
10652:
10653: sub check_user_status {
1.412 raeburn 10654: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10655: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10656: my @uroles = keys(%userinfo);
1.274 raeburn 10657: my $srchstr;
10658: my $active_chk = 'none';
1.412 raeburn 10659: my $now = time;
1.274 raeburn 10660: if (@uroles > 0) {
1.908 raeburn 10661: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10662: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10663: } else {
1.412 raeburn 10664: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10665: }
10666: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10667: my $role_end = 0;
10668: my $role_start = 0;
10669: $active_chk = 'active';
1.412 raeburn 10670: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10671: $role_end = $1;
10672: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10673: $role_start = $1;
1.274 raeburn 10674: }
10675: }
10676: if ($role_start > 0) {
1.412 raeburn 10677: if ($now < $role_start) {
1.274 raeburn 10678: $active_chk = 'future';
10679: }
10680: }
10681: if ($role_end > 0) {
1.412 raeburn 10682: if ($now > $role_end) {
1.274 raeburn 10683: $active_chk = 'previous';
10684: }
10685: }
10686: }
10687: }
10688: return $active_chk;
10689: }
10690:
10691: ###############################################
10692:
10693: =pod
10694:
1.405 albertel 10695: =item * &get_sections()
1.233 raeburn 10696:
10697: Determines all the sections for a course including
10698: sections with students and sections containing other roles.
1.419 raeburn 10699: Incoming parameters:
10700:
10701: 1. domain
10702: 2. course number
10703: 3. reference to array containing roles for which sections should
10704: be gathered (optional).
10705: 4. reference to array containing status types for which sections
10706: should be gathered (optional).
10707:
10708: If the third argument is undefined, sections are gathered for any role.
10709: If the fourth argument is undefined, sections are gathered for any status.
10710: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10711:
1.374 raeburn 10712: Returns section hash (keys are section IDs, values are
10713: number of users in each section), subject to the
1.419 raeburn 10714: optional roles filter, optional status filter
1.233 raeburn 10715:
10716: =cut
10717:
10718: ###############################################
10719: sub get_sections {
1.419 raeburn 10720: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10721: if (!defined($cdom) || !defined($cnum)) {
10722: my $cid = $env{'request.course.id'};
10723:
10724: return if (!defined($cid));
10725:
10726: $cdom = $env{'course.'.$cid.'.domain'};
10727: $cnum = $env{'course.'.$cid.'.num'};
10728: }
10729:
10730: my %sectioncount;
1.419 raeburn 10731: my $now = time;
1.240 albertel 10732:
1.1118 raeburn 10733: my $check_students = 1;
10734: my $only_students = 0;
10735: if (ref($possible_roles) eq 'ARRAY') {
10736: if (grep(/^st$/,@{$possible_roles})) {
10737: if (@{$possible_roles} == 1) {
10738: $only_students = 1;
10739: }
10740: } else {
10741: $check_students = 0;
10742: }
10743: }
10744:
10745: if ($check_students) {
1.276 albertel 10746: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10747: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10748: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10749: my $start_index = &Apache::loncoursedata::CL_START();
10750: my $end_index = &Apache::loncoursedata::CL_END();
10751: my $status;
1.366 albertel 10752: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10753: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10754: $data->[$status_index],
10755: $data->[$start_index],
10756: $data->[$end_index]);
10757: if ($stu_status eq 'Active') {
10758: $status = 'active';
10759: } elsif ($end < $now) {
10760: $status = 'previous';
10761: } elsif ($start > $now) {
10762: $status = 'future';
10763: }
10764: if ($section ne '-1' && $section !~ /^\s*$/) {
10765: if ((!defined($possible_status)) || (($status ne '') &&
10766: (grep/^\Q$status\E$/,@{$possible_status}))) {
10767: $sectioncount{$section}++;
10768: }
1.240 albertel 10769: }
10770: }
10771: }
1.1118 raeburn 10772: if ($only_students) {
10773: return %sectioncount;
10774: }
1.240 albertel 10775: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10776: foreach my $user (sort(keys(%courseroles))) {
10777: if ($user !~ /^(\w{2})/) { next; }
10778: my ($role) = ($user =~ /^(\w{2})/);
10779: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10780: my ($section,$status);
1.240 albertel 10781: if ($role eq 'cr' &&
10782: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10783: $section=$1;
10784: }
10785: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10786: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10787: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10788: if ($end == -1 && $start == -1) {
10789: next; #deleted role
10790: }
10791: if (!defined($possible_status)) {
10792: $sectioncount{$section}++;
10793: } else {
10794: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10795: $status = 'active';
10796: } elsif ($end < $now) {
10797: $status = 'future';
10798: } elsif ($start > $now) {
10799: $status = 'previous';
10800: }
10801: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10802: $sectioncount{$section}++;
10803: }
10804: }
1.233 raeburn 10805: }
1.366 albertel 10806: return %sectioncount;
1.233 raeburn 10807: }
10808:
1.274 raeburn 10809: ###############################################
1.294 raeburn 10810:
10811: =pod
1.405 albertel 10812:
10813: =item * &get_course_users()
10814:
1.275 raeburn 10815: Retrieves usernames:domains for users in the specified course
10816: with specific role(s), and access status.
10817:
10818: Incoming parameters:
1.277 albertel 10819: 1. course domain
10820: 2. course number
10821: 3. access status: users must have - either active,
1.275 raeburn 10822: previous, future, or all.
1.277 albertel 10823: 4. reference to array of permissible roles
1.288 raeburn 10824: 5. reference to array of section restrictions (optional)
10825: 6. reference to results object (hash of hashes).
10826: 7. reference to optional userdata hash
1.609 raeburn 10827: 8. reference to optional statushash
1.630 raeburn 10828: 9. flag if privileged users (except those set to unhide in
10829: course settings) should be excluded
1.609 raeburn 10830: Keys of top level results hash are roles.
1.275 raeburn 10831: Keys of inner hashes are username:domain, with
10832: values set to access type.
1.288 raeburn 10833: Optional userdata hash returns an array with arguments in the
10834: same order as loncoursedata::get_classlist() for student data.
10835:
1.609 raeburn 10836: Optional statushash returns
10837:
1.288 raeburn 10838: Entries for end, start, section and status are blank because
10839: of the possibility of multiple values for non-student roles.
10840:
1.275 raeburn 10841: =cut
1.405 albertel 10842:
1.275 raeburn 10843: ###############################################
1.405 albertel 10844:
1.275 raeburn 10845: sub get_course_users {
1.630 raeburn 10846: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10847: my %idx = ();
1.419 raeburn 10848: my %seclists;
1.288 raeburn 10849:
10850: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10851: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10852: $idx{end} = &Apache::loncoursedata::CL_END();
10853: $idx{start} = &Apache::loncoursedata::CL_START();
10854: $idx{id} = &Apache::loncoursedata::CL_ID();
10855: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10856: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10857: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10858:
1.290 albertel 10859: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10860: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10861: my $now = time;
1.277 albertel 10862: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10863: my $match = 0;
1.412 raeburn 10864: my $secmatch = 0;
1.419 raeburn 10865: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10866: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10867: if ($section eq '') {
10868: $section = 'none';
10869: }
1.291 albertel 10870: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10871: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10872: $secmatch = 1;
10873: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10874: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10875: $secmatch = 1;
10876: }
10877: } else {
1.419 raeburn 10878: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10879: $secmatch = 1;
10880: }
1.290 albertel 10881: }
1.412 raeburn 10882: if (!$secmatch) {
10883: next;
10884: }
1.419 raeburn 10885: }
1.275 raeburn 10886: if (defined($$types{'active'})) {
1.288 raeburn 10887: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10888: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10889: $match = 1;
1.275 raeburn 10890: }
10891: }
10892: if (defined($$types{'previous'})) {
1.609 raeburn 10893: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10894: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10895: $match = 1;
1.275 raeburn 10896: }
10897: }
10898: if (defined($$types{'future'})) {
1.609 raeburn 10899: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10900: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10901: $match = 1;
1.275 raeburn 10902: }
10903: }
1.609 raeburn 10904: if ($match) {
10905: push(@{$seclists{$student}},$section);
10906: if (ref($userdata) eq 'HASH') {
10907: $$userdata{$student} = $$classlist{$student};
10908: }
10909: if (ref($statushash) eq 'HASH') {
10910: $statushash->{$student}{'st'}{$section} = $status;
10911: }
1.288 raeburn 10912: }
1.275 raeburn 10913: }
10914: }
1.412 raeburn 10915: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 10916: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10917: my $now = time;
1.609 raeburn 10918: my %displaystatus = ( previous => 'Expired',
10919: active => 'Active',
10920: future => 'Future',
10921: );
1.1121 raeburn 10922: my (%nothide,@possdoms);
1.630 raeburn 10923: if ($hidepriv) {
10924: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
10925: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
10926: if ($user !~ /:/) {
10927: $nothide{join(':',split(/[\@]/,$user))}=1;
10928: } else {
10929: $nothide{$user} = 1;
10930: }
10931: }
1.1121 raeburn 10932: my @possdoms = ($cdom);
10933: if ($coursehash{'checkforpriv'}) {
10934: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
10935: }
1.630 raeburn 10936: }
1.439 raeburn 10937: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 10938: my $match = 0;
1.412 raeburn 10939: my $secmatch = 0;
1.439 raeburn 10940: my $status;
1.412 raeburn 10941: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 10942: $user =~ s/:$//;
1.439 raeburn 10943: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10944: if ($end == -1 || $start == -1) {
10945: next;
10946: }
10947: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10948: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10949: my ($uname,$udom) = split(/:/,$user);
10950: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10951: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10952: $secmatch = 1;
10953: } elsif ($usec eq '') {
1.420 albertel 10954: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10955: $secmatch = 1;
10956: }
10957: } else {
10958: if (grep(/^\Q$usec\E$/,@{$sections})) {
10959: $secmatch = 1;
10960: }
10961: }
10962: if (!$secmatch) {
10963: next;
10964: }
1.288 raeburn 10965: }
1.419 raeburn 10966: if ($usec eq '') {
10967: $usec = 'none';
10968: }
1.275 raeburn 10969: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10970: if ($hidepriv) {
1.1121 raeburn 10971: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10972: (!$nothide{$uname.':'.$udom})) {
10973: next;
10974: }
10975: }
1.503 raeburn 10976: if ($end > 0 && $end < $now) {
1.439 raeburn 10977: $status = 'previous';
10978: } elsif ($start > $now) {
10979: $status = 'future';
10980: } else {
10981: $status = 'active';
10982: }
1.277 albertel 10983: foreach my $type (keys(%{$types})) {
1.275 raeburn 10984: if ($status eq $type) {
1.420 albertel 10985: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10986: push(@{$$users{$role}{$user}},$type);
10987: }
1.288 raeburn 10988: $match = 1;
10989: }
10990: }
1.419 raeburn 10991: if (($match) && (ref($userdata) eq 'HASH')) {
10992: if (!exists($$userdata{$uname.':'.$udom})) {
10993: &get_user_info($udom,$uname,\%idx,$userdata);
10994: }
1.420 albertel 10995: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10996: push(@{$seclists{$uname.':'.$udom}},$usec);
10997: }
1.609 raeburn 10998: if (ref($statushash) eq 'HASH') {
10999: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
11000: }
1.275 raeburn 11001: }
11002: }
11003: }
11004: }
1.290 albertel 11005: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 11006: if ((defined($cdom)) && (defined($cnum))) {
11007: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
11008: if ( defined($csettings{'internal.courseowner'}) ) {
11009: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 11010: next if ($owner eq '');
11011: my ($ownername,$ownerdom);
11012: if ($owner =~ /^([^:]+):([^:]+)$/) {
11013: $ownername = $1;
11014: $ownerdom = $2;
11015: } else {
11016: $ownername = $owner;
11017: $ownerdom = $cdom;
11018: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 11019: }
11020: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 11021: if (defined($userdata) &&
1.609 raeburn 11022: !exists($$userdata{$owner})) {
11023: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
11024: if (!grep(/^none$/,@{$seclists{$owner}})) {
11025: push(@{$seclists{$owner}},'none');
11026: }
11027: if (ref($statushash) eq 'HASH') {
11028: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 11029: }
1.290 albertel 11030: }
1.279 raeburn 11031: }
11032: }
11033: }
1.419 raeburn 11034: foreach my $user (keys(%seclists)) {
11035: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
11036: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
11037: }
1.275 raeburn 11038: }
11039: return;
11040: }
11041:
1.288 raeburn 11042: sub get_user_info {
11043: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 11044: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
11045: &plainname($uname,$udom,'lastname');
1.291 albertel 11046: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 11047: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 11048: my %idhash = &Apache::lonnet::idrget($udom,($uname));
11049: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 11050: return;
11051: }
1.275 raeburn 11052:
1.472 raeburn 11053: ###############################################
11054:
11055: =pod
11056:
11057: =item * &get_user_quota()
11058:
1.1134 raeburn 11059: Retrieves quota assigned for storage of user files.
11060: Default is to report quota for portfolio files.
1.472 raeburn 11061:
11062: Incoming parameters:
11063: 1. user's username
11064: 2. user's domain
1.1134 raeburn 11065: 3. quota name - portfolio, author, or course
1.1136 raeburn 11066: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 11067: 4. crstype - official, unofficial, textbook, placement or community,
11068: if quota name is course
1.472 raeburn 11069:
11070: Returns:
1.1163 raeburn 11071: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 11072: 2. (Optional) Type of setting: custom or default
11073: (individually assigned or default for user's
11074: institutional status).
11075: 3. (Optional) - User's institutional status (e.g., faculty, staff
11076: or student - types as defined in localenroll::inst_usertypes
11077: for user's domain, which determines default quota for user.
11078: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 11079:
11080: If a value has been stored in the user's environment,
1.536 raeburn 11081: it will return that, otherwise it returns the maximal default
1.1134 raeburn 11082: defined for the user's institutional status(es) in the domain.
1.472 raeburn 11083:
11084: =cut
11085:
11086: ###############################################
11087:
11088:
11089: sub get_user_quota {
1.1136 raeburn 11090: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 11091: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 11092: if (!defined($udom)) {
11093: $udom = $env{'user.domain'};
11094: }
11095: if (!defined($uname)) {
11096: $uname = $env{'user.name'};
11097: }
11098: if (($udom eq '' || $uname eq '') ||
11099: ($udom eq 'public') && ($uname eq 'public')) {
11100: $quota = 0;
1.536 raeburn 11101: $quotatype = 'default';
11102: $defquota = 0;
1.472 raeburn 11103: } else {
1.536 raeburn 11104: my $inststatus;
1.1134 raeburn 11105: if ($quotaname eq 'course') {
11106: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
11107: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
11108: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
11109: } else {
11110: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
11111: $quota = $cenv{'internal.uploadquota'};
11112: }
1.536 raeburn 11113: } else {
1.1134 raeburn 11114: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
11115: if ($quotaname eq 'author') {
11116: $quota = $env{'environment.authorquota'};
11117: } else {
11118: $quota = $env{'environment.portfolioquota'};
11119: }
11120: $inststatus = $env{'environment.inststatus'};
11121: } else {
11122: my %userenv =
11123: &Apache::lonnet::get('environment',['portfolioquota',
11124: 'authorquota','inststatus'],$udom,$uname);
11125: my ($tmp) = keys(%userenv);
11126: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
11127: if ($quotaname eq 'author') {
11128: $quota = $userenv{'authorquota'};
11129: } else {
11130: $quota = $userenv{'portfolioquota'};
11131: }
11132: $inststatus = $userenv{'inststatus'};
11133: } else {
11134: undef(%userenv);
11135: }
11136: }
11137: }
11138: if ($quota eq '' || wantarray) {
11139: if ($quotaname eq 'course') {
11140: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 11141: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 11142: ($crstype eq 'community') || ($crstype eq 'textbook') ||
11143: ($crstype eq 'placement')) {
1.1136 raeburn 11144: $defquota = $domdefs{$crstype.'quota'};
11145: }
11146: if ($defquota eq '') {
11147: $defquota = 500;
11148: }
1.1134 raeburn 11149: } else {
11150: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
11151: }
11152: if ($quota eq '') {
11153: $quota = $defquota;
11154: $quotatype = 'default';
11155: } else {
11156: $quotatype = 'custom';
11157: }
1.472 raeburn 11158: }
11159: }
1.536 raeburn 11160: if (wantarray) {
11161: return ($quota,$quotatype,$settingstatus,$defquota);
11162: } else {
11163: return $quota;
11164: }
1.472 raeburn 11165: }
11166:
11167: ###############################################
11168:
11169: =pod
11170:
11171: =item * &default_quota()
11172:
1.536 raeburn 11173: Retrieves default quota assigned for storage of user portfolio files,
11174: given an (optional) user's institutional status.
1.472 raeburn 11175:
11176: Incoming parameters:
1.1142 raeburn 11177:
1.472 raeburn 11178: 1. domain
1.536 raeburn 11179: 2. (Optional) institutional status(es). This is a : separated list of
11180: status types (e.g., faculty, staff, student etc.)
11181: which apply to the user for whom the default is being retrieved.
11182: If the institutional status string in undefined, the domain
1.1134 raeburn 11183: default quota will be returned.
11184: 3. quota name - portfolio, author, or course
11185: (if no quota name provided, defaults to portfolio).
1.472 raeburn 11186:
11187: Returns:
1.1142 raeburn 11188:
1.1163 raeburn 11189: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 11190: 2. (Optional) institutional type which determined the value of the
11191: default quota.
1.472 raeburn 11192:
11193: If a value has been stored in the domain's configuration db,
11194: it will return that, otherwise it returns 20 (for backwards
11195: compatibility with domains which have not set up a configuration
1.1163 raeburn 11196: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 11197:
1.536 raeburn 11198: If the user's status includes multiple types (e.g., staff and student),
11199: the largest default quota which applies to the user determines the
11200: default quota returned.
11201:
1.472 raeburn 11202: =cut
11203:
11204: ###############################################
11205:
11206:
11207: sub default_quota {
1.1134 raeburn 11208: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 11209: my ($defquota,$settingstatus);
11210: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 11211: ['quotas'],$udom);
1.1134 raeburn 11212: my $key = 'defaultquota';
11213: if ($quotaname eq 'author') {
11214: $key = 'authorquota';
11215: }
1.622 raeburn 11216: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 11217: if ($inststatus ne '') {
1.765 raeburn 11218: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 11219: foreach my $item (@statuses) {
1.1134 raeburn 11220: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11221: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 11222: if ($defquota eq '') {
1.1134 raeburn 11223: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11224: $settingstatus = $item;
1.1134 raeburn 11225: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
11226: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11227: $settingstatus = $item;
11228: }
11229: }
1.1134 raeburn 11230: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11231: if ($quotahash{'quotas'}{$item} ne '') {
11232: if ($defquota eq '') {
11233: $defquota = $quotahash{'quotas'}{$item};
11234: $settingstatus = $item;
11235: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
11236: $defquota = $quotahash{'quotas'}{$item};
11237: $settingstatus = $item;
11238: }
1.536 raeburn 11239: }
11240: }
11241: }
11242: }
11243: if ($defquota eq '') {
1.1134 raeburn 11244: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11245: $defquota = $quotahash{'quotas'}{$key}{'default'};
11246: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11247: $defquota = $quotahash{'quotas'}{'default'};
11248: }
1.536 raeburn 11249: $settingstatus = 'default';
1.1139 raeburn 11250: if ($defquota eq '') {
11251: if ($quotaname eq 'author') {
11252: $defquota = 500;
11253: }
11254: }
1.536 raeburn 11255: }
11256: } else {
11257: $settingstatus = 'default';
1.1134 raeburn 11258: if ($quotaname eq 'author') {
11259: $defquota = 500;
11260: } else {
11261: $defquota = 20;
11262: }
1.536 raeburn 11263: }
11264: if (wantarray) {
11265: return ($defquota,$settingstatus);
1.472 raeburn 11266: } else {
1.536 raeburn 11267: return $defquota;
1.472 raeburn 11268: }
11269: }
11270:
1.1135 raeburn 11271: ###############################################
11272:
11273: =pod
11274:
1.1136 raeburn 11275: =item * &excess_filesize_warning()
1.1135 raeburn 11276:
11277: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 11278: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 11279: space to be exceeded.
1.1136 raeburn 11280:
11281: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 11282: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 11283:
1.1165 raeburn 11284: Inputs: 7
1.1136 raeburn 11285: 1. username or coursenum
1.1135 raeburn 11286: 2. domain
1.1136 raeburn 11287: 3. context ('author' or 'course')
1.1135 raeburn 11288: 4. filename of file for which action is being requested
11289: 5. filesize (kB) of file
11290: 6. action being taken: copy or upload.
1.1237 raeburn 11291: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 11292:
11293: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 11294: otherwise return null.
11295:
11296: =back
1.1135 raeburn 11297:
11298: =cut
11299:
1.1136 raeburn 11300: sub excess_filesize_warning {
1.1165 raeburn 11301: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 11302: my $current_disk_usage = 0;
1.1165 raeburn 11303: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 11304: if ($context eq 'author') {
11305: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
11306: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
11307: } else {
11308: foreach my $subdir ('docs','supplemental') {
11309: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
11310: }
11311: }
1.1135 raeburn 11312: $disk_quota = int($disk_quota * 1000);
11313: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 11314: return '<p class="LC_warning">'.
1.1135 raeburn 11315: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 11316: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
11317: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 11318: $disk_quota,$current_disk_usage).
11319: '</p>';
11320: }
11321: return;
11322: }
11323:
11324: ###############################################
11325:
11326:
1.1136 raeburn 11327:
11328:
1.384 raeburn 11329: sub get_secgrprole_info {
11330: my ($cdom,$cnum,$needroles,$type) = @_;
11331: my %sections_count = &get_sections($cdom,$cnum);
11332: my @sections = (sort {$a <=> $b} keys(%sections_count));
11333: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
11334: my @groups = sort(keys(%curr_groups));
11335: my $allroles = [];
11336: my $rolehash;
11337: my $accesshash = {
11338: active => 'Currently has access',
11339: future => 'Will have future access',
11340: previous => 'Previously had access',
11341: };
11342: if ($needroles) {
11343: $rolehash = {'all' => 'all'};
1.385 albertel 11344: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11345: if (&Apache::lonnet::error(%user_roles)) {
11346: undef(%user_roles);
11347: }
11348: foreach my $item (keys(%user_roles)) {
1.384 raeburn 11349: my ($role)=split(/\:/,$item,2);
11350: if ($role eq 'cr') { next; }
11351: if ($role =~ /^cr/) {
11352: $$rolehash{$role} = (split('/',$role))[3];
11353: } else {
11354: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
11355: }
11356: }
11357: foreach my $key (sort(keys(%{$rolehash}))) {
11358: push(@{$allroles},$key);
11359: }
11360: push (@{$allroles},'st');
11361: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
11362: }
11363: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
11364: }
11365:
1.555 raeburn 11366: sub user_picker {
1.1279 raeburn 11367: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 11368: my $currdom = $dom;
1.1253 raeburn 11369: my @alldoms = &Apache::lonnet::all_domains();
11370: if (@alldoms == 1) {
11371: my %domsrch = &Apache::lonnet::get_dom('configuration',
11372: ['directorysrch'],$alldoms[0]);
11373: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
11374: my $showdom = $domdesc;
11375: if ($showdom eq '') {
11376: $showdom = $dom;
11377: }
11378: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
11379: if ((!$domsrch{'directorysrch'}{'available'}) &&
11380: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
11381: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
11382: }
11383: }
11384: }
1.555 raeburn 11385: my %curr_selected = (
11386: srchin => 'dom',
1.580 raeburn 11387: srchby => 'lastname',
1.555 raeburn 11388: );
11389: my $srchterm;
1.625 raeburn 11390: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 11391: if ($srch->{'srchby'} ne '') {
11392: $curr_selected{'srchby'} = $srch->{'srchby'};
11393: }
11394: if ($srch->{'srchin'} ne '') {
11395: $curr_selected{'srchin'} = $srch->{'srchin'};
11396: }
11397: if ($srch->{'srchtype'} ne '') {
11398: $curr_selected{'srchtype'} = $srch->{'srchtype'};
11399: }
11400: if ($srch->{'srchdomain'} ne '') {
11401: $currdom = $srch->{'srchdomain'};
11402: }
11403: $srchterm = $srch->{'srchterm'};
11404: }
1.1222 damieng 11405: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11406: 'usr' => 'Search criteria',
1.563 raeburn 11407: 'doma' => 'Domain/institution to search',
1.558 albertel 11408: 'uname' => 'username',
11409: 'lastname' => 'last name',
1.555 raeburn 11410: 'lastfirst' => 'last name, first name',
1.558 albertel 11411: 'crs' => 'in this course',
1.576 raeburn 11412: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11413: 'alc' => 'all LON-CAPA',
1.573 raeburn 11414: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11415: 'exact' => 'is',
11416: 'contains' => 'contains',
1.569 raeburn 11417: 'begins' => 'begins with',
1.1222 damieng 11418: );
11419: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11420: 'youm' => "You must include some text to search for.",
11421: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11422: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11423: 'yomc' => "You must choose a domain when using an institutional directory search.",
11424: 'ymcd' => "You must choose a domain when using a domain search.",
11425: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11426: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11427: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11428: );
1.1222 damieng 11429: &html_escape(\%html_lt);
11430: &js_escape(\%js_lt);
1.1255 raeburn 11431: my $domform;
1.1277 raeburn 11432: my $allow_blank = 1;
1.1255 raeburn 11433: if ($fixeddom) {
1.1277 raeburn 11434: $allow_blank = 0;
11435: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11436: } else {
1.1287 raeburn 11437: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11438: my ($trusted,$untrusted);
1.1287 raeburn 11439: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11440: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11441: } elsif ($context eq 'author') {
1.1288 raeburn 11442: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11443: } elsif ($context eq 'domain') {
1.1288 raeburn 11444: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11445: }
1.1288 raeburn 11446: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11447: }
1.563 raeburn 11448: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11449:
11450: my @srchins = ('crs','dom','alc','instd');
11451:
11452: foreach my $option (@srchins) {
11453: # FIXME 'alc' option unavailable until
11454: # loncreateuser::print_user_query_page()
11455: # has been completed.
11456: next if ($option eq 'alc');
1.880 raeburn 11457: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11458: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11459: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11460: if ($curr_selected{'srchin'} eq $option) {
11461: $srchinsel .= '
1.1222 damieng 11462: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11463: } else {
11464: $srchinsel .= '
1.1222 damieng 11465: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11466: }
1.555 raeburn 11467: }
1.563 raeburn 11468: $srchinsel .= "\n </select>\n";
1.555 raeburn 11469:
11470: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11471: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11472: if ($curr_selected{'srchby'} eq $option) {
11473: $srchbysel .= '
1.1222 damieng 11474: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11475: } else {
11476: $srchbysel .= '
1.1222 damieng 11477: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11478: }
11479: }
11480: $srchbysel .= "\n </select>\n";
11481:
11482: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11483: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11484: if ($curr_selected{'srchtype'} eq $option) {
11485: $srchtypesel .= '
1.1222 damieng 11486: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11487: } else {
11488: $srchtypesel .= '
1.1222 damieng 11489: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11490: }
11491: }
11492: $srchtypesel .= "\n </select>\n";
11493:
1.558 albertel 11494: my ($newuserscript,$new_user_create);
1.994 raeburn 11495: my $context_dom = $env{'request.role.domain'};
11496: if ($context eq 'requestcrs') {
11497: if ($env{'form.coursedom'} ne '') {
11498: $context_dom = $env{'form.coursedom'};
11499: }
11500: }
1.556 raeburn 11501: if ($forcenewuser) {
1.576 raeburn 11502: if (ref($srch) eq 'HASH') {
1.994 raeburn 11503: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11504: if ($cancreate) {
11505: $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>';
11506: } else {
1.799 bisitz 11507: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11508: my %usertypetext = (
11509: official => 'institutional',
11510: unofficial => 'non-institutional',
11511: );
1.799 bisitz 11512: $new_user_create = '<p class="LC_warning">'
11513: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11514: .' '
11515: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11516: ,'<a href="'.$helplink.'">','</a>')
11517: .'</p><br />';
1.627 raeburn 11518: }
1.576 raeburn 11519: }
11520: }
11521:
1.556 raeburn 11522: $newuserscript = <<"ENDSCRIPT";
11523:
1.570 raeburn 11524: function setSearch(createnew,callingForm) {
1.556 raeburn 11525: if (createnew == 1) {
1.570 raeburn 11526: for (var i=0; i<callingForm.srchby.length; i++) {
11527: if (callingForm.srchby.options[i].value == 'uname') {
11528: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11529: }
11530: }
1.570 raeburn 11531: for (var i=0; i<callingForm.srchin.length; i++) {
11532: if ( callingForm.srchin.options[i].value == 'dom') {
11533: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11534: }
11535: }
1.570 raeburn 11536: for (var i=0; i<callingForm.srchtype.length; i++) {
11537: if (callingForm.srchtype.options[i].value == 'exact') {
11538: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11539: }
11540: }
1.570 raeburn 11541: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11542: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11543: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11544: }
11545: }
11546: }
11547: }
11548: ENDSCRIPT
1.558 albertel 11549:
1.556 raeburn 11550: }
11551:
1.555 raeburn 11552: my $output = <<"END_BLOCK";
1.556 raeburn 11553: <script type="text/javascript">
1.824 bisitz 11554: // <![CDATA[
1.570 raeburn 11555: function validateEntry(callingForm) {
1.558 albertel 11556:
1.556 raeburn 11557: var checkok = 1;
1.558 albertel 11558: var srchin;
1.570 raeburn 11559: for (var i=0; i<callingForm.srchin.length; i++) {
11560: if ( callingForm.srchin[i].checked ) {
11561: srchin = callingForm.srchin[i].value;
1.558 albertel 11562: }
11563: }
11564:
1.570 raeburn 11565: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11566: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11567: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11568: var srchterm = callingForm.srchterm.value;
11569: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11570: var msg = "";
11571:
11572: if (srchterm == "") {
11573: checkok = 0;
1.1222 damieng 11574: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11575: }
11576:
1.569 raeburn 11577: if (srchtype== 'begins') {
11578: if (srchterm.length < 2) {
11579: checkok = 0;
1.1222 damieng 11580: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11581: }
11582: }
11583:
1.556 raeburn 11584: if (srchtype== 'contains') {
11585: if (srchterm.length < 3) {
11586: checkok = 0;
1.1222 damieng 11587: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11588: }
11589: }
11590: if (srchin == 'instd') {
11591: if (srchdomain == '') {
11592: checkok = 0;
1.1222 damieng 11593: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11594: }
11595: }
11596: if (srchin == 'dom') {
11597: if (srchdomain == '') {
11598: checkok = 0;
1.1222 damieng 11599: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11600: }
11601: }
11602: if (srchby == 'lastfirst') {
11603: if (srchterm.indexOf(",") == -1) {
11604: checkok = 0;
1.1222 damieng 11605: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11606: }
11607: if (srchterm.indexOf(",") == srchterm.length -1) {
11608: checkok = 0;
1.1222 damieng 11609: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11610: }
11611: }
11612: if (checkok == 0) {
1.1222 damieng 11613: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11614: return;
11615: }
11616: if (checkok == 1) {
1.570 raeburn 11617: callingForm.submit();
1.556 raeburn 11618: }
11619: }
11620:
11621: $newuserscript
11622:
1.824 bisitz 11623: // ]]>
1.556 raeburn 11624: </script>
1.558 albertel 11625:
11626: $new_user_create
11627:
1.555 raeburn 11628: END_BLOCK
1.558 albertel 11629:
1.876 raeburn 11630: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11631: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11632: $domform.
11633: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11634: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11635: $srchbysel.
11636: $srchtypesel.
11637: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11638: $srchinsel.
11639: &Apache::lonhtmlcommon::row_closure(1).
11640: &Apache::lonhtmlcommon::end_pick_box().
11641: '<br />';
1.1253 raeburn 11642: return ($output,1);
1.555 raeburn 11643: }
11644:
1.612 raeburn 11645: sub user_rule_check {
1.615 raeburn 11646: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11647: my ($response,%inst_response);
1.612 raeburn 11648: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11649: if (keys(%{$usershash}) > 1) {
11650: my (%by_username,%by_id,%userdoms);
11651: my $checkid;
11652: if (ref($checks) eq 'HASH') {
11653: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11654: $checkid = 1;
11655: }
11656: }
11657: foreach my $user (keys(%{$usershash})) {
11658: my ($uname,$udom) = split(/:/,$user);
11659: if ($checkid) {
11660: if (ref($usershash->{$user}) eq 'HASH') {
11661: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 11662: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 11663: $userdoms{$udom} = 1;
1.1227 raeburn 11664: if (ref($inst_results) eq 'HASH') {
11665: $inst_results->{$uname.':'.$udom} = {};
11666: }
1.1226 raeburn 11667: }
11668: }
11669: } else {
11670: $by_username{$udom}{$uname} = 1;
11671: $userdoms{$udom} = 1;
1.1227 raeburn 11672: if (ref($inst_results) eq 'HASH') {
11673: $inst_results->{$uname.':'.$udom} = {};
11674: }
1.1226 raeburn 11675: }
11676: }
11677: foreach my $udom (keys(%userdoms)) {
11678: if (!$got_rules->{$udom}) {
11679: my %domconfig = &Apache::lonnet::get_dom('configuration',
11680: ['usercreation'],$udom);
11681: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11682: foreach my $item ('username','id') {
11683: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 11684: $$curr_rules{$udom}{$item} =
11685: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 11686: }
11687: }
11688: }
11689: $got_rules->{$udom} = 1;
11690: }
1.612 raeburn 11691: }
1.1226 raeburn 11692: if ($checkid) {
11693: foreach my $udom (keys(%by_id)) {
11694: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11695: if ($outcome eq 'ok') {
1.1227 raeburn 11696: foreach my $id (keys(%{$by_id{$udom}})) {
11697: my $uname = $by_id{$udom}{$id};
11698: $inst_response{$uname.':'.$udom} = $outcome;
11699: }
1.1226 raeburn 11700: if (ref($results) eq 'HASH') {
11701: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 11702: if (exists($inst_response{$uname.':'.$udom})) {
11703: $inst_response{$uname.':'.$udom} = $outcome;
11704: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11705: }
1.1226 raeburn 11706: }
11707: }
11708: }
1.612 raeburn 11709: }
1.615 raeburn 11710: } else {
1.1226 raeburn 11711: foreach my $udom (keys(%by_username)) {
11712: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11713: if ($outcome eq 'ok') {
1.1227 raeburn 11714: foreach my $uname (keys(%{$by_username{$udom}})) {
11715: $inst_response{$uname.':'.$udom} = $outcome;
11716: }
1.1226 raeburn 11717: if (ref($results) eq 'HASH') {
11718: foreach my $uname (keys(%{$results})) {
11719: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11720: }
11721: }
11722: }
11723: }
1.612 raeburn 11724: }
1.1226 raeburn 11725: } elsif (keys(%{$usershash}) == 1) {
11726: my $user = (keys(%{$usershash}))[0];
11727: my ($uname,$udom) = split(/:/,$user);
11728: if (($udom ne '') && ($uname ne '')) {
11729: if (ref($usershash->{$user}) eq 'HASH') {
11730: if (ref($checks) eq 'HASH') {
11731: if (defined($checks->{'username'})) {
11732: ($inst_response{$user},%{$inst_results->{$user}}) =
11733: &Apache::lonnet::get_instuser($udom,$uname);
11734: } elsif (defined($checks->{'id'})) {
11735: if ($usershash->{$user}->{'id'} ne '') {
11736: ($inst_response{$user},%{$inst_results->{$user}}) =
11737: &Apache::lonnet::get_instuser($udom,undef,
11738: $usershash->{$user}->{'id'});
11739: } else {
11740: ($inst_response{$user},%{$inst_results->{$user}}) =
11741: &Apache::lonnet::get_instuser($udom,$uname);
11742: }
1.585 raeburn 11743: }
1.1226 raeburn 11744: } else {
11745: ($inst_response{$user},%{$inst_results->{$user}}) =
11746: &Apache::lonnet::get_instuser($udom,$uname);
11747: return;
11748: }
11749: if (!$got_rules->{$udom}) {
11750: my %domconfig = &Apache::lonnet::get_dom('configuration',
11751: ['usercreation'],$udom);
11752: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11753: foreach my $item ('username','id') {
11754: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11755: $$curr_rules{$udom}{$item} =
11756: $domconfig{'usercreation'}{$item.'_rule'};
11757: }
11758: }
11759: }
11760: $got_rules->{$udom} = 1;
1.585 raeburn 11761: }
11762: }
1.1226 raeburn 11763: } else {
11764: return;
11765: }
11766: } else {
11767: return;
11768: }
11769: foreach my $user (keys(%{$usershash})) {
11770: my ($uname,$udom) = split(/:/,$user);
11771: next if (($udom eq '') || ($uname eq ''));
11772: my $id;
1.1227 raeburn 11773: if (ref($inst_results) eq 'HASH') {
11774: if (ref($inst_results->{$user}) eq 'HASH') {
11775: $id = $inst_results->{$user}->{'id'};
11776: }
11777: }
11778: if ($id eq '') {
11779: if (ref($usershash->{$user})) {
11780: $id = $usershash->{$user}->{'id'};
11781: }
1.585 raeburn 11782: }
1.612 raeburn 11783: foreach my $item (keys(%{$checks})) {
11784: if (ref($$curr_rules{$udom}) eq 'HASH') {
11785: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11786: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 11787: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11788: $$curr_rules{$udom}{$item});
1.612 raeburn 11789: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11790: if ($rule_check{$rule}) {
11791: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 11792: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11793: if (ref($inst_results) eq 'HASH') {
11794: if (ref($inst_results->{$user}) eq 'HASH') {
11795: if (keys(%{$inst_results->{$user}}) == 0) {
11796: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 11797: } elsif ($item eq 'id') {
11798: if ($inst_results->{$user}->{'id'} eq '') {
11799: $$alerts{$item}{$udom}{$uname} = 1;
11800: }
1.615 raeburn 11801: }
1.612 raeburn 11802: }
11803: }
1.615 raeburn 11804: }
11805: last;
1.585 raeburn 11806: }
11807: }
11808: }
11809: }
11810: }
11811: }
11812: }
11813: }
1.612 raeburn 11814: return;
11815: }
11816:
11817: sub user_rule_formats {
11818: my ($domain,$domdesc,$curr_rules,$check) = @_;
11819: my %text = (
11820: 'username' => 'Usernames',
11821: 'id' => 'IDs',
11822: );
11823: my $output;
11824: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11825: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11826: if (@{$ruleorder} > 0) {
1.1102 raeburn 11827: $output = '<br />'.
11828: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11829: '<span class="LC_cusr_emph">','</span>',$domdesc).
11830: ' <ul>';
1.612 raeburn 11831: foreach my $rule (@{$ruleorder}) {
11832: if (ref($curr_rules) eq 'ARRAY') {
11833: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11834: if (ref($rules->{$rule}) eq 'HASH') {
11835: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11836: $rules->{$rule}{'desc'}.'</li>';
11837: }
11838: }
11839: }
11840: }
11841: $output .= '</ul>';
11842: }
11843: }
11844: return $output;
11845: }
11846:
11847: sub instrule_disallow_msg {
1.615 raeburn 11848: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11849: my $response;
11850: my %text = (
11851: item => 'username',
11852: items => 'usernames',
11853: match => 'matches',
11854: do => 'does',
11855: action => 'a username',
11856: one => 'one',
11857: );
11858: if ($count > 1) {
11859: $text{'item'} = 'usernames';
11860: $text{'match'} ='match';
11861: $text{'do'} = 'do';
11862: $text{'action'} = 'usernames',
11863: $text{'one'} = 'ones';
11864: }
11865: if ($checkitem eq 'id') {
11866: $text{'items'} = 'IDs';
11867: $text{'item'} = 'ID';
11868: $text{'action'} = 'an ID';
1.615 raeburn 11869: if ($count > 1) {
11870: $text{'item'} = 'IDs';
11871: $text{'action'} = 'IDs';
11872: }
1.612 raeburn 11873: }
1.674 bisitz 11874: $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 11875: if ($mode eq 'upload') {
11876: if ($checkitem eq 'username') {
11877: $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'}.");
11878: } elsif ($checkitem eq 'id') {
1.674 bisitz 11879: $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 11880: }
1.669 raeburn 11881: } elsif ($mode eq 'selfcreate') {
11882: if ($checkitem eq 'id') {
11883: $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.");
11884: }
1.615 raeburn 11885: } else {
11886: if ($checkitem eq 'username') {
11887: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11888: } elsif ($checkitem eq 'id') {
11889: $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.");
11890: }
1.612 raeburn 11891: }
11892: return $response;
1.585 raeburn 11893: }
11894:
1.624 raeburn 11895: sub personal_data_fieldtitles {
11896: my %fieldtitles = &Apache::lonlocal::texthash (
11897: id => 'Student/Employee ID',
11898: permanentemail => 'E-mail address',
11899: lastname => 'Last Name',
11900: firstname => 'First Name',
11901: middlename => 'Middle Name',
11902: generation => 'Generation',
11903: gen => 'Generation',
1.765 raeburn 11904: inststatus => 'Affiliation',
1.624 raeburn 11905: );
11906: return %fieldtitles;
11907: }
11908:
1.642 raeburn 11909: sub sorted_inst_types {
11910: my ($dom) = @_;
1.1185 raeburn 11911: my ($usertypes,$order);
11912: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
11913: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
11914: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
11915: $order = $domdefaults{'inststatus'}{'inststatusorder'};
11916: } else {
11917: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
11918: }
1.642 raeburn 11919: my $othertitle = &mt('All users');
11920: if ($env{'request.course.id'}) {
1.668 raeburn 11921: $othertitle = &mt('Any users');
1.642 raeburn 11922: }
11923: my @types;
11924: if (ref($order) eq 'ARRAY') {
11925: @types = @{$order};
11926: }
11927: if (@types == 0) {
11928: if (ref($usertypes) eq 'HASH') {
11929: @types = sort(keys(%{$usertypes}));
11930: }
11931: }
11932: if (keys(%{$usertypes}) > 0) {
11933: $othertitle = &mt('Other users');
11934: }
11935: return ($othertitle,$usertypes,\@types);
11936: }
11937:
1.645 raeburn 11938: sub get_institutional_codes {
1.1361 raeburn 11939: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 11940: # Get complete list of course sections to update
11941: my @currsections = ();
11942: my @currxlists = ();
1.1361 raeburn 11943: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 11944: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 11945: my $crskey = $crs.':'.$coursecode;
11946: @{$unclutteredsec{$crskey}} = ();
11947: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 11948:
11949: if ($$settings{'internal.sectionnums'} ne '') {
11950: @currsections = split(/,/,$$settings{'internal.sectionnums'});
11951: }
11952:
11953: if ($$settings{'internal.crosslistings'} ne '') {
11954: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11955: }
11956:
11957: if (@currxlists > 0) {
1.1361 raeburn 11958: foreach my $xl (@currxlists) {
11959: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11960: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 11961: push(@{$allcourses},$1);
1.645 raeburn 11962: $$LC_code{$1} = $2;
11963: }
11964: }
11965: }
11966: }
1.1361 raeburn 11967:
1.645 raeburn 11968: if (@currsections > 0) {
1.1361 raeburn 11969: foreach my $sec (@currsections) {
11970: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11971: my $instsec = $1;
1.645 raeburn 11972: my $lc_sec = $2;
1.1361 raeburn 11973: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11974: push(@{$unclutteredsec{$crskey}},$instsec);
11975: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11976: }
11977: }
11978: }
11979: }
11980:
11981: if (@{$unclutteredsec{$crskey}} > 0) {
11982: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11983: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11984: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11985: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11986: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 11987: push(@{$allcourses},$sec);
1.1361 raeburn 11988: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11989: }
11990: }
11991: }
11992: }
11993: return;
11994: }
11995:
1.971 raeburn 11996: sub get_standard_codeitems {
11997: return ('Year','Semester','Department','Number','Section');
11998: }
11999:
1.112 bowersj2 12000: =pod
12001:
1.780 raeburn 12002: =head1 Slot Helpers
12003:
12004: =over 4
12005:
12006: =item * sorted_slots()
12007:
1.1040 raeburn 12008: Sorts an array of slot names in order of an optional sort key,
12009: default sort is by slot start time (earliest first).
1.780 raeburn 12010:
12011: Inputs:
12012:
12013: =over 4
12014:
12015: slotsarr - Reference to array of unsorted slot names.
12016:
12017: slots - Reference to hash of hash, where outer hash keys are slot names.
12018:
1.1040 raeburn 12019: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
12020:
1.549 albertel 12021: =back
12022:
1.780 raeburn 12023: Returns:
12024:
12025: =over 4
12026:
1.1040 raeburn 12027: sorted - An array of slot names sorted by a specified sort key
12028: (default sort key is start time of the slot).
1.780 raeburn 12029:
12030: =back
12031:
12032: =cut
12033:
12034:
12035: sub sorted_slots {
1.1040 raeburn 12036: my ($slotsarr,$slots,$sortkey) = @_;
12037: if ($sortkey eq '') {
12038: $sortkey = 'starttime';
12039: }
1.780 raeburn 12040: my @sorted;
12041: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
12042: @sorted =
12043: sort {
12044: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 12045: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 12046: }
12047: if (ref($slots->{$a})) { return -1;}
12048: if (ref($slots->{$b})) { return 1;}
12049: return 0;
12050: } @{$slotsarr};
12051: }
12052: return @sorted;
12053: }
12054:
1.1040 raeburn 12055: =pod
12056:
12057: =item * get_future_slots()
12058:
12059: Inputs:
12060:
12061: =over 4
12062:
12063: cnum - course number
12064:
12065: cdom - course domain
12066:
12067: now - current UNIX time
12068:
12069: symb - optional symb
12070:
12071: =back
12072:
12073: Returns:
12074:
12075: =over 4
12076:
12077: sorted_reservable - ref to array of student_schedulable slots currently
12078: reservable, ordered by end date of reservation period.
12079:
12080: reservable_now - ref to hash of student_schedulable slots currently
12081: reservable.
12082:
12083: Keys in inner hash are:
12084: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12085: (b) endreserve: end date of reservation period.
12086: (c) uniqueperiod: start,end dates when slot is to be uniquely
12087: selected.
1.1040 raeburn 12088:
12089: sorted_future - ref to array of student_schedulable slots reservable in
12090: the future, ordered by start date of reservation period.
12091:
12092: future_reservable - ref to hash of student_schedulable slots reservable
12093: in the future.
12094:
12095: Keys in inner hash are:
12096: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12097: (b) startreserve: start date of reservation period.
12098: (c) uniqueperiod: start,end dates when slot is to be uniquely
12099: selected.
1.1040 raeburn 12100:
12101: =back
12102:
12103: =cut
12104:
12105: sub get_future_slots {
12106: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 12107: my $map;
12108: if ($symb) {
12109: ($map) = &Apache::lonnet::decode_symb($symb);
12110: }
1.1040 raeburn 12111: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
12112: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
12113: foreach my $slot (keys(%slots)) {
12114: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
12115: if ($symb) {
1.1229 raeburn 12116: if ($slots{$slot}->{'symb'} ne '') {
12117: my $canuse;
12118: my %oksymbs;
12119: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
12120: map { $oksymbs{$_} = 1; } @slotsymbs;
12121: if ($oksymbs{$symb}) {
12122: $canuse = 1;
12123: } else {
12124: foreach my $item (@slotsymbs) {
12125: if ($item =~ /\.(page|sequence)$/) {
12126: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
12127: if (($map ne '') && ($map eq $sloturl)) {
12128: $canuse = 1;
12129: last;
12130: }
12131: }
12132: }
12133: }
12134: next unless ($canuse);
12135: }
1.1040 raeburn 12136: }
12137: if (($slots{$slot}->{'starttime'} > $now) &&
12138: ($slots{$slot}->{'endtime'} > $now)) {
12139: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
12140: my $userallowed = 0;
12141: if ($slots{$slot}->{'allowedsections'}) {
12142: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
12143: if (!defined($env{'request.role.sec'})
12144: && grep(/^No section assigned$/,@allowed_sec)) {
12145: $userallowed=1;
12146: } else {
12147: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
12148: $userallowed=1;
12149: }
12150: }
12151: unless ($userallowed) {
12152: if (defined($env{'request.course.groups'})) {
12153: my @groups = split(/:/,$env{'request.course.groups'});
12154: foreach my $group (@groups) {
12155: if (grep(/^\Q$group\E$/,@allowed_sec)) {
12156: $userallowed=1;
12157: last;
12158: }
12159: }
12160: }
12161: }
12162: }
12163: if ($slots{$slot}->{'allowedusers'}) {
12164: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
12165: my $user = $env{'user.name'}.':'.$env{'user.domain'};
12166: if (grep(/^\Q$user\E$/,@allowed_users)) {
12167: $userallowed = 1;
12168: }
12169: }
12170: next unless($userallowed);
12171: }
12172: my $startreserve = $slots{$slot}->{'startreserve'};
12173: my $endreserve = $slots{$slot}->{'endreserve'};
12174: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 12175: my $uniqueperiod;
12176: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
12177: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
12178: }
1.1040 raeburn 12179: if (($startreserve < $now) &&
12180: (!$endreserve || $endreserve > $now)) {
12181: my $lastres = $endreserve;
12182: if (!$lastres) {
12183: $lastres = $slots{$slot}->{'starttime'};
12184: }
12185: $reservable_now{$slot} = {
12186: symb => $symb,
1.1250 raeburn 12187: endreserve => $lastres,
12188: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12189: };
12190: } elsif (($startreserve > $now) &&
12191: (!$endreserve || $endreserve > $startreserve)) {
12192: $future_reservable{$slot} = {
12193: symb => $symb,
1.1250 raeburn 12194: startreserve => $startreserve,
12195: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12196: };
12197: }
12198: }
12199: }
12200: my @unsorted_reservable = keys(%reservable_now);
12201: if (@unsorted_reservable > 0) {
12202: @sorted_reservable =
12203: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
12204: }
12205: my @unsorted_future = keys(%future_reservable);
12206: if (@unsorted_future > 0) {
12207: @sorted_future =
12208: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
12209: }
12210: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
12211: }
1.780 raeburn 12212:
12213: =pod
12214:
1.1057 foxr 12215: =back
12216:
1.549 albertel 12217: =head1 HTTP Helpers
12218:
12219: =over 4
12220:
1.648 raeburn 12221: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 12222:
1.258 albertel 12223: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 12224: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 12225: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 12226:
12227: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
12228: $possible_names is an ref to an array of form element names. As an example:
12229: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 12230: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 12231:
12232: =cut
1.1 albertel 12233:
1.6 albertel 12234: sub get_unprocessed_cgi {
1.25 albertel 12235: my ($query,$possible_names)= @_;
1.26 matthew 12236: # $Apache::lonxml::debug=1;
1.356 albertel 12237: foreach my $pair (split(/&/,$query)) {
12238: my ($name, $value) = split(/=/,$pair);
1.369 www 12239: $name = &unescape($name);
1.25 albertel 12240: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
12241: $value =~ tr/+/ /;
12242: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 12243: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 12244: }
1.16 harris41 12245: }
1.6 albertel 12246: }
12247:
1.112 bowersj2 12248: =pod
12249:
1.648 raeburn 12250: =item * &cacheheader()
1.112 bowersj2 12251:
12252: returns cache-controlling header code
12253:
12254: =cut
12255:
1.7 albertel 12256: sub cacheheader {
1.258 albertel 12257: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 12258: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
12259: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 12260: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
12261: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 12262: return $output;
1.7 albertel 12263: }
12264:
1.112 bowersj2 12265: =pod
12266:
1.648 raeburn 12267: =item * &no_cache($r)
1.112 bowersj2 12268:
12269: specifies header code to not have cache
12270:
12271: =cut
12272:
1.9 albertel 12273: sub no_cache {
1.216 albertel 12274: my ($r) = @_;
12275: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 12276: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 12277: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
12278: $r->no_cache(1);
12279: $r->header_out("Expires" => $date);
12280: $r->header_out("Pragma" => "no-cache");
1.123 www 12281: }
12282:
12283: sub content_type {
1.181 albertel 12284: my ($r,$type,$charset) = @_;
1.299 foxr 12285: if ($r) {
12286: # Note that printout.pl calls this with undef for $r.
12287: &no_cache($r);
12288: }
1.258 albertel 12289: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 12290: unless ($charset) {
12291: $charset=&Apache::lonlocal::current_encoding;
12292: }
12293: if ($charset) { $type.='; charset='.$charset; }
12294: if ($r) {
12295: $r->content_type($type);
12296: } else {
12297: print("Content-type: $type\n\n");
12298: }
1.9 albertel 12299: }
1.25 albertel 12300:
1.112 bowersj2 12301: =pod
12302:
1.648 raeburn 12303: =item * &add_to_env($name,$value)
1.112 bowersj2 12304:
1.258 albertel 12305: adds $name to the %env hash with value
1.112 bowersj2 12306: $value, if $name already exists, the entry is converted to an array
12307: reference and $value is added to the array.
12308:
12309: =cut
12310:
1.25 albertel 12311: sub add_to_env {
12312: my ($name,$value)=@_;
1.258 albertel 12313: if (defined($env{$name})) {
12314: if (ref($env{$name})) {
1.25 albertel 12315: #already have multiple values
1.258 albertel 12316: push(@{ $env{$name} },$value);
1.25 albertel 12317: } else {
12318: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 12319: my $first=$env{$name};
12320: undef($env{$name});
12321: push(@{ $env{$name} },$first,$value);
1.25 albertel 12322: }
12323: } else {
1.258 albertel 12324: $env{$name}=$value;
1.25 albertel 12325: }
1.31 albertel 12326: }
1.149 albertel 12327:
12328: =pod
12329:
1.648 raeburn 12330: =item * &get_env_multiple($name)
1.149 albertel 12331:
1.258 albertel 12332: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 12333: values may be defined and end up as an array ref.
12334:
12335: returns an array of values
12336:
12337: =cut
12338:
12339: sub get_env_multiple {
12340: my ($name) = @_;
12341: my @values;
1.258 albertel 12342: if (defined($env{$name})) {
1.149 albertel 12343: # exists is it an array
1.258 albertel 12344: if (ref($env{$name})) {
12345: @values=@{ $env{$name} };
1.149 albertel 12346: } else {
1.258 albertel 12347: $values[0]=$env{$name};
1.149 albertel 12348: }
12349: }
12350: return(@values);
12351: }
12352:
1.1249 damieng 12353: # Looks at given dependencies, and returns something depending on the context.
12354: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
12355: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
12356: # For all other contexts, returns ($output, $counter, $numpathchg).
12357: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
12358: # $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.
12359: # $numpathchg: integer with the number of cleaned up dependency paths.
12360: # \%existing: hash reference clean path -> 1 only for existing dependencies.
12361: # \%mapping: hash reference clean path -> original path for all dependencies.
12362: # @param {string} actionurl - The path to the handler, indicative of the context.
12363: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
12364: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
12365: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
12366: # @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)
12367: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 12368: sub ask_for_embedded_content {
1.1249 damieng 12369: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 12370: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 12371: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 12372: %currsubfile,%unused,$rem);
1.1071 raeburn 12373: my $counter = 0;
12374: my $numnew = 0;
1.987 raeburn 12375: my $numremref = 0;
12376: my $numinvalid = 0;
12377: my $numpathchg = 0;
12378: my $numexisting = 0;
1.1071 raeburn 12379: my $numunused = 0;
12380: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 12381: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 12382: my $heading = &mt('Upload embedded files');
12383: my $buttontext = &mt('Upload');
12384:
1.1249 damieng 12385: # fills these variables based on the context:
12386: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
12387: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 12388: if ($env{'request.course.id'}) {
1.1123 raeburn 12389: if ($actionurl eq '/adm/dependencies') {
12390: $navmap = Apache::lonnavmaps::navmap->new();
12391: }
12392: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
12393: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 12394: }
1.1123 raeburn 12395: if (($actionurl eq '/adm/portfolio') ||
12396: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 12397: my $current_path='/';
12398: if ($env{'form.currentpath'}) {
12399: $current_path = $env{'form.currentpath'};
12400: }
12401: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 12402: $udom = $cdom;
12403: $uname = $cnum;
1.984 raeburn 12404: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
12405: } else {
12406: $udom = $env{'user.domain'};
12407: $uname = $env{'user.name'};
12408: $url = '/userfiles/portfolio';
12409: }
1.987 raeburn 12410: $toplevel = $url.'/';
1.984 raeburn 12411: $url .= $current_path;
12412: $getpropath = 1;
1.987 raeburn 12413: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12414: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12415: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12416: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12417: $toplevel = $url;
1.984 raeburn 12418: if ($rest ne '') {
1.987 raeburn 12419: $url .= $rest;
12420: }
12421: } elsif ($actionurl eq '/adm/coursedocs') {
12422: if (ref($args) eq 'HASH') {
1.1071 raeburn 12423: $url = $args->{'docs_url'};
12424: $toplevel = $url;
1.1084 raeburn 12425: if ($args->{'context'} eq 'paste') {
12426: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12427: ($path) =
12428: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12429: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12430: $fileloc =~ s{^/}{};
12431: }
1.1071 raeburn 12432: }
1.1084 raeburn 12433: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12434: if ($env{'request.course.id'} ne '') {
12435: if (ref($args) eq 'HASH') {
12436: $url = $args->{'docs_url'};
12437: $title = $args->{'docs_title'};
1.1126 raeburn 12438: $toplevel = $url;
12439: unless ($toplevel =~ m{^/}) {
12440: $toplevel = "/$url";
12441: }
1.1085 raeburn 12442: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12443: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12444: $path = $1;
12445: } else {
12446: ($path) =
12447: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12448: }
1.1195 raeburn 12449: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12450: $fileloc = $toplevel;
12451: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12452: my ($udom,$uname,$fname) =
12453: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12454: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12455: } else {
12456: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12457: }
1.1071 raeburn 12458: $fileloc =~ s{^/}{};
12459: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12460: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12461: }
1.987 raeburn 12462: }
1.1123 raeburn 12463: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12464: $udom = $cdom;
12465: $uname = $cnum;
12466: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12467: $toplevel = $url;
12468: $path = $url;
12469: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12470: $fileloc =~ s{^/}{};
1.987 raeburn 12471: }
1.1249 damieng 12472:
12473: # parses the dependency paths to get some info
12474: # fills $newfiles, $mapping, $subdependencies, $dependencies
12475: # $newfiles: hash URL -> 1 for new files or external URLs
12476: # (will be completed later)
12477: # $mapping:
12478: # for external URLs: external URL -> external URL
12479: # for relative paths: clean path -> original path
12480: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12481: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12482: foreach my $file (keys(%{$allfiles})) {
12483: my $embed_file;
12484: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12485: $embed_file = $1;
12486: } else {
12487: $embed_file = $file;
12488: }
1.1158 raeburn 12489: my ($absolutepath,$cleaned_file);
12490: if ($embed_file =~ m{^\w+://}) {
12491: $cleaned_file = $embed_file;
1.1147 raeburn 12492: $newfiles{$cleaned_file} = 1;
12493: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12494: } else {
1.1158 raeburn 12495: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12496: if ($embed_file =~ m{^/}) {
12497: $absolutepath = $embed_file;
12498: }
1.1147 raeburn 12499: if ($cleaned_file =~ m{/}) {
12500: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12501: $path = &check_for_traversal($path,$url,$toplevel);
12502: my $item = $fname;
12503: if ($path ne '') {
12504: $item = $path.'/'.$fname;
12505: $subdependencies{$path}{$fname} = 1;
12506: } else {
12507: $dependencies{$item} = 1;
12508: }
12509: if ($absolutepath) {
12510: $mapping{$item} = $absolutepath;
12511: } else {
12512: $mapping{$item} = $embed_file;
12513: }
12514: } else {
12515: $dependencies{$embed_file} = 1;
12516: if ($absolutepath) {
1.1147 raeburn 12517: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12518: } else {
1.1147 raeburn 12519: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12520: }
12521: }
1.984 raeburn 12522: }
12523: }
1.1249 damieng 12524:
12525: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12526: # and lists
12527: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12528: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12529: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12530: # the path had to be cleaned up
12531: # $existing: hash clean path -> 1 if the file exists
12532: # $numexisting: number of keys in $existing
12533: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12534: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12535: # dependency subdirectories that are
12536: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12537: my $dirptr = 16384;
1.984 raeburn 12538: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12539: $currsubfile{$path} = {};
1.1123 raeburn 12540: if (($actionurl eq '/adm/portfolio') ||
12541: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12542: my ($sublistref,$listerror) =
12543: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12544: if (ref($sublistref) eq 'ARRAY') {
12545: foreach my $line (@{$sublistref}) {
12546: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12547: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12548: }
1.984 raeburn 12549: }
1.987 raeburn 12550: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12551: if (opendir(my $dir,$url.'/'.$path)) {
12552: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12553: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12554: }
1.1084 raeburn 12555: } elsif (($actionurl eq '/adm/dependencies') ||
12556: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12557: ($args->{'context'} eq 'paste')) ||
12558: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12559: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12560: my $dir;
12561: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12562: $dir = $fileloc;
12563: } else {
12564: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12565: }
1.1071 raeburn 12566: if ($dir ne '') {
12567: my ($sublistref,$listerror) =
12568: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12569: if (ref($sublistref) eq 'ARRAY') {
12570: foreach my $line (@{$sublistref}) {
12571: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12572: undef,$mtime)=split(/\&/,$line,12);
12573: unless (($testdir&$dirptr) ||
12574: ($file_name =~ /^\.\.?$/)) {
12575: $currsubfile{$path}{$file_name} = [$size,$mtime];
12576: }
12577: }
12578: }
12579: }
1.984 raeburn 12580: }
12581: }
12582: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12583: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12584: my $item = $path.'/'.$file;
12585: unless ($mapping{$item} eq $item) {
12586: $pathchanges{$item} = 1;
12587: }
12588: $existing{$item} = 1;
12589: $numexisting ++;
12590: } else {
12591: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12592: }
12593: }
1.1071 raeburn 12594: if ($actionurl eq '/adm/dependencies') {
12595: foreach my $path (keys(%currsubfile)) {
12596: if (ref($currsubfile{$path}) eq 'HASH') {
12597: foreach my $file (keys(%{$currsubfile{$path}})) {
12598: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12599: next if (($rem ne '') &&
12600: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12601: (ref($navmap) &&
12602: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12603: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12604: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12605: $unused{$path.'/'.$file} = 1;
12606: }
12607: }
12608: }
12609: }
12610: }
1.984 raeburn 12611: }
1.1249 damieng 12612:
12613: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12614: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12615: my %currfile;
1.1123 raeburn 12616: if (($actionurl eq '/adm/portfolio') ||
12617: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12618: my ($dirlistref,$listerror) =
12619: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12620: if (ref($dirlistref) eq 'ARRAY') {
12621: foreach my $line (@{$dirlistref}) {
12622: my ($file_name,$rest) = split(/\&/,$line,2);
12623: $currfile{$file_name} = 1;
12624: }
1.984 raeburn 12625: }
1.987 raeburn 12626: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12627: if (opendir(my $dir,$url)) {
1.987 raeburn 12628: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12629: map {$currfile{$_} = 1;} @dir_list;
12630: }
1.1084 raeburn 12631: } elsif (($actionurl eq '/adm/dependencies') ||
12632: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12633: ($args->{'context'} eq 'paste')) ||
12634: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12635: if ($env{'request.course.id'} ne '') {
12636: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12637: if ($dir ne '') {
12638: my ($dirlistref,$listerror) =
12639: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12640: if (ref($dirlistref) eq 'ARRAY') {
12641: foreach my $line (@{$dirlistref}) {
12642: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12643: $size,undef,$mtime)=split(/\&/,$line,12);
12644: unless (($testdir&$dirptr) ||
12645: ($file_name =~ /^\.\.?$/)) {
12646: $currfile{$file_name} = [$size,$mtime];
12647: }
12648: }
12649: }
12650: }
12651: }
1.984 raeburn 12652: }
1.1249 damieng 12653: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12654: # are not in subdirectories, using $currfile
1.984 raeburn 12655: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12656: if (exists($currfile{$file})) {
1.987 raeburn 12657: unless ($mapping{$file} eq $file) {
12658: $pathchanges{$file} = 1;
12659: }
12660: $existing{$file} = 1;
12661: $numexisting ++;
12662: } else {
1.984 raeburn 12663: $newfiles{$file} = 1;
12664: }
12665: }
1.1071 raeburn 12666: foreach my $file (keys(%currfile)) {
12667: unless (($file eq $filename) ||
12668: ($file eq $filename.'.bak') ||
12669: ($dependencies{$file})) {
1.1085 raeburn 12670: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 12671: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12672: next if (($rem ne '') &&
12673: (($env{"httpref.$rem".$file} ne '') ||
12674: (ref($navmap) &&
12675: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12676: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12677: ($navmap->getResourceByUrl($rem.$1)))))));
12678: }
1.1085 raeburn 12679: }
1.1071 raeburn 12680: $unused{$file} = 1;
12681: }
12682: }
1.1249 damieng 12683:
12684: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 12685: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12686: ($args->{'context'} eq 'paste')) {
12687: $counter = scalar(keys(%existing));
12688: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 12689: return ($output,$counter,$numpathchg,\%existing);
12690: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12691: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12692: $counter = scalar(keys(%existing));
12693: $numpathchg = scalar(keys(%pathchanges));
12694: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 12695: }
1.1249 damieng 12696:
12697: # returns HTML otherwise, with dependency results and to ask for more uploads
12698:
12699: # $upload_output: missing dependencies (with upload form)
12700: # $modify_output: uploaded dependencies (in use)
12701: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 12702: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12703: if ($actionurl eq '/adm/dependencies') {
12704: next if ($embed_file =~ m{^\w+://});
12705: }
1.660 raeburn 12706: $upload_output .= &start_data_table_row().
1.1123 raeburn 12707: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12708: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12709: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 12710: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12711: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12712: }
1.1123 raeburn 12713: $upload_output .= '</td>';
1.1071 raeburn 12714: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 12715: $upload_output.='<td align="right">'.
12716: '<span class="LC_info LC_fontsize_medium">'.
12717: &mt("URL points to web address").'</span>';
1.987 raeburn 12718: $numremref++;
1.660 raeburn 12719: } elsif ($args->{'error_on_invalid_names'}
12720: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 12721: $upload_output.='<td align="right"><span class="LC_warning">'.
12722: &mt('Invalid characters').'</span>';
1.987 raeburn 12723: $numinvalid++;
1.660 raeburn 12724: } else {
1.1123 raeburn 12725: $upload_output .= '<td>'.
12726: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12727: $embed_file,\%mapping,
1.1071 raeburn 12728: $allfiles,$codebase,'upload');
12729: $counter ++;
12730: $numnew ++;
1.987 raeburn 12731: }
12732: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12733: }
12734: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12735: if ($actionurl eq '/adm/dependencies') {
12736: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12737: $modify_output .= &start_data_table_row().
12738: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12739: '<img src="'.&icon($embed_file).'" border="0" />'.
12740: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12741: '<td>'.$size.'</td>'.
12742: '<td>'.$mtime.'</td>'.
12743: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12744: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12745: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12746: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12747: &embedded_file_element('upload_embedded',$counter,
12748: $embed_file,\%mapping,
12749: $allfiles,$codebase,'modify').
12750: '</div></td>'.
12751: &end_data_table_row()."\n";
12752: $counter ++;
12753: } else {
12754: $upload_output .= &start_data_table_row().
1.1123 raeburn 12755: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12756: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12757: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12758: &Apache::loncommon::end_data_table_row()."\n";
12759: }
12760: }
12761: my $delidx = $counter;
12762: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12763: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12764: $delete_output .= &start_data_table_row().
12765: '<td><img src="'.&icon($oldfile).'" />'.
12766: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12767: '<td>'.$size.'</td>'.
12768: '<td>'.$mtime.'</td>'.
12769: '<td><label><input type="checkbox" name="del_upload_dep" '.
12770: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12771: &embedded_file_element('upload_embedded',$delidx,
12772: $oldfile,\%mapping,$allfiles,
12773: $codebase,'delete').'</td>'.
12774: &end_data_table_row()."\n";
12775: $numunused ++;
12776: $delidx ++;
1.987 raeburn 12777: }
12778: if ($upload_output) {
12779: $upload_output = &start_data_table().
12780: $upload_output.
12781: &end_data_table()."\n";
12782: }
1.1071 raeburn 12783: if ($modify_output) {
12784: $modify_output = &start_data_table().
12785: &start_data_table_header_row().
12786: '<th>'.&mt('File').'</th>'.
12787: '<th>'.&mt('Size (KB)').'</th>'.
12788: '<th>'.&mt('Modified').'</th>'.
12789: '<th>'.&mt('Upload replacement?').'</th>'.
12790: &end_data_table_header_row().
12791: $modify_output.
12792: &end_data_table()."\n";
12793: }
12794: if ($delete_output) {
12795: $delete_output = &start_data_table().
12796: &start_data_table_header_row().
12797: '<th>'.&mt('File').'</th>'.
12798: '<th>'.&mt('Size (KB)').'</th>'.
12799: '<th>'.&mt('Modified').'</th>'.
12800: '<th>'.&mt('Delete?').'</th>'.
12801: &end_data_table_header_row().
12802: $delete_output.
12803: &end_data_table()."\n";
12804: }
1.987 raeburn 12805: my $applies = 0;
12806: if ($numremref) {
12807: $applies ++;
12808: }
12809: if ($numinvalid) {
12810: $applies ++;
12811: }
12812: if ($numexisting) {
12813: $applies ++;
12814: }
1.1071 raeburn 12815: if ($counter || $numunused) {
1.987 raeburn 12816: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12817: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12818: $state.'<h3>'.$heading.'</h3>';
12819: if ($actionurl eq '/adm/dependencies') {
12820: if ($numnew) {
12821: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12822: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12823: $upload_output.'<br />'."\n";
12824: }
12825: if ($numexisting) {
12826: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12827: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12828: $modify_output.'<br />'."\n";
12829: $buttontext = &mt('Save changes');
12830: }
12831: if ($numunused) {
12832: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12833: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12834: $delete_output.'<br />'."\n";
12835: $buttontext = &mt('Save changes');
12836: }
12837: } else {
12838: $output .= $upload_output.'<br />'."\n";
12839: }
12840: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12841: $counter.'" />'."\n";
12842: if ($actionurl eq '/adm/dependencies') {
12843: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12844: $numnew.'" />'."\n";
12845: } elsif ($actionurl eq '') {
1.987 raeburn 12846: $output .= '<input type="hidden" name="phase" value="three" />';
12847: }
12848: } elsif ($applies) {
12849: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12850: if ($applies > 1) {
12851: $output .=
1.1123 raeburn 12852: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12853: if ($numremref) {
12854: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12855: }
12856: if ($numinvalid) {
12857: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12858: }
12859: if ($numexisting) {
12860: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12861: }
12862: $output .= '</ul><br />';
12863: } elsif ($numremref) {
12864: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12865: } elsif ($numinvalid) {
12866: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12867: } elsif ($numexisting) {
12868: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12869: }
12870: $output .= $upload_output.'<br />';
12871: }
12872: my ($pathchange_output,$chgcount);
1.1071 raeburn 12873: $chgcount = $counter;
1.987 raeburn 12874: if (keys(%pathchanges) > 0) {
12875: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12876: if ($counter) {
1.987 raeburn 12877: $output .= &embedded_file_element('pathchange',$chgcount,
12878: $embed_file,\%mapping,
1.1071 raeburn 12879: $allfiles,$codebase,'change');
1.987 raeburn 12880: } else {
12881: $pathchange_output .=
12882: &start_data_table_row().
12883: '<td><input type ="checkbox" name="namechange" value="'.
12884: $chgcount.'" checked="checked" /></td>'.
12885: '<td>'.$mapping{$embed_file}.'</td>'.
12886: '<td>'.$embed_file.
12887: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12888: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12889: '</td>'.&end_data_table_row();
1.660 raeburn 12890: }
1.987 raeburn 12891: $numpathchg ++;
12892: $chgcount ++;
1.660 raeburn 12893: }
12894: }
1.1127 raeburn 12895: if (($counter) || ($numunused)) {
1.987 raeburn 12896: if ($numpathchg) {
12897: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12898: $numpathchg.'" />'."\n";
12899: }
12900: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12901: ($actionurl eq '/adm/imsimport')) {
12902: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12903: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12904: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12905: } elsif ($actionurl eq '/adm/dependencies') {
12906: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12907: }
1.1123 raeburn 12908: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 12909: } elsif ($numpathchg) {
12910: my %pathchange = ();
12911: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
12912: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12913: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 12914: }
1.987 raeburn 12915: }
1.1071 raeburn 12916: return ($output,$counter,$numpathchg);
1.987 raeburn 12917: }
12918:
1.1147 raeburn 12919: =pod
12920:
12921: =item * clean_path($name)
12922:
12923: Performs clean-up of directories, subdirectories and filename in an
12924: embedded object, referenced in an HTML file which is being uploaded
12925: to a course or portfolio, where
12926: "Upload embedded images/multimedia files if HTML file" checkbox was
12927: checked.
12928:
12929: Clean-up is similar to replacements in lonnet::clean_filename()
12930: except each / between sub-directory and next level is preserved.
12931:
12932: =cut
12933:
12934: sub clean_path {
12935: my ($embed_file) = @_;
12936: $embed_file =~s{^/+}{};
12937: my @contents;
12938: if ($embed_file =~ m{/}) {
12939: @contents = split(/\//,$embed_file);
12940: } else {
12941: @contents = ($embed_file);
12942: }
12943: my $lastidx = scalar(@contents)-1;
12944: for (my $i=0; $i<=$lastidx; $i++) {
12945: $contents[$i]=~s{\\}{/}g;
12946: $contents[$i]=~s/\s+/\_/g;
12947: $contents[$i]=~s{[^/\w\.\-]}{}g;
12948: if ($i == $lastidx) {
12949: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
12950: }
12951: }
12952: if ($lastidx > 0) {
12953: return join('/',@contents);
12954: } else {
12955: return $contents[0];
12956: }
12957: }
12958:
1.987 raeburn 12959: sub embedded_file_element {
1.1071 raeburn 12960: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 12961: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
12962: (ref($codebase) eq 'HASH'));
12963: my $output;
1.1071 raeburn 12964: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 12965: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12966: }
12967: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12968: &escape($embed_file).'" />';
12969: unless (($context eq 'upload_embedded') &&
12970: ($mapping->{$embed_file} eq $embed_file)) {
12971: $output .='
12972: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12973: }
12974: my $attrib;
12975: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12976: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12977: }
12978: $output .=
12979: "\n\t\t".
12980: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12981: $attrib.'" />';
12982: if (exists($codebase->{$mapping->{$embed_file}})) {
12983: $output .=
12984: "\n\t\t".
12985: '<input name="codebase_'.$num.'" type="hidden" value="'.
12986: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12987: }
1.987 raeburn 12988: return $output;
1.660 raeburn 12989: }
12990:
1.1071 raeburn 12991: sub get_dependency_details {
12992: my ($currfile,$currsubfile,$embed_file) = @_;
12993: my ($size,$mtime,$showsize,$showmtime);
12994: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12995: if ($embed_file =~ m{/}) {
12996: my ($path,$fname) = split(/\//,$embed_file);
12997: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12998: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12999: }
13000: } else {
13001: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
13002: ($size,$mtime) = @{$currfile->{$embed_file}};
13003: }
13004: }
13005: $showsize = $size/1024.0;
13006: $showsize = sprintf("%.1f",$showsize);
13007: if ($mtime > 0) {
13008: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
13009: }
13010: }
13011: return ($showsize,$showmtime);
13012: }
13013:
13014: sub ask_embedded_js {
13015: return <<"END";
13016: <script type="text/javascript"">
13017: // <![CDATA[
13018: function toggleBrowse(counter) {
13019: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
13020: var fileid = document.getElementById('embedded_item_'+counter);
13021: var uploaddivid = document.getElementById('moduploaddep_'+counter);
13022: if (chkboxid.checked == true) {
13023: uploaddivid.style.display='block';
13024: } else {
13025: uploaddivid.style.display='none';
13026: fileid.value = '';
13027: }
13028: }
13029: // ]]>
13030: </script>
13031:
13032: END
13033: }
13034:
1.661 raeburn 13035: sub upload_embedded {
13036: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 13037: $current_disk_usage,$hiddenstate,$actionurl) = @_;
13038: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 13039: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
13040: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
13041: my $orig_uploaded_filename =
13042: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 13043: foreach my $type ('orig','ref','attrib','codebase') {
13044: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
13045: $env{'form.embedded_'.$type.'_'.$i} =
13046: &unescape($env{'form.embedded_'.$type.'_'.$i});
13047: }
13048: }
1.661 raeburn 13049: my ($path,$fname) =
13050: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
13051: # no path, whole string is fname
13052: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
13053: $fname = &Apache::lonnet::clean_filename($fname);
13054: # See if there is anything left
13055: next if ($fname eq '');
13056:
13057: # Check if file already exists as a file or directory.
13058: my ($state,$msg);
13059: if ($context eq 'portfolio') {
13060: my $port_path = $dirpath;
13061: if ($group ne '') {
13062: $port_path = "groups/$group/$port_path";
13063: }
1.987 raeburn 13064: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
13065: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 13066: $dir_root,$port_path,$disk_quota,
13067: $current_disk_usage,$uname,$udom);
13068: if ($state eq 'will_exceed_quota'
1.984 raeburn 13069: || $state eq 'file_locked') {
1.661 raeburn 13070: $output .= $msg;
13071: next;
13072: }
13073: } elsif (($context eq 'author') || ($context eq 'testbank')) {
13074: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
13075: if ($state eq 'exists') {
13076: $output .= $msg;
13077: next;
13078: }
13079: }
13080: # Check if extension is valid
13081: if (($fname =~ /\.(\w+)$/) &&
13082: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 13083: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
13084: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 13085: next;
13086: } elsif (($fname =~ /\.(\w+)$/) &&
13087: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 13088: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 13089: next;
13090: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 13091: $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 13092: next;
13093: }
13094: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 13095: my $subdir = $path;
13096: $subdir =~ s{/+$}{};
1.661 raeburn 13097: if ($context eq 'portfolio') {
1.984 raeburn 13098: my $result;
13099: if ($state eq 'existingfile') {
13100: $result=
13101: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 13102: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 13103: } else {
1.984 raeburn 13104: $result=
13105: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 13106: $dirpath.
1.1123 raeburn 13107: $env{'form.currentpath'}.$subdir);
1.984 raeburn 13108: if ($result !~ m|^/uploaded/|) {
13109: $output .= '<span class="LC_error">'
13110: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13111: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13112: .'</span><br />';
13113: next;
13114: } else {
1.987 raeburn 13115: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13116: $path.$fname.'</span>').'<br />';
1.984 raeburn 13117: }
1.661 raeburn 13118: }
1.1123 raeburn 13119: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 13120: my $extendedsubdir = $dirpath.'/'.$subdir;
13121: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 13122: my $result =
1.1126 raeburn 13123: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 13124: if ($result !~ m|^/uploaded/|) {
13125: $output .= '<span class="LC_error">'
13126: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13127: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13128: .'</span><br />';
13129: next;
13130: } else {
13131: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13132: $path.$fname.'</span>').'<br />';
1.1125 raeburn 13133: if ($context eq 'syllabus') {
13134: &Apache::lonnet::make_public_indefinitely($result);
13135: }
1.987 raeburn 13136: }
1.661 raeburn 13137: } else {
13138: # Save the file
13139: my $target = $env{'form.embedded_item_'.$i};
13140: my $fullpath = $dir_root.$dirpath.'/'.$path;
13141: my $dest = $fullpath.$fname;
13142: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 13143: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 13144: my $count;
13145: my $filepath = $dir_root;
1.1027 raeburn 13146: foreach my $subdir (@parts) {
13147: $filepath .= "/$subdir";
13148: if (!-e $filepath) {
1.661 raeburn 13149: mkdir($filepath,0770);
13150: }
13151: }
13152: my $fh;
13153: if (!open($fh,'>'.$dest)) {
13154: &Apache::lonnet::logthis('Failed to create '.$dest);
13155: $output .= '<span class="LC_error">'.
1.1071 raeburn 13156: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
13157: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13158: '</span><br />';
13159: } else {
13160: if (!print $fh $env{'form.embedded_item_'.$i}) {
13161: &Apache::lonnet::logthis('Failed to write to '.$dest);
13162: $output .= '<span class="LC_error">'.
1.1071 raeburn 13163: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
13164: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13165: '</span><br />';
13166: } else {
1.987 raeburn 13167: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13168: $url.'</span>').'<br />';
13169: unless ($context eq 'testbank') {
13170: $footer .= &mt('View embedded file: [_1]',
13171: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
13172: }
13173: }
13174: close($fh);
13175: }
13176: }
13177: if ($env{'form.embedded_ref_'.$i}) {
13178: $pathchange{$i} = 1;
13179: }
13180: }
13181: if ($output) {
13182: $output = '<p>'.$output.'</p>';
13183: }
13184: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
13185: $returnflag = 'ok';
1.1071 raeburn 13186: my $numpathchgs = scalar(keys(%pathchange));
13187: if ($numpathchgs > 0) {
1.987 raeburn 13188: if ($context eq 'portfolio') {
13189: $output .= '<p>'.&mt('or').'</p>';
13190: } elsif ($context eq 'testbank') {
1.1071 raeburn 13191: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
13192: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 13193: $returnflag = 'modify_orightml';
13194: }
13195: }
1.1071 raeburn 13196: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 13197: }
13198:
13199: sub modify_html_form {
13200: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
13201: my $end = 0;
13202: my $modifyform;
13203: if ($context eq 'upload_embedded') {
13204: return unless (ref($pathchange) eq 'HASH');
13205: if ($env{'form.number_embedded_items'}) {
13206: $end += $env{'form.number_embedded_items'};
13207: }
13208: if ($env{'form.number_pathchange_items'}) {
13209: $end += $env{'form.number_pathchange_items'};
13210: }
13211: if ($end) {
13212: for (my $i=0; $i<$end; $i++) {
13213: if ($i < $env{'form.number_embedded_items'}) {
13214: next unless($pathchange->{$i});
13215: }
13216: $modifyform .=
13217: &start_data_table_row().
13218: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
13219: 'checked="checked" /></td>'.
13220: '<td>'.$env{'form.embedded_ref_'.$i}.
13221: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
13222: &escape($env{'form.embedded_ref_'.$i}).'" />'.
13223: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
13224: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
13225: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
13226: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
13227: '<td>'.$env{'form.embedded_orig_'.$i}.
13228: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
13229: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
13230: &end_data_table_row();
1.1071 raeburn 13231: }
1.987 raeburn 13232: }
13233: } else {
13234: $modifyform = $pathchgtable;
13235: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
13236: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
13237: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
13238: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
13239: }
13240: }
13241: if ($modifyform) {
1.1071 raeburn 13242: if ($actionurl eq '/adm/dependencies') {
13243: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
13244: }
1.987 raeburn 13245: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
13246: '<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".
13247: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
13248: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
13249: '</ol></p>'."\n".'<p>'.
13250: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
13251: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
13252: &start_data_table()."\n".
13253: &start_data_table_header_row().
13254: '<th>'.&mt('Change?').'</th>'.
13255: '<th>'.&mt('Current reference').'</th>'.
13256: '<th>'.&mt('Required reference').'</th>'.
13257: &end_data_table_header_row()."\n".
13258: $modifyform.
13259: &end_data_table().'<br />'."\n".$hiddenstate.
13260: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
13261: '</form>'."\n";
13262: }
13263: return;
13264: }
13265:
13266: sub modify_html_refs {
1.1123 raeburn 13267: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 13268: my $container;
13269: if ($context eq 'portfolio') {
13270: $container = $env{'form.container'};
13271: } elsif ($context eq 'coursedoc') {
13272: $container = $env{'form.primaryurl'};
1.1071 raeburn 13273: } elsif ($context eq 'manage_dependencies') {
13274: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
13275: $container = "/$container";
1.1123 raeburn 13276: } elsif ($context eq 'syllabus') {
13277: $container = $url;
1.987 raeburn 13278: } else {
1.1027 raeburn 13279: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 13280: }
13281: my (%allfiles,%codebase,$output,$content);
13282: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 13283: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 13284: if (wantarray) {
13285: return ('',0,0);
13286: } else {
13287: return;
13288: }
13289: }
13290: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13291: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 13292: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
13293: if (wantarray) {
13294: return ('',0,0);
13295: } else {
13296: return;
13297: }
13298: }
1.987 raeburn 13299: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 13300: if ($content eq '-1') {
13301: if (wantarray) {
13302: return ('',0,0);
13303: } else {
13304: return;
13305: }
13306: }
1.987 raeburn 13307: } else {
1.1071 raeburn 13308: unless ($container =~ /^\Q$dir_root\E/) {
13309: if (wantarray) {
13310: return ('',0,0);
13311: } else {
13312: return;
13313: }
13314: }
1.1317 raeburn 13315: if (open(my $fh,'<',$container)) {
1.987 raeburn 13316: $content = join('', <$fh>);
13317: close($fh);
13318: } else {
1.1071 raeburn 13319: if (wantarray) {
13320: return ('',0,0);
13321: } else {
13322: return;
13323: }
1.987 raeburn 13324: }
13325: }
13326: my ($count,$codebasecount) = (0,0);
13327: my $mm = new File::MMagic;
13328: my $mime_type = $mm->checktype_contents($content);
13329: if ($mime_type eq 'text/html') {
13330: my $parse_result =
13331: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
13332: \%codebase,\$content);
13333: if ($parse_result eq 'ok') {
13334: foreach my $i (@changes) {
13335: my $orig = &unescape($env{'form.embedded_orig_'.$i});
13336: my $ref = &unescape($env{'form.embedded_ref_'.$i});
13337: if ($allfiles{$ref}) {
13338: my $newname = $orig;
13339: my ($attrib_regexp,$codebase);
1.1006 raeburn 13340: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 13341: if ($attrib_regexp =~ /:/) {
13342: $attrib_regexp =~ s/\:/|/g;
13343: }
13344: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13345: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13346: $count += $numchg;
1.1123 raeburn 13347: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 13348: delete($allfiles{$ref});
1.987 raeburn 13349: }
13350: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 13351: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 13352: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
13353: $codebasecount ++;
13354: }
13355: }
13356: }
1.1123 raeburn 13357: my $skiprewrites;
1.987 raeburn 13358: if ($count || $codebasecount) {
13359: my $saveresult;
1.1071 raeburn 13360: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13361: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 13362: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13363: if ($url eq $container) {
13364: my ($fname) = ($container =~ m{/([^/]+)$});
13365: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13366: $count,'<span class="LC_filename">'.
1.1071 raeburn 13367: $fname.'</span>').'</p>';
1.987 raeburn 13368: } else {
13369: $output = '<p class="LC_error">'.
13370: &mt('Error: update failed for: [_1].',
13371: '<span class="LC_filename">'.
13372: $container.'</span>').'</p>';
13373: }
1.1123 raeburn 13374: if ($context eq 'syllabus') {
13375: unless ($saveresult eq 'ok') {
13376: $skiprewrites = 1;
13377: }
13378: }
1.987 raeburn 13379: } else {
1.1317 raeburn 13380: if (open(my $fh,'>',$container)) {
1.987 raeburn 13381: print $fh $content;
13382: close($fh);
13383: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13384: $count,'<span class="LC_filename">'.
13385: $container.'</span>').'</p>';
1.661 raeburn 13386: } else {
1.987 raeburn 13387: $output = '<p class="LC_error">'.
13388: &mt('Error: could not update [_1].',
13389: '<span class="LC_filename">'.
13390: $container.'</span>').'</p>';
1.661 raeburn 13391: }
13392: }
13393: }
1.1123 raeburn 13394: if (($context eq 'syllabus') && (!$skiprewrites)) {
13395: my ($actionurl,$state);
13396: $actionurl = "/public/$udom/$uname/syllabus";
13397: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
13398: &ask_for_embedded_content($actionurl,$state,\%allfiles,
13399: \%codebase,
13400: {'context' => 'rewrites',
13401: 'ignore_remote_references' => 1,});
13402: if (ref($mapping) eq 'HASH') {
13403: my $rewrites = 0;
13404: foreach my $key (keys(%{$mapping})) {
13405: next if ($key =~ m{^https?://});
13406: my $ref = $mapping->{$key};
13407: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13408: my $attrib;
13409: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13410: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13411: }
13412: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13413: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13414: $rewrites += $numchg;
13415: }
13416: }
13417: if ($rewrites) {
13418: my $saveresult;
13419: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13420: if ($url eq $container) {
13421: my ($fname) = ($container =~ m{/([^/]+)$});
13422: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13423: $count,'<span class="LC_filename">'.
13424: $fname.'</span>').'</p>';
13425: } else {
13426: $output .= '<p class="LC_error">'.
13427: &mt('Error: could not update links in [_1].',
13428: '<span class="LC_filename">'.
13429: $container.'</span>').'</p>';
13430:
13431: }
13432: }
13433: }
13434: }
1.987 raeburn 13435: } else {
13436: &logthis('Failed to parse '.$container.
13437: ' to modify references: '.$parse_result);
1.661 raeburn 13438: }
13439: }
1.1071 raeburn 13440: if (wantarray) {
13441: return ($output,$count,$codebasecount);
13442: } else {
13443: return $output;
13444: }
1.661 raeburn 13445: }
13446:
13447: sub check_for_existing {
13448: my ($path,$fname,$element) = @_;
13449: my ($state,$msg);
13450: if (-d $path.'/'.$fname) {
13451: $state = 'exists';
13452: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13453: } elsif (-e $path.'/'.$fname) {
13454: $state = 'exists';
13455: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13456: }
13457: if ($state eq 'exists') {
13458: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13459: }
13460: return ($state,$msg);
13461: }
13462:
13463: sub check_for_upload {
13464: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13465: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13466: my $filesize = length($env{'form.'.$element});
13467: if (!$filesize) {
13468: my $msg = '<span class="LC_error">'.
13469: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13470: '<span class="LC_filename">'.$fname.'</span>',
13471: $filesize).'<br />'.
1.1007 raeburn 13472: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13473: '</span>';
13474: return ('zero_bytes',$msg);
13475: }
13476: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13477: my $getpropath = 1;
1.1021 raeburn 13478: my ($dirlistref,$listerror) =
13479: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13480: my $found_file = 0;
13481: my $locked_file = 0;
1.991 raeburn 13482: my @lockers;
13483: my $navmap;
13484: if ($env{'request.course.id'}) {
13485: $navmap = Apache::lonnavmaps::navmap->new();
13486: }
1.1021 raeburn 13487: if (ref($dirlistref) eq 'ARRAY') {
13488: foreach my $line (@{$dirlistref}) {
13489: my ($file_name,$rest)=split(/\&/,$line,2);
13490: if ($file_name eq $fname){
13491: $file_name = $path.$file_name;
13492: if ($group ne '') {
13493: $file_name = $group.$file_name;
13494: }
13495: $found_file = 1;
13496: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13497: foreach my $lock (@lockers) {
13498: if (ref($lock) eq 'ARRAY') {
13499: my ($symb,$crsid) = @{$lock};
13500: if ($crsid eq $env{'request.course.id'}) {
13501: if (ref($navmap)) {
13502: my $res = $navmap->getBySymb($symb);
13503: foreach my $part (@{$res->parts()}) {
13504: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13505: unless (($slot_status == $res->RESERVED) ||
13506: ($slot_status == $res->RESERVED_LOCATION)) {
13507: $locked_file = 1;
13508: }
1.991 raeburn 13509: }
1.1021 raeburn 13510: } else {
13511: $locked_file = 1;
1.991 raeburn 13512: }
13513: } else {
13514: $locked_file = 1;
13515: }
13516: }
1.1021 raeburn 13517: }
13518: } else {
13519: my @info = split(/\&/,$rest);
13520: my $currsize = $info[6]/1000;
13521: if ($currsize < $filesize) {
13522: my $extra = $filesize - $currsize;
13523: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13524: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13525: &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 13526: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13527: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13528: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13529: return ('will_exceed_quota',$msg);
13530: }
1.984 raeburn 13531: }
13532: }
1.661 raeburn 13533: }
13534: }
13535: }
13536: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13537: my $msg = '<p class="LC_warning">'.
13538: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13539: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13540: return ('will_exceed_quota',$msg);
13541: } elsif ($found_file) {
13542: if ($locked_file) {
1.1179 bisitz 13543: my $msg = '<p class="LC_warning">';
1.661 raeburn 13544: $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 13545: $msg .= '</p>';
1.661 raeburn 13546: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13547: return ('file_locked',$msg);
13548: } else {
1.1179 bisitz 13549: my $msg = '<p class="LC_error">';
1.984 raeburn 13550: $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 13551: $msg .= '</p>';
1.984 raeburn 13552: return ('existingfile',$msg);
1.661 raeburn 13553: }
13554: }
13555: }
13556:
1.987 raeburn 13557: sub check_for_traversal {
13558: my ($path,$url,$toplevel) = @_;
13559: my @parts=split(/\//,$path);
13560: my $cleanpath;
13561: my $fullpath = $url;
13562: for (my $i=0;$i<@parts;$i++) {
13563: next if ($parts[$i] eq '.');
13564: if ($parts[$i] eq '..') {
13565: $fullpath =~ s{([^/]+/)$}{};
13566: } else {
13567: $fullpath .= $parts[$i].'/';
13568: }
13569: }
13570: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13571: $cleanpath = $1;
13572: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13573: my $curr_toprel = $1;
13574: my @parts = split(/\//,$curr_toprel);
13575: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13576: my @urlparts = split(/\//,$url_toprel);
13577: my $doubledots;
13578: my $startdiff = -1;
13579: for (my $i=0; $i<@urlparts; $i++) {
13580: if ($startdiff == -1) {
13581: unless ($urlparts[$i] eq $parts[$i]) {
13582: $startdiff = $i;
13583: $doubledots .= '../';
13584: }
13585: } else {
13586: $doubledots .= '../';
13587: }
13588: }
13589: if ($startdiff > -1) {
13590: $cleanpath = $doubledots;
13591: for (my $i=$startdiff; $i<@parts; $i++) {
13592: $cleanpath .= $parts[$i].'/';
13593: }
13594: }
13595: }
13596: $cleanpath =~ s{(/)$}{};
13597: return $cleanpath;
13598: }
1.31 albertel 13599:
1.1053 raeburn 13600: sub is_archive_file {
13601: my ($mimetype) = @_;
13602: if (($mimetype eq 'application/octet-stream') ||
13603: ($mimetype eq 'application/x-stuffit') ||
13604: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13605: return 1;
13606: }
13607: return;
13608: }
13609:
13610: sub decompress_form {
1.1065 raeburn 13611: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13612: my %lt = &Apache::lonlocal::texthash (
13613: this => 'This file is an archive file.',
1.1067 raeburn 13614: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13615: itsc => 'Its contents are as follows:',
1.1053 raeburn 13616: youm => 'You may wish to extract its contents.',
13617: extr => 'Extract contents',
1.1067 raeburn 13618: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13619: proa => 'Process automatically?',
1.1053 raeburn 13620: yes => 'Yes',
13621: no => 'No',
1.1067 raeburn 13622: fold => 'Title for folder containing movie',
13623: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13624: );
1.1065 raeburn 13625: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13626: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13627: my $info = &list_archive_contents($fileloc,\@paths);
13628: if (@paths) {
13629: foreach my $path (@paths) {
13630: $path =~ s{^/}{};
1.1067 raeburn 13631: if ($path =~ m{^([^/]+)/$}) {
13632: $topdir = $1;
13633: }
1.1065 raeburn 13634: if ($path =~ m{^([^/]+)/}) {
13635: $toplevel{$1} = $path;
13636: } else {
13637: $toplevel{$path} = $path;
13638: }
13639: }
13640: }
1.1067 raeburn 13641: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13642: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13643: "$topdir/media/",
13644: "$topdir/media/$topdir.mp4",
13645: "$topdir/media/FirstFrame.png",
13646: "$topdir/media/player.swf",
13647: "$topdir/media/swfobject.js",
13648: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13649: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13650: "$topdir/$topdir.mp4",
13651: "$topdir/$topdir\_config.xml",
13652: "$topdir/$topdir\_controller.swf",
13653: "$topdir/$topdir\_embed.css",
13654: "$topdir/$topdir\_First_Frame.png",
13655: "$topdir/$topdir\_player.html",
13656: "$topdir/$topdir\_Thumbnails.png",
13657: "$topdir/playerProductInstall.swf",
13658: "$topdir/scripts/",
13659: "$topdir/scripts/config_xml.js",
13660: "$topdir/scripts/handlebars.js",
13661: "$topdir/scripts/jquery-1.7.1.min.js",
13662: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13663: "$topdir/scripts/modernizr.js",
13664: "$topdir/scripts/player-min.js",
13665: "$topdir/scripts/swfobject.js",
13666: "$topdir/skins/",
13667: "$topdir/skins/configuration_express.xml",
13668: "$topdir/skins/express_show/",
13669: "$topdir/skins/express_show/player-min.css",
13670: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 13671: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13672: "$topdir/$topdir.mp4",
13673: "$topdir/$topdir\_config.xml",
13674: "$topdir/$topdir\_controller.swf",
13675: "$topdir/$topdir\_embed.css",
13676: "$topdir/$topdir\_First_Frame.png",
13677: "$topdir/$topdir\_player.html",
13678: "$topdir/$topdir\_Thumbnails.png",
13679: "$topdir/playerProductInstall.swf",
13680: "$topdir/scripts/",
13681: "$topdir/scripts/config_xml.js",
13682: "$topdir/scripts/techsmith-smart-player.min.js",
13683: "$topdir/skins/",
13684: "$topdir/skins/configuration_express.xml",
13685: "$topdir/skins/express_show/",
13686: "$topdir/skins/express_show/spritesheet.min.css",
13687: "$topdir/skins/express_show/spritesheet.png",
13688: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 13689: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13690: if (@diffs == 0) {
1.1164 raeburn 13691: $is_camtasia = 6;
13692: } else {
1.1197 raeburn 13693: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 13694: if (@diffs == 0) {
13695: $is_camtasia = 8;
1.1197 raeburn 13696: } else {
13697: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13698: if (@diffs == 0) {
13699: $is_camtasia = 8;
13700: }
1.1164 raeburn 13701: }
1.1067 raeburn 13702: }
13703: }
13704: my $output;
13705: if ($is_camtasia) {
13706: $output = <<"ENDCAM";
13707: <script type="text/javascript" language="Javascript">
13708: // <![CDATA[
13709:
13710: function camtasiaToggle() {
13711: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13712: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 13713: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13714: document.getElementById('camtasia_titles').style.display='block';
13715: } else {
13716: document.getElementById('camtasia_titles').style.display='none';
13717: }
13718: }
13719: }
13720: return;
13721: }
13722:
13723: // ]]>
13724: </script>
13725: <p>$lt{'camt'}</p>
13726: ENDCAM
1.1065 raeburn 13727: } else {
1.1067 raeburn 13728: $output = '<p>'.$lt{'this'};
13729: if ($info eq '') {
13730: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13731: } else {
13732: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13733: '<div><pre>'.$info.'</pre></div>';
13734: }
1.1065 raeburn 13735: }
1.1067 raeburn 13736: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13737: my $duplicates;
13738: my $num = 0;
13739: if (ref($dirlist) eq 'ARRAY') {
13740: foreach my $item (@{$dirlist}) {
13741: if (ref($item) eq 'ARRAY') {
13742: if (exists($toplevel{$item->[0]})) {
13743: $duplicates .=
13744: &start_data_table_row().
13745: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13746: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13747: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13748: 'value="1" />'.&mt('Yes').'</label>'.
13749: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13750: '<td>'.$item->[0].'</td>';
13751: if ($item->[2]) {
13752: $duplicates .= '<td>'.&mt('Directory').'</td>';
13753: } else {
13754: $duplicates .= '<td>'.&mt('File').'</td>';
13755: }
13756: $duplicates .= '<td>'.$item->[3].'</td>'.
13757: '<td>'.
13758: &Apache::lonlocal::locallocaltime($item->[4]).
13759: '</td>'.
13760: &end_data_table_row();
13761: $num ++;
13762: }
13763: }
13764: }
13765: }
13766: my $itemcount;
13767: if (@paths > 0) {
13768: $itemcount = scalar(@paths);
13769: } else {
13770: $itemcount = 1;
13771: }
1.1067 raeburn 13772: if ($is_camtasia) {
13773: $output .= $lt{'auto'}.'<br />'.
13774: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 13775: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13776: $lt{'yes'}.'</label> <label>'.
13777: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13778: $lt{'no'}.'</label></span><br />'.
13779: '<div id="camtasia_titles" style="display:block">'.
13780: &Apache::lonhtmlcommon::start_pick_box().
13781: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13782: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13783: &Apache::lonhtmlcommon::row_closure().
13784: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13785: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13786: &Apache::lonhtmlcommon::row_closure(1).
13787: &Apache::lonhtmlcommon::end_pick_box().
13788: '</div>';
13789: }
1.1065 raeburn 13790: $output .=
13791: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13792: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13793: "\n";
1.1065 raeburn 13794: if ($duplicates ne '') {
13795: $output .= '<p><span class="LC_warning">'.
13796: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13797: &start_data_table().
13798: &start_data_table_header_row().
13799: '<th>'.&mt('Overwrite?').'</th>'.
13800: '<th>'.&mt('Name').'</th>'.
13801: '<th>'.&mt('Type').'</th>'.
13802: '<th>'.&mt('Size').'</th>'.
13803: '<th>'.&mt('Last modified').'</th>'.
13804: &end_data_table_header_row().
13805: $duplicates.
13806: &end_data_table().
13807: '</p>';
13808: }
1.1067 raeburn 13809: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13810: if (ref($hiddenelements) eq 'HASH') {
13811: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13812: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13813: }
13814: }
13815: $output .= <<"END";
1.1067 raeburn 13816: <br />
1.1053 raeburn 13817: <input type="submit" name="decompress" value="$lt{'extr'}" />
13818: </form>
13819: $noextract
13820: END
13821: return $output;
13822: }
13823:
1.1065 raeburn 13824: sub decompression_utility {
13825: my ($program) = @_;
13826: my @utilities = ('tar','gunzip','bunzip2','unzip');
13827: my $location;
13828: if (grep(/^\Q$program\E$/,@utilities)) {
13829: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13830: '/usr/sbin/') {
13831: if (-x $dir.$program) {
13832: $location = $dir.$program;
13833: last;
13834: }
13835: }
13836: }
13837: return $location;
13838: }
13839:
13840: sub list_archive_contents {
13841: my ($file,$pathsref) = @_;
13842: my (@cmd,$output);
13843: my $needsregexp;
13844: if ($file =~ /\.zip$/) {
13845: @cmd = (&decompression_utility('unzip'),"-l");
13846: $needsregexp = 1;
13847: } elsif (($file =~ m/\.tar\.gz$/) ||
13848: ($file =~ /\.tgz$/)) {
13849: @cmd = (&decompression_utility('tar'),"-ztf");
13850: } elsif ($file =~ /\.tar\.bz2$/) {
13851: @cmd = (&decompression_utility('tar'),"-jtf");
13852: } elsif ($file =~ m|\.tar$|) {
13853: @cmd = (&decompression_utility('tar'),"-tf");
13854: }
13855: if (@cmd) {
13856: undef($!);
13857: undef($@);
13858: if (open(my $fh,"-|", @cmd, $file)) {
13859: while (my $line = <$fh>) {
13860: $output .= $line;
13861: chomp($line);
13862: my $item;
13863: if ($needsregexp) {
13864: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13865: } else {
13866: $item = $line;
13867: }
13868: if ($item ne '') {
13869: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13870: push(@{$pathsref},$item);
13871: }
13872: }
13873: }
13874: close($fh);
13875: }
13876: }
13877: return $output;
13878: }
13879:
1.1053 raeburn 13880: sub decompress_uploaded_file {
13881: my ($file,$dir) = @_;
13882: &Apache::lonnet::appenv({'cgi.file' => $file});
13883: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13884: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13885: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13886: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13887: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13888: my $decompressed = $env{'cgi.decompressed'};
13889: &Apache::lonnet::delenv('cgi.file');
13890: &Apache::lonnet::delenv('cgi.dir');
13891: &Apache::lonnet::delenv('cgi.decompressed');
13892: return ($decompressed,$result);
13893: }
13894:
1.1055 raeburn 13895: sub process_decompression {
13896: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 13897: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13898: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13899: &mt('Unexpected file path.').'</p>'."\n";
13900: }
13901: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13902: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13903: &mt('Unexpected course context.').'</p>'."\n";
13904: }
1.1293 raeburn 13905: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 13906: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13907: &mt('Filename contained unexpected characters.').'</p>'."\n";
13908: }
1.1055 raeburn 13909: my ($dir,$error,$warning,$output);
1.1180 raeburn 13910: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 13911: $error = &mt('Filename not a supported archive file type.').
13912: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 13913: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
13914: } else {
13915: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13916: if ($docuhome eq 'no_host') {
13917: $error = &mt('Could not determine home server for course.');
13918: } else {
13919: my @ids=&Apache::lonnet::current_machine_ids();
13920: my $currdir = "$dir_root/$destination";
13921: if (grep(/^\Q$docuhome\E$/,@ids)) {
13922: $dir = &LONCAPA::propath($docudom,$docuname).
13923: "$dir_root/$destination";
13924: } else {
13925: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
13926: "$dir_root/$docudom/$docuname/$destination";
13927: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
13928: $error = &mt('Archive file not found.');
13929: }
13930: }
1.1065 raeburn 13931: my (@to_overwrite,@to_skip);
13932: if ($env{'form.archive_overwrite_total'} > 0) {
13933: my $total = $env{'form.archive_overwrite_total'};
13934: for (my $i=0; $i<$total; $i++) {
13935: if ($env{'form.archive_overwrite_'.$i} == 1) {
13936: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
13937: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
13938: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
13939: }
13940: }
13941: }
13942: my $numskip = scalar(@to_skip);
1.1292 raeburn 13943: my $numoverwrite = scalar(@to_overwrite);
13944: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 13945: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
13946: } elsif ($dir eq '') {
1.1055 raeburn 13947: $error = &mt('Directory containing archive file unavailable.');
13948: } elsif (!$error) {
1.1065 raeburn 13949: my ($decompressed,$display);
1.1292 raeburn 13950: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 13951: my $tempdir = time.'_'.$$.int(rand(10000));
13952: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 13953: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
13954: ($decompressed,$display) =
13955: &decompress_uploaded_file($file,"$dir/$tempdir");
13956: foreach my $item (@to_skip) {
13957: if (($item ne '') && ($item !~ /\.\./)) {
13958: if (-f "$dir/$tempdir/$item") {
13959: unlink("$dir/$tempdir/$item");
13960: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 13961: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 13962: }
13963: }
13964: }
13965: foreach my $item (@to_overwrite) {
13966: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13967: if (($item ne '') && ($item !~ /\.\./)) {
13968: if (-f "$dir/$item") {
13969: unlink("$dir/$item");
13970: } elsif (-d "$dir/$item") {
1.1300 raeburn 13971: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 13972: }
13973: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13974: }
1.1065 raeburn 13975: }
13976: }
1.1292 raeburn 13977: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 13978: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 13979: }
1.1065 raeburn 13980: }
13981: } else {
13982: ($decompressed,$display) =
13983: &decompress_uploaded_file($file,$dir);
13984: }
1.1055 raeburn 13985: if ($decompressed eq 'ok') {
1.1065 raeburn 13986: $output = '<p class="LC_info">'.
13987: &mt('Files extracted successfully from archive.').
13988: '</p>'."\n";
1.1055 raeburn 13989: my ($warning,$result,@contents);
13990: my ($newdirlistref,$newlisterror) =
13991: &Apache::lonnet::dirlist($currdir,$docudom,
13992: $docuname,1);
13993: my (%is_dir,%changes,@newitems);
13994: my $dirptr = 16384;
1.1065 raeburn 13995: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13996: foreach my $dir_line (@{$newdirlistref}) {
13997: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 13998: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13999: push(@newitems,$item);
14000: if ($dirptr&$testdir) {
14001: $is_dir{$item} = 1;
14002: }
14003: $changes{$item} = 1;
14004: }
14005: }
14006: }
14007: if (keys(%changes) > 0) {
14008: foreach my $item (sort(@newitems)) {
14009: if ($changes{$item}) {
14010: push(@contents,$item);
14011: }
14012: }
14013: }
14014: if (@contents > 0) {
1.1067 raeburn 14015: my $wantform;
14016: unless ($env{'form.autoextract_camtasia'}) {
14017: $wantform = 1;
14018: }
1.1056 raeburn 14019: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 14020: my ($count,$datatable) = &get_extracted($docudom,$docuname,
14021: $currdir,\%is_dir,
14022: \%children,\%parent,
1.1056 raeburn 14023: \@contents,\%dirorder,
14024: \%titles,$wantform);
1.1055 raeburn 14025: if ($datatable ne '') {
14026: $output .= &archive_options_form('decompressed',$datatable,
14027: $count,$hiddenelem);
1.1065 raeburn 14028: my $startcount = 6;
1.1055 raeburn 14029: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 14030: \%titles,\%children);
1.1055 raeburn 14031: }
1.1067 raeburn 14032: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 14033: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 14034: my %displayed;
14035: my $total = 1;
14036: $env{'form.archive_directory'} = [];
14037: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
14038: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
14039: $path =~ s{/$}{};
14040: my $item;
14041: if ($path ne '') {
14042: $item = "$path/$titles{$i}";
14043: } else {
14044: $item = $titles{$i};
14045: }
14046: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
14047: if ($item eq $contents[0]) {
14048: push(@{$env{'form.archive_directory'}},$i);
14049: $env{'form.archive_'.$i} = 'display';
14050: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
14051: $displayed{'folder'} = $i;
1.1164 raeburn 14052: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
14053: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 14054: $env{'form.archive_'.$i} = 'display';
14055: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
14056: $displayed{'web'} = $i;
14057: } else {
1.1164 raeburn 14058: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
14059: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
14060: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 14061: push(@{$env{'form.archive_directory'}},$i);
14062: }
14063: $env{'form.archive_'.$i} = 'dependency';
14064: }
14065: $total ++;
14066: }
14067: for (my $i=1; $i<$total; $i++) {
14068: next if ($i == $displayed{'web'});
14069: next if ($i == $displayed{'folder'});
14070: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
14071: }
14072: $env{'form.phase'} = 'decompress_cleanup';
14073: $env{'form.archivedelete'} = 1;
14074: $env{'form.archive_count'} = $total-1;
14075: $output .=
14076: &process_extracted_files('coursedocs',$docudom,
14077: $docuname,$destination,
14078: $dir_root,$hiddenelem);
14079: }
1.1055 raeburn 14080: } else {
14081: $warning = &mt('No new items extracted from archive file.');
14082: }
14083: } else {
14084: $output = $display;
14085: $error = &mt('An error occurred during extraction from the archive file.');
14086: }
14087: }
14088: }
14089: }
14090: if ($error) {
14091: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14092: $error.'</p>'."\n";
14093: }
14094: if ($warning) {
14095: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14096: }
14097: return $output;
14098: }
14099:
14100: sub get_extracted {
1.1056 raeburn 14101: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
14102: $titles,$wantform) = @_;
1.1055 raeburn 14103: my $count = 0;
14104: my $depth = 0;
14105: my $datatable;
1.1056 raeburn 14106: my @hierarchy;
1.1055 raeburn 14107: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 14108: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
14109: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 14110: foreach my $item (@{$contents}) {
14111: $count ++;
1.1056 raeburn 14112: @{$dirorder->{$count}} = @hierarchy;
14113: $titles->{$count} = $item;
1.1055 raeburn 14114: &archive_hierarchy($depth,$count,$parent,$children);
14115: if ($wantform) {
14116: $datatable .= &archive_row($is_dir->{$item},$item,
14117: $currdir,$depth,$count);
14118: }
14119: if ($is_dir->{$item}) {
14120: $depth ++;
1.1056 raeburn 14121: push(@hierarchy,$count);
14122: $parent->{$depth} = $count;
1.1055 raeburn 14123: $datatable .=
14124: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 14125: \$depth,\$count,\@hierarchy,$dirorder,
14126: $children,$parent,$titles,$wantform);
1.1055 raeburn 14127: $depth --;
1.1056 raeburn 14128: pop(@hierarchy);
1.1055 raeburn 14129: }
14130: }
14131: return ($count,$datatable);
14132: }
14133:
14134: sub recurse_extracted_archive {
1.1056 raeburn 14135: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
14136: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 14137: my $result='';
1.1056 raeburn 14138: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
14139: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
14140: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 14141: return $result;
14142: }
14143: my $dirptr = 16384;
14144: my ($newdirlistref,$newlisterror) =
14145: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
14146: if (ref($newdirlistref) eq 'ARRAY') {
14147: foreach my $dir_line (@{$newdirlistref}) {
14148: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
14149: unless ($item =~ /^\.+$/) {
14150: $$count ++;
1.1056 raeburn 14151: @{$dirorder->{$$count}} = @{$hierarchy};
14152: $titles->{$$count} = $item;
1.1055 raeburn 14153: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 14154:
1.1055 raeburn 14155: my $is_dir;
14156: if ($dirptr&$testdir) {
14157: $is_dir = 1;
14158: }
14159: if ($wantform) {
14160: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
14161: }
14162: if ($is_dir) {
14163: $$depth ++;
1.1056 raeburn 14164: push(@{$hierarchy},$$count);
14165: $parent->{$$depth} = $$count;
1.1055 raeburn 14166: $result .=
14167: &recurse_extracted_archive("$currdir/$item",$docudom,
14168: $docuname,$depth,$count,
1.1056 raeburn 14169: $hierarchy,$dirorder,$children,
14170: $parent,$titles,$wantform);
1.1055 raeburn 14171: $$depth --;
1.1056 raeburn 14172: pop(@{$hierarchy});
1.1055 raeburn 14173: }
14174: }
14175: }
14176: }
14177: return $result;
14178: }
14179:
14180: sub archive_hierarchy {
14181: my ($depth,$count,$parent,$children) =@_;
14182: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
14183: if (exists($parent->{$depth})) {
14184: $children->{$parent->{$depth}} .= $count.':';
14185: }
14186: }
14187: return;
14188: }
14189:
14190: sub archive_row {
14191: my ($is_dir,$item,$currdir,$depth,$count) = @_;
14192: my ($name) = ($item =~ m{([^/]+)$});
14193: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 14194: 'display' => 'Add as file',
1.1055 raeburn 14195: 'dependency' => 'Include as dependency',
14196: 'discard' => 'Discard',
14197: );
14198: if ($is_dir) {
1.1059 raeburn 14199: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 14200: }
1.1056 raeburn 14201: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
14202: my $offset = 0;
1.1055 raeburn 14203: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 14204: $offset ++;
1.1065 raeburn 14205: if ($action ne 'display') {
14206: $offset ++;
14207: }
1.1055 raeburn 14208: $output .= '<td><span class="LC_nobreak">'.
14209: '<label><input type="radio" name="archive_'.$count.
14210: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
14211: my $text = $choices{$action};
14212: if ($is_dir) {
14213: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
14214: if ($action eq 'display') {
1.1059 raeburn 14215: $text = &mt('Add as folder');
1.1055 raeburn 14216: }
1.1056 raeburn 14217: } else {
14218: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
14219:
14220: }
14221: $output .= ' /> '.$choices{$action}.'</label></span>';
14222: if ($action eq 'dependency') {
14223: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
14224: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
14225: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
14226: '<option value=""></option>'."\n".
14227: '</select>'."\n".
14228: '</div>';
1.1059 raeburn 14229: } elsif ($action eq 'display') {
14230: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
14231: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
14232: '</div>';
1.1055 raeburn 14233: }
1.1056 raeburn 14234: $output .= '</td>';
1.1055 raeburn 14235: }
14236: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
14237: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
14238: for (my $i=0; $i<$depth; $i++) {
14239: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
14240: }
14241: if ($is_dir) {
14242: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
14243: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
14244: } else {
14245: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
14246: }
14247: $output .= ' '.$name.'</td>'."\n".
14248: &end_data_table_row();
14249: return $output;
14250: }
14251:
14252: sub archive_options_form {
1.1065 raeburn 14253: my ($form,$display,$count,$hiddenelem) = @_;
14254: my %lt = &Apache::lonlocal::texthash(
14255: perm => 'Permanently remove archive file?',
14256: hows => 'How should each extracted item be incorporated in the course?',
14257: cont => 'Content actions for all',
14258: addf => 'Add as folder/file',
14259: incd => 'Include as dependency for a displayed file',
14260: disc => 'Discard',
14261: no => 'No',
14262: yes => 'Yes',
14263: save => 'Save',
14264: );
14265: my $output = <<"END";
14266: <form name="$form" method="post" action="">
14267: <p><span class="LC_nobreak">$lt{'perm'}
14268: <label>
14269: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
14270: </label>
14271:
14272: <label>
14273: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
14274: </span>
14275: </p>
14276: <input type="hidden" name="phase" value="decompress_cleanup" />
14277: <br />$lt{'hows'}
14278: <div class="LC_columnSection">
14279: <fieldset>
14280: <legend>$lt{'cont'}</legend>
14281: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
14282: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
14283: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
14284: </fieldset>
14285: </div>
14286: END
14287: return $output.
1.1055 raeburn 14288: &start_data_table()."\n".
1.1065 raeburn 14289: $display."\n".
1.1055 raeburn 14290: &end_data_table()."\n".
14291: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
14292: $hiddenelem.
1.1065 raeburn 14293: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 14294: '</form>';
14295: }
14296:
14297: sub archive_javascript {
1.1056 raeburn 14298: my ($startcount,$numitems,$titles,$children) = @_;
14299: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 14300: my $maintitle = $env{'form.comment'};
1.1055 raeburn 14301: my $scripttag = <<START;
14302: <script type="text/javascript">
14303: // <![CDATA[
14304:
14305: function checkAll(form,prefix) {
14306: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
14307: for (var i=0; i < form.elements.length; i++) {
14308: var id = form.elements[i].id;
14309: if ((id != '') && (id != undefined)) {
14310: if (idstr.test(id)) {
14311: if (form.elements[i].type == 'radio') {
14312: form.elements[i].checked = true;
1.1056 raeburn 14313: var nostart = i-$startcount;
1.1059 raeburn 14314: var offset = nostart%7;
14315: var count = (nostart-offset)/7;
1.1056 raeburn 14316: dependencyCheck(form,count,offset);
1.1055 raeburn 14317: }
14318: }
14319: }
14320: }
14321: }
14322:
14323: function propagateCheck(form,count) {
14324: if (count > 0) {
1.1059 raeburn 14325: var startelement = $startcount + ((count-1) * 7);
14326: for (var j=1; j<6; j++) {
14327: if ((j != 2) && (j != 4)) {
1.1056 raeburn 14328: var item = startelement + j;
14329: if (form.elements[item].type == 'radio') {
14330: if (form.elements[item].checked) {
14331: containerCheck(form,count,j);
14332: break;
14333: }
1.1055 raeburn 14334: }
14335: }
14336: }
14337: }
14338: }
14339:
14340: numitems = $numitems
1.1056 raeburn 14341: var titles = new Array(numitems);
14342: var parents = new Array(numitems);
1.1055 raeburn 14343: for (var i=0; i<numitems; i++) {
1.1056 raeburn 14344: parents[i] = new Array;
1.1055 raeburn 14345: }
1.1059 raeburn 14346: var maintitle = '$maintitle';
1.1055 raeburn 14347:
14348: START
14349:
1.1056 raeburn 14350: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
14351: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 14352: for (my $i=0; $i<@contents; $i ++) {
14353: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
14354: }
14355: }
14356:
1.1056 raeburn 14357: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
14358: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
14359: }
14360:
1.1055 raeburn 14361: $scripttag .= <<END;
14362:
14363: function containerCheck(form,count,offset) {
14364: if (count > 0) {
1.1056 raeburn 14365: dependencyCheck(form,count,offset);
1.1059 raeburn 14366: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 14367: form.elements[item].checked = true;
14368: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
14369: if (parents[count].length > 0) {
14370: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 14371: containerCheck(form,parents[count][j],offset);
14372: }
14373: }
14374: }
14375: }
14376: }
14377:
14378: function dependencyCheck(form,count,offset) {
14379: if (count > 0) {
1.1059 raeburn 14380: var chosen = (offset+$startcount)+7*(count-1);
14381: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 14382: var currtype = form.elements[depitem].type;
14383: if (form.elements[chosen].value == 'dependency') {
14384: document.getElementById('arc_depon_'+count).style.display='block';
14385: form.elements[depitem].options.length = 0;
14386: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 14387: for (var i=1; i<=numitems; i++) {
14388: if (i == count) {
14389: continue;
14390: }
1.1059 raeburn 14391: var startelement = $startcount + (i-1) * 7;
14392: for (var j=1; j<6; j++) {
14393: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 14394: var item = startelement + j;
14395: if (form.elements[item].type == 'radio') {
14396: if (form.elements[item].checked) {
14397: if (form.elements[item].value == 'display') {
14398: var n = form.elements[depitem].options.length;
14399: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
14400: }
14401: }
14402: }
14403: }
14404: }
14405: }
14406: } else {
14407: document.getElementById('arc_depon_'+count).style.display='none';
14408: form.elements[depitem].options.length = 0;
14409: form.elements[depitem].options[0] = new Option('Select','',true,true);
14410: }
1.1059 raeburn 14411: titleCheck(form,count,offset);
1.1056 raeburn 14412: }
14413: }
14414:
14415: function propagateSelect(form,count,offset) {
14416: if (count > 0) {
1.1065 raeburn 14417: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14418: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14419: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14420: if (parents[count].length > 0) {
14421: for (var j=0; j<parents[count].length; j++) {
14422: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14423: }
14424: }
14425: }
14426: }
14427: }
1.1056 raeburn 14428:
14429: function containerSelect(form,count,offset,picked) {
14430: if (count > 0) {
1.1065 raeburn 14431: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14432: if (form.elements[item].type == 'radio') {
14433: if (form.elements[item].value == 'dependency') {
14434: if (form.elements[item+1].type == 'select-one') {
14435: for (var i=0; i<form.elements[item+1].options.length; i++) {
14436: if (form.elements[item+1].options[i].value == picked) {
14437: form.elements[item+1].selectedIndex = i;
14438: break;
14439: }
14440: }
14441: }
14442: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14443: if (parents[count].length > 0) {
14444: for (var j=0; j<parents[count].length; j++) {
14445: containerSelect(form,parents[count][j],offset,picked);
14446: }
14447: }
14448: }
14449: }
14450: }
14451: }
14452: }
14453:
1.1059 raeburn 14454: function titleCheck(form,count,offset) {
14455: if (count > 0) {
14456: var chosen = (offset+$startcount)+7*(count-1);
14457: var depitem = $startcount + ((count-1) * 7) + 2;
14458: var currtype = form.elements[depitem].type;
14459: if (form.elements[chosen].value == 'display') {
14460: document.getElementById('arc_title_'+count).style.display='block';
14461: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14462: document.getElementById('archive_title_'+count).value=maintitle;
14463: }
14464: } else {
14465: document.getElementById('arc_title_'+count).style.display='none';
14466: if (currtype == 'text') {
14467: document.getElementById('archive_title_'+count).value='';
14468: }
14469: }
14470: }
14471: return;
14472: }
14473:
1.1055 raeburn 14474: // ]]>
14475: </script>
14476: END
14477: return $scripttag;
14478: }
14479:
14480: sub process_extracted_files {
1.1067 raeburn 14481: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14482: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14483: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14484: my @ids=&Apache::lonnet::current_machine_ids();
14485: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14486: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14487: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14488: if (grep(/^\Q$docuhome\E$/,@ids)) {
14489: $prefix = &LONCAPA::propath($docudom,$docuname);
14490: $pathtocheck = "$dir_root/$destination";
14491: $dir = $dir_root;
14492: $ishome = 1;
14493: } else {
14494: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14495: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14496: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14497: }
14498: my $currdir = "$dir_root/$destination";
14499: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14500: if ($env{'form.folderpath'}) {
14501: my @items = split('&',$env{'form.folderpath'});
14502: $folders{'0'} = $items[-2];
1.1099 raeburn 14503: if ($env{'form.folderpath'} =~ /\:1$/) {
14504: $containers{'0'}='page';
14505: } else {
14506: $containers{'0'}='sequence';
14507: }
1.1055 raeburn 14508: }
14509: my @archdirs = &get_env_multiple('form.archive_directory');
14510: if ($numitems) {
14511: for (my $i=1; $i<=$numitems; $i++) {
14512: my $path = $env{'form.archive_content_'.$i};
14513: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14514: my $item = $1;
14515: $toplevelitems{$item} = $i;
14516: if (grep(/^\Q$i\E$/,@archdirs)) {
14517: $is_dir{$item} = 1;
14518: }
14519: }
14520: }
14521: }
1.1067 raeburn 14522: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14523: if (keys(%toplevelitems) > 0) {
14524: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14525: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14526: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14527: }
1.1066 raeburn 14528: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14529: if ($numitems) {
14530: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14531: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14532: my $path = $env{'form.archive_content_'.$i};
14533: if ($path =~ /^\Q$pathtocheck\E/) {
14534: if ($env{'form.archive_'.$i} eq 'discard') {
14535: if ($prefix ne '' && $path ne '') {
14536: if (-e $prefix.$path) {
1.1066 raeburn 14537: if ((@archdirs > 0) &&
14538: (grep(/^\Q$i\E$/,@archdirs))) {
14539: $todeletedir{$prefix.$path} = 1;
14540: } else {
14541: $todelete{$prefix.$path} = 1;
14542: }
1.1055 raeburn 14543: }
14544: }
14545: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14546: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14547: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14548: $docstitle = $env{'form.archive_title_'.$i};
14549: if ($docstitle eq '') {
14550: $docstitle = $title;
14551: }
1.1055 raeburn 14552: $outer = 0;
1.1056 raeburn 14553: if (ref($dirorder{$i}) eq 'ARRAY') {
14554: if (@{$dirorder{$i}} > 0) {
14555: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14556: if ($env{'form.archive_'.$item} eq 'display') {
14557: $outer = $item;
14558: last;
14559: }
14560: }
14561: }
14562: }
14563: my ($errtext,$fatal) =
14564: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14565: '/'.$folders{$outer}.'.'.
14566: $containers{$outer});
14567: next if ($fatal);
14568: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14569: if ($context eq 'coursedocs') {
1.1056 raeburn 14570: $mapinner{$i} = time;
1.1055 raeburn 14571: $folders{$i} = 'default_'.$mapinner{$i};
14572: $containers{$i} = 'sequence';
14573: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14574: $folders{$i}.'.'.$containers{$i};
14575: my $newidx = &LONCAPA::map::getresidx();
14576: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14577: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14578: push(@LONCAPA::map::order,$newidx);
14579: my ($outtext,$errtext) =
14580: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14581: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14582: '.'.$containers{$outer},1,1);
1.1056 raeburn 14583: $newseqid{$i} = $newidx;
1.1067 raeburn 14584: unless ($errtext) {
1.1294 raeburn 14585: $result .= '<li>'.&mt('Folder: [_1] added to course',
14586: &HTML::Entities::encode($docstitle,'<>&"')).
14587: '</li>'."\n";
1.1067 raeburn 14588: }
1.1055 raeburn 14589: }
14590: } else {
14591: if ($context eq 'coursedocs') {
14592: my $newidx=&LONCAPA::map::getresidx();
14593: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14594: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14595: $title;
1.1392 raeburn 14596: if (($outer !~ /\D/) &&
14597: (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
14598: ($newidx !~ /\D/)) {
1.1294 raeburn 14599: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14600: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14601: }
14602: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14603: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14604: }
14605: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14606: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14607: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14608: unless ($ishome) {
14609: my $fetch = "$newdest{$i}/$title";
14610: $fetch =~ s/^\Q$prefix$dir\E//;
14611: $prompttofetch{$fetch} = 1;
14612: }
1.1292 raeburn 14613: }
1.1067 raeburn 14614: }
1.1294 raeburn 14615: $LONCAPA::map::resources[$newidx]=
14616: $docstitle.':'.$url.':false:normal:res';
14617: push(@LONCAPA::map::order, $newidx);
14618: my ($outtext,$errtext)=
14619: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14620: $docuname.'/'.$folders{$outer}.
14621: '.'.$containers{$outer},1,1);
14622: unless ($errtext) {
14623: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14624: $result .= '<li>'.&mt('File: [_1] added to course',
14625: &HTML::Entities::encode($docstitle,'<>&"')).
14626: '</li>'."\n";
14627: }
1.1067 raeburn 14628: }
1.1294 raeburn 14629: } else {
14630: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14631: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14632: }
1.1055 raeburn 14633: }
14634: }
1.1086 raeburn 14635: }
14636: } else {
1.1294 raeburn 14637: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14638: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14639: }
14640: }
14641: for (my $i=1; $i<=$numitems; $i++) {
14642: next unless ($env{'form.archive_'.$i} eq 'dependency');
14643: my $path = $env{'form.archive_content_'.$i};
14644: if ($path =~ /^\Q$pathtocheck\E/) {
14645: my ($title) = ($path =~ m{/([^/]+)$});
14646: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14647: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14648: if (ref($dirorder{$i}) eq 'ARRAY') {
14649: my ($itemidx,$fullpath,$relpath);
14650: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14651: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14652: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14653: if ($dirorder{$i}->[$j] eq $container) {
14654: $itemidx = $j;
1.1056 raeburn 14655: }
14656: }
1.1086 raeburn 14657: }
14658: if ($itemidx eq '') {
14659: $itemidx = 0;
14660: }
14661: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14662: if ($mapinner{$referrer{$i}}) {
14663: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14664: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14665: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14666: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14667: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14668: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14669: if (!-e $fullpath) {
14670: mkdir($fullpath,0755);
1.1056 raeburn 14671: }
14672: }
1.1086 raeburn 14673: } else {
14674: last;
1.1056 raeburn 14675: }
1.1086 raeburn 14676: }
14677: }
14678: } elsif ($newdest{$referrer{$i}}) {
14679: $fullpath = $newdest{$referrer{$i}};
14680: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14681: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14682: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14683: last;
14684: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14685: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14686: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14687: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14688: if (!-e $fullpath) {
14689: mkdir($fullpath,0755);
1.1056 raeburn 14690: }
14691: }
1.1086 raeburn 14692: } else {
14693: last;
1.1056 raeburn 14694: }
1.1055 raeburn 14695: }
14696: }
1.1086 raeburn 14697: if ($fullpath ne '') {
14698: if (-e "$prefix$path") {
1.1292 raeburn 14699: unless (rename("$prefix$path","$fullpath/$title")) {
14700: $warning .= &mt('Failed to rename dependency').'<br />';
14701: }
1.1086 raeburn 14702: }
14703: if (-e "$fullpath/$title") {
14704: my $showpath;
14705: if ($relpath ne '') {
14706: $showpath = "$relpath/$title";
14707: } else {
14708: $showpath = "/$title";
14709: }
1.1294 raeburn 14710: $result .= '<li>'.&mt('[_1] included as a dependency',
14711: &HTML::Entities::encode($showpath,'<>&"')).
14712: '</li>'."\n";
1.1292 raeburn 14713: unless ($ishome) {
14714: my $fetch = "$fullpath/$title";
14715: $fetch =~ s/^\Q$prefix$dir\E//;
14716: $prompttofetch{$fetch} = 1;
14717: }
1.1086 raeburn 14718: }
14719: }
1.1055 raeburn 14720: }
1.1086 raeburn 14721: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14722: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 14723: &HTML::Entities::encode($path,'<>&"'),
14724: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14725: '<br />';
1.1055 raeburn 14726: }
14727: } else {
1.1294 raeburn 14728: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 14729: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14730: }
14731: }
14732: if (keys(%todelete)) {
14733: foreach my $key (keys(%todelete)) {
14734: unlink($key);
1.1066 raeburn 14735: }
14736: }
14737: if (keys(%todeletedir)) {
14738: foreach my $key (keys(%todeletedir)) {
14739: rmdir($key);
14740: }
14741: }
14742: foreach my $dir (sort(keys(%is_dir))) {
14743: if (($pathtocheck ne '') && ($dir ne '')) {
14744: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14745: }
14746: }
1.1067 raeburn 14747: if ($result ne '') {
14748: $output .= '<ul>'."\n".
14749: $result."\n".
14750: '</ul>';
14751: }
14752: unless ($ishome) {
14753: my $replicationfail;
14754: foreach my $item (keys(%prompttofetch)) {
14755: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14756: unless ($fetchresult eq 'ok') {
14757: $replicationfail .= '<li>'.$item.'</li>'."\n";
14758: }
14759: }
14760: if ($replicationfail) {
14761: $output .= '<p class="LC_error">'.
14762: &mt('Course home server failed to retrieve:').'<ul>'.
14763: $replicationfail.
14764: '</ul></p>';
14765: }
14766: }
1.1055 raeburn 14767: } else {
14768: $warning = &mt('No items found in archive.');
14769: }
14770: if ($error) {
14771: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14772: $error.'</p>'."\n";
14773: }
14774: if ($warning) {
14775: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14776: }
14777: return $output;
14778: }
14779:
1.1066 raeburn 14780: sub cleanup_empty_dirs {
14781: my ($path) = @_;
14782: if (($path ne '') && (-d $path)) {
14783: if (opendir(my $dirh,$path)) {
14784: my @dircontents = grep(!/^\./,readdir($dirh));
14785: my $numitems = 0;
14786: foreach my $item (@dircontents) {
14787: if (-d "$path/$item") {
1.1111 raeburn 14788: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14789: if (-e "$path/$item") {
14790: $numitems ++;
14791: }
14792: } else {
14793: $numitems ++;
14794: }
14795: }
14796: if ($numitems == 0) {
14797: rmdir($path);
14798: }
14799: closedir($dirh);
14800: }
14801: }
14802: return;
14803: }
14804:
1.41 ng 14805: =pod
1.45 matthew 14806:
1.1162 raeburn 14807: =item * &get_folder_hierarchy()
1.1068 raeburn 14808:
14809: Provides hierarchy of names of folders/sub-folders containing the current
14810: item,
14811:
14812: Inputs: 3
14813: - $navmap - navmaps object
14814:
14815: - $map - url for map (either the trigger itself, or map containing
14816: the resource, which is the trigger).
14817:
14818: - $showitem - 1 => show title for map itself; 0 => do not show.
14819:
14820: Outputs: 1 @pathitems - array of folder/subfolder names.
14821:
14822: =cut
14823:
14824: sub get_folder_hierarchy {
14825: my ($navmap,$map,$showitem) = @_;
14826: my @pathitems;
14827: if (ref($navmap)) {
14828: my $mapres = $navmap->getResourceByUrl($map);
14829: if (ref($mapres)) {
14830: my $pcslist = $mapres->map_hierarchy();
14831: if ($pcslist ne '') {
14832: my @pcs = split(/,/,$pcslist);
14833: foreach my $pc (@pcs) {
14834: if ($pc == 1) {
1.1129 raeburn 14835: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14836: } else {
14837: my $res = $navmap->getByMapPc($pc);
14838: if (ref($res)) {
14839: my $title = $res->compTitle();
14840: $title =~ s/\W+/_/g;
14841: if ($title ne '') {
14842: push(@pathitems,$title);
14843: }
14844: }
14845: }
14846: }
14847: }
1.1071 raeburn 14848: if ($showitem) {
14849: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 14850: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14851: } else {
14852: my $maptitle = $mapres->compTitle();
14853: $maptitle =~ s/\W+/_/g;
14854: if ($maptitle ne '') {
14855: push(@pathitems,$maptitle);
14856: }
1.1068 raeburn 14857: }
14858: }
14859: }
14860: }
14861: return @pathitems;
14862: }
14863:
14864: =pod
14865:
1.1015 raeburn 14866: =item * &get_turnedin_filepath()
14867:
14868: Determines path in a user's portfolio file for storage of files uploaded
14869: to a specific essayresponse or dropbox item.
14870:
14871: Inputs: 3 required + 1 optional.
14872: $symb is symb for resource, $uname and $udom are for current user (required).
14873: $caller is optional (can be "submission", if routine is called when storing
14874: an upoaded file when "Submit Answer" button was pressed).
14875:
14876: Returns array containing $path and $multiresp.
14877: $path is path in portfolio. $multiresp is 1 if this resource contains more
14878: than one file upload item. Callers of routine should append partid as a
14879: subdirectory to $path in cases where $multiresp is 1.
14880:
14881: Called by: homework/essayresponse.pm and homework/structuretags.pm
14882:
14883: =cut
14884:
14885: sub get_turnedin_filepath {
14886: my ($symb,$uname,$udom,$caller) = @_;
14887: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14888: my $turnindir;
14889: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14890: $turnindir = $userhash{'turnindir'};
14891: my ($path,$multiresp);
14892: if ($turnindir eq '') {
14893: if ($caller eq 'submission') {
14894: $turnindir = &mt('turned in');
14895: $turnindir =~ s/\W+/_/g;
14896: my %newhash = (
14897: 'turnindir' => $turnindir,
14898: );
14899: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14900: }
14901: }
14902: if ($turnindir ne '') {
14903: $path = '/'.$turnindir.'/';
14904: my ($multipart,$turnin,@pathitems);
14905: my $navmap = Apache::lonnavmaps::navmap->new();
14906: if (defined($navmap)) {
14907: my $mapres = $navmap->getResourceByUrl($map);
14908: if (ref($mapres)) {
14909: my $pcslist = $mapres->map_hierarchy();
14910: if ($pcslist ne '') {
14911: foreach my $pc (split(/,/,$pcslist)) {
14912: my $res = $navmap->getByMapPc($pc);
14913: if (ref($res)) {
14914: my $title = $res->compTitle();
14915: $title =~ s/\W+/_/g;
14916: if ($title ne '') {
1.1149 raeburn 14917: if (($pc > 1) && (length($title) > 12)) {
14918: $title = substr($title,0,12);
14919: }
1.1015 raeburn 14920: push(@pathitems,$title);
14921: }
14922: }
14923: }
14924: }
14925: my $maptitle = $mapres->compTitle();
14926: $maptitle =~ s/\W+/_/g;
14927: if ($maptitle ne '') {
1.1149 raeburn 14928: if (length($maptitle) > 12) {
14929: $maptitle = substr($maptitle,0,12);
14930: }
1.1015 raeburn 14931: push(@pathitems,$maptitle);
14932: }
14933: unless ($env{'request.state'} eq 'construct') {
14934: my $res = $navmap->getBySymb($symb);
14935: if (ref($res)) {
14936: my $partlist = $res->parts();
14937: my $totaluploads = 0;
14938: if (ref($partlist) eq 'ARRAY') {
14939: foreach my $part (@{$partlist}) {
14940: my @types = $res->responseType($part);
14941: my @ids = $res->responseIds($part);
14942: for (my $i=0; $i < scalar(@ids); $i++) {
14943: if ($types[$i] eq 'essay') {
14944: my $partid = $part.'_'.$ids[$i];
14945: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
14946: $totaluploads ++;
14947: }
14948: }
14949: }
14950: }
14951: if ($totaluploads > 1) {
14952: $multiresp = 1;
14953: }
14954: }
14955: }
14956: }
14957: } else {
14958: return;
14959: }
14960: } else {
14961: return;
14962: }
14963: my $restitle=&Apache::lonnet::gettitle($symb);
14964: $restitle =~ s/\W+/_/g;
14965: if ($restitle eq '') {
14966: $restitle = ($resurl =~ m{/[^/]+$});
14967: if ($restitle eq '') {
14968: $restitle = time;
14969: }
14970: }
1.1149 raeburn 14971: if (length($restitle) > 12) {
14972: $restitle = substr($restitle,0,12);
14973: }
1.1015 raeburn 14974: push(@pathitems,$restitle);
14975: $path .= join('/',@pathitems);
14976: }
14977: return ($path,$multiresp);
14978: }
14979:
14980: =pod
14981:
1.464 albertel 14982: =back
1.41 ng 14983:
1.112 bowersj2 14984: =head1 CSV Upload/Handling functions
1.38 albertel 14985:
1.41 ng 14986: =over 4
14987:
1.648 raeburn 14988: =item * &upfile_store($r)
1.41 ng 14989:
14990: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14991: needs $env{'form.upfile'}
1.41 ng 14992: returns $datatoken to be put into hidden field
14993:
14994: =cut
1.31 albertel 14995:
14996: sub upfile_store {
14997: my $r=shift;
1.258 albertel 14998: $env{'form.upfile'}=~s/\r/\n/gs;
14999: $env{'form.upfile'}=~s/\f/\n/gs;
15000: $env{'form.upfile'}=~s/\n+/\n/gs;
15001: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 15002:
1.1299 raeburn 15003: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
15004: '_enroll_'.$env{'request.course.id'}.'_'.
15005: time.'_'.$$);
15006: return if ($datatoken eq '');
15007:
1.31 albertel 15008: {
1.158 raeburn 15009: my $datafile = $r->dir_config('lonDaemons').
15010: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15011: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 15012: print $fh $env{'form.upfile'};
1.158 raeburn 15013: close($fh);
15014: }
1.31 albertel 15015: }
15016: return $datatoken;
15017: }
15018:
1.56 matthew 15019: =pod
15020:
1.1290 raeburn 15021: =item * &load_tmp_file($r,$datatoken)
1.41 ng 15022:
15023: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 15024: $datatoken is the name to assign to the temporary file.
1.258 albertel 15025: sets $env{'form.upfile'} to the contents of the file
1.41 ng 15026:
15027: =cut
1.31 albertel 15028:
15029: sub load_tmp_file {
1.1290 raeburn 15030: my ($r,$datatoken) = @_;
15031: return if ($datatoken eq '');
1.31 albertel 15032: my @studentdata=();
15033: {
1.158 raeburn 15034: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 15035: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15036: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 15037: @studentdata=<$fh>;
15038: close($fh);
15039: }
1.31 albertel 15040: }
1.258 albertel 15041: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 15042: }
15043:
1.1290 raeburn 15044: sub valid_datatoken {
15045: my ($datatoken) = @_;
1.1325 raeburn 15046: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 15047: return $datatoken;
15048: }
15049: return;
15050: }
15051:
1.56 matthew 15052: =pod
15053:
1.648 raeburn 15054: =item * &upfile_record_sep()
1.41 ng 15055:
15056: Separate uploaded file into records
15057: returns array of records,
1.258 albertel 15058: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 15059:
15060: =cut
1.31 albertel 15061:
15062: sub upfile_record_sep {
1.258 albertel 15063: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 15064: } else {
1.248 albertel 15065: my @records;
1.258 albertel 15066: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 15067: if ($line=~/^\s*$/) { next; }
15068: push(@records,$line);
15069: }
15070: return @records;
1.31 albertel 15071: }
15072: }
15073:
1.56 matthew 15074: =pod
15075:
1.648 raeburn 15076: =item * &record_sep($record)
1.41 ng 15077:
1.258 albertel 15078: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 15079:
15080: =cut
15081:
1.263 www 15082: sub takeleft {
15083: my $index=shift;
15084: return substr('0000'.$index,-4,4);
15085: }
15086:
1.31 albertel 15087: sub record_sep {
15088: my $record=shift;
15089: my %components=();
1.258 albertel 15090: if ($env{'form.upfiletype'} eq 'xml') {
15091: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 15092: my $i=0;
1.356 albertel 15093: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 15094: $field=~s/^(\"|\')//;
15095: $field=~s/(\"|\')$//;
1.263 www 15096: $components{&takeleft($i)}=$field;
1.31 albertel 15097: $i++;
15098: }
1.258 albertel 15099: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 15100: my $i=0;
1.356 albertel 15101: foreach my $field (split(/\t/,$record)) {
1.31 albertel 15102: $field=~s/^(\"|\')//;
15103: $field=~s/(\"|\')$//;
1.263 www 15104: $components{&takeleft($i)}=$field;
1.31 albertel 15105: $i++;
15106: }
15107: } else {
1.561 www 15108: my $separator=',';
1.480 banghart 15109: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 15110: $separator=';';
1.480 banghart 15111: }
1.31 albertel 15112: my $i=0;
1.561 www 15113: # the character we are looking for to indicate the end of a quote or a record
15114: my $looking_for=$separator;
15115: # do not add the characters to the fields
15116: my $ignore=0;
15117: # we just encountered a separator (or the beginning of the record)
15118: my $just_found_separator=1;
15119: # store the field we are working on here
15120: my $field='';
15121: # work our way through all characters in record
15122: foreach my $character ($record=~/(.)/g) {
15123: if ($character eq $looking_for) {
15124: if ($character ne $separator) {
15125: # Found the end of a quote, again looking for separator
15126: $looking_for=$separator;
15127: $ignore=1;
15128: } else {
15129: # Found a separator, store away what we got
15130: $components{&takeleft($i)}=$field;
15131: $i++;
15132: $just_found_separator=1;
15133: $ignore=0;
15134: $field='';
15135: }
15136: next;
15137: }
15138: # single or double quotation marks after a separator indicate beginning of a quote
15139: # we are now looking for the end of the quote and need to ignore separators
15140: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
15141: $looking_for=$character;
15142: next;
15143: }
15144: # ignore would be true after we reached the end of a quote
15145: if ($ignore) { next; }
15146: if (($just_found_separator) && ($character=~/\s/)) { next; }
15147: $field.=$character;
15148: $just_found_separator=0;
1.31 albertel 15149: }
1.561 www 15150: # catch the very last entry, since we never encountered the separator
15151: $components{&takeleft($i)}=$field;
1.31 albertel 15152: }
15153: return %components;
15154: }
15155:
1.144 matthew 15156: ######################################################
15157: ######################################################
15158:
1.56 matthew 15159: =pod
15160:
1.648 raeburn 15161: =item * &upfile_select_html()
1.41 ng 15162:
1.144 matthew 15163: Return HTML code to select a file from the users machine and specify
15164: the file type.
1.41 ng 15165:
15166: =cut
15167:
1.144 matthew 15168: ######################################################
15169: ######################################################
1.31 albertel 15170: sub upfile_select_html {
1.144 matthew 15171: my %Types = (
15172: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 15173: semisv => &mt('Semicolon separated values'),
1.144 matthew 15174: space => &mt('Space separated'),
15175: tab => &mt('Tabulator separated'),
15176: # xml => &mt('HTML/XML'),
15177: );
15178: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 15179: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 15180: foreach my $type (sort(keys(%Types))) {
15181: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
15182: }
15183: $Str .= "</select>\n";
15184: return $Str;
1.31 albertel 15185: }
15186:
1.301 albertel 15187: sub get_samples {
15188: my ($records,$toget) = @_;
15189: my @samples=({});
15190: my $got=0;
15191: foreach my $rec (@$records) {
15192: my %temp = &record_sep($rec);
15193: if (! grep(/\S/, values(%temp))) { next; }
15194: if (%temp) {
15195: $samples[$got]=\%temp;
15196: $got++;
15197: if ($got == $toget) { last; }
15198: }
15199: }
15200: return \@samples;
15201: }
15202:
1.144 matthew 15203: ######################################################
15204: ######################################################
15205:
1.56 matthew 15206: =pod
15207:
1.648 raeburn 15208: =item * &csv_print_samples($r,$records)
1.41 ng 15209:
15210: Prints a table of sample values from each column uploaded $r is an
15211: Apache Request ref, $records is an arrayref from
15212: &Apache::loncommon::upfile_record_sep
15213:
15214: =cut
15215:
1.144 matthew 15216: ######################################################
15217: ######################################################
1.31 albertel 15218: sub csv_print_samples {
15219: my ($r,$records) = @_;
1.662 bisitz 15220: my $samples = &get_samples($records,5);
1.301 albertel 15221:
1.594 raeburn 15222: $r->print(&mt('Samples').'<br />'.&start_data_table().
15223: &start_data_table_header_row());
1.356 albertel 15224: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 15225: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 15226: $r->print(&end_data_table_header_row());
1.301 albertel 15227: foreach my $hash (@$samples) {
1.594 raeburn 15228: $r->print(&start_data_table_row());
1.356 albertel 15229: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 15230: $r->print('<td>');
1.356 albertel 15231: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 15232: $r->print('</td>');
15233: }
1.594 raeburn 15234: $r->print(&end_data_table_row());
1.31 albertel 15235: }
1.594 raeburn 15236: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 15237: }
15238:
1.144 matthew 15239: ######################################################
15240: ######################################################
15241:
1.56 matthew 15242: =pod
15243:
1.648 raeburn 15244: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 15245:
15246: Prints a table to create associations between values and table columns.
1.144 matthew 15247:
1.41 ng 15248: $r is an Apache Request ref,
15249: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 15250: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 15251:
15252: =cut
15253:
1.144 matthew 15254: ######################################################
15255: ######################################################
1.31 albertel 15256: sub csv_print_select_table {
15257: my ($r,$records,$d) = @_;
1.301 albertel 15258: my $i=0;
15259: my $samples = &get_samples($records,1);
1.144 matthew 15260: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 15261: &start_data_table().&start_data_table_header_row().
1.144 matthew 15262: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 15263: '<th>'.&mt('Column').'</th>'.
15264: &end_data_table_header_row()."\n");
1.356 albertel 15265: foreach my $array_ref (@$d) {
15266: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 15267: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 15268:
1.875 bisitz 15269: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 15270: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 15271: $r->print('<option value="none"></option>');
1.356 albertel 15272: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
15273: $r->print('<option value="'.$sample.'"'.
15274: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 15275: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 15276: }
1.594 raeburn 15277: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 15278: $i++;
15279: }
1.594 raeburn 15280: $r->print(&end_data_table());
1.31 albertel 15281: $i--;
15282: return $i;
15283: }
1.56 matthew 15284:
1.144 matthew 15285: ######################################################
15286: ######################################################
15287:
1.56 matthew 15288: =pod
1.31 albertel 15289:
1.648 raeburn 15290: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 15291:
15292: Prints a table of sample values from the upload and can make associate samples to internal names.
15293:
15294: $r is an Apache Request ref,
15295: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
15296: $d is an array of 2 element arrays (internal name, displayed name)
15297:
15298: =cut
15299:
1.144 matthew 15300: ######################################################
15301: ######################################################
1.31 albertel 15302: sub csv_samples_select_table {
15303: my ($r,$records,$d) = @_;
15304: my $i=0;
1.144 matthew 15305: #
1.662 bisitz 15306: my $max_samples = 5;
15307: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 15308: $r->print(&start_data_table().
15309: &start_data_table_header_row().'<th>'.
15310: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
15311: &end_data_table_header_row());
1.301 albertel 15312:
15313: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 15314: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 15315: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 15316: foreach my $option (@$d) {
15317: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 15318: $r->print('<option value="'.$value.'"'.
1.253 albertel 15319: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 15320: $display.'</option>');
1.31 albertel 15321: }
15322: $r->print('</select></td><td>');
1.662 bisitz 15323: foreach my $line (0..($max_samples-1)) {
1.301 albertel 15324: if (defined($samples->[$line]{$key})) {
15325: $r->print($samples->[$line]{$key}."<br />\n");
15326: }
15327: }
1.594 raeburn 15328: $r->print('</td>'.&end_data_table_row());
1.31 albertel 15329: $i++;
15330: }
1.594 raeburn 15331: $r->print(&end_data_table());
1.31 albertel 15332: $i--;
15333: return($i);
1.115 matthew 15334: }
15335:
1.144 matthew 15336: ######################################################
15337: ######################################################
15338:
1.115 matthew 15339: =pod
15340:
1.648 raeburn 15341: =item * &clean_excel_name($name)
1.115 matthew 15342:
15343: Returns a replacement for $name which does not contain any illegal characters.
15344:
15345: =cut
15346:
1.144 matthew 15347: ######################################################
15348: ######################################################
1.115 matthew 15349: sub clean_excel_name {
15350: my ($name) = @_;
15351: $name =~ s/[:\*\?\/\\]//g;
15352: if (length($name) > 31) {
15353: $name = substr($name,0,31);
15354: }
15355: return $name;
1.25 albertel 15356: }
1.84 albertel 15357:
1.85 albertel 15358: =pod
15359:
1.648 raeburn 15360: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 15361:
15362: Returns either 1 or undef
15363:
15364: 1 if the part is to be hidden, undef if it is to be shown
15365:
15366: Arguments are:
15367:
15368: $id the id of the part to be checked
15369: $symb, optional the symb of the resource to check
15370: $udom, optional the domain of the user to check for
15371: $uname, optional the username of the user to check for
15372:
15373: =cut
1.84 albertel 15374:
15375: sub check_if_partid_hidden {
15376: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 15377: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 15378: $symb,$udom,$uname);
1.141 albertel 15379: my $truth=1;
15380: #if the string starts with !, then the list is the list to show not hide
15381: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 15382: my @hiddenlist=split(/,/,$hiddenparts);
15383: foreach my $checkid (@hiddenlist) {
1.141 albertel 15384: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 15385: }
1.141 albertel 15386: return !$truth;
1.84 albertel 15387: }
1.127 matthew 15388:
1.138 matthew 15389:
15390: ############################################################
15391: ############################################################
15392:
15393: =pod
15394:
1.157 matthew 15395: =back
15396:
1.138 matthew 15397: =head1 cgi-bin script and graphing routines
15398:
1.157 matthew 15399: =over 4
15400:
1.648 raeburn 15401: =item * &get_cgi_id()
1.138 matthew 15402:
15403: Inputs: none
15404:
15405: Returns an id which can be used to pass environment variables
15406: to various cgi-bin scripts. These environment variables will
15407: be removed from the users environment after a given time by
15408: the routine &Apache::lonnet::transfer_profile_to_env.
15409:
15410: =cut
15411:
15412: ############################################################
15413: ############################################################
1.152 albertel 15414: my $uniq=0;
1.136 matthew 15415: sub get_cgi_id {
1.154 albertel 15416: $uniq=($uniq+1)%100000;
1.280 albertel 15417: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15418: }
15419:
1.127 matthew 15420: ############################################################
15421: ############################################################
15422:
15423: =pod
15424:
1.648 raeburn 15425: =item * &DrawBarGraph()
1.127 matthew 15426:
1.138 matthew 15427: Facilitates the plotting of data in a (stacked) bar graph.
15428: Puts plot definition data into the users environment in order for
15429: graph.png to plot it. Returns an <img> tag for the plot.
15430: The bars on the plot are labeled '1','2',...,'n'.
15431:
15432: Inputs:
15433:
15434: =over 4
15435:
15436: =item $Title: string, the title of the plot
15437:
15438: =item $xlabel: string, text describing the X-axis of the plot
15439:
15440: =item $ylabel: string, text describing the Y-axis of the plot
15441:
15442: =item $Max: scalar, the maximum Y value to use in the plot
15443: If $Max is < any data point, the graph will not be rendered.
15444:
1.140 matthew 15445: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15446: they are plotted. If undefined, default values will be used.
15447:
1.178 matthew 15448: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15449:
1.138 matthew 15450: =item @Values: An array of array references. Each array reference holds data
15451: to be plotted in a stacked bar chart.
15452:
1.239 matthew 15453: =item If the final element of @Values is a hash reference the key/value
15454: pairs will be added to the graph definition.
15455:
1.138 matthew 15456: =back
15457:
15458: Returns:
15459:
15460: An <img> tag which references graph.png and the appropriate identifying
15461: information for the plot.
15462:
1.127 matthew 15463: =cut
15464:
15465: ############################################################
15466: ############################################################
1.134 matthew 15467: sub DrawBarGraph {
1.178 matthew 15468: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15469: #
15470: if (! defined($colors)) {
15471: $colors = ['#33ff00',
15472: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15473: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15474: ];
15475: }
1.228 matthew 15476: my $extra_settings = {};
15477: if (ref($Values[-1]) eq 'HASH') {
15478: $extra_settings = pop(@Values);
15479: }
1.127 matthew 15480: #
1.136 matthew 15481: my $identifier = &get_cgi_id();
15482: my $id = 'cgi.'.$identifier;
1.129 matthew 15483: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15484: return '';
15485: }
1.225 matthew 15486: #
15487: my @Labels;
15488: if (defined($labels)) {
15489: @Labels = @$labels;
15490: } else {
15491: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15492: push(@Labels,$i+1);
1.225 matthew 15493: }
15494: }
15495: #
1.129 matthew 15496: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15497: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15498: my %ValuesHash;
15499: my $NumSets=1;
15500: foreach my $array (@Values) {
15501: next if (! ref($array));
1.136 matthew 15502: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15503: join(',',@$array);
1.129 matthew 15504: }
1.127 matthew 15505: #
1.136 matthew 15506: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15507: if ($NumBars < 3) {
15508: $width = 120+$NumBars*32;
1.220 matthew 15509: $xskip = 1;
1.225 matthew 15510: $bar_width = 30;
15511: } elsif ($NumBars < 5) {
15512: $width = 120+$NumBars*20;
15513: $xskip = 1;
15514: $bar_width = 20;
1.220 matthew 15515: } elsif ($NumBars < 10) {
1.136 matthew 15516: $width = 120+$NumBars*15;
15517: $xskip = 1;
15518: $bar_width = 15;
15519: } elsif ($NumBars <= 25) {
15520: $width = 120+$NumBars*11;
15521: $xskip = 5;
15522: $bar_width = 8;
15523: } elsif ($NumBars <= 50) {
15524: $width = 120+$NumBars*8;
15525: $xskip = 5;
15526: $bar_width = 4;
15527: } else {
15528: $width = 120+$NumBars*8;
15529: $xskip = 5;
15530: $bar_width = 4;
15531: }
15532: #
1.137 matthew 15533: $Max = 1 if ($Max < 1);
15534: if ( int($Max) < $Max ) {
15535: $Max++;
15536: $Max = int($Max);
15537: }
1.127 matthew 15538: $Title = '' if (! defined($Title));
15539: $xlabel = '' if (! defined($xlabel));
15540: $ylabel = '' if (! defined($ylabel));
1.369 www 15541: $ValuesHash{$id.'.title'} = &escape($Title);
15542: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15543: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15544: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15545: $ValuesHash{$id.'.NumBars'} = $NumBars;
15546: $ValuesHash{$id.'.NumSets'} = $NumSets;
15547: $ValuesHash{$id.'.PlotType'} = 'bar';
15548: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15549: $ValuesHash{$id.'.height'} = $height;
15550: $ValuesHash{$id.'.width'} = $width;
15551: $ValuesHash{$id.'.xskip'} = $xskip;
15552: $ValuesHash{$id.'.bar_width'} = $bar_width;
15553: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15554: #
1.228 matthew 15555: # Deal with other parameters
15556: while (my ($key,$value) = each(%$extra_settings)) {
15557: $ValuesHash{$id.'.'.$key} = $value;
15558: }
15559: #
1.646 raeburn 15560: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15561: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15562: }
15563:
15564: ############################################################
15565: ############################################################
15566:
15567: =pod
15568:
1.648 raeburn 15569: =item * &DrawXYGraph()
1.137 matthew 15570:
1.138 matthew 15571: Facilitates the plotting of data in an XY graph.
15572: Puts plot definition data into the users environment in order for
15573: graph.png to plot it. Returns an <img> tag for the plot.
15574:
15575: Inputs:
15576:
15577: =over 4
15578:
15579: =item $Title: string, the title of the plot
15580:
15581: =item $xlabel: string, text describing the X-axis of the plot
15582:
15583: =item $ylabel: string, text describing the Y-axis of the plot
15584:
15585: =item $Max: scalar, the maximum Y value to use in the plot
15586: If $Max is < any data point, the graph will not be rendered.
15587:
15588: =item $colors: Array ref containing the hex color codes for the data to be
15589: plotted in. If undefined, default values will be used.
15590:
15591: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15592:
15593: =item $Ydata: Array ref containing Array refs.
1.185 www 15594: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15595:
15596: =item %Values: hash indicating or overriding any default values which are
15597: passed to graph.png.
15598: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15599:
15600: =back
15601:
15602: Returns:
15603:
15604: An <img> tag which references graph.png and the appropriate identifying
15605: information for the plot.
15606:
1.137 matthew 15607: =cut
15608:
15609: ############################################################
15610: ############################################################
15611: sub DrawXYGraph {
15612: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15613: #
15614: # Create the identifier for the graph
15615: my $identifier = &get_cgi_id();
15616: my $id = 'cgi.'.$identifier;
15617: #
15618: $Title = '' if (! defined($Title));
15619: $xlabel = '' if (! defined($xlabel));
15620: $ylabel = '' if (! defined($ylabel));
15621: my %ValuesHash =
15622: (
1.369 www 15623: $id.'.title' => &escape($Title),
15624: $id.'.xlabel' => &escape($xlabel),
15625: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15626: $id.'.y_max_value'=> $Max,
15627: $id.'.labels' => join(',',@$Xlabels),
15628: $id.'.PlotType' => 'XY',
15629: );
15630: #
15631: if (defined($colors) && ref($colors) eq 'ARRAY') {
15632: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15633: }
15634: #
15635: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15636: return '';
15637: }
15638: my $NumSets=1;
1.138 matthew 15639: foreach my $array (@{$Ydata}){
1.137 matthew 15640: next if (! ref($array));
15641: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15642: }
1.138 matthew 15643: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15644: #
15645: # Deal with other parameters
15646: while (my ($key,$value) = each(%Values)) {
15647: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15648: }
15649: #
1.646 raeburn 15650: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15651: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15652: }
15653:
15654: ############################################################
15655: ############################################################
15656:
15657: =pod
15658:
1.648 raeburn 15659: =item * &DrawXYYGraph()
1.138 matthew 15660:
15661: Facilitates the plotting of data in an XY graph with two Y axes.
15662: Puts plot definition data into the users environment in order for
15663: graph.png to plot it. Returns an <img> tag for the plot.
15664:
15665: Inputs:
15666:
15667: =over 4
15668:
15669: =item $Title: string, the title of the plot
15670:
15671: =item $xlabel: string, text describing the X-axis of the plot
15672:
15673: =item $ylabel: string, text describing the Y-axis of the plot
15674:
15675: =item $colors: Array ref containing the hex color codes for the data to be
15676: plotted in. If undefined, default values will be used.
15677:
15678: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15679:
15680: =item $Ydata1: The first data set
15681:
15682: =item $Min1: The minimum value of the left Y-axis
15683:
15684: =item $Max1: The maximum value of the left Y-axis
15685:
15686: =item $Ydata2: The second data set
15687:
15688: =item $Min2: The minimum value of the right Y-axis
15689:
15690: =item $Max2: The maximum value of the left Y-axis
15691:
15692: =item %Values: hash indicating or overriding any default values which are
15693: passed to graph.png.
15694: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15695:
15696: =back
15697:
15698: Returns:
15699:
15700: An <img> tag which references graph.png and the appropriate identifying
15701: information for the plot.
1.136 matthew 15702:
15703: =cut
15704:
15705: ############################################################
15706: ############################################################
1.137 matthew 15707: sub DrawXYYGraph {
15708: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15709: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15710: #
15711: # Create the identifier for the graph
15712: my $identifier = &get_cgi_id();
15713: my $id = 'cgi.'.$identifier;
15714: #
15715: $Title = '' if (! defined($Title));
15716: $xlabel = '' if (! defined($xlabel));
15717: $ylabel = '' if (! defined($ylabel));
15718: my %ValuesHash =
15719: (
1.369 www 15720: $id.'.title' => &escape($Title),
15721: $id.'.xlabel' => &escape($xlabel),
15722: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15723: $id.'.labels' => join(',',@$Xlabels),
15724: $id.'.PlotType' => 'XY',
15725: $id.'.NumSets' => 2,
1.137 matthew 15726: $id.'.two_axes' => 1,
15727: $id.'.y1_max_value' => $Max1,
15728: $id.'.y1_min_value' => $Min1,
15729: $id.'.y2_max_value' => $Max2,
15730: $id.'.y2_min_value' => $Min2,
1.136 matthew 15731: );
15732: #
1.137 matthew 15733: if (defined($colors) && ref($colors) eq 'ARRAY') {
15734: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15735: }
15736: #
15737: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15738: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15739: return '';
15740: }
15741: my $NumSets=1;
1.137 matthew 15742: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15743: next if (! ref($array));
15744: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15745: }
15746: #
15747: # Deal with other parameters
15748: while (my ($key,$value) = each(%Values)) {
15749: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15750: }
15751: #
1.646 raeburn 15752: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15753: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15754: }
15755:
15756: ############################################################
15757: ############################################################
15758:
15759: =pod
15760:
1.157 matthew 15761: =back
15762:
1.139 matthew 15763: =head1 Statistics helper routines?
15764:
15765: Bad place for them but what the hell.
15766:
1.157 matthew 15767: =over 4
15768:
1.648 raeburn 15769: =item * &chartlink()
1.139 matthew 15770:
15771: Returns a link to the chart for a specific student.
15772:
15773: Inputs:
15774:
15775: =over 4
15776:
15777: =item $linktext: The text of the link
15778:
15779: =item $sname: The students username
15780:
15781: =item $sdomain: The students domain
15782:
15783: =back
15784:
1.157 matthew 15785: =back
15786:
1.139 matthew 15787: =cut
15788:
15789: ############################################################
15790: ############################################################
15791: sub chartlink {
15792: my ($linktext, $sname, $sdomain) = @_;
15793: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15794: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15795: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15796: '">'.$linktext.'</a>';
1.153 matthew 15797: }
15798:
15799: #######################################################
15800: #######################################################
15801:
15802: =pod
15803:
15804: =head1 Course Environment Routines
1.157 matthew 15805:
15806: =over 4
1.153 matthew 15807:
1.648 raeburn 15808: =item * &restore_course_settings()
1.153 matthew 15809:
1.648 raeburn 15810: =item * &store_course_settings()
1.153 matthew 15811:
15812: Restores/Store indicated form parameters from the course environment.
15813: Will not overwrite existing values of the form parameters.
15814:
15815: Inputs:
15816: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15817:
15818: a hash ref describing the data to be stored. For example:
15819:
15820: %Save_Parameters = ('Status' => 'scalar',
15821: 'chartoutputmode' => 'scalar',
15822: 'chartoutputdata' => 'scalar',
15823: 'Section' => 'array',
1.373 raeburn 15824: 'Group' => 'array',
1.153 matthew 15825: 'StudentData' => 'array',
15826: 'Maps' => 'array');
15827:
15828: Returns: both routines return nothing
15829:
1.631 raeburn 15830: =back
15831:
1.153 matthew 15832: =cut
15833:
15834: #######################################################
15835: #######################################################
15836: sub store_course_settings {
1.496 albertel 15837: return &store_settings($env{'request.course.id'},@_);
15838: }
15839:
15840: sub store_settings {
1.153 matthew 15841: # save to the environment
15842: # appenv the same items, just to be safe
1.300 albertel 15843: my $udom = $env{'user.domain'};
15844: my $uname = $env{'user.name'};
1.496 albertel 15845: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15846: my %SaveHash;
15847: my %AppHash;
15848: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15849: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15850: my $envname = 'environment.'.$basename;
1.258 albertel 15851: if (exists($env{'form.'.$setting})) {
1.153 matthew 15852: # Save this value away
15853: if ($type eq 'scalar' &&
1.258 albertel 15854: (! exists($env{$envname}) ||
15855: $env{$envname} ne $env{'form.'.$setting})) {
15856: $SaveHash{$basename} = $env{'form.'.$setting};
15857: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15858: } elsif ($type eq 'array') {
15859: my $stored_form;
1.258 albertel 15860: if (ref($env{'form.'.$setting})) {
1.153 matthew 15861: $stored_form = join(',',
15862: map {
1.369 www 15863: &escape($_);
1.258 albertel 15864: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15865: } else {
15866: $stored_form =
1.369 www 15867: &escape($env{'form.'.$setting});
1.153 matthew 15868: }
15869: # Determine if the array contents are the same.
1.258 albertel 15870: if ($stored_form ne $env{$envname}) {
1.153 matthew 15871: $SaveHash{$basename} = $stored_form;
15872: $AppHash{$envname} = $stored_form;
15873: }
15874: }
15875: }
15876: }
15877: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15878: $udom,$uname);
1.153 matthew 15879: if ($put_result !~ /^(ok|delayed)/) {
15880: &Apache::lonnet::logthis('unable to save form parameters, '.
15881: 'got error:'.$put_result);
15882: }
15883: # Make sure these settings stick around in this session, too
1.646 raeburn 15884: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15885: return;
15886: }
15887:
15888: sub restore_course_settings {
1.499 albertel 15889: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15890: }
15891:
15892: sub restore_settings {
15893: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15894: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15895: next if (exists($env{'form.'.$setting}));
1.496 albertel 15896: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15897: '.'.$setting;
1.258 albertel 15898: if (exists($env{$envname})) {
1.153 matthew 15899: if ($type eq 'scalar') {
1.258 albertel 15900: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15901: } elsif ($type eq 'array') {
1.258 albertel 15902: $env{'form.'.$setting} = [
1.153 matthew 15903: map {
1.369 www 15904: &unescape($_);
1.258 albertel 15905: } split(',',$env{$envname})
1.153 matthew 15906: ];
15907: }
15908: }
15909: }
1.127 matthew 15910: }
15911:
1.618 raeburn 15912: #######################################################
15913: #######################################################
15914:
15915: =pod
15916:
15917: =head1 Domain E-mail Routines
15918:
15919: =over 4
15920:
1.648 raeburn 15921: =item * &build_recipient_list()
1.618 raeburn 15922:
1.1144 raeburn 15923: Build recipient lists for following types of e-mail:
1.766 raeburn 15924: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 15925: (d) Help requests, (e) Course requests needing approval, (f) loncapa
15926: module change checking, student/employee ID conflict checks, as
15927: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
15928: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 15929:
15930: Inputs:
1.619 raeburn 15931: defmail (scalar - email address of default recipient),
1.1144 raeburn 15932: mailing type (scalar: errormail, packagesmail, helpdeskmail,
15933: requestsmail, updatesmail, or idconflictsmail).
15934:
1.619 raeburn 15935: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 15936:
1.619 raeburn 15937: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 15938: i.e., predates configuration by DC via domainprefs.pm
15939:
15940: $requname username of requester (if mailing type is helpdeskmail)
15941:
15942: $requdom domain of requester (if mailing type is helpdeskmail)
15943:
15944: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
15945:
1.618 raeburn 15946:
1.655 raeburn 15947: Returns: comma separated list of addresses to which to send e-mail.
15948:
15949: =back
1.618 raeburn 15950:
15951: =cut
15952:
15953: ############################################################
15954: ############################################################
15955: sub build_recipient_list {
1.1297 raeburn 15956: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 15957: my @recipients;
1.1270 raeburn 15958: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 15959: my %domconfig =
1.1270 raeburn 15960: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 15961: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 15962: if (exists($domconfig{'contacts'}{$mailing})) {
15963: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
15964: my @contacts = ('adminemail','supportemail');
15965: foreach my $item (@contacts) {
15966: if ($domconfig{'contacts'}{$mailing}{$item}) {
15967: my $addr = $domconfig{'contacts'}{$item};
15968: if (!grep(/^\Q$addr\E$/,@recipients)) {
15969: push(@recipients,$addr);
15970: }
1.619 raeburn 15971: }
1.1270 raeburn 15972: }
15973: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15974: if ($mailing eq 'helpdeskmail') {
15975: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15976: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15977: my @ok_bccs;
15978: foreach my $bcc (@bccs) {
15979: $bcc =~ s/^\s+//g;
15980: $bcc =~ s/\s+$//g;
15981: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15982: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15983: push(@ok_bccs,$bcc);
15984: }
15985: }
15986: }
15987: if (@ok_bccs > 0) {
15988: $allbcc = join(', ',@ok_bccs);
15989: }
15990: }
15991: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15992: }
15993: }
1.766 raeburn 15994: } elsif ($origmail ne '') {
1.1270 raeburn 15995: $lastresort = $origmail;
1.618 raeburn 15996: }
1.1297 raeburn 15997: if ($mailing eq 'helpdeskmail') {
15998: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15999: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
16000: my ($inststatus,$inststatus_checked);
16001: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
16002: ($env{'user.domain'} ne 'public')) {
16003: $inststatus_checked = 1;
16004: $inststatus = $env{'environment.inststatus'};
16005: }
16006: unless ($inststatus_checked) {
16007: if (($requname ne '') && ($requdom ne '')) {
16008: if (($requname =~ /^$match_username$/) &&
16009: ($requdom =~ /^$match_domain$/) &&
16010: (&Apache::lonnet::domain($requdom))) {
16011: my $requhome = &Apache::lonnet::homeserver($requname,
16012: $requdom);
16013: unless ($requhome eq 'no_host') {
16014: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
16015: $inststatus = $userenv{'inststatus'};
16016: $inststatus_checked = 1;
16017: }
16018: }
16019: }
16020: }
16021: unless ($inststatus_checked) {
16022: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
16023: my %srch = (srchby => 'email',
16024: srchdomain => $defdom,
16025: srchterm => $reqemail,
16026: srchtype => 'exact');
16027: my %srch_results = &Apache::lonnet::usersearch(\%srch);
16028: foreach my $uname (keys(%srch_results)) {
16029: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16030: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16031: $inststatus_checked = 1;
16032: last;
16033: }
16034: }
16035: unless ($inststatus_checked) {
16036: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
16037: if ($dirsrchres eq 'ok') {
16038: foreach my $uname (keys(%srch_results)) {
16039: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16040: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16041: $inststatus_checked = 1;
16042: last;
16043: }
16044: }
16045: }
16046: }
16047: }
16048: }
16049: if ($inststatus ne '') {
16050: foreach my $status (split(/\:/,$inststatus)) {
16051: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
16052: my @contacts = ('adminemail','supportemail');
16053: foreach my $item (@contacts) {
16054: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
16055: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
16056: if (!grep(/^\Q$addr\E$/,@recipients)) {
16057: push(@recipients,$addr);
16058: }
16059: }
16060: }
16061: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
16062: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
16063: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
16064: my @ok_bccs;
16065: foreach my $bcc (@bccs) {
16066: $bcc =~ s/^\s+//g;
16067: $bcc =~ s/\s+$//g;
16068: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16069: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16070: push(@ok_bccs,$bcc);
16071: }
16072: }
16073: }
16074: if (@ok_bccs > 0) {
16075: $allbcc = join(', ',@ok_bccs);
16076: }
16077: }
16078: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
16079: last;
16080: }
16081: }
16082: }
16083: }
16084: }
1.619 raeburn 16085: } elsif ($origmail ne '') {
1.1270 raeburn 16086: $lastresort = $origmail;
16087: }
1.1297 raeburn 16088: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 16089: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
16090: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
16091: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
16092: my %what = (
16093: perlvar => 1,
16094: );
16095: my $primary = &Apache::lonnet::domain($defdom,'primary');
16096: if ($primary) {
16097: my $gotaddr;
16098: my ($result,$returnhash) =
16099: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
16100: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
16101: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
16102: $lastresort = $returnhash->{'lonSupportEMail'};
16103: $gotaddr = 1;
16104: }
16105: }
16106: unless ($gotaddr) {
16107: my $uintdom = &Apache::lonnet::internet_dom($primary);
16108: my $intdom = &Apache::lonnet::internet_dom($lonhost);
16109: unless ($uintdom eq $intdom) {
16110: my %domconfig =
16111: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
16112: if (ref($domconfig{'contacts'}) eq 'HASH') {
16113: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
16114: my @contacts = ('adminemail','supportemail');
16115: foreach my $item (@contacts) {
16116: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
16117: my $addr = $domconfig{'contacts'}{$item};
16118: if (!grep(/^\Q$addr\E$/,@recipients)) {
16119: push(@recipients,$addr);
16120: }
16121: }
16122: }
16123: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
16124: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
16125: }
16126: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
16127: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
16128: my @ok_bccs;
16129: foreach my $bcc (@bccs) {
16130: $bcc =~ s/^\s+//g;
16131: $bcc =~ s/\s+$//g;
16132: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16133: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16134: push(@ok_bccs,$bcc);
16135: }
16136: }
16137: }
16138: if (@ok_bccs > 0) {
16139: $allbcc = join(', ',@ok_bccs);
16140: }
16141: }
16142: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
16143: }
16144: }
16145: }
16146: }
16147: }
16148: }
1.618 raeburn 16149: }
1.688 raeburn 16150: if (defined($defmail)) {
16151: if ($defmail ne '') {
16152: push(@recipients,$defmail);
16153: }
1.618 raeburn 16154: }
16155: if ($otheremails) {
1.619 raeburn 16156: my @others;
16157: if ($otheremails =~ /,/) {
16158: @others = split(/,/,$otheremails);
1.618 raeburn 16159: } else {
1.619 raeburn 16160: push(@others,$otheremails);
16161: }
16162: foreach my $addr (@others) {
16163: if (!grep(/^\Q$addr\E$/,@recipients)) {
16164: push(@recipients,$addr);
16165: }
1.618 raeburn 16166: }
16167: }
1.1298 raeburn 16168: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 16169: if ((!@recipients) && ($lastresort ne '')) {
16170: push(@recipients,$lastresort);
16171: }
16172: } elsif ($lastresort ne '') {
16173: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
16174: push(@recipients,$lastresort);
16175: }
16176: }
1.1271 raeburn 16177: my $recipientlist = join(',',@recipients);
1.1270 raeburn 16178: if (wantarray) {
16179: return ($recipientlist,$allbcc,$addtext);
16180: } else {
16181: return $recipientlist;
16182: }
1.618 raeburn 16183: }
16184:
1.127 matthew 16185: ############################################################
16186: ############################################################
1.154 albertel 16187:
1.655 raeburn 16188: =pod
16189:
1.1224 musolffc 16190: =over 4
16191:
1.1223 musolffc 16192: =item * &mime_email()
16193:
16194: Sends an email with a possible attachment
16195:
16196: Inputs:
16197:
16198: =over 4
16199:
16200: from - Sender's email address
16201:
1.1343 raeburn 16202: replyto - Reply-To email address
16203:
1.1223 musolffc 16204: to - Email address of recipient
16205:
16206: subject - Subject of email
16207:
16208: body - Body of email
16209:
16210: cc_string - Carbon copy email address
16211:
16212: bcc - Blind carbon copy email address
16213:
16214: attachment_path - Path of file to be attached
16215:
16216: file_name - Name of file to be attached
16217:
16218: attachment_text - The body of an attachment of type "TEXT"
16219:
16220: =back
16221:
16222: =back
16223:
16224: =cut
16225:
16226: ############################################################
16227: ############################################################
16228:
16229: sub mime_email {
1.1343 raeburn 16230: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
16231: $file_name,$attachment_text) = @_;
16232:
1.1223 musolffc 16233: my $msg = MIME::Lite->new(
16234: From => $from,
16235: To => $to,
16236: Subject => $subject,
16237: Type =>'TEXT',
16238: Data => $body,
16239: );
1.1343 raeburn 16240: if ($replyto ne '') {
16241: $msg->add("Reply-To" => $replyto);
16242: }
1.1223 musolffc 16243: if ($cc_string ne '') {
16244: $msg->add("Cc" => $cc_string);
16245: }
16246: if ($bcc ne '') {
16247: $msg->add("Bcc" => $bcc);
16248: }
16249: $msg->attr("content-type" => "text/plain");
16250: $msg->attr("content-type.charset" => "UTF-8");
16251: # Attach file if given
16252: if ($attachment_path) {
16253: unless ($file_name) {
16254: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
16255: }
16256: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
16257: $msg->attach(Type => $type,
16258: Path => $attachment_path,
16259: Filename => $file_name
16260: );
16261: # Otherwise attach text if given
16262: } elsif ($attachment_text) {
16263: $msg->attach(Type => 'TEXT',
16264: Data => $attachment_text);
16265: }
16266: # Send it
16267: $msg->send('sendmail');
16268: }
16269:
16270: ############################################################
16271: ############################################################
16272:
16273: =pod
16274:
1.655 raeburn 16275: =head1 Course Catalog Routines
16276:
16277: =over 4
16278:
16279: =item * &gather_categories()
16280:
16281: Converts category definitions - keys of categories hash stored in
16282: coursecategories in configuration.db on the primary library server in a
16283: domain - to an array. Also generates javascript and idx hash used to
16284: generate Domain Coordinator interface for editing Course Categories.
16285:
16286: Inputs:
1.663 raeburn 16287:
1.655 raeburn 16288: categories (reference to hash of category definitions).
1.663 raeburn 16289:
1.655 raeburn 16290: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16291: categories and subcategories).
1.663 raeburn 16292:
1.655 raeburn 16293: idx (reference to hash of counters used in Domain Coordinator interface for
16294: editing Course Categories).
1.663 raeburn 16295:
1.655 raeburn 16296: jsarray (reference to array of categories used to create Javascript arrays for
16297: Domain Coordinator interface for editing Course Categories).
16298:
16299: Returns: nothing
16300:
16301: Side effects: populates cats, idx and jsarray.
16302:
16303: =cut
16304:
16305: sub gather_categories {
16306: my ($categories,$cats,$idx,$jsarray) = @_;
16307: my %counters;
16308: my $num = 0;
16309: foreach my $item (keys(%{$categories})) {
16310: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
16311: if ($container eq '' && $depth == 0) {
16312: $cats->[$depth][$categories->{$item}] = $cat;
16313: } else {
16314: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
16315: }
16316: my ($escitem,$tail) = split(/:/,$item,2);
16317: if ($counters{$tail} eq '') {
16318: $counters{$tail} = $num;
16319: $num ++;
16320: }
16321: if (ref($idx) eq 'HASH') {
16322: $idx->{$item} = $counters{$tail};
16323: }
16324: if (ref($jsarray) eq 'ARRAY') {
16325: push(@{$jsarray->[$counters{$tail}]},$item);
16326: }
16327: }
16328: return;
16329: }
16330:
16331: =pod
16332:
16333: =item * &extract_categories()
16334:
16335: Used to generate breadcrumb trails for course categories.
16336:
16337: Inputs:
1.663 raeburn 16338:
1.655 raeburn 16339: categories (reference to hash of category definitions).
1.663 raeburn 16340:
1.655 raeburn 16341: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16342: categories and subcategories).
1.663 raeburn 16343:
1.655 raeburn 16344: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 16345:
1.655 raeburn 16346: allitems (reference to hash - key is category key
16347: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16348:
1.655 raeburn 16349: idx (reference to hash of counters used in Domain Coordinator interface for
16350: editing Course Categories).
1.663 raeburn 16351:
1.655 raeburn 16352: jsarray (reference to array of categories used to create Javascript arrays for
16353: Domain Coordinator interface for editing Course Categories).
16354:
1.665 raeburn 16355: subcats (reference to hash of arrays containing all subcategories within each
16356: category, -recursive)
16357:
1.1321 raeburn 16358: maxd (reference to hash used to hold max depth for all top-level categories).
16359:
1.655 raeburn 16360: Returns: nothing
16361:
16362: Side effects: populates trails and allitems hash references.
16363:
16364: =cut
16365:
16366: sub extract_categories {
1.1321 raeburn 16367: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 16368: if (ref($categories) eq 'HASH') {
16369: &gather_categories($categories,$cats,$idx,$jsarray);
16370: if (ref($cats->[0]) eq 'ARRAY') {
16371: for (my $i=0; $i<@{$cats->[0]}; $i++) {
16372: my $name = $cats->[0][$i];
16373: my $item = &escape($name).'::0';
16374: my $trailstr;
16375: if ($name eq 'instcode') {
16376: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 16377: } elsif ($name eq 'communities') {
16378: $trailstr = &mt('Communities');
1.1239 raeburn 16379: } elsif ($name eq 'placement') {
16380: $trailstr = &mt('Placement Tests');
1.655 raeburn 16381: } else {
16382: $trailstr = $name;
16383: }
16384: if ($allitems->{$item} eq '') {
16385: push(@{$trails},$trailstr);
16386: $allitems->{$item} = scalar(@{$trails})-1;
16387: }
16388: my @parents = ($name);
16389: if (ref($cats->[1]{$name}) eq 'ARRAY') {
16390: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
16391: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 16392: if (ref($subcats) eq 'HASH') {
16393: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
16394: }
1.1321 raeburn 16395: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 16396: }
16397: } else {
16398: if (ref($subcats) eq 'HASH') {
16399: $subcats->{$item} = [];
1.655 raeburn 16400: }
1.1321 raeburn 16401: if (ref($maxd) eq 'HASH') {
16402: $maxd->{$name} = 1;
16403: }
1.655 raeburn 16404: }
16405: }
16406: }
16407: }
16408: return;
16409: }
16410:
16411: =pod
16412:
1.1162 raeburn 16413: =item * &recurse_categories()
1.655 raeburn 16414:
16415: Recursively used to generate breadcrumb trails for course categories.
16416:
16417: Inputs:
1.663 raeburn 16418:
1.655 raeburn 16419: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16420: categories and subcategories).
1.663 raeburn 16421:
1.655 raeburn 16422: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16423:
16424: category (current course category, for which breadcrumb trail is being generated).
16425:
16426: trails (reference to array of breadcrumb trails for each category).
16427:
1.655 raeburn 16428: allitems (reference to hash - key is category key
16429: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16430:
1.655 raeburn 16431: parents (array containing containers directories for current category,
16432: back to top level).
16433:
16434: Returns: nothing
16435:
16436: Side effects: populates trails and allitems hash references
16437:
16438: =cut
16439:
16440: sub recurse_categories {
1.1321 raeburn 16441: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16442: my $shallower = $depth - 1;
16443: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16444: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16445: my $name = $cats->[$depth]{$category}[$k];
16446: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16447: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16448: if ($allitems->{$item} eq '') {
16449: push(@{$trails},$trailstr);
16450: $allitems->{$item} = scalar(@{$trails})-1;
16451: }
16452: my $deeper = $depth+1;
16453: push(@{$parents},$category);
1.665 raeburn 16454: if (ref($subcats) eq 'HASH') {
16455: my $subcat = &escape($name).':'.$category.':'.$depth;
16456: for (my $j=@{$parents}; $j>=0; $j--) {
16457: my $higher;
16458: if ($j > 0) {
16459: $higher = &escape($parents->[$j]).':'.
16460: &escape($parents->[$j-1]).':'.$j;
16461: } else {
16462: $higher = &escape($parents->[$j]).'::'.$j;
16463: }
16464: push(@{$subcats->{$higher}},$subcat);
16465: }
16466: }
16467: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16468: $subcats,$maxd);
1.655 raeburn 16469: pop(@{$parents});
16470: }
16471: } else {
16472: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16473: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16474: if ($allitems->{$item} eq '') {
16475: push(@{$trails},$trailstr);
16476: $allitems->{$item} = scalar(@{$trails})-1;
16477: }
1.1321 raeburn 16478: if (ref($maxd) eq 'HASH') {
16479: if ($depth > $maxd->{$parents->[0]}) {
16480: $maxd->{$parents->[0]} = $depth;
16481: }
16482: }
1.655 raeburn 16483: }
16484: return;
16485: }
16486:
1.663 raeburn 16487: =pod
16488:
1.1162 raeburn 16489: =item * &assign_categories_table()
1.663 raeburn 16490:
16491: Create a datatable for display of hierarchical categories in a domain,
16492: with checkboxes to allow a course to be categorized.
16493:
16494: Inputs:
16495:
16496: cathash - reference to hash of categories defined for the domain (from
16497: configuration.db)
16498:
16499: currcat - scalar with an & separated list of categories assigned to a course.
16500:
1.919 raeburn 16501: type - scalar contains course type (Course or Community).
16502:
1.1260 raeburn 16503: disabled - scalar (optional) contains disabled="disabled" if input elements are
16504: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16505:
1.663 raeburn 16506: Returns: $output (markup to be displayed)
16507:
16508: =cut
16509:
16510: sub assign_categories_table {
1.1259 raeburn 16511: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16512: my $output;
16513: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16514: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16515: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16516: $maxdepth = scalar(@cats);
16517: if (@cats > 0) {
16518: my $itemcount = 0;
16519: if (ref($cats[0]) eq 'ARRAY') {
16520: my @currcategories;
16521: if ($currcat ne '') {
16522: @currcategories = split('&',$currcat);
16523: }
1.919 raeburn 16524: my $table;
1.663 raeburn 16525: for (my $i=0; $i<@{$cats[0]}; $i++) {
16526: my $parent = $cats[0][$i];
1.919 raeburn 16527: next if ($parent eq 'instcode');
16528: if ($type eq 'Community') {
16529: next unless ($parent eq 'communities');
1.1239 raeburn 16530: } elsif ($type eq 'Placement') {
16531: next unless ($parent eq 'placement');
1.919 raeburn 16532: } else {
1.1239 raeburn 16533: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16534: }
1.663 raeburn 16535: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16536: my $item = &escape($parent).'::0';
16537: my $checked = '';
16538: if (@currcategories > 0) {
16539: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16540: $checked = ' checked="checked"';
1.663 raeburn 16541: }
16542: }
1.919 raeburn 16543: my $parent_title = $parent;
16544: if ($parent eq 'communities') {
16545: $parent_title = &mt('Communities');
1.1239 raeburn 16546: } elsif ($parent eq 'placement') {
16547: $parent_title = &mt('Placement Tests');
1.919 raeburn 16548: }
16549: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16550: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16551: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16552: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16553: my $depth = 1;
16554: push(@path,$parent);
1.1259 raeburn 16555: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16556: pop(@path);
1.919 raeburn 16557: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16558: $itemcount ++;
16559: }
1.919 raeburn 16560: if ($itemcount) {
16561: $output = &Apache::loncommon::start_data_table().
16562: $table.
16563: &Apache::loncommon::end_data_table();
16564: }
1.663 raeburn 16565: }
16566: }
16567: }
16568: return $output;
16569: }
16570:
16571: =pod
16572:
1.1162 raeburn 16573: =item * &assign_category_rows()
1.663 raeburn 16574:
16575: Create a datatable row for display of nested categories in a domain,
16576: with checkboxes to allow a course to be categorized,called recursively.
16577:
16578: Inputs:
16579:
16580: itemcount - track row number for alternating colors
16581:
16582: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16583: categories and subcategories.
16584:
16585: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16586:
16587: parent - parent of current category item
16588:
16589: path - Array containing all categories back up through the hierarchy from the
16590: current category to the top level.
16591:
16592: currcategories - reference to array of current categories assigned to the course
16593:
1.1260 raeburn 16594: disabled - scalar (optional) contains disabled="disabled" if input elements are
16595: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16596:
1.663 raeburn 16597: Returns: $output (markup to be displayed).
16598:
16599: =cut
16600:
16601: sub assign_category_rows {
1.1259 raeburn 16602: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16603: my ($text,$name,$item,$chgstr);
16604: if (ref($cats) eq 'ARRAY') {
16605: my $maxdepth = scalar(@{$cats});
16606: if (ref($cats->[$depth]) eq 'HASH') {
16607: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16608: my $numchildren = @{$cats->[$depth]{$parent}};
16609: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16610: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16611: for (my $j=0; $j<$numchildren; $j++) {
16612: $name = $cats->[$depth]{$parent}[$j];
16613: $item = &escape($name).':'.&escape($parent).':'.$depth;
16614: my $deeper = $depth+1;
16615: my $checked = '';
16616: if (ref($currcategories) eq 'ARRAY') {
16617: if (@{$currcategories} > 0) {
16618: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16619: $checked = ' checked="checked"';
1.663 raeburn 16620: }
16621: }
16622: }
1.664 raeburn 16623: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16624: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16625: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16626: '<input type="hidden" name="catname" value="'.$name.'" />'.
16627: '</td><td>';
1.663 raeburn 16628: if (ref($path) eq 'ARRAY') {
16629: push(@{$path},$name);
1.1259 raeburn 16630: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16631: pop(@{$path});
16632: }
16633: $text .= '</td></tr>';
16634: }
16635: $text .= '</table></td>';
16636: }
16637: }
16638: }
16639: return $text;
16640: }
16641:
1.1181 raeburn 16642: =pod
16643:
16644: =back
16645:
16646: =cut
16647:
1.655 raeburn 16648: ############################################################
16649: ############################################################
16650:
16651:
1.443 albertel 16652: sub commit_customrole {
1.1408 raeburn 16653: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
1.1399 raeburn 16654: my $result = &Apache::lonnet::assigncustomrole(
1.1408 raeburn 16655: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
16656: $context,$othdomby,$requester);
1.630 raeburn 16657: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16658: ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399 raeburn 16659: ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
16660: if (wantarray) {
16661: return ($output,$result);
16662: } else {
16663: return $output;
16664: }
1.443 albertel 16665: }
16666:
16667: sub commit_standardrole {
1.1408 raeburn 16668: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits,
16669: $othdomby,$requester) = @_;
1.1399 raeburn 16670: my ($output,$logmsg,$linefeed,$result);
1.541 raeburn 16671: if ($context eq 'auto') {
16672: $linefeed = "\n";
16673: } else {
16674: $linefeed = "<br />\n";
16675: }
1.443 albertel 16676: if ($three eq 'st') {
1.1399 raeburn 16677: $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1408 raeburn 16678: $one,$two,$sec,$context,$credits,$othdomby,
16679: $requester);
1.541 raeburn 16680: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16681: ($result eq 'unknown_course') || ($result eq 'refused')) {
16682: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16683: } else {
1.541 raeburn 16684: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16685: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16686: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16687: if ($context eq 'auto') {
16688: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16689: } else {
16690: $output .= '<b>'.$result.'</b>'.$linefeed.
16691: &mt('Add to classlist').': <b>ok</b>';
16692: }
16693: $output .= $linefeed;
1.443 albertel 16694: }
16695: } else {
16696: $output = &mt('Assigning').' '.$three.' in '.$url.
16697: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16698: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1408 raeburn 16699: $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,
16700: '','',$context,$othdomby,$requester);
1.541 raeburn 16701: if ($context eq 'auto') {
16702: $output .= $result.$linefeed;
16703: } else {
16704: $output .= '<b>'.$result.'</b>'.$linefeed;
16705: }
1.443 albertel 16706: }
1.1399 raeburn 16707: if (wantarray) {
16708: return ($output,$result);
16709: } else {
16710: return $output;
16711: }
1.443 albertel 16712: }
16713:
16714: sub commit_studentrole {
1.1116 raeburn 16715: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
1.1408 raeburn 16716: $credits,$othdomby,$requester) = @_;
1.626 raeburn 16717: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16718: if ($context eq 'auto') {
16719: $linefeed = "\n";
16720: } else {
16721: $linefeed = '<br />'."\n";
16722: }
1.443 albertel 16723: if (defined($one) && defined($two)) {
16724: my $cid=$one.'_'.$two;
16725: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16726: my $secchange = 0;
16727: my $expire_role_result;
16728: my $modify_section_result;
1.628 raeburn 16729: if ($oldsec ne '-1') {
16730: if ($oldsec ne $sec) {
1.443 albertel 16731: $secchange = 1;
1.628 raeburn 16732: my $now = time;
1.443 albertel 16733: my $uurl='/'.$cid;
16734: $uurl=~s/\_/\//g;
16735: if ($oldsec) {
16736: $uurl.='/'.$oldsec;
16737: }
1.626 raeburn 16738: $oldsecurl = $uurl;
1.628 raeburn 16739: $expire_role_result =
1.1408 raeburn 16740: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
16741: '','','',$context,$othdomby,$requester);
16742: if ($env{'request.course.sec'} ne '') {
1.628 raeburn 16743: if ($expire_role_result eq 'refused') {
16744: my @roles = ('st');
16745: my @statuses = ('previous');
16746: my @roledoms = ($one);
16747: my $withsec = 1;
16748: my %roleshash =
16749: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16750: \@statuses,\@roles,\@roledoms,$withsec);
16751: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16752: my ($oldstart,$oldend) =
16753: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16754: if ($oldend > 0 && $oldend <= $now) {
16755: $expire_role_result = 'ok';
16756: }
16757: }
16758: }
16759: }
1.443 albertel 16760: $result = $expire_role_result;
16761: }
16762: }
16763: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 16764: $modify_section_result =
16765: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16766: undef,undef,undef,$sec,
16767: $end,$start,'','',$cid,
1.1408 raeburn 16768: '',$context,$credits,'',
16769: $othdomby,$requester);
1.443 albertel 16770: if ($modify_section_result =~ /^ok/) {
16771: if ($secchange == 1) {
1.628 raeburn 16772: if ($sec eq '') {
16773: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16774: } else {
16775: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16776: }
1.443 albertel 16777: } elsif ($oldsec eq '-1') {
1.628 raeburn 16778: if ($sec eq '') {
16779: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16780: } else {
16781: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16782: }
1.443 albertel 16783: } else {
1.628 raeburn 16784: if ($sec eq '') {
16785: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16786: } else {
16787: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16788: }
1.443 albertel 16789: }
16790: } else {
1.1115 raeburn 16791: if ($secchange) {
1.628 raeburn 16792: $$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;
16793: } else {
16794: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16795: }
1.443 albertel 16796: }
16797: $result = $modify_section_result;
16798: } elsif ($secchange == 1) {
1.628 raeburn 16799: if ($oldsec eq '') {
1.1103 raeburn 16800: $$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 16801: } else {
16802: $$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;
16803: }
1.626 raeburn 16804: if ($expire_role_result eq 'refused') {
16805: my $newsecurl = '/'.$cid;
16806: $newsecurl =~ s/\_/\//g;
16807: if ($sec ne '') {
16808: $newsecurl.='/'.$sec;
16809: }
16810: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16811: if ($sec eq '') {
16812: $$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;
16813: } else {
16814: $$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;
16815: }
16816: }
16817: }
1.443 albertel 16818: }
16819: } else {
1.626 raeburn 16820: $$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 16821: $result = "error: incomplete course id\n";
16822: }
16823: return $result;
16824: }
16825:
1.1108 raeburn 16826: sub show_role_extent {
16827: my ($scope,$context,$role) = @_;
16828: $scope =~ s{^/}{};
16829: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16830: push(@courseroles,'co');
16831: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16832: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16833: $scope =~ s{/}{_};
16834: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16835: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16836: my ($audom,$auname) = split(/\//,$scope);
16837: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16838: &Apache::loncommon::plainname($auname,$audom).'</span>');
16839: } else {
16840: $scope =~ s{/$}{};
16841: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16842: &Apache::lonnet::domain($scope,'description').'</span>');
16843: }
16844: }
16845:
1.443 albertel 16846: ############################################################
16847: ############################################################
16848:
1.566 albertel 16849: sub check_clone {
1.578 raeburn 16850: my ($args,$linefeed) = @_;
1.566 albertel 16851: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16852: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16853: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 16854: my $clonetitle;
16855: my @clonemsg;
1.566 albertel 16856: my $can_clone = 0;
1.944 raeburn 16857: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16858: if ($lctype ne 'community') {
16859: $lctype = 'course';
16860: }
1.566 albertel 16861: if ($clonehome eq 'no_host') {
1.944 raeburn 16862: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16863: push(@clonemsg,({
16864: mt => 'No new community created.',
16865: args => [],
16866: },
16867: {
16868: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16869: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16870: }));
1.908 raeburn 16871: } else {
1.1344 raeburn 16872: push(@clonemsg,({
16873: mt => 'No new course created.',
16874: args => [],
16875: },
16876: {
16877: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16878: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16879: }));
16880: }
1.566 albertel 16881: } else {
16882: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 16883: $clonetitle = $clonedesc{'description'};
1.944 raeburn 16884: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16885: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 16886: push(@clonemsg,({
16887: mt => 'No new community created.',
16888: args => [],
16889: },
16890: {
16891: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16892: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16893: }));
16894: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16895: }
16896: }
1.1262 raeburn 16897: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16898: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16899: $can_clone = 1;
16900: } else {
1.1221 raeburn 16901: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16902: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 16903: if ($clonehash{'cloners'} eq '') {
16904: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16905: if ($domdefs{'canclone'}) {
16906: unless ($domdefs{'canclone'} eq 'none') {
16907: if ($domdefs{'canclone'} eq 'domain') {
16908: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
16909: $can_clone = 1;
16910: }
16911: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16912: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
16913: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
16914: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
16915: $can_clone = 1;
16916: }
16917: }
16918: }
16919: }
1.578 raeburn 16920: } else {
1.1221 raeburn 16921: my @cloners = split(/,/,$clonehash{'cloners'});
16922: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 16923: $can_clone = 1;
1.1221 raeburn 16924: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 16925: $can_clone = 1;
1.1225 raeburn 16926: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
16927: $can_clone = 1;
1.1221 raeburn 16928: }
16929: unless ($can_clone) {
1.1225 raeburn 16930: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16931: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 16932: my (%gotdomdefaults,%gotcodedefaults);
16933: foreach my $cloner (@cloners) {
16934: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
16935: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
16936: my (%codedefaults,@code_order);
16937: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
16938: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
16939: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
16940: }
16941: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
16942: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
16943: }
16944: } else {
16945: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
16946: \%codedefaults,
16947: \@code_order);
16948: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
16949: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
16950: }
16951: if (@code_order > 0) {
16952: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
16953: $cloner,$clonehash{'internal.coursecode'},
16954: $args->{'crscode'})) {
16955: $can_clone = 1;
16956: last;
16957: }
16958: }
16959: }
16960: }
16961: }
1.1225 raeburn 16962: }
16963: }
16964: unless ($can_clone) {
16965: my $ccrole = 'cc';
16966: if ($args->{'crstype'} eq 'Community') {
16967: $ccrole = 'co';
16968: }
16969: my %roleshash =
16970: &Apache::lonnet::get_my_roles($args->{'ccuname'},
16971: $args->{'ccdomain'},
16972: 'userroles',['active'],[$ccrole],
16973: [$args->{'clonedomain'}]);
16974: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
16975: $can_clone = 1;
16976: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
16977: $args->{'ccuname'},$args->{'ccdomain'})) {
16978: $can_clone = 1;
1.1221 raeburn 16979: }
16980: }
16981: unless ($can_clone) {
16982: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16983: push(@clonemsg,({
16984: mt => 'No new community created.',
16985: args => [],
16986: },
16987: {
16988: 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]).',
16989: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16990: }));
1.942 raeburn 16991: } else {
1.1344 raeburn 16992: push(@clonemsg,({
16993: mt => 'No new course created.',
16994: args => [],
16995: },
16996: {
16997: 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]).',
16998: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16999: }));
1.1221 raeburn 17000: }
1.566 albertel 17001: }
1.578 raeburn 17002: }
1.566 albertel 17003: }
1.1344 raeburn 17004: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17005: }
17006:
1.444 albertel 17007: sub construct_course {
1.1262 raeburn 17008: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 17009: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
17010: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 17011: my $linefeed = '<br />'."\n";
17012: if ($context eq 'auto') {
17013: $linefeed = "\n";
17014: }
1.566 albertel 17015:
17016: #
17017: # Are we cloning?
17018: #
1.1344 raeburn 17019: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17020: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 17021: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 17022: if (!$can_clone) {
1.1344 raeburn 17023: return (0,$outcome,$clonemsgref);
1.566 albertel 17024: }
17025: }
17026:
1.444 albertel 17027: #
17028: # Open course
17029: #
1.1239 raeburn 17030: my $showncrstype;
17031: if ($args->{'crstype'} eq 'Placement') {
17032: $showncrstype = 'placement test';
17033: } else {
17034: $showncrstype = lc($args->{'crstype'});
17035: }
1.444 albertel 17036: my %cenv=();
17037: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
17038: $args->{'cdescr'},
17039: $args->{'curl'},
17040: $args->{'course_home'},
17041: $args->{'nonstandard'},
17042: $args->{'crscode'},
17043: $args->{'ccuname'}.':'.
17044: $args->{'ccdomain'},
1.882 raeburn 17045: $args->{'crstype'},
1.1344 raeburn 17046: $cnum,$context,$category,
17047: $callercontext);
1.444 albertel 17048:
17049: # Note: The testing routines depend on this being output; see
17050: # Utils::Course. This needs to at least be output as a comment
17051: # if anyone ever decides to not show this, and Utils::Course::new
17052: # will need to be suitably modified.
1.1344 raeburn 17053: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17054: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17055: } else {
17056: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17057: }
1.943 raeburn 17058: if ($$courseid =~ /^error:/) {
1.1344 raeburn 17059: return (0,$outcome,$clonemsgref);
1.943 raeburn 17060: }
17061:
1.444 albertel 17062: #
17063: # Check if created correctly
17064: #
1.479 albertel 17065: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 17066: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 17067: if ($crsuhome eq 'no_host') {
1.1344 raeburn 17068: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17069: $outcome .= &mt_user($user_lh,
17070: 'Course creation failed, unrecognized course home server.');
17071: } else {
17072: $outcome .= &mt('Course creation failed, unrecognized course home server.');
17073: }
17074: $outcome .= $linefeed;
17075: return (0,$outcome,$clonemsgref);
1.943 raeburn 17076: }
1.541 raeburn 17077: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 17078:
1.444 albertel 17079: #
1.566 albertel 17080: # Do the cloning
17081: #
1.1344 raeburn 17082: my @clonemsg;
1.566 albertel 17083: if ($can_clone && $cloneid) {
1.1344 raeburn 17084: push(@clonemsg,
17085: {
17086: mt => 'Created [_1] by cloning from [_2]',
17087: args => [$showncrstype,$clonetitle],
17088: });
1.566 albertel 17089: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 17090: # Copy all files
1.1344 raeburn 17091: my @info =
17092: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
17093: $args->{'dateshift'},$args->{'crscode'},
17094: $args->{'ccuname'}.':'.$args->{'ccdomain'},
17095: $args->{'tinyurls'});
17096: if (@info) {
17097: push(@clonemsg,@info);
17098: }
1.444 albertel 17099: # Restore URL
1.566 albertel 17100: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 17101: # Restore title
1.566 albertel 17102: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 17103: # Restore creation date, creator and creation context.
17104: $cenv{'internal.created'}=$oldcenv{'internal.created'};
17105: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
17106: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 17107: # Mark as cloned
1.566 albertel 17108: $cenv{'clonedfrom'}=$cloneid;
1.638 www 17109: # Need to clone grading mode
17110: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
17111: $cenv{'grading'}=$newenv{'grading'};
17112: # Do not clone these environment entries
17113: &Apache::lonnet::del('environment',
17114: ['default_enrollment_start_date',
17115: 'default_enrollment_end_date',
17116: 'question.email',
17117: 'policy.email',
17118: 'comment.email',
17119: 'pch.users.denied',
1.725 raeburn 17120: 'plc.users.denied',
17121: 'hidefromcat',
1.1121 raeburn 17122: 'checkforpriv',
1.1355 raeburn 17123: 'categories'],
1.638 www 17124: $$crsudom,$$crsunum);
1.1170 raeburn 17125: if ($args->{'textbook'}) {
17126: $cenv{'internal.textbook'} = $args->{'textbook'};
17127: }
1.444 albertel 17128: }
1.566 albertel 17129:
1.444 albertel 17130: #
17131: # Set environment (will override cloned, if existing)
17132: #
17133: my @sections = ();
17134: my @xlists = ();
17135: if ($args->{'crstype'}) {
17136: $cenv{'type'}=$args->{'crstype'};
17137: }
1.1371 raeburn 17138: if ($args->{'lti'}) {
17139: $cenv{'internal.lti'}=$args->{'lti'};
17140: }
1.444 albertel 17141: if ($args->{'crsid'}) {
17142: $cenv{'courseid'}=$args->{'crsid'};
17143: }
17144: if ($args->{'crscode'}) {
17145: $cenv{'internal.coursecode'}=$args->{'crscode'};
17146: }
17147: if ($args->{'crsquota'} ne '') {
17148: $cenv{'internal.coursequota'}=$args->{'crsquota'};
17149: } else {
17150: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
17151: }
17152: if ($args->{'ccuname'}) {
17153: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
17154: ':'.$args->{'ccdomain'};
17155: } else {
17156: $cenv{'internal.courseowner'} = $args->{'curruser'};
17157: }
1.1116 raeburn 17158: if ($args->{'defaultcredits'}) {
17159: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
17160: }
1.444 albertel 17161: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1412 raeburn 17162: my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444 albertel 17163: if ($args->{'crssections'}) {
17164: $cenv{'internal.sectionnums'} = '';
17165: if ($args->{'crssections'} =~ m/,/) {
17166: @sections = split/,/,$args->{'crssections'};
17167: } else {
17168: $sections[0] = $args->{'crssections'};
17169: }
17170: if (@sections > 0) {
17171: foreach my $item (@sections) {
17172: my ($sec,$gp) = split/:/,$item;
17173: my $class = $args->{'crscode'}.$sec;
17174: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
17175: $cenv{'internal.sectionnums'} .= $item.',';
1.1412 raeburn 17176: if ($addcheck eq 'ok') {
17177: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17178: push(@oklcsecs,$gp);
17179: }
17180: } else {
1.1263 raeburn 17181: push(@badclasses,$class);
1.444 albertel 17182: }
17183: }
17184: $cenv{'internal.sectionnums'} =~ s/,$//;
17185: }
17186: }
17187: # do not hide course coordinator from staff listing,
17188: # even if privileged
17189: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 17190: # add course coordinator's domain to domains to check for privileged users
17191: # if different to course domain
17192: if ($$crsudom ne $args->{'ccdomain'}) {
17193: $cenv{'checkforpriv'} = $args->{'ccdomain'};
17194: }
1.444 albertel 17195: # add crosslistings
17196: if ($args->{'crsxlist'}) {
17197: $cenv{'internal.crosslistings'}='';
17198: if ($args->{'crsxlist'} =~ m/,/) {
17199: @xlists = split/,/,$args->{'crsxlist'};
17200: } else {
17201: $xlists[0] = $args->{'crsxlist'};
17202: }
17203: if (@xlists > 0) {
17204: foreach my $item (@xlists) {
17205: my ($xl,$gp) = split/:/,$item;
17206: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
17207: $cenv{'internal.crosslistings'} .= $item.',';
1.1412 raeburn 17208: if ($addcheck eq 'ok') {
17209: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17210: push(@oklcsecs,$gp);
17211: }
17212: } else {
1.1263 raeburn 17213: push(@badclasses,$xl);
1.444 albertel 17214: }
17215: }
17216: $cenv{'internal.crosslistings'} =~ s/,$//;
17217: }
17218: }
17219: if ($args->{'autoadds'}) {
17220: $cenv{'internal.autoadds'}=$args->{'autoadds'};
17221: }
17222: if ($args->{'autodrops'}) {
17223: $cenv{'internal.autodrops'}=$args->{'autodrops'};
17224: }
17225: # check for notification of enrollment changes
17226: my @notified = ();
17227: if ($args->{'notify_owner'}) {
17228: if ($args->{'ccuname'} ne '') {
17229: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
17230: }
17231: }
17232: if ($args->{'notify_dc'}) {
17233: if ($uname ne '') {
1.630 raeburn 17234: push(@notified,$uname.':'.$udom);
1.444 albertel 17235: }
17236: }
17237: if (@notified > 0) {
17238: my $notifylist;
17239: if (@notified > 1) {
17240: $notifylist = join(',',@notified);
17241: } else {
17242: $notifylist = $notified[0];
17243: }
17244: $cenv{'internal.notifylist'} = $notifylist;
17245: }
17246: if (@badclasses > 0) {
17247: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 17248: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
17249: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
17250: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 17251: );
1.1264 raeburn 17252: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
17253: &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
1.541 raeburn 17254: if ($context eq 'auto') {
17255: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 17256: } else {
1.566 albertel 17257: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 17258: }
17259: foreach my $item (@badclasses) {
1.541 raeburn 17260: if ($context eq 'auto') {
1.1261 raeburn 17261: $outcome .= " - $item\n";
1.541 raeburn 17262: } else {
1.1261 raeburn 17263: $outcome .= "<li>$item</li>\n";
1.541 raeburn 17264: }
1.1261 raeburn 17265: }
17266: if ($context eq 'auto') {
17267: $outcome .= $linefeed;
17268: } else {
17269: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 17270: }
1.444 albertel 17271: }
17272: if ($args->{'no_end_date'}) {
17273: $args->{'endaccess'} = 0;
17274: }
1.1412 raeburn 17275: # If an official course with institutional sections is created by cloning
17276: # an existing course, section-specific hiding of course totals in student's
17277: # view of grades as copied from cloned course, will be checked for valid
17278: # sections.
17279: if (($can_clone && $cloneid) &&
17280: ($cenv{'internal.coursecode'} ne '') &&
17281: ($cenv{'grading'} eq 'standard') &&
17282: ($cenv{'hidetotals'} ne '') &&
17283: ($cenv{'hidetotals'} ne 'all')) {
17284: my @hidesecs;
17285: my $deletehidetotals;
17286: if (@oklcsecs) {
17287: foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
17288: if (grep(/^\Q$sec$/,@oklcsecs)) {
17289: push(@hidesecs,$sec);
17290: }
17291: }
17292: if (@hidesecs) {
17293: $cenv{'hidetotals'} = join(',',@hidesecs);
17294: } else {
17295: $deletehidetotals = 1;
17296: }
17297: } else {
17298: $deletehidetotals = 1;
17299: }
17300: if ($deletehidetotals) {
17301: delete($cenv{'hidetotals'});
17302: &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
17303: }
17304: }
1.444 albertel 17305: $cenv{'internal.autostart'}=$args->{'enrollstart'};
17306: $cenv{'internal.autoend'}=$args->{'enrollend'};
17307: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
17308: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
17309: if ($args->{'showphotos'}) {
17310: $cenv{'internal.showphotos'}=$args->{'showphotos'};
17311: }
17312: $cenv{'internal.authtype'} = $args->{'authtype'};
17313: $cenv{'internal.autharg'} = $args->{'autharg'};
17314: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
17315: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 17316: 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');
17317: if ($context eq 'auto') {
17318: $outcome .= $krb_msg;
17319: } else {
1.566 albertel 17320: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 17321: }
17322: $outcome .= $linefeed;
1.444 albertel 17323: }
17324: }
17325: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
17326: if ($args->{'setpolicy'}) {
17327: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17328: }
17329: if ($args->{'setcontent'}) {
17330: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17331: }
1.1251 raeburn 17332: if ($args->{'setcomment'}) {
17333: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17334: }
1.444 albertel 17335: }
17336: if ($args->{'reshome'}) {
17337: $cenv{'reshome'}=$args->{'reshome'}.'/';
17338: $cenv{'reshome'}=~s/\/+$/\//;
17339: }
17340: #
17341: # course has keyed access
17342: #
17343: if ($args->{'setkeys'}) {
17344: $cenv{'keyaccess'}='yes';
17345: }
17346: # if specified, key authority is not course, but user
17347: # only active if keyaccess is yes
17348: if ($args->{'keyauth'}) {
1.487 albertel 17349: my ($user,$domain) = split(':',$args->{'keyauth'});
17350: $user = &LONCAPA::clean_username($user);
17351: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 17352: if ($user ne '' && $domain ne '') {
1.487 albertel 17353: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 17354: }
17355: }
17356:
1.1166 raeburn 17357: #
1.1167 raeburn 17358: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 17359: #
17360: if ($args->{'uniquecode'}) {
17361: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
17362: if ($code) {
17363: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 17364: my %crsinfo =
17365: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
17366: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
17367: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
17368: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
17369: }
1.1166 raeburn 17370: if (ref($coderef)) {
17371: $$coderef = $code;
17372: }
17373: }
17374: }
17375:
1.444 albertel 17376: if ($args->{'disresdis'}) {
17377: $cenv{'pch.roles.denied'}='st';
17378: }
17379: if ($args->{'disablechat'}) {
17380: $cenv{'plc.roles.denied'}='st';
17381: }
17382:
17383: # Record we've not yet viewed the Course Initialization Helper for this
17384: # course
17385: $cenv{'course.helper.not.run'} = 1;
17386: #
17387: # Use new Randomseed
17388: #
17389: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
17390: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
17391: #
17392: # The encryption code and receipt prefix for this course
17393: #
17394: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
17395: $cenv{'internal.encpref'}=100+int(9*rand(99));
17396: #
17397: # By default, use standard grading
17398: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
17399:
1.541 raeburn 17400: $outcome .= $linefeed.&mt('Setting environment').': '.
17401: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17402: #
17403: # Open all assignments
17404: #
17405: if ($args->{'openall'}) {
1.1341 raeburn 17406: my $opendate = time;
17407: if ($args->{'openallfrom'} =~ /^\d+$/) {
17408: $opendate = $args->{'openallfrom'};
17409: }
1.444 albertel 17410: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 17411: my %storecontent = ($storeunder => $opendate,
1.444 albertel 17412: $storeunder.'.type' => 'date_start');
1.1341 raeburn 17413: $outcome .= &mt('All assignments open starting [_1]',
17414: &Apache::lonlocal::locallocaltime($opendate)).': '.
17415: &Apache::lonnet::cput
17416: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17417: }
17418: #
17419: # Set first page
17420: #
17421: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
17422: || ($cloneid)) {
17423: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 17424:
17425: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
17426: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
17427:
1.444 albertel 17428: $outcome .= ($fatal?$errtext:'read ok').' - ';
17429: my $title; my $url;
17430: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 17431: $title=&mt('Syllabus');
1.444 albertel 17432: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
17433: } else {
1.963 raeburn 17434: $title=&mt('Table of Contents');
1.444 albertel 17435: $url='/adm/navmaps';
17436: }
1.445 albertel 17437:
17438: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
17439: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
17440:
17441: if ($errtext) { $fatal=2; }
1.541 raeburn 17442: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 17443: }
1.566 albertel 17444:
1.1237 raeburn 17445: #
17446: # Set params for Placement Tests
17447: #
1.1239 raeburn 17448: if ($args->{'crstype'} eq 'Placement') {
17449: my %storecontent;
17450: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
17451: my %defaults = (
17452: buttonshide => { value => 'yes',
17453: type => 'string_yesno',},
17454: type => { value => 'randomizetry',
17455: type => 'string_questiontype',},
17456: maxtries => { value => 1,
17457: type => 'int_pos',},
17458: problemstatus => { value => 'no',
17459: type => 'string_problemstatus',},
17460: );
17461: foreach my $key (keys(%defaults)) {
17462: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
17463: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
17464: }
1.1237 raeburn 17465: &Apache::lonnet::cput
17466: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17467: }
17468:
1.1344 raeburn 17469: return (1,$outcome,\@clonemsg);
1.444 albertel 17470: }
17471:
1.1166 raeburn 17472: sub make_unique_code {
17473: my ($cdom,$cnum) = @_;
17474: # get lock on uniquecodes db
17475: my $lockhash = {
17476: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17477: ':'.$env{'user.domain'},
17478: };
17479: my $tries = 0;
17480: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17481: my ($code,$error);
17482:
17483: while (($gotlock ne 'ok') && ($tries<3)) {
17484: $tries ++;
17485: sleep 1;
17486: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17487: }
17488: if ($gotlock eq 'ok') {
17489: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17490: my $gotcode;
17491: my $attempts = 0;
17492: while ((!$gotcode) && ($attempts < 100)) {
17493: $code = &generate_code();
17494: if (!exists($currcodes{$code})) {
17495: $gotcode = 1;
17496: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17497: $error = 'nostore';
17498: }
17499: }
17500: $attempts ++;
17501: }
17502: my @del_lock = ($cnum."\0".'uniquecodes');
17503: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17504: } else {
17505: $error = 'nolock';
17506: }
17507: return ($code,$error);
17508: }
17509:
17510: sub generate_code {
17511: my $code;
17512: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17513: for (my $i=0; $i<6; $i++) {
17514: my $lettnum = int (rand 2);
17515: my $item = '';
17516: if ($lettnum) {
17517: $item = $letts[int( rand(18) )];
17518: } else {
17519: $item = 1+int( rand(8) );
17520: }
17521: $code .= $item;
17522: }
17523: return $code;
17524: }
17525:
1.444 albertel 17526: ############################################################
17527: ############################################################
17528:
1.1237 raeburn 17529: # Community, Course and Placement Test
1.378 raeburn 17530: sub course_type {
17531: my ($cid) = @_;
17532: if (!defined($cid)) {
17533: $cid = $env{'request.course.id'};
17534: }
1.404 albertel 17535: if (defined($env{'course.'.$cid.'.type'})) {
17536: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17537: } else {
17538: return 'Course';
1.377 raeburn 17539: }
17540: }
1.156 albertel 17541:
1.406 raeburn 17542: sub group_term {
17543: my $crstype = &course_type();
17544: my %names = (
17545: 'Course' => 'group',
1.865 raeburn 17546: 'Community' => 'group',
1.1237 raeburn 17547: 'Placement' => 'group',
1.406 raeburn 17548: );
17549: return $names{$crstype};
17550: }
17551:
1.902 raeburn 17552: sub course_types {
1.1310 raeburn 17553: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17554: my %typename = (
17555: official => 'Official course',
17556: unofficial => 'Unofficial course',
17557: community => 'Community',
1.1165 raeburn 17558: textbook => 'Textbook course',
1.1237 raeburn 17559: placement => 'Placement test',
1.1310 raeburn 17560: lti => 'LTI provider',
1.902 raeburn 17561: );
17562: return (\@types,\%typename);
17563: }
17564:
1.156 albertel 17565: sub icon {
17566: my ($file)=@_;
1.505 albertel 17567: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17568: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17569: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17570: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17571: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17572: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17573: $curfext.".gif") {
17574: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17575: $curfext.".gif";
17576: }
17577: }
1.249 albertel 17578: return &lonhttpdurl($iconname);
1.154 albertel 17579: }
1.84 albertel 17580:
1.575 albertel 17581: sub lonhttpdurl {
1.692 www 17582: #
17583: # Had been used for "small fry" static images on separate port 8080.
17584: # Modify here if lightweight http functionality desired again.
17585: # Currently eliminated due to increasing firewall issues.
17586: #
1.575 albertel 17587: my ($url)=@_;
1.692 www 17588: return $url;
1.215 albertel 17589: }
17590:
1.213 albertel 17591: sub connection_aborted {
17592: my ($r)=@_;
17593: $r->print(" ");$r->rflush();
17594: my $c = $r->connection;
17595: return $c->aborted();
17596: }
17597:
1.221 foxr 17598: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17599: # strings as 'strings'.
17600: sub escape_single {
1.221 foxr 17601: my ($input) = @_;
1.223 albertel 17602: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17603: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17604: return $input;
17605: }
1.223 albertel 17606:
1.222 foxr 17607: # Same as escape_single, but escape's "'s This
17608: # can be used for "strings"
17609: sub escape_double {
17610: my ($input) = @_;
17611: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17612: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17613: return $input;
17614: }
1.223 albertel 17615:
1.222 foxr 17616: # Escapes the last element of a full URL.
17617: sub escape_url {
17618: my ($url) = @_;
1.238 raeburn 17619: my @urlslices = split(/\//, $url,-1);
1.369 www 17620: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17621: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17622: }
1.462 albertel 17623:
1.820 raeburn 17624: sub compare_arrays {
17625: my ($arrayref1,$arrayref2) = @_;
17626: my (@difference,%count);
17627: @difference = ();
17628: %count = ();
17629: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17630: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17631: foreach my $element (keys(%count)) {
17632: if ($count{$element} == 1) {
17633: push(@difference,$element);
17634: }
17635: }
17636: }
17637: return @difference;
17638: }
17639:
1.1322 raeburn 17640: sub lon_status_items {
17641: my %defaults = (
17642: E => 100,
17643: W => 4,
17644: N => 1,
1.1324 raeburn 17645: U => 5,
1.1322 raeburn 17646: threshold => 200,
17647: sysmail => 2500,
17648: );
17649: my %names = (
17650: E => 'Errors',
17651: W => 'Warnings',
17652: N => 'Notices',
1.1324 raeburn 17653: U => 'Unsent',
1.1322 raeburn 17654: );
17655: return (\%defaults,\%names);
17656: }
17657:
1.817 bisitz 17658: # -------------------------------------------------------- Initialize user login
1.462 albertel 17659: sub init_user_environment {
1.463 albertel 17660: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17661: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17662:
17663: my $public=($username eq 'public' && $domain eq 'public');
17664:
1.1415 raeburn 17665: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
17666: $coauthorenv);
1.462 albertel 17667: my $now=time;
17668:
17669: if ($public) {
17670: my $max_public=100;
17671: my $oldest;
17672: my $oldest_time=0;
17673: for(my $next=1;$next<=$max_public;$next++) {
17674: if (-e $lonids."/publicuser_$next.id") {
17675: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17676: if ($mtime<$oldest_time || !$oldest_time) {
17677: $oldest_time=$mtime;
17678: $oldest=$next;
17679: }
17680: } else {
17681: $cookie="publicuser_$next";
17682: last;
17683: }
17684: }
17685: if (!$cookie) { $cookie="publicuser_$oldest"; }
17686: } else {
1.1275 raeburn 17687: # See if old ID present, if so, remove if this isn't a robot,
17688: # killing any existing non-robot sessions
1.463 albertel 17689: if (!$args->{'robot'}) {
17690: opendir(DIR,$lonids);
17691: while ($filename=readdir(DIR)) {
17692: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 17693: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17694: &GDBM_READER(),0640)) {
1.1295 raeburn 17695: my $linkedfile;
1.1320 raeburn 17696: if (exists($oldenv{'user.linkedenv'})) {
17697: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 17698: }
1.1320 raeburn 17699: untie(%oldenv);
17700: if (unlink("$lonids/$filename")) {
17701: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17702: if (-l "$lonids/$linkedfile.id") {
17703: unlink("$lonids/$linkedfile.id");
17704: }
1.1295 raeburn 17705: }
17706: }
17707: } else {
17708: unlink($lonids.'/'.$filename);
17709: }
1.463 albertel 17710: }
1.462 albertel 17711: }
1.463 albertel 17712: closedir(DIR);
1.1204 raeburn 17713: # If there is a undeleted lockfile for the user's paste buffer remove it.
17714: my $namespace = 'nohist_courseeditor';
17715: my $lockingkey = 'paste'."\0".'locked_num';
17716: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17717: $domain,$username);
17718: if (exists($lockhash{$lockingkey})) {
17719: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17720: unless ($delresult eq 'ok') {
17721: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17722: }
17723: }
1.462 albertel 17724: }
17725: # Give them a new cookie
1.463 albertel 17726: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17727: : $now.$$.int(rand(10000)));
1.463 albertel 17728: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17729:
17730: # Initialize roles
17731:
1.1414 raeburn 17732: ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
1.1062 raeburn 17733: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17734: }
17735: # ------------------------------------ Check browser type and MathML capability
17736:
1.1194 raeburn 17737: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17738: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17739:
17740: # ------------------------------------------------------------- Get environment
17741:
17742: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17743: my ($tmp) = keys(%userenv);
1.1275 raeburn 17744: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 17745: undef(%userenv);
17746: }
17747: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17748: $form->{'interface'}=$userenv{'interface'};
17749: }
17750: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17751:
17752: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17753: foreach my $option ('interface','localpath','localres') {
17754: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17755: }
17756: # --------------------------------------------------------- Write first profile
17757:
17758: {
1.1350 raeburn 17759: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 17760: my %initial_env =
17761: ("user.name" => $username,
17762: "user.domain" => $domain,
17763: "user.home" => $authhost,
17764: "browser.type" => $clientbrowser,
17765: "browser.version" => $clientversion,
17766: "browser.mathml" => $clientmathml,
17767: "browser.unicode" => $clientunicode,
17768: "browser.os" => $clientos,
1.1137 raeburn 17769: "browser.mobile" => $clientmobile,
1.1141 raeburn 17770: "browser.info" => $clientinfo,
1.1194 raeburn 17771: "browser.osversion" => $clientosversion,
1.462 albertel 17772: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17773: "request.course.fn" => '',
17774: "request.course.uri" => '',
17775: "request.course.sec" => '',
17776: "request.role" => 'cm',
17777: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 17778: "request.host" => $ip,);
1.462 albertel 17779:
17780: if ($form->{'localpath'}) {
17781: $initial_env{"browser.localpath"} = $form->{'localpath'};
17782: $initial_env{"browser.localres"} = $form->{'localres'};
17783: }
17784:
17785: if ($form->{'interface'}) {
17786: $form->{'interface'}=~s/\W//gs;
17787: $initial_env{"browser.interface"} = $form->{'interface'};
17788: $env{'browser.interface'}=$form->{'interface'};
17789: }
17790:
1.1157 raeburn 17791: if ($form->{'iptoken'}) {
17792: my $lonhost = $r->dir_config('lonHostID');
17793: $initial_env{"user.noloadbalance"} = $lonhost;
17794: $env{'user.noloadbalance'} = $lonhost;
17795: }
17796:
1.1268 raeburn 17797: if ($form->{'noloadbalance'}) {
17798: my @hosts = &Apache::lonnet::current_machine_ids();
17799: my $hosthere = $form->{'noloadbalance'};
17800: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17801: $initial_env{"user.noloadbalance"} = $hosthere;
17802: $env{'user.noloadbalance'} = $hosthere;
17803: }
17804: }
17805:
1.1016 raeburn 17806: unless ($domain eq 'public') {
1.1273 raeburn 17807: my %is_adv = ( is_adv => $env{'user.adv'} );
17808: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
17809:
1.1414 raeburn 17810: foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
17811: $userenv{'availabletools.'.$tool} =
1.1273 raeburn 17812: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17813: undef,\%userenv,\%domdef,\%is_adv);
17814: }
1.980 raeburn 17815:
1.1311 raeburn 17816: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 17817: $userenv{'canrequest.'.$crstype} =
17818: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17819: 'reload','requestcourses',
17820: \%userenv,\%domdef,\%is_adv);
17821: }
1.724 raeburn 17822:
1.1418 raeburn 17823: if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
17824: (exists($userroles->{"user.role.au./$domain/"}))) {
17825: if ($userenv{'authoreditors'}) {
17826: $userenv{'editors'} = $userenv{'authoreditors'};
17827: } elsif ($domdef{'editors'} ne '') {
17828: $userenv{'editors'} = $domdef{'editors'};
17829: } else {
17830: $userenv{'editors'} = 'edit,xml';
17831: }
17832: }
17833:
1.1273 raeburn 17834: $userenv{'canrequest.author'} =
17835: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17836: 'reload','requestauthor',
1.980 raeburn 17837: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 17838: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17839: $domain,$username);
17840: my $reqstatus = $reqauthor{'author_status'};
17841: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17842: if (ref($reqauthor{'author'}) eq 'HASH') {
17843: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17844: $reqauthor{'author'}{'timestamp'};
17845: }
1.1092 raeburn 17846: }
1.1287 raeburn 17847: my ($types,$typename) = &course_types();
17848: if (ref($types) eq 'ARRAY') {
17849: my @options = ('approval','validate','autolimit');
17850: my $optregex = join('|',@options);
17851: my (%willtrust,%trustchecked);
17852: foreach my $type (@{$types}) {
17853: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
17854: if ($dom_str ne '') {
17855: my $updatedstr = '';
17856: my @possdomains = split(',',$dom_str);
17857: foreach my $entry (@possdomains) {
17858: my ($extdom,$extopt) = split(':',$entry);
17859: unless ($trustchecked{$extdom}) {
17860: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
17861: $trustchecked{$extdom} = 1;
17862: }
17863: if ($willtrust{$extdom}) {
17864: $updatedstr .= $entry.',';
17865: }
17866: }
17867: $updatedstr =~ s/,$//;
17868: if ($updatedstr) {
17869: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
17870: } else {
17871: delete($userenv{'reqcrsotherdom.'.$type});
17872: }
17873: }
17874: }
17875: }
1.1092 raeburn 17876: }
1.462 albertel 17877: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17878:
1.462 albertel 17879: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17880: &GDBM_WRCREAT(),0640)) {
17881: &_add_to_env(\%disk_env,\%initial_env);
17882: &_add_to_env(\%disk_env,\%userenv,'environment.');
17883: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17884: if (ref($firstaccenv) eq 'HASH') {
17885: &_add_to_env(\%disk_env,$firstaccenv);
17886: }
17887: if (ref($timerintenv) eq 'HASH') {
17888: &_add_to_env(\%disk_env,$timerintenv);
17889: }
1.1414 raeburn 17890: if (ref($coauthorenv) eq 'HASH') {
17891: if (keys(%{$coauthorenv})) {
17892: &_add_to_env(\%disk_env,$coauthorenv);
17893: }
17894: }
1.463 albertel 17895: if (ref($args->{'extra_env'})) {
17896: &_add_to_env(\%disk_env,$args->{'extra_env'});
17897: }
1.462 albertel 17898: untie(%disk_env);
17899: } else {
1.705 tempelho 17900: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17901: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17902: return 'error: '.$!;
17903: }
17904: }
17905: $env{'request.role'}='cm';
17906: $env{'request.role.adv'}=$env{'user.adv'};
17907: $env{'browser.type'}=$clientbrowser;
17908:
17909: return $cookie;
17910:
17911: }
17912:
17913: sub _add_to_env {
17914: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 17915: if (ref($env_data) eq 'HASH') {
17916: while (my ($key,$value) = each(%$env_data)) {
17917: $idf->{$prefix.$key} = $value;
17918: $env{$prefix.$key} = $value;
17919: }
1.462 albertel 17920: }
17921: }
17922:
1.685 tempelho 17923: # --- Get the symbolic name of a problem and the url
17924: sub get_symb {
17925: my ($request,$silent) = @_;
1.726 raeburn 17926: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 17927: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
17928: if ($symb eq '') {
17929: if (!$silent) {
1.1071 raeburn 17930: if (ref($request)) {
17931: $request->print("Unable to handle ambiguous references:$url:.");
17932: }
1.685 tempelho 17933: return ();
17934: }
17935: }
17936: &Apache::lonenc::check_decrypt(\$symb);
17937: return ($symb);
17938: }
17939:
17940: # --------------------------------------------------------------Get annotation
17941:
17942: sub get_annotation {
17943: my ($symb,$enc) = @_;
17944:
17945: my $key = $symb;
17946: if (!$enc) {
17947: $key =
17948: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
17949: }
17950: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
17951: return $annotation{$key};
17952: }
17953:
17954: sub clean_symb {
1.731 raeburn 17955: my ($symb,$delete_enc) = @_;
1.685 tempelho 17956:
17957: &Apache::lonenc::check_decrypt(\$symb);
17958: my $enc = $env{'request.enc'};
1.731 raeburn 17959: if ($delete_enc) {
1.730 raeburn 17960: delete($env{'request.enc'});
17961: }
1.685 tempelho 17962:
17963: return ($symb,$enc);
17964: }
1.462 albertel 17965:
1.1181 raeburn 17966: ############################################################
17967: ############################################################
17968:
17969: =pod
17970:
17971: =head1 Routines for building display used to search for courses
17972:
17973:
17974: =over 4
17975:
17976: =item * &build_filters()
17977:
17978: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 17979: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
17980: and quotacheck.pl
17981:
1.1181 raeburn 17982:
17983: Inputs:
17984:
17985: filterlist - anonymous array of fields to include as potential filters
17986:
17987: crstype - course type
17988:
17989: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
17990: to pop-open a course selector (will contain "extra element").
17991:
17992: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
17993:
17994: filter - anonymous hash of criteria and their values
17995:
17996: action - form action
17997:
17998: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
17999:
1.1182 raeburn 18000: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 18001:
18002: cloneruname - username of owner of new course who wants to clone
18003:
18004: clonerudom - domain of owner of new course who wants to clone
18005:
18006: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
18007:
18008: codetitlesref - reference to array of titles of components in institutional codes (official courses)
18009:
18010: codedom - domain
18011:
18012: formname - value of form element named "form".
18013:
18014: fixeddom - domain, if fixed.
18015:
18016: prevphase - value to assign to form element named "phase" when going back to the previous screen
18017:
18018: cnameelement - name of form element in form on opener page which will receive title of selected course
18019:
18020: cnumelement - name of form element in form on opener page which will receive courseID of selected course
18021:
18022: cdomelement - name of form element in form on opener page which will receive domain of selected course
18023:
18024: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
18025:
18026: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
18027:
18028: clonewarning - warning message about missing information for intended course owner when DC creates a course
18029:
1.1182 raeburn 18030:
1.1181 raeburn 18031: Returns: $output - HTML for display of search criteria, and hidden form elements.
18032:
1.1182 raeburn 18033:
1.1181 raeburn 18034: Side Effects: None
18035:
18036: =cut
18037:
18038: # ---------------------------------------------- search for courses based on last activity etc.
18039:
18040: sub build_filters {
18041: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
18042: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
18043: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
18044: $cnameelement,$cnumelement,$cdomelement,$setroles,
18045: $clonetext,$clonewarning) = @_;
1.1182 raeburn 18046: my ($list,$jscript);
1.1181 raeburn 18047: my $onchange = 'javascript:updateFilters(this)';
18048: my ($domainselectform,$sincefilterform,$createdfilterform,
18049: $ownerdomselectform,$persondomselectform,$instcodeform,
18050: $typeselectform,$instcodetitle);
18051: if ($formname eq '') {
18052: $formname = $caller;
18053: }
18054: foreach my $item (@{$filterlist}) {
18055: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
18056: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
18057: if ($item eq 'domainfilter') {
18058: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
18059: } elsif ($item eq 'coursefilter') {
18060: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
18061: } elsif ($item eq 'ownerfilter') {
18062: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18063: } elsif ($item eq 'ownerdomfilter') {
18064: $filter->{'ownerdomfilter'} =
18065: &LONCAPA::clean_domain($filter->{$item});
18066: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
18067: 'ownerdomfilter',1);
18068: } elsif ($item eq 'personfilter') {
18069: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18070: } elsif ($item eq 'persondomfilter') {
18071: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
18072: 'persondomfilter',1);
18073: } else {
18074: $filter->{$item} =~ s/\W//g;
18075: }
18076: if (!$filter->{$item}) {
18077: $filter->{$item} = '';
18078: }
18079: }
18080: if ($item eq 'domainfilter') {
18081: my $allow_blank = 1;
18082: if ($formname eq 'portform') {
18083: $allow_blank=0;
18084: } elsif ($formname eq 'studentform') {
18085: $allow_blank=0;
18086: }
18087: if ($fixeddom) {
18088: $domainselectform = '<input type="hidden" name="domainfilter"'.
18089: ' value="'.$codedom.'" />'.
18090: &Apache::lonnet::domain($codedom,'description');
18091: } else {
18092: $domainselectform = &select_dom_form($filter->{$item},
18093: 'domainfilter',
18094: $allow_blank,'',$onchange);
18095: }
18096: } else {
18097: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
18098: }
18099: }
18100:
18101: # last course activity filter and selection
18102: $sincefilterform = &timebased_select_form('sincefilter',$filter);
18103:
18104: # course created filter and selection
18105: if (exists($filter->{'createdfilter'})) {
18106: $createdfilterform = &timebased_select_form('createdfilter',$filter);
18107: }
18108:
1.1239 raeburn 18109: my $prefix = $crstype;
18110: if ($crstype eq 'Placement') {
18111: $prefix = 'Placement Test'
18112: }
1.1181 raeburn 18113: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 18114: 'cac' => "$prefix Activity",
18115: 'ccr' => "$prefix Created",
18116: 'cde' => "$prefix Title",
18117: 'cdo' => "$prefix Domain",
1.1181 raeburn 18118: 'ins' => 'Institutional Code',
18119: 'inc' => 'Institutional Categorization',
1.1239 raeburn 18120: 'cow' => "$prefix Owner/Co-owner",
18121: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 18122: 'cog' => 'Type',
18123: );
18124:
18125: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18126: my $typeval = 'Course';
18127: if ($crstype eq 'Community') {
18128: $typeval = 'Community';
1.1239 raeburn 18129: } elsif ($crstype eq 'Placement') {
18130: $typeval = 'Placement';
1.1181 raeburn 18131: }
18132: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
18133: } else {
18134: $typeselectform = '<select name="type" size="1"';
18135: if ($onchange) {
18136: $typeselectform .= ' onchange="'.$onchange.'"';
18137: }
18138: $typeselectform .= '>'."\n";
1.1237 raeburn 18139: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 18140: my $shown;
18141: if ($posstype eq 'Placement') {
18142: $shown = &mt('Placement Test');
18143: } else {
18144: $shown = &mt($posstype);
18145: }
1.1181 raeburn 18146: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 18147: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 18148: }
18149: $typeselectform.="</select>";
18150: }
18151:
18152: my ($cloneableonlyform,$cloneabletitle);
18153: if (exists($filter->{'cloneableonly'})) {
18154: my $cloneableon = '';
18155: my $cloneableoff = ' checked="checked"';
18156: if ($filter->{'cloneableonly'}) {
18157: $cloneableon = $cloneableoff;
18158: $cloneableoff = '';
18159: }
18160: $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>';
18161: if ($formname eq 'ccrs') {
1.1187 bisitz 18162: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 18163: } else {
18164: $cloneabletitle = &mt('Cloneable by you');
18165: }
18166: }
18167: my $officialjs;
18168: if ($crstype eq 'Course') {
18169: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 18170: # if (($fixeddom) || ($formname eq 'requestcrs') ||
18171: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
18172: if ($codedom) {
1.1181 raeburn 18173: $officialjs = 1;
18174: ($instcodeform,$jscript,$$numtitlesref) =
18175: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
18176: $officialjs,$codetitlesref);
18177: if ($jscript) {
1.1182 raeburn 18178: $jscript = '<script type="text/javascript">'."\n".
18179: '// <![CDATA['."\n".
18180: $jscript."\n".
18181: '// ]]>'."\n".
18182: '</script>'."\n";
1.1181 raeburn 18183: }
18184: }
18185: if ($instcodeform eq '') {
18186: $instcodeform =
18187: '<input type="text" name="instcodefilter" size="10" value="'.
18188: $list->{'instcodefilter'}.'" />';
18189: $instcodetitle = $lt{'ins'};
18190: } else {
18191: $instcodetitle = $lt{'inc'};
18192: }
18193: if ($fixeddom) {
18194: $instcodetitle .= '<br />('.$codedom.')';
18195: }
18196: }
18197: }
18198: my $output = qq|
18199: <form method="post" name="filterpicker" action="$action">
18200: <input type="hidden" name="form" value="$formname" />
18201: |;
18202: if ($formname eq 'modifycourse') {
18203: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
18204: '<input type="hidden" name="prevphase" value="'.
18205: $prevphase.'" />'."\n";
1.1198 musolffc 18206: } elsif ($formname eq 'quotacheck') {
18207: $output .= qq|
18208: <input type="hidden" name="sortby" value="" />
18209: <input type="hidden" name="sortorder" value="" />
18210: |;
18211: } else {
1.1181 raeburn 18212: my $name_input;
18213: if ($cnameelement ne '') {
18214: $name_input = '<input type="hidden" name="cnameelement" value="'.
18215: $cnameelement.'" />';
18216: }
18217: $output .= qq|
1.1182 raeburn 18218: <input type="hidden" name="cnumelement" value="$cnumelement" />
18219: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 18220: $name_input
18221: $roleelement
18222: $multelement
18223: $typeelement
18224: |;
18225: if ($formname eq 'portform') {
18226: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
18227: }
18228: }
18229: if ($fixeddom) {
18230: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
18231: }
18232: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
18233: if ($sincefilterform) {
18234: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
18235: .$sincefilterform
18236: .&Apache::lonhtmlcommon::row_closure();
18237: }
18238: if ($createdfilterform) {
18239: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
18240: .$createdfilterform
18241: .&Apache::lonhtmlcommon::row_closure();
18242: }
18243: if ($domainselectform) {
18244: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
18245: .$domainselectform
18246: .&Apache::lonhtmlcommon::row_closure();
18247: }
18248: if ($typeselectform) {
18249: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18250: $output .= $typeselectform;
18251: } else {
18252: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
18253: .$typeselectform
18254: .&Apache::lonhtmlcommon::row_closure();
18255: }
18256: }
18257: if ($instcodeform) {
18258: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
18259: .$instcodeform
18260: .&Apache::lonhtmlcommon::row_closure();
18261: }
18262: if (exists($filter->{'ownerfilter'})) {
18263: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
18264: '<table><tr><td>'.&mt('Username').'<br />'.
18265: '<input type="text" name="ownerfilter" size="20" value="'.
18266: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18267: $ownerdomselectform.'</td></tr></table>'.
18268: &Apache::lonhtmlcommon::row_closure();
18269: }
18270: if (exists($filter->{'personfilter'})) {
18271: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
18272: '<table><tr><td>'.&mt('Username').'<br />'.
18273: '<input type="text" name="personfilter" size="20" value="'.
18274: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18275: $persondomselectform.'</td></tr></table>'.
18276: &Apache::lonhtmlcommon::row_closure();
18277: }
18278: if (exists($filter->{'coursefilter'})) {
18279: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
18280: .'<input type="text" name="coursefilter" size="25" value="'
18281: .$list->{'coursefilter'}.'" />'
18282: .&Apache::lonhtmlcommon::row_closure();
18283: }
18284: if ($cloneableonlyform) {
18285: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
18286: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
18287: }
18288: if (exists($filter->{'descriptfilter'})) {
18289: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
18290: .'<input type="text" name="descriptfilter" size="40" value="'
18291: .$list->{'descriptfilter'}.'" />'
18292: .&Apache::lonhtmlcommon::row_closure(1);
18293: }
18294: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
18295: '<input type="hidden" name="updater" value="" />'."\n".
18296: '<input type="submit" name="gosearch" value="'.
18297: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
18298: return $jscript.$clonewarning.$output;
18299: }
18300:
18301: =pod
18302:
18303: =item * &timebased_select_form()
18304:
1.1182 raeburn 18305: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 18306: filter e.g., Course Activity, Course Created, when searching for courses
18307: or communities
18308:
18309: Inputs:
18310:
18311: item - name of form element (sincefilter or createdfilter)
18312:
18313: filter - anonymous hash of criteria and their values
18314:
18315: Returns: HTML for a select box contained a blank, then six time selections,
18316: with value set in incoming form variables currently selected.
18317:
18318: Side Effects: None
18319:
18320: =cut
18321:
18322: sub timebased_select_form {
18323: my ($item,$filter) = @_;
18324: if (ref($filter) eq 'HASH') {
18325: $filter->{$item} =~ s/[^\d-]//g;
18326: if (!$filter->{$item}) { $filter->{$item}=-1; }
18327: return &select_form(
18328: $filter->{$item},
18329: $item,
18330: { '-1' => '',
18331: '86400' => &mt('today'),
18332: '604800' => &mt('last week'),
18333: '2592000' => &mt('last month'),
18334: '7776000' => &mt('last three months'),
18335: '15552000' => &mt('last six months'),
18336: '31104000' => &mt('last year'),
18337: 'select_form_order' =>
18338: ['-1','86400','604800','2592000','7776000',
18339: '15552000','31104000']});
18340: }
18341: }
18342:
18343: =pod
18344:
18345: =item * &js_changer()
18346:
18347: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 18348: when course type or domain is changed, and also to hide 'Searching ...' on
18349: page load completion for page showing search result.
1.1181 raeburn 18350:
18351: Inputs: None
18352:
1.1183 raeburn 18353: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 18354:
18355: Side Effects: None
18356:
18357: =cut
18358:
18359: sub js_changer {
18360: return <<ENDJS;
18361: <script type="text/javascript">
18362: // <![CDATA[
18363: function updateFilters(caller) {
18364: if (typeof(caller) != "undefined") {
18365: document.filterpicker.updater.value = caller.name;
18366: }
18367: document.filterpicker.submit();
18368: }
1.1183 raeburn 18369:
18370: function hideSearching() {
18371: if (document.getElementById('searching')) {
18372: document.getElementById('searching').style.display = 'none';
18373: }
18374: return;
18375: }
18376:
1.1181 raeburn 18377: // ]]>
18378: </script>
18379:
18380: ENDJS
18381: }
18382:
18383: =pod
18384:
1.1182 raeburn 18385: =item * &search_courses()
18386:
18387: Process selected filters form course search form and pass to lonnet::courseiddump
18388: to retrieve a hash for which keys are courseIDs which match the selected filters.
18389:
18390: Inputs:
18391:
18392: dom - domain being searched
18393:
18394: type - course type ('Course' or 'Community' or '.' if any).
18395:
18396: filter - anonymous hash of criteria and their values
18397:
18398: numtitles - for institutional codes - number of categories
18399:
18400: cloneruname - optional username of new course owner
18401:
18402: clonerudom - optional domain of new course owner
18403:
1.1221 raeburn 18404: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 18405: (used when DC is using course creation form)
18406:
18407: codetitles - reference to array of titles of components in institutional codes (official courses).
18408:
1.1221 raeburn 18409: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
18410: (and so can clone automatically)
18411:
18412: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
18413:
18414: reqinstcode - institutional code of new course, where search_courses is used to identify potential
18415: courses to clone
1.1182 raeburn 18416:
18417: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
18418:
18419:
18420: Side Effects: None
18421:
18422: =cut
18423:
18424:
18425: sub search_courses {
1.1221 raeburn 18426: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
18427: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 18428: my (%courses,%showcourses,$cloner);
18429: if (($filter->{'ownerfilter'} ne '') ||
18430: ($filter->{'ownerdomfilter'} ne '')) {
18431: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
18432: $filter->{'ownerdomfilter'};
18433: }
18434: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
18435: if (!$filter->{$item}) {
18436: $filter->{$item}='.';
18437: }
18438: }
18439: my $now = time;
18440: my $timefilter =
18441: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
18442: my ($createdbefore,$createdafter);
18443: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
18444: $createdbefore = $now;
18445: $createdafter = $now-$filter->{'createdfilter'};
18446: }
18447: my ($instcodefilter,$regexpok);
18448: if ($numtitles) {
18449: if ($env{'form.official'} eq 'on') {
18450: $instcodefilter =
18451: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18452: $regexpok = 1;
18453: } elsif ($env{'form.official'} eq 'off') {
18454: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18455: unless ($instcodefilter eq '') {
18456: $regexpok = -1;
18457: }
18458: }
18459: } else {
18460: $instcodefilter = $filter->{'instcodefilter'};
18461: }
18462: if ($instcodefilter eq '') { $instcodefilter = '.'; }
18463: if ($type eq '') { $type = '.'; }
18464:
18465: if (($clonerudom ne '') && ($cloneruname ne '')) {
18466: $cloner = $cloneruname.':'.$clonerudom;
18467: }
18468: %courses = &Apache::lonnet::courseiddump($dom,
18469: $filter->{'descriptfilter'},
18470: $timefilter,
18471: $instcodefilter,
18472: $filter->{'combownerfilter'},
18473: $filter->{'coursefilter'},
18474: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 18475: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 18476: $filter->{'cloneableonly'},
18477: $createdbefore,$createdafter,undef,
1.1221 raeburn 18478: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 18479: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18480: my $ccrole;
18481: if ($type eq 'Community') {
18482: $ccrole = 'co';
18483: } else {
18484: $ccrole = 'cc';
18485: }
18486: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18487: $filter->{'persondomfilter'},
18488: 'userroles',undef,
18489: [$ccrole,'in','ad','ep','ta','cr'],
18490: $dom);
18491: foreach my $role (keys(%rolehash)) {
18492: my ($cnum,$cdom,$courserole) = split(':',$role);
18493: my $cid = $cdom.'_'.$cnum;
18494: if (exists($courses{$cid})) {
18495: if (ref($courses{$cid}) eq 'HASH') {
18496: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18497: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18498: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18499: }
18500: } else {
18501: $courses{$cid}{roles} = [$courserole];
18502: }
18503: $showcourses{$cid} = $courses{$cid};
18504: }
18505: }
18506: }
18507: %courses = %showcourses;
18508: }
18509: return %courses;
18510: }
18511:
18512: =pod
18513:
1.1181 raeburn 18514: =back
18515:
1.1207 raeburn 18516: =head1 Routines for version requirements for current course.
18517:
18518: =over 4
18519:
18520: =item * &check_release_required()
18521:
18522: Compares required LON-CAPA version with version on server, and
18523: if required version is newer looks for a server with the required version.
18524:
18525: Looks first at servers in user's owen domain; if none suitable, looks at
18526: servers in course's domain are permitted to host sessions for user's domain.
18527:
18528: Inputs:
18529:
18530: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18531:
18532: $courseid - Course ID of current course
18533:
18534: $rolecode - User's current role in course (for switchserver query string).
18535:
18536: $required - LON-CAPA version needed by course (format: Major.Minor).
18537:
18538:
18539: Returns:
18540:
18541: $switchserver - query string tp append to /adm/switchserver call (if
18542: current server's LON-CAPA version is too old.
18543:
18544: $warning - Message is displayed if no suitable server could be found.
18545:
18546: =cut
18547:
18548: sub check_release_required {
18549: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18550: my ($switchserver,$warning);
18551: if ($required ne '') {
18552: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18553: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18554: if ($reqdmajor ne '' && $reqdminor ne '') {
18555: my $otherserver;
18556: if (($major eq '' && $minor eq '') ||
18557: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18558: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18559: my $switchlcrev =
18560: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18561: $userdomserver);
18562: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18563: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18564: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18565: my $cdom = $env{'course.'.$courseid.'.domain'};
18566: if ($cdom ne $env{'user.domain'}) {
18567: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18568: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18569: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18570: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18571: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18572: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18573: my $canhost =
18574: &Apache::lonnet::can_host_session($env{'user.domain'},
18575: $coursedomserver,
18576: $remoterev,
18577: $udomdefaults{'remotesessions'},
18578: $defdomdefaults{'hostedsessions'});
18579:
18580: if ($canhost) {
18581: $otherserver = $coursedomserver;
18582: } else {
18583: $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.");
18584: }
18585: } else {
18586: $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).");
18587: }
18588: } else {
18589: $otherserver = $userdomserver;
18590: }
18591: }
18592: if ($otherserver ne '') {
18593: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18594: }
18595: }
18596: }
18597: return ($switchserver,$warning);
18598: }
18599:
18600: =pod
18601:
18602: =item * &check_release_result()
18603:
18604: Inputs:
18605:
18606: $switchwarning - Warning message if no suitable server found to host session.
18607:
18608: $switchserver - query string to append to /adm/switchserver containing lonHostID
18609: and current role.
18610:
18611: Returns: HTML to display with information about requirement to switch server.
18612: Either displaying warning with link to Roles/Courses screen or
18613: display link to switchserver.
18614:
1.1181 raeburn 18615: =cut
18616:
1.1207 raeburn 18617: sub check_release_result {
18618: my ($switchwarning,$switchserver) = @_;
18619: my $output = &start_page('Selected course unavailable on this server').
18620: '<p class="LC_warning">';
18621: if ($switchwarning) {
18622: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18623: if (&show_course()) {
18624: $output .= &mt('Display courses');
18625: } else {
18626: $output .= &mt('Display roles');
18627: }
18628: $output .= '</a>';
18629: } elsif ($switchserver) {
18630: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18631: '<br />'.
18632: '<a href="/adm/switchserver?'.$switchserver.'">'.
18633: &mt('Switch Server').
18634: '</a>';
18635: }
18636: $output .= '</p>'.&end_page();
18637: return $output;
18638: }
18639:
18640: =pod
18641:
18642: =item * &needs_coursereinit()
18643:
18644: Determine if course contents stored for user's session needs to be
18645: refreshed, because content has changed since "Big Hash" last tied.
18646:
18647: Check for change is made if time last checked is more than 10 minutes ago
18648: (by default).
18649:
18650: Inputs:
18651:
18652: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18653:
18654: $interval (optional) - Time which may elapse (in s) between last check for content
18655: change in current course. (default: 600 s).
18656:
18657: Returns: an array; first element is:
18658:
18659: =over 4
18660:
18661: 'switch' - if content updates mean user's session
18662: needs to be switched to a server running a newer LON-CAPA version
18663:
18664: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18665: on current server hosting user's session
18666:
18667: '' - if no action required.
18668:
18669: =back
18670:
18671: If first item element is 'switch':
18672:
18673: second item is $switchwarning - Warning message if no suitable server found to host session.
18674:
18675: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18676: and current role.
18677:
18678: otherwise: no other elements returned.
18679:
18680: =back
18681:
18682: =cut
18683:
18684: sub needs_coursereinit {
18685: my ($loncaparev,$interval) = @_;
18686: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18687: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18688: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18689: my $now = time;
18690: if ($interval eq '') {
18691: $interval = 600;
18692: }
18693: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 18694: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 18695: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18696: if ($blocked) {
18697: return ();
18698: }
1.1391 raeburn 18699: my $update;
18700: my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18701: my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
18702: if ($lastmainchange > $env{'request.course.tied'}) {
18703: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18704: if ($needswitch) {
18705: return ('switch',$switchwarning,$switchserver);
18706: }
18707: $update = 'main';
18708: }
18709: if ($lastsuppchange > $env{'request.course.suppupdated'}) {
18710: if ($update) {
18711: $update = 'both';
18712: } else {
18713: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18714: if ($needswitch) {
18715: return ('switch',$switchwarning,$switchserver);
18716: } else {
18717: $update = 'supp';
1.1207 raeburn 18718: }
18719: }
1.1391 raeburn 18720: return ($update);
18721: }
18722: }
18723: return ();
18724: }
18725:
18726: sub switch_for_update {
18727: my ($loncaparev,$cdom,$cnum) = @_;
18728: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18729: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18730: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18731: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18732: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18733: $curr_reqd_hash{'internal.releaserequired'}});
18734: my ($switchserver,$switchwarning) =
18735: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18736: $curr_reqd_hash{'internal.releaserequired'});
18737: if ($switchwarning ne '' || $switchserver ne '') {
18738: return ('switch',$switchwarning,$switchserver);
18739: }
1.1207 raeburn 18740: }
18741: }
18742: return ();
18743: }
1.1181 raeburn 18744:
1.1083 raeburn 18745: sub update_content_constraints {
1.1395 raeburn 18746: my ($cdom,$cnum,$chome,$cid) = @_;
1.1083 raeburn 18747: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18748: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 18749: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 18750: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 18751: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 18752: if ($item eq 'resourcetag') {
18753: if ($name eq 'responsetype') {
18754: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18755: }
1.1307 raeburn 18756: } elsif ($item eq 'course') {
18757: if ($name eq 'courserestype') {
18758: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
18759: }
1.1083 raeburn 18760: }
18761: }
18762: my $navmap = Apache::lonnavmaps::navmap->new();
18763: if (defined($navmap)) {
1.1307 raeburn 18764: my (%allresponses,%allcrsrestypes);
18765: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
18766: if ($res->is_tool()) {
18767: if ($allcrsrestypes{'exttool'}) {
18768: $allcrsrestypes{'exttool'} ++;
18769: } else {
18770: $allcrsrestypes{'exttool'} = 1;
18771: }
18772: next;
18773: }
1.1083 raeburn 18774: my %responses = $res->responseTypes();
18775: foreach my $key (keys(%responses)) {
18776: next unless(exists($checkresponsetypes{$key}));
18777: $allresponses{$key} += $responses{$key};
18778: }
18779: }
18780: foreach my $key (keys(%allresponses)) {
18781: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18782: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18783: ($reqdmajor,$reqdminor) = ($major,$minor);
18784: }
18785: }
1.1307 raeburn 18786: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 18787: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 18788: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18789: ($reqdmajor,$reqdminor) = ($major,$minor);
18790: }
18791: }
1.1083 raeburn 18792: undef($navmap);
18793: }
1.1391 raeburn 18794: if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308 raeburn 18795: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
18796: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18797: ($reqdmajor,$reqdminor) = ($major,$minor);
18798: }
18799: }
1.1083 raeburn 18800: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18801: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18802: }
18803: return;
18804: }
18805:
1.1110 raeburn 18806: sub allmaps_incourse {
18807: my ($cdom,$cnum,$chome,$cid) = @_;
18808: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18809: $cid = $env{'request.course.id'};
18810: $cdom = $env{'course.'.$cid.'.domain'};
18811: $cnum = $env{'course.'.$cid.'.num'};
18812: $chome = $env{'course.'.$cid.'.home'};
18813: }
18814: my %allmaps = ();
18815: my $lastchange =
18816: &Apache::lonnet::get_coursechange($cdom,$cnum);
18817: if ($lastchange > $env{'request.course.tied'}) {
18818: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18819: unless ($ferr) {
1.1395 raeburn 18820: &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110 raeburn 18821: }
18822: }
18823: my $navmap = Apache::lonnavmaps::navmap->new();
18824: if (defined($navmap)) {
18825: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18826: $allmaps{$res->src()} = 1;
18827: }
18828: }
18829: return \%allmaps;
18830: }
18831:
1.1083 raeburn 18832: sub parse_supplemental_title {
18833: my ($title) = @_;
18834:
18835: my ($foldertitle,$renametitle);
18836: if ($title =~ /&&&/) {
18837: $title = &HTML::Entites::decode($title);
18838: }
18839: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18840: $renametitle=$4;
18841: my ($time,$uname,$udom) = ($1,$2,$3);
18842: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18843: my $name = &plainname($uname,$udom);
18844: $name = &HTML::Entities::encode($name,'"<>&\'');
18845: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1401 raeburn 18846: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
1.1402 raeburn 18847: if ($foldertitle ne '') {
1.1401 raeburn 18848: $title .= ': <br />'.$foldertitle;
18849: }
1.1083 raeburn 18850: }
18851: if (wantarray) {
18852: return ($title,$foldertitle,$renametitle);
18853: }
18854: return $title;
18855: }
18856:
1.1395 raeburn 18857: sub get_supplemental {
18858: my ($cnum,$cdom,$ignorecache,$possdel)=@_;
18859: my $hashid=$cnum.':'.$cdom;
18860: my ($supplemental,$cached,$set_httprefs);
18861: unless ($ignorecache) {
18862: ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
18863: }
18864: unless (defined($cached)) {
18865: my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
18866: unless ($chome eq 'no_host') {
18867: my @order = @LONCAPA::map::order;
18868: my @resources = @LONCAPA::map::resources;
18869: my @resparms = @LONCAPA::map::resparms;
18870: my @zombies = @LONCAPA::map::zombies;
18871: my ($errors,%ids,%hidden);
18872: $errors =
18873: &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
18874: $errors,$possdel,\%ids,\%hidden);
18875: @LONCAPA::map::order = @order;
18876: @LONCAPA::map::resources = @resources;
18877: @LONCAPA::map::resparms = @resparms;
18878: @LONCAPA::map::zombies = @zombies;
18879: $set_httprefs = 1;
18880: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18881: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18882: }
18883: $supplemental = {
18884: ids => \%ids,
18885: hidden => \%hidden,
18886: };
18887: &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
18888: }
18889: }
18890: return ($supplemental,$set_httprefs);
18891: }
18892:
1.1143 raeburn 18893: sub recurse_supplemental {
1.1391 raeburn 18894: my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
18895: if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
18896: my $mapnum;
18897: if ($suppmap eq 'supplemental.sequence') {
18898: $mapnum = 0;
18899: } else {
18900: ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
18901: }
1.1143 raeburn 18902: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18903: if ($fatal) {
18904: $errors ++;
18905: } else {
1.1389 raeburn 18906: my @order = @LONCAPA::map::order;
18907: if (@order > 0) {
18908: my @resources = @LONCAPA::map::resources;
1.1391 raeburn 18909: my @resparms = @LONCAPA::map::resparms;
1.1389 raeburn 18910: foreach my $idx (@order) {
18911: my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143 raeburn 18912: if (($src ne '') && ($status eq 'res')) {
1.1391 raeburn 18913: my $id = $mapnum.':'.$idx;
18914: push(@{$suppids->{$src}},$id);
18915: if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
18916: $hiddensupp->{$id} = 1;
18917: }
1.1146 raeburn 18918: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391 raeburn 18919: $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
18920: $hiddensupp,$hiddensupp->{$id});
1.1143 raeburn 18921: } else {
1.1391 raeburn 18922: my $allowed;
18923: if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
18924: $allowed = 1;
18925: } elsif ($possdel) {
18926: foreach my $item (@{$suppids->{$src}}) {
18927: next if ($item eq $id);
18928: unless ($hiddensupp->{$item}) {
18929: $allowed = 1;
18930: last;
18931: }
18932: }
18933: if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
18934: &Apache::lonnet::delenv('httpref.'.$src);
18935: }
18936: }
18937: if ($allowed && (!exists($env{'httpref.'.$src}))) {
18938: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308 raeburn 18939: }
1.1143 raeburn 18940: }
18941: }
18942: }
18943: }
18944: }
18945: }
1.1391 raeburn 18946: return $errors;
18947: }
18948:
18949: sub set_supp_httprefs {
18950: my ($cnum,$cdom,$supplemental,$possdel) = @_;
18951: if (ref($supplemental) eq 'HASH') {
18952: if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
18953: foreach my $src (keys(%{$supplemental->{'ids'}})) {
18954: next if ($src =~ /\.sequence$/);
18955: if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
18956: my $allowed;
18957: if ($env{'request.role.adv'}) {
18958: $allowed = 1;
18959: } else {
18960: foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
18961: unless ($supplemental->{'hidden'}->{$id}) {
18962: $allowed = 1;
18963: last;
18964: }
18965: }
18966: }
18967: if (exists($env{'httpref.'.$src})) {
18968: if ($possdel) {
18969: unless ($allowed) {
18970: &Apache::lonnet::delenv('httpref.'.$src);
18971: }
18972: }
18973: } elsif ($allowed) {
18974: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
18975: }
18976: }
18977: }
18978: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18979: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18980: }
18981: }
18982: }
18983: }
18984:
18985: sub get_supp_parameter {
18986: my ($resparm,$name)=@_;
18987: return if ($resparm eq '');
18988: my $value=undef;
18989: my $ptype=undef;
18990: foreach (split('&&&',$resparm)) {
18991: my ($thistype,$thisname,$thisvalue)=split('___',$_);
18992: if ($thisname eq $name) {
18993: $value=$thisvalue;
18994: $ptype=$thistype;
18995: }
18996: }
18997: return $value;
1.1143 raeburn 18998: }
18999:
1.1101 raeburn 19000: sub symb_to_docspath {
1.1267 raeburn 19001: my ($symb,$navmapref) = @_;
19002: return unless ($symb && ref($navmapref));
1.1101 raeburn 19003: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
19004: if ($resurl=~/\.(sequence|page)$/) {
19005: $mapurl=$resurl;
19006: } elsif ($resurl eq 'adm/navmaps') {
19007: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
19008: }
19009: my $mapresobj;
1.1267 raeburn 19010: unless (ref($$navmapref)) {
19011: $$navmapref = Apache::lonnavmaps::navmap->new();
19012: }
19013: if (ref($$navmapref)) {
19014: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 19015: }
19016: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
19017: my $type=$2;
19018: my $path;
19019: if (ref($mapresobj)) {
19020: my $pcslist = $mapresobj->map_hierarchy();
19021: if ($pcslist ne '') {
19022: foreach my $pc (split(/,/,$pcslist)) {
19023: next if ($pc <= 1);
1.1267 raeburn 19024: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 19025: if (ref($res)) {
19026: my $thisurl = $res->src();
19027: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
19028: my $thistitle = $res->title();
19029: $path .= '&'.
19030: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 19031: &escape($thistitle).
1.1101 raeburn 19032: ':'.$res->randompick().
19033: ':'.$res->randomout().
19034: ':'.$res->encrypted().
19035: ':'.$res->randomorder().
19036: ':'.$res->is_page();
19037: }
19038: }
19039: }
19040: $path =~ s/^\&//;
19041: my $maptitle = $mapresobj->title();
19042: if ($mapurl eq 'default') {
1.1129 raeburn 19043: $maptitle = 'Main Content';
1.1101 raeburn 19044: }
19045: $path .= (($path ne '')? '&' : '').
19046: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19047: &escape($maptitle).
1.1101 raeburn 19048: ':'.$mapresobj->randompick().
19049: ':'.$mapresobj->randomout().
19050: ':'.$mapresobj->encrypted().
19051: ':'.$mapresobj->randomorder().
19052: ':'.$mapresobj->is_page();
19053: } else {
19054: my $maptitle = &Apache::lonnet::gettitle($mapurl);
19055: my $ispage = (($type eq 'page')? 1 : '');
19056: if ($mapurl eq 'default') {
1.1129 raeburn 19057: $maptitle = 'Main Content';
1.1101 raeburn 19058: }
19059: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19060: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 19061: }
19062: unless ($mapurl eq 'default') {
19063: $path = 'default&'.
1.1146 raeburn 19064: &escape('Main Content').
1.1101 raeburn 19065: ':::::&'.$path;
19066: }
19067: return $path;
19068: }
19069:
1.1393 raeburn 19070: sub validate_folderpath {
19071: my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
19072: if ($env{'form.folderpath'} ne '') {
19073: my @items = split(/\&/,$env{'form.folderpath'});
1.1394 raeburn 19074: my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393 raeburn 19075: for (my $i=0; $i<@items; $i++) {
19076: my $odd = $i%2;
19077: if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
19078: $badpath = 1;
1.1394 raeburn 19079: } elsif ($odd && $supplementalflag) {
1.1393 raeburn 19080: my $idx = $i-1;
1.1394 raeburn 19081: if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
19082: my $esc_name = $1;
19083: if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
19084: $supppath .= '&'.$esc_name;
19085: $changed = 1;
19086: } else {
19087: $supppath .= '&'.$items[$i];
19088: }
19089: } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
19090: $changed = 1;
1.1393 raeburn 19091: my $is_hidden;
19092: unless ($got_supp) {
1.1395 raeburn 19093: my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393 raeburn 19094: if (ref($supplemental) eq 'HASH') {
19095: if (ref($supplemental->{'hidden'}) eq 'HASH') {
19096: %supphidden = %{$supplemental->{'hidden'}};
19097: }
19098: if (ref($supplemental->{'ids'}) eq 'HASH') {
19099: %suppids = %{$supplemental->{'ids'}};
19100: }
19101: }
19102: $got_supp = 1;
19103: }
19104: if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
19105: my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
19106: if ($supphidden{$mapid}) {
19107: $is_hidden = 1;
19108: }
19109: }
1.1394 raeburn 19110: $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
19111: } else {
19112: $supppath .= '&'.$items[$i];
1.1393 raeburn 19113: }
19114: } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
19115: $badpath = 1;
1.1394 raeburn 19116: } elsif ($supplementalflag) {
1.1393 raeburn 19117: $supppath .= '&'.$items[$i];
19118: }
19119: last if ($badpath);
19120: }
19121: if ($badpath) {
19122: delete($env{'form.folderpath'});
1.1394 raeburn 19123: } elsif ($changed && $supplementalflag) {
1.1393 raeburn 19124: $supppath =~ s/^\&//;
19125: $env{'form.folderpath'} = $supppath;
19126: }
19127: }
19128: return;
19129: }
19130:
1.1094 raeburn 19131: sub captcha_display {
1.1327 raeburn 19132: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19133: my ($output,$error);
1.1234 raeburn 19134: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 19135: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19136: if ($captcha eq 'original') {
1.1094 raeburn 19137: $output = &create_captcha();
19138: unless ($output) {
1.1172 raeburn 19139: $error = 'captcha';
1.1094 raeburn 19140: }
19141: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19142: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 19143: unless ($output) {
1.1172 raeburn 19144: $error = 'recaptcha';
1.1094 raeburn 19145: }
19146: }
1.1234 raeburn 19147: return ($output,$error,$captcha,$version);
1.1094 raeburn 19148: }
19149:
19150: sub captcha_response {
1.1327 raeburn 19151: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19152: my ($captcha_chk,$captcha_error);
1.1327 raeburn 19153: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19154: if ($captcha eq 'original') {
1.1094 raeburn 19155: ($captcha_chk,$captcha_error) = &check_captcha();
19156: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19157: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 19158: } else {
19159: $captcha_chk = 1;
19160: }
19161: return ($captcha_chk,$captcha_error);
19162: }
19163:
19164: sub get_captcha_config {
1.1327 raeburn 19165: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 19166: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 19167: my $hostname = &Apache::lonnet::hostname($lonhost);
19168: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
19169: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 19170: if ($context eq 'usercreation') {
19171: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
19172: if (ref($domconfig{$context}) eq 'HASH') {
19173: $hashtocheck = $domconfig{$context}{'cancreate'};
19174: if (ref($hashtocheck) eq 'HASH') {
19175: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
19176: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
19177: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
19178: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
19179: }
19180: if ($privkey && $pubkey) {
19181: $captcha = 'recaptcha';
1.1234 raeburn 19182: $version = $hashtocheck->{'recaptchaversion'};
19183: if ($version ne '2') {
19184: $version = 1;
19185: }
1.1095 raeburn 19186: } else {
19187: $captcha = 'original';
19188: }
19189: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
19190: $captcha = 'original';
19191: }
1.1094 raeburn 19192: }
1.1095 raeburn 19193: } else {
19194: $captcha = 'captcha';
19195: }
19196: } elsif ($context eq 'login') {
19197: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
19198: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
19199: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
19200: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 19201: if ($privkey && $pubkey) {
19202: $captcha = 'recaptcha';
1.1234 raeburn 19203: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
19204: if ($version ne '2') {
19205: $version = 1;
19206: }
1.1095 raeburn 19207: } else {
19208: $captcha = 'original';
1.1094 raeburn 19209: }
1.1095 raeburn 19210: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
19211: $captcha = 'original';
1.1094 raeburn 19212: }
1.1327 raeburn 19213: } elsif ($context eq 'passwords') {
19214: if ($dom_in_effect) {
19215: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
19216: if ($passwdconf{'captcha'} eq 'recaptcha') {
19217: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
19218: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
19219: $privkey = $passwdconf{'recaptchakeys'}{'private'};
19220: }
19221: if ($privkey && $pubkey) {
19222: $captcha = 'recaptcha';
19223: $version = $passwdconf{'recaptchaversion'};
19224: if ($version ne '2') {
19225: $version = 1;
19226: }
19227: } else {
19228: $captcha = 'original';
19229: }
19230: } elsif ($passwdconf{'captcha'} ne 'notused') {
19231: $captcha = 'original';
19232: }
19233: }
19234: }
1.1234 raeburn 19235: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 19236: }
19237:
19238: sub create_captcha {
19239: my %captcha_params = &captcha_settings();
19240: my ($output,$maxtries,$tries) = ('',10,0);
19241: while ($tries < $maxtries) {
19242: $tries ++;
19243: my $captcha = Authen::Captcha->new (
19244: output_folder => $captcha_params{'output_dir'},
19245: data_folder => $captcha_params{'db_dir'},
19246: );
19247: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
19248:
19249: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
19250: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 19251: '<span class="LC_nobreak">'.
1.1094 raeburn 19252: &mt('Type in the letters/numbers shown below').' '.
1.1390 raeburn 19253: '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367 raeburn 19254: '</span><br />'.
1.1176 raeburn 19255: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 19256: last;
19257: }
19258: }
1.1323 raeburn 19259: if ($output eq '') {
19260: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
19261: }
1.1094 raeburn 19262: return $output;
19263: }
19264:
19265: sub captcha_settings {
19266: my %captcha_params = (
19267: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
19268: www_output_dir => "/captchaspool",
19269: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
19270: numchars => '5',
19271: );
19272: return %captcha_params;
19273: }
19274:
19275: sub check_captcha {
19276: my ($captcha_chk,$captcha_error);
19277: my $code = $env{'form.code'};
19278: my $md5sum = $env{'form.crypt'};
19279: my %captcha_params = &captcha_settings();
19280: my $captcha = Authen::Captcha->new(
19281: output_folder => $captcha_params{'output_dir'},
19282: data_folder => $captcha_params{'db_dir'},
19283: );
1.1109 raeburn 19284: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 19285: my %captcha_hash = (
19286: 0 => 'Code not checked (file error)',
19287: -1 => 'Failed: code expired',
19288: -2 => 'Failed: invalid code (not in database)',
19289: -3 => 'Failed: invalid code (code does not match crypt)',
19290: );
19291: if ($captcha_chk != 1) {
19292: $captcha_error = $captcha_hash{$captcha_chk}
19293: }
19294: return ($captcha_chk,$captcha_error);
19295: }
19296:
19297: sub create_recaptcha {
1.1234 raeburn 19298: my ($pubkey,$version) = @_;
19299: if ($version >= 2) {
1.1367 raeburn 19300: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
19301: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 19302: } else {
19303: my $use_ssl;
19304: if ($ENV{'SERVER_PORT'} == 443) {
19305: $use_ssl = 1;
19306: }
19307: my $captcha = Captcha::reCAPTCHA->new;
19308: return $captcha->get_options_setter({theme => 'white'})."\n".
19309: $captcha->get_html($pubkey,undef,$use_ssl).
19310: &mt('If the text is hard to read, [_1] will replace them.',
19311: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
19312: '<br /><br />';
19313: }
1.1094 raeburn 19314: }
19315:
19316: sub check_recaptcha {
1.1234 raeburn 19317: my ($privkey,$version) = @_;
1.1094 raeburn 19318: my $captcha_chk;
1.1350 raeburn 19319: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 19320: if ($version >= 2) {
19321: my %info = (
19322: secret => $privkey,
19323: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 19324: remoteip => $ip,
1.1234 raeburn 19325: );
1.1280 raeburn 19326: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
19327: $request->content(join('&',map {
19328: my $name = escape($_);
19329: "$name=" . ( ref($info{$_}) eq 'ARRAY'
19330: ? join("&$name=", map {escape($_) } @{$info{$_}})
19331: : &escape($info{$_}) );
19332: } keys(%info)));
19333: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 19334: if ($response->is_success) {
19335: my $data = JSON::DWIW->from_json($response->decoded_content);
19336: if (ref($data) eq 'HASH') {
19337: if ($data->{'success'}) {
19338: $captcha_chk = 1;
19339: }
19340: }
19341: }
19342: } else {
19343: my $captcha = Captcha::reCAPTCHA->new;
19344: my $captcha_result =
19345: $captcha->check_answer(
19346: $privkey,
1.1350 raeburn 19347: $ip,
1.1234 raeburn 19348: $env{'form.recaptcha_challenge_field'},
19349: $env{'form.recaptcha_response_field'},
19350: );
19351: if ($captcha_result->{is_valid}) {
19352: $captcha_chk = 1;
19353: }
1.1094 raeburn 19354: }
19355: return $captcha_chk;
19356: }
19357:
1.1174 raeburn 19358: sub emailusername_info {
1.1244 raeburn 19359: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 19360: my %titles = &Apache::lonlocal::texthash (
19361: lastname => 'Last Name',
19362: firstname => 'First Name',
19363: institution => 'School/college/university',
19364: location => "School's city, state/province, country",
19365: web => "School's web address",
19366: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 19367: id => 'Student/Employee ID',
1.1174 raeburn 19368: );
19369: return (\@fields,\%titles);
19370: }
19371:
1.1161 raeburn 19372: sub cleanup_html {
19373: my ($incoming) = @_;
19374: my $outgoing;
19375: if ($incoming ne '') {
19376: $outgoing = $incoming;
19377: $outgoing =~ s/;/;/g;
19378: $outgoing =~ s/\#/#/g;
19379: $outgoing =~ s/\&/&/g;
19380: $outgoing =~ s/</</g;
19381: $outgoing =~ s/>/>/g;
19382: $outgoing =~ s/\(/(/g;
19383: $outgoing =~ s/\)/)/g;
19384: $outgoing =~ s/"/"/g;
19385: $outgoing =~ s/'/'/g;
19386: $outgoing =~ s/\$/$/g;
19387: $outgoing =~ s{/}{/}g;
19388: $outgoing =~ s/=/=/g;
19389: $outgoing =~ s/\\/\/g
19390: }
19391: return $outgoing;
19392: }
19393:
1.1190 musolffc 19394: # Checks for critical messages and returns a redirect url if one exists.
19395: # $interval indicates how often to check for messages.
1.1282 raeburn 19396: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 19397: sub critical_redirect {
1.1282 raeburn 19398: my ($interval,$context) = @_;
1.1356 raeburn 19399: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
19400: return ();
19401: }
1.1190 musolffc 19402: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 19403: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
19404: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
19405: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 19406: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 19407: if ($blocked) {
19408: my $checkrole = "cm./$cdom/$cnum";
19409: if ($env{'request.course.sec'} ne '') {
19410: $checkrole .= "/$env{'request.course.sec'}";
19411: }
19412: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
19413: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
19414: return;
19415: }
19416: }
19417: }
1.1190 musolffc 19418: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
19419: $env{'user.name'});
19420: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 19421: my $redirecturl;
1.1190 musolffc 19422: if ($what[0]) {
1.1356 raeburn 19423: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 19424: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 19425: my $url=&Apache::lonnet::absolute_url().$redirecturl;
19426: return (1, $url);
1.1190 musolffc 19427: }
1.1191 raeburn 19428: }
19429: }
19430: return ();
1.1190 musolffc 19431: }
19432:
1.1174 raeburn 19433: # Use:
19434: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
19435: #
19436: ##################################################
19437: # password associated functions #
19438: ##################################################
19439: sub des_keys {
19440: # Make a new key for DES encryption.
19441: # Each key has two parts which are returned separately.
19442: # Please note: Each key must be passed through the &hex function
19443: # before it is output to the web browser. The hex versions cannot
19444: # be used to decrypt.
19445: my @hexstr=('0','1','2','3','4','5','6','7',
19446: '8','9','a','b','c','d','e','f');
19447: my $lkey='';
19448: for (0..7) {
19449: $lkey.=$hexstr[rand(15)];
19450: }
19451: my $ukey='';
19452: for (0..7) {
19453: $ukey.=$hexstr[rand(15)];
19454: }
19455: return ($lkey,$ukey);
19456: }
19457:
19458: sub des_decrypt {
19459: my ($key,$cyphertext) = @_;
19460: my $keybin=pack("H16",$key);
19461: my $cypher;
19462: if ($Crypt::DES::VERSION>=2.03) {
19463: $cypher=new Crypt::DES $keybin;
19464: } else {
19465: $cypher=new DES $keybin;
19466: }
1.1233 raeburn 19467: my $plaintext='';
19468: my $cypherlength = length($cyphertext);
19469: my $numchunks = int($cypherlength/32);
19470: for (my $j=0; $j<$numchunks; $j++) {
19471: my $start = $j*32;
19472: my $cypherblock = substr($cyphertext,$start,32);
19473: my $chunk =
19474: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
19475: $chunk .=
19476: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
19477: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
19478: $plaintext .= $chunk;
19479: }
1.1174 raeburn 19480: return $plaintext;
19481: }
19482:
1.1344 raeburn 19483: sub get_requested_shorturls {
1.1309 raeburn 19484: my ($cdom,$cnum,$navmap) = @_;
19485: return unless (ref($navmap));
1.1344 raeburn 19486: my ($numnew,$errors);
1.1309 raeburn 19487: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
19488: if (@toshorten) {
19489: my (%maps,%resources,%titles);
19490: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
19491: 'shorturls',$cdom,$cnum);
19492: if (keys(%resources)) {
1.1344 raeburn 19493: my %tocreate;
1.1309 raeburn 19494: foreach my $item (sort {$a <=> $b} (@toshorten)) {
19495: my $symb = $resources{$item};
19496: if ($symb) {
19497: $tocreate{$cnum.'&'.$symb} = 1;
19498: }
19499: }
1.1344 raeburn 19500: if (keys(%tocreate)) {
19501: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
19502: \%tocreate);
19503: }
1.1309 raeburn 19504: }
1.1344 raeburn 19505: }
19506: return ($numnew,$errors);
19507: }
19508:
19509: sub make_short_symbs {
19510: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
19511: my ($numnew,@errors);
19512: if (ref($tocreateref) eq 'HASH') {
19513: my %tocreate = %{$tocreateref};
1.1309 raeburn 19514: if (keys(%tocreate)) {
19515: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
19516: my $su = Short::URL->new(no_vowels => 1);
19517: my $init = '';
19518: my (%newunique,%addcourse,%courseonly,%failed);
19519: # get lock on tiny db
19520: my $now = time;
1.1344 raeburn 19521: if ($lockuser eq '') {
19522: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
19523: }
1.1309 raeburn 19524: my $lockhash = {
1.1344 raeburn 19525: "lock\0$now" => $lockuser,
1.1309 raeburn 19526: };
19527: my $tries = 0;
19528: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19529: my ($code,$error);
19530: while (($gotlock ne 'ok') && ($tries<3)) {
19531: $tries ++;
19532: sleep 1;
1.1319 raeburn 19533: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 19534: }
19535: if ($gotlock eq 'ok') {
19536: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
19537: \%addcourse,\%courseonly,\%failed);
19538: if (keys(%failed)) {
19539: my $numfailed = scalar(keys(%failed));
19540: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
19541: }
19542: if (keys(%newunique)) {
19543: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
19544: if ($putres eq 'ok') {
19545: $numnew = scalar(keys(%newunique));
19546: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
19547: unless ($newputres eq 'ok') {
19548: push(@errors,&mt('error: could not store course look-up of short URLs'));
19549: }
19550: } else {
19551: push(@errors,&mt('error: could not store unique six character URLs'));
19552: }
19553: }
19554: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
19555: unless ($dellockres eq 'ok') {
19556: push(@errors,&mt('error: could not release lockfile'));
19557: }
19558: } else {
19559: push(@errors,&mt('error: could not obtain lockfile'));
19560: }
19561: if (keys(%courseonly)) {
19562: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
19563: if ($result ne 'ok') {
19564: push(@errors,&mt('error: could not update course look-up of short URLs'));
19565: }
19566: }
19567: }
19568: }
19569: return ($numnew,\@errors);
19570: }
19571:
19572: sub shorten_symbs {
19573: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
19574: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
19575: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
19576: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
19577: my (%possibles,%collisions);
19578: foreach my $key (keys(%{$tocreate})) {
19579: my $num = String::CRC32::crc32($key);
19580: my $tiny = $su->encode($num,$init);
19581: if ($tiny) {
19582: $possibles{$tiny} = $key;
19583: }
19584: }
19585: if (!$init) {
19586: $init = 1;
19587: } else {
19588: $init ++;
19589: }
19590: if (keys(%possibles)) {
19591: my @posstiny = keys(%possibles);
19592: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
19593: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
19594: if (keys(%currtiny)) {
19595: foreach my $key (keys(%currtiny)) {
19596: next if ($currtiny{$key} eq '');
19597: if ($currtiny{$key} eq $possibles{$key}) {
19598: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
19599: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19600: $courseonly->{$tsymb} = $key;
19601: }
19602: } else {
19603: $collisions{$possibles{$key}} = 1;
19604: }
19605: delete($possibles{$key});
19606: }
19607: }
19608: foreach my $key (keys(%possibles)) {
19609: $newunique->{$key} = $possibles{$key};
19610: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
19611: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19612: $addcourse->{$tsymb} = $key;
19613: }
19614: }
19615: }
19616: if (keys(%collisions)) {
19617: if ($init <5) {
19618: if (!$init) {
19619: $init = 1;
19620: } else {
19621: $init ++;
19622: }
19623: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
19624: $newunique,$addcourse,$courseonly,$failed);
19625: } else {
19626: foreach my $key (keys(%collisions)) {
19627: $failed->{$key} = 1;
19628: }
19629: }
19630: }
19631: return $init;
19632: }
19633:
1.1328 raeburn 19634: sub is_nonframeable {
1.1329 raeburn 19635: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
19636: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 19637: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 19638:
19639: $remprotocol = lc($remprotocol);
19640: $remhost = lc($remhost);
19641: my $remport = 80;
19642: if ($remprotocol eq 'https') {
19643: $remport = 443;
19644: }
1.1330 raeburn 19645: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 19646: if ($cached) {
19647: unless ($nocache) {
19648: if ($result) {
19649: return 1;
19650: } else {
19651: return 0;
19652: }
19653: }
19654: }
1.1328 raeburn 19655: my $uselink;
19656: my $request = new HTTP::Request('HEAD',$url);
19657: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
19658: if ($response->is_success()) {
19659: my $secpolicy = lc($response->header('content-security-policy'));
19660: my $xframeop = lc($response->header('x-frame-options'));
19661: $secpolicy =~ s/^\s+|\s+$//g;
19662: $xframeop =~ s/^\s+|\s+$//g;
19663: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 19664: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 19665: my ($origin,$protocol,$port);
19666: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19667: $port = $ENV{'SERVER_PORT'};
19668: } else {
19669: $port = 80;
19670: }
19671: if ($absolute eq '') {
19672: $protocol = 'http:';
19673: if ($port == 443) {
19674: $protocol = 'https:';
19675: }
19676: $origin = $protocol.'//'.lc($hostname);
19677: } else {
19678: $origin = lc($absolute);
19679: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19680: }
19681: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19682: my $framepolicy = $1;
19683: $framepolicy =~ s/^\s+|\s+$//g;
19684: my @policies = split(/\s+/,$framepolicy);
19685: if (@policies) {
19686: if (grep(/^\Q'none'\E$/,@policies)) {
19687: $uselink = 1;
19688: } else {
19689: $uselink = 1;
19690: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19691: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19692: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19693: undef($uselink);
19694: }
19695: if ($uselink) {
19696: if (grep(/^\Q'self'\E$/,@policies)) {
19697: if (($origin ne '') && ($remotehost eq $origin)) {
19698: undef($uselink);
19699: }
19700: }
19701: }
19702: if ($uselink) {
19703: my @possok;
19704: if ($ip ne '') {
19705: push(@possok,$ip);
19706: }
19707: my $hoststr = '';
19708: foreach my $part (reverse(split(/\./,$hostname))) {
19709: if ($hoststr eq '') {
19710: $hoststr = $part;
19711: } else {
19712: $hoststr = "$part.$hoststr";
19713: }
19714: if ($hoststr eq $hostname) {
19715: push(@possok,$hostname);
19716: } else {
19717: push(@possok,"*.$hoststr");
19718: }
19719: }
19720: if (@possok) {
19721: foreach my $poss (@possok) {
19722: last if (!$uselink);
19723: foreach my $policy (@policies) {
19724: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19725: undef($uselink);
19726: last;
19727: }
19728: }
19729: }
19730: }
19731: }
19732: }
19733: }
19734: } elsif ($xframeop ne '') {
19735: $uselink = 1;
19736: my @policies = split(/\s*,\s*/,$xframeop);
19737: if (@policies) {
19738: unless (grep(/^deny$/,@policies)) {
19739: if ($origin ne '') {
19740: if (grep(/^sameorigin$/,@policies)) {
19741: if ($remotehost eq $origin) {
19742: undef($uselink);
19743: }
19744: }
19745: if ($uselink) {
19746: foreach my $policy (@policies) {
19747: if ($policy =~ /^allow-from\s*(.+)$/) {
19748: my $allowfrom = $1;
19749: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19750: undef($uselink);
19751: last;
19752: }
19753: }
19754: }
19755: }
19756: }
19757: }
19758: }
19759: }
19760: }
19761: }
1.1329 raeburn 19762: if ($nocache) {
19763: if ($cached) {
19764: my $devalidate;
19765: if ($uselink && !$result) {
19766: $devalidate = 1;
19767: } elsif (!$uselink && $result) {
19768: $devalidate = 1;
19769: }
19770: if ($devalidate) {
19771: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19772: }
19773: }
19774: } else {
19775: if ($uselink) {
19776: $result = 1;
19777: } else {
19778: $result = 0;
19779: }
19780: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19781: }
1.1328 raeburn 19782: return $uselink;
19783: }
19784:
1.1359 raeburn 19785: sub page_menu {
19786: my ($menucolls,$menunum) = @_;
19787: my %menu;
19788: foreach my $item (split(/;/,$menucolls)) {
19789: my ($num,$value) = split(/\%/,$item);
19790: if ($num eq $menunum) {
19791: my @entries = split(/\&/,$value);
19792: foreach my $entry (@entries) {
19793: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 19794: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 19795: $menu{$name} = $fields;
19796: } else {
19797: my @shown;
19798: if ($fields =~ /,/) {
19799: @shown = split(/,/,$fields);
19800: } else {
19801: @shown = ($fields);
19802: }
19803: if (@shown) {
19804: foreach my $field (@shown) {
19805: next if ($field eq '');
19806: $menu{$field} = 1;
19807: }
19808: }
19809: }
19810: }
19811: }
19812: }
19813: return %menu;
19814: }
19815:
1.112 bowersj2 19816: 1;
19817: __END__;
1.41 ng 19818:
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