Annotation of loncom/interface/loncommon.pm, revision 1.1420
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1420 ! raeburn 4: # $Id: loncommon.pm,v 1.1419 2023/11/18 21:12:45 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.1420 ! raeburn 2444: =item * &iframe_wrapper_headjs()
! 2445:
! 2446: #
! 2447: # Where iframe is in use, if window.onload() executes before the custom resize function
! 2448: # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)
! 2449: # are used to ensure document.ready() triggers a call to resize, so the iframe contents
! 2450: # do not obscure the Functions menu.
! 2451: #
! 2452:
! 2453: =back
! 2454:
! 2455: =cut
! 2456:
! 2457:
! 2458: sub iframe_wrapper_headjs {
! 2459: return <<"ENDJS";
! 2460: <script type="text/javascript">
! 2461: // <![CDATA[
! 2462: var LCnotready = 0;
! 2463: var LCresizedef = 0;
! 2464: // ]]>
! 2465: </script>
! 2466:
! 2467: ENDJS
! 2468:
! 2469: }
! 2470:
! 2471: =pod
! 2472:
! 2473: =item * &iframe_wrapper_resizejs()
! 2474:
! 2475: #
! 2476: # jQuery to use when iframe is in use and a page resize occurs.
! 2477: # This script will ensure that the iframe does not obscure any
! 2478: # standard LON-CAPA inline menus (primary, secondary, and/or
! 2479: # breadcrumbs and Functions menus. Expects javascript from
! 2480: # &iframe_wrapper_headjs() to be in head portion of the web page,
! 2481: # e.g., by inclusion in second arg passed to &start_page().
! 2482: #
! 2483:
! 2484: =back
! 2485:
! 2486: =cut
! 2487:
! 2488: sub iframe_wrapper_resizejs {
! 2489: my $offset = 5;
! 2490: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
! 2491: if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
! 2492: $offset = 0;
! 2493: }
! 2494: return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);
! 2495: \$(document).ready( function() {
! 2496: \$(window).unbind('resize').resize(function(){
! 2497: var header = null;
! 2498: var offset = $offset;
! 2499: var height = 0;
! 2500: var hdrtop = 0;
! 2501: if (\$('div.LC_head_subbox:first').length) {
! 2502: header = \$('div.LC_head_subbox:first');
! 2503: offset = 9;
! 2504: } else {
! 2505: if (\$('#LC_breadcrumbs').length) {
! 2506: header = \$('#LC_breadcrumbs');
! 2507: }
! 2508: }
! 2509: if (header != null && header.length) {
! 2510: height = header.height();
! 2511: hdrtop = header.position().top;
! 2512: }
! 2513: var pos = height + hdrtop + offset;
! 2514: \$('.LC_iframecontainer').css('top', pos);
! 2515: });
! 2516: LCresizedef = 1;
! 2517: if (LCnotready == 1) {
! 2518: LCnotready = 0;
! 2519: \$(window).trigger('resize');
! 2520: }
! 2521: });
! 2522: window.onload = function(){
! 2523: if (LCresizedef) {
! 2524: LCnotready = 0;
! 2525: \$(window).trigger('resize');
! 2526: } else {
! 2527: LCnotready = 1;
! 2528: }
! 2529: };
! 2530: SCRIPT
! 2531:
! 2532: }
! 2533:
! 2534: =pod
! 2535:
1.256 matthew 2536: =head1 Excel and CSV file utility routines
2537:
2538: =cut
2539:
2540: ###############################################################
2541: ###############################################################
2542:
2543: =pod
2544:
1.1162 raeburn 2545: =over 4
2546:
1.648 raeburn 2547: =item * &csv_translate($text)
1.37 matthew 2548:
1.185 www 2549: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2550: format.
2551:
2552: =cut
2553:
1.180 matthew 2554: ###############################################################
2555: ###############################################################
1.37 matthew 2556: sub csv_translate {
2557: my $text = shift;
2558: $text =~ s/\"/\"\"/g;
1.209 albertel 2559: $text =~ s/\n/ /g;
1.37 matthew 2560: return $text;
2561: }
1.180 matthew 2562:
2563: ###############################################################
2564: ###############################################################
2565:
2566: =pod
2567:
1.648 raeburn 2568: =item * &define_excel_formats()
1.180 matthew 2569:
2570: Define some commonly used Excel cell formats.
2571:
2572: Currently supported formats:
2573:
2574: =over 4
2575:
2576: =item header
2577:
2578: =item bold
2579:
2580: =item h1
2581:
2582: =item h2
2583:
2584: =item h3
2585:
1.256 matthew 2586: =item h4
2587:
2588: =item i
2589:
1.180 matthew 2590: =item date
2591:
2592: =back
2593:
2594: Inputs: $workbook
2595:
2596: Returns: $format, a hash reference.
2597:
1.1057 foxr 2598:
1.180 matthew 2599: =cut
2600:
2601: ###############################################################
2602: ###############################################################
2603: sub define_excel_formats {
2604: my ($workbook) = @_;
2605: my $format;
2606: $format->{'header'} = $workbook->add_format(bold => 1,
2607: bottom => 1,
2608: align => 'center');
2609: $format->{'bold'} = $workbook->add_format(bold=>1);
2610: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2611: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2612: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2613: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2614: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2615: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2616: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2617: return $format;
2618: }
2619:
2620: ###############################################################
2621: ###############################################################
1.113 bowersj2 2622:
2623: =pod
2624:
1.648 raeburn 2625: =item * &create_workbook()
1.255 matthew 2626:
2627: Create an Excel worksheet. If it fails, output message on the
2628: request object and return undefs.
2629:
2630: Inputs: Apache request object
2631:
2632: Returns (undef) on failure,
2633: Excel worksheet object, scalar with filename, and formats
2634: from &Apache::loncommon::define_excel_formats on success
2635:
2636: =cut
2637:
2638: ###############################################################
2639: ###############################################################
2640: sub create_workbook {
2641: my ($r) = @_;
2642: #
2643: # Create the excel spreadsheet
2644: my $filename = '/prtspool/'.
1.258 albertel 2645: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2646: time.'_'.rand(1000000000).'.xls';
2647: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2648: if (! defined($workbook)) {
2649: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2650: $r->print(
2651: '<p class="LC_error">'
2652: .&mt('Problems occurred in creating the new Excel file.')
2653: .' '.&mt('This error has been logged.')
2654: .' '.&mt('Please alert your LON-CAPA administrator.')
2655: .'</p>'
2656: );
1.255 matthew 2657: return (undef);
2658: }
2659: #
1.1014 foxr 2660: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2661: #
2662: my $format = &Apache::loncommon::define_excel_formats($workbook);
2663: return ($workbook,$filename,$format);
2664: }
2665:
2666: ###############################################################
2667: ###############################################################
2668:
2669: =pod
2670:
1.648 raeburn 2671: =item * &create_text_file()
1.113 bowersj2 2672:
1.542 raeburn 2673: Create a file to write to and eventually make available to the user.
1.256 matthew 2674: If file creation fails, outputs an error message on the request object and
2675: return undefs.
1.113 bowersj2 2676:
1.256 matthew 2677: Inputs: Apache request object, and file suffix
1.113 bowersj2 2678:
1.256 matthew 2679: Returns (undef) on failure,
2680: Filehandle and filename on success.
1.113 bowersj2 2681:
2682: =cut
2683:
1.256 matthew 2684: ###############################################################
2685: ###############################################################
2686: sub create_text_file {
2687: my ($r,$suffix) = @_;
2688: if (! defined($suffix)) { $suffix = 'txt'; };
2689: my $fh;
2690: my $filename = '/prtspool/'.
1.258 albertel 2691: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2692: time.'_'.rand(1000000000).'.'.$suffix;
2693: $fh = Apache::File->new('>/home/httpd'.$filename);
2694: if (! defined($fh)) {
2695: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2696: $r->print(
2697: '<p class="LC_error">'
2698: .&mt('Problems occurred in creating the output file.')
2699: .' '.&mt('This error has been logged.')
2700: .' '.&mt('Please alert your LON-CAPA administrator.')
2701: .'</p>'
2702: );
1.113 bowersj2 2703: }
1.256 matthew 2704: return ($fh,$filename)
1.113 bowersj2 2705: }
2706:
2707:
1.256 matthew 2708: =pod
1.113 bowersj2 2709:
2710: =back
2711:
2712: =cut
1.37 matthew 2713:
2714: ###############################################################
1.33 matthew 2715: ## Home server <option> list generating code ##
2716: ###############################################################
1.35 matthew 2717:
1.169 www 2718: # ------------------------------------------
2719:
2720: sub domain_select {
1.1289 raeburn 2721: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2722: my @possdoms;
2723: if (ref($incdoms) eq 'ARRAY') {
2724: @possdoms = @{$incdoms};
2725: } else {
2726: @possdoms = &Apache::lonnet::all_domains();
2727: }
2728:
1.169 www 2729: my %domains=map {
1.514 albertel 2730: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2731: } @possdoms;
2732:
2733: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2734: foreach my $dom (@{$excdoms}) {
2735: delete($domains{$dom});
2736: }
2737: }
2738:
1.169 www 2739: if ($multiple) {
2740: $domains{''}=&mt('Any domain');
1.550 albertel 2741: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2742: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2743: } else {
1.550 albertel 2744: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2745: return &select_form($name,$value,\%domains);
1.169 www 2746: }
2747: }
2748:
1.282 albertel 2749: #-------------------------------------------
2750:
2751: =pod
2752:
1.519 raeburn 2753: =head1 Routines for form select boxes
2754:
2755: =over 4
2756:
1.648 raeburn 2757: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2758:
2759: Returns a string containing a <select> element int multiple mode
2760:
2761:
2762: Args:
2763: $name - name of the <select> element
1.506 raeburn 2764: $value - scalar or array ref of values that should already be selected
1.282 albertel 2765: $size - number of rows long the select element is
1.283 albertel 2766: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2767: (shown text should already have been &mt())
1.506 raeburn 2768: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2769:
1.282 albertel 2770: =cut
2771:
2772: #-------------------------------------------
1.169 www 2773: sub multiple_select_form {
1.284 albertel 2774: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2775: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2776: my $output='';
1.191 matthew 2777: if (! defined($size)) {
2778: $size = 4;
1.283 albertel 2779: if (scalar(keys(%$hash))<4) {
2780: $size = scalar(keys(%$hash));
1.191 matthew 2781: }
2782: }
1.734 bisitz 2783: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2784: my @order;
1.506 raeburn 2785: if (ref($order) eq 'ARRAY') {
2786: @order = @{$order};
2787: } else {
2788: @order = sort(keys(%$hash));
1.501 banghart 2789: }
2790: if (exists($$hash{'select_form_order'})) {
2791: @order = @{$$hash{'select_form_order'}};
2792: }
2793:
1.284 albertel 2794: foreach my $key (@order) {
1.356 albertel 2795: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2796: $output.='selected="selected" ' if ($selected{$key});
2797: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2798: }
2799: $output.="</select>\n";
2800: return $output;
2801: }
2802:
1.88 www 2803: #-------------------------------------------
2804:
2805: =pod
2806:
1.1254 raeburn 2807: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2808:
2809: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2810: allow a user to select options from a ref to a hash containing:
2811: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2812: a javascript onchange item, e.g., onchange="this.form.submit();".
2813: An optional arg -- $readonly -- if true will cause the select form
2814: to be disabled, e.g., for the case where an instructor has a section-
2815: specific role, and is viewing/modifying parameters.
1.970 raeburn 2816:
1.88 www 2817: See lonrights.pm for an example invocation and use.
2818:
2819: =cut
2820:
2821: #-------------------------------------------
2822: sub select_form {
1.1228 raeburn 2823: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2824: return unless (ref($hashref) eq 'HASH');
2825: if ($onchange) {
2826: $onchange = ' onchange="'.$onchange.'"';
2827: }
1.1228 raeburn 2828: my $disabled;
2829: if ($readonly) {
2830: $disabled = ' disabled="disabled"';
2831: }
2832: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2833: my @keys;
1.970 raeburn 2834: if (exists($hashref->{'select_form_order'})) {
2835: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2836: } else {
1.970 raeburn 2837: @keys=sort(keys(%{$hashref}));
1.128 albertel 2838: }
1.356 albertel 2839: foreach my $key (@keys) {
2840: $selectform.=
2841: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2842: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2843: ">".$hashref->{$key}."</option>\n";
1.88 www 2844: }
2845: $selectform.="</select>";
2846: return $selectform;
2847: }
2848:
1.475 www 2849: # For display filters
2850:
2851: sub display_filter {
1.1074 raeburn 2852: my ($context) = @_;
1.475 www 2853: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2854: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2855: my $phraseinput = 'hidden';
2856: my $includeinput = 'hidden';
2857: my ($checked,$includetypestext);
2858: if ($env{'form.displayfilter'} eq 'containing') {
2859: $phraseinput = 'text';
2860: if ($context eq 'parmslog') {
2861: $includeinput = 'checkbox';
2862: if ($env{'form.includetypes'}) {
2863: $checked = ' checked="checked"';
2864: }
2865: $includetypestext = &mt('Include parameter types');
2866: }
2867: } else {
2868: $includetypestext = ' ';
2869: }
2870: my ($additional,$secondid,$thirdid);
2871: if ($context eq 'parmslog') {
2872: $additional =
2873: '<label><input type="'.$includeinput.'" name="includetypes"'.
2874: $checked.' name="includetypes" value="1" id="includetypes" />'.
2875: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2876: '</label>';
2877: $secondid = 'includetypes';
2878: $thirdid = 'includetypestext';
2879: }
2880: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2881: '$secondid','$thirdid')";
2882: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.1403 raeburn 2883: &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
1.475 www 2884: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2885: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2886: &mt('Filter: [_1]',
1.477 www 2887: &select_form($env{'form.displayfilter'},
2888: 'displayfilter',
1.970 raeburn 2889: {'currentfolder' => 'Current folder/page',
1.477 www 2890: 'containing' => 'Containing phrase',
1.1074 raeburn 2891: 'none' => 'None'},$onchange)).' '.
2892: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2893: &HTML::Entities::encode($env{'form.containingphrase'}).
2894: '" />'.$additional;
2895: }
2896:
2897: sub display_filter_js {
2898: my $includetext = &mt('Include parameter types');
2899: return <<"ENDJS";
2900:
2901: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2902: var firstType = 'hidden';
2903: if (setter.options[setter.selectedIndex].value == 'containing') {
2904: firstType = 'text';
2905: }
2906: firstObject = document.getElementById(firstid);
2907: if (typeof(firstObject) == 'object') {
2908: if (firstObject.type != firstType) {
2909: changeInputType(firstObject,firstType);
2910: }
2911: }
2912: if (context == 'parmslog') {
2913: var secondType = 'hidden';
2914: if (firstType == 'text') {
2915: secondType = 'checkbox';
2916: }
2917: secondObject = document.getElementById(secondid);
2918: if (typeof(secondObject) == 'object') {
2919: if (secondObject.type != secondType) {
2920: changeInputType(secondObject,secondType);
2921: }
2922: }
2923: var textItem = document.getElementById(thirdid);
2924: var currtext = textItem.innerHTML;
2925: var newtext;
2926: if (firstType == 'text') {
2927: newtext = '$includetext';
2928: } else {
2929: newtext = ' ';
2930: }
2931: if (currtext != newtext) {
2932: textItem.innerHTML = newtext;
2933: }
2934: }
2935: return;
2936: }
2937:
2938: function changeInputType(oldObject,newType) {
2939: var newObject = document.createElement('input');
2940: newObject.type = newType;
2941: if (oldObject.size) {
2942: newObject.size = oldObject.size;
2943: }
2944: if (oldObject.value) {
2945: newObject.value = oldObject.value;
2946: }
2947: if (oldObject.name) {
2948: newObject.name = oldObject.name;
2949: }
2950: if (oldObject.id) {
2951: newObject.id = oldObject.id;
2952: }
2953: oldObject.parentNode.replaceChild(newObject,oldObject);
2954: return;
2955: }
2956:
2957: ENDJS
1.475 www 2958: }
2959:
1.167 www 2960: sub gradeleveldescription {
2961: my $gradelevel=shift;
2962: my %gradelevels=(0 => 'Not specified',
2963: 1 => 'Grade 1',
2964: 2 => 'Grade 2',
2965: 3 => 'Grade 3',
2966: 4 => 'Grade 4',
2967: 5 => 'Grade 5',
2968: 6 => 'Grade 6',
2969: 7 => 'Grade 7',
2970: 8 => 'Grade 8',
2971: 9 => 'Grade 9',
2972: 10 => 'Grade 10',
2973: 11 => 'Grade 11',
2974: 12 => 'Grade 12',
2975: 13 => 'Grade 13',
2976: 14 => '100 Level',
2977: 15 => '200 Level',
2978: 16 => '300 Level',
2979: 17 => '400 Level',
2980: 18 => 'Graduate Level');
2981: return &mt($gradelevels{$gradelevel});
2982: }
2983:
1.163 www 2984: sub select_level_form {
2985: my ($deflevel,$name)=@_;
2986: unless ($deflevel) { $deflevel=0; }
1.167 www 2987: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2988: for (my $i=0; $i<=18; $i++) {
2989: $selectform.="<option value=\"$i\" ".
1.253 albertel 2990: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2991: ">".&gradeleveldescription($i)."</option>\n";
2992: }
2993: $selectform.="</select>";
2994: return $selectform;
1.163 www 2995: }
1.167 www 2996:
1.35 matthew 2997: #-------------------------------------------
2998:
1.45 matthew 2999: =pod
3000:
1.1256 raeburn 3001: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 3002:
3003: Returns a string containing a <select name='$name' size='1'> form to
3004: allow a user to select the domain to preform an operation in.
3005: See loncreateuser.pm for an example invocation and use.
3006:
1.90 www 3007: If the $includeempty flag is set, it also includes an empty choice ("no domain
3008: selected");
3009:
1.743 raeburn 3010: If the $showdomdesc flag is set, the domain name is followed by the domain description.
3011:
1.910 raeburn 3012: 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.
3013:
1.1121 raeburn 3014: The optional $incdoms is a reference to an array of domains which will be the only available options.
3015:
3016: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 3017:
1.1256 raeburn 3018: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
3019:
1.35 matthew 3020: =cut
3021:
3022: #-------------------------------------------
1.34 matthew 3023: sub select_dom_form {
1.1256 raeburn 3024: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 3025: if ($onchange) {
1.874 raeburn 3026: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 3027: }
1.1256 raeburn 3028: if ($disabled) {
3029: $disabled = ' disabled="disabled"';
3030: }
1.1121 raeburn 3031: my (@domains,%exclude);
1.910 raeburn 3032: if (ref($incdoms) eq 'ARRAY') {
3033: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
3034: } else {
3035: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
3036: }
1.90 www 3037: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 3038: if (ref($excdoms) eq 'ARRAY') {
3039: map { $exclude{$_} = 1; } @{$excdoms};
3040: }
1.1256 raeburn 3041: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 3042: foreach my $dom (@domains) {
1.1121 raeburn 3043: next if ($exclude{$dom});
1.356 albertel 3044: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 3045: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
3046: if ($showdomdesc) {
3047: if ($dom ne '') {
3048: my $domdesc = &Apache::lonnet::domain($dom,'description');
3049: if ($domdesc ne '') {
3050: $selectdomain .= ' ('.$domdesc.')';
3051: }
3052: }
3053: }
3054: $selectdomain .= "</option>\n";
1.34 matthew 3055: }
3056: $selectdomain.="</select>";
3057: return $selectdomain;
3058: }
3059:
1.35 matthew 3060: #-------------------------------------------
3061:
1.45 matthew 3062: =pod
3063:
1.648 raeburn 3064: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 3065:
1.586 raeburn 3066: input: 4 arguments (two required, two optional) -
3067: $domain - domain of new user
3068: $name - name of form element
3069: $default - Value of 'default' causes a default item to be first
3070: option, and selected by default.
3071: $hide - Value of 'hide' causes hiding of the name of the server,
3072: if 1 server found, or default, if 0 found.
1.594 raeburn 3073: output: returns 2 items:
1.586 raeburn 3074: (a) form element which contains either:
3075: (i) <select name="$name">
3076: <option value="$hostid1">$hostid $servers{$hostid}</option>
3077: <option value="$hostid2">$hostid $servers{$hostid}</option>
3078: </select>
3079: form item if there are multiple library servers in $domain, or
3080: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
3081: if there is only one library server in $domain.
3082:
3083: (b) number of library servers found.
3084:
3085: See loncreateuser.pm for example of use.
1.35 matthew 3086:
3087: =cut
3088:
3089: #-------------------------------------------
1.586 raeburn 3090: sub home_server_form_item {
3091: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 3092: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 3093: my $result;
3094: my $numlib = keys(%servers);
3095: if ($numlib > 1) {
3096: $result .= '<select name="'.$name.'" />'."\n";
3097: if ($default) {
1.804 bisitz 3098: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 3099: '</option>'."\n";
3100: }
3101: foreach my $hostid (sort(keys(%servers))) {
3102: $result.= '<option value="'.$hostid.'">'.
3103: $hostid.' '.$servers{$hostid}."</option>\n";
3104: }
3105: $result .= '</select>'."\n";
3106: } elsif ($numlib == 1) {
3107: my $hostid;
3108: foreach my $item (keys(%servers)) {
3109: $hostid = $item;
3110: }
3111: $result .= '<input type="hidden" name="'.$name.'" value="'.
3112: $hostid.'" />';
3113: if (!$hide) {
3114: $result .= $hostid.' '.$servers{$hostid};
3115: }
3116: $result .= "\n";
3117: } elsif ($default) {
3118: $result .= '<input type="hidden" name="'.$name.
3119: '" value="default" />';
3120: if (!$hide) {
3121: $result .= &mt('default');
3122: }
3123: $result .= "\n";
1.33 matthew 3124: }
1.586 raeburn 3125: return ($result,$numlib);
1.33 matthew 3126: }
1.112 bowersj2 3127:
3128: =pod
3129:
1.534 albertel 3130: =back
3131:
1.112 bowersj2 3132: =cut
1.87 matthew 3133:
3134: ###############################################################
1.112 bowersj2 3135: ## Decoding User Agent ##
1.87 matthew 3136: ###############################################################
3137:
3138: =pod
3139:
1.112 bowersj2 3140: =head1 Decoding the User Agent
3141:
3142: =over 4
3143:
3144: =item * &decode_user_agent()
1.87 matthew 3145:
3146: Inputs: $r
3147:
3148: Outputs:
3149:
3150: =over 4
3151:
1.112 bowersj2 3152: =item * $httpbrowser
1.87 matthew 3153:
1.112 bowersj2 3154: =item * $clientbrowser
1.87 matthew 3155:
1.112 bowersj2 3156: =item * $clientversion
1.87 matthew 3157:
1.112 bowersj2 3158: =item * $clientmathml
1.87 matthew 3159:
1.112 bowersj2 3160: =item * $clientunicode
1.87 matthew 3161:
1.112 bowersj2 3162: =item * $clientos
1.87 matthew 3163:
1.1137 raeburn 3164: =item * $clientmobile
3165:
1.1141 raeburn 3166: =item * $clientinfo
3167:
1.1194 raeburn 3168: =item * $clientosversion
3169:
1.87 matthew 3170: =back
3171:
1.157 matthew 3172: =back
3173:
1.87 matthew 3174: =cut
3175:
3176: ###############################################################
3177: ###############################################################
3178: sub decode_user_agent {
1.247 albertel 3179: my ($r)=@_;
1.87 matthew 3180: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
3181: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
3182: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 3183: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 3184: my $clientbrowser='unknown';
3185: my $clientversion='0';
3186: my $clientmathml='';
3187: my $clientunicode='0';
1.1137 raeburn 3188: my $clientmobile=0;
1.1194 raeburn 3189: my $clientosversion='';
1.87 matthew 3190: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 3191: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 3192: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
3193: $clientbrowser=$bname;
3194: $httpbrowser=~/$vreg/i;
3195: $clientversion=$1;
3196: $clientmathml=($clientversion>=$minv);
3197: $clientunicode=($clientversion>=$univ);
3198: }
3199: }
3200: my $clientos='unknown';
1.1141 raeburn 3201: my $clientinfo;
1.87 matthew 3202: if (($httpbrowser=~/linux/i) ||
3203: ($httpbrowser=~/unix/i) ||
3204: ($httpbrowser=~/ux/i) ||
3205: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
3206: if (($httpbrowser=~/vax/i) ||
3207: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
3208: if ($httpbrowser=~/next/i) { $clientos='next'; }
3209: if (($httpbrowser=~/mac/i) ||
3210: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 3211: if ($httpbrowser=~/win/i) {
3212: $clientos='win';
3213: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
3214: $clientosversion = $1;
3215: }
3216: }
1.87 matthew 3217: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3218: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3219: $clientmobile=lc($1);
3220: }
1.1141 raeburn 3221: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3222: $clientinfo = 'firefox-'.$1;
3223: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3224: $clientinfo = 'chromeframe-'.$1;
3225: }
1.87 matthew 3226: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3227: $clientunicode,$clientos,$clientmobile,$clientinfo,
3228: $clientosversion);
1.87 matthew 3229: }
3230:
1.32 matthew 3231: ###############################################################
3232: ## Authentication changing form generation subroutines ##
3233: ###############################################################
3234: ##
3235: ## All of the authform_xxxxxxx subroutines take their inputs in a
3236: ## hash, and have reasonable default values.
3237: ##
3238: ## formname = the name given in the <form> tag.
1.35 matthew 3239: #-------------------------------------------
3240:
1.45 matthew 3241: =pod
3242:
1.112 bowersj2 3243: =head1 Authentication Routines
3244:
3245: =over 4
3246:
1.648 raeburn 3247: =item * &authform_xxxxxx()
1.35 matthew 3248:
3249: The authform_xxxxxx subroutines provide javascript and html forms which
3250: handle some of the conveniences required for authentication forms.
3251: This is not an optimal method, but it works.
3252:
3253: =over 4
3254:
1.112 bowersj2 3255: =item * authform_header
1.35 matthew 3256:
1.112 bowersj2 3257: =item * authform_authorwarning
1.35 matthew 3258:
1.112 bowersj2 3259: =item * authform_nochange
1.35 matthew 3260:
1.112 bowersj2 3261: =item * authform_kerberos
1.35 matthew 3262:
1.112 bowersj2 3263: =item * authform_internal
1.35 matthew 3264:
1.112 bowersj2 3265: =item * authform_filesystem
1.35 matthew 3266:
1.1310 raeburn 3267: =item * authform_lti
3268:
1.35 matthew 3269: =back
3270:
1.648 raeburn 3271: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3272:
1.35 matthew 3273: =cut
3274:
3275: #-------------------------------------------
1.32 matthew 3276: sub authform_header{
3277: my %in = (
3278: formname => 'cu',
1.80 albertel 3279: kerb_def_dom => '',
1.32 matthew 3280: @_,
3281: );
3282: $in{'formname'} = 'document.' . $in{'formname'};
3283: my $result='';
1.80 albertel 3284:
3285: #---------------------------------------------- Code for upper case translation
3286: my $Javascript_toUpperCase;
3287: unless ($in{kerb_def_dom}) {
3288: $Javascript_toUpperCase =<<"END";
3289: switch (choice) {
3290: case 'krb': currentform.elements[choicearg].value =
3291: currentform.elements[choicearg].value.toUpperCase();
3292: break;
3293: default:
3294: }
3295: END
3296: } else {
3297: $Javascript_toUpperCase = "";
3298: }
3299:
1.165 raeburn 3300: my $radioval = "'nochange'";
1.591 raeburn 3301: if (defined($in{'curr_authtype'})) {
3302: if ($in{'curr_authtype'} ne '') {
3303: $radioval = "'".$in{'curr_authtype'}."arg'";
3304: }
1.174 matthew 3305: }
1.165 raeburn 3306: my $argfield = 'null';
1.591 raeburn 3307: if (defined($in{'mode'})) {
1.165 raeburn 3308: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3309: if (defined($in{'curr_autharg'})) {
3310: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3311: $argfield = "'$in{'curr_autharg'}'";
3312: }
3313: }
3314: }
3315: }
3316:
1.32 matthew 3317: $result.=<<"END";
3318: var current = new Object();
1.165 raeburn 3319: current.radiovalue = $radioval;
3320: current.argfield = $argfield;
1.32 matthew 3321:
3322: function changed_radio(choice,currentform) {
3323: var choicearg = choice + 'arg';
3324: // If a radio button in changed, we need to change the argfield
3325: if (current.radiovalue != choice) {
3326: current.radiovalue = choice;
3327: if (current.argfield != null) {
3328: currentform.elements[current.argfield].value = '';
3329: }
3330: if (choice == 'nochange') {
3331: current.argfield = null;
3332: } else {
3333: current.argfield = choicearg;
3334: switch(choice) {
3335: case 'krb':
3336: currentform.elements[current.argfield].value =
3337: "$in{'kerb_def_dom'}";
3338: break;
3339: default:
3340: break;
3341: }
3342: }
3343: }
3344: return;
3345: }
1.22 www 3346:
1.32 matthew 3347: function changed_text(choice,currentform) {
3348: var choicearg = choice + 'arg';
3349: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3350: $Javascript_toUpperCase
1.32 matthew 3351: // clear old field
3352: if ((current.argfield != choicearg) && (current.argfield != null)) {
3353: currentform.elements[current.argfield].value = '';
3354: }
3355: current.argfield = choicearg;
3356: }
3357: set_auth_radio_buttons(choice,currentform);
3358: return;
1.20 www 3359: }
1.32 matthew 3360:
3361: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3362: var numauthchoices = currentform.login.length;
3363: if (typeof numauthchoices == "undefined") {
3364: return;
3365: }
1.32 matthew 3366: var i=0;
1.986 raeburn 3367: while (i < numauthchoices) {
1.32 matthew 3368: if (currentform.login[i].value == newvalue) { break; }
3369: i++;
3370: }
1.986 raeburn 3371: if (i == numauthchoices) {
1.32 matthew 3372: return;
3373: }
3374: current.radiovalue = newvalue;
3375: currentform.login[i].checked = true;
3376: return;
3377: }
3378: END
3379: return $result;
3380: }
3381:
1.1106 raeburn 3382: sub authform_authorwarning {
1.32 matthew 3383: my $result='';
1.144 matthew 3384: $result='<i>'.
3385: &mt('As a general rule, only authors or co-authors should be '.
3386: 'filesystem authenticated '.
3387: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3388: return $result;
3389: }
3390:
1.1106 raeburn 3391: sub authform_nochange {
1.32 matthew 3392: my %in = (
3393: formname => 'document.cu',
3394: kerb_def_dom => 'MSU.EDU',
3395: @_,
3396: );
1.1106 raeburn 3397: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3398: my $result;
1.1104 raeburn 3399: if (!$authnum) {
1.1105 raeburn 3400: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3401: } else {
3402: $result = '<label>'.&mt('[_1] Do not change login data',
3403: '<input type="radio" name="login" value="nochange" '.
3404: 'checked="checked" onclick="'.
1.281 albertel 3405: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3406: '</label>';
1.586 raeburn 3407: }
1.32 matthew 3408: return $result;
3409: }
3410:
1.591 raeburn 3411: sub authform_kerberos {
1.32 matthew 3412: my %in = (
3413: formname => 'document.cu',
3414: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3415: kerb_def_auth => 'krb4',
1.32 matthew 3416: @_,
3417: );
1.586 raeburn 3418: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3419: $autharg,$jscall,$disabled);
1.1106 raeburn 3420: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3421: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3422: $check5 = ' checked="checked"';
1.80 albertel 3423: } else {
1.772 bisitz 3424: $check4 = ' checked="checked"';
1.80 albertel 3425: }
1.1259 raeburn 3426: if ($in{'readonly'}) {
3427: $disabled = ' disabled="disabled"';
3428: }
1.165 raeburn 3429: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3430: if (defined($in{'curr_authtype'})) {
3431: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3432: $krbcheck = ' checked="checked"';
1.623 raeburn 3433: if (defined($in{'mode'})) {
3434: if ($in{'mode'} eq 'modifyuser') {
3435: $krbcheck = '';
3436: }
3437: }
1.591 raeburn 3438: if (defined($in{'curr_kerb_ver'})) {
3439: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3440: $check5 = ' checked="checked"';
1.591 raeburn 3441: $check4 = '';
3442: } else {
1.772 bisitz 3443: $check4 = ' checked="checked"';
1.591 raeburn 3444: $check5 = '';
3445: }
1.586 raeburn 3446: }
1.591 raeburn 3447: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3448: $krbarg = $in{'curr_autharg'};
3449: }
1.586 raeburn 3450: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3451: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3452: $result =
3453: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3454: $in{'curr_autharg'},$krbver);
3455: } else {
3456: $result =
3457: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3458: }
3459: return $result;
3460: }
3461: }
3462: } else {
3463: if ($authnum == 1) {
1.784 bisitz 3464: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3465: }
3466: }
1.586 raeburn 3467: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3468: return;
1.587 raeburn 3469: } elsif ($authtype eq '') {
1.591 raeburn 3470: if (defined($in{'mode'})) {
1.587 raeburn 3471: if ($in{'mode'} eq 'modifycourse') {
3472: if ($authnum == 1) {
1.1259 raeburn 3473: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3474: }
3475: }
3476: }
1.586 raeburn 3477: }
3478: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3479: if ($authtype eq '') {
3480: $authtype = '<input type="radio" name="login" value="krb" '.
3481: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3482: $krbcheck.$disabled.' />';
1.586 raeburn 3483: }
3484: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3485: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3486: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3487: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3488: $in{'curr_authtype'} eq 'krb4')) {
3489: $result .= &mt
1.144 matthew 3490: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3491: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3492: '<label>'.$authtype,
1.281 albertel 3493: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3494: 'value="'.$krbarg.'" '.
1.1259 raeburn 3495: 'onchange="'.$jscall.'"'.$disabled.' />',
3496: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3497: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3498: '</label>');
1.586 raeburn 3499: } elsif ($can_assign{'krb4'}) {
3500: $result .= &mt
3501: ('[_1] Kerberos authenticated with domain [_2] '.
3502: '[_3] Version 4 [_4]',
3503: '<label>'.$authtype,
3504: '</label><input type="text" size="10" name="krbarg" '.
3505: 'value="'.$krbarg.'" '.
1.1259 raeburn 3506: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3507: '<label><input type="hidden" name="krbver" value="4" />',
3508: '</label>');
3509: } elsif ($can_assign{'krb5'}) {
3510: $result .= &mt
3511: ('[_1] Kerberos authenticated with domain [_2] '.
3512: '[_3] Version 5 [_4]',
3513: '<label>'.$authtype,
3514: '</label><input type="text" size="10" name="krbarg" '.
3515: 'value="'.$krbarg.'" '.
1.1259 raeburn 3516: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3517: '<label><input type="hidden" name="krbver" value="5" />',
3518: '</label>');
3519: }
1.32 matthew 3520: return $result;
3521: }
3522:
1.1106 raeburn 3523: sub authform_internal {
1.586 raeburn 3524: my %in = (
1.32 matthew 3525: formname => 'document.cu',
3526: kerb_def_dom => 'MSU.EDU',
3527: @_,
3528: );
1.1259 raeburn 3529: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3530: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3531: if ($in{'readonly'}) {
3532: $disabled = ' disabled="disabled"';
3533: }
1.591 raeburn 3534: if (defined($in{'curr_authtype'})) {
3535: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3536: if ($can_assign{'int'}) {
1.772 bisitz 3537: $intcheck = 'checked="checked" ';
1.623 raeburn 3538: if (defined($in{'mode'})) {
3539: if ($in{'mode'} eq 'modifyuser') {
3540: $intcheck = '';
3541: }
3542: }
1.591 raeburn 3543: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3544: $intarg = $in{'curr_autharg'};
3545: }
3546: } else {
3547: $result = &mt('Currently internally authenticated.');
3548: return $result;
1.165 raeburn 3549: }
3550: }
1.586 raeburn 3551: } else {
3552: if ($authnum == 1) {
1.784 bisitz 3553: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3554: }
3555: }
3556: if (!$can_assign{'int'}) {
3557: return;
1.587 raeburn 3558: } elsif ($authtype eq '') {
1.591 raeburn 3559: if (defined($in{'mode'})) {
1.587 raeburn 3560: if ($in{'mode'} eq 'modifycourse') {
3561: if ($authnum == 1) {
1.1259 raeburn 3562: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3563: }
3564: }
3565: }
1.165 raeburn 3566: }
1.586 raeburn 3567: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3568: if ($authtype eq '') {
3569: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3570: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3571: }
1.605 bisitz 3572: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3573: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3574: $result = &mt
1.144 matthew 3575: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3576: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3577: $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 3578: return $result;
3579: }
3580:
1.1104 raeburn 3581: sub authform_local {
1.32 matthew 3582: my %in = (
3583: formname => 'document.cu',
3584: kerb_def_dom => 'MSU.EDU',
3585: @_,
3586: );
1.1259 raeburn 3587: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3588: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3589: if ($in{'readonly'}) {
3590: $disabled = ' disabled="disabled"';
3591: }
1.591 raeburn 3592: if (defined($in{'curr_authtype'})) {
3593: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3594: if ($can_assign{'loc'}) {
1.772 bisitz 3595: $loccheck = 'checked="checked" ';
1.623 raeburn 3596: if (defined($in{'mode'})) {
3597: if ($in{'mode'} eq 'modifyuser') {
3598: $loccheck = '';
3599: }
3600: }
1.591 raeburn 3601: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3602: $locarg = $in{'curr_autharg'};
3603: }
3604: } else {
3605: $result = &mt('Currently using local (institutional) authentication.');
3606: return $result;
1.165 raeburn 3607: }
3608: }
1.586 raeburn 3609: } else {
3610: if ($authnum == 1) {
1.784 bisitz 3611: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3612: }
3613: }
3614: if (!$can_assign{'loc'}) {
3615: return;
1.587 raeburn 3616: } elsif ($authtype eq '') {
1.591 raeburn 3617: if (defined($in{'mode'})) {
1.587 raeburn 3618: if ($in{'mode'} eq 'modifycourse') {
3619: if ($authnum == 1) {
1.1259 raeburn 3620: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3621: }
3622: }
3623: }
1.165 raeburn 3624: }
1.586 raeburn 3625: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3626: if ($authtype eq '') {
3627: $authtype = '<input type="radio" name="login" value="loc" '.
3628: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3629: $jscall.'"'.$disabled.' />';
1.586 raeburn 3630: }
3631: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3632: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3633: $result = &mt('[_1] Local Authentication with argument [_2]',
3634: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3635: return $result;
3636: }
3637:
1.1106 raeburn 3638: sub authform_filesystem {
1.32 matthew 3639: my %in = (
3640: formname => 'document.cu',
3641: kerb_def_dom => 'MSU.EDU',
3642: @_,
3643: );
1.1259 raeburn 3644: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3645: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3646: if ($in{'readonly'}) {
3647: $disabled = ' disabled="disabled"';
3648: }
1.591 raeburn 3649: if (defined($in{'curr_authtype'})) {
3650: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3651: if ($can_assign{'fsys'}) {
1.772 bisitz 3652: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3653: if (defined($in{'mode'})) {
3654: if ($in{'mode'} eq 'modifyuser') {
3655: $fsyscheck = '';
3656: }
3657: }
1.586 raeburn 3658: } else {
3659: $result = &mt('Currently Filesystem Authenticated.');
3660: return $result;
1.1259 raeburn 3661: }
1.586 raeburn 3662: }
3663: } else {
3664: if ($authnum == 1) {
1.784 bisitz 3665: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3666: }
3667: }
3668: if (!$can_assign{'fsys'}) {
3669: return;
1.587 raeburn 3670: } elsif ($authtype eq '') {
1.591 raeburn 3671: if (defined($in{'mode'})) {
1.587 raeburn 3672: if ($in{'mode'} eq 'modifycourse') {
3673: if ($authnum == 1) {
1.1259 raeburn 3674: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3675: }
3676: }
3677: }
1.586 raeburn 3678: }
3679: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3680: if ($authtype eq '') {
3681: $authtype = '<input type="radio" name="login" value="fsys" '.
3682: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3683: $jscall.'"'.$disabled.' />';
1.586 raeburn 3684: }
1.1310 raeburn 3685: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3686: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3687: $result = &mt
1.144 matthew 3688: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3689: '<label>'.$authtype,'</label>'.$autharg);
3690: return $result;
3691: }
3692:
3693: sub authform_lti {
3694: my %in = (
3695: formname => 'document.cu',
3696: kerb_def_dom => 'MSU.EDU',
3697: @_,
3698: );
3699: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3700: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3701: if ($in{'readonly'}) {
3702: $disabled = ' disabled="disabled"';
3703: }
3704: if (defined($in{'curr_authtype'})) {
3705: if ($in{'curr_authtype'} eq 'lti') {
3706: if ($can_assign{'lti'}) {
3707: $lticheck = 'checked="checked" ';
3708: if (defined($in{'mode'})) {
3709: if ($in{'mode'} eq 'modifyuser') {
3710: $lticheck = '';
3711: }
3712: }
3713: } else {
3714: $result = &mt('Currently LTI Authenticated.');
3715: return $result;
3716: }
3717: }
3718: } else {
3719: if ($authnum == 1) {
3720: $authtype = '<input type="hidden" name="login" value="lti" />';
3721: }
3722: }
3723: if (!$can_assign{'lti'}) {
3724: return;
3725: } elsif ($authtype eq '') {
3726: if (defined($in{'mode'})) {
3727: if ($in{'mode'} eq 'modifycourse') {
3728: if ($authnum == 1) {
3729: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3730: }
3731: }
3732: }
3733: }
3734: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3735: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3736: $authtype = '<input type="radio" name="login" value="lti" '.
3737: $lticheck.' onchange="'.$jscall.'" onclick="'.
3738: $jscall.'"'.$disabled.' />';
3739: }
3740: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3741: if ($authtype) {
3742: $result = &mt('[_1] LTI Authenticated',
3743: '<label>'.$authtype.'</label>'.$autharg);
3744: } else {
3745: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3746: $autharg;
3747: }
1.32 matthew 3748: return $result;
3749: }
3750:
1.586 raeburn 3751: sub get_assignable_auth {
3752: my ($dom) = @_;
3753: if ($dom eq '') {
3754: $dom = $env{'request.role.domain'};
3755: }
3756: my %can_assign = (
3757: krb4 => 1,
3758: krb5 => 1,
3759: int => 1,
3760: loc => 1,
1.1310 raeburn 3761: lti => 1,
1.586 raeburn 3762: );
3763: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3764: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3765: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3766: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3767: my $context;
3768: if ($env{'request.role'} =~ /^au/) {
3769: $context = 'author';
1.1259 raeburn 3770: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3771: $context = 'domain';
3772: } elsif ($env{'request.course.id'}) {
3773: $context = 'course';
3774: }
3775: if ($context) {
3776: if (ref($authhash->{$context}) eq 'HASH') {
3777: %can_assign = %{$authhash->{$context}};
3778: }
3779: }
3780: }
3781: }
3782: my $authnum = 0;
3783: foreach my $key (keys(%can_assign)) {
3784: if ($can_assign{$key}) {
3785: $authnum ++;
3786: }
3787: }
3788: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3789: $authnum --;
3790: }
3791: return ($authnum,%can_assign);
3792: }
3793:
1.1331 raeburn 3794: sub check_passwd_rules {
3795: my ($domain,$plainpass) = @_;
3796: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3797: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3798: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3799: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3800: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3801: if ($passwdconf{'min'} > $min) {
3802: $min = $passwdconf{'min'};
3803: }
1.1331 raeburn 3804: }
3805: if ($passwdconf{'max'} =~ /^\d+$/) {
3806: $max = $passwdconf{'max'};
3807: }
3808: @chars = @{$passwdconf{'chars'}};
3809: }
3810: if (($min) && (length($plainpass) < $min)) {
3811: push(@brokerule,'min');
3812: }
3813: if (($max) && (length($plainpass) > $max)) {
3814: push(@brokerule,'max');
3815: }
3816: if (@chars) {
3817: my %rules;
3818: map { $rules{$_} = 1; } @chars;
3819: if ($rules{'uc'}) {
3820: unless ($plainpass =~ /[A-Z]/) {
3821: push(@brokerule,'uc');
3822: }
3823: }
3824: if ($rules{'lc'}) {
1.1332 raeburn 3825: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3826: push(@brokerule,'lc');
3827: }
3828: }
3829: if ($rules{'num'}) {
3830: unless ($plainpass =~ /\d/) {
3831: push(@brokerule,'num');
3832: }
3833: }
3834: if ($rules{'spec'}) {
3835: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3836: push(@brokerule,'spec');
3837: }
3838: }
3839: }
3840: if (@brokerule) {
3841: my %rulenames = &Apache::lonlocal::texthash(
3842: uc => 'At least one upper case letter',
3843: lc => 'At least one lower case letter',
3844: num => 'At least one number',
3845: spec => 'At least one non-alphanumeric',
3846: );
3847: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3848: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3849: $rulenames{'num'} .= ': 0123456789';
3850: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3851: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3852: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3853: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3854: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3855: if (grep(/^$rule$/,@brokerule)) {
3856: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3857: }
3858: }
3859: $warning .= '</ul>';
3860: }
1.1332 raeburn 3861: if (wantarray) {
3862: return @brokerule;
3863: }
1.1331 raeburn 3864: return $warning;
3865: }
3866:
1.1376 raeburn 3867: sub passwd_validation_js {
1.1377 raeburn 3868: my ($currpasswdval,$domain,$context,$id) = @_;
3869: my (%passwdconf,$alertmsg);
3870: if ($context eq 'linkprot') {
3871: my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3872: if (ref($domconfig{'ltisec'}) eq 'HASH') {
3873: if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3874: %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3875: }
3876: }
3877: if ($id eq 'add') {
3878: $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3879: } elsif ($id =~ /^\d+$/) {
3880: my $pos = $id+1;
3881: $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3882: } else {
3883: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3884: }
3885: } else {
3886: %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3887: $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3888: }
1.1376 raeburn 3889: my ($min,$max,@chars,$numrules,$intargjs,%alert);
3890: $numrules = 0;
3891: $min = $Apache::lonnet::passwdmin;
3892: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3893: if ($passwdconf{'min'} =~ /^\d+$/) {
3894: if ($passwdconf{'min'} > $min) {
3895: $min = $passwdconf{'min'};
3896: }
3897: }
3898: if ($passwdconf{'max'} =~ /^\d+$/) {
3899: $max = $passwdconf{'max'};
3900: $numrules ++;
3901: }
3902: @chars = @{$passwdconf{'chars'}};
3903: if (@chars) {
3904: $numrules ++;
3905: }
3906: }
3907: if ($min > 0) {
3908: $numrules ++;
3909: }
3910: if (($min > 0) || ($max ne '') || (@chars > 0)) {
3911: if ($min) {
3912: $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3913: }
3914: if ($max) {
3915: $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3916: }
3917: my (@charalerts,@charrules);
3918: if (@chars) {
3919: if (grep(/^uc$/,@chars)) {
3920: push(@charalerts,&mt('contain at least one upper case letter'));
3921: push(@charrules,'uc');
3922: }
3923: if (grep(/^lc$/,@chars)) {
3924: push(@charalerts,&mt('contain at least one lower case letter'));
3925: push(@charrules,'lc');
3926: }
3927: if (grep(/^num$/,@chars)) {
3928: push(@charalerts,&mt('contain at least one number'));
3929: push(@charrules,'num');
3930: }
3931: if (grep(/^spec$/,@chars)) {
3932: push(@charalerts,&mt('contain at least one non-alphanumeric'));
3933: push(@charrules,'spec');
3934: }
3935: }
3936: $intargjs = qq| var rulesmsg = '';\n|.
3937: qq| var currpwval = $currpasswdval;\n|;
3938: if ($min) {
3939: $intargjs .= qq|
3940: if (currpwval.length < $min) {
3941: rulesmsg += ' - $alert{min}';
3942: }
3943: |;
3944: }
3945: if ($max) {
3946: $intargjs .= qq|
3947: if (currpwval.length > $max) {
3948: rulesmsg += ' - $alert{max}';
3949: }
3950: |;
3951: }
3952: if (@chars > 0) {
3953: my $charrulestr = '"'.join('","',@charrules).'"';
3954: my $charalertstr = '"'.join('","',@charalerts).'"';
3955: $intargjs .= qq| var brokerules = new Array();\n|.
3956: qq| var charrules = new Array($charrulestr);\n|.
3957: qq| var charalerts = new Array($charalertstr);\n|;
3958: my %rules;
3959: map { $rules{$_} = 1; } @chars;
3960: if ($rules{'uc'}) {
3961: $intargjs .= qq|
3962: var ucRegExp = /[A-Z]/;
3963: if (!ucRegExp.test(currpwval)) {
3964: brokerules.push('uc');
3965: }
3966: |;
3967: }
3968: if ($rules{'lc'}) {
3969: $intargjs .= qq|
3970: var lcRegExp = /[a-z]/;
3971: if (!lcRegExp.test(currpwval)) {
3972: brokerules.push('lc');
3973: }
3974: |;
3975: }
3976: if ($rules{'num'}) {
3977: $intargjs .= qq|
3978: var numRegExp = /[0-9]/;
3979: if (!numRegExp.test(currpwval)) {
3980: brokerules.push('num');
3981: }
3982: |;
3983: }
3984: if ($rules{'spec'}) {
3985: $intargjs .= q|
3986: var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3987: if (!specRegExp.test(currpwval)) {
3988: brokerules.push('spec');
3989: }
3990: |;
3991: }
3992: $intargjs .= qq|
3993: if (brokerules.length > 0) {
3994: for (var i=0; i<brokerules.length; i++) {
3995: for (var j=0; j<charrules.length; j++) {
3996: if (brokerules[i] == charrules[j]) {
3997: rulesmsg += ' - '+charalerts[j]+'\\n';
3998: break;
3999: }
4000: }
4001: }
4002: }
4003: |;
4004: }
4005: $intargjs .= qq|
4006: if (rulesmsg != '') {
4007: rulesmsg = '$alertmsg'+rulesmsg;
4008: alert(rulesmsg);
4009: return false;
4010: }
4011: |;
4012: }
4013: return ($numrules,$intargjs);
4014: }
4015:
1.80 albertel 4016: ###############################################################
4017: ## Get Kerberos Defaults for Domain ##
4018: ###############################################################
4019: ##
4020: ## Returns default kerberos version and an associated argument
4021: ## as listed in file domain.tab. If not listed, provides
4022: ## appropriate default domain and kerberos version.
4023: ##
4024: #-------------------------------------------
4025:
4026: =pod
4027:
1.648 raeburn 4028: =item * &get_kerberos_defaults()
1.80 albertel 4029:
4030: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 4031: version and domain. If not found, it defaults to version 4 and the
4032: domain of the server.
1.80 albertel 4033:
1.648 raeburn 4034: =over 4
4035:
1.80 albertel 4036: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
4037:
1.648 raeburn 4038: =back
4039:
4040: =back
4041:
1.80 albertel 4042: =cut
4043:
4044: #-------------------------------------------
4045: sub get_kerberos_defaults {
4046: my $domain=shift;
1.641 raeburn 4047: my ($krbdef,$krbdefdom);
4048: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
4049: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
4050: $krbdef = $domdefaults{'auth_def'};
4051: $krbdefdom = $domdefaults{'auth_arg_def'};
4052: } else {
1.80 albertel 4053: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
4054: my $krbdefdom=$1;
4055: $krbdefdom=~tr/a-z/A-Z/;
4056: $krbdef = "krb4";
4057: }
4058: return ($krbdef,$krbdefdom);
4059: }
1.112 bowersj2 4060:
1.32 matthew 4061:
1.46 matthew 4062: ###############################################################
4063: ## Thesaurus Functions ##
4064: ###############################################################
1.20 www 4065:
1.46 matthew 4066: =pod
1.20 www 4067:
1.112 bowersj2 4068: =head1 Thesaurus Functions
4069:
4070: =over 4
4071:
1.648 raeburn 4072: =item * &initialize_keywords()
1.46 matthew 4073:
4074: Initializes the package variable %Keywords if it is empty. Uses the
4075: package variable $thesaurus_db_file.
4076:
4077: =cut
4078:
4079: ###################################################
4080:
4081: sub initialize_keywords {
4082: return 1 if (scalar keys(%Keywords));
4083: # If we are here, %Keywords is empty, so fill it up
4084: # Make sure the file we need exists...
4085: if (! -e $thesaurus_db_file) {
4086: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
4087: " failed because it does not exist");
4088: return 0;
4089: }
4090: # Set up the hash as a database
4091: my %thesaurus_db;
4092: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4093: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4094: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
4095: $thesaurus_db_file);
4096: return 0;
4097: }
4098: # Get the average number of appearances of a word.
4099: my $avecount = $thesaurus_db{'average.count'};
4100: # Put keywords (those that appear > average) into %Keywords
4101: while (my ($word,$data)=each (%thesaurus_db)) {
4102: my ($count,undef) = split /:/,$data;
4103: $Keywords{$word}++ if ($count > $avecount);
4104: }
4105: untie %thesaurus_db;
4106: # Remove special values from %Keywords.
1.356 albertel 4107: foreach my $value ('total.count','average.count') {
4108: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 4109: }
1.46 matthew 4110: return 1;
4111: }
4112:
4113: ###################################################
4114:
4115: =pod
4116:
1.648 raeburn 4117: =item * &keyword($word)
1.46 matthew 4118:
4119: Returns true if $word is a keyword. A keyword is a word that appears more
4120: than the average number of times in the thesaurus database. Calls
4121: &initialize_keywords
4122:
4123: =cut
4124:
4125: ###################################################
1.20 www 4126:
4127: sub keyword {
1.46 matthew 4128: return if (!&initialize_keywords());
4129: my $word=lc(shift());
4130: $word=~s/\W//g;
4131: return exists($Keywords{$word});
1.20 www 4132: }
1.46 matthew 4133:
4134: ###############################################################
4135:
4136: =pod
1.20 www 4137:
1.648 raeburn 4138: =item * &get_related_words()
1.46 matthew 4139:
1.160 matthew 4140: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 4141: an array of words. If the keyword is not in the thesaurus, an empty array
4142: will be returned. The order of the words returned is determined by the
4143: database which holds them.
4144:
4145: Uses global $thesaurus_db_file.
4146:
1.1057 foxr 4147:
1.46 matthew 4148: =cut
4149:
4150: ###############################################################
4151: sub get_related_words {
4152: my $keyword = shift;
4153: my %thesaurus_db;
4154: if (! -e $thesaurus_db_file) {
4155: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
4156: "failed because the file does not exist");
4157: return ();
4158: }
4159: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4160: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4161: return ();
4162: }
4163: my @Words=();
1.429 www 4164: my $count=0;
1.46 matthew 4165: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 4166: # The first element is the number of times
4167: # the word appears. We do not need it now.
1.429 www 4168: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
4169: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
4170: my $threshold=$mostfrequentcount/10;
4171: foreach my $possibleword (@RelatedWords) {
4172: my ($word,$wordcount)=split(/\,/,$possibleword);
4173: if ($wordcount>$threshold) {
4174: push(@Words,$word);
4175: $count++;
4176: if ($count>10) { last; }
4177: }
1.20 www 4178: }
4179: }
1.46 matthew 4180: untie %thesaurus_db;
4181: return @Words;
1.14 harris41 4182: }
1.1090 foxr 4183: ###############################################################
4184: #
4185: # Spell checking
4186: #
4187:
4188: =pod
4189:
1.1142 raeburn 4190: =back
4191:
1.1090 foxr 4192: =head1 Spell checking
4193:
4194: =over 4
4195:
4196: =item * &check_spelling($wordlist $language)
4197:
4198: Takes a string containing words and feeds it to an external
4199: spellcheck program via a pipeline. Returns a string containing
4200: them mis-spelled words.
4201:
4202: Parameters:
4203:
4204: =over 4
4205:
4206: =item - $wordlist
4207:
4208: String that will be fed into the spellcheck program.
4209:
4210: =item - $language
4211:
4212: Language string that specifies the language for which the spell
4213: check will be performed.
4214:
4215: =back
4216:
4217: =back
4218:
4219: Note: This sub assumes that aspell is installed.
4220:
4221:
4222: =cut
4223:
1.46 matthew 4224:
1.1090 foxr 4225: sub check_spelling {
4226: my ($wordlist, $language) = @_;
1.1091 foxr 4227: my @misspellings;
4228:
4229: # Generate the speller and set the langauge.
4230: # if explicitly selected:
1.1090 foxr 4231:
1.1091 foxr 4232: my $speller = Text::Aspell->new;
1.1090 foxr 4233: if ($language) {
1.1091 foxr 4234: $speller->set_option('lang', $language);
1.1090 foxr 4235: }
4236:
1.1091 foxr 4237: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 4238:
1.1091 foxr 4239: my @words = split(/\s+/, $wordlist);
1.1090 foxr 4240:
1.1091 foxr 4241: foreach my $word (@words) {
4242: if(! $speller->check($word)) {
4243: push(@misspellings, $word);
1.1090 foxr 4244: }
4245: }
1.1091 foxr 4246: return join(' ', @misspellings);
4247:
1.1090 foxr 4248: }
4249:
1.61 www 4250: # -------------------------------------------------------------- Plaintext name
1.81 albertel 4251: =pod
4252:
1.112 bowersj2 4253: =head1 User Name Functions
4254:
4255: =over 4
4256:
1.648 raeburn 4257: =item * &plainname($uname,$udom,$first)
1.81 albertel 4258:
1.112 bowersj2 4259: Takes a users logon name and returns it as a string in
1.226 albertel 4260: "first middle last generation" form
4261: if $first is set to 'lastname' then it returns it as
4262: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 4263:
4264: =cut
1.61 www 4265:
1.295 www 4266:
1.81 albertel 4267: ###############################################################
1.61 www 4268: sub plainname {
1.226 albertel 4269: my ($uname,$udom,$first)=@_;
1.537 albertel 4270: return if (!defined($uname) || !defined($udom));
1.295 www 4271: my %names=&getnames($uname,$udom);
1.226 albertel 4272: my $name=&Apache::lonnet::format_name($names{'firstname'},
4273: $names{'middlename'},
4274: $names{'lastname'},
4275: $names{'generation'},$first);
4276: $name=~s/^\s+//;
1.62 www 4277: $name=~s/\s+$//;
4278: $name=~s/\s+/ /g;
1.353 albertel 4279: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 4280: return $name;
1.61 www 4281: }
1.66 www 4282:
4283: # -------------------------------------------------------------------- Nickname
1.81 albertel 4284: =pod
4285:
1.648 raeburn 4286: =item * &nickname($uname,$udom)
1.81 albertel 4287:
4288: Gets a users name and returns it as a string as
4289:
4290: ""nickname""
1.66 www 4291:
1.81 albertel 4292: if the user has a nickname or
4293:
4294: "first middle last generation"
4295:
4296: if the user does not
4297:
4298: =cut
1.66 www 4299:
4300: sub nickname {
4301: my ($uname,$udom)=@_;
1.537 albertel 4302: return if (!defined($uname) || !defined($udom));
1.295 www 4303: my %names=&getnames($uname,$udom);
1.68 albertel 4304: my $name=$names{'nickname'};
1.66 www 4305: if ($name) {
4306: $name='"'.$name.'"';
4307: } else {
4308: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
4309: $names{'lastname'}.' '.$names{'generation'};
4310: $name=~s/\s+$//;
4311: $name=~s/\s+/ /g;
4312: }
4313: return $name;
4314: }
4315:
1.295 www 4316: sub getnames {
4317: my ($uname,$udom)=@_;
1.537 albertel 4318: return if (!defined($uname) || !defined($udom));
1.433 albertel 4319: if ($udom eq 'public' && $uname eq 'public') {
4320: return ('lastname' => &mt('Public'));
4321: }
1.295 www 4322: my $id=$uname.':'.$udom;
4323: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
4324: if ($cached) {
4325: return %{$names};
4326: } else {
4327: my %loadnames=&Apache::lonnet::get('environment',
4328: ['firstname','middlename','lastname','generation','nickname'],
4329: $udom,$uname);
4330: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
4331: return %loadnames;
4332: }
4333: }
1.61 www 4334:
1.542 raeburn 4335: # -------------------------------------------------------------------- getemails
1.648 raeburn 4336:
1.542 raeburn 4337: =pod
4338:
1.648 raeburn 4339: =item * &getemails($uname,$udom)
1.542 raeburn 4340:
4341: Gets a user's email information and returns it as a hash with keys:
4342: notification, critnotification, permanentemail
4343:
4344: For notification and critnotification, values are comma-separated lists
1.648 raeburn 4345: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 4346:
1.648 raeburn 4347:
1.542 raeburn 4348: =cut
4349:
1.648 raeburn 4350:
1.466 albertel 4351: sub getemails {
4352: my ($uname,$udom)=@_;
4353: if ($udom eq 'public' && $uname eq 'public') {
4354: return;
4355: }
1.467 www 4356: if (!$udom) { $udom=$env{'user.domain'}; }
4357: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 4358: my $id=$uname.':'.$udom;
4359: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
4360: if ($cached) {
4361: return %{$names};
4362: } else {
4363: my %loadnames=&Apache::lonnet::get('environment',
4364: ['notification','critnotification',
4365: 'permanentemail'],
4366: $udom,$uname);
4367: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4368: return %loadnames;
4369: }
4370: }
4371:
1.551 albertel 4372: sub flush_email_cache {
4373: my ($uname,$udom)=@_;
4374: if (!$udom) { $udom =$env{'user.domain'}; }
4375: if (!$uname) { $uname=$env{'user.name'}; }
4376: return if ($udom eq 'public' && $uname eq 'public');
4377: my $id=$uname.':'.$udom;
4378: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4379: }
4380:
1.728 raeburn 4381: # -------------------------------------------------------------------- getlangs
4382:
4383: =pod
4384:
4385: =item * &getlangs($uname,$udom)
4386:
4387: Gets a user's language preference and returns it as a hash with key:
4388: language.
4389:
4390: =cut
4391:
4392:
4393: sub getlangs {
4394: my ($uname,$udom) = @_;
4395: if (!$udom) { $udom =$env{'user.domain'}; }
4396: if (!$uname) { $uname=$env{'user.name'}; }
4397: my $id=$uname.':'.$udom;
4398: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4399: if ($cached) {
4400: return %{$langs};
4401: } else {
4402: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4403: $udom,$uname);
4404: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4405: return %loadlangs;
4406: }
4407: }
4408:
4409: sub flush_langs_cache {
4410: my ($uname,$udom)=@_;
4411: if (!$udom) { $udom =$env{'user.domain'}; }
4412: if (!$uname) { $uname=$env{'user.name'}; }
4413: return if ($udom eq 'public' && $uname eq 'public');
4414: my $id=$uname.':'.$udom;
4415: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4416: }
4417:
1.61 www 4418: # ------------------------------------------------------------------ Screenname
1.81 albertel 4419:
4420: =pod
4421:
1.648 raeburn 4422: =item * &screenname($uname,$udom)
1.81 albertel 4423:
4424: Gets a users screenname and returns it as a string
4425:
4426: =cut
1.61 www 4427:
4428: sub screenname {
4429: my ($uname,$udom)=@_;
1.258 albertel 4430: if ($uname eq $env{'user.name'} &&
4431: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4432: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4433: return $names{'screenname'};
1.62 www 4434: }
4435:
1.212 albertel 4436:
1.802 bisitz 4437: # ------------------------------------------------------------- Confirm Wrapper
4438: =pod
4439:
1.1142 raeburn 4440: =item * &confirmwrapper($message)
1.802 bisitz 4441:
4442: Wrap messages about completion of operation in box
4443:
4444: =cut
4445:
4446: sub confirmwrapper {
4447: my ($message)=@_;
4448: if ($message) {
4449: return "\n".'<div class="LC_confirm_box">'."\n"
4450: .$message."\n"
4451: .'</div>'."\n";
4452: } else {
4453: return $message;
4454: }
4455: }
4456:
1.62 www 4457: # ------------------------------------------------------------- Message Wrapper
4458:
4459: sub messagewrapper {
1.369 www 4460: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4461: return
1.441 albertel 4462: '<a href="/adm/email?compose=individual&'.
4463: 'recname='.$username.'&recdom='.$domain.
4464: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4465: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4466: }
1.802 bisitz 4467:
1.74 www 4468: # --------------------------------------------------------------- Notes Wrapper
4469:
4470: sub noteswrapper {
4471: my ($link,$un,$do)=@_;
4472: return
1.896 amueller 4473: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4474: }
1.802 bisitz 4475:
1.62 www 4476: # ------------------------------------------------------------- Aboutme Wrapper
4477:
4478: sub aboutmewrapper {
1.1070 raeburn 4479: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4480: if (!defined($username) && !defined($domain)) {
4481: return;
4482: }
1.1096 raeburn 4483: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4484: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4485: }
4486:
4487: # ------------------------------------------------------------ Syllabus Wrapper
4488:
4489: sub syllabuswrapper {
1.707 bisitz 4490: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4491: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4492: }
1.14 harris41 4493:
1.1397 raeburn 4494: # -----------------------------------------------------------------------------
4495:
1.1396 raeburn 4496: sub aboutme_on {
4497: my ($uname,$udom)=@_;
4498: unless ($uname) { $uname=$env{'user.name'}; }
4499: unless ($udom) { $udom=$env{'user.domain'}; }
4500: return if ($udom eq 'public' && $uname eq 'public');
4501: my $hashkey=$uname.':'.$udom;
4502: my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
4503: if ($cached) {
4504: return $aboutme;
4505: }
4506: $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
4507: &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
4508: return $aboutme;
4509: }
4510:
4511: sub devalidate_aboutme_cache {
4512: my ($uname,$udom)=@_;
4513: if (!$udom) { $udom =$env{'user.domain'}; }
4514: if (!$uname) { $uname=$env{'user.name'}; }
4515: return if ($udom eq 'public' && $uname eq 'public');
4516: my $id=$uname.':'.$udom;
4517: &Apache::lonnet::devalidate_cache_new('aboutme',$id);
4518: }
4519:
1.208 matthew 4520: sub track_student_link {
1.887 raeburn 4521: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4522: my $link ="/adm/trackstudent?";
1.208 matthew 4523: my $title = 'View recent activity';
4524: if (defined($sname) && $sname !~ /^\s*$/ &&
4525: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4526: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4527: $title .= ' of this student';
1.268 albertel 4528: }
1.208 matthew 4529: if (defined($target) && $target !~ /^\s*$/) {
4530: $target = qq{target="$target"};
4531: } else {
4532: $target = '';
4533: }
1.268 albertel 4534: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4535: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4536: $title = &mt($title);
4537: $linktext = &mt($linktext);
1.448 albertel 4538: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4539: &help_open_topic('View_recent_activity');
1.208 matthew 4540: }
4541:
1.781 raeburn 4542: sub slot_reservations_link {
4543: my ($linktext,$sname,$sdom,$target) = @_;
4544: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4545: my $title = 'View slot reservation history';
4546: if (defined($sname) && $sname !~ /^\s*$/ &&
4547: defined($sdom) && $sdom !~ /^\s*$/) {
4548: $link .= "&uname=$sname&udom=$sdom";
4549: $title .= ' of this student';
4550: }
4551: if (defined($target) && $target !~ /^\s*$/) {
4552: $target = qq{target="$target"};
4553: } else {
4554: $target = '';
4555: }
4556: $title = &mt($title);
4557: $linktext = &mt($linktext);
4558: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4559: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4560:
4561: }
4562:
1.508 www 4563: # ===================================================== Display a student photo
4564:
4565:
1.509 albertel 4566: sub student_image_tag {
1.508 www 4567: my ($domain,$user)=@_;
4568: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4569: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4570: return '<img src="'.$imgsrc.'" align="right" />';
4571: } else {
4572: return '';
4573: }
4574: }
4575:
1.112 bowersj2 4576: =pod
4577:
4578: =back
4579:
4580: =head1 Access .tab File Data
4581:
4582: =over 4
4583:
1.648 raeburn 4584: =item * &languageids()
1.112 bowersj2 4585:
4586: returns list of all language ids
4587:
4588: =cut
4589:
1.14 harris41 4590: sub languageids {
1.16 harris41 4591: return sort(keys(%language));
1.14 harris41 4592: }
4593:
1.112 bowersj2 4594: =pod
4595:
1.648 raeburn 4596: =item * &languagedescription()
1.112 bowersj2 4597:
4598: returns description of a specified language id
4599:
4600: =cut
4601:
1.14 harris41 4602: sub languagedescription {
1.125 www 4603: my $code=shift;
4604: return ($supported_language{$code}?'* ':'').
4605: $language{$code}.
1.126 www 4606: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4607: }
4608:
1.1048 foxr 4609: =pod
4610:
4611: =item * &plainlanguagedescription
4612:
4613: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4614: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4615:
4616: =cut
4617:
1.145 www 4618: sub plainlanguagedescription {
4619: my $code=shift;
4620: return $language{$code};
4621: }
4622:
1.1048 foxr 4623: =pod
4624:
4625: =item * &supportedlanguagecode
4626:
4627: Returns the supported language code (e.g. sptutf maps to pt) given a language
4628: code.
4629:
4630: =cut
4631:
1.145 www 4632: sub supportedlanguagecode {
4633: my $code=shift;
4634: return $supported_language{$code};
1.97 www 4635: }
4636:
1.112 bowersj2 4637: =pod
4638:
1.1048 foxr 4639: =item * &latexlanguage()
4640:
4641: Given a language key code returns the correspondnig language to use
4642: to select the correct hyphenation on LaTeX printouts. This is undef if there
4643: is no supported hyphenation for the language code.
4644:
4645: =cut
4646:
4647: sub latexlanguage {
4648: my $code = shift;
4649: return $latex_language{$code};
4650: }
4651:
4652: =pod
4653:
4654: =item * &latexhyphenation()
4655:
4656: Same as above but what's supplied is the language as it might be stored
4657: in the metadata.
4658:
4659: =cut
4660:
4661: sub latexhyphenation {
4662: my $key = shift;
4663: return $latex_language_bykey{$key};
4664: }
4665:
4666: =pod
4667:
1.648 raeburn 4668: =item * ©rightids()
1.112 bowersj2 4669:
4670: returns list of all copyrights
4671:
4672: =cut
4673:
4674: sub copyrightids {
4675: return sort(keys(%cprtag));
4676: }
4677:
4678: =pod
4679:
1.648 raeburn 4680: =item * ©rightdescription()
1.112 bowersj2 4681:
4682: returns description of a specified copyright id
4683:
4684: =cut
4685:
4686: sub copyrightdescription {
1.166 www 4687: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4688: }
1.197 matthew 4689:
4690: =pod
4691:
1.648 raeburn 4692: =item * &source_copyrightids()
1.192 taceyjo1 4693:
4694: returns list of all source copyrights
4695:
4696: =cut
4697:
4698: sub source_copyrightids {
4699: return sort(keys(%scprtag));
4700: }
4701:
4702: =pod
4703:
1.648 raeburn 4704: =item * &source_copyrightdescription()
1.192 taceyjo1 4705:
4706: returns description of a specified source copyright id
4707:
4708: =cut
4709:
4710: sub source_copyrightdescription {
4711: return &mt($scprtag{shift(@_)});
4712: }
1.112 bowersj2 4713:
4714: =pod
4715:
1.648 raeburn 4716: =item * &filecategories()
1.112 bowersj2 4717:
4718: returns list of all file categories
4719:
4720: =cut
4721:
4722: sub filecategories {
4723: return sort(keys(%category_extensions));
4724: }
4725:
4726: =pod
4727:
1.648 raeburn 4728: =item * &filecategorytypes()
1.112 bowersj2 4729:
4730: returns list of file types belonging to a given file
4731: category
4732:
4733: =cut
4734:
4735: sub filecategorytypes {
1.356 albertel 4736: my ($cat) = @_;
1.1248 raeburn 4737: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4738: return @{$category_extensions{lc($cat)}};
4739: } else {
4740: return ();
4741: }
1.112 bowersj2 4742: }
4743:
4744: =pod
4745:
1.648 raeburn 4746: =item * &fileembstyle()
1.112 bowersj2 4747:
4748: returns embedding style for a specified file type
4749:
4750: =cut
4751:
4752: sub fileembstyle {
4753: return $fe{lc(shift(@_))};
1.169 www 4754: }
4755:
1.351 www 4756: sub filemimetype {
4757: return $fm{lc(shift(@_))};
4758: }
4759:
1.169 www 4760:
4761: sub filecategoryselect {
4762: my ($name,$value)=@_;
1.189 matthew 4763: return &select_form($value,$name,
1.970 raeburn 4764: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4765: }
4766:
4767: =pod
4768:
1.648 raeburn 4769: =item * &filedescription()
1.112 bowersj2 4770:
4771: returns description for a specified file type
4772:
4773: =cut
4774:
4775: sub filedescription {
1.188 matthew 4776: my $file_description = $fd{lc(shift())};
4777: $file_description =~ s:([\[\]]):~$1:g;
4778: return &mt($file_description);
1.112 bowersj2 4779: }
4780:
4781: =pod
4782:
1.648 raeburn 4783: =item * &filedescriptionex()
1.112 bowersj2 4784:
4785: returns description for a specified file type with
4786: extra formatting
4787:
4788: =cut
4789:
4790: sub filedescriptionex {
4791: my $ex=shift;
1.188 matthew 4792: my $file_description = $fd{lc($ex)};
4793: $file_description =~ s:([\[\]]):~$1:g;
4794: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4795: }
4796:
4797: # End of .tab access
4798: =pod
4799:
4800: =back
4801:
4802: =cut
4803:
4804: # ------------------------------------------------------------------ File Types
4805: sub fileextensions {
4806: return sort(keys(%fe));
4807: }
4808:
1.97 www 4809: # ----------------------------------------------------------- Display Languages
4810: # returns a hash with all desired display languages
4811: #
4812:
4813: sub display_languages {
4814: my %languages=();
1.695 raeburn 4815: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4816: $languages{$lang}=1;
1.97 www 4817: }
4818: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4819: if ($env{'form.displaylanguage'}) {
1.356 albertel 4820: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4821: $languages{$lang}=1;
1.97 www 4822: }
4823: }
4824: return %languages;
1.14 harris41 4825: }
4826:
1.582 albertel 4827: sub languages {
4828: my ($possible_langs) = @_;
1.695 raeburn 4829: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4830: if (!ref($possible_langs)) {
4831: if( wantarray ) {
4832: return @preferred_langs;
4833: } else {
4834: return $preferred_langs[0];
4835: }
4836: }
4837: my %possibilities = map { $_ => 1 } (@$possible_langs);
4838: my @preferred_possibilities;
4839: foreach my $preferred_lang (@preferred_langs) {
4840: if (exists($possibilities{$preferred_lang})) {
4841: push(@preferred_possibilities, $preferred_lang);
4842: }
4843: }
4844: if( wantarray ) {
4845: return @preferred_possibilities;
4846: }
4847: return $preferred_possibilities[0];
4848: }
4849:
1.742 raeburn 4850: sub user_lang {
4851: my ($touname,$toudom,$fromcid) = @_;
4852: my @userlangs;
4853: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4854: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4855: $env{'course.'.$fromcid.'.languages'}));
4856: } else {
4857: my %langhash = &getlangs($touname,$toudom);
4858: if ($langhash{'languages'} ne '') {
4859: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4860: } else {
4861: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4862: if ($domdefs{'lang_def'} ne '') {
4863: @userlangs = ($domdefs{'lang_def'});
4864: }
4865: }
4866: }
4867: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4868: my $user_lh = Apache::localize->get_handle(@languages);
4869: return $user_lh;
4870: }
4871:
4872:
1.112 bowersj2 4873: ###############################################################
4874: ## Student Answer Attempts ##
4875: ###############################################################
4876:
4877: =pod
4878:
4879: =head1 Alternate Problem Views
4880:
4881: =over 4
4882:
1.648 raeburn 4883: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4884: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4885:
4886: Return string with previous attempt on problem. Arguments:
4887:
4888: =over 4
4889:
4890: =item * $symb: Problem, including path
4891:
4892: =item * $username: username of the desired student
4893:
4894: =item * $domain: domain of the desired student
1.14 harris41 4895:
1.112 bowersj2 4896: =item * $course: Course ID
1.14 harris41 4897:
1.112 bowersj2 4898: =item * $getattempt: Leave blank for all attempts, otherwise put
4899: something
1.14 harris41 4900:
1.112 bowersj2 4901: =item * $regexp: if string matches this regexp, the string will be
4902: sent to $gradesub
1.14 harris41 4903:
1.112 bowersj2 4904: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4905:
1.1199 raeburn 4906: =item * $usec: section of the desired student
4907:
4908: =item * $identifier: counter for student (multiple students one problem) or
4909: problem (one student; whole sequence).
4910:
1.112 bowersj2 4911: =back
1.14 harris41 4912:
1.112 bowersj2 4913: The output string is a table containing all desired attempts, if any.
1.16 harris41 4914:
1.112 bowersj2 4915: =cut
1.1 albertel 4916:
4917: sub get_previous_attempt {
1.1199 raeburn 4918: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4919: my $prevattempts='';
1.43 ng 4920: no strict 'refs';
1.1 albertel 4921: if ($symb) {
1.3 albertel 4922: my (%returnhash)=
4923: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4924: if ($returnhash{'version'}) {
4925: my %lasthash=();
4926: my $version;
4927: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4928: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4929: if ($key =~ /\.rawrndseed$/) {
4930: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4931: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4932: } else {
4933: $lasthash{$key}=$returnhash{$version.':'.$key};
4934: }
1.19 harris41 4935: }
1.1 albertel 4936: }
1.596 albertel 4937: $prevattempts=&start_data_table().&start_data_table_header_row();
4938: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4939: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4940: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4941: foreach my $key (sort(keys(%lasthash))) {
4942: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4943: if ($#parts > 0) {
1.31 albertel 4944: my $data=$parts[-1];
1.989 raeburn 4945: next if ($data eq 'foilorder');
1.31 albertel 4946: pop(@parts);
1.1010 www 4947: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4948: if ($data eq 'type') {
4949: unless ($showsurv) {
4950: my $id = join(',',@parts);
4951: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4952: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4953: $lasthidden{$ign.'.'.$id} = 1;
4954: }
1.945 raeburn 4955: }
1.1199 raeburn 4956: if ($identifier ne '') {
4957: my $id = join(',',@parts);
4958: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4959: $domain,$username,$usec,undef,$course) =~ /^no/) {
4960: $hidestatus{$ign.'.'.$id} = 1;
4961: }
4962: }
4963: } elsif ($data eq 'regrader') {
4964: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4965: my $id = join(',',@parts);
4966: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4967: }
1.1010 www 4968: }
1.31 albertel 4969: } else {
1.41 ng 4970: if ($#parts == 0) {
4971: $prevattempts.='<th>'.$parts[0].'</th>';
4972: } else {
4973: $prevattempts.='<th>'.$ign.'</th>';
4974: }
1.31 albertel 4975: }
1.16 harris41 4976: }
1.596 albertel 4977: $prevattempts.=&end_data_table_header_row();
1.40 ng 4978: if ($getattempt eq '') {
1.1199 raeburn 4979: my (%solved,%resets,%probstatus);
1.1200 raeburn 4980: if (($identifier ne '') && (keys(%regraded) > 0)) {
4981: for ($version=1;$version<=$returnhash{'version'};$version++) {
4982: foreach my $id (keys(%regraded)) {
4983: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4984: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4985: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4986: push(@{$resets{$id}},$version);
1.1199 raeburn 4987: }
4988: }
4989: }
1.1200 raeburn 4990: }
4991: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4992: my (@hidden,@unsolved);
1.945 raeburn 4993: if (%typeparts) {
4994: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4995: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4996: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4997: push(@hidden,$id);
1.1199 raeburn 4998: } elsif ($identifier ne '') {
4999: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
5000: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
5001: ($hidestatus{$id})) {
1.1200 raeburn 5002: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 5003: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
5004: push(@{$solved{$id}},$version);
5005: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
5006: (ref($solved{$id}) eq 'ARRAY')) {
5007: my $skip;
5008: if (ref($resets{$id}) eq 'ARRAY') {
5009: foreach my $reset (@{$resets{$id}}) {
5010: if ($reset > $solved{$id}[-1]) {
5011: $skip=1;
5012: last;
5013: }
5014: }
5015: }
5016: unless ($skip) {
5017: my ($ign,$partslist) = split(/\./,$id,2);
5018: push(@unsolved,$partslist);
5019: }
5020: }
5021: }
1.945 raeburn 5022: }
5023: }
5024: }
5025: $prevattempts.=&start_data_table_row().
1.1199 raeburn 5026: '<td>'.&mt('Transaction [_1]',$version);
5027: if (@unsolved) {
5028: $prevattempts .= '<span class="LC_nobreak"><label>'.
5029: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
5030: &mt('Hide').'</label></span>';
5031: }
5032: $prevattempts .= '</td>';
1.945 raeburn 5033: if (@hidden) {
5034: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5035: next if ($key =~ /\.foilorder$/);
1.945 raeburn 5036: my $hide;
5037: foreach my $id (@hidden) {
5038: if ($key =~ /^\Q$id\E/) {
5039: $hide = 1;
5040: last;
5041: }
5042: }
5043: if ($hide) {
5044: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
5045: if (($data eq 'award') || ($data eq 'awarddetail')) {
5046: my $value = &format_previous_attempt_value($key,
5047: $returnhash{$version.':'.$key});
1.1173 kruse 5048: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5049: } else {
5050: $prevattempts.='<td> </td>';
5051: }
5052: } else {
5053: if ($key =~ /\./) {
1.1212 raeburn 5054: my $value = $returnhash{$version.':'.$key};
5055: if ($key =~ /\.rndseed$/) {
5056: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
5057: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
5058: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
5059: }
5060: }
5061: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
5062: ' </td>';
1.945 raeburn 5063: } else {
5064: $prevattempts.='<td> </td>';
5065: }
5066: }
5067: }
5068: } else {
5069: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5070: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 5071: my $value = $returnhash{$version.':'.$key};
5072: if ($key =~ /\.rndseed$/) {
5073: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
5074: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
5075: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
5076: }
5077: }
5078: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
5079: ' </td>';
1.945 raeburn 5080: }
5081: }
5082: $prevattempts.=&end_data_table_row();
1.40 ng 5083: }
1.1 albertel 5084: }
1.945 raeburn 5085: my @currhidden = keys(%lasthidden);
1.596 albertel 5086: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 5087: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5088: next if ($key =~ /\.foilorder$/);
1.945 raeburn 5089: if (%typeparts) {
5090: my $hidden;
5091: foreach my $id (@currhidden) {
5092: if ($key =~ /^\Q$id\E/) {
5093: $hidden = 1;
5094: last;
5095: }
5096: }
5097: if ($hidden) {
5098: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
5099: if (($data eq 'award') || ($data eq 'awarddetail')) {
5100: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5101: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5102: $value = &$gradesub($value);
5103: }
1.1173 kruse 5104: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 5105: } else {
5106: $prevattempts.='<td> </td>';
5107: }
5108: } else {
5109: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5110: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5111: $value = &$gradesub($value);
5112: }
1.1173 kruse 5113: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5114: }
5115: } else {
5116: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5117: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5118: $value = &$gradesub($value);
5119: }
1.1173 kruse 5120: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5121: }
1.16 harris41 5122: }
1.596 albertel 5123: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 5124: } else {
1.1305 raeburn 5125: my $msg;
5126: if ($symb =~ /ext\.tool$/) {
5127: $msg = &mt('No grade passed back.');
5128: } else {
5129: $msg = &mt('Nothing submitted - no attempts.');
5130: }
1.596 albertel 5131: $prevattempts=
5132: &start_data_table().&start_data_table_row().
1.1305 raeburn 5133: '<td>'.$msg.'</td>'.
1.596 albertel 5134: &end_data_table_row().&end_data_table();
1.1 albertel 5135: }
5136: } else {
1.596 albertel 5137: $prevattempts=
5138: &start_data_table().&start_data_table_row().
5139: '<td>'.&mt('No data.').'</td>'.
5140: &end_data_table_row().&end_data_table();
1.1 albertel 5141: }
1.10 albertel 5142: }
5143:
1.581 albertel 5144: sub format_previous_attempt_value {
5145: my ($key,$value) = @_;
1.1011 www 5146: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 5147: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 5148: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 5149: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 5150: } elsif ($key =~ /answerstring$/) {
5151: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 5152: my @answer = %answers;
5153: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 5154: my @anskeys = sort(keys(%answers));
5155: if (@anskeys == 1) {
5156: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 5157: if ($answer =~ m{\0}) {
5158: $answer =~ s{\0}{,}g;
1.988 raeburn 5159: }
5160: my $tag_internal_answer_name = 'INTERNAL';
5161: if ($anskeys[0] eq $tag_internal_answer_name) {
5162: $value = $answer;
5163: } else {
5164: $value = $anskeys[0].'='.$answer;
5165: }
5166: } else {
5167: foreach my $ans (@anskeys) {
5168: my $answer = $answers{$ans};
1.1001 raeburn 5169: if ($answer =~ m{\0}) {
5170: $answer =~ s{\0}{,}g;
1.988 raeburn 5171: }
5172: $value .= $ans.'='.$answer.'<br />';;
5173: }
5174: }
1.581 albertel 5175: } else {
1.1173 kruse 5176: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 5177: }
5178: return $value;
5179: }
5180:
5181:
1.107 albertel 5182: sub relative_to_absolute {
5183: my ($url,$output)=@_;
5184: my $parser=HTML::TokeParser->new(\$output);
5185: my $token;
5186: my $thisdir=$url;
5187: my @rlinks=();
5188: while ($token=$parser->get_token) {
5189: if ($token->[0] eq 'S') {
5190: if ($token->[1] eq 'a') {
5191: if ($token->[2]->{'href'}) {
5192: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
5193: }
5194: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
5195: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
5196: } elsif ($token->[1] eq 'base') {
5197: $thisdir=$token->[2]->{'href'};
5198: }
5199: }
5200: }
5201: $thisdir=~s-/[^/]*$--;
1.356 albertel 5202: foreach my $link (@rlinks) {
1.726 raeburn 5203: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 5204: ($link=~/^\//) ||
5205: ($link=~/^javascript:/i) ||
5206: ($link=~/^mailto:/i) ||
5207: ($link=~/^\#/)) {
5208: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
5209: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 5210: }
5211: }
5212: # -------------------------------------------------- Deal with Applet codebases
5213: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
5214: return $output;
5215: }
5216:
1.112 bowersj2 5217: =pod
5218:
1.648 raeburn 5219: =item * &get_student_view()
1.112 bowersj2 5220:
5221: show a snapshot of what student was looking at
5222:
5223: =cut
5224:
1.10 albertel 5225: sub get_student_view {
1.186 albertel 5226: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 5227: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5228: my (%form);
1.10 albertel 5229: my @elements=('symb','courseid','domain','username');
5230: foreach my $element (@elements) {
1.186 albertel 5231: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5232: }
1.186 albertel 5233: if (defined($moreenv)) {
5234: %form=(%form,%{$moreenv});
5235: }
1.236 albertel 5236: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 5237: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 5238: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
5239: $feedurl =~ s{^/adm/wrapper}{};
5240: }
1.650 www 5241: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 5242: $userview=~s/\<body[^\>]*\>//gi;
5243: $userview=~s/\<\/body\>//gi;
5244: $userview=~s/\<html\>//gi;
5245: $userview=~s/\<\/html\>//gi;
5246: $userview=~s/\<head\>//gi;
5247: $userview=~s/\<\/head\>//gi;
5248: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 5249: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 5250: if (wantarray) {
5251: return ($userview,$response);
5252: } else {
5253: return $userview;
5254: }
5255: }
5256:
5257: sub get_student_view_with_retries {
5258: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
5259:
5260: my $ok = 0; # True if we got a good response.
5261: my $content;
5262: my $response;
5263:
5264: # Try to get the student_view done. within the retries count:
5265:
5266: do {
5267: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
5268: $ok = $response->is_success;
5269: if (!$ok) {
5270: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
5271: }
5272: $retries--;
5273: } while (!$ok && ($retries > 0));
5274:
5275: if (!$ok) {
5276: $content = ''; # On error return an empty content.
5277: }
1.651 www 5278: if (wantarray) {
5279: return ($content, $response);
5280: } else {
5281: return $content;
5282: }
1.11 albertel 5283: }
5284:
1.1349 raeburn 5285: sub css_links {
5286: my ($currsymb,$level) = @_;
5287: my ($links,@symbs,%cssrefs,%httpref);
5288: if ($level eq 'map') {
5289: my $navmap = Apache::lonnavmaps::navmap->new();
5290: if (ref($navmap)) {
5291: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
5292: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
5293: foreach my $res (@resources) {
5294: if (ref($res) && $res->symb()) {
5295: push(@symbs,$res->symb());
5296: }
5297: }
5298: }
5299: } else {
5300: @symbs = ($currsymb);
5301: }
5302: foreach my $symb (@symbs) {
5303: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
5304: if ($css_href =~ /\S/) {
5305: unless ($css_href =~ m{https?://}) {
5306: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
5307: my $proburl = &Apache::lonnet::clutter($url);
5308: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
5309: unless ($css_href =~ m{^/}) {
5310: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
5311: }
5312: if ($css_href =~ m{^/(res|uploaded)/}) {
5313: unless (($httpref{'httpref.'.$css_href}) ||
5314: (&Apache::lonnet::is_on_map($css_href))) {
5315: my $thisurl = $proburl;
5316: if ($env{'httpref.'.$proburl}) {
5317: $thisurl = $env{'httpref.'.$proburl};
5318: }
5319: $httpref{'httpref.'.$css_href} = $thisurl;
5320: }
5321: }
5322: }
5323: $cssrefs{$css_href} = 1;
5324: }
5325: }
5326: if (keys(%httpref)) {
5327: &Apache::lonnet::appenv(\%httpref);
5328: }
5329: if (keys(%cssrefs)) {
5330: foreach my $css_href (keys(%cssrefs)) {
5331: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
5332: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
5333: }
5334: }
5335: return $links;
5336: }
5337:
1.112 bowersj2 5338: =pod
5339:
1.648 raeburn 5340: =item * &get_student_answers()
1.112 bowersj2 5341:
5342: show a snapshot of how student was answering problem
5343:
5344: =cut
5345:
1.11 albertel 5346: sub get_student_answers {
1.100 sakharuk 5347: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 5348: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5349: my (%moreenv);
1.11 albertel 5350: my @elements=('symb','courseid','domain','username');
5351: foreach my $element (@elements) {
1.186 albertel 5352: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5353: }
1.186 albertel 5354: $moreenv{'grade_target'}='answer';
5355: %moreenv=(%form,%moreenv);
1.497 raeburn 5356: $feedurl = &Apache::lonnet::clutter($feedurl);
5357: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 5358: return $userview;
1.1 albertel 5359: }
1.116 albertel 5360:
5361: =pod
5362:
5363: =item * &submlink()
5364:
1.242 albertel 5365: Inputs: $text $uname $udom $symb $target
1.116 albertel 5366:
5367: Returns: A link to grades.pm such as to see the SUBM view of a student
5368:
5369: =cut
5370:
5371: ###############################################
5372: sub submlink {
1.242 albertel 5373: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 5374: if (!($uname && $udom)) {
5375: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5376: &Apache::lonnet::whichuser($symb);
1.116 albertel 5377: if (!$symb) { $symb=$cursymb; }
5378: }
1.254 matthew 5379: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5380: $symb=&escape($symb);
1.960 bisitz 5381: if ($target) { $target=" target=\"$target\""; }
5382: return
5383: '<a href="/adm/grades?command=submission'.
5384: '&symb='.$symb.
5385: '&student='.$uname.
5386: '&userdom='.$udom.'"'.
5387: $target.'>'.$text.'</a>';
1.242 albertel 5388: }
5389: ##############################################
5390:
5391: =pod
5392:
5393: =item * &pgrdlink()
5394:
5395: Inputs: $text $uname $udom $symb $target
5396:
5397: Returns: A link to grades.pm such as to see the PGRD view of a student
5398:
5399: =cut
5400:
5401: ###############################################
5402: sub pgrdlink {
5403: my $link=&submlink(@_);
5404: $link=~s/(&command=submission)/$1&showgrading=yes/;
5405: return $link;
5406: }
5407: ##############################################
5408:
5409: =pod
5410:
5411: =item * &pprmlink()
5412:
5413: Inputs: $text $uname $udom $symb $target
5414:
5415: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 5416: student and a specific resource
1.242 albertel 5417:
5418: =cut
5419:
5420: ###############################################
5421: sub pprmlink {
5422: my ($text,$uname,$udom,$symb,$target)=@_;
5423: if (!($uname && $udom)) {
5424: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5425: &Apache::lonnet::whichuser($symb);
1.242 albertel 5426: if (!$symb) { $symb=$cursymb; }
5427: }
1.254 matthew 5428: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5429: $symb=&escape($symb);
1.242 albertel 5430: if ($target) { $target="target=\"$target\""; }
1.595 albertel 5431: return '<a href="/adm/parmset?command=set&'.
5432: 'symb='.$symb.'&uname='.$uname.
5433: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 5434: }
5435: ##############################################
1.37 matthew 5436:
1.112 bowersj2 5437: =pod
5438:
5439: =back
5440:
5441: =cut
5442:
1.37 matthew 5443: ###############################################
1.51 www 5444:
5445:
5446: sub timehash {
1.687 raeburn 5447: my ($thistime) = @_;
5448: my $timezone = &Apache::lonlocal::gettimezone();
5449: my $dt = DateTime->from_epoch(epoch => $thistime)
5450: ->set_time_zone($timezone);
5451: my $wday = $dt->day_of_week();
5452: if ($wday == 7) { $wday = 0; }
5453: return ( 'second' => $dt->second(),
5454: 'minute' => $dt->minute(),
5455: 'hour' => $dt->hour(),
5456: 'day' => $dt->day_of_month(),
5457: 'month' => $dt->month(),
5458: 'year' => $dt->year(),
5459: 'weekday' => $wday,
5460: 'dayyear' => $dt->day_of_year(),
5461: 'dlsav' => $dt->is_dst() );
1.51 www 5462: }
5463:
1.370 www 5464: sub utc_string {
5465: my ($date)=@_;
1.371 www 5466: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5467: }
5468:
1.51 www 5469: sub maketime {
5470: my %th=@_;
1.687 raeburn 5471: my ($epoch_time,$timezone,$dt);
5472: $timezone = &Apache::lonlocal::gettimezone();
5473: eval {
5474: $dt = DateTime->new( year => $th{'year'},
5475: month => $th{'month'},
5476: day => $th{'day'},
5477: hour => $th{'hour'},
5478: minute => $th{'minute'},
5479: second => $th{'second'},
5480: time_zone => $timezone,
5481: );
5482: };
5483: if (!$@) {
5484: $epoch_time = $dt->epoch;
5485: if ($epoch_time) {
5486: return $epoch_time;
5487: }
5488: }
1.51 www 5489: return POSIX::mktime(
5490: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5491: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5492: }
5493:
5494: #########################################
1.51 www 5495:
5496: sub findallcourses {
1.482 raeburn 5497: my ($roles,$uname,$udom) = @_;
1.355 albertel 5498: my %roles;
5499: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5500: my %courses;
1.51 www 5501: my $now=time;
1.482 raeburn 5502: if (!defined($uname)) {
5503: $uname = $env{'user.name'};
5504: }
5505: if (!defined($udom)) {
5506: $udom = $env{'user.domain'};
5507: }
5508: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5509: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5510: if (!%roles) {
5511: %roles = (
5512: cc => 1,
1.907 raeburn 5513: co => 1,
1.482 raeburn 5514: in => 1,
5515: ep => 1,
5516: ta => 1,
5517: cr => 1,
5518: st => 1,
5519: );
5520: }
5521: foreach my $entry (keys(%roleshash)) {
5522: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5523: if ($trole =~ /^cr/) {
5524: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5525: } else {
5526: next if (!exists($roles{$trole}));
5527: }
5528: if ($tend) {
5529: next if ($tend < $now);
5530: }
5531: if ($tstart) {
5532: next if ($tstart > $now);
5533: }
1.1058 raeburn 5534: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5535: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5536: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5537: if ($secpart eq '') {
5538: ($cnum,$role) = split(/_/,$cnumpart);
5539: $sec = 'none';
1.1058 raeburn 5540: $value .= $cnum.'/';
1.482 raeburn 5541: } else {
5542: $cnum = $cnumpart;
5543: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5544: $value .= $cnum.'/'.$sec;
5545: }
5546: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5547: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5548: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5549: }
5550: } else {
5551: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5552: }
1.482 raeburn 5553: }
5554: } else {
5555: foreach my $key (keys(%env)) {
1.483 albertel 5556: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5557: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5558: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5559: next if ($role eq 'ca' || $role eq 'aa');
5560: next if (%roles && !exists($roles{$role}));
5561: my ($starttime,$endtime)=split(/\./,$env{$key});
5562: my $active=1;
5563: if ($starttime) {
5564: if ($now<$starttime) { $active=0; }
5565: }
5566: if ($endtime) {
5567: if ($now>$endtime) { $active=0; }
5568: }
5569: if ($active) {
1.1058 raeburn 5570: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5571: if ($sec eq '') {
5572: $sec = 'none';
1.1058 raeburn 5573: } else {
5574: $value .= $sec;
5575: }
5576: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5577: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5578: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5579: }
5580: } else {
5581: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5582: }
1.474 raeburn 5583: }
5584: }
1.51 www 5585: }
5586: }
1.474 raeburn 5587: return %courses;
1.51 www 5588: }
1.37 matthew 5589:
1.54 www 5590: ###############################################
1.474 raeburn 5591:
5592: sub blockcheck {
1.1372 raeburn 5593: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
5594: unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
5595: my ($has_evb,$check_ipaccess);
5596: my $dom = $env{'user.domain'};
5597: if ($env{'request.course.id'}) {
5598: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5599: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5600: my $checkrole = "cm./$cdom/$cnum";
5601: my $sec = $env{'request.course.sec'};
5602: if ($sec ne '') {
5603: $checkrole .= "/$sec";
5604: }
5605: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5606: ($env{'request.role'} !~ /^st/)) {
5607: $has_evb = 1;
5608: }
5609: unless ($has_evb) {
5610: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
5611: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
5612: if ($udom eq $cdom) {
5613: $check_ipaccess = 1;
5614: }
5615: }
5616: }
1.1375 raeburn 5617: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5618: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5619: my $checkrole;
5620: if ($env{'request.role.domain'} eq '') {
5621: $checkrole = "cm./$env{'user.domain'}/";
5622: } else {
5623: $checkrole = "cm./$env{'request.role.domain'}/";
5624: }
5625: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5626: $has_evb = 1;
5627: }
1.1372 raeburn 5628: }
5629: unless ($has_evb || $check_ipaccess) {
5630: my @machinedoms = &Apache::lonnet::current_machine_domains();
5631: if (($dom eq 'public') && ($activity eq 'port')) {
5632: $dom = $udom;
5633: }
5634: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5635: $check_ipaccess = 1;
5636: } else {
5637: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5638: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5639: my $prim = &Apache::lonnet::domain($dom,'primary');
5640: my $intdom = &Apache::lonnet::internet_dom($prim);
5641: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5642: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5643: $check_ipaccess = 1;
5644: }
5645: }
5646: }
5647: }
5648: if ($check_ipaccess) {
5649: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5650: unless (defined($cached)) {
5651: my %domconfig =
5652: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5653: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5654: }
5655: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5656: foreach my $id (keys(%{$ipaccessref})) {
5657: if (ref($ipaccessref->{$id}) eq 'HASH') {
5658: my $range = $ipaccessref->{$id}->{'ip'};
5659: if ($range) {
5660: if (&Apache::lonnet::ip_match($clientip,$range)) {
5661: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5662: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5663: return ('','','',$id,$dom);
5664: last;
5665: }
5666: }
5667: }
5668: }
5669: }
5670: }
5671: }
5672: }
1.1373 raeburn 5673: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5674: return ();
5675: }
1.1372 raeburn 5676: }
1.1189 raeburn 5677: if (defined($udom) && defined($uname)) {
5678: # If uname and udom are for a course, check for blocks in the course.
5679: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5680: my ($startblock,$endblock,$triggerblock) =
1.1347 raeburn 5681: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189 raeburn 5682: return ($startblock,$endblock,$triggerblock);
5683: }
5684: } else {
1.490 raeburn 5685: $udom = $env{'user.domain'};
5686: $uname = $env{'user.name'};
5687: }
5688:
1.502 raeburn 5689: my $startblock = 0;
5690: my $endblock = 0;
1.1062 raeburn 5691: my $triggerblock = '';
1.1373 raeburn 5692: my %live_courses;
5693: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5694: %live_courses = &findallcourses(undef,$uname,$udom);
5695: }
1.474 raeburn 5696:
1.490 raeburn 5697: # If uname is for a user, and activity is course-specific, i.e.,
5698: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5699:
1.490 raeburn 5700: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5701: $activity eq 'groups' || $activity eq 'printout' ||
1.1346 raeburn 5702: $activity eq 'search' || $activity eq 'reinit' ||
5703: $activity eq 'alert') &&
1.1189 raeburn 5704: ($env{'request.course.id'})) {
1.490 raeburn 5705: foreach my $key (keys(%live_courses)) {
5706: if ($key ne $env{'request.course.id'}) {
5707: delete($live_courses{$key});
5708: }
5709: }
5710: }
5711:
5712: my $otheruser = 0;
5713: my %own_courses;
5714: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5715: # Resource belongs to user other than current user.
5716: $otheruser = 1;
5717: # Gather courses for current user
5718: %own_courses =
5719: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5720: }
5721:
5722: # Gather active course roles - course coordinator, instructor,
5723: # exam proctor, ta, student, or custom role.
1.474 raeburn 5724:
5725: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5726: my ($cdom,$cnum);
5727: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5728: $cdom = $env{'course.'.$course.'.domain'};
5729: $cnum = $env{'course.'.$course.'.num'};
5730: } else {
1.490 raeburn 5731: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5732: }
5733: my $no_ownblock = 0;
5734: my $no_userblock = 0;
1.533 raeburn 5735: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5736: # Check if current user has 'evb' priv for this
5737: if (defined($own_courses{$course})) {
5738: foreach my $sec (keys(%{$own_courses{$course}})) {
5739: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5740: if ($sec ne 'none') {
5741: $checkrole .= '/'.$sec;
5742: }
5743: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5744: $no_ownblock = 1;
5745: last;
5746: }
5747: }
5748: }
5749: # if they have 'evb' priv and are currently not playing student
5750: next if (($no_ownblock) &&
5751: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5752: }
1.474 raeburn 5753: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5754: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5755: if ($sec ne 'none') {
1.482 raeburn 5756: $checkrole .= '/'.$sec;
1.474 raeburn 5757: }
1.490 raeburn 5758: if ($otheruser) {
5759: # Resource belongs to user other than current user.
5760: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5761: my (%allroles,%userroles);
5762: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5763: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5764: my ($trole,$tdom,$tnum,$tsec);
5765: if ($entry =~ /^cr/) {
5766: ($trole,$tdom,$tnum,$tsec) =
5767: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5768: } else {
5769: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5770: }
5771: my ($spec,$area,$trest);
5772: $area = '/'.$tdom.'/'.$tnum;
5773: $trest = $tnum;
5774: if ($tsec ne '') {
5775: $area .= '/'.$tsec;
5776: $trest .= '/'.$tsec;
5777: }
5778: $spec = $trole.'.'.$area;
5779: if ($trole =~ /^cr/) {
5780: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5781: $tdom,$spec,$trest,$area);
5782: } else {
5783: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5784: $tdom,$spec,$trest,$area);
5785: }
5786: }
1.1276 raeburn 5787: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5788: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5789: if ($1) {
5790: $no_userblock = 1;
5791: last;
5792: }
1.486 raeburn 5793: }
5794: }
1.490 raeburn 5795: } else {
5796: # Resource belongs to current user
5797: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5798: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5799: $no_ownblock = 1;
5800: last;
5801: }
1.474 raeburn 5802: }
5803: }
5804: # if they have the evb priv and are currently not playing student
1.482 raeburn 5805: next if (($no_ownblock) &&
1.491 albertel 5806: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5807: next if ($no_userblock);
1.474 raeburn 5808:
1.1303 raeburn 5809: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5810: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5811:
1.1062 raeburn 5812: my ($start,$end,$trigger) =
1.1347 raeburn 5813: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5814: if (($start != 0) &&
5815: (($startblock == 0) || ($startblock > $start))) {
5816: $startblock = $start;
1.1062 raeburn 5817: if ($trigger ne '') {
5818: $triggerblock = $trigger;
5819: }
1.502 raeburn 5820: }
5821: if (($end != 0) &&
5822: (($endblock == 0) || ($endblock < $end))) {
5823: $endblock = $end;
1.1062 raeburn 5824: if ($trigger ne '') {
5825: $triggerblock = $trigger;
5826: }
1.502 raeburn 5827: }
1.490 raeburn 5828: }
1.1062 raeburn 5829: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5830: }
5831:
5832: sub get_blocks {
1.1347 raeburn 5833: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5834: my $startblock = 0;
5835: my $endblock = 0;
1.1062 raeburn 5836: my $triggerblock = '';
1.490 raeburn 5837: my $course = $cdom.'_'.$cnum;
5838: $setters->{$course} = {};
5839: $setters->{$course}{'staff'} = [];
5840: $setters->{$course}{'times'} = [];
1.1062 raeburn 5841: $setters->{$course}{'triggers'} = [];
5842: my (@blockers,%triggered);
5843: my $now = time;
5844: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5845: if ($activity eq 'docs') {
1.1348 raeburn 5846: my ($blocked,$nosymbcache,$noenccheck);
1.1347 raeburn 5847: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5848: $blocked = 1;
5849: $nosymbcache = 1;
1.1348 raeburn 5850: $noenccheck = 1;
1.1347 raeburn 5851: }
1.1348 raeburn 5852: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5853: foreach my $block (@blockers) {
5854: if ($block =~ /^firstaccess____(.+)$/) {
5855: my $item = $1;
5856: my $type = 'map';
5857: my $timersymb = $item;
5858: if ($item eq 'course') {
5859: $type = 'course';
5860: } elsif ($item =~ /___\d+___/) {
5861: $type = 'resource';
5862: } else {
5863: $timersymb = &Apache::lonnet::symbread($item);
5864: }
5865: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5866: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5867: $triggered{$block} = {
5868: start => $start,
5869: end => $end,
5870: type => $type,
5871: };
5872: }
5873: }
5874: } else {
5875: foreach my $block (keys(%commblocks)) {
5876: if ($block =~ m/^(\d+)____(\d+)$/) {
5877: my ($start,$end) = ($1,$2);
5878: if ($start <= time && $end >= time) {
5879: if (ref($commblocks{$block}) eq 'HASH') {
5880: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5881: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5882: unless(grep(/^\Q$block\E$/,@blockers)) {
5883: push(@blockers,$block);
5884: }
5885: }
5886: }
5887: }
5888: }
5889: } elsif ($block =~ /^firstaccess____(.+)$/) {
5890: my $item = $1;
5891: my $timersymb = $item;
5892: my $type = 'map';
5893: if ($item eq 'course') {
5894: $type = 'course';
5895: } elsif ($item =~ /___\d+___/) {
5896: $type = 'resource';
5897: } else {
5898: $timersymb = &Apache::lonnet::symbread($item);
5899: }
5900: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5901: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5902: if ($start && $end) {
5903: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5904: if (ref($commblocks{$block}) eq 'HASH') {
5905: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5906: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5907: unless(grep(/^\Q$block\E$/,@blockers)) {
5908: push(@blockers,$block);
5909: $triggered{$block} = {
5910: start => $start,
5911: end => $end,
5912: type => $type,
5913: };
5914: }
5915: }
5916: }
1.1062 raeburn 5917: }
5918: }
1.490 raeburn 5919: }
1.1062 raeburn 5920: }
5921: }
5922: }
5923: foreach my $blocker (@blockers) {
5924: my ($staff_name,$staff_dom,$title,$blocks) =
5925: &parse_block_record($commblocks{$blocker});
5926: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5927: my ($start,$end,$triggertype);
5928: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5929: ($start,$end) = ($1,$2);
5930: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5931: $start = $triggered{$blocker}{'start'};
5932: $end = $triggered{$blocker}{'end'};
5933: $triggertype = $triggered{$blocker}{'type'};
5934: }
5935: if ($start) {
5936: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5937: if ($triggertype) {
5938: push(@{$$setters{$course}{'triggers'}},$triggertype);
5939: } else {
5940: push(@{$$setters{$course}{'triggers'}},0);
5941: }
5942: if ( ($startblock == 0) || ($startblock > $start) ) {
5943: $startblock = $start;
5944: if ($triggertype) {
5945: $triggerblock = $blocker;
1.474 raeburn 5946: }
5947: }
1.1062 raeburn 5948: if ( ($endblock == 0) || ($endblock < $end) ) {
5949: $endblock = $end;
5950: if ($triggertype) {
5951: $triggerblock = $blocker;
5952: }
5953: }
1.474 raeburn 5954: }
5955: }
1.1062 raeburn 5956: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5957: }
5958:
5959: sub parse_block_record {
5960: my ($record) = @_;
5961: my ($setuname,$setudom,$title,$blocks);
5962: if (ref($record) eq 'HASH') {
5963: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5964: $title = &unescape($record->{'event'});
5965: $blocks = $record->{'blocks'};
5966: } else {
5967: my @data = split(/:/,$record,3);
5968: if (scalar(@data) eq 2) {
5969: $title = $data[1];
5970: ($setuname,$setudom) = split(/@/,$data[0]);
5971: } else {
5972: ($setuname,$setudom,$title) = @data;
5973: }
5974: $blocks = { 'com' => 'on' };
5975: }
5976: return ($setuname,$setudom,$title,$blocks);
5977: }
5978:
1.854 kalberla 5979: sub blocking_status {
1.1372 raeburn 5980: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5981: my %setters;
1.890 droeschl 5982:
1.1061 raeburn 5983: # check for active blocking
1.1372 raeburn 5984: if ($clientip eq '') {
5985: $clientip = &Apache::lonnet::get_requestor_ip();
5986: }
5987: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5988: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5989: my $blocked = 0;
1.1372 raeburn 5990: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5991: $blocked = 1;
5992: }
1.890 droeschl 5993:
1.1061 raeburn 5994: # caller just wants to know whether a block is active
5995: if (!wantarray) { return $blocked; }
5996:
5997: # build a link to a popup window containing the details
5998: my $querystring = "?activity=$activity";
1.1351 raeburn 5999: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
6000: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232 raeburn 6001: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
6002: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 6003: } elsif ($activity eq 'docs') {
1.1347 raeburn 6004: my $showurl = &Apache::lonenc::check_encrypt($url);
6005: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
6006: if ($symb) {
6007: my $showsymb = &Apache::lonenc::check_encrypt($symb);
6008: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
6009: }
1.1062 raeburn 6010: }
1.1061 raeburn 6011:
6012: my $output .= <<'END_MYBLOCK';
6013: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
6014: var options = "width=" + w + ",height=" + h + ",";
6015: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
6016: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
6017: var newWin = window.open(url, wdwName, options);
6018: newWin.focus();
6019: }
1.890 droeschl 6020: END_MYBLOCK
1.854 kalberla 6021:
1.1061 raeburn 6022: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 6023:
1.1061 raeburn 6024: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 6025: my $text = &mt('Communication Blocked');
1.1217 raeburn 6026: my $class = 'LC_comblock';
1.1062 raeburn 6027: if ($activity eq 'docs') {
6028: $text = &mt('Content Access Blocked');
1.1217 raeburn 6029: $class = '';
1.1063 raeburn 6030: } elsif ($activity eq 'printout') {
6031: $text = &mt('Printing Blocked');
1.1232 raeburn 6032: } elsif ($activity eq 'passwd') {
6033: $text = &mt('Password Changing Blocked');
1.1345 raeburn 6034: } elsif ($activity eq 'grades') {
6035: $text = &mt('Gradebook Blocked');
1.1346 raeburn 6036: } elsif ($activity eq 'search') {
6037: $text = &mt('Search Blocked');
1.1282 raeburn 6038: } elsif ($activity eq 'alert') {
6039: $text = &mt('Checking Critical Messages Blocked');
6040: } elsif ($activity eq 'reinit') {
6041: $text = &mt('Checking Course Update Blocked');
1.1351 raeburn 6042: } elsif ($activity eq 'about') {
6043: $text = &mt('Access to User Information Pages Blocked');
1.1373 raeburn 6044: } elsif ($activity eq 'wishlist') {
6045: $text = &mt('Access to Stored Links Blocked');
6046: } elsif ($activity eq 'annotate') {
6047: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 6048: }
1.1061 raeburn 6049: $output .= <<"END_BLOCK";
1.1217 raeburn 6050: <div class='$class'>
1.869 kalberla 6051: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 6052: title='$text'>
6053: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 6054: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 6055: title='$text'>$text</a>
1.867 kalberla 6056: </div>
6057:
6058: END_BLOCK
1.474 raeburn 6059:
1.1061 raeburn 6060: return ($blocked, $output);
1.854 kalberla 6061: }
1.490 raeburn 6062:
1.60 matthew 6063: ###############################################
6064:
1.682 raeburn 6065: sub check_ip_acc {
1.1201 raeburn 6066: my ($acc,$clientip)=@_;
1.682 raeburn 6067: &Apache::lonxml::debug("acc is $acc");
6068: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
6069: return 1;
6070: }
1.1339 raeburn 6071: my ($ip,$allowed);
6072: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
6073: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
6074: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
6075: } else {
1.1350 raeburn 6076: my $remote_ip = &Apache::lonnet::get_requestor_ip();
6077: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339 raeburn 6078: }
1.682 raeburn 6079:
6080: my $name;
1.1219 raeburn 6081: my %access = (
6082: allowfrom => 1,
6083: denyfrom => 0,
6084: );
6085: my @allows;
6086: my @denies;
6087: foreach my $item (split(',',$acc)) {
6088: $item =~ s/^\s*//;
6089: $item =~ s/\s*$//;
6090: my $pattern;
6091: if ($item =~ /^\!(.+)$/) {
6092: push(@denies,$1);
6093: } else {
6094: push(@allows,$item);
6095: }
6096: }
6097: my $numdenies = scalar(@denies);
6098: my $numallows = scalar(@allows);
6099: my $count = 0;
6100: foreach my $pattern (@denies,@allows) {
6101: $count ++;
6102: my $acctype = 'allowfrom';
6103: if ($count <= $numdenies) {
6104: $acctype = 'denyfrom';
6105: }
1.682 raeburn 6106: if ($pattern =~ /\*$/) {
6107: #35.8.*
6108: $pattern=~s/\*//;
1.1219 raeburn 6109: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6110: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
6111: #35.8.3.[34-56]
6112: my $low=$2;
6113: my $high=$3;
6114: $pattern=$1;
6115: if ($ip =~ /^\Q$pattern\E/) {
6116: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 6117: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 6118: }
6119: } elsif ($pattern =~ /^\*/) {
6120: #*.msu.edu
6121: $pattern=~s/\*//;
6122: if (!defined($name)) {
6123: use Socket;
6124: my $netaddr=inet_aton($ip);
6125: ($name)=gethostbyaddr($netaddr,AF_INET);
6126: }
1.1219 raeburn 6127: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 6128: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
6129: #127.0.0.1
1.1219 raeburn 6130: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6131: } else {
6132: #some.name.com
6133: if (!defined($name)) {
6134: use Socket;
6135: my $netaddr=inet_aton($ip);
6136: ($name)=gethostbyaddr($netaddr,AF_INET);
6137: }
1.1219 raeburn 6138: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
6139: }
6140: if ($allowed =~ /^(0|1)$/) { last; }
6141: }
6142: if ($allowed eq '') {
6143: if ($numdenies && !$numallows) {
6144: $allowed = 1;
6145: } else {
6146: $allowed = 0;
1.682 raeburn 6147: }
6148: }
6149: return $allowed;
6150: }
6151:
6152: ###############################################
6153:
1.60 matthew 6154: =pod
6155:
1.112 bowersj2 6156: =head1 Domain Template Functions
6157:
6158: =over 4
6159:
6160: =item * &determinedomain()
1.60 matthew 6161:
6162: Inputs: $domain (usually will be undef)
6163:
1.63 www 6164: Returns: Determines which domain should be used for designs
1.60 matthew 6165:
6166: =cut
1.54 www 6167:
1.60 matthew 6168: ###############################################
1.63 www 6169: sub determinedomain {
6170: my $domain=shift;
1.531 albertel 6171: if (! $domain) {
1.60 matthew 6172: # Determine domain if we have not been given one
1.893 raeburn 6173: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 6174: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
6175: if ($env{'request.role.domain'}) {
6176: $domain=$env{'request.role.domain'};
1.60 matthew 6177: }
6178: }
1.63 www 6179: return $domain;
6180: }
6181: ###############################################
1.517 raeburn 6182:
1.518 albertel 6183: sub devalidate_domconfig_cache {
6184: my ($udom)=@_;
6185: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
6186: }
6187:
6188: # ---------------------- Get domain configuration for a domain
6189: sub get_domainconf {
6190: my ($udom) = @_;
6191: my $cachetime=1800;
6192: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
6193: if (defined($cached)) { return %{$result}; }
6194:
6195: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 6196: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 6197: my (%designhash,%legacy);
1.518 albertel 6198: if (keys(%domconfig) > 0) {
6199: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 6200: if (keys(%{$domconfig{'login'}})) {
6201: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 6202: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 6203: if (($key eq 'loginvia') || ($key eq 'headtag')) {
6204: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6205: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
6206: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
6207: if ($key eq 'loginvia') {
6208: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
6209: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
6210: $designhash{$udom.'.login.loginvia'} = $server;
6211: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
6212:
6213: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
6214: } else {
6215: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
6216: }
1.948 raeburn 6217: }
1.1208 raeburn 6218: } elsif ($key eq 'headtag') {
6219: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
6220: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 6221: }
1.946 raeburn 6222: }
1.1208 raeburn 6223: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
6224: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
6225: }
1.946 raeburn 6226: }
6227: }
6228: }
1.1366 raeburn 6229: } elsif ($key eq 'saml') {
6230: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6231: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
6232: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
6233: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386 raeburn 6234: foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366 raeburn 6235: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
6236: }
6237: }
6238: }
6239: }
1.946 raeburn 6240: } else {
6241: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
6242: $designhash{$udom.'.login.'.$key.'_'.$img} =
6243: $domconfig{'login'}{$key}{$img};
6244: }
1.699 raeburn 6245: }
6246: } else {
6247: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
6248: }
1.632 raeburn 6249: }
6250: } else {
6251: $legacy{'login'} = 1;
1.518 albertel 6252: }
1.632 raeburn 6253: } else {
6254: $legacy{'login'} = 1;
1.518 albertel 6255: }
6256: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 6257: if (keys(%{$domconfig{'rolecolors'}})) {
6258: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
6259: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
6260: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
6261: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
6262: }
1.518 albertel 6263: }
6264: }
1.632 raeburn 6265: } else {
6266: $legacy{'rolecolors'} = 1;
1.518 albertel 6267: }
1.632 raeburn 6268: } else {
6269: $legacy{'rolecolors'} = 1;
1.518 albertel 6270: }
1.948 raeburn 6271: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
6272: if ($domconfig{'autoenroll'}{'co-owners'}) {
6273: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
6274: }
6275: }
1.632 raeburn 6276: if (keys(%legacy) > 0) {
6277: my %legacyhash = &get_legacy_domconf($udom);
6278: foreach my $item (keys(%legacyhash)) {
6279: if ($item =~ /^\Q$udom\E\.login/) {
6280: if ($legacy{'login'}) {
6281: $designhash{$item} = $legacyhash{$item};
6282: }
6283: } else {
6284: if ($legacy{'rolecolors'}) {
6285: $designhash{$item} = $legacyhash{$item};
6286: }
1.518 albertel 6287: }
6288: }
6289: }
1.632 raeburn 6290: } else {
6291: %designhash = &get_legacy_domconf($udom);
1.518 albertel 6292: }
6293: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
6294: $cachetime);
6295: return %designhash;
6296: }
6297:
1.632 raeburn 6298: sub get_legacy_domconf {
6299: my ($udom) = @_;
6300: my %legacyhash;
6301: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
6302: my $designfile = $designdir.'/'.$udom.'.tab';
6303: if (-e $designfile) {
1.1317 raeburn 6304: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 6305: while (my $line = <$fh>) {
6306: next if ($line =~ /^\#/);
6307: chomp($line);
6308: my ($key,$val)=(split(/\=/,$line));
6309: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
6310: }
6311: close($fh);
6312: }
6313: }
1.1026 raeburn 6314: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 6315: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
6316: }
6317: return %legacyhash;
6318: }
6319:
1.63 www 6320: =pod
6321:
1.112 bowersj2 6322: =item * &domainlogo()
1.63 www 6323:
6324: Inputs: $domain (usually will be undef)
6325:
6326: Returns: A link to a domain logo, if the domain logo exists.
6327: If the domain logo does not exist, a description of the domain.
6328:
6329: =cut
1.112 bowersj2 6330:
1.63 www 6331: ###############################################
6332: sub domainlogo {
1.517 raeburn 6333: my $domain = &determinedomain(shift);
1.518 albertel 6334: my %designhash = &get_domainconf($domain);
1.517 raeburn 6335: # See if there is a logo
6336: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 6337: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 6338: if ($imgsrc =~ m{^/(adm|res)/}) {
6339: if ($imgsrc =~ m{^/res/}) {
6340: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
6341: &Apache::lonnet::repcopy($local_name);
6342: }
6343: $imgsrc = &lonhttpdurl($imgsrc);
1.1374 raeburn 6344: }
6345: my $alttext = $domain;
6346: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
6347: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
6348: }
6349: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 6350: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
6351: return &Apache::lonnet::domain($domain,'description');
1.59 www 6352: } else {
1.60 matthew 6353: return '';
1.59 www 6354: }
6355: }
1.63 www 6356: ##############################################
6357:
6358: =pod
6359:
1.112 bowersj2 6360: =item * &designparm()
1.63 www 6361:
6362: Inputs: $which parameter; $domain (usually will be undef)
6363:
6364: Returns: value of designparamter $which
6365:
6366: =cut
1.112 bowersj2 6367:
1.397 albertel 6368:
1.400 albertel 6369: ##############################################
1.397 albertel 6370: sub designparm {
6371: my ($which,$domain)=@_;
6372: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 6373: return $env{'environment.color.'.$which};
1.96 www 6374: }
1.63 www 6375: $domain=&determinedomain($domain);
1.1016 raeburn 6376: my %domdesign;
6377: unless ($domain eq 'public') {
6378: %domdesign = &get_domainconf($domain);
6379: }
1.520 raeburn 6380: my $output;
1.517 raeburn 6381: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 6382: $output = $domdesign{$domain.'.'.$which};
1.63 www 6383: } else {
1.520 raeburn 6384: $output = $defaultdesign{$which};
6385: }
6386: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 6387: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 6388: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 6389: if ($output =~ m{^/res/}) {
6390: my $local_name = &Apache::lonnet::filelocation('',$output);
6391: &Apache::lonnet::repcopy($local_name);
6392: }
1.520 raeburn 6393: $output = &lonhttpdurl($output);
6394: }
1.63 www 6395: }
1.520 raeburn 6396: return $output;
1.63 www 6397: }
1.59 www 6398:
1.822 bisitz 6399: ##############################################
6400: =pod
6401:
1.832 bisitz 6402: =item * &authorspace()
6403:
1.1028 raeburn 6404: Inputs: $url (usually will be undef).
1.832 bisitz 6405:
1.1132 raeburn 6406: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 6407: directory being viewed (or for which action is being taken).
6408: If $url is provided, and begins /priv/<domain>/<uname>
6409: the path will be that portion of the $context argument.
6410: Otherwise the path will be for the author space of the current
6411: user when the current role is author, or for that of the
6412: co-author/assistant co-author space when the current role
6413: is co-author or assistant co-author.
1.832 bisitz 6414:
6415: =cut
6416:
6417: sub authorspace {
1.1028 raeburn 6418: my ($url) = @_;
6419: if ($url ne '') {
6420: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
6421: return $1;
6422: }
6423: }
1.832 bisitz 6424: my $caname = '';
1.1024 www 6425: my $cadom = '';
1.1028 raeburn 6426: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 6427: ($cadom,$caname) =
1.832 bisitz 6428: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 6429: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 6430: $caname = $env{'user.name'};
1.1024 www 6431: $cadom = $env{'user.domain'};
1.832 bisitz 6432: }
1.1028 raeburn 6433: if (($caname ne '') && ($cadom ne '')) {
6434: return "/priv/$cadom/$caname/";
6435: }
6436: return;
1.832 bisitz 6437: }
6438:
6439: ##############################################
6440: =pod
6441:
1.822 bisitz 6442: =item * &head_subbox()
6443:
6444: Inputs: $content (contains HTML code with page functions, etc.)
6445:
6446: Returns: HTML div with $content
6447: To be included in page header
6448:
6449: =cut
6450:
6451: sub head_subbox {
6452: my ($content)=@_;
6453: my $output =
1.993 raeburn 6454: '<div class="LC_head_subbox">'
1.822 bisitz 6455: .$content
6456: .'</div>'
6457: }
6458:
6459: ##############################################
6460: =pod
6461:
6462: =item * &CSTR_pageheader()
6463:
1.1026 raeburn 6464: Input: (optional) filename from which breadcrumb trail is built.
6465: In most cases no input as needed, as $env{'request.filename'}
6466: is appropriate for use in building the breadcrumb trail.
1.1379 raeburn 6467: frameset flag
6468: If page header is being requested for use in a frameset, then
6469: the second (option) argument -- frameset will be true, and
6470: the target attribute set for links should be target="_parent".
1.1407 raeburn 6471: If $title is supplied as the thitd arg, that will be used to
6472: the left of the breadcrumbs tail for the current path.
1.822 bisitz 6473:
6474: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6475: To be included on Authoring Space pages
1.822 bisitz 6476:
6477: =cut
6478:
6479: sub CSTR_pageheader {
1.1407 raeburn 6480: my ($trailfile,$frameset,$title) = @_;
1.1026 raeburn 6481: if ($trailfile eq '') {
6482: $trailfile = $env{'request.filename'};
6483: }
6484:
6485: # this is for resources; directories have customtitle, and crumbs
6486: # and select recent are created in lonpubdir.pm
6487:
6488: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6489: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6490: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6491: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6492: $formaction =~ s{/+}{/}g;
1.822 bisitz 6493:
6494: my $parentpath = '';
6495: my $lastitem = '';
6496: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6497: $parentpath = $1;
6498: $lastitem = $2;
6499: } else {
6500: $lastitem = $thisdisfn;
6501: }
1.921 bisitz 6502:
1.1406 raeburn 6503: my $crsauthor;
1.1246 raeburn 6504: if (($env{'request.course.id'}) &&
6505: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6506: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6507: $crsauthor = 1;
1.1406 raeburn 6508: if ($title eq '') {
6509: $title = &mt('Course Authoring Space');
6510: }
6511: } elsif ($title eq '') {
1.1246 raeburn 6512: $title = &mt('Authoring Space');
6513: }
6514:
1.1379 raeburn 6515: my ($target,$crumbtarget) = (' target="_top"','_top');
6516: if ($frameset) {
6517: $target = ' target="_parent"';
6518: $crumbtarget = '_parent';
6519: } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6520: $target = '';
6521: $crumbtarget = '';
1.1379 raeburn 6522: } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378 raeburn 6523: $target = ' target="'.$env{'request.deeplink.target'}.'"';
6524: $crumbtarget = $env{'request.deeplink.target'};
6525: }
1.1313 raeburn 6526:
1.921 bisitz 6527: my $output =
1.1407 raeburn 6528: '<div>'
1.822 bisitz 6529: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6530: .'<b>'.$title.'</b> '
1.1314 raeburn 6531: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6532: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6533:
6534: if ($lastitem) {
6535: $output .=
6536: '<span class="LC_filename">'
6537: .$lastitem
6538: .'</span>';
6539: }
1.1245 raeburn 6540:
1.1246 raeburn 6541: if ($crsauthor) {
1.1379 raeburn 6542: $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6543: } else {
6544: $output .=
6545: '<br />'
1.1314 raeburn 6546: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6547: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6548: .'</form>'
1.1379 raeburn 6549: .&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6550: }
1.1407 raeburn 6551: $output .= '</div>';
1.921 bisitz 6552:
6553: return $output;
1.822 bisitz 6554: }
6555:
1.1419 raeburn 6556: ##############################################
6557: =pod
6558:
6559: =item * &nocodemirror()
6560:
6561: Input: None
6562:
6563: Returns: 1 if CodeMirror is deactivated based on
6564: user's preference, or domain default,
6565: if user indicated use of default.
6566:
6567: =cut
6568:
1.1416 raeburn 6569: sub nocodemirror {
6570: my $nocodem = $env{'environment.nocodemirror'};
6571: unless ($nocodem) {
6572: my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
6573: if ($domdefs{'nocodemirror'}) {
6574: $nocodem = 'yes';
6575: }
6576: }
1.1417 raeburn 6577: if ($nocodem eq 'yes') {
6578: return 1;
6579: }
6580: return;
1.1416 raeburn 6581: }
6582:
1.1419 raeburn 6583: ##############################################
6584: =pod
6585:
6586: =item * &permitted_editors()
6587:
6588: Input: None
6589:
6590: Returns: %editors hash in which keys are editors
6591: permitted in current Authoring Space.
6592: Value for each key is 1. Possible keys
6593: are: edit, xml, and daxe. If no specific
6594: set of editors has been set for the Author
6595: who owns the Authoring Space, then the
6596: domain default will be used. If no domain
6597: default has been set, then the keys will be
6598: edit and xml.
6599:
6600: =cut
6601:
1.1418 raeburn 6602: sub permitted_editors {
6603: my ($is_author,$is_coauthor,$auname,$audom,%editors);
6604: if ($env{'request.role'} =~ m{^au\./}) {
6605: $is_author = 1;
6606: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
6607: ($audom,$auname) = ($1,$2);
6608: if (($audom ne '') && ($auname ne '')) {
6609: if (($env{'user.domain'} eq $audom) &&
6610: ($env{'user.name'} eq $auname)) {
6611: $is_author = 1;
6612: } else {
6613: $is_coauthor = 1;
6614: }
6615: }
6616: } elsif ($env{'request.course.id'}) {
6617: if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6618: ($audom,$auname) = ($1,$2);
6619: } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6620: ($audom,$auname) = ($1,$2);
6621: }
6622: if (($audom ne '') && ($auname ne '')) {
6623: if (($env{'user.domain'} eq $audom) &&
6624: ($env{'user.name'} eq $auname)) {
6625: $is_author = 1;
6626: } else {
6627: $is_coauthor = 1;
6628: }
6629: }
6630: }
6631: if ($is_author) {
6632: if (exists($env{'environment.editors'})) {
6633: map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
6634: } else {
6635: %editors = ( edit => 1,
6636: xml => 1,
6637: );
6638: }
6639: } elsif ($is_coauthor) {
6640: if (exists($env{"environment.internal.editors./$audom/$auname"})) {
6641: map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
6642: } else {
6643: %editors = ( edit => 1,
6644: xml => 1,
6645: );
6646: }
6647: } else {
6648: %editors = ( edit => 1,
6649: xml => 1,
6650: );
6651: }
6652: return %editors;
6653: }
6654:
1.60 matthew 6655: ###############################################
6656: ###############################################
6657:
6658: =pod
6659:
1.112 bowersj2 6660: =back
6661:
1.549 albertel 6662: =head1 HTML Helpers
1.112 bowersj2 6663:
6664: =over 4
6665:
6666: =item * &bodytag()
1.60 matthew 6667:
6668: Returns a uniform header for LON-CAPA web pages.
6669:
6670: Inputs:
6671:
1.112 bowersj2 6672: =over 4
6673:
6674: =item * $title, A title to be displayed on the page.
6675:
6676: =item * $function, the current role (can be undef).
6677:
6678: =item * $addentries, extra parameters for the <body> tag.
6679:
6680: =item * $bodyonly, if defined, only return the <body> tag.
6681:
6682: =item * $domain, if defined, force a given domain.
6683:
6684: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6685: text interface only)
1.60 matthew 6686:
1.814 bisitz 6687: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6688: navigational links
1.317 albertel 6689:
1.338 albertel 6690: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6691:
1.460 albertel 6692: =item * $args, optional argument valid values are
6693: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6694: use_absolute -> for external resource or syllabus, this will
6695: contain https://<hostname> if server uses
6696: https (as per hosts.tab), but request is for http
6697: hostname -> hostname, from $r->hostname().
1.460 albertel 6698:
1.1096 raeburn 6699: =item * $advtoolsref, optional argument, ref to an array containing
6700: inlineremote items to be added in "Functions" menu below
6701: breadcrumbs.
6702:
1.1316 raeburn 6703: =item * $ltiscope, optional argument, will be one of: resource, map or
6704: course, if LON-CAPA is in LTI Provider context. Value is
6705: the scope of use, i.e., launch was for access to a single, a map
6706: or the entire course.
6707:
6708: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6709: context, this will contain the URL for the landing item in
6710: the course, after launch from an LTI Consumer
6711:
1.1318 raeburn 6712: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6713: context, this will contain a reference to hash of items
6714: to be included in the page header and/or inline menu.
6715:
1.1385 raeburn 6716: =item * $menucoll, optional argument, if specific menu collection is in
6717: effect, either set as the default for the course, or set for
6718: the deeplink paramater for $env{'request.deeplink.login'}
6719: then $menucoll will be the number of that collection.
6720:
6721: =item * $menuref, optional argument, reference to a hash, containing the
6722: menu options included for the menu in effect, based on the
6723: configuration for the numbered menu collection in use.
6724:
6725: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
6726: within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
6727: if so, $showncrumbsref is set there to 1, and will propagate back
6728: via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
6729: being called a second time.
6730:
1.112 bowersj2 6731: =back
6732:
1.60 matthew 6733: Returns: A uniform header for LON-CAPA web pages.
6734: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6735: If $bodyonly is undef or zero, an html string containing a <body> tag and
6736: other decorations will be returned.
6737:
6738: =cut
6739:
1.54 www 6740: sub bodytag {
1.831 bisitz 6741: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6742: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385 raeburn 6743: $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339 albertel 6744:
1.954 raeburn 6745: my $public;
6746: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6747: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6748: $public = 1;
6749: }
1.460 albertel 6750: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6751: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6752: my $hostname = $args->{'hostname'};
1.339 albertel 6753:
1.183 matthew 6754: $function = &get_users_function() if (!$function);
1.339 albertel 6755: my $img = &designparm($function.'.img',$domain);
6756: my $font = &designparm($function.'.font',$domain);
6757: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6758:
1.803 bisitz 6759: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6760: 'bgcolor' => $pgbg,
1.339 albertel 6761: 'text' => $font,
6762: 'alink' => &designparm($function.'.alink',$domain),
6763: 'vlink' => &designparm($function.'.vlink',$domain),
6764: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6765: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6766:
1.63 www 6767: # role and realm
1.1178 raeburn 6768: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6769: if ($realm) {
6770: $realm = '/'.$realm;
6771: }
1.1357 raeburn 6772: if ($role eq 'ca') {
1.479 albertel 6773: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6774: $realm = &plainname($rname,$rdom);
1.378 raeburn 6775: }
1.55 www 6776: # realm
1.1357 raeburn 6777: my ($cid,$sec);
1.258 albertel 6778: if ($env{'request.course.id'}) {
1.1357 raeburn 6779: $cid = $env{'request.course.id'};
6780: if ($env{'request.course.sec'}) {
6781: $sec = $env{'request.course.sec'};
6782: }
6783: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6784: if (&Apache::lonnet::is_course($1,$2)) {
6785: $cid = $1.'_'.$2;
6786: $sec = $3;
6787: }
6788: }
6789: if ($cid) {
1.378 raeburn 6790: if ($env{'request.role'} !~ /^cr/) {
6791: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6792: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6793: if ($env{'request.role.desc'}) {
6794: $role = $env{'request.role.desc'};
6795: } else {
6796: $role = &mt('Helpdesk[_1]',' '.$2);
6797: }
1.1257 raeburn 6798: } else {
6799: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6800: }
1.1357 raeburn 6801: if ($sec) {
6802: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6803: }
1.1357 raeburn 6804: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6805: } else {
6806: $role = &Apache::lonnet::plaintext($role);
1.54 www 6807: }
1.433 albertel 6808:
1.359 albertel 6809: if (!$realm) { $realm=' '; }
1.330 albertel 6810:
1.438 albertel 6811: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6812:
1.101 www 6813: # construct main body tag
1.359 albertel 6814: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6815: &Apache::lontexconvert::init_math_support();
1.252 albertel 6816:
1.1131 raeburn 6817: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6818:
1.1130 raeburn 6819: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6820: return $bodytag;
1.1130 raeburn 6821: }
1.359 albertel 6822:
1.954 raeburn 6823: if ($public) {
1.433 albertel 6824: undef($role);
6825: }
1.1318 raeburn 6826:
1.1359 raeburn 6827: my $showcrstitle = 1;
1.1357 raeburn 6828: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6829: if (ref($ltimenu) eq 'HASH') {
6830: unless ($ltimenu->{'role'}) {
6831: undef($role);
6832: }
6833: unless ($ltimenu->{'coursetitle'}) {
6834: $realm=' ';
1.1359 raeburn 6835: $showcrstitle = 0;
6836: }
6837: }
6838: } elsif (($cid) && ($menucoll)) {
6839: if (ref($menuref) eq 'HASH') {
6840: unless ($menuref->{'role'}) {
6841: undef($role);
6842: }
6843: unless ($menuref->{'crs'}) {
6844: $realm=' ';
6845: $showcrstitle = 0;
1.1318 raeburn 6846: }
6847: }
6848: }
6849:
1.762 bisitz 6850: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6851: #
6852: # Extra info if you are the DC
6853: my $dc_info = '';
1.1359 raeburn 6854: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6855: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6856: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6857: $dc_info =~ s/\s+$//;
1.359 albertel 6858: }
6859:
1.1237 raeburn 6860: my $crstype;
1.1357 raeburn 6861: if ($cid) {
6862: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 6863: } elsif ($args->{'crstype'}) {
6864: $crstype = $args->{'crstype'};
6865: }
6866: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6867: undef($role);
6868: } else {
1.1242 raeburn 6869: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6870: }
1.853 droeschl 6871:
1.903 droeschl 6872: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6873:
6874: # if ($env{'request.state'} eq 'construct') {
6875: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6876: # }
6877:
1.1130 raeburn 6878: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6879: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6880:
1.1318 raeburn 6881: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 6882: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380 raeburn 6883: $args->{'links_disabled'},
6884: $args->{'links_target'});
1.359 albertel 6885:
1.1318 raeburn 6886: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6887: if ($dc_info) {
6888: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6889: }
6890: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6891: <em>$realm</em> $dc_info</div>|;
6892: return $bodytag;
6893: }
1.894 droeschl 6894:
1.1318 raeburn 6895: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6896: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6897: }
1.916 droeschl 6898:
1.1318 raeburn 6899: $bodytag .= $right;
1.852 droeschl 6900:
1.1318 raeburn 6901: if ($dc_info) {
6902: $dc_info = &dc_courseid_toggle($dc_info);
6903: }
6904: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6905: }
1.916 droeschl 6906:
1.1169 raeburn 6907: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6908: if ($args->{'no_secondary_menu'}) {
6909: return $bodytag;
6910: }
1.1169 raeburn 6911: #don't show menus for public users
1.954 raeburn 6912: if (!$public){
1.1318 raeburn 6913: unless ($args->{'no_inline_menu'}) {
6914: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 6915: $args->{'no_primary_menu'},
1.1369 raeburn 6916: $menucoll,$menuref,
1.1380 raeburn 6917: $args->{'links_disabled'},
6918: $args->{'links_target'});
1.1318 raeburn 6919: }
1.903 droeschl 6920: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6921: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6922: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6923: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385 raeburn 6924: $args->{'bread_crumbs'},'','',$hostname,
6925: $ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6926: } elsif ($forcereg) {
6927: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385 raeburn 6928: $args->{'group'},$args->{'hide_buttons'},
6929: $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6930: } else {
6931: $bodytag .=
6932: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6933: $forcereg,$args->{'group'},
6934: $args->{'bread_crumbs'},
1.1274 raeburn 6935: $advtoolsref,'',$hostname);
1.920 raeburn 6936: }
1.903 droeschl 6937: }else{
6938: # this is to seperate menu from content when there's no secondary
6939: # menu. Especially needed for public accessible ressources.
6940: $bodytag .= '<hr style="clear:both" />';
6941: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6942: }
1.903 droeschl 6943:
1.235 raeburn 6944: return $bodytag;
1.182 matthew 6945: }
6946:
1.917 raeburn 6947: sub dc_courseid_toggle {
6948: my ($dc_info) = @_;
1.980 raeburn 6949: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6950: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6951: &mt('(More ...)').'</a></span>'.
6952: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6953: }
6954:
1.330 albertel 6955: sub make_attr_string {
6956: my ($register,$attr_ref) = @_;
6957:
6958: if ($attr_ref && !ref($attr_ref)) {
6959: die("addentries Must be a hash ref ".
6960: join(':',caller(1))." ".
6961: join(':',caller(0))." ");
6962: }
6963:
6964: if ($register) {
1.339 albertel 6965: my ($on_load,$on_unload);
6966: foreach my $key (keys(%{$attr_ref})) {
6967: if (lc($key) eq 'onload') {
6968: $on_load.=$attr_ref->{$key}.';';
6969: delete($attr_ref->{$key});
6970:
6971: } elsif (lc($key) eq 'onunload') {
6972: $on_unload.=$attr_ref->{$key}.';';
6973: delete($attr_ref->{$key});
6974: }
6975: }
1.953 droeschl 6976: $attr_ref->{'onload'} = $on_load;
6977: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6978: }
1.339 albertel 6979:
1.330 albertel 6980: my $attr_string;
1.1159 raeburn 6981: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6982: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6983: }
6984: return $attr_string;
6985: }
6986:
6987:
1.182 matthew 6988: ###############################################
1.251 albertel 6989: ###############################################
6990:
6991: =pod
6992:
6993: =item * &endbodytag()
6994:
6995: Returns a uniform footer for LON-CAPA web pages.
6996:
1.635 raeburn 6997: Inputs: 1 - optional reference to an args hash
6998: If in the hash, key for noredirectlink has a value which evaluates to true,
6999: a 'Continue' link is not displayed if the page contains an
7000: internal redirect in the <head></head> section,
7001: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 7002:
7003: =cut
7004:
7005: sub endbodytag {
1.635 raeburn 7006: my ($args) = @_;
1.1080 raeburn 7007: my $endbodytag;
7008: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
7009: $endbodytag='</body>';
7010: }
1.315 albertel 7011: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 7012: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386 raeburn 7013: my ($endbodyjs,$idattr);
7014: if ($env{'internal.head.to_opener'}) {
7015: my $linkid = 'LC_continue_link';
7016: $idattr = ' id="'.$linkid.'"';
7017: my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
7018: $endbodyjs=<<ENDJS;
7019: <script type="text/javascript">
7020: // <![CDATA[
7021: function ebFunction(evt) {
7022: evt.preventDefault();
7023: var dest = '$redirect_for_js';
7024: if (window.opener != null && !window.opener.closed) {
7025: window.opener.location.href=dest;
7026: window.close();
7027: } else {
7028: window.location.href=dest;
7029: }
7030: return false;
7031: }
7032:
7033: \$(document).ready(function () {
7034: if (document.getElementById('$linkid')) {
7035: var clickelem = document.getElementById('$linkid');
7036: clickelem.addEventListener('click',ebFunction,false);
7037: }
7038: });
7039: // ]]>
7040: </script>
7041: ENDJS
7042: }
1.635 raeburn 7043: $endbodytag=
1.1386 raeburn 7044: "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635 raeburn 7045: &mt('Continue').'</a>'.
7046: $endbodytag;
7047: }
1.315 albertel 7048: }
1.1411 raeburn 7049: if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
7050: $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
7051: }
1.251 albertel 7052: return $endbodytag;
7053: }
7054:
1.352 albertel 7055: =pod
7056:
7057: =item * &standard_css()
7058:
7059: Returns a style sheet
7060:
7061: Inputs: (all optional)
7062: domain -> force to color decorate a page for a specific
7063: domain
7064: function -> force usage of a specific rolish color scheme
7065: bgcolor -> override the default page bgcolor
7066:
7067: =cut
7068:
1.343 albertel 7069: sub standard_css {
1.345 albertel 7070: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 7071: $function = &get_users_function() if (!$function);
7072: my $img = &designparm($function.'.img', $domain);
7073: my $tabbg = &designparm($function.'.tabbg', $domain);
7074: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 7075: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 7076: #second colour for later usage
1.345 albertel 7077: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 7078: my $pgbg_or_bgcolor =
7079: $bgcolor ||
1.352 albertel 7080: &designparm($function.'.pgbg', $domain);
1.382 albertel 7081: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 7082: my $alink = &designparm($function.'.alink', $domain);
7083: my $vlink = &designparm($function.'.vlink', $domain);
7084: my $link = &designparm($function.'.link', $domain);
7085:
1.602 albertel 7086: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 7087: my $mono = 'monospace';
1.850 bisitz 7088: my $data_table_head = $sidebg;
7089: my $data_table_light = '#FAFAFA';
1.1060 bisitz 7090: my $data_table_dark = '#E0E0E0';
1.470 banghart 7091: my $data_table_darker = '#CCCCCC';
1.349 albertel 7092: my $data_table_highlight = '#FFFF00';
1.352 albertel 7093: my $mail_new = '#FFBB77';
7094: my $mail_new_hover = '#DD9955';
7095: my $mail_read = '#BBBB77';
7096: my $mail_read_hover = '#999944';
7097: my $mail_replied = '#AAAA88';
7098: my $mail_replied_hover = '#888855';
7099: my $mail_other = '#99BBBB';
7100: my $mail_other_hover = '#669999';
1.391 albertel 7101: my $table_header = '#DDDDDD';
1.489 raeburn 7102: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 7103: my $lg_border_color = '#C8C8C8';
1.952 onken 7104: my $button_hover = '#BF2317';
1.392 albertel 7105:
1.608 albertel 7106: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 7107: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
7108: : '0 3px 0 4px';
1.448 albertel 7109:
1.523 albertel 7110:
1.343 albertel 7111: return <<END;
1.947 droeschl 7112:
7113: /* needed for iframe to allow 100% height in FF */
7114: body, html {
7115: margin: 0;
7116: padding: 0 0.5%;
7117: height: 99%; /* to avoid scrollbars */
7118: }
7119:
1.795 www 7120: body {
1.911 bisitz 7121: font-family: $sans;
7122: line-height:130%;
7123: font-size:0.83em;
7124: color:$font;
1.795 www 7125: }
7126:
1.959 onken 7127: a:focus,
7128: a:focus img {
1.795 www 7129: color: red;
7130: }
1.698 harmsja 7131:
1.911 bisitz 7132: form, .inline {
7133: display: inline;
1.795 www 7134: }
1.721 harmsja 7135:
1.795 www 7136: .LC_right {
1.911 bisitz 7137: text-align:right;
1.795 www 7138: }
7139:
7140: .LC_middle {
1.911 bisitz 7141: vertical-align:middle;
1.795 www 7142: }
1.721 harmsja 7143:
1.1130 raeburn 7144: .LC_floatleft {
7145: float: left;
7146: }
7147:
7148: .LC_floatright {
7149: float: right;
7150: }
7151:
1.911 bisitz 7152: .LC_400Box {
7153: width:400px;
7154: }
1.721 harmsja 7155:
1.947 droeschl 7156: .LC_iframecontainer {
7157: width: 98%;
7158: margin: 0;
7159: position: fixed;
7160: top: 8.5em;
7161: bottom: 0;
7162: }
7163:
7164: .LC_iframecontainer iframe{
7165: border: none;
7166: width: 100%;
7167: height: 100%;
7168: }
7169:
1.778 bisitz 7170: .LC_filename {
7171: font-family: $mono;
7172: white-space:pre;
1.921 bisitz 7173: font-size: 120%;
1.778 bisitz 7174: }
7175:
7176: .LC_fileicon {
7177: border: none;
7178: height: 1.3em;
7179: vertical-align: text-bottom;
7180: margin-right: 0.3em;
7181: text-decoration:none;
7182: }
7183:
1.1008 www 7184: .LC_setting {
7185: text-decoration:underline;
7186: }
7187:
1.350 albertel 7188: .LC_error {
7189: color: red;
7190: }
1.795 www 7191:
1.1097 bisitz 7192: .LC_warning {
7193: color: darkorange;
7194: }
7195:
1.457 albertel 7196: .LC_diff_removed {
1.733 bisitz 7197: color: red;
1.394 albertel 7198: }
1.532 albertel 7199:
7200: .LC_info,
1.457 albertel 7201: .LC_success,
7202: .LC_diff_added {
1.350 albertel 7203: color: green;
7204: }
1.795 www 7205:
1.802 bisitz 7206: div.LC_confirm_box {
7207: background-color: #FAFAFA;
7208: border: 1px solid $lg_border_color;
7209: margin-right: 0;
7210: padding: 5px;
7211: }
7212:
7213: div.LC_confirm_box .LC_error img,
7214: div.LC_confirm_box .LC_success img {
7215: vertical-align: middle;
7216: }
7217:
1.1242 raeburn 7218: .LC_maxwidth {
7219: max-width: 100%;
7220: height: auto;
7221: }
7222:
1.1243 raeburn 7223: .LC_textsize_mobile {
7224: \@media only screen and (max-device-width: 480px) {
7225: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
7226: }
7227: }
7228:
1.440 albertel 7229: .LC_icon {
1.771 droeschl 7230: border: none;
1.790 droeschl 7231: vertical-align: middle;
1.771 droeschl 7232: }
7233:
1.543 albertel 7234: .LC_docs_spacer {
7235: width: 25px;
7236: height: 1px;
1.771 droeschl 7237: border: none;
1.543 albertel 7238: }
1.346 albertel 7239:
1.532 albertel 7240: .LC_internal_info {
1.735 bisitz 7241: color: #999999;
1.532 albertel 7242: }
7243:
1.794 www 7244: .LC_discussion {
1.1050 www 7245: background: $data_table_dark;
1.911 bisitz 7246: border: 1px solid black;
7247: margin: 2px;
1.794 www 7248: }
7249:
7250: .LC_disc_action_left {
1.1050 www 7251: background: $sidebg;
1.911 bisitz 7252: text-align: left;
1.1050 www 7253: padding: 4px;
7254: margin: 2px;
1.794 www 7255: }
7256:
7257: .LC_disc_action_right {
1.1050 www 7258: background: $sidebg;
1.911 bisitz 7259: text-align: right;
1.1050 www 7260: padding: 4px;
7261: margin: 2px;
1.794 www 7262: }
7263:
7264: .LC_disc_new_item {
1.911 bisitz 7265: background: white;
7266: border: 2px solid red;
1.1050 www 7267: margin: 4px;
7268: padding: 4px;
1.794 www 7269: }
7270:
7271: .LC_disc_old_item {
1.911 bisitz 7272: background: white;
1.1050 www 7273: margin: 4px;
7274: padding: 4px;
1.794 www 7275: }
7276:
1.458 albertel 7277: table.LC_pastsubmission {
7278: border: 1px solid black;
7279: margin: 2px;
7280: }
7281:
1.924 bisitz 7282: table#LC_menubuttons {
1.345 albertel 7283: width: 100%;
7284: background: $pgbg;
1.392 albertel 7285: border: 2px;
1.402 albertel 7286: border-collapse: separate;
1.803 bisitz 7287: padding: 0;
1.345 albertel 7288: }
1.392 albertel 7289:
1.801 tempelho 7290: table#LC_title_bar a {
7291: color: $fontmenu;
7292: }
1.836 bisitz 7293:
1.807 droeschl 7294: table#LC_title_bar {
1.819 tempelho 7295: clear: both;
1.836 bisitz 7296: display: none;
1.807 droeschl 7297: }
7298:
1.795 www 7299: table#LC_title_bar,
1.933 droeschl 7300: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 7301: table#LC_title_bar.LC_with_remote {
1.359 albertel 7302: width: 100%;
1.392 albertel 7303: border-color: $pgbg;
7304: border-style: solid;
7305: border-width: $border;
1.379 albertel 7306: background: $pgbg;
1.801 tempelho 7307: color: $fontmenu;
1.392 albertel 7308: border-collapse: collapse;
1.803 bisitz 7309: padding: 0;
1.819 tempelho 7310: margin: 0;
1.359 albertel 7311: }
1.795 www 7312:
1.933 droeschl 7313: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 7314: margin: 0;
7315: padding: 0;
1.933 droeschl 7316: position: relative;
7317: list-style: none;
1.913 droeschl 7318: }
1.933 droeschl 7319: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 7320: display: inline;
7321: }
1.933 droeschl 7322:
7323: .LC_breadcrumb_tools_navigation {
1.913 droeschl 7324: padding: 0;
1.933 droeschl 7325: margin: 0;
7326: float: left;
1.913 droeschl 7327: }
1.933 droeschl 7328: .LC_breadcrumb_tools_tools {
7329: padding: 0;
7330: margin: 0;
1.913 droeschl 7331: float: right;
7332: }
7333:
1.1240 raeburn 7334: .LC_placement_prog {
7335: padding-right: 20px;
7336: font-weight: bold;
7337: font-size: 90%;
7338: }
7339:
1.359 albertel 7340: table#LC_title_bar td {
7341: background: $tabbg;
7342: }
1.795 www 7343:
1.911 bisitz 7344: table#LC_menubuttons img {
1.803 bisitz 7345: border: none;
1.346 albertel 7346: }
1.795 www 7347:
1.842 droeschl 7348: .LC_breadcrumbs_component {
1.911 bisitz 7349: float: right;
7350: margin: 0 1em;
1.357 albertel 7351: }
1.842 droeschl 7352: .LC_breadcrumbs_component img {
1.911 bisitz 7353: vertical-align: middle;
1.777 tempelho 7354: }
1.795 www 7355:
1.1243 raeburn 7356: .LC_breadcrumbs_hoverable {
7357: background: $sidebg;
7358: }
7359:
1.383 albertel 7360: td.LC_table_cell_checkbox {
7361: text-align: center;
7362: }
1.795 www 7363:
7364: .LC_fontsize_small {
1.911 bisitz 7365: font-size: 70%;
1.705 tempelho 7366: }
7367:
1.844 bisitz 7368: #LC_breadcrumbs {
1.911 bisitz 7369: clear:both;
7370: background: $sidebg;
7371: border-bottom: 1px solid $lg_border_color;
7372: line-height: 2.5em;
1.933 droeschl 7373: overflow: hidden;
1.911 bisitz 7374: margin: 0;
7375: padding: 0;
1.995 raeburn 7376: text-align: left;
1.819 tempelho 7377: }
1.862 bisitz 7378:
1.1098 bisitz 7379: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 7380: clear:both;
7381: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 7382: border: 1px solid $sidebg;
1.1098 bisitz 7383: margin: 0 0 10px 0;
1.966 bisitz 7384: padding: 3px;
1.995 raeburn 7385: text-align: left;
1.822 bisitz 7386: }
7387:
1.795 www 7388: .LC_fontsize_medium {
1.911 bisitz 7389: font-size: 85%;
1.705 tempelho 7390: }
7391:
1.795 www 7392: .LC_fontsize_large {
1.911 bisitz 7393: font-size: 120%;
1.705 tempelho 7394: }
7395:
1.346 albertel 7396: .LC_menubuttons_inline_text {
7397: color: $font;
1.698 harmsja 7398: font-size: 90%;
1.701 harmsja 7399: padding-left:3px;
1.346 albertel 7400: }
7401:
1.934 droeschl 7402: .LC_menubuttons_inline_text img{
7403: vertical-align: middle;
7404: }
7405:
1.1051 www 7406: li.LC_menubuttons_inline_text img {
1.951 onken 7407: cursor:pointer;
1.1002 droeschl 7408: text-decoration: none;
1.951 onken 7409: }
7410:
1.526 www 7411: .LC_menubuttons_link {
7412: text-decoration: none;
7413: }
1.795 www 7414:
1.522 albertel 7415: .LC_menubuttons_category {
1.521 www 7416: color: $font;
1.526 www 7417: background: $pgbg;
1.521 www 7418: font-size: larger;
7419: font-weight: bold;
7420: }
7421:
1.346 albertel 7422: td.LC_menubuttons_text {
1.911 bisitz 7423: color: $font;
1.346 albertel 7424: }
1.706 harmsja 7425:
1.346 albertel 7426: .LC_current_location {
7427: background: $tabbg;
7428: }
1.795 www 7429:
1.1286 raeburn 7430: td.LC_zero_height {
7431: line-height: 0;
7432: cellpadding: 0;
7433: }
7434:
1.938 bisitz 7435: table.LC_data_table {
1.347 albertel 7436: border: 1px solid #000000;
1.402 albertel 7437: border-collapse: separate;
1.426 albertel 7438: border-spacing: 1px;
1.610 albertel 7439: background: $pgbg;
1.347 albertel 7440: }
1.795 www 7441:
1.422 albertel 7442: .LC_data_table_dense {
7443: font-size: small;
7444: }
1.795 www 7445:
1.507 raeburn 7446: table.LC_nested_outer {
7447: border: 1px solid #000000;
1.589 raeburn 7448: border-collapse: collapse;
1.803 bisitz 7449: border-spacing: 0;
1.507 raeburn 7450: width: 100%;
7451: }
1.795 www 7452:
1.879 raeburn 7453: table.LC_innerpickbox,
1.507 raeburn 7454: table.LC_nested {
1.803 bisitz 7455: border: none;
1.589 raeburn 7456: border-collapse: collapse;
1.803 bisitz 7457: border-spacing: 0;
1.507 raeburn 7458: width: 100%;
7459: }
1.795 www 7460:
1.911 bisitz 7461: table.LC_data_table tr th,
7462: table.LC_calendar tr th,
1.879 raeburn 7463: table.LC_prior_tries tr th,
7464: table.LC_innerpickbox tr th {
1.349 albertel 7465: font-weight: bold;
7466: background-color: $data_table_head;
1.801 tempelho 7467: color:$fontmenu;
1.701 harmsja 7468: font-size:90%;
1.347 albertel 7469: }
1.795 www 7470:
1.879 raeburn 7471: table.LC_innerpickbox tr th,
7472: table.LC_innerpickbox tr td {
7473: vertical-align: top;
7474: }
7475:
1.711 raeburn 7476: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7477: background-color: #CCCCCC;
1.711 raeburn 7478: font-weight: bold;
7479: text-align: left;
7480: }
1.795 www 7481:
1.912 bisitz 7482: table.LC_data_table tr.LC_odd_row > td {
7483: background-color: $data_table_light;
7484: padding: 2px;
7485: vertical-align: top;
7486: }
7487:
1.809 bisitz 7488: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7489: background-color: $data_table_light;
1.912 bisitz 7490: vertical-align: top;
7491: }
7492:
7493: table.LC_data_table tr.LC_even_row > td {
7494: background-color: $data_table_dark;
1.425 albertel 7495: padding: 2px;
1.900 bisitz 7496: vertical-align: top;
1.347 albertel 7497: }
1.795 www 7498:
1.809 bisitz 7499: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7500: background-color: $data_table_dark;
1.900 bisitz 7501: vertical-align: top;
1.347 albertel 7502: }
1.795 www 7503:
1.425 albertel 7504: table.LC_data_table tr.LC_data_table_highlight td {
7505: background-color: $data_table_darker;
7506: }
1.795 www 7507:
1.639 raeburn 7508: table.LC_data_table tr td.LC_leftcol_header {
7509: background-color: $data_table_head;
7510: font-weight: bold;
7511: }
1.795 www 7512:
1.451 albertel 7513: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7514: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7515: font-weight: bold;
7516: font-style: italic;
7517: text-align: center;
7518: padding: 8px;
1.347 albertel 7519: }
1.795 www 7520:
1.1114 raeburn 7521: table.LC_data_table tr.LC_empty_row td,
7522: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7523: background-color: $sidebg;
7524: }
7525:
7526: table.LC_nested tr.LC_empty_row td {
7527: background-color: #FFFFFF;
7528: }
7529:
1.890 droeschl 7530: table.LC_caption {
7531: }
7532:
1.507 raeburn 7533: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7534: padding: 4ex
7535: }
1.795 www 7536:
1.507 raeburn 7537: table.LC_nested_outer tr th {
7538: font-weight: bold;
1.801 tempelho 7539: color:$fontmenu;
1.507 raeburn 7540: background-color: $data_table_head;
1.701 harmsja 7541: font-size: small;
1.507 raeburn 7542: border-bottom: 1px solid #000000;
7543: }
1.795 www 7544:
1.507 raeburn 7545: table.LC_nested_outer tr td.LC_subheader {
7546: background-color: $data_table_head;
7547: font-weight: bold;
7548: font-size: small;
7549: border-bottom: 1px solid #000000;
7550: text-align: right;
1.451 albertel 7551: }
1.795 www 7552:
1.507 raeburn 7553: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7554: background-color: #CCCCCC;
1.451 albertel 7555: font-weight: bold;
7556: font-size: small;
1.507 raeburn 7557: text-align: center;
7558: }
1.795 www 7559:
1.589 raeburn 7560: table.LC_nested tr.LC_info_row td.LC_left_item,
7561: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7562: text-align: left;
1.451 albertel 7563: }
1.795 www 7564:
1.507 raeburn 7565: table.LC_nested td {
1.735 bisitz 7566: background-color: #FFFFFF;
1.451 albertel 7567: font-size: small;
1.507 raeburn 7568: }
1.795 www 7569:
1.507 raeburn 7570: table.LC_nested_outer tr th.LC_right_item,
7571: table.LC_nested tr.LC_info_row td.LC_right_item,
7572: table.LC_nested tr.LC_odd_row td.LC_right_item,
7573: table.LC_nested tr td.LC_right_item {
1.451 albertel 7574: text-align: right;
7575: }
7576:
1.507 raeburn 7577: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7578: background-color: #EEEEEE;
1.451 albertel 7579: }
7580:
1.473 raeburn 7581: table.LC_createuser {
7582: }
7583:
7584: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7585: font-size: small;
1.473 raeburn 7586: }
7587:
7588: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7589: background-color: #CCCCCC;
1.473 raeburn 7590: font-weight: bold;
7591: text-align: center;
7592: }
7593:
1.349 albertel 7594: table.LC_calendar {
7595: border: 1px solid #000000;
7596: border-collapse: collapse;
1.917 raeburn 7597: width: 98%;
1.349 albertel 7598: }
1.795 www 7599:
1.349 albertel 7600: table.LC_calendar_pickdate {
7601: font-size: xx-small;
7602: }
1.795 www 7603:
1.349 albertel 7604: table.LC_calendar tr td {
7605: border: 1px solid #000000;
7606: vertical-align: top;
1.917 raeburn 7607: width: 14%;
1.349 albertel 7608: }
1.795 www 7609:
1.349 albertel 7610: table.LC_calendar tr td.LC_calendar_day_empty {
7611: background-color: $data_table_dark;
7612: }
1.795 www 7613:
1.779 bisitz 7614: table.LC_calendar tr td.LC_calendar_day_current {
7615: background-color: $data_table_highlight;
1.777 tempelho 7616: }
1.795 www 7617:
1.938 bisitz 7618: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7619: background-color: $mail_new;
7620: }
1.795 www 7621:
1.938 bisitz 7622: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7623: background-color: $mail_new_hover;
7624: }
1.795 www 7625:
1.938 bisitz 7626: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7627: background-color: $mail_read;
7628: }
1.795 www 7629:
1.938 bisitz 7630: /*
7631: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7632: background-color: $mail_read_hover;
7633: }
1.938 bisitz 7634: */
1.795 www 7635:
1.938 bisitz 7636: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7637: background-color: $mail_replied;
7638: }
1.795 www 7639:
1.938 bisitz 7640: /*
7641: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7642: background-color: $mail_replied_hover;
7643: }
1.938 bisitz 7644: */
1.795 www 7645:
1.938 bisitz 7646: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7647: background-color: $mail_other;
7648: }
1.795 www 7649:
1.938 bisitz 7650: /*
7651: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7652: background-color: $mail_other_hover;
7653: }
1.938 bisitz 7654: */
1.494 raeburn 7655:
1.777 tempelho 7656: table.LC_data_table tr > td.LC_browser_file,
7657: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7658: background: #AAEE77;
1.389 albertel 7659: }
1.795 www 7660:
1.777 tempelho 7661: table.LC_data_table tr > td.LC_browser_file_locked,
7662: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7663: background: #FFAA99;
1.387 albertel 7664: }
1.795 www 7665:
1.777 tempelho 7666: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7667: background: #888888;
1.779 bisitz 7668: }
1.795 www 7669:
1.777 tempelho 7670: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7671: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7672: background: #F8F866;
1.777 tempelho 7673: }
1.795 www 7674:
1.696 bisitz 7675: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7676: background: #E0E8FF;
1.387 albertel 7677: }
1.696 bisitz 7678:
1.707 bisitz 7679: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7680: /* background: #77FF77; */
1.707 bisitz 7681: }
1.795 www 7682:
1.707 bisitz 7683: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7684: border-right: 8px solid #FFFF77;
1.707 bisitz 7685: }
1.795 www 7686:
1.707 bisitz 7687: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7688: border-right: 8px solid #FFAA77;
1.707 bisitz 7689: }
1.795 www 7690:
1.707 bisitz 7691: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7692: border-right: 8px solid #FF7777;
1.707 bisitz 7693: }
1.795 www 7694:
1.707 bisitz 7695: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7696: border-right: 8px solid #AAFF77;
1.707 bisitz 7697: }
1.795 www 7698:
1.707 bisitz 7699: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7700: border-right: 8px solid #11CC55;
1.707 bisitz 7701: }
7702:
1.388 albertel 7703: span.LC_current_location {
1.701 harmsja 7704: font-size:larger;
1.388 albertel 7705: background: $pgbg;
7706: }
1.387 albertel 7707:
1.1029 www 7708: span.LC_current_nav_location {
7709: font-weight:bold;
7710: background: $sidebg;
7711: }
7712:
1.395 albertel 7713: span.LC_parm_menu_item {
7714: font-size: larger;
7715: }
1.795 www 7716:
1.395 albertel 7717: span.LC_parm_scope_all {
7718: color: red;
7719: }
1.795 www 7720:
1.395 albertel 7721: span.LC_parm_scope_folder {
7722: color: green;
7723: }
1.795 www 7724:
1.395 albertel 7725: span.LC_parm_scope_resource {
7726: color: orange;
7727: }
1.795 www 7728:
1.395 albertel 7729: span.LC_parm_part {
7730: color: blue;
7731: }
1.795 www 7732:
1.911 bisitz 7733: span.LC_parm_folder,
7734: span.LC_parm_symb {
1.395 albertel 7735: font-size: x-small;
7736: font-family: $mono;
7737: color: #AAAAAA;
7738: }
7739:
1.977 bisitz 7740: ul.LC_parm_parmlist li {
7741: display: inline-block;
7742: padding: 0.3em 0.8em;
7743: vertical-align: top;
7744: width: 150px;
7745: border-top:1px solid $lg_border_color;
7746: }
7747:
1.795 www 7748: td.LC_parm_overview_level_menu,
7749: td.LC_parm_overview_map_menu,
7750: td.LC_parm_overview_parm_selectors,
7751: td.LC_parm_overview_restrictions {
1.396 albertel 7752: border: 1px solid black;
7753: border-collapse: collapse;
7754: }
1.795 www 7755:
1.1285 raeburn 7756: span.LC_parm_recursive,
7757: td.LC_parm_recursive {
7758: font-weight: bold;
7759: font-size: smaller;
7760: }
7761:
1.396 albertel 7762: table.LC_parm_overview_restrictions td {
7763: border-width: 1px 4px 1px 4px;
7764: border-style: solid;
7765: border-color: $pgbg;
7766: text-align: center;
7767: }
1.795 www 7768:
1.396 albertel 7769: table.LC_parm_overview_restrictions th {
7770: background: $tabbg;
7771: border-width: 1px 4px 1px 4px;
7772: border-style: solid;
7773: border-color: $pgbg;
7774: }
1.795 www 7775:
1.398 albertel 7776: table#LC_helpmenu {
1.803 bisitz 7777: border: none;
1.398 albertel 7778: height: 55px;
1.803 bisitz 7779: border-spacing: 0;
1.398 albertel 7780: }
7781:
7782: table#LC_helpmenu fieldset legend {
7783: font-size: larger;
7784: }
1.795 www 7785:
1.397 albertel 7786: table#LC_helpmenu_links {
7787: width: 100%;
7788: border: 1px solid black;
7789: background: $pgbg;
1.803 bisitz 7790: padding: 0;
1.397 albertel 7791: border-spacing: 1px;
7792: }
1.795 www 7793:
1.397 albertel 7794: table#LC_helpmenu_links tr td {
7795: padding: 1px;
7796: background: $tabbg;
1.399 albertel 7797: text-align: center;
7798: font-weight: bold;
1.397 albertel 7799: }
1.396 albertel 7800:
1.795 www 7801: table#LC_helpmenu_links a:link,
7802: table#LC_helpmenu_links a:visited,
1.397 albertel 7803: table#LC_helpmenu_links a:active {
7804: text-decoration: none;
7805: color: $font;
7806: }
1.795 www 7807:
1.397 albertel 7808: table#LC_helpmenu_links a:hover {
7809: text-decoration: underline;
7810: color: $vlink;
7811: }
1.396 albertel 7812:
1.417 albertel 7813: .LC_chrt_popup_exists {
7814: border: 1px solid #339933;
7815: margin: -1px;
7816: }
1.795 www 7817:
1.417 albertel 7818: .LC_chrt_popup_up {
7819: border: 1px solid yellow;
7820: margin: -1px;
7821: }
1.795 www 7822:
1.417 albertel 7823: .LC_chrt_popup {
7824: border: 1px solid #8888FF;
7825: background: #CCCCFF;
7826: }
1.795 www 7827:
1.421 albertel 7828: table.LC_pick_box {
7829: border-collapse: separate;
7830: background: white;
7831: border: 1px solid black;
7832: border-spacing: 1px;
7833: }
1.795 www 7834:
1.421 albertel 7835: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7836: background: $sidebg;
1.421 albertel 7837: font-weight: bold;
1.900 bisitz 7838: text-align: left;
1.740 bisitz 7839: vertical-align: top;
1.421 albertel 7840: width: 184px;
7841: padding: 8px;
7842: }
1.795 www 7843:
1.579 raeburn 7844: table.LC_pick_box td.LC_pick_box_value {
7845: text-align: left;
7846: padding: 8px;
7847: }
1.795 www 7848:
1.579 raeburn 7849: table.LC_pick_box td.LC_pick_box_select {
7850: text-align: left;
7851: padding: 8px;
7852: }
1.795 www 7853:
1.424 albertel 7854: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7855: padding: 0;
1.421 albertel 7856: height: 1px;
7857: background: black;
7858: }
1.795 www 7859:
1.421 albertel 7860: table.LC_pick_box td.LC_pick_box_submit {
7861: text-align: right;
7862: }
1.795 www 7863:
1.579 raeburn 7864: table.LC_pick_box td.LC_evenrow_value {
7865: text-align: left;
7866: padding: 8px;
7867: background-color: $data_table_light;
7868: }
1.795 www 7869:
1.579 raeburn 7870: table.LC_pick_box td.LC_oddrow_value {
7871: text-align: left;
7872: padding: 8px;
7873: background-color: $data_table_light;
7874: }
1.795 www 7875:
1.579 raeburn 7876: span.LC_helpform_receipt_cat {
7877: font-weight: bold;
7878: }
1.795 www 7879:
1.424 albertel 7880: table.LC_group_priv_box {
7881: background: white;
7882: border: 1px solid black;
7883: border-spacing: 1px;
7884: }
1.795 www 7885:
1.424 albertel 7886: table.LC_group_priv_box td.LC_pick_box_title {
7887: background: $tabbg;
7888: font-weight: bold;
7889: text-align: right;
7890: width: 184px;
7891: }
1.795 www 7892:
1.424 albertel 7893: table.LC_group_priv_box td.LC_groups_fixed {
7894: background: $data_table_light;
7895: text-align: center;
7896: }
1.795 www 7897:
1.424 albertel 7898: table.LC_group_priv_box td.LC_groups_optional {
7899: background: $data_table_dark;
7900: text-align: center;
7901: }
1.795 www 7902:
1.424 albertel 7903: table.LC_group_priv_box td.LC_groups_functionality {
7904: background: $data_table_darker;
7905: text-align: center;
7906: font-weight: bold;
7907: }
1.795 www 7908:
1.424 albertel 7909: table.LC_group_priv td {
7910: text-align: left;
1.803 bisitz 7911: padding: 0;
1.424 albertel 7912: }
7913:
7914: .LC_navbuttons {
7915: margin: 2ex 0ex 2ex 0ex;
7916: }
1.795 www 7917:
1.423 albertel 7918: .LC_topic_bar {
7919: font-weight: bold;
7920: background: $tabbg;
1.918 wenzelju 7921: margin: 1em 0em 1em 2em;
1.805 bisitz 7922: padding: 3px;
1.918 wenzelju 7923: font-size: 1.2em;
1.423 albertel 7924: }
1.795 www 7925:
1.423 albertel 7926: .LC_topic_bar span {
1.918 wenzelju 7927: left: 0.5em;
7928: position: absolute;
1.423 albertel 7929: vertical-align: middle;
1.918 wenzelju 7930: font-size: 1.2em;
1.423 albertel 7931: }
1.795 www 7932:
1.423 albertel 7933: table.LC_course_group_status {
7934: margin: 20px;
7935: }
1.795 www 7936:
1.423 albertel 7937: table.LC_status_selector td {
7938: vertical-align: top;
7939: text-align: center;
1.424 albertel 7940: padding: 4px;
7941: }
1.795 www 7942:
1.599 albertel 7943: div.LC_feedback_link {
1.616 albertel 7944: clear: both;
1.829 kalberla 7945: background: $sidebg;
1.779 bisitz 7946: width: 100%;
1.829 kalberla 7947: padding-bottom: 10px;
7948: border: 1px $tabbg solid;
1.833 kalberla 7949: height: 22px;
7950: line-height: 22px;
7951: padding-top: 5px;
7952: }
7953:
7954: div.LC_feedback_link img {
7955: height: 22px;
1.867 kalberla 7956: vertical-align:middle;
1.829 kalberla 7957: }
7958:
1.911 bisitz 7959: div.LC_feedback_link a {
1.829 kalberla 7960: text-decoration: none;
1.489 raeburn 7961: }
1.795 www 7962:
1.867 kalberla 7963: div.LC_comblock {
1.911 bisitz 7964: display:inline;
1.867 kalberla 7965: color:$font;
7966: font-size:90%;
7967: }
7968:
7969: div.LC_feedback_link div.LC_comblock {
7970: padding-left:5px;
7971: }
7972:
7973: div.LC_feedback_link div.LC_comblock a {
7974: color:$font;
7975: }
7976:
1.489 raeburn 7977: span.LC_feedback_link {
1.858 bisitz 7978: /* background: $feedback_link_bg; */
1.599 albertel 7979: font-size: larger;
7980: }
1.795 www 7981:
1.599 albertel 7982: span.LC_message_link {
1.858 bisitz 7983: /* background: $feedback_link_bg; */
1.599 albertel 7984: font-size: larger;
7985: position: absolute;
7986: right: 1em;
1.489 raeburn 7987: }
1.421 albertel 7988:
1.515 albertel 7989: table.LC_prior_tries {
1.524 albertel 7990: border: 1px solid #000000;
7991: border-collapse: separate;
7992: border-spacing: 1px;
1.515 albertel 7993: }
1.523 albertel 7994:
1.515 albertel 7995: table.LC_prior_tries td {
1.524 albertel 7996: padding: 2px;
1.515 albertel 7997: }
1.523 albertel 7998:
7999: .LC_answer_correct {
1.795 www 8000: background: lightgreen;
8001: color: darkgreen;
8002: padding: 6px;
1.523 albertel 8003: }
1.795 www 8004:
1.523 albertel 8005: .LC_answer_charged_try {
1.797 www 8006: background: #FFAAAA;
1.795 www 8007: color: darkred;
8008: padding: 6px;
1.523 albertel 8009: }
1.795 www 8010:
1.779 bisitz 8011: .LC_answer_not_charged_try,
1.523 albertel 8012: .LC_answer_no_grade,
8013: .LC_answer_late {
1.795 www 8014: background: lightyellow;
1.523 albertel 8015: color: black;
1.795 www 8016: padding: 6px;
1.523 albertel 8017: }
1.795 www 8018:
1.523 albertel 8019: .LC_answer_previous {
1.795 www 8020: background: lightblue;
8021: color: darkblue;
8022: padding: 6px;
1.523 albertel 8023: }
1.795 www 8024:
1.779 bisitz 8025: .LC_answer_no_message {
1.777 tempelho 8026: background: #FFFFFF;
8027: color: black;
1.795 www 8028: padding: 6px;
1.779 bisitz 8029: }
1.795 www 8030:
1.1334 raeburn 8031: .LC_answer_unknown,
8032: .LC_answer_warning {
1.779 bisitz 8033: background: orange;
8034: color: black;
1.795 www 8035: padding: 6px;
1.777 tempelho 8036: }
1.795 www 8037:
1.529 albertel 8038: span.LC_prior_numerical,
8039: span.LC_prior_string,
8040: span.LC_prior_custom,
8041: span.LC_prior_reaction,
8042: span.LC_prior_math {
1.925 bisitz 8043: font-family: $mono;
1.523 albertel 8044: white-space: pre;
8045: }
8046:
1.525 albertel 8047: span.LC_prior_string {
1.925 bisitz 8048: font-family: $mono;
1.525 albertel 8049: white-space: pre;
8050: }
8051:
1.523 albertel 8052: table.LC_prior_option {
8053: width: 100%;
8054: border-collapse: collapse;
8055: }
1.795 www 8056:
1.911 bisitz 8057: table.LC_prior_rank,
1.795 www 8058: table.LC_prior_match {
1.528 albertel 8059: border-collapse: collapse;
8060: }
1.795 www 8061:
1.528 albertel 8062: table.LC_prior_option tr td,
8063: table.LC_prior_rank tr td,
8064: table.LC_prior_match tr td {
1.524 albertel 8065: border: 1px solid #000000;
1.515 albertel 8066: }
8067:
1.855 bisitz 8068: .LC_nobreak {
1.544 albertel 8069: white-space: nowrap;
1.519 raeburn 8070: }
8071:
1.576 raeburn 8072: span.LC_cusr_emph {
8073: font-style: italic;
8074: }
8075:
1.633 raeburn 8076: span.LC_cusr_subheading {
8077: font-weight: normal;
8078: font-size: 85%;
8079: }
8080:
1.861 bisitz 8081: div.LC_docs_entry_move {
1.859 bisitz 8082: border: 1px solid #BBBBBB;
1.545 albertel 8083: background: #DDDDDD;
1.861 bisitz 8084: width: 22px;
1.859 bisitz 8085: padding: 1px;
8086: margin: 0;
1.545 albertel 8087: }
8088:
1.861 bisitz 8089: table.LC_data_table tr > td.LC_docs_entry_commands,
8090: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 8091: font-size: x-small;
8092: }
1.795 www 8093:
1.861 bisitz 8094: .LC_docs_entry_parameter {
8095: white-space: nowrap;
8096: }
8097:
1.544 albertel 8098: .LC_docs_copy {
1.545 albertel 8099: color: #000099;
1.544 albertel 8100: }
1.795 www 8101:
1.544 albertel 8102: .LC_docs_cut {
1.545 albertel 8103: color: #550044;
1.544 albertel 8104: }
1.795 www 8105:
1.544 albertel 8106: .LC_docs_rename {
1.545 albertel 8107: color: #009900;
1.544 albertel 8108: }
1.795 www 8109:
1.544 albertel 8110: .LC_docs_remove {
1.545 albertel 8111: color: #990000;
8112: }
8113:
1.1284 raeburn 8114: .LC_docs_alias {
8115: color: #440055;
8116: }
8117:
1.1286 raeburn 8118: .LC_domprefs_email,
1.1284 raeburn 8119: .LC_docs_alias_name,
1.547 albertel 8120: .LC_docs_reinit_warn,
8121: .LC_docs_ext_edit {
8122: font-size: x-small;
8123: }
8124:
1.545 albertel 8125: table.LC_docs_adddocs td,
8126: table.LC_docs_adddocs th {
8127: border: 1px solid #BBBBBB;
8128: padding: 4px;
8129: background: #DDDDDD;
1.543 albertel 8130: }
8131:
1.584 albertel 8132: table.LC_sty_begin {
8133: background: #BBFFBB;
8134: }
1.795 www 8135:
1.584 albertel 8136: table.LC_sty_end {
8137: background: #FFBBBB;
8138: }
8139:
1.589 raeburn 8140: table.LC_double_column {
1.803 bisitz 8141: border-width: 0;
1.589 raeburn 8142: border-collapse: collapse;
8143: width: 100%;
8144: padding: 2px;
8145: }
8146:
8147: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 8148: top: 2px;
1.589 raeburn 8149: left: 2px;
8150: width: 47%;
8151: vertical-align: top;
8152: }
8153:
8154: table.LC_double_column tr td.LC_right_col {
8155: top: 2px;
1.779 bisitz 8156: right: 2px;
1.589 raeburn 8157: width: 47%;
8158: vertical-align: top;
8159: }
8160:
1.591 raeburn 8161: div.LC_left_float {
8162: float: left;
8163: padding-right: 5%;
1.597 albertel 8164: padding-bottom: 4px;
1.591 raeburn 8165: }
8166:
8167: div.LC_clear_float_header {
1.597 albertel 8168: padding-bottom: 2px;
1.591 raeburn 8169: }
8170:
8171: div.LC_clear_float_footer {
1.597 albertel 8172: padding-top: 10px;
1.591 raeburn 8173: clear: both;
8174: }
8175:
1.597 albertel 8176: div.LC_grade_show_user {
1.941 bisitz 8177: /* border-left: 5px solid $sidebg; */
8178: border-top: 5px solid #000000;
8179: margin: 50px 0 0 0;
1.936 bisitz 8180: padding: 15px 0 5px 10px;
1.597 albertel 8181: }
1.795 www 8182:
1.936 bisitz 8183: div.LC_grade_show_user_odd_row {
1.941 bisitz 8184: /* border-left: 5px solid #000000; */
8185: }
8186:
8187: div.LC_grade_show_user div.LC_Box {
8188: margin-right: 50px;
1.597 albertel 8189: }
8190:
8191: div.LC_grade_submissions,
8192: div.LC_grade_message_center,
1.936 bisitz 8193: div.LC_grade_info_links {
1.597 albertel 8194: margin: 5px;
8195: width: 99%;
8196: background: #FFFFFF;
8197: }
1.795 www 8198:
1.597 albertel 8199: div.LC_grade_submissions_header,
1.936 bisitz 8200: div.LC_grade_message_center_header {
1.705 tempelho 8201: font-weight: bold;
8202: font-size: large;
1.597 albertel 8203: }
1.795 www 8204:
1.597 albertel 8205: div.LC_grade_submissions_body,
1.936 bisitz 8206: div.LC_grade_message_center_body {
1.597 albertel 8207: border: 1px solid black;
8208: width: 99%;
8209: background: #FFFFFF;
8210: }
1.795 www 8211:
1.613 albertel 8212: table.LC_scantron_action {
8213: width: 100%;
8214: }
1.795 www 8215:
1.613 albertel 8216: table.LC_scantron_action tr th {
1.698 harmsja 8217: font-weight:bold;
8218: font-style:normal;
1.613 albertel 8219: }
1.795 www 8220:
1.779 bisitz 8221: .LC_edit_problem_header,
1.614 albertel 8222: div.LC_edit_problem_footer {
1.705 tempelho 8223: font-weight: normal;
8224: font-size: medium;
1.602 albertel 8225: margin: 2px;
1.1060 bisitz 8226: background-color: $sidebg;
1.600 albertel 8227: }
1.795 www 8228:
1.600 albertel 8229: div.LC_edit_problem_header,
1.602 albertel 8230: div.LC_edit_problem_header div,
1.614 albertel 8231: div.LC_edit_problem_footer,
8232: div.LC_edit_problem_footer div,
1.602 albertel 8233: div.LC_edit_problem_editxml_header,
8234: div.LC_edit_problem_editxml_header div {
1.1205 golterma 8235: z-index: 100;
1.600 albertel 8236: }
1.795 www 8237:
1.600 albertel 8238: div.LC_edit_problem_header_title {
1.705 tempelho 8239: font-weight: bold;
8240: font-size: larger;
1.602 albertel 8241: background: $tabbg;
8242: padding: 3px;
1.1060 bisitz 8243: margin: 0 0 5px 0;
1.602 albertel 8244: }
1.795 www 8245:
1.602 albertel 8246: table.LC_edit_problem_header_title {
8247: width: 100%;
1.600 albertel 8248: background: $tabbg;
1.602 albertel 8249: }
8250:
1.1205 golterma 8251: div.LC_edit_actionbar {
8252: background-color: $sidebg;
1.1218 droeschl 8253: margin: 0;
8254: padding: 0;
8255: line-height: 200%;
1.602 albertel 8256: }
1.795 www 8257:
1.1218 droeschl 8258: div.LC_edit_actionbar div{
8259: padding: 0;
8260: margin: 0;
8261: display: inline-block;
1.600 albertel 8262: }
1.795 www 8263:
1.1124 bisitz 8264: .LC_edit_opt {
8265: padding-left: 1em;
8266: white-space: nowrap;
8267: }
8268:
1.1152 golterma 8269: .LC_edit_problem_latexhelper{
8270: text-align: right;
8271: }
8272:
8273: #LC_edit_problem_colorful div{
8274: margin-left: 40px;
8275: }
8276:
1.1205 golterma 8277: #LC_edit_problem_codemirror div{
8278: margin-left: 0px;
8279: }
8280:
1.911 bisitz 8281: img.stift {
1.803 bisitz 8282: border-width: 0;
8283: vertical-align: middle;
1.677 riegler 8284: }
1.680 riegler 8285:
1.923 bisitz 8286: table td.LC_mainmenu_col_fieldset {
1.680 riegler 8287: vertical-align: top;
1.777 tempelho 8288: }
1.795 www 8289:
1.716 raeburn 8290: div.LC_createcourse {
1.911 bisitz 8291: margin: 10px 10px 10px 10px;
1.716 raeburn 8292: }
8293:
1.917 raeburn 8294: .LC_dccid {
1.1130 raeburn 8295: float: right;
1.917 raeburn 8296: margin: 0.2em 0 0 0;
8297: padding: 0;
8298: font-size: 90%;
8299: display:none;
8300: }
8301:
1.897 wenzelju 8302: ol.LC_primary_menu a:hover,
1.721 harmsja 8303: ol#LC_MenuBreadcrumbs a:hover,
8304: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 8305: ul#LC_secondary_menu a:hover,
1.721 harmsja 8306: .LC_FormSectionClearButton input:hover
1.795 www 8307: ul.LC_TabContent li:hover a {
1.952 onken 8308: color:$button_hover;
1.911 bisitz 8309: text-decoration:none;
1.693 droeschl 8310: }
8311:
1.779 bisitz 8312: h1 {
1.911 bisitz 8313: padding: 0;
8314: line-height:130%;
1.693 droeschl 8315: }
1.698 harmsja 8316:
1.911 bisitz 8317: h2,
8318: h3,
8319: h4,
8320: h5,
8321: h6 {
8322: margin: 5px 0 5px 0;
8323: padding: 0;
8324: line-height:130%;
1.693 droeschl 8325: }
1.795 www 8326:
8327: .LC_hcell {
1.911 bisitz 8328: padding:3px 15px 3px 15px;
8329: margin: 0;
8330: background-color:$tabbg;
8331: color:$fontmenu;
8332: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 8333: }
1.795 www 8334:
1.840 bisitz 8335: .LC_Box > .LC_hcell {
1.911 bisitz 8336: margin: 0 -10px 10px -10px;
1.835 bisitz 8337: }
8338:
1.721 harmsja 8339: .LC_noBorder {
1.911 bisitz 8340: border: 0;
1.698 harmsja 8341: }
1.693 droeschl 8342:
1.721 harmsja 8343: .LC_FormSectionClearButton input {
1.911 bisitz 8344: background-color:transparent;
8345: border: none;
8346: cursor:pointer;
8347: text-decoration:underline;
1.693 droeschl 8348: }
1.763 bisitz 8349:
8350: .LC_help_open_topic {
1.911 bisitz 8351: color: #FFFFFF;
8352: background-color: #EEEEFF;
8353: margin: 1px;
8354: padding: 4px;
8355: border: 1px solid #000033;
8356: white-space: nowrap;
8357: /* vertical-align: middle; */
1.759 neumanie 8358: }
1.693 droeschl 8359:
1.911 bisitz 8360: dl,
8361: ul,
8362: div,
8363: fieldset {
8364: margin: 10px 10px 10px 0;
8365: /* overflow: hidden; */
1.693 droeschl 8366: }
1.795 www 8367:
1.1404 raeburn 8368: fieldset#LC_selectuser {
8369: margin: 0;
8370: padding: 0;
8371: }
8372:
1.1211 raeburn 8373: article.geogebraweb div {
8374: margin: 0;
8375: }
8376:
1.838 bisitz 8377: fieldset > legend {
1.911 bisitz 8378: font-weight: bold;
8379: padding: 0 5px 0 5px;
1.838 bisitz 8380: }
8381:
1.813 bisitz 8382: #LC_nav_bar {
1.911 bisitz 8383: float: left;
1.995 raeburn 8384: background-color: $pgbg_or_bgcolor;
1.966 bisitz 8385: margin: 0 0 2px 0;
1.807 droeschl 8386: }
8387:
1.916 droeschl 8388: #LC_realm {
8389: margin: 0.2em 0 0 0;
8390: padding: 0;
8391: font-weight: bold;
8392: text-align: center;
1.995 raeburn 8393: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8394: }
8395:
1.911 bisitz 8396: #LC_nav_bar em {
8397: font-weight: bold;
8398: font-style: normal;
1.807 droeschl 8399: }
8400:
1.897 wenzelju 8401: ol.LC_primary_menu {
1.934 droeschl 8402: margin: 0;
1.1076 raeburn 8403: padding: 0;
1.807 droeschl 8404: }
8405:
1.852 droeschl 8406: ol#LC_PathBreadcrumbs {
1.911 bisitz 8407: margin: 0;
1.693 droeschl 8408: }
8409:
1.897 wenzelju 8410: ol.LC_primary_menu li {
1.1076 raeburn 8411: color: RGB(80, 80, 80);
8412: vertical-align: middle;
8413: text-align: left;
8414: list-style: none;
1.1205 golterma 8415: position: relative;
1.1076 raeburn 8416: float: left;
1.1205 golterma 8417: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8418: line-height: 1.5em;
1.1076 raeburn 8419: }
8420:
1.1205 golterma 8421: ol.LC_primary_menu li a,
8422: ol.LC_primary_menu li p {
1.1076 raeburn 8423: display: block;
8424: margin: 0;
8425: padding: 0 5px 0 10px;
8426: text-decoration: none;
8427: }
8428:
1.1205 golterma 8429: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8430: display: inline-block;
8431: width: 95%;
8432: text-align: left;
8433: }
8434:
8435: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8436: display: inline-block;
8437: width: 5%;
8438: float: right;
8439: text-align: right;
8440: font-size: 70%;
8441: }
8442:
8443: ol.LC_primary_menu ul {
1.1076 raeburn 8444: display: none;
1.1205 golterma 8445: width: 15em;
1.1076 raeburn 8446: background-color: $data_table_light;
1.1205 golterma 8447: position: absolute;
8448: top: 100%;
1.1076 raeburn 8449: }
8450:
1.1205 golterma 8451: ol.LC_primary_menu ul ul {
8452: left: 100%;
8453: top: 0;
8454: }
8455:
8456: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8457: display: block;
8458: position: absolute;
8459: margin: 0;
8460: padding: 0;
1.1078 raeburn 8461: z-index: 2;
1.1076 raeburn 8462: }
8463:
8464: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8465: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8466: font-size: 90%;
1.911 bisitz 8467: vertical-align: top;
1.1076 raeburn 8468: float: none;
1.1079 raeburn 8469: border-left: 1px solid black;
8470: border-right: 1px solid black;
1.1205 golterma 8471: /* A dark bottom border to visualize different menu options;
8472: overwritten in the create_submenu routine for the last border-bottom of the menu */
8473: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8474: }
8475:
1.1205 golterma 8476: ol.LC_primary_menu li li p:hover {
8477: color:$button_hover;
8478: text-decoration:none;
8479: background-color:$data_table_dark;
1.1076 raeburn 8480: }
8481:
8482: ol.LC_primary_menu li li a:hover {
8483: color:$button_hover;
8484: background-color:$data_table_dark;
1.693 droeschl 8485: }
8486:
1.1205 golterma 8487: /* Font-size equal to the size of the predecessors*/
8488: ol.LC_primary_menu li:hover li li {
8489: font-size: 100%;
8490: }
8491:
1.897 wenzelju 8492: ol.LC_primary_menu li img {
1.911 bisitz 8493: vertical-align: bottom;
1.934 droeschl 8494: height: 1.1em;
1.1077 raeburn 8495: margin: 0.2em 0 0 0;
1.693 droeschl 8496: }
8497:
1.897 wenzelju 8498: ol.LC_primary_menu a {
1.911 bisitz 8499: color: RGB(80, 80, 80);
8500: text-decoration: none;
1.693 droeschl 8501: }
1.795 www 8502:
1.949 droeschl 8503: ol.LC_primary_menu a.LC_new_message {
8504: font-weight:bold;
8505: color: darkred;
8506: }
8507:
1.975 raeburn 8508: ol.LC_docs_parameters {
8509: margin-left: 0;
8510: padding: 0;
8511: list-style: none;
8512: }
8513:
8514: ol.LC_docs_parameters li {
8515: margin: 0;
8516: padding-right: 20px;
8517: display: inline;
8518: }
8519:
1.976 raeburn 8520: ol.LC_docs_parameters li:before {
8521: content: "\\002022 \\0020";
8522: }
8523:
8524: li.LC_docs_parameters_title {
8525: font-weight: bold;
8526: }
8527:
8528: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8529: content: "";
8530: }
8531:
1.897 wenzelju 8532: ul#LC_secondary_menu {
1.1107 raeburn 8533: clear: right;
1.911 bisitz 8534: color: $fontmenu;
8535: background: $tabbg;
8536: list-style: none;
8537: padding: 0;
8538: margin: 0;
8539: width: 100%;
1.995 raeburn 8540: text-align: left;
1.1107 raeburn 8541: float: left;
1.808 droeschl 8542: }
8543:
1.897 wenzelju 8544: ul#LC_secondary_menu li {
1.911 bisitz 8545: font-weight: bold;
8546: line-height: 1.8em;
1.1107 raeburn 8547: border-right: 1px solid black;
8548: float: left;
8549: }
8550:
8551: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8552: background-color: $data_table_light;
8553: }
8554:
8555: ul#LC_secondary_menu li a {
1.911 bisitz 8556: padding: 0 0.8em;
1.1107 raeburn 8557: }
8558:
8559: ul#LC_secondary_menu li ul {
8560: display: none;
8561: }
8562:
8563: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8564: display: block;
8565: position: absolute;
8566: margin: 0;
8567: padding: 0;
8568: list-style:none;
8569: float: none;
8570: background-color: $data_table_light;
8571: z-index: 2;
8572: margin-left: -1px;
8573: }
8574:
8575: ul#LC_secondary_menu li ul li {
8576: font-size: 90%;
8577: vertical-align: top;
8578: border-left: 1px solid black;
1.911 bisitz 8579: border-right: 1px solid black;
1.1119 raeburn 8580: background-color: $data_table_light;
1.1107 raeburn 8581: list-style:none;
8582: float: none;
8583: }
8584:
8585: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8586: background-color: $data_table_dark;
1.807 droeschl 8587: }
8588:
1.847 tempelho 8589: ul.LC_TabContent {
1.911 bisitz 8590: display:block;
8591: background: $sidebg;
8592: border-bottom: solid 1px $lg_border_color;
8593: list-style:none;
1.1020 raeburn 8594: margin: -1px -10px 0 -10px;
1.911 bisitz 8595: padding: 0;
1.693 droeschl 8596: }
8597:
1.795 www 8598: ul.LC_TabContent li,
8599: ul.LC_TabContentBigger li {
1.911 bisitz 8600: float:left;
1.741 harmsja 8601: }
1.795 www 8602:
1.897 wenzelju 8603: ul#LC_secondary_menu li a {
1.911 bisitz 8604: color: $fontmenu;
8605: text-decoration: none;
1.693 droeschl 8606: }
1.795 www 8607:
1.721 harmsja 8608: ul.LC_TabContent {
1.952 onken 8609: min-height:20px;
1.721 harmsja 8610: }
1.795 www 8611:
8612: ul.LC_TabContent li {
1.911 bisitz 8613: vertical-align:middle;
1.959 onken 8614: padding: 0 16px 0 10px;
1.911 bisitz 8615: background-color:$tabbg;
8616: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8617: border-left: solid 1px $font;
1.721 harmsja 8618: }
1.795 www 8619:
1.847 tempelho 8620: ul.LC_TabContent .right {
1.911 bisitz 8621: float:right;
1.847 tempelho 8622: }
8623:
1.911 bisitz 8624: ul.LC_TabContent li a,
8625: ul.LC_TabContent li {
8626: color:rgb(47,47,47);
8627: text-decoration:none;
8628: font-size:95%;
8629: font-weight:bold;
1.952 onken 8630: min-height:20px;
8631: }
8632:
1.959 onken 8633: ul.LC_TabContent li a:hover,
8634: ul.LC_TabContent li a:focus {
1.952 onken 8635: color: $button_hover;
1.959 onken 8636: background:none;
8637: outline:none;
1.952 onken 8638: }
8639:
8640: ul.LC_TabContent li:hover {
8641: color: $button_hover;
8642: cursor:pointer;
1.721 harmsja 8643: }
1.795 www 8644:
1.911 bisitz 8645: ul.LC_TabContent li.active {
1.952 onken 8646: color: $font;
1.911 bisitz 8647: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8648: border-bottom:solid 1px #FFFFFF;
8649: cursor: default;
1.744 ehlerst 8650: }
1.795 www 8651:
1.959 onken 8652: ul.LC_TabContent li.active a {
8653: color:$font;
8654: background:#FFFFFF;
8655: outline: none;
8656: }
1.1047 raeburn 8657:
8658: ul.LC_TabContent li.goback {
8659: float: left;
8660: border-left: none;
8661: }
8662:
1.870 tempelho 8663: #maincoursedoc {
1.911 bisitz 8664: clear:both;
1.870 tempelho 8665: }
8666:
8667: ul.LC_TabContentBigger {
1.911 bisitz 8668: display:block;
8669: list-style:none;
8670: padding: 0;
1.870 tempelho 8671: }
8672:
1.795 www 8673: ul.LC_TabContentBigger li {
1.911 bisitz 8674: vertical-align:bottom;
8675: height: 30px;
8676: font-size:110%;
8677: font-weight:bold;
8678: color: #737373;
1.841 tempelho 8679: }
8680:
1.957 onken 8681: ul.LC_TabContentBigger li.active {
8682: position: relative;
8683: top: 1px;
8684: }
8685:
1.870 tempelho 8686: ul.LC_TabContentBigger li a {
1.911 bisitz 8687: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8688: height: 30px;
8689: line-height: 30px;
8690: text-align: center;
8691: display: block;
8692: text-decoration: none;
1.958 onken 8693: outline: none;
1.741 harmsja 8694: }
1.795 www 8695:
1.870 tempelho 8696: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8697: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8698: color:$font;
1.744 ehlerst 8699: }
1.795 www 8700:
1.870 tempelho 8701: ul.LC_TabContentBigger li b {
1.911 bisitz 8702: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8703: display: block;
8704: float: left;
8705: padding: 0 30px;
1.957 onken 8706: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8707: }
8708:
1.956 onken 8709: ul.LC_TabContentBigger li:hover b {
8710: color:$button_hover;
8711: }
8712:
1.870 tempelho 8713: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8714: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8715: color:$font;
1.957 onken 8716: border: 0;
1.741 harmsja 8717: }
1.693 droeschl 8718:
1.870 tempelho 8719:
1.862 bisitz 8720: ul.LC_CourseBreadcrumbs {
8721: background: $sidebg;
1.1020 raeburn 8722: height: 2em;
1.862 bisitz 8723: padding-left: 10px;
1.1020 raeburn 8724: margin: 0;
1.862 bisitz 8725: list-style-position: inside;
8726: }
8727:
1.911 bisitz 8728: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8729: ol#LC_PathBreadcrumbs {
1.911 bisitz 8730: padding-left: 10px;
8731: margin: 0;
1.933 droeschl 8732: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8733: }
8734:
1.911 bisitz 8735: ol#LC_MenuBreadcrumbs li,
8736: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8737: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8738: display: inline;
1.933 droeschl 8739: white-space: normal;
1.693 droeschl 8740: }
8741:
1.823 bisitz 8742: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8743: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8744: text-decoration: none;
8745: font-size:90%;
1.693 droeschl 8746: }
1.795 www 8747:
1.969 droeschl 8748: ol#LC_MenuBreadcrumbs h1 {
8749: display: inline;
8750: font-size: 90%;
8751: line-height: 2.5em;
8752: margin: 0;
8753: padding: 0;
8754: }
8755:
1.795 www 8756: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8757: text-decoration:none;
8758: font-size:100%;
8759: font-weight:bold;
1.693 droeschl 8760: }
1.795 www 8761:
1.840 bisitz 8762: .LC_Box {
1.911 bisitz 8763: border: solid 1px $lg_border_color;
8764: padding: 0 10px 10px 10px;
1.746 neumanie 8765: }
1.795 www 8766:
1.1020 raeburn 8767: .LC_DocsBox {
8768: border: solid 1px $lg_border_color;
8769: padding: 0 0 10px 10px;
8770: }
8771:
1.795 www 8772: .LC_AboutMe_Image {
1.911 bisitz 8773: float:left;
8774: margin-right:10px;
1.747 neumanie 8775: }
1.795 www 8776:
8777: .LC_Clear_AboutMe_Image {
1.911 bisitz 8778: clear:left;
1.747 neumanie 8779: }
1.795 www 8780:
1.721 harmsja 8781: dl.LC_ListStyleClean dt {
1.911 bisitz 8782: padding-right: 5px;
8783: display: table-header-group;
1.693 droeschl 8784: }
8785:
1.721 harmsja 8786: dl.LC_ListStyleClean dd {
1.911 bisitz 8787: display: table-row;
1.693 droeschl 8788: }
8789:
1.721 harmsja 8790: .LC_ListStyleClean,
8791: .LC_ListStyleSimple,
8792: .LC_ListStyleNormal,
1.795 www 8793: .LC_ListStyleSpecial {
1.911 bisitz 8794: /* display:block; */
8795: list-style-position: inside;
8796: list-style-type: none;
8797: overflow: hidden;
8798: padding: 0;
1.693 droeschl 8799: }
8800:
1.721 harmsja 8801: .LC_ListStyleSimple li,
8802: .LC_ListStyleSimple dd,
8803: .LC_ListStyleNormal li,
8804: .LC_ListStyleNormal dd,
8805: .LC_ListStyleSpecial li,
1.795 www 8806: .LC_ListStyleSpecial dd {
1.911 bisitz 8807: margin: 0;
8808: padding: 5px 5px 5px 10px;
8809: clear: both;
1.693 droeschl 8810: }
8811:
1.721 harmsja 8812: .LC_ListStyleClean li,
8813: .LC_ListStyleClean dd {
1.911 bisitz 8814: padding-top: 0;
8815: padding-bottom: 0;
1.693 droeschl 8816: }
8817:
1.721 harmsja 8818: .LC_ListStyleSimple dd,
1.795 www 8819: .LC_ListStyleSimple li {
1.911 bisitz 8820: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8821: }
8822:
1.721 harmsja 8823: .LC_ListStyleSpecial li,
8824: .LC_ListStyleSpecial dd {
1.911 bisitz 8825: list-style-type: none;
8826: background-color: RGB(220, 220, 220);
8827: margin-bottom: 4px;
1.693 droeschl 8828: }
8829:
1.721 harmsja 8830: table.LC_SimpleTable {
1.911 bisitz 8831: margin:5px;
8832: border:solid 1px $lg_border_color;
1.795 www 8833: }
1.693 droeschl 8834:
1.721 harmsja 8835: table.LC_SimpleTable tr {
1.911 bisitz 8836: padding: 0;
8837: border:solid 1px $lg_border_color;
1.693 droeschl 8838: }
1.795 www 8839:
8840: table.LC_SimpleTable thead {
1.911 bisitz 8841: background:rgb(220,220,220);
1.693 droeschl 8842: }
8843:
1.721 harmsja 8844: div.LC_columnSection {
1.911 bisitz 8845: display: block;
8846: clear: both;
8847: overflow: hidden;
8848: margin: 0;
1.693 droeschl 8849: }
8850:
1.721 harmsja 8851: div.LC_columnSection>* {
1.911 bisitz 8852: float: left;
8853: margin: 10px 20px 10px 0;
8854: overflow:hidden;
1.693 droeschl 8855: }
1.721 harmsja 8856:
1.795 www 8857: table em {
1.911 bisitz 8858: font-weight: bold;
8859: font-style: normal;
1.748 schulted 8860: }
1.795 www 8861:
1.779 bisitz 8862: table.LC_tableBrowseRes,
1.795 www 8863: table.LC_tableOfContent {
1.911 bisitz 8864: border:none;
8865: border-spacing: 1px;
8866: padding: 3px;
8867: background-color: #FFFFFF;
8868: font-size: 90%;
1.753 droeschl 8869: }
1.789 droeschl 8870:
1.911 bisitz 8871: table.LC_tableOfContent {
8872: border-collapse: collapse;
1.789 droeschl 8873: }
8874:
1.771 droeschl 8875: table.LC_tableBrowseRes a,
1.768 schulted 8876: table.LC_tableOfContent a {
1.911 bisitz 8877: background-color: transparent;
8878: text-decoration: none;
1.753 droeschl 8879: }
8880:
1.795 www 8881: table.LC_tableOfContent img {
1.911 bisitz 8882: border: none;
8883: height: 1.3em;
8884: vertical-align: text-bottom;
8885: margin-right: 0.3em;
1.753 droeschl 8886: }
1.757 schulted 8887:
1.795 www 8888: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8889: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8890: }
8891:
1.795 www 8892: a#LC_content_toolbar_everything {
1.911 bisitz 8893: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8894: }
8895:
1.795 www 8896: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8897: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8898: }
8899:
1.795 www 8900: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8901: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8902: }
8903:
1.795 www 8904: a#LC_content_toolbar_changefolder {
1.911 bisitz 8905: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8906: }
8907:
1.795 www 8908: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8909: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8910: }
8911:
1.1043 raeburn 8912: a#LC_content_toolbar_edittoplevel {
8913: background-image:url(/res/adm/pages/edittoplevel.gif);
8914: }
8915:
1.1384 raeburn 8916: a#LC_content_toolbar_printout {
8917: background-image:url(/res/adm/pages/printout.gif);
8918: }
8919:
1.795 www 8920: ul#LC_toolbar li a:hover {
1.911 bisitz 8921: background-position: bottom center;
1.757 schulted 8922: }
8923:
1.795 www 8924: ul#LC_toolbar {
1.911 bisitz 8925: padding: 0;
8926: margin: 2px;
8927: list-style:none;
8928: position:relative;
8929: background-color:white;
1.1082 raeburn 8930: overflow: auto;
1.757 schulted 8931: }
8932:
1.795 www 8933: ul#LC_toolbar li {
1.911 bisitz 8934: border:1px solid white;
8935: padding: 0;
8936: margin: 0;
8937: float: left;
8938: display:inline;
8939: vertical-align:middle;
1.1082 raeburn 8940: white-space: nowrap;
1.911 bisitz 8941: }
1.757 schulted 8942:
1.783 amueller 8943:
1.795 www 8944: a.LC_toolbarItem {
1.911 bisitz 8945: display:block;
8946: padding: 0;
8947: margin: 0;
8948: height: 32px;
8949: width: 32px;
8950: color:white;
8951: border: none;
8952: background-repeat:no-repeat;
8953: background-color:transparent;
1.757 schulted 8954: }
8955:
1.915 droeschl 8956: ul.LC_funclist {
8957: margin: 0;
8958: padding: 0.5em 1em 0.5em 0;
8959: }
8960:
1.933 droeschl 8961: ul.LC_funclist > li:first-child {
8962: font-weight:bold;
8963: margin-left:0.8em;
8964: }
8965:
1.915 droeschl 8966: ul.LC_funclist + ul.LC_funclist {
8967: /*
8968: left border as a seperator if we have more than
8969: one list
8970: */
8971: border-left: 1px solid $sidebg;
8972: /*
8973: this hides the left border behind the border of the
8974: outer box if element is wrapped to the next 'line'
8975: */
8976: margin-left: -1px;
8977: }
8978:
1.843 bisitz 8979: ul.LC_funclist li {
1.915 droeschl 8980: display: inline;
1.782 bisitz 8981: white-space: nowrap;
1.915 droeschl 8982: margin: 0 0 0 25px;
8983: line-height: 150%;
1.782 bisitz 8984: }
8985:
1.974 wenzelju 8986: .LC_hidden {
8987: display: none;
8988: }
8989:
1.1030 www 8990: .LCmodal-overlay {
8991: position:fixed;
8992: top:0;
8993: right:0;
8994: bottom:0;
8995: left:0;
8996: height:100%;
8997: width:100%;
8998: margin:0;
8999: padding:0;
9000: background:#999;
9001: opacity:.75;
9002: filter: alpha(opacity=75);
9003: -moz-opacity: 0.75;
9004: z-index:101;
9005: }
9006:
9007: * html .LCmodal-overlay {
9008: position: absolute;
9009: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
9010: }
9011:
9012: .LCmodal-window {
9013: position:fixed;
9014: top:50%;
9015: left:50%;
9016: margin:0;
9017: padding:0;
9018: z-index:102;
9019: }
9020:
9021: * html .LCmodal-window {
9022: position:absolute;
9023: }
9024:
9025: .LCclose-window {
9026: position:absolute;
9027: width:32px;
9028: height:32px;
9029: right:8px;
9030: top:8px;
9031: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
9032: text-indent:-99999px;
9033: overflow:hidden;
9034: cursor:pointer;
9035: }
9036:
1.1369 raeburn 9037: .LCisDisabled {
9038: cursor: not-allowed;
9039: opacity: 0.5;
9040: }
9041:
9042: a[aria-disabled="true"] {
9043: color: currentColor;
9044: display: inline-block; /* For IE11/ MS Edge bug */
9045: pointer-events: none;
9046: text-decoration: none;
9047: }
9048:
1.1335 raeburn 9049: pre.LC_wordwrap {
9050: white-space: pre-wrap;
9051: white-space: -moz-pre-wrap;
9052: white-space: -pre-wrap;
9053: white-space: -o-pre-wrap;
9054: word-wrap: break-word;
9055: }
9056:
1.1100 raeburn 9057: /*
1.1231 damieng 9058: styles used for response display
9059: */
9060: div.LC_radiofoil, div.LC_rankfoil {
9061: margin: .5em 0em .5em 0em;
9062: }
9063: table.LC_itemgroup {
9064: margin-top: 1em;
9065: }
9066:
9067: /*
1.1100 raeburn 9068: styles used by TTH when "Default set of options to pass to tth/m
9069: when converting TeX" in course settings has been set
9070:
9071: option passed: -t
9072:
9073: */
9074:
9075: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
9076: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
9077: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
9078: td div.norm {line-height:normal;}
9079:
9080: /*
9081: option passed -y3
9082: */
9083:
9084: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
9085: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
9086: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
9087:
1.1230 damieng 9088: /*
9089: sections with roles, for content only
9090: */
9091: section[class^="role-"] {
9092: padding-left: 10px;
9093: padding-right: 5px;
9094: margin-top: 8px;
9095: margin-bottom: 8px;
9096: border: 1px solid #2A4;
9097: border-radius: 5px;
9098: box-shadow: 0px 1px 1px #BBB;
9099: }
9100: section[class^="role-"]>h1 {
9101: position: relative;
9102: margin: 0px;
9103: padding-top: 10px;
9104: padding-left: 40px;
9105: }
9106: section[class^="role-"]>h1:before {
9107: position: absolute;
9108: left: -5px;
9109: top: 5px;
9110: }
9111: section.role-activity>h1:before {
9112: content:url('/adm/daxe/images/section_icons/activity.png');
9113: }
9114: section.role-advice>h1:before {
9115: content:url('/adm/daxe/images/section_icons/advice.png');
9116: }
9117: section.role-bibliography>h1:before {
9118: content:url('/adm/daxe/images/section_icons/bibliography.png');
9119: }
9120: section.role-citation>h1:before {
9121: content:url('/adm/daxe/images/section_icons/citation.png');
9122: }
9123: section.role-conclusion>h1:before {
9124: content:url('/adm/daxe/images/section_icons/conclusion.png');
9125: }
9126: section.role-definition>h1:before {
9127: content:url('/adm/daxe/images/section_icons/definition.png');
9128: }
9129: section.role-demonstration>h1:before {
9130: content:url('/adm/daxe/images/section_icons/demonstration.png');
9131: }
9132: section.role-example>h1:before {
9133: content:url('/adm/daxe/images/section_icons/example.png');
9134: }
9135: section.role-explanation>h1:before {
9136: content:url('/adm/daxe/images/section_icons/explanation.png');
9137: }
9138: section.role-introduction>h1:before {
9139: content:url('/adm/daxe/images/section_icons/introduction.png');
9140: }
9141: section.role-method>h1:before {
9142: content:url('/adm/daxe/images/section_icons/method.png');
9143: }
9144: section.role-more_information>h1:before {
9145: content:url('/adm/daxe/images/section_icons/more_information.png');
9146: }
9147: section.role-objectives>h1:before {
9148: content:url('/adm/daxe/images/section_icons/objectives.png');
9149: }
9150: section.role-prerequisites>h1:before {
9151: content:url('/adm/daxe/images/section_icons/prerequisites.png');
9152: }
9153: section.role-remark>h1:before {
9154: content:url('/adm/daxe/images/section_icons/remark.png');
9155: }
9156: section.role-reminder>h1:before {
9157: content:url('/adm/daxe/images/section_icons/reminder.png');
9158: }
9159: section.role-summary>h1:before {
9160: content:url('/adm/daxe/images/section_icons/summary.png');
9161: }
9162: section.role-syntax>h1:before {
9163: content:url('/adm/daxe/images/section_icons/syntax.png');
9164: }
9165: section.role-warning>h1:before {
9166: content:url('/adm/daxe/images/section_icons/warning.png');
9167: }
9168:
1.1269 raeburn 9169: #LC_minitab_header {
9170: float:left;
9171: width:100%;
9172: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
9173: font-size:93%;
9174: line-height:normal;
9175: margin: 0.5em 0 0.5em 0;
9176: }
9177: #LC_minitab_header ul {
9178: margin:0;
9179: padding:10px 10px 0;
9180: list-style:none;
9181: }
9182: #LC_minitab_header li {
9183: float:left;
9184: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
9185: margin:0;
9186: padding:0 0 0 9px;
9187: }
9188: #LC_minitab_header a {
9189: display:block;
9190: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
9191: padding:5px 15px 4px 6px;
9192: }
9193: #LC_minitab_header #LC_current_minitab {
9194: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
9195: }
9196: #LC_minitab_header #LC_current_minitab a {
9197: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
9198: padding-bottom:5px;
9199: }
9200:
9201:
1.343 albertel 9202: END
9203: }
9204:
1.306 albertel 9205: =pod
9206:
9207: =item * &headtag()
9208:
9209: Returns a uniform footer for LON-CAPA web pages.
9210:
1.307 albertel 9211: Inputs: $title - optional title for the head
9212: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 9213: $args - optional arguments
1.319 albertel 9214: force_register - if is true call registerurl so the remote is
9215: informed
1.415 albertel 9216: redirect -> array ref of
9217: 1- seconds before redirect occurs
9218: 2- url to redirect to
9219: 3- whether the side effect should occur
1.315 albertel 9220: (side effect of setting
9221: $env{'internal.head.redirect'} to the url
1.1386 raeburn 9222: redirected to)
9223: 4- whether the redirect target should be
9224: the opener of the current (pop-up)
9225: window (side effect of setting
9226: $env{'internal.head.to_opener'} to
9227: 1, if true.
1.1388 raeburn 9228: 5- whether encrypt check should be skipped
1.352 albertel 9229: domain -> force to color decorate a page for a specific
9230: domain
9231: function -> force usage of a specific rolish color scheme
9232: bgcolor -> override the default page bgcolor
1.460 albertel 9233: no_auto_mt_title
9234: -> prevent &mt()ing the title arg
1.464 albertel 9235:
1.306 albertel 9236: =cut
9237:
9238: sub headtag {
1.313 albertel 9239: my ($title,$head_extra,$args) = @_;
1.306 albertel 9240:
1.363 albertel 9241: my $function = $args->{'function'} || &get_users_function();
9242: my $domain = $args->{'domain'} || &determinedomain();
9243: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 9244: my $httphost = $args->{'use_absolute'};
1.418 albertel 9245: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 9246: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 9247: #time(),
1.418 albertel 9248: $env{'environment.color.timestamp'},
1.363 albertel 9249: $function,$domain,$bgcolor);
9250:
1.369 www 9251: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 9252:
1.308 albertel 9253: my $result =
9254: '<head>'.
1.1160 raeburn 9255: &font_settings($args);
1.319 albertel 9256:
1.1188 raeburn 9257: my $inhibitprint;
9258: if ($args->{'print_suppress'}) {
9259: $inhibitprint = &print_suppression();
9260: }
1.1064 raeburn 9261:
1.461 albertel 9262: if (!$args->{'frameset'}) {
9263: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
9264: }
1.962 droeschl 9265: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
9266: $result .= Apache::lonxml::display_title();
1.319 albertel 9267: }
1.436 albertel 9268: if (!$args->{'no_nav_bar'}
9269: && !$args->{'only_body'}
9270: && !$args->{'frameset'}) {
1.1154 raeburn 9271: $result .= &help_menu_js($httphost);
1.1032 www 9272: $result.=&modal_window();
1.1038 www 9273: $result.=&togglebox_script();
1.1034 www 9274: $result.=&wishlist_window();
1.1041 www 9275: $result.=&LCprogressbarUpdate_script();
1.1034 www 9276: } else {
9277: if ($args->{'add_modal'}) {
9278: $result.=&modal_window();
9279: }
9280: if ($args->{'add_wishlist'}) {
9281: $result.=&wishlist_window();
9282: }
1.1038 www 9283: if ($args->{'add_togglebox'}) {
9284: $result.=&togglebox_script();
9285: }
1.1041 www 9286: if ($args->{'add_progressbar'}) {
9287: $result.=&LCprogressbarUpdate_script();
9288: }
1.436 albertel 9289: }
1.314 albertel 9290: if (ref($args->{'redirect'})) {
1.1388 raeburn 9291: my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
9292: if (!$skip_enc_check) {
9293: $url = &Apache::lonenc::check_encrypt($url);
9294: }
1.414 albertel 9295: if (!$inhibit_continue) {
9296: $env{'internal.head.redirect'} = $url;
9297: }
1.1386 raeburn 9298: $result.=<<"ADDMETA";
1.313 albertel 9299: <meta http-equiv="pragma" content="no-cache" />
1.1386 raeburn 9300: ADDMETA
9301: if ($to_opener) {
9302: $env{'internal.head.to_opener'} = 1;
9303: my $dest = &js_escape($url);
9304: my $timeout = int($time * 1000);
9305: $result .=<<"ENDJS";
9306: <script type="text/javascript">
9307: // <![CDATA[
9308: function LC_To_Opener() {
9309: var dest = '$dest';
9310: if (dest != '') {
9311: if (window.opener != null && !window.opener.closed) {
9312: window.opener.location.href=dest;
9313: window.close();
9314: } else {
9315: window.location.href=dest;
9316: }
9317: }
9318: }
9319: \$(document).ready(function () {
9320: setTimeout('LC_To_Opener()',$timeout);
9321: });
9322: // ]]>
9323: </script>
9324: ENDJS
9325: } else {
9326: $result.=<<"ADDMETA";
1.344 albertel 9327: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 9328: ADDMETA
1.1386 raeburn 9329: }
1.1210 raeburn 9330: } else {
9331: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
9332: my $requrl = $env{'request.uri'};
9333: if ($requrl eq '') {
9334: $requrl = $ENV{'REQUEST_URI'};
9335: $requrl =~ s/\?.+$//;
9336: }
9337: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
9338: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
9339: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
9340: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
9341: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
9342: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 9343: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 9344: my ($offload,$offloadoth);
1.1210 raeburn 9345: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
9346: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 9347: $offload = 1;
1.1353 raeburn 9348: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9349: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9350: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9351: $offloadoth = 1;
9352: $dom_in_use = $env{'user.domain'};
9353: }
9354: }
1.1340 raeburn 9355: }
9356: }
9357: unless ($offload) {
9358: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
9359: if ($domdefs{'offloadoth'}{$lonhost}) {
9360: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9361: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9362: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9363: $offload = 1;
1.1352 raeburn 9364: $offloadoth = 1;
1.1340 raeburn 9365: $dom_in_use = $env{'user.domain'};
9366: }
1.1210 raeburn 9367: }
1.1340 raeburn 9368: }
9369: }
9370: }
9371: if ($offload) {
1.1358 raeburn 9372: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 9373: if (($newserver eq '') && ($offloadoth)) {
9374: my @domains = &Apache::lonnet::current_machine_domains();
9375: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
9376: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
9377: }
9378: }
1.1340 raeburn 9379: if (($newserver) && ($newserver ne $lonhost)) {
9380: my $numsec = 5;
9381: my $timeout = $numsec * 1000;
9382: my ($newurl,$locknum,%locks,$msg);
9383: if ($env{'request.role.adv'}) {
9384: ($locknum,%locks) = &Apache::lonnet::get_locks();
9385: }
9386: my $disable_submit = 0;
9387: if ($requrl =~ /$LONCAPA::assess_re/) {
9388: $disable_submit = 1;
9389: }
9390: if ($locknum) {
9391: my @lockinfo = sort(values(%locks));
1.1354 raeburn 9392: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 9393: join(", ",sort(values(%locks)))."\n";
9394: if (&show_course()) {
9395: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
9396: } else {
9397: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 9398: }
1.1340 raeburn 9399: } else {
9400: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
9401: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
9402: }
9403: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
9404: $newurl = '/adm/switchserver?otherserver='.$newserver;
9405: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
9406: $newurl .= '&role='.$env{'request.role'};
9407: }
9408: if ($env{'request.symb'}) {
9409: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
9410: if ($shownsymb =~ m{^/enc/}) {
9411: my $reqdmajor = 2;
9412: my $reqdminor = 11;
9413: my $reqdsubminor = 3;
9414: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
9415: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
9416: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
9417: if (($major eq '' && $minor eq '') ||
9418: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
9419: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
9420: ($reqdsubminor > $subminor))))) {
9421: undef($shownsymb);
9422: }
1.1210 raeburn 9423: }
1.1340 raeburn 9424: if ($shownsymb) {
9425: &js_escape(\$shownsymb);
9426: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 9427: }
1.1340 raeburn 9428: } else {
9429: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
9430: &js_escape(\$shownurl);
9431: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 9432: }
1.1340 raeburn 9433: }
9434: &js_escape(\$msg);
9435: $result.=<<OFFLOAD
1.1210 raeburn 9436: <meta http-equiv="pragma" content="no-cache" />
9437: <script type="text/javascript">
1.1215 raeburn 9438: // <![CDATA[
1.1210 raeburn 9439: function LC_Offload_Now() {
9440: var dest = "$newurl";
9441: if (dest != '') {
9442: window.location.href="$newurl";
9443: }
9444: }
1.1214 raeburn 9445: \$(document).ready(function () {
9446: window.alert('$msg');
9447: if ($disable_submit) {
1.1210 raeburn 9448: \$(".LC_hwk_submit").prop("disabled", true);
9449: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9450: }
9451: setTimeout('LC_Offload_Now()', $timeout);
9452: });
1.1215 raeburn 9453: // ]]>
1.1210 raeburn 9454: </script>
9455: OFFLOAD
9456: }
9457: }
9458: }
9459: }
9460: }
1.313 albertel 9461: }
1.306 albertel 9462: if (!defined($title)) {
9463: $title = 'The LearningOnline Network with CAPA';
9464: }
1.460 albertel 9465: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
9466: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 9467: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
9468: if (!$args->{'frameset'}) {
9469: $result .= ' /';
9470: }
9471: $result .= '>'
1.1064 raeburn 9472: .$inhibitprint
1.414 albertel 9473: .$head_extra;
1.1242 raeburn 9474: my $clientmobile;
9475: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9476: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9477: } else {
9478: $clientmobile = $env{'browser.mobile'};
9479: }
9480: if ($clientmobile) {
1.1137 raeburn 9481: $result .= '
9482: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9483: <meta name="apple-mobile-web-app-capable" content="yes" />';
9484: }
1.1278 raeburn 9485: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9486: return $result.'</head>';
1.306 albertel 9487: }
9488:
9489: =pod
9490:
1.340 albertel 9491: =item * &font_settings()
9492:
9493: Returns neccessary <meta> to set the proper encoding
9494:
1.1160 raeburn 9495: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9496:
9497: =cut
9498:
9499: sub font_settings {
1.1160 raeburn 9500: my ($args) = @_;
1.340 albertel 9501: my $headerstring='';
1.1160 raeburn 9502: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9503: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9504: $headerstring.=
9505: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9506: if (!$args->{'frameset'}) {
9507: $headerstring.= ' /';
9508: }
9509: $headerstring .= '>'."\n";
1.340 albertel 9510: }
9511: return $headerstring;
9512: }
9513:
1.341 albertel 9514: =pod
9515:
1.1064 raeburn 9516: =item * &print_suppression()
9517:
9518: In course context returns css which causes the body to be blank when media="print",
9519: if printout generation is unavailable for the current resource.
9520:
9521: This could be because:
9522:
9523: (a) printstartdate is in the future
9524:
9525: (b) printenddate is in the past
9526:
9527: (c) there is an active exam block with "printout"
9528: functionality blocked
9529:
9530: Users with pav, pfo or evb privileges are exempt.
9531:
9532: Inputs: none
9533:
9534: =cut
9535:
9536:
9537: sub print_suppression {
9538: my $noprint;
9539: if ($env{'request.course.id'}) {
9540: my $scope = $env{'request.course.id'};
9541: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9542: (&Apache::lonnet::allowed('pfo',$scope))) {
9543: return;
9544: }
9545: if ($env{'request.course.sec'} ne '') {
9546: $scope .= "/$env{'request.course.sec'}";
9547: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9548: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9549: return;
1.1064 raeburn 9550: }
9551: }
9552: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9553: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9554: my $clientip = &Apache::lonnet::get_requestor_ip();
9555: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9556: if ($blocked) {
9557: my $checkrole = "cm./$cdom/$cnum";
9558: if ($env{'request.course.sec'} ne '') {
9559: $checkrole .= "/$env{'request.course.sec'}";
9560: }
9561: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9562: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9563: $noprint = 1;
9564: }
9565: }
9566: unless ($noprint) {
9567: my $symb = &Apache::lonnet::symbread();
9568: if ($symb ne '') {
9569: my $navmap = Apache::lonnavmaps::navmap->new();
9570: if (ref($navmap)) {
9571: my $res = $navmap->getBySymb($symb);
9572: if (ref($res)) {
9573: if (!$res->resprintable()) {
9574: $noprint = 1;
9575: }
9576: }
9577: }
9578: }
9579: }
9580: if ($noprint) {
9581: return <<"ENDSTYLE";
9582: <style type="text/css" media="print">
9583: body { display:none }
9584: </style>
9585: ENDSTYLE
9586: }
9587: }
9588: return;
9589: }
9590:
9591: =pod
9592:
1.341 albertel 9593: =item * &xml_begin()
9594:
9595: Returns the needed doctype and <html>
9596:
9597: Inputs: none
9598:
9599: =cut
9600:
9601: sub xml_begin {
1.1168 raeburn 9602: my ($is_frameset) = @_;
1.341 albertel 9603: my $output='';
9604:
9605: if ($env{'browser.mathml'}) {
9606: $output='<?xml version="1.0"?>'
9607: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9608: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9609:
9610: # .'<!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">] >'
9611: .'<!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">'
9612: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9613: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9614: } elsif ($is_frameset) {
9615: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9616: '<html>'."\n";
1.341 albertel 9617: } else {
1.1168 raeburn 9618: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9619: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9620: }
9621: return $output;
9622: }
1.340 albertel 9623:
9624: =pod
9625:
1.306 albertel 9626: =item * &start_page()
9627:
9628: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9629:
1.648 raeburn 9630: Inputs:
9631:
9632: =over 4
9633:
9634: $title - optional title for the page
9635:
9636: $head_extra - optional extra HTML to incude inside the <head>
9637:
9638: $args - additional optional args supported are:
9639:
9640: =over 8
9641:
9642: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9643: arg on
1.814 bisitz 9644: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9645: add_entries -> additional attributes to add to the <body>
9646: domain -> force to color decorate a page for a
1.317 albertel 9647: specific domain
1.648 raeburn 9648: function -> force usage of a specific rolish color
1.317 albertel 9649: scheme
1.648 raeburn 9650: redirect -> see &headtag()
9651: bgcolor -> override the default page bg color
9652: js_ready -> return a string ready for being used in
1.317 albertel 9653: a javascript writeln
1.648 raeburn 9654: html_encode -> return a string ready for being used in
1.320 albertel 9655: a html attribute
1.648 raeburn 9656: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9657: $forcereg arg
1.648 raeburn 9658: frameset -> if true will start with a <frameset>
1.330 albertel 9659: rather than <body>
1.648 raeburn 9660: skip_phases -> hash ref of
1.338 albertel 9661: head -> skip the <html><head> generation
9662: body -> skip all <body> generation
1.648 raeburn 9663: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9664: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9665: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 9666: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9667: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9668: group -> includes the current group, if page is for a
1.1274 raeburn 9669: specific group
9670: use_absolute -> for request for external resource or syllabus, this
9671: will contain https://<hostname> if server uses
9672: https (as per hosts.tab), but request is for http
9673: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9674: links_disabled -> Links in primary and secondary menus are disabled
9675: (Can enable them once page has loaded - see lonroles.pm
9676: for an example).
1.1380 raeburn 9677: links_target -> Target for links, e.g., _parent (optional).
1.361 albertel 9678:
1.648 raeburn 9679: =back
1.460 albertel 9680:
1.648 raeburn 9681: =back
1.562 albertel 9682:
1.306 albertel 9683: =cut
9684:
9685: sub start_page {
1.309 albertel 9686: my ($title,$head_extra,$args) = @_;
1.318 albertel 9687: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9688:
1.315 albertel 9689: $env{'internal.start_page'}++;
1.1359 raeburn 9690: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9691:
1.338 albertel 9692: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9693: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9694: }
1.1316 raeburn 9695:
9696: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9697: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9698: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9699: $args->{'no_primary_menu'} = 1;
9700: }
9701: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9702: $args->{'no_inline_menu'} = 1;
9703: }
9704: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9705: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9706: }
9707: } else {
9708: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9709: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9710: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9711: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9712: $args->{'no_primary_menu'} = 1;
9713: }
9714: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9715: $args->{'no_inline_menu'} = 1;
9716: }
9717: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9718: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9719: }
9720: }
9721: }
1.1316 raeburn 9722: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9723: $env{'course.'.$env{'request.course.id'}.'.domain'},
9724: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9725: } elsif ($env{'request.course.id'}) {
9726: my $expiretime=600;
9727: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9728: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9729: }
9730: my ($deeplinkmenu,$menuref);
9731: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9732: if ($menucoll) {
9733: if (ref($menuref) eq 'HASH') {
9734: %menu = %{$menuref};
9735: }
9736: if ($menu{'top'} eq 'n') {
9737: $args->{'no_primary_menu'} = 1;
9738: }
9739: if ($menu{'inline'} eq 'n') {
9740: unless (&Apache::lonnet::allowed('opa')) {
9741: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9742: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9743: my $crstype = &course_type();
9744: my $now = time;
9745: my $ccrole;
9746: if ($crstype eq 'Community') {
9747: $ccrole = 'co';
9748: } else {
9749: $ccrole = 'cc';
9750: }
9751: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9752: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9753: if ((($start) && ($start<0)) ||
9754: (($end) && ($end<$now)) ||
9755: (($start) && ($now<$start))) {
9756: $args->{'no_inline_menu'} = 1;
9757: }
9758: } else {
9759: $args->{'no_inline_menu'} = 1;
9760: }
9761: }
9762: }
9763: }
1.1316 raeburn 9764: }
1.1359 raeburn 9765:
1.1385 raeburn 9766: my $showncrumbs;
1.338 albertel 9767: if (! exists($args->{'skip_phases'}{'body'}) ) {
9768: if ($args->{'frameset'}) {
9769: my $attr_string = &make_attr_string($args->{'force_register'},
9770: $args->{'add_entries'});
9771: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9772: } else {
9773: $result .=
9774: &bodytag($title,
9775: $args->{'function'}, $args->{'add_entries'},
9776: $args->{'only_body'}, $args->{'domain'},
9777: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 9778: $args->{'bgcolor'}, $args,
1.1385 raeburn 9779: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
9780: \%menu,\$showncrumbs);
1.831 bisitz 9781: }
1.330 albertel 9782: }
1.338 albertel 9783:
1.315 albertel 9784: if ($args->{'js_ready'}) {
1.713 kaisler 9785: $result = &js_ready($result);
1.315 albertel 9786: }
1.320 albertel 9787: if ($args->{'html_encode'}) {
1.713 kaisler 9788: $result = &html_encode($result);
9789: }
9790:
1.813 bisitz 9791: # Preparation for new and consistent functionlist at top of screen
9792: # if ($args->{'functionlist'}) {
9793: # $result .= &build_functionlist();
9794: #}
9795:
1.964 droeschl 9796: # Don't add anything more if only_body wanted or in const space
9797: return $result if $args->{'only_body'}
9798: || $env{'request.state'} eq 'construct';
1.813 bisitz 9799:
9800: #Breadcrumbs
1.758 kaisler 9801: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385 raeburn 9802: unless ($showncrumbs) {
1.758 kaisler 9803: &Apache::lonhtmlcommon::clear_breadcrumbs();
9804: #if any br links exists, add them to the breadcrumbs
9805: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9806: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9807: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9808: }
9809: }
1.1096 raeburn 9810: # if @advtools array contains items add then to the breadcrumbs
9811: if (@advtools > 0) {
9812: &Apache::lonmenu::advtools_crumbs(@advtools);
9813: }
1.1272 raeburn 9814: my $menulink;
9815: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
9816: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 9817: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 9818: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
9819: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
9820: (!$env{'request.role.adv'}))) {
9821: $menulink = 0;
9822: } else {
9823: undef($menulink);
9824: }
1.1385 raeburn 9825: my $linkprotout;
9826: if ($env{'request.deeplink.login'}) {
9827: my $linkprotout = &Apache::lonmenu::linkprot_exit();
9828: if ($linkprotout) {
9829: &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
9830: }
9831: }
1.758 kaisler 9832: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9833: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 9834: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 9835: } else {
1.1272 raeburn 9836: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 9837: }
1.1385 raeburn 9838: }
1.320 albertel 9839: }
1.315 albertel 9840: return $result;
1.306 albertel 9841: }
9842:
9843: sub end_page {
1.315 albertel 9844: my ($args) = @_;
9845: $env{'internal.end_page'}++;
1.330 albertel 9846: my $result;
1.335 albertel 9847: if ($args->{'discussion'}) {
9848: my ($target,$parser);
9849: if (ref($args->{'discussion'})) {
9850: ($target,$parser) =($args->{'discussion'}{'target'},
9851: $args->{'discussion'}{'parser'});
9852: }
9853: $result .= &Apache::lonxml::xmlend($target,$parser);
9854: }
1.330 albertel 9855: if ($args->{'frameset'}) {
9856: $result .= '</frameset>';
9857: } else {
1.635 raeburn 9858: $result .= &endbodytag($args);
1.330 albertel 9859: }
1.1080 raeburn 9860: unless ($args->{'notbody'}) {
9861: $result .= "\n</html>";
9862: }
1.330 albertel 9863:
1.315 albertel 9864: if ($args->{'js_ready'}) {
1.317 albertel 9865: $result = &js_ready($result);
1.315 albertel 9866: }
1.335 albertel 9867:
1.320 albertel 9868: if ($args->{'html_encode'}) {
9869: $result = &html_encode($result);
9870: }
1.335 albertel 9871:
1.315 albertel 9872: return $result;
9873: }
9874:
1.1359 raeburn 9875: sub menucoll_in_effect {
9876: my ($menucoll,$deeplinkmenu,%menu);
9877: if ($env{'request.course.id'}) {
9878: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 9879: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 9880: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 9881: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9882: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9883: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9884: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9885: my $navmap = Apache::lonnavmaps::navmap->new();
9886: if (ref($navmap)) {
9887: $deeplink = $navmap->get_mapparam(undef,
9888: &Apache::lonnet::declutter($env{'request.noversionuri'}),
9889: '0.deeplink');
1.1370 raeburn 9890: } else {
9891: $check_login_symb = 1;
1.1362 raeburn 9892: }
9893: } else {
1.1370 raeburn 9894: my $symb = &Apache::lonnet::symbread();
9895: if ($symb) {
9896: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9897: } else {
9898: $check_login_symb = 1;
9899: }
1.1362 raeburn 9900: }
9901: } else {
1.1370 raeburn 9902: $check_login_symb = 1;
9903: }
9904: if ($check_login_symb) {
1.1362 raeburn 9905: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9906: if ($deeplink_symb =~ /\.(page|sequence)$/) {
9907: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9908: my $navmap = Apache::lonnavmaps::navmap->new();
9909: if (ref($navmap)) {
9910: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9911: }
9912: } else {
9913: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9914: }
9915: }
1.1359 raeburn 9916: if ($deeplink ne '') {
1.1378 raeburn 9917: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 9918: if ($display =~ /^\d+$/) {
9919: $deeplinkmenu = 1;
9920: $menucoll = $display;
9921: }
9922: }
9923: }
9924: if ($menucoll) {
9925: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9926: }
9927: }
9928: return ($menucoll,$deeplinkmenu,\%menu);
9929: }
9930:
1.1362 raeburn 9931: sub deeplink_login_symb {
9932: my ($cnum,$cdom) = @_;
9933: my $login_symb;
9934: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 9935: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9936: }
9937: return $login_symb;
9938: }
9939:
9940: sub symb_from_tinyurl {
9941: my ($url,$cnum,$cdom) = @_;
9942: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9943: my $key = $1;
9944: my ($tinyurl,$login);
9945: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9946: if (defined($cached)) {
9947: $tinyurl = $result;
9948: } else {
9949: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9950: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9951: if ($currtiny{$key} ne '') {
9952: $tinyurl = $currtiny{$key};
9953: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 9954: }
1.1364 raeburn 9955: }
9956: if ($tinyurl ne '') {
9957: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9958: if (wantarray) {
9959: return ($cnumreq,$symb);
9960: } elsif ($cnumreq eq $cnum) {
9961: return $symb;
1.1362 raeburn 9962: }
9963: }
9964: }
1.1364 raeburn 9965: if (wantarray) {
9966: return ();
9967: } else {
9968: return;
9969: }
1.1362 raeburn 9970: }
9971:
1.1405 raeburn 9972: sub usable_exttools {
9973: my %tooltypes;
9974: if ($env{'request.course.id'}) {
9975: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
9976: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
9977: %tooltypes = (
9978: crs => 1,
9979: dom => 1,
9980: );
9981: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
9982: $tooltypes{'crs'} = 1;
9983: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
9984: $tooltypes{'dom'} = 1;
9985: }
9986: } else {
9987: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9988: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9989: my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
9990: if ($crstype eq '') {
9991: $crstype = 'course';
9992: }
9993: if ($crstype eq 'course') {
9994: if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
9995: $crstype = 'official';
9996: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
9997: $crstype = 'textbook';
9998: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
9999: $crstype = 'lti';
10000: } else {
10001: $crstype = 'unofficial';
10002: }
10003: }
10004: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
10005: if ($domdefaults{$crstype.'domexttool'}) {
10006: $tooltypes{'dom'} = 1;
10007: }
10008: if ($domdefaults{$crstype.'exttool'}) {
10009: $tooltypes{'crs'} = 1;
10010: }
10011: }
10012: }
10013: return %tooltypes;
10014: }
10015:
1.1034 www 10016: sub wishlist_window {
10017: return(<<'ENDWISHLIST');
1.1046 raeburn 10018: <script type="text/javascript">
1.1034 www 10019: // <![CDATA[
10020: // <!-- BEGIN LON-CAPA Internal
10021: function set_wishlistlink(title, path) {
10022: if (!title) {
10023: title = document.title;
10024: title = title.replace(/^LON-CAPA /,'');
10025: }
1.1175 raeburn 10026: title = encodeURIComponent(title);
1.1203 raeburn 10027: title = title.replace("'","\\\'");
1.1034 www 10028: if (!path) {
10029: path = location.pathname;
10030: }
1.1175 raeburn 10031: path = encodeURIComponent(path);
1.1203 raeburn 10032: path = path.replace("'","\\\'");
1.1034 www 10033: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
10034: 'wishlistNewLink','width=560,height=350,scrollbars=0');
10035: }
10036: // END LON-CAPA Internal -->
10037: // ]]>
10038: </script>
10039: ENDWISHLIST
10040: }
10041:
1.1030 www 10042: sub modal_window {
10043: return(<<'ENDMODAL');
1.1046 raeburn 10044: <script type="text/javascript">
1.1030 www 10045: // <![CDATA[
10046: // <!-- BEGIN LON-CAPA Internal
10047: var modalWindow = {
10048: parent:"body",
10049: windowId:null,
10050: content:null,
10051: width:null,
10052: height:null,
10053: close:function()
10054: {
10055: $(".LCmodal-window").remove();
10056: $(".LCmodal-overlay").remove();
10057: },
10058: open:function()
10059: {
10060: var modal = "";
10061: modal += "<div class=\"LCmodal-overlay\"></div>";
10062: 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;\">";
10063: modal += this.content;
10064: modal += "</div>";
10065:
10066: $(this.parent).append(modal);
10067:
10068: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
10069: $(".LCclose-window").click(function(){modalWindow.close();});
10070: $(".LCmodal-overlay").click(function(){modalWindow.close();});
10071: }
10072: };
1.1140 raeburn 10073: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 10074: {
1.1266 raeburn 10075: source = source.replace(/'/g,"'");
1.1030 www 10076: modalWindow.windowId = "myModal";
10077: modalWindow.width = width;
10078: modalWindow.height = height;
1.1196 raeburn 10079: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 10080: modalWindow.open();
1.1208 raeburn 10081: };
1.1030 www 10082: // END LON-CAPA Internal -->
10083: // ]]>
10084: </script>
10085: ENDMODAL
10086: }
10087:
10088: sub modal_link {
1.1140 raeburn 10089: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 10090: unless ($width) { $width=480; }
10091: unless ($height) { $height=400; }
1.1031 www 10092: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 10093: unless ($transparency) { $transparency='true'; }
10094:
1.1074 raeburn 10095: my $target_attr;
10096: if (defined($target)) {
10097: $target_attr = 'target="'.$target.'"';
10098: }
10099: return <<"ENDLINK";
1.1336 raeburn 10100: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 10101: ENDLINK
1.1030 www 10102: }
10103:
1.1032 www 10104: sub modal_adhoc_script {
1.1365 raeburn 10105: my ($funcname,$width,$height,$content,$possmathjax)=@_;
10106: my $mathjax;
10107: if ($possmathjax) {
10108: $mathjax = <<'ENDJAX';
10109: if (typeof MathJax == 'object') {
10110: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
10111: }
10112: ENDJAX
10113: }
1.1032 www 10114: return (<<ENDADHOC);
1.1046 raeburn 10115: <script type="text/javascript">
1.1032 www 10116: // <![CDATA[
10117: var $funcname = function()
10118: {
10119: modalWindow.windowId = "myModal";
10120: modalWindow.width = $width;
10121: modalWindow.height = $height;
10122: modalWindow.content = '$content';
10123: modalWindow.open();
1.1365 raeburn 10124: $mathjax
1.1032 www 10125: };
10126: // ]]>
10127: </script>
10128: ENDADHOC
10129: }
10130:
1.1041 www 10131: sub modal_adhoc_inner {
1.1365 raeburn 10132: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 10133: my $innerwidth=$width-20;
10134: $content=&js_ready(
1.1140 raeburn 10135: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
10136: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
10137: $content.
1.1041 www 10138: &end_scrollbox().
1.1140 raeburn 10139: &end_page()
1.1041 www 10140: );
1.1365 raeburn 10141: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 10142: }
10143:
10144: sub modal_adhoc_window {
1.1365 raeburn 10145: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
10146: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 10147: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
10148: }
10149:
10150: sub modal_adhoc_launch {
10151: my ($funcname,$width,$height,$content)=@_;
10152: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
10153: <script type="text/javascript">
10154: // <![CDATA[
10155: $funcname();
10156: // ]]>
10157: </script>
10158: ENDLAUNCH
10159: }
10160:
10161: sub modal_adhoc_close {
10162: return (<<ENDCLOSE);
10163: <script type="text/javascript">
10164: // <![CDATA[
10165: modalWindow.close();
10166: // ]]>
10167: </script>
10168: ENDCLOSE
10169: }
10170:
1.1038 www 10171: sub togglebox_script {
10172: return(<<ENDTOGGLE);
10173: <script type="text/javascript">
10174: // <![CDATA[
10175: function LCtoggleDisplay(id,hidetext,showtext) {
10176: link = document.getElementById(id + "link").childNodes[0];
10177: with (document.getElementById(id).style) {
10178: if (display == "none" ) {
10179: display = "inline";
10180: link.nodeValue = hidetext;
10181: } else {
10182: display = "none";
10183: link.nodeValue = showtext;
10184: }
10185: }
10186: }
10187: // ]]>
10188: </script>
10189: ENDTOGGLE
10190: }
10191:
1.1039 www 10192: sub start_togglebox {
10193: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
10194: unless ($heading) { $heading=''; } else { $heading.=' '; }
10195: unless ($showtext) { $showtext=&mt('show'); }
10196: unless ($hidetext) { $hidetext=&mt('hide'); }
10197: unless ($headerbg) { $headerbg='#FFFFFF'; }
10198: return &start_data_table().
10199: &start_data_table_header_row().
10200: '<td bgcolor="'.$headerbg.'">'.$heading.
10201: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
10202: $showtext.'\')">'.$showtext.'</a>]</td>'.
10203: &end_data_table_header_row().
10204: '<tr id="'.$id.'" style="display:none""><td>';
10205: }
10206:
10207: sub end_togglebox {
10208: return '</td></tr>'.&end_data_table();
10209: }
10210:
1.1041 www 10211: sub LCprogressbar_script {
1.1302 raeburn 10212: my ($id,$number_to_do)=@_;
10213: if ($number_to_do) {
10214: return(<<ENDPROGRESS);
1.1041 www 10215: <script type="text/javascript">
10216: // <![CDATA[
1.1045 www 10217: \$('#progressbar$id').progressbar({
1.1041 www 10218: value: 0,
10219: change: function(event, ui) {
10220: var newVal = \$(this).progressbar('option', 'value');
10221: \$('.pblabel', this).text(LCprogressTxt);
10222: }
10223: });
10224: // ]]>
10225: </script>
10226: ENDPROGRESS
1.1302 raeburn 10227: } else {
10228: return(<<ENDPROGRESS);
10229: <script type="text/javascript">
10230: // <![CDATA[
10231: \$('#progressbar$id').progressbar({
10232: value: false,
10233: create: function(event, ui) {
10234: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
10235: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
10236: }
10237: });
10238: // ]]>
10239: </script>
10240: ENDPROGRESS
10241: }
1.1041 www 10242: }
10243:
10244: sub LCprogressbarUpdate_script {
10245: return(<<ENDPROGRESSUPDATE);
10246: <style type="text/css">
10247: .ui-progressbar { position:relative; }
1.1302 raeburn 10248: .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 10249: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
10250: </style>
10251: <script type="text/javascript">
10252: // <![CDATA[
1.1045 www 10253: var LCprogressTxt='---';
10254:
1.1302 raeburn 10255: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 10256: LCprogressTxt=progresstext;
1.1302 raeburn 10257: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
10258: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
10259: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 10260: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
10261: } else {
10262: \$('#progressbar'+id).progressbar('value',percent);
10263: }
1.1041 www 10264: }
10265: // ]]>
10266: </script>
10267: ENDPROGRESSUPDATE
10268: }
10269:
1.1042 www 10270: my $LClastpercent;
1.1045 www 10271: my $LCidcnt;
10272: my $LCcurrentid;
1.1042 www 10273:
1.1041 www 10274: sub LCprogressbar {
1.1302 raeburn 10275: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 10276: $LClastpercent=0;
1.1045 www 10277: $LCidcnt++;
10278: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 10279: my ($starting,$content);
10280: if ($number_to_do) {
10281: $starting=&mt('Starting');
10282: $content=(<<ENDPROGBAR);
10283: $preamble
1.1045 www 10284: <div id="progressbar$LCcurrentid">
1.1041 www 10285: <span class="pblabel">$starting</span>
10286: </div>
10287: ENDPROGBAR
1.1302 raeburn 10288: } else {
10289: $starting=&mt('Loading...');
10290: $LClastpercent='false';
10291: $content=(<<ENDPROGBAR);
10292: $preamble
10293: <div id="progressbar$LCcurrentid">
10294: <div class="progress-label">$starting</div>
10295: </div>
10296: ENDPROGBAR
10297: }
10298: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 10299: }
10300:
10301: sub LCprogressbarUpdate {
1.1302 raeburn 10302: my ($r,$val,$text,$number_to_do)=@_;
10303: if ($number_to_do) {
10304: unless ($val) {
10305: if ($LClastpercent) {
10306: $val=$LClastpercent;
10307: } else {
10308: $val=0;
10309: }
10310: }
10311: if ($val<0) { $val=0; }
10312: if ($val>100) { $val=0; }
10313: $LClastpercent=$val;
10314: unless ($text) { $text=$val.'%'; }
10315: } else {
10316: $val = 'false';
1.1042 www 10317: }
1.1041 www 10318: $text=&js_ready($text);
1.1044 www 10319: &r_print($r,<<ENDUPDATE);
1.1041 www 10320: <script type="text/javascript">
10321: // <![CDATA[
1.1302 raeburn 10322: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 10323: // ]]>
10324: </script>
10325: ENDUPDATE
1.1035 www 10326: }
10327:
1.1042 www 10328: sub LCprogressbarClose {
10329: my ($r)=@_;
10330: $LClastpercent=0;
1.1044 www 10331: &r_print($r,<<ENDCLOSE);
1.1042 www 10332: <script type="text/javascript">
10333: // <![CDATA[
1.1045 www 10334: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 10335: // ]]>
10336: </script>
10337: ENDCLOSE
1.1044 www 10338: }
10339:
10340: sub r_print {
10341: my ($r,$to_print)=@_;
10342: if ($r) {
10343: $r->print($to_print);
10344: $r->rflush();
10345: } else {
10346: print($to_print);
10347: }
1.1042 www 10348: }
10349:
1.320 albertel 10350: sub html_encode {
10351: my ($result) = @_;
10352:
1.322 albertel 10353: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 10354:
10355: return $result;
10356: }
1.1044 www 10357:
1.317 albertel 10358: sub js_ready {
10359: my ($result) = @_;
10360:
1.323 albertel 10361: $result =~ s/[\n\r]/ /xmsg;
10362: $result =~ s/\\/\\\\/xmsg;
10363: $result =~ s/'/\\'/xmsg;
1.372 albertel 10364: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 10365:
10366: return $result;
10367: }
10368:
1.315 albertel 10369: sub validate_page {
10370: if ( exists($env{'internal.start_page'})
1.316 albertel 10371: && $env{'internal.start_page'} > 1) {
10372: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 10373: $env{'internal.start_page'}.' '.
1.316 albertel 10374: $ENV{'request.filename'});
1.315 albertel 10375: }
10376: if ( exists($env{'internal.end_page'})
1.316 albertel 10377: && $env{'internal.end_page'} > 1) {
10378: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 10379: $env{'internal.end_page'}.' '.
1.316 albertel 10380: $env{'request.filename'});
1.315 albertel 10381: }
10382: if ( exists($env{'internal.start_page'})
10383: && ! exists($env{'internal.end_page'})) {
1.316 albertel 10384: &Apache::lonnet::logthis('start_page called without end_page '.
10385: $env{'request.filename'});
1.315 albertel 10386: }
10387: if ( ! exists($env{'internal.start_page'})
10388: && exists($env{'internal.end_page'})) {
1.316 albertel 10389: &Apache::lonnet::logthis('end_page called without start_page'.
10390: $env{'request.filename'});
1.315 albertel 10391: }
1.306 albertel 10392: }
1.315 albertel 10393:
1.996 www 10394:
10395: sub start_scrollbox {
1.1140 raeburn 10396: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 10397: unless ($outerwidth) { $outerwidth='520px'; }
10398: unless ($width) { $width='500px'; }
10399: unless ($height) { $height='200px'; }
1.1075 raeburn 10400: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 10401: if ($id ne '') {
1.1140 raeburn 10402: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 10403: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 10404: }
1.1075 raeburn 10405: if ($bgcolor ne '') {
10406: $tdcol = "background-color: $bgcolor;";
10407: }
1.1137 raeburn 10408: my $nicescroll_js;
10409: if ($env{'browser.mobile'}) {
1.1140 raeburn 10410: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
10411: }
10412: return <<"END";
10413: $nicescroll_js
10414:
10415: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
10416: <div style="overflow:auto; width:$width; height:$height;"$div_id>
10417: END
10418: }
10419:
10420: sub end_scrollbox {
10421: return '</div></td></tr></table>';
10422: }
10423:
10424: sub nicescroll_javascript {
10425: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
10426: my %options;
10427: if (ref($cursor) eq 'HASH') {
10428: %options = %{$cursor};
10429: }
10430: unless ($options{'railalign'} =~ /^left|right$/) {
10431: $options{'railalign'} = 'left';
10432: }
10433: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10434: my $function = &get_users_function();
10435: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 10436: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 10437: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 10438: }
1.1140 raeburn 10439: }
10440: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
10441: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 10442: $options{'cursoropacity'}='1.0';
10443: }
1.1140 raeburn 10444: } else {
10445: $options{'cursoropacity'}='1.0';
10446: }
10447: if ($options{'cursorfixedheight'} eq 'none') {
10448: delete($options{'cursorfixedheight'});
10449: } else {
10450: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
10451: }
10452: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
10453: delete($options{'railoffset'});
10454: }
10455: my @niceoptions;
10456: while (my($key,$value) = each(%options)) {
10457: if ($value =~ /^\{.+\}$/) {
10458: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 10459: } else {
1.1140 raeburn 10460: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 10461: }
1.1140 raeburn 10462: }
10463: my $nicescroll_js = '
1.1137 raeburn 10464: $(document).ready(
1.1140 raeburn 10465: function() {
10466: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
10467: }
1.1137 raeburn 10468: );
10469: ';
1.1140 raeburn 10470: if ($framecheck) {
10471: $nicescroll_js .= '
10472: function expand_div(caller) {
10473: if (top === self) {
10474: document.getElementById("'.$id.'").style.width = "auto";
10475: document.getElementById("'.$id.'").style.height = "auto";
10476: } else {
10477: try {
10478: if (parent.frames) {
10479: if (parent.frames.length > 1) {
10480: var framesrc = parent.frames[1].location.href;
10481: var currsrc = framesrc.replace(/\#.*$/,"");
10482: if ((caller == "search") || (currsrc == "'.$location.'")) {
10483: document.getElementById("'.$id.'").style.width = "auto";
10484: document.getElementById("'.$id.'").style.height = "auto";
10485: }
10486: }
10487: }
10488: } catch (e) {
10489: return;
10490: }
1.1137 raeburn 10491: }
1.1140 raeburn 10492: return;
1.996 www 10493: }
1.1140 raeburn 10494: ';
10495: }
10496: if ($needjsready) {
10497: $nicescroll_js = '
10498: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10499: } else {
10500: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10501: }
10502: return $nicescroll_js;
1.996 www 10503: }
10504:
1.318 albertel 10505: sub simple_error_page {
1.1150 bisitz 10506: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10507: my %displayargs;
1.1151 raeburn 10508: if (ref($args) eq 'HASH') {
10509: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10510: if ($args->{'only_body'}) {
10511: $displayargs{'only_body'} = 1;
10512: }
10513: if ($args->{'no_nav_bar'}) {
10514: $displayargs{'no_nav_bar'} = 1;
10515: }
1.1151 raeburn 10516: } else {
10517: $msg = &mt($msg);
10518: }
1.1150 bisitz 10519:
1.318 albertel 10520: my $page =
1.1304 raeburn 10521: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10522: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10523: &Apache::loncommon::end_page();
10524: if (ref($r)) {
10525: $r->print($page);
1.327 albertel 10526: return;
1.318 albertel 10527: }
10528: return $page;
10529: }
1.347 albertel 10530:
10531: {
1.610 albertel 10532: my @row_count;
1.961 onken 10533:
10534: sub start_data_table_count {
10535: unshift(@row_count, 0);
10536: return;
10537: }
10538:
10539: sub end_data_table_count {
10540: shift(@row_count);
10541: return;
10542: }
10543:
1.347 albertel 10544: sub start_data_table {
1.1018 raeburn 10545: my ($add_class,$id) = @_;
1.422 albertel 10546: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10547: my $table_id;
10548: if (defined($id)) {
10549: $table_id = ' id="'.$id.'"';
10550: }
1.961 onken 10551: &start_data_table_count();
1.1018 raeburn 10552: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10553: }
10554:
10555: sub end_data_table {
1.961 onken 10556: &end_data_table_count();
1.389 albertel 10557: return '</table>'."\n";;
1.347 albertel 10558: }
10559:
10560: sub start_data_table_row {
1.974 wenzelju 10561: my ($add_class, $id) = @_;
1.610 albertel 10562: $row_count[0]++;
10563: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10564: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10565: $id = (' id="'.$id.'"') unless ($id eq '');
10566: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10567: }
1.471 banghart 10568:
10569: sub continue_data_table_row {
1.974 wenzelju 10570: my ($add_class, $id) = @_;
1.610 albertel 10571: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10572: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10573: $id = (' id="'.$id.'"') unless ($id eq '');
10574: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10575: }
1.347 albertel 10576:
10577: sub end_data_table_row {
1.389 albertel 10578: return '</tr>'."\n";;
1.347 albertel 10579: }
1.367 www 10580:
1.421 albertel 10581: sub start_data_table_empty_row {
1.707 bisitz 10582: # $row_count[0]++;
1.421 albertel 10583: return '<tr class="LC_empty_row" >'."\n";;
10584: }
10585:
10586: sub end_data_table_empty_row {
10587: return '</tr>'."\n";;
10588: }
10589:
1.367 www 10590: sub start_data_table_header_row {
1.389 albertel 10591: return '<tr class="LC_header_row">'."\n";;
1.367 www 10592: }
10593:
10594: sub end_data_table_header_row {
1.389 albertel 10595: return '</tr>'."\n";;
1.367 www 10596: }
1.890 droeschl 10597:
10598: sub data_table_caption {
10599: my $caption = shift;
10600: return "<caption class=\"LC_caption\">$caption</caption>";
10601: }
1.347 albertel 10602: }
10603:
1.548 albertel 10604: =pod
10605:
10606: =item * &inhibit_menu_check($arg)
10607:
10608: Checks for a inhibitmenu state and generates output to preserve it
10609:
10610: Inputs: $arg - can be any of
10611: - undef - in which case the return value is a string
10612: to add into arguments list of a uri
10613: - 'input' - in which case the return value is a HTML
10614: <form> <input> field of type hidden to
10615: preserve the value
10616: - a url - in which case the return value is the url with
10617: the neccesary cgi args added to preserve the
10618: inhibitmenu state
10619: - a ref to a url - no return value, but the string is
10620: updated to include the neccessary cgi
10621: args to preserve the inhibitmenu state
10622:
10623: =cut
10624:
10625: sub inhibit_menu_check {
10626: my ($arg) = @_;
10627: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10628: if ($arg eq 'input') {
10629: if ($env{'form.inhibitmenu'}) {
10630: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10631: } else {
10632: return
10633: }
10634: }
10635: if ($env{'form.inhibitmenu'}) {
10636: if (ref($arg)) {
10637: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10638: } elsif ($arg eq '') {
10639: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10640: } else {
10641: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10642: }
10643: }
10644: if (!ref($arg)) {
10645: return $arg;
10646: }
10647: }
10648:
1.251 albertel 10649: ###############################################
1.182 matthew 10650:
10651: =pod
10652:
1.549 albertel 10653: =back
10654:
10655: =head1 User Information Routines
10656:
10657: =over 4
10658:
1.405 albertel 10659: =item * &get_users_function()
1.182 matthew 10660:
10661: Used by &bodytag to determine the current users primary role.
10662: Returns either 'student','coordinator','admin', or 'author'.
10663:
10664: =cut
10665:
10666: ###############################################
10667: sub get_users_function {
1.815 tempelho 10668: my $function = 'norole';
1.818 tempelho 10669: if ($env{'request.role'}=~/^(st)/) {
10670: $function='student';
10671: }
1.907 raeburn 10672: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10673: $function='coordinator';
10674: }
1.258 albertel 10675: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10676: $function='admin';
10677: }
1.826 bisitz 10678: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10679: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10680: $function='author';
10681: }
10682: return $function;
1.54 www 10683: }
1.99 www 10684:
10685: ###############################################
10686:
1.233 raeburn 10687: =pod
10688:
1.821 raeburn 10689: =item * &show_course()
10690:
10691: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10692: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10693:
10694: Inputs:
10695: None
10696:
10697: Outputs:
10698: Scalar: 1 if 'Course' to be used, 0 otherwise.
10699:
10700: =cut
10701:
10702: ###############################################
10703: sub show_course {
1.1408 raeburn 10704: my ($udom,$uname) = @_;
10705: if (($udom ne '') && ($uname ne '')) {
10706: if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
1.1410 raeburn 10707: if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
1.1408 raeburn 10708: return 0;
10709: } else {
10710: return 1;
10711: }
10712: }
10713: }
1.821 raeburn 10714: my $course = !$env{'user.adv'};
10715: if (!$env{'user.adv'}) {
10716: foreach my $env (keys(%env)) {
10717: next if ($env !~ m/^user\.priv\./);
10718: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10719: $course = 0;
10720: last;
10721: }
10722: }
10723: }
10724: return $course;
10725: }
10726:
10727: ###############################################
10728:
10729: =pod
10730:
1.542 raeburn 10731: =item * &check_user_status()
1.274 raeburn 10732:
10733: Determines current status of supplied role for a
10734: specific user. Roles can be active, previous or future.
10735:
10736: Inputs:
10737: user's domain, user's username, course's domain,
1.375 raeburn 10738: course's number, optional section ID.
1.274 raeburn 10739:
10740: Outputs:
10741: role status: active, previous or future.
10742:
10743: =cut
10744:
10745: sub check_user_status {
1.412 raeburn 10746: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10747: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10748: my @uroles = keys(%userinfo);
1.274 raeburn 10749: my $srchstr;
10750: my $active_chk = 'none';
1.412 raeburn 10751: my $now = time;
1.274 raeburn 10752: if (@uroles > 0) {
1.908 raeburn 10753: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10754: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10755: } else {
1.412 raeburn 10756: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10757: }
10758: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10759: my $role_end = 0;
10760: my $role_start = 0;
10761: $active_chk = 'active';
1.412 raeburn 10762: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10763: $role_end = $1;
10764: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10765: $role_start = $1;
1.274 raeburn 10766: }
10767: }
10768: if ($role_start > 0) {
1.412 raeburn 10769: if ($now < $role_start) {
1.274 raeburn 10770: $active_chk = 'future';
10771: }
10772: }
10773: if ($role_end > 0) {
1.412 raeburn 10774: if ($now > $role_end) {
1.274 raeburn 10775: $active_chk = 'previous';
10776: }
10777: }
10778: }
10779: }
10780: return $active_chk;
10781: }
10782:
10783: ###############################################
10784:
10785: =pod
10786:
1.405 albertel 10787: =item * &get_sections()
1.233 raeburn 10788:
10789: Determines all the sections for a course including
10790: sections with students and sections containing other roles.
1.419 raeburn 10791: Incoming parameters:
10792:
10793: 1. domain
10794: 2. course number
10795: 3. reference to array containing roles for which sections should
10796: be gathered (optional).
10797: 4. reference to array containing status types for which sections
10798: should be gathered (optional).
10799:
10800: If the third argument is undefined, sections are gathered for any role.
10801: If the fourth argument is undefined, sections are gathered for any status.
10802: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10803:
1.374 raeburn 10804: Returns section hash (keys are section IDs, values are
10805: number of users in each section), subject to the
1.419 raeburn 10806: optional roles filter, optional status filter
1.233 raeburn 10807:
10808: =cut
10809:
10810: ###############################################
10811: sub get_sections {
1.419 raeburn 10812: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10813: if (!defined($cdom) || !defined($cnum)) {
10814: my $cid = $env{'request.course.id'};
10815:
10816: return if (!defined($cid));
10817:
10818: $cdom = $env{'course.'.$cid.'.domain'};
10819: $cnum = $env{'course.'.$cid.'.num'};
10820: }
10821:
10822: my %sectioncount;
1.419 raeburn 10823: my $now = time;
1.240 albertel 10824:
1.1118 raeburn 10825: my $check_students = 1;
10826: my $only_students = 0;
10827: if (ref($possible_roles) eq 'ARRAY') {
10828: if (grep(/^st$/,@{$possible_roles})) {
10829: if (@{$possible_roles} == 1) {
10830: $only_students = 1;
10831: }
10832: } else {
10833: $check_students = 0;
10834: }
10835: }
10836:
10837: if ($check_students) {
1.276 albertel 10838: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10839: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10840: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10841: my $start_index = &Apache::loncoursedata::CL_START();
10842: my $end_index = &Apache::loncoursedata::CL_END();
10843: my $status;
1.366 albertel 10844: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10845: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10846: $data->[$status_index],
10847: $data->[$start_index],
10848: $data->[$end_index]);
10849: if ($stu_status eq 'Active') {
10850: $status = 'active';
10851: } elsif ($end < $now) {
10852: $status = 'previous';
10853: } elsif ($start > $now) {
10854: $status = 'future';
10855: }
10856: if ($section ne '-1' && $section !~ /^\s*$/) {
10857: if ((!defined($possible_status)) || (($status ne '') &&
10858: (grep/^\Q$status\E$/,@{$possible_status}))) {
10859: $sectioncount{$section}++;
10860: }
1.240 albertel 10861: }
10862: }
10863: }
1.1118 raeburn 10864: if ($only_students) {
10865: return %sectioncount;
10866: }
1.240 albertel 10867: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10868: foreach my $user (sort(keys(%courseroles))) {
10869: if ($user !~ /^(\w{2})/) { next; }
10870: my ($role) = ($user =~ /^(\w{2})/);
10871: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10872: my ($section,$status);
1.240 albertel 10873: if ($role eq 'cr' &&
10874: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10875: $section=$1;
10876: }
10877: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10878: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10879: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10880: if ($end == -1 && $start == -1) {
10881: next; #deleted role
10882: }
10883: if (!defined($possible_status)) {
10884: $sectioncount{$section}++;
10885: } else {
10886: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10887: $status = 'active';
10888: } elsif ($end < $now) {
10889: $status = 'future';
10890: } elsif ($start > $now) {
10891: $status = 'previous';
10892: }
10893: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10894: $sectioncount{$section}++;
10895: }
10896: }
1.233 raeburn 10897: }
1.366 albertel 10898: return %sectioncount;
1.233 raeburn 10899: }
10900:
1.274 raeburn 10901: ###############################################
1.294 raeburn 10902:
10903: =pod
1.405 albertel 10904:
10905: =item * &get_course_users()
10906:
1.275 raeburn 10907: Retrieves usernames:domains for users in the specified course
10908: with specific role(s), and access status.
10909:
10910: Incoming parameters:
1.277 albertel 10911: 1. course domain
10912: 2. course number
10913: 3. access status: users must have - either active,
1.275 raeburn 10914: previous, future, or all.
1.277 albertel 10915: 4. reference to array of permissible roles
1.288 raeburn 10916: 5. reference to array of section restrictions (optional)
10917: 6. reference to results object (hash of hashes).
10918: 7. reference to optional userdata hash
1.609 raeburn 10919: 8. reference to optional statushash
1.630 raeburn 10920: 9. flag if privileged users (except those set to unhide in
10921: course settings) should be excluded
1.609 raeburn 10922: Keys of top level results hash are roles.
1.275 raeburn 10923: Keys of inner hashes are username:domain, with
10924: values set to access type.
1.288 raeburn 10925: Optional userdata hash returns an array with arguments in the
10926: same order as loncoursedata::get_classlist() for student data.
10927:
1.609 raeburn 10928: Optional statushash returns
10929:
1.288 raeburn 10930: Entries for end, start, section and status are blank because
10931: of the possibility of multiple values for non-student roles.
10932:
1.275 raeburn 10933: =cut
1.405 albertel 10934:
1.275 raeburn 10935: ###############################################
1.405 albertel 10936:
1.275 raeburn 10937: sub get_course_users {
1.630 raeburn 10938: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10939: my %idx = ();
1.419 raeburn 10940: my %seclists;
1.288 raeburn 10941:
10942: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10943: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10944: $idx{end} = &Apache::loncoursedata::CL_END();
10945: $idx{start} = &Apache::loncoursedata::CL_START();
10946: $idx{id} = &Apache::loncoursedata::CL_ID();
10947: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10948: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10949: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10950:
1.290 albertel 10951: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10952: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10953: my $now = time;
1.277 albertel 10954: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10955: my $match = 0;
1.412 raeburn 10956: my $secmatch = 0;
1.419 raeburn 10957: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10958: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10959: if ($section eq '') {
10960: $section = 'none';
10961: }
1.291 albertel 10962: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10963: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10964: $secmatch = 1;
10965: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10966: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10967: $secmatch = 1;
10968: }
10969: } else {
1.419 raeburn 10970: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10971: $secmatch = 1;
10972: }
1.290 albertel 10973: }
1.412 raeburn 10974: if (!$secmatch) {
10975: next;
10976: }
1.419 raeburn 10977: }
1.275 raeburn 10978: if (defined($$types{'active'})) {
1.288 raeburn 10979: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10980: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10981: $match = 1;
1.275 raeburn 10982: }
10983: }
10984: if (defined($$types{'previous'})) {
1.609 raeburn 10985: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10986: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10987: $match = 1;
1.275 raeburn 10988: }
10989: }
10990: if (defined($$types{'future'})) {
1.609 raeburn 10991: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10992: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10993: $match = 1;
1.275 raeburn 10994: }
10995: }
1.609 raeburn 10996: if ($match) {
10997: push(@{$seclists{$student}},$section);
10998: if (ref($userdata) eq 'HASH') {
10999: $$userdata{$student} = $$classlist{$student};
11000: }
11001: if (ref($statushash) eq 'HASH') {
11002: $statushash->{$student}{'st'}{$section} = $status;
11003: }
1.288 raeburn 11004: }
1.275 raeburn 11005: }
11006: }
1.412 raeburn 11007: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 11008: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11009: my $now = time;
1.609 raeburn 11010: my %displaystatus = ( previous => 'Expired',
11011: active => 'Active',
11012: future => 'Future',
11013: );
1.1121 raeburn 11014: my (%nothide,@possdoms);
1.630 raeburn 11015: if ($hidepriv) {
11016: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
11017: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
11018: if ($user !~ /:/) {
11019: $nothide{join(':',split(/[\@]/,$user))}=1;
11020: } else {
11021: $nothide{$user} = 1;
11022: }
11023: }
1.1121 raeburn 11024: my @possdoms = ($cdom);
11025: if ($coursehash{'checkforpriv'}) {
11026: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
11027: }
1.630 raeburn 11028: }
1.439 raeburn 11029: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 11030: my $match = 0;
1.412 raeburn 11031: my $secmatch = 0;
1.439 raeburn 11032: my $status;
1.412 raeburn 11033: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 11034: $user =~ s/:$//;
1.439 raeburn 11035: my ($end,$start) = split(/:/,$coursepersonnel{$person});
11036: if ($end == -1 || $start == -1) {
11037: next;
11038: }
11039: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
11040: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 11041: my ($uname,$udom) = split(/:/,$user);
11042: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 11043: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 11044: $secmatch = 1;
11045: } elsif ($usec eq '') {
1.420 albertel 11046: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 11047: $secmatch = 1;
11048: }
11049: } else {
11050: if (grep(/^\Q$usec\E$/,@{$sections})) {
11051: $secmatch = 1;
11052: }
11053: }
11054: if (!$secmatch) {
11055: next;
11056: }
1.288 raeburn 11057: }
1.419 raeburn 11058: if ($usec eq '') {
11059: $usec = 'none';
11060: }
1.275 raeburn 11061: if ($uname ne '' && $udom ne '') {
1.630 raeburn 11062: if ($hidepriv) {
1.1121 raeburn 11063: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 11064: (!$nothide{$uname.':'.$udom})) {
11065: next;
11066: }
11067: }
1.503 raeburn 11068: if ($end > 0 && $end < $now) {
1.439 raeburn 11069: $status = 'previous';
11070: } elsif ($start > $now) {
11071: $status = 'future';
11072: } else {
11073: $status = 'active';
11074: }
1.277 albertel 11075: foreach my $type (keys(%{$types})) {
1.275 raeburn 11076: if ($status eq $type) {
1.420 albertel 11077: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 11078: push(@{$$users{$role}{$user}},$type);
11079: }
1.288 raeburn 11080: $match = 1;
11081: }
11082: }
1.419 raeburn 11083: if (($match) && (ref($userdata) eq 'HASH')) {
11084: if (!exists($$userdata{$uname.':'.$udom})) {
11085: &get_user_info($udom,$uname,\%idx,$userdata);
11086: }
1.420 albertel 11087: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 11088: push(@{$seclists{$uname.':'.$udom}},$usec);
11089: }
1.609 raeburn 11090: if (ref($statushash) eq 'HASH') {
11091: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
11092: }
1.275 raeburn 11093: }
11094: }
11095: }
11096: }
1.290 albertel 11097: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 11098: if ((defined($cdom)) && (defined($cnum))) {
11099: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
11100: if ( defined($csettings{'internal.courseowner'}) ) {
11101: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 11102: next if ($owner eq '');
11103: my ($ownername,$ownerdom);
11104: if ($owner =~ /^([^:]+):([^:]+)$/) {
11105: $ownername = $1;
11106: $ownerdom = $2;
11107: } else {
11108: $ownername = $owner;
11109: $ownerdom = $cdom;
11110: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 11111: }
11112: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 11113: if (defined($userdata) &&
1.609 raeburn 11114: !exists($$userdata{$owner})) {
11115: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
11116: if (!grep(/^none$/,@{$seclists{$owner}})) {
11117: push(@{$seclists{$owner}},'none');
11118: }
11119: if (ref($statushash) eq 'HASH') {
11120: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 11121: }
1.290 albertel 11122: }
1.279 raeburn 11123: }
11124: }
11125: }
1.419 raeburn 11126: foreach my $user (keys(%seclists)) {
11127: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
11128: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
11129: }
1.275 raeburn 11130: }
11131: return;
11132: }
11133:
1.288 raeburn 11134: sub get_user_info {
11135: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 11136: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
11137: &plainname($uname,$udom,'lastname');
1.291 albertel 11138: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 11139: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 11140: my %idhash = &Apache::lonnet::idrget($udom,($uname));
11141: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 11142: return;
11143: }
1.275 raeburn 11144:
1.472 raeburn 11145: ###############################################
11146:
11147: =pod
11148:
11149: =item * &get_user_quota()
11150:
1.1134 raeburn 11151: Retrieves quota assigned for storage of user files.
11152: Default is to report quota for portfolio files.
1.472 raeburn 11153:
11154: Incoming parameters:
11155: 1. user's username
11156: 2. user's domain
1.1134 raeburn 11157: 3. quota name - portfolio, author, or course
1.1136 raeburn 11158: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 11159: 4. crstype - official, unofficial, textbook, placement or community,
11160: if quota name is course
1.472 raeburn 11161:
11162: Returns:
1.1163 raeburn 11163: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 11164: 2. (Optional) Type of setting: custom or default
11165: (individually assigned or default for user's
11166: institutional status).
11167: 3. (Optional) - User's institutional status (e.g., faculty, staff
11168: or student - types as defined in localenroll::inst_usertypes
11169: for user's domain, which determines default quota for user.
11170: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 11171:
11172: If a value has been stored in the user's environment,
1.536 raeburn 11173: it will return that, otherwise it returns the maximal default
1.1134 raeburn 11174: defined for the user's institutional status(es) in the domain.
1.472 raeburn 11175:
11176: =cut
11177:
11178: ###############################################
11179:
11180:
11181: sub get_user_quota {
1.1136 raeburn 11182: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 11183: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 11184: if (!defined($udom)) {
11185: $udom = $env{'user.domain'};
11186: }
11187: if (!defined($uname)) {
11188: $uname = $env{'user.name'};
11189: }
11190: if (($udom eq '' || $uname eq '') ||
11191: ($udom eq 'public') && ($uname eq 'public')) {
11192: $quota = 0;
1.536 raeburn 11193: $quotatype = 'default';
11194: $defquota = 0;
1.472 raeburn 11195: } else {
1.536 raeburn 11196: my $inststatus;
1.1134 raeburn 11197: if ($quotaname eq 'course') {
11198: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
11199: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
11200: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
11201: } else {
11202: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
11203: $quota = $cenv{'internal.uploadquota'};
11204: }
1.536 raeburn 11205: } else {
1.1134 raeburn 11206: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
11207: if ($quotaname eq 'author') {
11208: $quota = $env{'environment.authorquota'};
11209: } else {
11210: $quota = $env{'environment.portfolioquota'};
11211: }
11212: $inststatus = $env{'environment.inststatus'};
11213: } else {
11214: my %userenv =
11215: &Apache::lonnet::get('environment',['portfolioquota',
11216: 'authorquota','inststatus'],$udom,$uname);
11217: my ($tmp) = keys(%userenv);
11218: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
11219: if ($quotaname eq 'author') {
11220: $quota = $userenv{'authorquota'};
11221: } else {
11222: $quota = $userenv{'portfolioquota'};
11223: }
11224: $inststatus = $userenv{'inststatus'};
11225: } else {
11226: undef(%userenv);
11227: }
11228: }
11229: }
11230: if ($quota eq '' || wantarray) {
11231: if ($quotaname eq 'course') {
11232: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 11233: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 11234: ($crstype eq 'community') || ($crstype eq 'textbook') ||
11235: ($crstype eq 'placement')) {
1.1136 raeburn 11236: $defquota = $domdefs{$crstype.'quota'};
11237: }
11238: if ($defquota eq '') {
11239: $defquota = 500;
11240: }
1.1134 raeburn 11241: } else {
11242: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
11243: }
11244: if ($quota eq '') {
11245: $quota = $defquota;
11246: $quotatype = 'default';
11247: } else {
11248: $quotatype = 'custom';
11249: }
1.472 raeburn 11250: }
11251: }
1.536 raeburn 11252: if (wantarray) {
11253: return ($quota,$quotatype,$settingstatus,$defquota);
11254: } else {
11255: return $quota;
11256: }
1.472 raeburn 11257: }
11258:
11259: ###############################################
11260:
11261: =pod
11262:
11263: =item * &default_quota()
11264:
1.536 raeburn 11265: Retrieves default quota assigned for storage of user portfolio files,
11266: given an (optional) user's institutional status.
1.472 raeburn 11267:
11268: Incoming parameters:
1.1142 raeburn 11269:
1.472 raeburn 11270: 1. domain
1.536 raeburn 11271: 2. (Optional) institutional status(es). This is a : separated list of
11272: status types (e.g., faculty, staff, student etc.)
11273: which apply to the user for whom the default is being retrieved.
11274: If the institutional status string in undefined, the domain
1.1134 raeburn 11275: default quota will be returned.
11276: 3. quota name - portfolio, author, or course
11277: (if no quota name provided, defaults to portfolio).
1.472 raeburn 11278:
11279: Returns:
1.1142 raeburn 11280:
1.1163 raeburn 11281: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 11282: 2. (Optional) institutional type which determined the value of the
11283: default quota.
1.472 raeburn 11284:
11285: If a value has been stored in the domain's configuration db,
11286: it will return that, otherwise it returns 20 (for backwards
11287: compatibility with domains which have not set up a configuration
1.1163 raeburn 11288: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 11289:
1.536 raeburn 11290: If the user's status includes multiple types (e.g., staff and student),
11291: the largest default quota which applies to the user determines the
11292: default quota returned.
11293:
1.472 raeburn 11294: =cut
11295:
11296: ###############################################
11297:
11298:
11299: sub default_quota {
1.1134 raeburn 11300: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 11301: my ($defquota,$settingstatus);
11302: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 11303: ['quotas'],$udom);
1.1134 raeburn 11304: my $key = 'defaultquota';
11305: if ($quotaname eq 'author') {
11306: $key = 'authorquota';
11307: }
1.622 raeburn 11308: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 11309: if ($inststatus ne '') {
1.765 raeburn 11310: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 11311: foreach my $item (@statuses) {
1.1134 raeburn 11312: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11313: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 11314: if ($defquota eq '') {
1.1134 raeburn 11315: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11316: $settingstatus = $item;
1.1134 raeburn 11317: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
11318: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11319: $settingstatus = $item;
11320: }
11321: }
1.1134 raeburn 11322: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11323: if ($quotahash{'quotas'}{$item} ne '') {
11324: if ($defquota eq '') {
11325: $defquota = $quotahash{'quotas'}{$item};
11326: $settingstatus = $item;
11327: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
11328: $defquota = $quotahash{'quotas'}{$item};
11329: $settingstatus = $item;
11330: }
1.536 raeburn 11331: }
11332: }
11333: }
11334: }
11335: if ($defquota eq '') {
1.1134 raeburn 11336: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11337: $defquota = $quotahash{'quotas'}{$key}{'default'};
11338: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11339: $defquota = $quotahash{'quotas'}{'default'};
11340: }
1.536 raeburn 11341: $settingstatus = 'default';
1.1139 raeburn 11342: if ($defquota eq '') {
11343: if ($quotaname eq 'author') {
11344: $defquota = 500;
11345: }
11346: }
1.536 raeburn 11347: }
11348: } else {
11349: $settingstatus = 'default';
1.1134 raeburn 11350: if ($quotaname eq 'author') {
11351: $defquota = 500;
11352: } else {
11353: $defquota = 20;
11354: }
1.536 raeburn 11355: }
11356: if (wantarray) {
11357: return ($defquota,$settingstatus);
1.472 raeburn 11358: } else {
1.536 raeburn 11359: return $defquota;
1.472 raeburn 11360: }
11361: }
11362:
1.1135 raeburn 11363: ###############################################
11364:
11365: =pod
11366:
1.1136 raeburn 11367: =item * &excess_filesize_warning()
1.1135 raeburn 11368:
11369: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 11370: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 11371: space to be exceeded.
1.1136 raeburn 11372:
11373: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 11374: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 11375:
1.1165 raeburn 11376: Inputs: 7
1.1136 raeburn 11377: 1. username or coursenum
1.1135 raeburn 11378: 2. domain
1.1136 raeburn 11379: 3. context ('author' or 'course')
1.1135 raeburn 11380: 4. filename of file for which action is being requested
11381: 5. filesize (kB) of file
11382: 6. action being taken: copy or upload.
1.1237 raeburn 11383: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 11384:
11385: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 11386: otherwise return null.
11387:
11388: =back
1.1135 raeburn 11389:
11390: =cut
11391:
1.1136 raeburn 11392: sub excess_filesize_warning {
1.1165 raeburn 11393: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 11394: my $current_disk_usage = 0;
1.1165 raeburn 11395: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 11396: if ($context eq 'author') {
11397: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
11398: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
11399: } else {
11400: foreach my $subdir ('docs','supplemental') {
11401: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
11402: }
11403: }
1.1135 raeburn 11404: $disk_quota = int($disk_quota * 1000);
11405: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 11406: return '<p class="LC_warning">'.
1.1135 raeburn 11407: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 11408: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
11409: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 11410: $disk_quota,$current_disk_usage).
11411: '</p>';
11412: }
11413: return;
11414: }
11415:
11416: ###############################################
11417:
11418:
1.1136 raeburn 11419:
11420:
1.384 raeburn 11421: sub get_secgrprole_info {
11422: my ($cdom,$cnum,$needroles,$type) = @_;
11423: my %sections_count = &get_sections($cdom,$cnum);
11424: my @sections = (sort {$a <=> $b} keys(%sections_count));
11425: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
11426: my @groups = sort(keys(%curr_groups));
11427: my $allroles = [];
11428: my $rolehash;
11429: my $accesshash = {
11430: active => 'Currently has access',
11431: future => 'Will have future access',
11432: previous => 'Previously had access',
11433: };
11434: if ($needroles) {
11435: $rolehash = {'all' => 'all'};
1.385 albertel 11436: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11437: if (&Apache::lonnet::error(%user_roles)) {
11438: undef(%user_roles);
11439: }
11440: foreach my $item (keys(%user_roles)) {
1.384 raeburn 11441: my ($role)=split(/\:/,$item,2);
11442: if ($role eq 'cr') { next; }
11443: if ($role =~ /^cr/) {
11444: $$rolehash{$role} = (split('/',$role))[3];
11445: } else {
11446: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
11447: }
11448: }
11449: foreach my $key (sort(keys(%{$rolehash}))) {
11450: push(@{$allroles},$key);
11451: }
11452: push (@{$allroles},'st');
11453: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
11454: }
11455: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
11456: }
11457:
1.555 raeburn 11458: sub user_picker {
1.1279 raeburn 11459: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 11460: my $currdom = $dom;
1.1253 raeburn 11461: my @alldoms = &Apache::lonnet::all_domains();
11462: if (@alldoms == 1) {
11463: my %domsrch = &Apache::lonnet::get_dom('configuration',
11464: ['directorysrch'],$alldoms[0]);
11465: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
11466: my $showdom = $domdesc;
11467: if ($showdom eq '') {
11468: $showdom = $dom;
11469: }
11470: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
11471: if ((!$domsrch{'directorysrch'}{'available'}) &&
11472: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
11473: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
11474: }
11475: }
11476: }
1.555 raeburn 11477: my %curr_selected = (
11478: srchin => 'dom',
1.580 raeburn 11479: srchby => 'lastname',
1.555 raeburn 11480: );
11481: my $srchterm;
1.625 raeburn 11482: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 11483: if ($srch->{'srchby'} ne '') {
11484: $curr_selected{'srchby'} = $srch->{'srchby'};
11485: }
11486: if ($srch->{'srchin'} ne '') {
11487: $curr_selected{'srchin'} = $srch->{'srchin'};
11488: }
11489: if ($srch->{'srchtype'} ne '') {
11490: $curr_selected{'srchtype'} = $srch->{'srchtype'};
11491: }
11492: if ($srch->{'srchdomain'} ne '') {
11493: $currdom = $srch->{'srchdomain'};
11494: }
11495: $srchterm = $srch->{'srchterm'};
11496: }
1.1222 damieng 11497: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11498: 'usr' => 'Search criteria',
1.563 raeburn 11499: 'doma' => 'Domain/institution to search',
1.558 albertel 11500: 'uname' => 'username',
11501: 'lastname' => 'last name',
1.555 raeburn 11502: 'lastfirst' => 'last name, first name',
1.558 albertel 11503: 'crs' => 'in this course',
1.576 raeburn 11504: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11505: 'alc' => 'all LON-CAPA',
1.573 raeburn 11506: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11507: 'exact' => 'is',
11508: 'contains' => 'contains',
1.569 raeburn 11509: 'begins' => 'begins with',
1.1222 damieng 11510: );
11511: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11512: 'youm' => "You must include some text to search for.",
11513: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11514: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11515: 'yomc' => "You must choose a domain when using an institutional directory search.",
11516: 'ymcd' => "You must choose a domain when using a domain search.",
11517: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11518: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11519: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11520: );
1.1222 damieng 11521: &html_escape(\%html_lt);
11522: &js_escape(\%js_lt);
1.1255 raeburn 11523: my $domform;
1.1277 raeburn 11524: my $allow_blank = 1;
1.1255 raeburn 11525: if ($fixeddom) {
1.1277 raeburn 11526: $allow_blank = 0;
11527: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11528: } else {
1.1287 raeburn 11529: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11530: my ($trusted,$untrusted);
1.1287 raeburn 11531: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11532: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11533: } elsif ($context eq 'author') {
1.1288 raeburn 11534: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11535: } elsif ($context eq 'domain') {
1.1288 raeburn 11536: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11537: }
1.1288 raeburn 11538: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11539: }
1.563 raeburn 11540: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11541:
11542: my @srchins = ('crs','dom','alc','instd');
11543:
11544: foreach my $option (@srchins) {
11545: # FIXME 'alc' option unavailable until
11546: # loncreateuser::print_user_query_page()
11547: # has been completed.
11548: next if ($option eq 'alc');
1.880 raeburn 11549: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11550: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11551: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11552: if ($curr_selected{'srchin'} eq $option) {
11553: $srchinsel .= '
1.1222 damieng 11554: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11555: } else {
11556: $srchinsel .= '
1.1222 damieng 11557: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11558: }
1.555 raeburn 11559: }
1.563 raeburn 11560: $srchinsel .= "\n </select>\n";
1.555 raeburn 11561:
11562: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11563: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11564: if ($curr_selected{'srchby'} eq $option) {
11565: $srchbysel .= '
1.1222 damieng 11566: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11567: } else {
11568: $srchbysel .= '
1.1222 damieng 11569: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11570: }
11571: }
11572: $srchbysel .= "\n </select>\n";
11573:
11574: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11575: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11576: if ($curr_selected{'srchtype'} eq $option) {
11577: $srchtypesel .= '
1.1222 damieng 11578: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11579: } else {
11580: $srchtypesel .= '
1.1222 damieng 11581: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11582: }
11583: }
11584: $srchtypesel .= "\n </select>\n";
11585:
1.558 albertel 11586: my ($newuserscript,$new_user_create);
1.994 raeburn 11587: my $context_dom = $env{'request.role.domain'};
11588: if ($context eq 'requestcrs') {
11589: if ($env{'form.coursedom'} ne '') {
11590: $context_dom = $env{'form.coursedom'};
11591: }
11592: }
1.556 raeburn 11593: if ($forcenewuser) {
1.576 raeburn 11594: if (ref($srch) eq 'HASH') {
1.994 raeburn 11595: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11596: if ($cancreate) {
11597: $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>';
11598: } else {
1.799 bisitz 11599: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11600: my %usertypetext = (
11601: official => 'institutional',
11602: unofficial => 'non-institutional',
11603: );
1.799 bisitz 11604: $new_user_create = '<p class="LC_warning">'
11605: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11606: .' '
11607: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11608: ,'<a href="'.$helplink.'">','</a>')
11609: .'</p><br />';
1.627 raeburn 11610: }
1.576 raeburn 11611: }
11612: }
11613:
1.556 raeburn 11614: $newuserscript = <<"ENDSCRIPT";
11615:
1.570 raeburn 11616: function setSearch(createnew,callingForm) {
1.556 raeburn 11617: if (createnew == 1) {
1.570 raeburn 11618: for (var i=0; i<callingForm.srchby.length; i++) {
11619: if (callingForm.srchby.options[i].value == 'uname') {
11620: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11621: }
11622: }
1.570 raeburn 11623: for (var i=0; i<callingForm.srchin.length; i++) {
11624: if ( callingForm.srchin.options[i].value == 'dom') {
11625: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11626: }
11627: }
1.570 raeburn 11628: for (var i=0; i<callingForm.srchtype.length; i++) {
11629: if (callingForm.srchtype.options[i].value == 'exact') {
11630: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11631: }
11632: }
1.570 raeburn 11633: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11634: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11635: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11636: }
11637: }
11638: }
11639: }
11640: ENDSCRIPT
1.558 albertel 11641:
1.556 raeburn 11642: }
11643:
1.555 raeburn 11644: my $output = <<"END_BLOCK";
1.556 raeburn 11645: <script type="text/javascript">
1.824 bisitz 11646: // <![CDATA[
1.570 raeburn 11647: function validateEntry(callingForm) {
1.558 albertel 11648:
1.556 raeburn 11649: var checkok = 1;
1.558 albertel 11650: var srchin;
1.570 raeburn 11651: for (var i=0; i<callingForm.srchin.length; i++) {
11652: if ( callingForm.srchin[i].checked ) {
11653: srchin = callingForm.srchin[i].value;
1.558 albertel 11654: }
11655: }
11656:
1.570 raeburn 11657: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11658: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11659: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11660: var srchterm = callingForm.srchterm.value;
11661: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11662: var msg = "";
11663:
11664: if (srchterm == "") {
11665: checkok = 0;
1.1222 damieng 11666: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11667: }
11668:
1.569 raeburn 11669: if (srchtype== 'begins') {
11670: if (srchterm.length < 2) {
11671: checkok = 0;
1.1222 damieng 11672: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11673: }
11674: }
11675:
1.556 raeburn 11676: if (srchtype== 'contains') {
11677: if (srchterm.length < 3) {
11678: checkok = 0;
1.1222 damieng 11679: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11680: }
11681: }
11682: if (srchin == 'instd') {
11683: if (srchdomain == '') {
11684: checkok = 0;
1.1222 damieng 11685: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11686: }
11687: }
11688: if (srchin == 'dom') {
11689: if (srchdomain == '') {
11690: checkok = 0;
1.1222 damieng 11691: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11692: }
11693: }
11694: if (srchby == 'lastfirst') {
11695: if (srchterm.indexOf(",") == -1) {
11696: checkok = 0;
1.1222 damieng 11697: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11698: }
11699: if (srchterm.indexOf(",") == srchterm.length -1) {
11700: checkok = 0;
1.1222 damieng 11701: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11702: }
11703: }
11704: if (checkok == 0) {
1.1222 damieng 11705: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11706: return;
11707: }
11708: if (checkok == 1) {
1.570 raeburn 11709: callingForm.submit();
1.556 raeburn 11710: }
11711: }
11712:
11713: $newuserscript
11714:
1.824 bisitz 11715: // ]]>
1.556 raeburn 11716: </script>
1.558 albertel 11717:
11718: $new_user_create
11719:
1.555 raeburn 11720: END_BLOCK
1.558 albertel 11721:
1.876 raeburn 11722: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11723: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11724: $domform.
11725: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11726: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11727: $srchbysel.
11728: $srchtypesel.
11729: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11730: $srchinsel.
11731: &Apache::lonhtmlcommon::row_closure(1).
11732: &Apache::lonhtmlcommon::end_pick_box().
11733: '<br />';
1.1253 raeburn 11734: return ($output,1);
1.555 raeburn 11735: }
11736:
1.612 raeburn 11737: sub user_rule_check {
1.615 raeburn 11738: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11739: my ($response,%inst_response);
1.612 raeburn 11740: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11741: if (keys(%{$usershash}) > 1) {
11742: my (%by_username,%by_id,%userdoms);
11743: my $checkid;
11744: if (ref($checks) eq 'HASH') {
11745: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11746: $checkid = 1;
11747: }
11748: }
11749: foreach my $user (keys(%{$usershash})) {
11750: my ($uname,$udom) = split(/:/,$user);
11751: if ($checkid) {
11752: if (ref($usershash->{$user}) eq 'HASH') {
11753: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 11754: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 11755: $userdoms{$udom} = 1;
1.1227 raeburn 11756: if (ref($inst_results) eq 'HASH') {
11757: $inst_results->{$uname.':'.$udom} = {};
11758: }
1.1226 raeburn 11759: }
11760: }
11761: } else {
11762: $by_username{$udom}{$uname} = 1;
11763: $userdoms{$udom} = 1;
1.1227 raeburn 11764: if (ref($inst_results) eq 'HASH') {
11765: $inst_results->{$uname.':'.$udom} = {};
11766: }
1.1226 raeburn 11767: }
11768: }
11769: foreach my $udom (keys(%userdoms)) {
11770: if (!$got_rules->{$udom}) {
11771: my %domconfig = &Apache::lonnet::get_dom('configuration',
11772: ['usercreation'],$udom);
11773: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11774: foreach my $item ('username','id') {
11775: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 11776: $$curr_rules{$udom}{$item} =
11777: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 11778: }
11779: }
11780: }
11781: $got_rules->{$udom} = 1;
11782: }
1.612 raeburn 11783: }
1.1226 raeburn 11784: if ($checkid) {
11785: foreach my $udom (keys(%by_id)) {
11786: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11787: if ($outcome eq 'ok') {
1.1227 raeburn 11788: foreach my $id (keys(%{$by_id{$udom}})) {
11789: my $uname = $by_id{$udom}{$id};
11790: $inst_response{$uname.':'.$udom} = $outcome;
11791: }
1.1226 raeburn 11792: if (ref($results) eq 'HASH') {
11793: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 11794: if (exists($inst_response{$uname.':'.$udom})) {
11795: $inst_response{$uname.':'.$udom} = $outcome;
11796: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11797: }
1.1226 raeburn 11798: }
11799: }
11800: }
1.612 raeburn 11801: }
1.615 raeburn 11802: } else {
1.1226 raeburn 11803: foreach my $udom (keys(%by_username)) {
11804: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11805: if ($outcome eq 'ok') {
1.1227 raeburn 11806: foreach my $uname (keys(%{$by_username{$udom}})) {
11807: $inst_response{$uname.':'.$udom} = $outcome;
11808: }
1.1226 raeburn 11809: if (ref($results) eq 'HASH') {
11810: foreach my $uname (keys(%{$results})) {
11811: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11812: }
11813: }
11814: }
11815: }
1.612 raeburn 11816: }
1.1226 raeburn 11817: } elsif (keys(%{$usershash}) == 1) {
11818: my $user = (keys(%{$usershash}))[0];
11819: my ($uname,$udom) = split(/:/,$user);
11820: if (($udom ne '') && ($uname ne '')) {
11821: if (ref($usershash->{$user}) eq 'HASH') {
11822: if (ref($checks) eq 'HASH') {
11823: if (defined($checks->{'username'})) {
11824: ($inst_response{$user},%{$inst_results->{$user}}) =
11825: &Apache::lonnet::get_instuser($udom,$uname);
11826: } elsif (defined($checks->{'id'})) {
11827: if ($usershash->{$user}->{'id'} ne '') {
11828: ($inst_response{$user},%{$inst_results->{$user}}) =
11829: &Apache::lonnet::get_instuser($udom,undef,
11830: $usershash->{$user}->{'id'});
11831: } else {
11832: ($inst_response{$user},%{$inst_results->{$user}}) =
11833: &Apache::lonnet::get_instuser($udom,$uname);
11834: }
1.585 raeburn 11835: }
1.1226 raeburn 11836: } else {
11837: ($inst_response{$user},%{$inst_results->{$user}}) =
11838: &Apache::lonnet::get_instuser($udom,$uname);
11839: return;
11840: }
11841: if (!$got_rules->{$udom}) {
11842: my %domconfig = &Apache::lonnet::get_dom('configuration',
11843: ['usercreation'],$udom);
11844: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11845: foreach my $item ('username','id') {
11846: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11847: $$curr_rules{$udom}{$item} =
11848: $domconfig{'usercreation'}{$item.'_rule'};
11849: }
11850: }
11851: }
11852: $got_rules->{$udom} = 1;
1.585 raeburn 11853: }
11854: }
1.1226 raeburn 11855: } else {
11856: return;
11857: }
11858: } else {
11859: return;
11860: }
11861: foreach my $user (keys(%{$usershash})) {
11862: my ($uname,$udom) = split(/:/,$user);
11863: next if (($udom eq '') || ($uname eq ''));
11864: my $id;
1.1227 raeburn 11865: if (ref($inst_results) eq 'HASH') {
11866: if (ref($inst_results->{$user}) eq 'HASH') {
11867: $id = $inst_results->{$user}->{'id'};
11868: }
11869: }
11870: if ($id eq '') {
11871: if (ref($usershash->{$user})) {
11872: $id = $usershash->{$user}->{'id'};
11873: }
1.585 raeburn 11874: }
1.612 raeburn 11875: foreach my $item (keys(%{$checks})) {
11876: if (ref($$curr_rules{$udom}) eq 'HASH') {
11877: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11878: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 11879: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11880: $$curr_rules{$udom}{$item});
1.612 raeburn 11881: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11882: if ($rule_check{$rule}) {
11883: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 11884: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11885: if (ref($inst_results) eq 'HASH') {
11886: if (ref($inst_results->{$user}) eq 'HASH') {
11887: if (keys(%{$inst_results->{$user}}) == 0) {
11888: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 11889: } elsif ($item eq 'id') {
11890: if ($inst_results->{$user}->{'id'} eq '') {
11891: $$alerts{$item}{$udom}{$uname} = 1;
11892: }
1.615 raeburn 11893: }
1.612 raeburn 11894: }
11895: }
1.615 raeburn 11896: }
11897: last;
1.585 raeburn 11898: }
11899: }
11900: }
11901: }
11902: }
11903: }
11904: }
11905: }
1.612 raeburn 11906: return;
11907: }
11908:
11909: sub user_rule_formats {
11910: my ($domain,$domdesc,$curr_rules,$check) = @_;
11911: my %text = (
11912: 'username' => 'Usernames',
11913: 'id' => 'IDs',
11914: );
11915: my $output;
11916: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11917: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11918: if (@{$ruleorder} > 0) {
1.1102 raeburn 11919: $output = '<br />'.
11920: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11921: '<span class="LC_cusr_emph">','</span>',$domdesc).
11922: ' <ul>';
1.612 raeburn 11923: foreach my $rule (@{$ruleorder}) {
11924: if (ref($curr_rules) eq 'ARRAY') {
11925: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11926: if (ref($rules->{$rule}) eq 'HASH') {
11927: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11928: $rules->{$rule}{'desc'}.'</li>';
11929: }
11930: }
11931: }
11932: }
11933: $output .= '</ul>';
11934: }
11935: }
11936: return $output;
11937: }
11938:
11939: sub instrule_disallow_msg {
1.615 raeburn 11940: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11941: my $response;
11942: my %text = (
11943: item => 'username',
11944: items => 'usernames',
11945: match => 'matches',
11946: do => 'does',
11947: action => 'a username',
11948: one => 'one',
11949: );
11950: if ($count > 1) {
11951: $text{'item'} = 'usernames';
11952: $text{'match'} ='match';
11953: $text{'do'} = 'do';
11954: $text{'action'} = 'usernames',
11955: $text{'one'} = 'ones';
11956: }
11957: if ($checkitem eq 'id') {
11958: $text{'items'} = 'IDs';
11959: $text{'item'} = 'ID';
11960: $text{'action'} = 'an ID';
1.615 raeburn 11961: if ($count > 1) {
11962: $text{'item'} = 'IDs';
11963: $text{'action'} = 'IDs';
11964: }
1.612 raeburn 11965: }
1.674 bisitz 11966: $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 11967: if ($mode eq 'upload') {
11968: if ($checkitem eq 'username') {
11969: $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'}.");
11970: } elsif ($checkitem eq 'id') {
1.674 bisitz 11971: $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 11972: }
1.669 raeburn 11973: } elsif ($mode eq 'selfcreate') {
11974: if ($checkitem eq 'id') {
11975: $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.");
11976: }
1.615 raeburn 11977: } else {
11978: if ($checkitem eq 'username') {
11979: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11980: } elsif ($checkitem eq 'id') {
11981: $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.");
11982: }
1.612 raeburn 11983: }
11984: return $response;
1.585 raeburn 11985: }
11986:
1.624 raeburn 11987: sub personal_data_fieldtitles {
11988: my %fieldtitles = &Apache::lonlocal::texthash (
11989: id => 'Student/Employee ID',
11990: permanentemail => 'E-mail address',
11991: lastname => 'Last Name',
11992: firstname => 'First Name',
11993: middlename => 'Middle Name',
11994: generation => 'Generation',
11995: gen => 'Generation',
1.765 raeburn 11996: inststatus => 'Affiliation',
1.624 raeburn 11997: );
11998: return %fieldtitles;
11999: }
12000:
1.642 raeburn 12001: sub sorted_inst_types {
12002: my ($dom) = @_;
1.1185 raeburn 12003: my ($usertypes,$order);
12004: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
12005: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
12006: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
12007: $order = $domdefaults{'inststatus'}{'inststatusorder'};
12008: } else {
12009: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
12010: }
1.642 raeburn 12011: my $othertitle = &mt('All users');
12012: if ($env{'request.course.id'}) {
1.668 raeburn 12013: $othertitle = &mt('Any users');
1.642 raeburn 12014: }
12015: my @types;
12016: if (ref($order) eq 'ARRAY') {
12017: @types = @{$order};
12018: }
12019: if (@types == 0) {
12020: if (ref($usertypes) eq 'HASH') {
12021: @types = sort(keys(%{$usertypes}));
12022: }
12023: }
12024: if (keys(%{$usertypes}) > 0) {
12025: $othertitle = &mt('Other users');
12026: }
12027: return ($othertitle,$usertypes,\@types);
12028: }
12029:
1.645 raeburn 12030: sub get_institutional_codes {
1.1361 raeburn 12031: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 12032: # Get complete list of course sections to update
12033: my @currsections = ();
12034: my @currxlists = ();
1.1361 raeburn 12035: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 12036: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 12037: my $crskey = $crs.':'.$coursecode;
12038: @{$unclutteredsec{$crskey}} = ();
12039: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 12040:
12041: if ($$settings{'internal.sectionnums'} ne '') {
12042: @currsections = split(/,/,$$settings{'internal.sectionnums'});
12043: }
12044:
12045: if ($$settings{'internal.crosslistings'} ne '') {
12046: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
12047: }
12048:
12049: if (@currxlists > 0) {
1.1361 raeburn 12050: foreach my $xl (@currxlists) {
12051: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 12052: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 12053: push(@{$allcourses},$1);
1.645 raeburn 12054: $$LC_code{$1} = $2;
12055: }
12056: }
12057: }
12058: }
1.1361 raeburn 12059:
1.645 raeburn 12060: if (@currsections > 0) {
1.1361 raeburn 12061: foreach my $sec (@currsections) {
12062: if ($sec =~ m/^(\w+):(\w*)$/ ) {
12063: my $instsec = $1;
1.645 raeburn 12064: my $lc_sec = $2;
1.1361 raeburn 12065: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
12066: push(@{$unclutteredsec{$crskey}},$instsec);
12067: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
12068: }
12069: }
12070: }
12071: }
12072:
12073: if (@{$unclutteredsec{$crskey}} > 0) {
12074: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
12075: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
12076: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
12077: my $sec = $coursecode.$formattedsec{$crskey}[$i];
12078: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 12079: push(@{$allcourses},$sec);
1.1361 raeburn 12080: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 12081: }
12082: }
12083: }
12084: }
12085: return;
12086: }
12087:
1.971 raeburn 12088: sub get_standard_codeitems {
12089: return ('Year','Semester','Department','Number','Section');
12090: }
12091:
1.112 bowersj2 12092: =pod
12093:
1.780 raeburn 12094: =head1 Slot Helpers
12095:
12096: =over 4
12097:
12098: =item * sorted_slots()
12099:
1.1040 raeburn 12100: Sorts an array of slot names in order of an optional sort key,
12101: default sort is by slot start time (earliest first).
1.780 raeburn 12102:
12103: Inputs:
12104:
12105: =over 4
12106:
12107: slotsarr - Reference to array of unsorted slot names.
12108:
12109: slots - Reference to hash of hash, where outer hash keys are slot names.
12110:
1.1040 raeburn 12111: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
12112:
1.549 albertel 12113: =back
12114:
1.780 raeburn 12115: Returns:
12116:
12117: =over 4
12118:
1.1040 raeburn 12119: sorted - An array of slot names sorted by a specified sort key
12120: (default sort key is start time of the slot).
1.780 raeburn 12121:
12122: =back
12123:
12124: =cut
12125:
12126:
12127: sub sorted_slots {
1.1040 raeburn 12128: my ($slotsarr,$slots,$sortkey) = @_;
12129: if ($sortkey eq '') {
12130: $sortkey = 'starttime';
12131: }
1.780 raeburn 12132: my @sorted;
12133: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
12134: @sorted =
12135: sort {
12136: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 12137: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 12138: }
12139: if (ref($slots->{$a})) { return -1;}
12140: if (ref($slots->{$b})) { return 1;}
12141: return 0;
12142: } @{$slotsarr};
12143: }
12144: return @sorted;
12145: }
12146:
1.1040 raeburn 12147: =pod
12148:
12149: =item * get_future_slots()
12150:
12151: Inputs:
12152:
12153: =over 4
12154:
12155: cnum - course number
12156:
12157: cdom - course domain
12158:
12159: now - current UNIX time
12160:
12161: symb - optional symb
12162:
12163: =back
12164:
12165: Returns:
12166:
12167: =over 4
12168:
12169: sorted_reservable - ref to array of student_schedulable slots currently
12170: reservable, ordered by end date of reservation period.
12171:
12172: reservable_now - ref to hash of student_schedulable slots currently
12173: reservable.
12174:
12175: Keys in inner hash are:
12176: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12177: (b) endreserve: end date of reservation period.
12178: (c) uniqueperiod: start,end dates when slot is to be uniquely
12179: selected.
1.1040 raeburn 12180:
12181: sorted_future - ref to array of student_schedulable slots reservable in
12182: the future, ordered by start date of reservation period.
12183:
12184: future_reservable - ref to hash of student_schedulable slots reservable
12185: in the future.
12186:
12187: Keys in inner hash are:
12188: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12189: (b) startreserve: start date of reservation period.
12190: (c) uniqueperiod: start,end dates when slot is to be uniquely
12191: selected.
1.1040 raeburn 12192:
12193: =back
12194:
12195: =cut
12196:
12197: sub get_future_slots {
12198: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 12199: my $map;
12200: if ($symb) {
12201: ($map) = &Apache::lonnet::decode_symb($symb);
12202: }
1.1040 raeburn 12203: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
12204: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
12205: foreach my $slot (keys(%slots)) {
12206: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
12207: if ($symb) {
1.1229 raeburn 12208: if ($slots{$slot}->{'symb'} ne '') {
12209: my $canuse;
12210: my %oksymbs;
12211: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
12212: map { $oksymbs{$_} = 1; } @slotsymbs;
12213: if ($oksymbs{$symb}) {
12214: $canuse = 1;
12215: } else {
12216: foreach my $item (@slotsymbs) {
12217: if ($item =~ /\.(page|sequence)$/) {
12218: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
12219: if (($map ne '') && ($map eq $sloturl)) {
12220: $canuse = 1;
12221: last;
12222: }
12223: }
12224: }
12225: }
12226: next unless ($canuse);
12227: }
1.1040 raeburn 12228: }
12229: if (($slots{$slot}->{'starttime'} > $now) &&
12230: ($slots{$slot}->{'endtime'} > $now)) {
12231: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
12232: my $userallowed = 0;
12233: if ($slots{$slot}->{'allowedsections'}) {
12234: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
12235: if (!defined($env{'request.role.sec'})
12236: && grep(/^No section assigned$/,@allowed_sec)) {
12237: $userallowed=1;
12238: } else {
12239: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
12240: $userallowed=1;
12241: }
12242: }
12243: unless ($userallowed) {
12244: if (defined($env{'request.course.groups'})) {
12245: my @groups = split(/:/,$env{'request.course.groups'});
12246: foreach my $group (@groups) {
12247: if (grep(/^\Q$group\E$/,@allowed_sec)) {
12248: $userallowed=1;
12249: last;
12250: }
12251: }
12252: }
12253: }
12254: }
12255: if ($slots{$slot}->{'allowedusers'}) {
12256: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
12257: my $user = $env{'user.name'}.':'.$env{'user.domain'};
12258: if (grep(/^\Q$user\E$/,@allowed_users)) {
12259: $userallowed = 1;
12260: }
12261: }
12262: next unless($userallowed);
12263: }
12264: my $startreserve = $slots{$slot}->{'startreserve'};
12265: my $endreserve = $slots{$slot}->{'endreserve'};
12266: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 12267: my $uniqueperiod;
12268: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
12269: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
12270: }
1.1040 raeburn 12271: if (($startreserve < $now) &&
12272: (!$endreserve || $endreserve > $now)) {
12273: my $lastres = $endreserve;
12274: if (!$lastres) {
12275: $lastres = $slots{$slot}->{'starttime'};
12276: }
12277: $reservable_now{$slot} = {
12278: symb => $symb,
1.1250 raeburn 12279: endreserve => $lastres,
12280: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12281: };
12282: } elsif (($startreserve > $now) &&
12283: (!$endreserve || $endreserve > $startreserve)) {
12284: $future_reservable{$slot} = {
12285: symb => $symb,
1.1250 raeburn 12286: startreserve => $startreserve,
12287: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12288: };
12289: }
12290: }
12291: }
12292: my @unsorted_reservable = keys(%reservable_now);
12293: if (@unsorted_reservable > 0) {
12294: @sorted_reservable =
12295: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
12296: }
12297: my @unsorted_future = keys(%future_reservable);
12298: if (@unsorted_future > 0) {
12299: @sorted_future =
12300: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
12301: }
12302: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
12303: }
1.780 raeburn 12304:
12305: =pod
12306:
1.1057 foxr 12307: =back
12308:
1.549 albertel 12309: =head1 HTTP Helpers
12310:
12311: =over 4
12312:
1.648 raeburn 12313: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 12314:
1.258 albertel 12315: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 12316: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 12317: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 12318:
12319: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
12320: $possible_names is an ref to an array of form element names. As an example:
12321: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 12322: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 12323:
12324: =cut
1.1 albertel 12325:
1.6 albertel 12326: sub get_unprocessed_cgi {
1.25 albertel 12327: my ($query,$possible_names)= @_;
1.26 matthew 12328: # $Apache::lonxml::debug=1;
1.356 albertel 12329: foreach my $pair (split(/&/,$query)) {
12330: my ($name, $value) = split(/=/,$pair);
1.369 www 12331: $name = &unescape($name);
1.25 albertel 12332: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
12333: $value =~ tr/+/ /;
12334: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 12335: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 12336: }
1.16 harris41 12337: }
1.6 albertel 12338: }
12339:
1.112 bowersj2 12340: =pod
12341:
1.648 raeburn 12342: =item * &cacheheader()
1.112 bowersj2 12343:
12344: returns cache-controlling header code
12345:
12346: =cut
12347:
1.7 albertel 12348: sub cacheheader {
1.258 albertel 12349: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 12350: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
12351: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 12352: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
12353: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 12354: return $output;
1.7 albertel 12355: }
12356:
1.112 bowersj2 12357: =pod
12358:
1.648 raeburn 12359: =item * &no_cache($r)
1.112 bowersj2 12360:
12361: specifies header code to not have cache
12362:
12363: =cut
12364:
1.9 albertel 12365: sub no_cache {
1.216 albertel 12366: my ($r) = @_;
12367: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 12368: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 12369: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
12370: $r->no_cache(1);
12371: $r->header_out("Expires" => $date);
12372: $r->header_out("Pragma" => "no-cache");
1.123 www 12373: }
12374:
12375: sub content_type {
1.181 albertel 12376: my ($r,$type,$charset) = @_;
1.299 foxr 12377: if ($r) {
12378: # Note that printout.pl calls this with undef for $r.
12379: &no_cache($r);
12380: }
1.258 albertel 12381: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 12382: unless ($charset) {
12383: $charset=&Apache::lonlocal::current_encoding;
12384: }
12385: if ($charset) { $type.='; charset='.$charset; }
12386: if ($r) {
12387: $r->content_type($type);
12388: } else {
12389: print("Content-type: $type\n\n");
12390: }
1.9 albertel 12391: }
1.25 albertel 12392:
1.112 bowersj2 12393: =pod
12394:
1.648 raeburn 12395: =item * &add_to_env($name,$value)
1.112 bowersj2 12396:
1.258 albertel 12397: adds $name to the %env hash with value
1.112 bowersj2 12398: $value, if $name already exists, the entry is converted to an array
12399: reference and $value is added to the array.
12400:
12401: =cut
12402:
1.25 albertel 12403: sub add_to_env {
12404: my ($name,$value)=@_;
1.258 albertel 12405: if (defined($env{$name})) {
12406: if (ref($env{$name})) {
1.25 albertel 12407: #already have multiple values
1.258 albertel 12408: push(@{ $env{$name} },$value);
1.25 albertel 12409: } else {
12410: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 12411: my $first=$env{$name};
12412: undef($env{$name});
12413: push(@{ $env{$name} },$first,$value);
1.25 albertel 12414: }
12415: } else {
1.258 albertel 12416: $env{$name}=$value;
1.25 albertel 12417: }
1.31 albertel 12418: }
1.149 albertel 12419:
12420: =pod
12421:
1.648 raeburn 12422: =item * &get_env_multiple($name)
1.149 albertel 12423:
1.258 albertel 12424: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 12425: values may be defined and end up as an array ref.
12426:
12427: returns an array of values
12428:
12429: =cut
12430:
12431: sub get_env_multiple {
12432: my ($name) = @_;
12433: my @values;
1.258 albertel 12434: if (defined($env{$name})) {
1.149 albertel 12435: # exists is it an array
1.258 albertel 12436: if (ref($env{$name})) {
12437: @values=@{ $env{$name} };
1.149 albertel 12438: } else {
1.258 albertel 12439: $values[0]=$env{$name};
1.149 albertel 12440: }
12441: }
12442: return(@values);
12443: }
12444:
1.1249 damieng 12445: # Looks at given dependencies, and returns something depending on the context.
12446: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
12447: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
12448: # For all other contexts, returns ($output, $counter, $numpathchg).
12449: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
12450: # $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.
12451: # $numpathchg: integer with the number of cleaned up dependency paths.
12452: # \%existing: hash reference clean path -> 1 only for existing dependencies.
12453: # \%mapping: hash reference clean path -> original path for all dependencies.
12454: # @param {string} actionurl - The path to the handler, indicative of the context.
12455: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
12456: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
12457: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
12458: # @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)
12459: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 12460: sub ask_for_embedded_content {
1.1249 damieng 12461: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 12462: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 12463: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 12464: %currsubfile,%unused,$rem);
1.1071 raeburn 12465: my $counter = 0;
12466: my $numnew = 0;
1.987 raeburn 12467: my $numremref = 0;
12468: my $numinvalid = 0;
12469: my $numpathchg = 0;
12470: my $numexisting = 0;
1.1071 raeburn 12471: my $numunused = 0;
12472: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 12473: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 12474: my $heading = &mt('Upload embedded files');
12475: my $buttontext = &mt('Upload');
12476:
1.1249 damieng 12477: # fills these variables based on the context:
12478: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
12479: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 12480: if ($env{'request.course.id'}) {
1.1123 raeburn 12481: if ($actionurl eq '/adm/dependencies') {
12482: $navmap = Apache::lonnavmaps::navmap->new();
12483: }
12484: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
12485: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 12486: }
1.1123 raeburn 12487: if (($actionurl eq '/adm/portfolio') ||
12488: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 12489: my $current_path='/';
12490: if ($env{'form.currentpath'}) {
12491: $current_path = $env{'form.currentpath'};
12492: }
12493: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 12494: $udom = $cdom;
12495: $uname = $cnum;
1.984 raeburn 12496: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
12497: } else {
12498: $udom = $env{'user.domain'};
12499: $uname = $env{'user.name'};
12500: $url = '/userfiles/portfolio';
12501: }
1.987 raeburn 12502: $toplevel = $url.'/';
1.984 raeburn 12503: $url .= $current_path;
12504: $getpropath = 1;
1.987 raeburn 12505: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12506: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12507: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12508: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12509: $toplevel = $url;
1.984 raeburn 12510: if ($rest ne '') {
1.987 raeburn 12511: $url .= $rest;
12512: }
12513: } elsif ($actionurl eq '/adm/coursedocs') {
12514: if (ref($args) eq 'HASH') {
1.1071 raeburn 12515: $url = $args->{'docs_url'};
12516: $toplevel = $url;
1.1084 raeburn 12517: if ($args->{'context'} eq 'paste') {
12518: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12519: ($path) =
12520: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12521: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12522: $fileloc =~ s{^/}{};
12523: }
1.1071 raeburn 12524: }
1.1084 raeburn 12525: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12526: if ($env{'request.course.id'} ne '') {
12527: if (ref($args) eq 'HASH') {
12528: $url = $args->{'docs_url'};
12529: $title = $args->{'docs_title'};
1.1126 raeburn 12530: $toplevel = $url;
12531: unless ($toplevel =~ m{^/}) {
12532: $toplevel = "/$url";
12533: }
1.1085 raeburn 12534: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12535: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12536: $path = $1;
12537: } else {
12538: ($path) =
12539: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12540: }
1.1195 raeburn 12541: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12542: $fileloc = $toplevel;
12543: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12544: my ($udom,$uname,$fname) =
12545: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12546: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12547: } else {
12548: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12549: }
1.1071 raeburn 12550: $fileloc =~ s{^/}{};
12551: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12552: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12553: }
1.987 raeburn 12554: }
1.1123 raeburn 12555: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12556: $udom = $cdom;
12557: $uname = $cnum;
12558: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12559: $toplevel = $url;
12560: $path = $url;
12561: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12562: $fileloc =~ s{^/}{};
1.987 raeburn 12563: }
1.1249 damieng 12564:
12565: # parses the dependency paths to get some info
12566: # fills $newfiles, $mapping, $subdependencies, $dependencies
12567: # $newfiles: hash URL -> 1 for new files or external URLs
12568: # (will be completed later)
12569: # $mapping:
12570: # for external URLs: external URL -> external URL
12571: # for relative paths: clean path -> original path
12572: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12573: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12574: foreach my $file (keys(%{$allfiles})) {
12575: my $embed_file;
12576: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12577: $embed_file = $1;
12578: } else {
12579: $embed_file = $file;
12580: }
1.1158 raeburn 12581: my ($absolutepath,$cleaned_file);
12582: if ($embed_file =~ m{^\w+://}) {
12583: $cleaned_file = $embed_file;
1.1147 raeburn 12584: $newfiles{$cleaned_file} = 1;
12585: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12586: } else {
1.1158 raeburn 12587: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12588: if ($embed_file =~ m{^/}) {
12589: $absolutepath = $embed_file;
12590: }
1.1147 raeburn 12591: if ($cleaned_file =~ m{/}) {
12592: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12593: $path = &check_for_traversal($path,$url,$toplevel);
12594: my $item = $fname;
12595: if ($path ne '') {
12596: $item = $path.'/'.$fname;
12597: $subdependencies{$path}{$fname} = 1;
12598: } else {
12599: $dependencies{$item} = 1;
12600: }
12601: if ($absolutepath) {
12602: $mapping{$item} = $absolutepath;
12603: } else {
12604: $mapping{$item} = $embed_file;
12605: }
12606: } else {
12607: $dependencies{$embed_file} = 1;
12608: if ($absolutepath) {
1.1147 raeburn 12609: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12610: } else {
1.1147 raeburn 12611: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12612: }
12613: }
1.984 raeburn 12614: }
12615: }
1.1249 damieng 12616:
12617: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12618: # and lists
12619: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12620: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12621: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12622: # the path had to be cleaned up
12623: # $existing: hash clean path -> 1 if the file exists
12624: # $numexisting: number of keys in $existing
12625: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12626: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12627: # dependency subdirectories that are
12628: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12629: my $dirptr = 16384;
1.984 raeburn 12630: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12631: $currsubfile{$path} = {};
1.1123 raeburn 12632: if (($actionurl eq '/adm/portfolio') ||
12633: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12634: my ($sublistref,$listerror) =
12635: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12636: if (ref($sublistref) eq 'ARRAY') {
12637: foreach my $line (@{$sublistref}) {
12638: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12639: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12640: }
1.984 raeburn 12641: }
1.987 raeburn 12642: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12643: if (opendir(my $dir,$url.'/'.$path)) {
12644: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12645: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12646: }
1.1084 raeburn 12647: } elsif (($actionurl eq '/adm/dependencies') ||
12648: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12649: ($args->{'context'} eq 'paste')) ||
12650: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12651: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12652: my $dir;
12653: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12654: $dir = $fileloc;
12655: } else {
12656: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12657: }
1.1071 raeburn 12658: if ($dir ne '') {
12659: my ($sublistref,$listerror) =
12660: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12661: if (ref($sublistref) eq 'ARRAY') {
12662: foreach my $line (@{$sublistref}) {
12663: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12664: undef,$mtime)=split(/\&/,$line,12);
12665: unless (($testdir&$dirptr) ||
12666: ($file_name =~ /^\.\.?$/)) {
12667: $currsubfile{$path}{$file_name} = [$size,$mtime];
12668: }
12669: }
12670: }
12671: }
1.984 raeburn 12672: }
12673: }
12674: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12675: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12676: my $item = $path.'/'.$file;
12677: unless ($mapping{$item} eq $item) {
12678: $pathchanges{$item} = 1;
12679: }
12680: $existing{$item} = 1;
12681: $numexisting ++;
12682: } else {
12683: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12684: }
12685: }
1.1071 raeburn 12686: if ($actionurl eq '/adm/dependencies') {
12687: foreach my $path (keys(%currsubfile)) {
12688: if (ref($currsubfile{$path}) eq 'HASH') {
12689: foreach my $file (keys(%{$currsubfile{$path}})) {
12690: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12691: next if (($rem ne '') &&
12692: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12693: (ref($navmap) &&
12694: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12695: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12696: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12697: $unused{$path.'/'.$file} = 1;
12698: }
12699: }
12700: }
12701: }
12702: }
1.984 raeburn 12703: }
1.1249 damieng 12704:
12705: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12706: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12707: my %currfile;
1.1123 raeburn 12708: if (($actionurl eq '/adm/portfolio') ||
12709: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12710: my ($dirlistref,$listerror) =
12711: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12712: if (ref($dirlistref) eq 'ARRAY') {
12713: foreach my $line (@{$dirlistref}) {
12714: my ($file_name,$rest) = split(/\&/,$line,2);
12715: $currfile{$file_name} = 1;
12716: }
1.984 raeburn 12717: }
1.987 raeburn 12718: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12719: if (opendir(my $dir,$url)) {
1.987 raeburn 12720: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12721: map {$currfile{$_} = 1;} @dir_list;
12722: }
1.1084 raeburn 12723: } elsif (($actionurl eq '/adm/dependencies') ||
12724: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12725: ($args->{'context'} eq 'paste')) ||
12726: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12727: if ($env{'request.course.id'} ne '') {
12728: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12729: if ($dir ne '') {
12730: my ($dirlistref,$listerror) =
12731: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12732: if (ref($dirlistref) eq 'ARRAY') {
12733: foreach my $line (@{$dirlistref}) {
12734: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12735: $size,undef,$mtime)=split(/\&/,$line,12);
12736: unless (($testdir&$dirptr) ||
12737: ($file_name =~ /^\.\.?$/)) {
12738: $currfile{$file_name} = [$size,$mtime];
12739: }
12740: }
12741: }
12742: }
12743: }
1.984 raeburn 12744: }
1.1249 damieng 12745: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12746: # are not in subdirectories, using $currfile
1.984 raeburn 12747: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12748: if (exists($currfile{$file})) {
1.987 raeburn 12749: unless ($mapping{$file} eq $file) {
12750: $pathchanges{$file} = 1;
12751: }
12752: $existing{$file} = 1;
12753: $numexisting ++;
12754: } else {
1.984 raeburn 12755: $newfiles{$file} = 1;
12756: }
12757: }
1.1071 raeburn 12758: foreach my $file (keys(%currfile)) {
12759: unless (($file eq $filename) ||
12760: ($file eq $filename.'.bak') ||
12761: ($dependencies{$file})) {
1.1085 raeburn 12762: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 12763: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12764: next if (($rem ne '') &&
12765: (($env{"httpref.$rem".$file} ne '') ||
12766: (ref($navmap) &&
12767: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12768: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12769: ($navmap->getResourceByUrl($rem.$1)))))));
12770: }
1.1085 raeburn 12771: }
1.1071 raeburn 12772: $unused{$file} = 1;
12773: }
12774: }
1.1249 damieng 12775:
12776: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 12777: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12778: ($args->{'context'} eq 'paste')) {
12779: $counter = scalar(keys(%existing));
12780: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 12781: return ($output,$counter,$numpathchg,\%existing);
12782: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12783: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12784: $counter = scalar(keys(%existing));
12785: $numpathchg = scalar(keys(%pathchanges));
12786: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 12787: }
1.1249 damieng 12788:
12789: # returns HTML otherwise, with dependency results and to ask for more uploads
12790:
12791: # $upload_output: missing dependencies (with upload form)
12792: # $modify_output: uploaded dependencies (in use)
12793: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 12794: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12795: if ($actionurl eq '/adm/dependencies') {
12796: next if ($embed_file =~ m{^\w+://});
12797: }
1.660 raeburn 12798: $upload_output .= &start_data_table_row().
1.1123 raeburn 12799: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12800: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12801: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 12802: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12803: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12804: }
1.1123 raeburn 12805: $upload_output .= '</td>';
1.1071 raeburn 12806: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 12807: $upload_output.='<td align="right">'.
12808: '<span class="LC_info LC_fontsize_medium">'.
12809: &mt("URL points to web address").'</span>';
1.987 raeburn 12810: $numremref++;
1.660 raeburn 12811: } elsif ($args->{'error_on_invalid_names'}
12812: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 12813: $upload_output.='<td align="right"><span class="LC_warning">'.
12814: &mt('Invalid characters').'</span>';
1.987 raeburn 12815: $numinvalid++;
1.660 raeburn 12816: } else {
1.1123 raeburn 12817: $upload_output .= '<td>'.
12818: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12819: $embed_file,\%mapping,
1.1071 raeburn 12820: $allfiles,$codebase,'upload');
12821: $counter ++;
12822: $numnew ++;
1.987 raeburn 12823: }
12824: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12825: }
12826: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12827: if ($actionurl eq '/adm/dependencies') {
12828: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12829: $modify_output .= &start_data_table_row().
12830: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12831: '<img src="'.&icon($embed_file).'" border="0" />'.
12832: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12833: '<td>'.$size.'</td>'.
12834: '<td>'.$mtime.'</td>'.
12835: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12836: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12837: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12838: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12839: &embedded_file_element('upload_embedded',$counter,
12840: $embed_file,\%mapping,
12841: $allfiles,$codebase,'modify').
12842: '</div></td>'.
12843: &end_data_table_row()."\n";
12844: $counter ++;
12845: } else {
12846: $upload_output .= &start_data_table_row().
1.1123 raeburn 12847: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12848: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12849: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12850: &Apache::loncommon::end_data_table_row()."\n";
12851: }
12852: }
12853: my $delidx = $counter;
12854: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12855: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12856: $delete_output .= &start_data_table_row().
12857: '<td><img src="'.&icon($oldfile).'" />'.
12858: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12859: '<td>'.$size.'</td>'.
12860: '<td>'.$mtime.'</td>'.
12861: '<td><label><input type="checkbox" name="del_upload_dep" '.
12862: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12863: &embedded_file_element('upload_embedded',$delidx,
12864: $oldfile,\%mapping,$allfiles,
12865: $codebase,'delete').'</td>'.
12866: &end_data_table_row()."\n";
12867: $numunused ++;
12868: $delidx ++;
1.987 raeburn 12869: }
12870: if ($upload_output) {
12871: $upload_output = &start_data_table().
12872: $upload_output.
12873: &end_data_table()."\n";
12874: }
1.1071 raeburn 12875: if ($modify_output) {
12876: $modify_output = &start_data_table().
12877: &start_data_table_header_row().
12878: '<th>'.&mt('File').'</th>'.
12879: '<th>'.&mt('Size (KB)').'</th>'.
12880: '<th>'.&mt('Modified').'</th>'.
12881: '<th>'.&mt('Upload replacement?').'</th>'.
12882: &end_data_table_header_row().
12883: $modify_output.
12884: &end_data_table()."\n";
12885: }
12886: if ($delete_output) {
12887: $delete_output = &start_data_table().
12888: &start_data_table_header_row().
12889: '<th>'.&mt('File').'</th>'.
12890: '<th>'.&mt('Size (KB)').'</th>'.
12891: '<th>'.&mt('Modified').'</th>'.
12892: '<th>'.&mt('Delete?').'</th>'.
12893: &end_data_table_header_row().
12894: $delete_output.
12895: &end_data_table()."\n";
12896: }
1.987 raeburn 12897: my $applies = 0;
12898: if ($numremref) {
12899: $applies ++;
12900: }
12901: if ($numinvalid) {
12902: $applies ++;
12903: }
12904: if ($numexisting) {
12905: $applies ++;
12906: }
1.1071 raeburn 12907: if ($counter || $numunused) {
1.987 raeburn 12908: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12909: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12910: $state.'<h3>'.$heading.'</h3>';
12911: if ($actionurl eq '/adm/dependencies') {
12912: if ($numnew) {
12913: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12914: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12915: $upload_output.'<br />'."\n";
12916: }
12917: if ($numexisting) {
12918: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12919: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12920: $modify_output.'<br />'."\n";
12921: $buttontext = &mt('Save changes');
12922: }
12923: if ($numunused) {
12924: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12925: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12926: $delete_output.'<br />'."\n";
12927: $buttontext = &mt('Save changes');
12928: }
12929: } else {
12930: $output .= $upload_output.'<br />'."\n";
12931: }
12932: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12933: $counter.'" />'."\n";
12934: if ($actionurl eq '/adm/dependencies') {
12935: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12936: $numnew.'" />'."\n";
12937: } elsif ($actionurl eq '') {
1.987 raeburn 12938: $output .= '<input type="hidden" name="phase" value="three" />';
12939: }
12940: } elsif ($applies) {
12941: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12942: if ($applies > 1) {
12943: $output .=
1.1123 raeburn 12944: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12945: if ($numremref) {
12946: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12947: }
12948: if ($numinvalid) {
12949: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12950: }
12951: if ($numexisting) {
12952: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12953: }
12954: $output .= '</ul><br />';
12955: } elsif ($numremref) {
12956: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12957: } elsif ($numinvalid) {
12958: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12959: } elsif ($numexisting) {
12960: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12961: }
12962: $output .= $upload_output.'<br />';
12963: }
12964: my ($pathchange_output,$chgcount);
1.1071 raeburn 12965: $chgcount = $counter;
1.987 raeburn 12966: if (keys(%pathchanges) > 0) {
12967: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12968: if ($counter) {
1.987 raeburn 12969: $output .= &embedded_file_element('pathchange',$chgcount,
12970: $embed_file,\%mapping,
1.1071 raeburn 12971: $allfiles,$codebase,'change');
1.987 raeburn 12972: } else {
12973: $pathchange_output .=
12974: &start_data_table_row().
12975: '<td><input type ="checkbox" name="namechange" value="'.
12976: $chgcount.'" checked="checked" /></td>'.
12977: '<td>'.$mapping{$embed_file}.'</td>'.
12978: '<td>'.$embed_file.
12979: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12980: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12981: '</td>'.&end_data_table_row();
1.660 raeburn 12982: }
1.987 raeburn 12983: $numpathchg ++;
12984: $chgcount ++;
1.660 raeburn 12985: }
12986: }
1.1127 raeburn 12987: if (($counter) || ($numunused)) {
1.987 raeburn 12988: if ($numpathchg) {
12989: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12990: $numpathchg.'" />'."\n";
12991: }
12992: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12993: ($actionurl eq '/adm/imsimport')) {
12994: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12995: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12996: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12997: } elsif ($actionurl eq '/adm/dependencies') {
12998: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12999: }
1.1123 raeburn 13000: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 13001: } elsif ($numpathchg) {
13002: my %pathchange = ();
13003: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
13004: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
13005: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 13006: }
1.987 raeburn 13007: }
1.1071 raeburn 13008: return ($output,$counter,$numpathchg);
1.987 raeburn 13009: }
13010:
1.1147 raeburn 13011: =pod
13012:
13013: =item * clean_path($name)
13014:
13015: Performs clean-up of directories, subdirectories and filename in an
13016: embedded object, referenced in an HTML file which is being uploaded
13017: to a course or portfolio, where
13018: "Upload embedded images/multimedia files if HTML file" checkbox was
13019: checked.
13020:
13021: Clean-up is similar to replacements in lonnet::clean_filename()
13022: except each / between sub-directory and next level is preserved.
13023:
13024: =cut
13025:
13026: sub clean_path {
13027: my ($embed_file) = @_;
13028: $embed_file =~s{^/+}{};
13029: my @contents;
13030: if ($embed_file =~ m{/}) {
13031: @contents = split(/\//,$embed_file);
13032: } else {
13033: @contents = ($embed_file);
13034: }
13035: my $lastidx = scalar(@contents)-1;
13036: for (my $i=0; $i<=$lastidx; $i++) {
13037: $contents[$i]=~s{\\}{/}g;
13038: $contents[$i]=~s/\s+/\_/g;
13039: $contents[$i]=~s{[^/\w\.\-]}{}g;
13040: if ($i == $lastidx) {
13041: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
13042: }
13043: }
13044: if ($lastidx > 0) {
13045: return join('/',@contents);
13046: } else {
13047: return $contents[0];
13048: }
13049: }
13050:
1.987 raeburn 13051: sub embedded_file_element {
1.1071 raeburn 13052: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 13053: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
13054: (ref($codebase) eq 'HASH'));
13055: my $output;
1.1071 raeburn 13056: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 13057: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
13058: }
13059: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
13060: &escape($embed_file).'" />';
13061: unless (($context eq 'upload_embedded') &&
13062: ($mapping->{$embed_file} eq $embed_file)) {
13063: $output .='
13064: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
13065: }
13066: my $attrib;
13067: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
13068: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
13069: }
13070: $output .=
13071: "\n\t\t".
13072: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
13073: $attrib.'" />';
13074: if (exists($codebase->{$mapping->{$embed_file}})) {
13075: $output .=
13076: "\n\t\t".
13077: '<input name="codebase_'.$num.'" type="hidden" value="'.
13078: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 13079: }
1.987 raeburn 13080: return $output;
1.660 raeburn 13081: }
13082:
1.1071 raeburn 13083: sub get_dependency_details {
13084: my ($currfile,$currsubfile,$embed_file) = @_;
13085: my ($size,$mtime,$showsize,$showmtime);
13086: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
13087: if ($embed_file =~ m{/}) {
13088: my ($path,$fname) = split(/\//,$embed_file);
13089: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
13090: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
13091: }
13092: } else {
13093: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
13094: ($size,$mtime) = @{$currfile->{$embed_file}};
13095: }
13096: }
13097: $showsize = $size/1024.0;
13098: $showsize = sprintf("%.1f",$showsize);
13099: if ($mtime > 0) {
13100: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
13101: }
13102: }
13103: return ($showsize,$showmtime);
13104: }
13105:
13106: sub ask_embedded_js {
13107: return <<"END";
13108: <script type="text/javascript"">
13109: // <![CDATA[
13110: function toggleBrowse(counter) {
13111: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
13112: var fileid = document.getElementById('embedded_item_'+counter);
13113: var uploaddivid = document.getElementById('moduploaddep_'+counter);
13114: if (chkboxid.checked == true) {
13115: uploaddivid.style.display='block';
13116: } else {
13117: uploaddivid.style.display='none';
13118: fileid.value = '';
13119: }
13120: }
13121: // ]]>
13122: </script>
13123:
13124: END
13125: }
13126:
1.661 raeburn 13127: sub upload_embedded {
13128: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 13129: $current_disk_usage,$hiddenstate,$actionurl) = @_;
13130: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 13131: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
13132: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
13133: my $orig_uploaded_filename =
13134: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 13135: foreach my $type ('orig','ref','attrib','codebase') {
13136: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
13137: $env{'form.embedded_'.$type.'_'.$i} =
13138: &unescape($env{'form.embedded_'.$type.'_'.$i});
13139: }
13140: }
1.661 raeburn 13141: my ($path,$fname) =
13142: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
13143: # no path, whole string is fname
13144: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
13145: $fname = &Apache::lonnet::clean_filename($fname);
13146: # See if there is anything left
13147: next if ($fname eq '');
13148:
13149: # Check if file already exists as a file or directory.
13150: my ($state,$msg);
13151: if ($context eq 'portfolio') {
13152: my $port_path = $dirpath;
13153: if ($group ne '') {
13154: $port_path = "groups/$group/$port_path";
13155: }
1.987 raeburn 13156: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
13157: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 13158: $dir_root,$port_path,$disk_quota,
13159: $current_disk_usage,$uname,$udom);
13160: if ($state eq 'will_exceed_quota'
1.984 raeburn 13161: || $state eq 'file_locked') {
1.661 raeburn 13162: $output .= $msg;
13163: next;
13164: }
13165: } elsif (($context eq 'author') || ($context eq 'testbank')) {
13166: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
13167: if ($state eq 'exists') {
13168: $output .= $msg;
13169: next;
13170: }
13171: }
13172: # Check if extension is valid
13173: if (($fname =~ /\.(\w+)$/) &&
13174: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 13175: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
13176: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 13177: next;
13178: } elsif (($fname =~ /\.(\w+)$/) &&
13179: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 13180: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 13181: next;
13182: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 13183: $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 13184: next;
13185: }
13186: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 13187: my $subdir = $path;
13188: $subdir =~ s{/+$}{};
1.661 raeburn 13189: if ($context eq 'portfolio') {
1.984 raeburn 13190: my $result;
13191: if ($state eq 'existingfile') {
13192: $result=
13193: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 13194: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 13195: } else {
1.984 raeburn 13196: $result=
13197: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 13198: $dirpath.
1.1123 raeburn 13199: $env{'form.currentpath'}.$subdir);
1.984 raeburn 13200: if ($result !~ m|^/uploaded/|) {
13201: $output .= '<span class="LC_error">'
13202: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13203: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13204: .'</span><br />';
13205: next;
13206: } else {
1.987 raeburn 13207: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13208: $path.$fname.'</span>').'<br />';
1.984 raeburn 13209: }
1.661 raeburn 13210: }
1.1123 raeburn 13211: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 13212: my $extendedsubdir = $dirpath.'/'.$subdir;
13213: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 13214: my $result =
1.1126 raeburn 13215: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 13216: if ($result !~ m|^/uploaded/|) {
13217: $output .= '<span class="LC_error">'
13218: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13219: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13220: .'</span><br />';
13221: next;
13222: } else {
13223: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13224: $path.$fname.'</span>').'<br />';
1.1125 raeburn 13225: if ($context eq 'syllabus') {
13226: &Apache::lonnet::make_public_indefinitely($result);
13227: }
1.987 raeburn 13228: }
1.661 raeburn 13229: } else {
13230: # Save the file
13231: my $target = $env{'form.embedded_item_'.$i};
13232: my $fullpath = $dir_root.$dirpath.'/'.$path;
13233: my $dest = $fullpath.$fname;
13234: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 13235: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 13236: my $count;
13237: my $filepath = $dir_root;
1.1027 raeburn 13238: foreach my $subdir (@parts) {
13239: $filepath .= "/$subdir";
13240: if (!-e $filepath) {
1.661 raeburn 13241: mkdir($filepath,0770);
13242: }
13243: }
13244: my $fh;
13245: if (!open($fh,'>'.$dest)) {
13246: &Apache::lonnet::logthis('Failed to create '.$dest);
13247: $output .= '<span class="LC_error">'.
1.1071 raeburn 13248: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
13249: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13250: '</span><br />';
13251: } else {
13252: if (!print $fh $env{'form.embedded_item_'.$i}) {
13253: &Apache::lonnet::logthis('Failed to write to '.$dest);
13254: $output .= '<span class="LC_error">'.
1.1071 raeburn 13255: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
13256: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13257: '</span><br />';
13258: } else {
1.987 raeburn 13259: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13260: $url.'</span>').'<br />';
13261: unless ($context eq 'testbank') {
13262: $footer .= &mt('View embedded file: [_1]',
13263: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
13264: }
13265: }
13266: close($fh);
13267: }
13268: }
13269: if ($env{'form.embedded_ref_'.$i}) {
13270: $pathchange{$i} = 1;
13271: }
13272: }
13273: if ($output) {
13274: $output = '<p>'.$output.'</p>';
13275: }
13276: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
13277: $returnflag = 'ok';
1.1071 raeburn 13278: my $numpathchgs = scalar(keys(%pathchange));
13279: if ($numpathchgs > 0) {
1.987 raeburn 13280: if ($context eq 'portfolio') {
13281: $output .= '<p>'.&mt('or').'</p>';
13282: } elsif ($context eq 'testbank') {
1.1071 raeburn 13283: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
13284: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 13285: $returnflag = 'modify_orightml';
13286: }
13287: }
1.1071 raeburn 13288: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 13289: }
13290:
13291: sub modify_html_form {
13292: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
13293: my $end = 0;
13294: my $modifyform;
13295: if ($context eq 'upload_embedded') {
13296: return unless (ref($pathchange) eq 'HASH');
13297: if ($env{'form.number_embedded_items'}) {
13298: $end += $env{'form.number_embedded_items'};
13299: }
13300: if ($env{'form.number_pathchange_items'}) {
13301: $end += $env{'form.number_pathchange_items'};
13302: }
13303: if ($end) {
13304: for (my $i=0; $i<$end; $i++) {
13305: if ($i < $env{'form.number_embedded_items'}) {
13306: next unless($pathchange->{$i});
13307: }
13308: $modifyform .=
13309: &start_data_table_row().
13310: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
13311: 'checked="checked" /></td>'.
13312: '<td>'.$env{'form.embedded_ref_'.$i}.
13313: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
13314: &escape($env{'form.embedded_ref_'.$i}).'" />'.
13315: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
13316: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
13317: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
13318: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
13319: '<td>'.$env{'form.embedded_orig_'.$i}.
13320: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
13321: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
13322: &end_data_table_row();
1.1071 raeburn 13323: }
1.987 raeburn 13324: }
13325: } else {
13326: $modifyform = $pathchgtable;
13327: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
13328: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
13329: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
13330: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
13331: }
13332: }
13333: if ($modifyform) {
1.1071 raeburn 13334: if ($actionurl eq '/adm/dependencies') {
13335: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
13336: }
1.987 raeburn 13337: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
13338: '<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".
13339: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
13340: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
13341: '</ol></p>'."\n".'<p>'.
13342: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
13343: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
13344: &start_data_table()."\n".
13345: &start_data_table_header_row().
13346: '<th>'.&mt('Change?').'</th>'.
13347: '<th>'.&mt('Current reference').'</th>'.
13348: '<th>'.&mt('Required reference').'</th>'.
13349: &end_data_table_header_row()."\n".
13350: $modifyform.
13351: &end_data_table().'<br />'."\n".$hiddenstate.
13352: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
13353: '</form>'."\n";
13354: }
13355: return;
13356: }
13357:
13358: sub modify_html_refs {
1.1123 raeburn 13359: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 13360: my $container;
13361: if ($context eq 'portfolio') {
13362: $container = $env{'form.container'};
13363: } elsif ($context eq 'coursedoc') {
13364: $container = $env{'form.primaryurl'};
1.1071 raeburn 13365: } elsif ($context eq 'manage_dependencies') {
13366: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
13367: $container = "/$container";
1.1123 raeburn 13368: } elsif ($context eq 'syllabus') {
13369: $container = $url;
1.987 raeburn 13370: } else {
1.1027 raeburn 13371: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 13372: }
13373: my (%allfiles,%codebase,$output,$content);
13374: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 13375: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 13376: if (wantarray) {
13377: return ('',0,0);
13378: } else {
13379: return;
13380: }
13381: }
13382: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13383: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 13384: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
13385: if (wantarray) {
13386: return ('',0,0);
13387: } else {
13388: return;
13389: }
13390: }
1.987 raeburn 13391: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 13392: if ($content eq '-1') {
13393: if (wantarray) {
13394: return ('',0,0);
13395: } else {
13396: return;
13397: }
13398: }
1.987 raeburn 13399: } else {
1.1071 raeburn 13400: unless ($container =~ /^\Q$dir_root\E/) {
13401: if (wantarray) {
13402: return ('',0,0);
13403: } else {
13404: return;
13405: }
13406: }
1.1317 raeburn 13407: if (open(my $fh,'<',$container)) {
1.987 raeburn 13408: $content = join('', <$fh>);
13409: close($fh);
13410: } else {
1.1071 raeburn 13411: if (wantarray) {
13412: return ('',0,0);
13413: } else {
13414: return;
13415: }
1.987 raeburn 13416: }
13417: }
13418: my ($count,$codebasecount) = (0,0);
13419: my $mm = new File::MMagic;
13420: my $mime_type = $mm->checktype_contents($content);
13421: if ($mime_type eq 'text/html') {
13422: my $parse_result =
13423: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
13424: \%codebase,\$content);
13425: if ($parse_result eq 'ok') {
13426: foreach my $i (@changes) {
13427: my $orig = &unescape($env{'form.embedded_orig_'.$i});
13428: my $ref = &unescape($env{'form.embedded_ref_'.$i});
13429: if ($allfiles{$ref}) {
13430: my $newname = $orig;
13431: my ($attrib_regexp,$codebase);
1.1006 raeburn 13432: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 13433: if ($attrib_regexp =~ /:/) {
13434: $attrib_regexp =~ s/\:/|/g;
13435: }
13436: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13437: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13438: $count += $numchg;
1.1123 raeburn 13439: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 13440: delete($allfiles{$ref});
1.987 raeburn 13441: }
13442: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 13443: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 13444: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
13445: $codebasecount ++;
13446: }
13447: }
13448: }
1.1123 raeburn 13449: my $skiprewrites;
1.987 raeburn 13450: if ($count || $codebasecount) {
13451: my $saveresult;
1.1071 raeburn 13452: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13453: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 13454: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13455: if ($url eq $container) {
13456: my ($fname) = ($container =~ m{/([^/]+)$});
13457: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13458: $count,'<span class="LC_filename">'.
1.1071 raeburn 13459: $fname.'</span>').'</p>';
1.987 raeburn 13460: } else {
13461: $output = '<p class="LC_error">'.
13462: &mt('Error: update failed for: [_1].',
13463: '<span class="LC_filename">'.
13464: $container.'</span>').'</p>';
13465: }
1.1123 raeburn 13466: if ($context eq 'syllabus') {
13467: unless ($saveresult eq 'ok') {
13468: $skiprewrites = 1;
13469: }
13470: }
1.987 raeburn 13471: } else {
1.1317 raeburn 13472: if (open(my $fh,'>',$container)) {
1.987 raeburn 13473: print $fh $content;
13474: close($fh);
13475: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13476: $count,'<span class="LC_filename">'.
13477: $container.'</span>').'</p>';
1.661 raeburn 13478: } else {
1.987 raeburn 13479: $output = '<p class="LC_error">'.
13480: &mt('Error: could not update [_1].',
13481: '<span class="LC_filename">'.
13482: $container.'</span>').'</p>';
1.661 raeburn 13483: }
13484: }
13485: }
1.1123 raeburn 13486: if (($context eq 'syllabus') && (!$skiprewrites)) {
13487: my ($actionurl,$state);
13488: $actionurl = "/public/$udom/$uname/syllabus";
13489: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
13490: &ask_for_embedded_content($actionurl,$state,\%allfiles,
13491: \%codebase,
13492: {'context' => 'rewrites',
13493: 'ignore_remote_references' => 1,});
13494: if (ref($mapping) eq 'HASH') {
13495: my $rewrites = 0;
13496: foreach my $key (keys(%{$mapping})) {
13497: next if ($key =~ m{^https?://});
13498: my $ref = $mapping->{$key};
13499: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13500: my $attrib;
13501: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13502: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13503: }
13504: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13505: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13506: $rewrites += $numchg;
13507: }
13508: }
13509: if ($rewrites) {
13510: my $saveresult;
13511: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13512: if ($url eq $container) {
13513: my ($fname) = ($container =~ m{/([^/]+)$});
13514: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13515: $count,'<span class="LC_filename">'.
13516: $fname.'</span>').'</p>';
13517: } else {
13518: $output .= '<p class="LC_error">'.
13519: &mt('Error: could not update links in [_1].',
13520: '<span class="LC_filename">'.
13521: $container.'</span>').'</p>';
13522:
13523: }
13524: }
13525: }
13526: }
1.987 raeburn 13527: } else {
13528: &logthis('Failed to parse '.$container.
13529: ' to modify references: '.$parse_result);
1.661 raeburn 13530: }
13531: }
1.1071 raeburn 13532: if (wantarray) {
13533: return ($output,$count,$codebasecount);
13534: } else {
13535: return $output;
13536: }
1.661 raeburn 13537: }
13538:
13539: sub check_for_existing {
13540: my ($path,$fname,$element) = @_;
13541: my ($state,$msg);
13542: if (-d $path.'/'.$fname) {
13543: $state = 'exists';
13544: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13545: } elsif (-e $path.'/'.$fname) {
13546: $state = 'exists';
13547: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13548: }
13549: if ($state eq 'exists') {
13550: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13551: }
13552: return ($state,$msg);
13553: }
13554:
13555: sub check_for_upload {
13556: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13557: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13558: my $filesize = length($env{'form.'.$element});
13559: if (!$filesize) {
13560: my $msg = '<span class="LC_error">'.
13561: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13562: '<span class="LC_filename">'.$fname.'</span>',
13563: $filesize).'<br />'.
1.1007 raeburn 13564: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13565: '</span>';
13566: return ('zero_bytes',$msg);
13567: }
13568: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13569: my $getpropath = 1;
1.1021 raeburn 13570: my ($dirlistref,$listerror) =
13571: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13572: my $found_file = 0;
13573: my $locked_file = 0;
1.991 raeburn 13574: my @lockers;
13575: my $navmap;
13576: if ($env{'request.course.id'}) {
13577: $navmap = Apache::lonnavmaps::navmap->new();
13578: }
1.1021 raeburn 13579: if (ref($dirlistref) eq 'ARRAY') {
13580: foreach my $line (@{$dirlistref}) {
13581: my ($file_name,$rest)=split(/\&/,$line,2);
13582: if ($file_name eq $fname){
13583: $file_name = $path.$file_name;
13584: if ($group ne '') {
13585: $file_name = $group.$file_name;
13586: }
13587: $found_file = 1;
13588: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13589: foreach my $lock (@lockers) {
13590: if (ref($lock) eq 'ARRAY') {
13591: my ($symb,$crsid) = @{$lock};
13592: if ($crsid eq $env{'request.course.id'}) {
13593: if (ref($navmap)) {
13594: my $res = $navmap->getBySymb($symb);
13595: foreach my $part (@{$res->parts()}) {
13596: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13597: unless (($slot_status == $res->RESERVED) ||
13598: ($slot_status == $res->RESERVED_LOCATION)) {
13599: $locked_file = 1;
13600: }
1.991 raeburn 13601: }
1.1021 raeburn 13602: } else {
13603: $locked_file = 1;
1.991 raeburn 13604: }
13605: } else {
13606: $locked_file = 1;
13607: }
13608: }
1.1021 raeburn 13609: }
13610: } else {
13611: my @info = split(/\&/,$rest);
13612: my $currsize = $info[6]/1000;
13613: if ($currsize < $filesize) {
13614: my $extra = $filesize - $currsize;
13615: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13616: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13617: &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 13618: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13619: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13620: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13621: return ('will_exceed_quota',$msg);
13622: }
1.984 raeburn 13623: }
13624: }
1.661 raeburn 13625: }
13626: }
13627: }
13628: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13629: my $msg = '<p class="LC_warning">'.
13630: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13631: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13632: return ('will_exceed_quota',$msg);
13633: } elsif ($found_file) {
13634: if ($locked_file) {
1.1179 bisitz 13635: my $msg = '<p class="LC_warning">';
1.661 raeburn 13636: $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 13637: $msg .= '</p>';
1.661 raeburn 13638: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13639: return ('file_locked',$msg);
13640: } else {
1.1179 bisitz 13641: my $msg = '<p class="LC_error">';
1.984 raeburn 13642: $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 13643: $msg .= '</p>';
1.984 raeburn 13644: return ('existingfile',$msg);
1.661 raeburn 13645: }
13646: }
13647: }
13648:
1.987 raeburn 13649: sub check_for_traversal {
13650: my ($path,$url,$toplevel) = @_;
13651: my @parts=split(/\//,$path);
13652: my $cleanpath;
13653: my $fullpath = $url;
13654: for (my $i=0;$i<@parts;$i++) {
13655: next if ($parts[$i] eq '.');
13656: if ($parts[$i] eq '..') {
13657: $fullpath =~ s{([^/]+/)$}{};
13658: } else {
13659: $fullpath .= $parts[$i].'/';
13660: }
13661: }
13662: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13663: $cleanpath = $1;
13664: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13665: my $curr_toprel = $1;
13666: my @parts = split(/\//,$curr_toprel);
13667: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13668: my @urlparts = split(/\//,$url_toprel);
13669: my $doubledots;
13670: my $startdiff = -1;
13671: for (my $i=0; $i<@urlparts; $i++) {
13672: if ($startdiff == -1) {
13673: unless ($urlparts[$i] eq $parts[$i]) {
13674: $startdiff = $i;
13675: $doubledots .= '../';
13676: }
13677: } else {
13678: $doubledots .= '../';
13679: }
13680: }
13681: if ($startdiff > -1) {
13682: $cleanpath = $doubledots;
13683: for (my $i=$startdiff; $i<@parts; $i++) {
13684: $cleanpath .= $parts[$i].'/';
13685: }
13686: }
13687: }
13688: $cleanpath =~ s{(/)$}{};
13689: return $cleanpath;
13690: }
1.31 albertel 13691:
1.1053 raeburn 13692: sub is_archive_file {
13693: my ($mimetype) = @_;
13694: if (($mimetype eq 'application/octet-stream') ||
13695: ($mimetype eq 'application/x-stuffit') ||
13696: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13697: return 1;
13698: }
13699: return;
13700: }
13701:
13702: sub decompress_form {
1.1065 raeburn 13703: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13704: my %lt = &Apache::lonlocal::texthash (
13705: this => 'This file is an archive file.',
1.1067 raeburn 13706: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13707: itsc => 'Its contents are as follows:',
1.1053 raeburn 13708: youm => 'You may wish to extract its contents.',
13709: extr => 'Extract contents',
1.1067 raeburn 13710: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13711: proa => 'Process automatically?',
1.1053 raeburn 13712: yes => 'Yes',
13713: no => 'No',
1.1067 raeburn 13714: fold => 'Title for folder containing movie',
13715: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13716: );
1.1065 raeburn 13717: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13718: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13719: my $info = &list_archive_contents($fileloc,\@paths);
13720: if (@paths) {
13721: foreach my $path (@paths) {
13722: $path =~ s{^/}{};
1.1067 raeburn 13723: if ($path =~ m{^([^/]+)/$}) {
13724: $topdir = $1;
13725: }
1.1065 raeburn 13726: if ($path =~ m{^([^/]+)/}) {
13727: $toplevel{$1} = $path;
13728: } else {
13729: $toplevel{$path} = $path;
13730: }
13731: }
13732: }
1.1067 raeburn 13733: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13734: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13735: "$topdir/media/",
13736: "$topdir/media/$topdir.mp4",
13737: "$topdir/media/FirstFrame.png",
13738: "$topdir/media/player.swf",
13739: "$topdir/media/swfobject.js",
13740: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13741: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13742: "$topdir/$topdir.mp4",
13743: "$topdir/$topdir\_config.xml",
13744: "$topdir/$topdir\_controller.swf",
13745: "$topdir/$topdir\_embed.css",
13746: "$topdir/$topdir\_First_Frame.png",
13747: "$topdir/$topdir\_player.html",
13748: "$topdir/$topdir\_Thumbnails.png",
13749: "$topdir/playerProductInstall.swf",
13750: "$topdir/scripts/",
13751: "$topdir/scripts/config_xml.js",
13752: "$topdir/scripts/handlebars.js",
13753: "$topdir/scripts/jquery-1.7.1.min.js",
13754: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13755: "$topdir/scripts/modernizr.js",
13756: "$topdir/scripts/player-min.js",
13757: "$topdir/scripts/swfobject.js",
13758: "$topdir/skins/",
13759: "$topdir/skins/configuration_express.xml",
13760: "$topdir/skins/express_show/",
13761: "$topdir/skins/express_show/player-min.css",
13762: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 13763: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13764: "$topdir/$topdir.mp4",
13765: "$topdir/$topdir\_config.xml",
13766: "$topdir/$topdir\_controller.swf",
13767: "$topdir/$topdir\_embed.css",
13768: "$topdir/$topdir\_First_Frame.png",
13769: "$topdir/$topdir\_player.html",
13770: "$topdir/$topdir\_Thumbnails.png",
13771: "$topdir/playerProductInstall.swf",
13772: "$topdir/scripts/",
13773: "$topdir/scripts/config_xml.js",
13774: "$topdir/scripts/techsmith-smart-player.min.js",
13775: "$topdir/skins/",
13776: "$topdir/skins/configuration_express.xml",
13777: "$topdir/skins/express_show/",
13778: "$topdir/skins/express_show/spritesheet.min.css",
13779: "$topdir/skins/express_show/spritesheet.png",
13780: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 13781: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13782: if (@diffs == 0) {
1.1164 raeburn 13783: $is_camtasia = 6;
13784: } else {
1.1197 raeburn 13785: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 13786: if (@diffs == 0) {
13787: $is_camtasia = 8;
1.1197 raeburn 13788: } else {
13789: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13790: if (@diffs == 0) {
13791: $is_camtasia = 8;
13792: }
1.1164 raeburn 13793: }
1.1067 raeburn 13794: }
13795: }
13796: my $output;
13797: if ($is_camtasia) {
13798: $output = <<"ENDCAM";
13799: <script type="text/javascript" language="Javascript">
13800: // <![CDATA[
13801:
13802: function camtasiaToggle() {
13803: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13804: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 13805: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13806: document.getElementById('camtasia_titles').style.display='block';
13807: } else {
13808: document.getElementById('camtasia_titles').style.display='none';
13809: }
13810: }
13811: }
13812: return;
13813: }
13814:
13815: // ]]>
13816: </script>
13817: <p>$lt{'camt'}</p>
13818: ENDCAM
1.1065 raeburn 13819: } else {
1.1067 raeburn 13820: $output = '<p>'.$lt{'this'};
13821: if ($info eq '') {
13822: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13823: } else {
13824: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13825: '<div><pre>'.$info.'</pre></div>';
13826: }
1.1065 raeburn 13827: }
1.1067 raeburn 13828: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13829: my $duplicates;
13830: my $num = 0;
13831: if (ref($dirlist) eq 'ARRAY') {
13832: foreach my $item (@{$dirlist}) {
13833: if (ref($item) eq 'ARRAY') {
13834: if (exists($toplevel{$item->[0]})) {
13835: $duplicates .=
13836: &start_data_table_row().
13837: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13838: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13839: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13840: 'value="1" />'.&mt('Yes').'</label>'.
13841: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13842: '<td>'.$item->[0].'</td>';
13843: if ($item->[2]) {
13844: $duplicates .= '<td>'.&mt('Directory').'</td>';
13845: } else {
13846: $duplicates .= '<td>'.&mt('File').'</td>';
13847: }
13848: $duplicates .= '<td>'.$item->[3].'</td>'.
13849: '<td>'.
13850: &Apache::lonlocal::locallocaltime($item->[4]).
13851: '</td>'.
13852: &end_data_table_row();
13853: $num ++;
13854: }
13855: }
13856: }
13857: }
13858: my $itemcount;
13859: if (@paths > 0) {
13860: $itemcount = scalar(@paths);
13861: } else {
13862: $itemcount = 1;
13863: }
1.1067 raeburn 13864: if ($is_camtasia) {
13865: $output .= $lt{'auto'}.'<br />'.
13866: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 13867: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13868: $lt{'yes'}.'</label> <label>'.
13869: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13870: $lt{'no'}.'</label></span><br />'.
13871: '<div id="camtasia_titles" style="display:block">'.
13872: &Apache::lonhtmlcommon::start_pick_box().
13873: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13874: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13875: &Apache::lonhtmlcommon::row_closure().
13876: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13877: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13878: &Apache::lonhtmlcommon::row_closure(1).
13879: &Apache::lonhtmlcommon::end_pick_box().
13880: '</div>';
13881: }
1.1065 raeburn 13882: $output .=
13883: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13884: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13885: "\n";
1.1065 raeburn 13886: if ($duplicates ne '') {
13887: $output .= '<p><span class="LC_warning">'.
13888: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13889: &start_data_table().
13890: &start_data_table_header_row().
13891: '<th>'.&mt('Overwrite?').'</th>'.
13892: '<th>'.&mt('Name').'</th>'.
13893: '<th>'.&mt('Type').'</th>'.
13894: '<th>'.&mt('Size').'</th>'.
13895: '<th>'.&mt('Last modified').'</th>'.
13896: &end_data_table_header_row().
13897: $duplicates.
13898: &end_data_table().
13899: '</p>';
13900: }
1.1067 raeburn 13901: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13902: if (ref($hiddenelements) eq 'HASH') {
13903: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13904: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13905: }
13906: }
13907: $output .= <<"END";
1.1067 raeburn 13908: <br />
1.1053 raeburn 13909: <input type="submit" name="decompress" value="$lt{'extr'}" />
13910: </form>
13911: $noextract
13912: END
13913: return $output;
13914: }
13915:
1.1065 raeburn 13916: sub decompression_utility {
13917: my ($program) = @_;
13918: my @utilities = ('tar','gunzip','bunzip2','unzip');
13919: my $location;
13920: if (grep(/^\Q$program\E$/,@utilities)) {
13921: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13922: '/usr/sbin/') {
13923: if (-x $dir.$program) {
13924: $location = $dir.$program;
13925: last;
13926: }
13927: }
13928: }
13929: return $location;
13930: }
13931:
13932: sub list_archive_contents {
13933: my ($file,$pathsref) = @_;
13934: my (@cmd,$output);
13935: my $needsregexp;
13936: if ($file =~ /\.zip$/) {
13937: @cmd = (&decompression_utility('unzip'),"-l");
13938: $needsregexp = 1;
13939: } elsif (($file =~ m/\.tar\.gz$/) ||
13940: ($file =~ /\.tgz$/)) {
13941: @cmd = (&decompression_utility('tar'),"-ztf");
13942: } elsif ($file =~ /\.tar\.bz2$/) {
13943: @cmd = (&decompression_utility('tar'),"-jtf");
13944: } elsif ($file =~ m|\.tar$|) {
13945: @cmd = (&decompression_utility('tar'),"-tf");
13946: }
13947: if (@cmd) {
13948: undef($!);
13949: undef($@);
13950: if (open(my $fh,"-|", @cmd, $file)) {
13951: while (my $line = <$fh>) {
13952: $output .= $line;
13953: chomp($line);
13954: my $item;
13955: if ($needsregexp) {
13956: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13957: } else {
13958: $item = $line;
13959: }
13960: if ($item ne '') {
13961: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13962: push(@{$pathsref},$item);
13963: }
13964: }
13965: }
13966: close($fh);
13967: }
13968: }
13969: return $output;
13970: }
13971:
1.1053 raeburn 13972: sub decompress_uploaded_file {
13973: my ($file,$dir) = @_;
13974: &Apache::lonnet::appenv({'cgi.file' => $file});
13975: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13976: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13977: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13978: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13979: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13980: my $decompressed = $env{'cgi.decompressed'};
13981: &Apache::lonnet::delenv('cgi.file');
13982: &Apache::lonnet::delenv('cgi.dir');
13983: &Apache::lonnet::delenv('cgi.decompressed');
13984: return ($decompressed,$result);
13985: }
13986:
1.1055 raeburn 13987: sub process_decompression {
13988: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 13989: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13990: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13991: &mt('Unexpected file path.').'</p>'."\n";
13992: }
13993: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13994: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13995: &mt('Unexpected course context.').'</p>'."\n";
13996: }
1.1293 raeburn 13997: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 13998: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13999: &mt('Filename contained unexpected characters.').'</p>'."\n";
14000: }
1.1055 raeburn 14001: my ($dir,$error,$warning,$output);
1.1180 raeburn 14002: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 14003: $error = &mt('Filename not a supported archive file type.').
14004: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 14005: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
14006: } else {
14007: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14008: if ($docuhome eq 'no_host') {
14009: $error = &mt('Could not determine home server for course.');
14010: } else {
14011: my @ids=&Apache::lonnet::current_machine_ids();
14012: my $currdir = "$dir_root/$destination";
14013: if (grep(/^\Q$docuhome\E$/,@ids)) {
14014: $dir = &LONCAPA::propath($docudom,$docuname).
14015: "$dir_root/$destination";
14016: } else {
14017: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
14018: "$dir_root/$docudom/$docuname/$destination";
14019: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
14020: $error = &mt('Archive file not found.');
14021: }
14022: }
1.1065 raeburn 14023: my (@to_overwrite,@to_skip);
14024: if ($env{'form.archive_overwrite_total'} > 0) {
14025: my $total = $env{'form.archive_overwrite_total'};
14026: for (my $i=0; $i<$total; $i++) {
14027: if ($env{'form.archive_overwrite_'.$i} == 1) {
14028: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
14029: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
14030: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
14031: }
14032: }
14033: }
14034: my $numskip = scalar(@to_skip);
1.1292 raeburn 14035: my $numoverwrite = scalar(@to_overwrite);
14036: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 14037: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
14038: } elsif ($dir eq '') {
1.1055 raeburn 14039: $error = &mt('Directory containing archive file unavailable.');
14040: } elsif (!$error) {
1.1065 raeburn 14041: my ($decompressed,$display);
1.1292 raeburn 14042: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 14043: my $tempdir = time.'_'.$$.int(rand(10000));
14044: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 14045: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
14046: ($decompressed,$display) =
14047: &decompress_uploaded_file($file,"$dir/$tempdir");
14048: foreach my $item (@to_skip) {
14049: if (($item ne '') && ($item !~ /\.\./)) {
14050: if (-f "$dir/$tempdir/$item") {
14051: unlink("$dir/$tempdir/$item");
14052: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 14053: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 14054: }
14055: }
14056: }
14057: foreach my $item (@to_overwrite) {
14058: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
14059: if (($item ne '') && ($item !~ /\.\./)) {
14060: if (-f "$dir/$item") {
14061: unlink("$dir/$item");
14062: } elsif (-d "$dir/$item") {
1.1300 raeburn 14063: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 14064: }
14065: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
14066: }
1.1065 raeburn 14067: }
14068: }
1.1292 raeburn 14069: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 14070: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 14071: }
1.1065 raeburn 14072: }
14073: } else {
14074: ($decompressed,$display) =
14075: &decompress_uploaded_file($file,$dir);
14076: }
1.1055 raeburn 14077: if ($decompressed eq 'ok') {
1.1065 raeburn 14078: $output = '<p class="LC_info">'.
14079: &mt('Files extracted successfully from archive.').
14080: '</p>'."\n";
1.1055 raeburn 14081: my ($warning,$result,@contents);
14082: my ($newdirlistref,$newlisterror) =
14083: &Apache::lonnet::dirlist($currdir,$docudom,
14084: $docuname,1);
14085: my (%is_dir,%changes,@newitems);
14086: my $dirptr = 16384;
1.1065 raeburn 14087: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 14088: foreach my $dir_line (@{$newdirlistref}) {
14089: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 14090: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 14091: push(@newitems,$item);
14092: if ($dirptr&$testdir) {
14093: $is_dir{$item} = 1;
14094: }
14095: $changes{$item} = 1;
14096: }
14097: }
14098: }
14099: if (keys(%changes) > 0) {
14100: foreach my $item (sort(@newitems)) {
14101: if ($changes{$item}) {
14102: push(@contents,$item);
14103: }
14104: }
14105: }
14106: if (@contents > 0) {
1.1067 raeburn 14107: my $wantform;
14108: unless ($env{'form.autoextract_camtasia'}) {
14109: $wantform = 1;
14110: }
1.1056 raeburn 14111: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 14112: my ($count,$datatable) = &get_extracted($docudom,$docuname,
14113: $currdir,\%is_dir,
14114: \%children,\%parent,
1.1056 raeburn 14115: \@contents,\%dirorder,
14116: \%titles,$wantform);
1.1055 raeburn 14117: if ($datatable ne '') {
14118: $output .= &archive_options_form('decompressed',$datatable,
14119: $count,$hiddenelem);
1.1065 raeburn 14120: my $startcount = 6;
1.1055 raeburn 14121: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 14122: \%titles,\%children);
1.1055 raeburn 14123: }
1.1067 raeburn 14124: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 14125: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 14126: my %displayed;
14127: my $total = 1;
14128: $env{'form.archive_directory'} = [];
14129: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
14130: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
14131: $path =~ s{/$}{};
14132: my $item;
14133: if ($path ne '') {
14134: $item = "$path/$titles{$i}";
14135: } else {
14136: $item = $titles{$i};
14137: }
14138: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
14139: if ($item eq $contents[0]) {
14140: push(@{$env{'form.archive_directory'}},$i);
14141: $env{'form.archive_'.$i} = 'display';
14142: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
14143: $displayed{'folder'} = $i;
1.1164 raeburn 14144: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
14145: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 14146: $env{'form.archive_'.$i} = 'display';
14147: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
14148: $displayed{'web'} = $i;
14149: } else {
1.1164 raeburn 14150: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
14151: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
14152: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 14153: push(@{$env{'form.archive_directory'}},$i);
14154: }
14155: $env{'form.archive_'.$i} = 'dependency';
14156: }
14157: $total ++;
14158: }
14159: for (my $i=1; $i<$total; $i++) {
14160: next if ($i == $displayed{'web'});
14161: next if ($i == $displayed{'folder'});
14162: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
14163: }
14164: $env{'form.phase'} = 'decompress_cleanup';
14165: $env{'form.archivedelete'} = 1;
14166: $env{'form.archive_count'} = $total-1;
14167: $output .=
14168: &process_extracted_files('coursedocs',$docudom,
14169: $docuname,$destination,
14170: $dir_root,$hiddenelem);
14171: }
1.1055 raeburn 14172: } else {
14173: $warning = &mt('No new items extracted from archive file.');
14174: }
14175: } else {
14176: $output = $display;
14177: $error = &mt('An error occurred during extraction from the archive file.');
14178: }
14179: }
14180: }
14181: }
14182: if ($error) {
14183: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14184: $error.'</p>'."\n";
14185: }
14186: if ($warning) {
14187: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14188: }
14189: return $output;
14190: }
14191:
14192: sub get_extracted {
1.1056 raeburn 14193: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
14194: $titles,$wantform) = @_;
1.1055 raeburn 14195: my $count = 0;
14196: my $depth = 0;
14197: my $datatable;
1.1056 raeburn 14198: my @hierarchy;
1.1055 raeburn 14199: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 14200: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
14201: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 14202: foreach my $item (@{$contents}) {
14203: $count ++;
1.1056 raeburn 14204: @{$dirorder->{$count}} = @hierarchy;
14205: $titles->{$count} = $item;
1.1055 raeburn 14206: &archive_hierarchy($depth,$count,$parent,$children);
14207: if ($wantform) {
14208: $datatable .= &archive_row($is_dir->{$item},$item,
14209: $currdir,$depth,$count);
14210: }
14211: if ($is_dir->{$item}) {
14212: $depth ++;
1.1056 raeburn 14213: push(@hierarchy,$count);
14214: $parent->{$depth} = $count;
1.1055 raeburn 14215: $datatable .=
14216: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 14217: \$depth,\$count,\@hierarchy,$dirorder,
14218: $children,$parent,$titles,$wantform);
1.1055 raeburn 14219: $depth --;
1.1056 raeburn 14220: pop(@hierarchy);
1.1055 raeburn 14221: }
14222: }
14223: return ($count,$datatable);
14224: }
14225:
14226: sub recurse_extracted_archive {
1.1056 raeburn 14227: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
14228: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 14229: my $result='';
1.1056 raeburn 14230: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
14231: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
14232: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 14233: return $result;
14234: }
14235: my $dirptr = 16384;
14236: my ($newdirlistref,$newlisterror) =
14237: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
14238: if (ref($newdirlistref) eq 'ARRAY') {
14239: foreach my $dir_line (@{$newdirlistref}) {
14240: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
14241: unless ($item =~ /^\.+$/) {
14242: $$count ++;
1.1056 raeburn 14243: @{$dirorder->{$$count}} = @{$hierarchy};
14244: $titles->{$$count} = $item;
1.1055 raeburn 14245: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 14246:
1.1055 raeburn 14247: my $is_dir;
14248: if ($dirptr&$testdir) {
14249: $is_dir = 1;
14250: }
14251: if ($wantform) {
14252: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
14253: }
14254: if ($is_dir) {
14255: $$depth ++;
1.1056 raeburn 14256: push(@{$hierarchy},$$count);
14257: $parent->{$$depth} = $$count;
1.1055 raeburn 14258: $result .=
14259: &recurse_extracted_archive("$currdir/$item",$docudom,
14260: $docuname,$depth,$count,
1.1056 raeburn 14261: $hierarchy,$dirorder,$children,
14262: $parent,$titles,$wantform);
1.1055 raeburn 14263: $$depth --;
1.1056 raeburn 14264: pop(@{$hierarchy});
1.1055 raeburn 14265: }
14266: }
14267: }
14268: }
14269: return $result;
14270: }
14271:
14272: sub archive_hierarchy {
14273: my ($depth,$count,$parent,$children) =@_;
14274: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
14275: if (exists($parent->{$depth})) {
14276: $children->{$parent->{$depth}} .= $count.':';
14277: }
14278: }
14279: return;
14280: }
14281:
14282: sub archive_row {
14283: my ($is_dir,$item,$currdir,$depth,$count) = @_;
14284: my ($name) = ($item =~ m{([^/]+)$});
14285: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 14286: 'display' => 'Add as file',
1.1055 raeburn 14287: 'dependency' => 'Include as dependency',
14288: 'discard' => 'Discard',
14289: );
14290: if ($is_dir) {
1.1059 raeburn 14291: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 14292: }
1.1056 raeburn 14293: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
14294: my $offset = 0;
1.1055 raeburn 14295: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 14296: $offset ++;
1.1065 raeburn 14297: if ($action ne 'display') {
14298: $offset ++;
14299: }
1.1055 raeburn 14300: $output .= '<td><span class="LC_nobreak">'.
14301: '<label><input type="radio" name="archive_'.$count.
14302: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
14303: my $text = $choices{$action};
14304: if ($is_dir) {
14305: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
14306: if ($action eq 'display') {
1.1059 raeburn 14307: $text = &mt('Add as folder');
1.1055 raeburn 14308: }
1.1056 raeburn 14309: } else {
14310: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
14311:
14312: }
14313: $output .= ' /> '.$choices{$action}.'</label></span>';
14314: if ($action eq 'dependency') {
14315: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
14316: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
14317: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
14318: '<option value=""></option>'."\n".
14319: '</select>'."\n".
14320: '</div>';
1.1059 raeburn 14321: } elsif ($action eq 'display') {
14322: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
14323: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
14324: '</div>';
1.1055 raeburn 14325: }
1.1056 raeburn 14326: $output .= '</td>';
1.1055 raeburn 14327: }
14328: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
14329: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
14330: for (my $i=0; $i<$depth; $i++) {
14331: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
14332: }
14333: if ($is_dir) {
14334: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
14335: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
14336: } else {
14337: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
14338: }
14339: $output .= ' '.$name.'</td>'."\n".
14340: &end_data_table_row();
14341: return $output;
14342: }
14343:
14344: sub archive_options_form {
1.1065 raeburn 14345: my ($form,$display,$count,$hiddenelem) = @_;
14346: my %lt = &Apache::lonlocal::texthash(
14347: perm => 'Permanently remove archive file?',
14348: hows => 'How should each extracted item be incorporated in the course?',
14349: cont => 'Content actions for all',
14350: addf => 'Add as folder/file',
14351: incd => 'Include as dependency for a displayed file',
14352: disc => 'Discard',
14353: no => 'No',
14354: yes => 'Yes',
14355: save => 'Save',
14356: );
14357: my $output = <<"END";
14358: <form name="$form" method="post" action="">
14359: <p><span class="LC_nobreak">$lt{'perm'}
14360: <label>
14361: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
14362: </label>
14363:
14364: <label>
14365: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
14366: </span>
14367: </p>
14368: <input type="hidden" name="phase" value="decompress_cleanup" />
14369: <br />$lt{'hows'}
14370: <div class="LC_columnSection">
14371: <fieldset>
14372: <legend>$lt{'cont'}</legend>
14373: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
14374: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
14375: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
14376: </fieldset>
14377: </div>
14378: END
14379: return $output.
1.1055 raeburn 14380: &start_data_table()."\n".
1.1065 raeburn 14381: $display."\n".
1.1055 raeburn 14382: &end_data_table()."\n".
14383: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
14384: $hiddenelem.
1.1065 raeburn 14385: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 14386: '</form>';
14387: }
14388:
14389: sub archive_javascript {
1.1056 raeburn 14390: my ($startcount,$numitems,$titles,$children) = @_;
14391: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 14392: my $maintitle = $env{'form.comment'};
1.1055 raeburn 14393: my $scripttag = <<START;
14394: <script type="text/javascript">
14395: // <![CDATA[
14396:
14397: function checkAll(form,prefix) {
14398: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
14399: for (var i=0; i < form.elements.length; i++) {
14400: var id = form.elements[i].id;
14401: if ((id != '') && (id != undefined)) {
14402: if (idstr.test(id)) {
14403: if (form.elements[i].type == 'radio') {
14404: form.elements[i].checked = true;
1.1056 raeburn 14405: var nostart = i-$startcount;
1.1059 raeburn 14406: var offset = nostart%7;
14407: var count = (nostart-offset)/7;
1.1056 raeburn 14408: dependencyCheck(form,count,offset);
1.1055 raeburn 14409: }
14410: }
14411: }
14412: }
14413: }
14414:
14415: function propagateCheck(form,count) {
14416: if (count > 0) {
1.1059 raeburn 14417: var startelement = $startcount + ((count-1) * 7);
14418: for (var j=1; j<6; j++) {
14419: if ((j != 2) && (j != 4)) {
1.1056 raeburn 14420: var item = startelement + j;
14421: if (form.elements[item].type == 'radio') {
14422: if (form.elements[item].checked) {
14423: containerCheck(form,count,j);
14424: break;
14425: }
1.1055 raeburn 14426: }
14427: }
14428: }
14429: }
14430: }
14431:
14432: numitems = $numitems
1.1056 raeburn 14433: var titles = new Array(numitems);
14434: var parents = new Array(numitems);
1.1055 raeburn 14435: for (var i=0; i<numitems; i++) {
1.1056 raeburn 14436: parents[i] = new Array;
1.1055 raeburn 14437: }
1.1059 raeburn 14438: var maintitle = '$maintitle';
1.1055 raeburn 14439:
14440: START
14441:
1.1056 raeburn 14442: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
14443: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 14444: for (my $i=0; $i<@contents; $i ++) {
14445: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
14446: }
14447: }
14448:
1.1056 raeburn 14449: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
14450: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
14451: }
14452:
1.1055 raeburn 14453: $scripttag .= <<END;
14454:
14455: function containerCheck(form,count,offset) {
14456: if (count > 0) {
1.1056 raeburn 14457: dependencyCheck(form,count,offset);
1.1059 raeburn 14458: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 14459: form.elements[item].checked = true;
14460: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
14461: if (parents[count].length > 0) {
14462: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 14463: containerCheck(form,parents[count][j],offset);
14464: }
14465: }
14466: }
14467: }
14468: }
14469:
14470: function dependencyCheck(form,count,offset) {
14471: if (count > 0) {
1.1059 raeburn 14472: var chosen = (offset+$startcount)+7*(count-1);
14473: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 14474: var currtype = form.elements[depitem].type;
14475: if (form.elements[chosen].value == 'dependency') {
14476: document.getElementById('arc_depon_'+count).style.display='block';
14477: form.elements[depitem].options.length = 0;
14478: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 14479: for (var i=1; i<=numitems; i++) {
14480: if (i == count) {
14481: continue;
14482: }
1.1059 raeburn 14483: var startelement = $startcount + (i-1) * 7;
14484: for (var j=1; j<6; j++) {
14485: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 14486: var item = startelement + j;
14487: if (form.elements[item].type == 'radio') {
14488: if (form.elements[item].checked) {
14489: if (form.elements[item].value == 'display') {
14490: var n = form.elements[depitem].options.length;
14491: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
14492: }
14493: }
14494: }
14495: }
14496: }
14497: }
14498: } else {
14499: document.getElementById('arc_depon_'+count).style.display='none';
14500: form.elements[depitem].options.length = 0;
14501: form.elements[depitem].options[0] = new Option('Select','',true,true);
14502: }
1.1059 raeburn 14503: titleCheck(form,count,offset);
1.1056 raeburn 14504: }
14505: }
14506:
14507: function propagateSelect(form,count,offset) {
14508: if (count > 0) {
1.1065 raeburn 14509: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14510: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14511: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14512: if (parents[count].length > 0) {
14513: for (var j=0; j<parents[count].length; j++) {
14514: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14515: }
14516: }
14517: }
14518: }
14519: }
1.1056 raeburn 14520:
14521: function containerSelect(form,count,offset,picked) {
14522: if (count > 0) {
1.1065 raeburn 14523: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14524: if (form.elements[item].type == 'radio') {
14525: if (form.elements[item].value == 'dependency') {
14526: if (form.elements[item+1].type == 'select-one') {
14527: for (var i=0; i<form.elements[item+1].options.length; i++) {
14528: if (form.elements[item+1].options[i].value == picked) {
14529: form.elements[item+1].selectedIndex = i;
14530: break;
14531: }
14532: }
14533: }
14534: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14535: if (parents[count].length > 0) {
14536: for (var j=0; j<parents[count].length; j++) {
14537: containerSelect(form,parents[count][j],offset,picked);
14538: }
14539: }
14540: }
14541: }
14542: }
14543: }
14544: }
14545:
1.1059 raeburn 14546: function titleCheck(form,count,offset) {
14547: if (count > 0) {
14548: var chosen = (offset+$startcount)+7*(count-1);
14549: var depitem = $startcount + ((count-1) * 7) + 2;
14550: var currtype = form.elements[depitem].type;
14551: if (form.elements[chosen].value == 'display') {
14552: document.getElementById('arc_title_'+count).style.display='block';
14553: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14554: document.getElementById('archive_title_'+count).value=maintitle;
14555: }
14556: } else {
14557: document.getElementById('arc_title_'+count).style.display='none';
14558: if (currtype == 'text') {
14559: document.getElementById('archive_title_'+count).value='';
14560: }
14561: }
14562: }
14563: return;
14564: }
14565:
1.1055 raeburn 14566: // ]]>
14567: </script>
14568: END
14569: return $scripttag;
14570: }
14571:
14572: sub process_extracted_files {
1.1067 raeburn 14573: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14574: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14575: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14576: my @ids=&Apache::lonnet::current_machine_ids();
14577: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14578: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14579: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14580: if (grep(/^\Q$docuhome\E$/,@ids)) {
14581: $prefix = &LONCAPA::propath($docudom,$docuname);
14582: $pathtocheck = "$dir_root/$destination";
14583: $dir = $dir_root;
14584: $ishome = 1;
14585: } else {
14586: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14587: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14588: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14589: }
14590: my $currdir = "$dir_root/$destination";
14591: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14592: if ($env{'form.folderpath'}) {
14593: my @items = split('&',$env{'form.folderpath'});
14594: $folders{'0'} = $items[-2];
1.1099 raeburn 14595: if ($env{'form.folderpath'} =~ /\:1$/) {
14596: $containers{'0'}='page';
14597: } else {
14598: $containers{'0'}='sequence';
14599: }
1.1055 raeburn 14600: }
14601: my @archdirs = &get_env_multiple('form.archive_directory');
14602: if ($numitems) {
14603: for (my $i=1; $i<=$numitems; $i++) {
14604: my $path = $env{'form.archive_content_'.$i};
14605: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14606: my $item = $1;
14607: $toplevelitems{$item} = $i;
14608: if (grep(/^\Q$i\E$/,@archdirs)) {
14609: $is_dir{$item} = 1;
14610: }
14611: }
14612: }
14613: }
1.1067 raeburn 14614: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14615: if (keys(%toplevelitems) > 0) {
14616: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14617: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14618: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14619: }
1.1066 raeburn 14620: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14621: if ($numitems) {
14622: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14623: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14624: my $path = $env{'form.archive_content_'.$i};
14625: if ($path =~ /^\Q$pathtocheck\E/) {
14626: if ($env{'form.archive_'.$i} eq 'discard') {
14627: if ($prefix ne '' && $path ne '') {
14628: if (-e $prefix.$path) {
1.1066 raeburn 14629: if ((@archdirs > 0) &&
14630: (grep(/^\Q$i\E$/,@archdirs))) {
14631: $todeletedir{$prefix.$path} = 1;
14632: } else {
14633: $todelete{$prefix.$path} = 1;
14634: }
1.1055 raeburn 14635: }
14636: }
14637: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14638: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14639: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14640: $docstitle = $env{'form.archive_title_'.$i};
14641: if ($docstitle eq '') {
14642: $docstitle = $title;
14643: }
1.1055 raeburn 14644: $outer = 0;
1.1056 raeburn 14645: if (ref($dirorder{$i}) eq 'ARRAY') {
14646: if (@{$dirorder{$i}} > 0) {
14647: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14648: if ($env{'form.archive_'.$item} eq 'display') {
14649: $outer = $item;
14650: last;
14651: }
14652: }
14653: }
14654: }
14655: my ($errtext,$fatal) =
14656: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14657: '/'.$folders{$outer}.'.'.
14658: $containers{$outer});
14659: next if ($fatal);
14660: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14661: if ($context eq 'coursedocs') {
1.1056 raeburn 14662: $mapinner{$i} = time;
1.1055 raeburn 14663: $folders{$i} = 'default_'.$mapinner{$i};
14664: $containers{$i} = 'sequence';
14665: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14666: $folders{$i}.'.'.$containers{$i};
14667: my $newidx = &LONCAPA::map::getresidx();
14668: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14669: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14670: push(@LONCAPA::map::order,$newidx);
14671: my ($outtext,$errtext) =
14672: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14673: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14674: '.'.$containers{$outer},1,1);
1.1056 raeburn 14675: $newseqid{$i} = $newidx;
1.1067 raeburn 14676: unless ($errtext) {
1.1294 raeburn 14677: $result .= '<li>'.&mt('Folder: [_1] added to course',
14678: &HTML::Entities::encode($docstitle,'<>&"')).
14679: '</li>'."\n";
1.1067 raeburn 14680: }
1.1055 raeburn 14681: }
14682: } else {
14683: if ($context eq 'coursedocs') {
14684: my $newidx=&LONCAPA::map::getresidx();
14685: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14686: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14687: $title;
1.1392 raeburn 14688: if (($outer !~ /\D/) &&
14689: (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
14690: ($newidx !~ /\D/)) {
1.1294 raeburn 14691: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14692: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14693: }
14694: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14695: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14696: }
14697: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14698: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14699: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14700: unless ($ishome) {
14701: my $fetch = "$newdest{$i}/$title";
14702: $fetch =~ s/^\Q$prefix$dir\E//;
14703: $prompttofetch{$fetch} = 1;
14704: }
1.1292 raeburn 14705: }
1.1067 raeburn 14706: }
1.1294 raeburn 14707: $LONCAPA::map::resources[$newidx]=
14708: $docstitle.':'.$url.':false:normal:res';
14709: push(@LONCAPA::map::order, $newidx);
14710: my ($outtext,$errtext)=
14711: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14712: $docuname.'/'.$folders{$outer}.
14713: '.'.$containers{$outer},1,1);
14714: unless ($errtext) {
14715: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14716: $result .= '<li>'.&mt('File: [_1] added to course',
14717: &HTML::Entities::encode($docstitle,'<>&"')).
14718: '</li>'."\n";
14719: }
1.1067 raeburn 14720: }
1.1294 raeburn 14721: } else {
14722: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14723: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14724: }
1.1055 raeburn 14725: }
14726: }
1.1086 raeburn 14727: }
14728: } else {
1.1294 raeburn 14729: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14730: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14731: }
14732: }
14733: for (my $i=1; $i<=$numitems; $i++) {
14734: next unless ($env{'form.archive_'.$i} eq 'dependency');
14735: my $path = $env{'form.archive_content_'.$i};
14736: if ($path =~ /^\Q$pathtocheck\E/) {
14737: my ($title) = ($path =~ m{/([^/]+)$});
14738: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14739: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14740: if (ref($dirorder{$i}) eq 'ARRAY') {
14741: my ($itemidx,$fullpath,$relpath);
14742: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14743: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14744: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14745: if ($dirorder{$i}->[$j] eq $container) {
14746: $itemidx = $j;
1.1056 raeburn 14747: }
14748: }
1.1086 raeburn 14749: }
14750: if ($itemidx eq '') {
14751: $itemidx = 0;
14752: }
14753: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14754: if ($mapinner{$referrer{$i}}) {
14755: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14756: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14757: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14758: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14759: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14760: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14761: if (!-e $fullpath) {
14762: mkdir($fullpath,0755);
1.1056 raeburn 14763: }
14764: }
1.1086 raeburn 14765: } else {
14766: last;
1.1056 raeburn 14767: }
1.1086 raeburn 14768: }
14769: }
14770: } elsif ($newdest{$referrer{$i}}) {
14771: $fullpath = $newdest{$referrer{$i}};
14772: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14773: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14774: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14775: last;
14776: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14777: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14778: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14779: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14780: if (!-e $fullpath) {
14781: mkdir($fullpath,0755);
1.1056 raeburn 14782: }
14783: }
1.1086 raeburn 14784: } else {
14785: last;
1.1056 raeburn 14786: }
1.1055 raeburn 14787: }
14788: }
1.1086 raeburn 14789: if ($fullpath ne '') {
14790: if (-e "$prefix$path") {
1.1292 raeburn 14791: unless (rename("$prefix$path","$fullpath/$title")) {
14792: $warning .= &mt('Failed to rename dependency').'<br />';
14793: }
1.1086 raeburn 14794: }
14795: if (-e "$fullpath/$title") {
14796: my $showpath;
14797: if ($relpath ne '') {
14798: $showpath = "$relpath/$title";
14799: } else {
14800: $showpath = "/$title";
14801: }
1.1294 raeburn 14802: $result .= '<li>'.&mt('[_1] included as a dependency',
14803: &HTML::Entities::encode($showpath,'<>&"')).
14804: '</li>'."\n";
1.1292 raeburn 14805: unless ($ishome) {
14806: my $fetch = "$fullpath/$title";
14807: $fetch =~ s/^\Q$prefix$dir\E//;
14808: $prompttofetch{$fetch} = 1;
14809: }
1.1086 raeburn 14810: }
14811: }
1.1055 raeburn 14812: }
1.1086 raeburn 14813: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14814: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 14815: &HTML::Entities::encode($path,'<>&"'),
14816: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14817: '<br />';
1.1055 raeburn 14818: }
14819: } else {
1.1294 raeburn 14820: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 14821: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14822: }
14823: }
14824: if (keys(%todelete)) {
14825: foreach my $key (keys(%todelete)) {
14826: unlink($key);
1.1066 raeburn 14827: }
14828: }
14829: if (keys(%todeletedir)) {
14830: foreach my $key (keys(%todeletedir)) {
14831: rmdir($key);
14832: }
14833: }
14834: foreach my $dir (sort(keys(%is_dir))) {
14835: if (($pathtocheck ne '') && ($dir ne '')) {
14836: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14837: }
14838: }
1.1067 raeburn 14839: if ($result ne '') {
14840: $output .= '<ul>'."\n".
14841: $result."\n".
14842: '</ul>';
14843: }
14844: unless ($ishome) {
14845: my $replicationfail;
14846: foreach my $item (keys(%prompttofetch)) {
14847: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14848: unless ($fetchresult eq 'ok') {
14849: $replicationfail .= '<li>'.$item.'</li>'."\n";
14850: }
14851: }
14852: if ($replicationfail) {
14853: $output .= '<p class="LC_error">'.
14854: &mt('Course home server failed to retrieve:').'<ul>'.
14855: $replicationfail.
14856: '</ul></p>';
14857: }
14858: }
1.1055 raeburn 14859: } else {
14860: $warning = &mt('No items found in archive.');
14861: }
14862: if ($error) {
14863: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14864: $error.'</p>'."\n";
14865: }
14866: if ($warning) {
14867: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14868: }
14869: return $output;
14870: }
14871:
1.1066 raeburn 14872: sub cleanup_empty_dirs {
14873: my ($path) = @_;
14874: if (($path ne '') && (-d $path)) {
14875: if (opendir(my $dirh,$path)) {
14876: my @dircontents = grep(!/^\./,readdir($dirh));
14877: my $numitems = 0;
14878: foreach my $item (@dircontents) {
14879: if (-d "$path/$item") {
1.1111 raeburn 14880: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14881: if (-e "$path/$item") {
14882: $numitems ++;
14883: }
14884: } else {
14885: $numitems ++;
14886: }
14887: }
14888: if ($numitems == 0) {
14889: rmdir($path);
14890: }
14891: closedir($dirh);
14892: }
14893: }
14894: return;
14895: }
14896:
1.41 ng 14897: =pod
1.45 matthew 14898:
1.1162 raeburn 14899: =item * &get_folder_hierarchy()
1.1068 raeburn 14900:
14901: Provides hierarchy of names of folders/sub-folders containing the current
14902: item,
14903:
14904: Inputs: 3
14905: - $navmap - navmaps object
14906:
14907: - $map - url for map (either the trigger itself, or map containing
14908: the resource, which is the trigger).
14909:
14910: - $showitem - 1 => show title for map itself; 0 => do not show.
14911:
14912: Outputs: 1 @pathitems - array of folder/subfolder names.
14913:
14914: =cut
14915:
14916: sub get_folder_hierarchy {
14917: my ($navmap,$map,$showitem) = @_;
14918: my @pathitems;
14919: if (ref($navmap)) {
14920: my $mapres = $navmap->getResourceByUrl($map);
14921: if (ref($mapres)) {
14922: my $pcslist = $mapres->map_hierarchy();
14923: if ($pcslist ne '') {
14924: my @pcs = split(/,/,$pcslist);
14925: foreach my $pc (@pcs) {
14926: if ($pc == 1) {
1.1129 raeburn 14927: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14928: } else {
14929: my $res = $navmap->getByMapPc($pc);
14930: if (ref($res)) {
14931: my $title = $res->compTitle();
14932: $title =~ s/\W+/_/g;
14933: if ($title ne '') {
14934: push(@pathitems,$title);
14935: }
14936: }
14937: }
14938: }
14939: }
1.1071 raeburn 14940: if ($showitem) {
14941: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 14942: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14943: } else {
14944: my $maptitle = $mapres->compTitle();
14945: $maptitle =~ s/\W+/_/g;
14946: if ($maptitle ne '') {
14947: push(@pathitems,$maptitle);
14948: }
1.1068 raeburn 14949: }
14950: }
14951: }
14952: }
14953: return @pathitems;
14954: }
14955:
14956: =pod
14957:
1.1015 raeburn 14958: =item * &get_turnedin_filepath()
14959:
14960: Determines path in a user's portfolio file for storage of files uploaded
14961: to a specific essayresponse or dropbox item.
14962:
14963: Inputs: 3 required + 1 optional.
14964: $symb is symb for resource, $uname and $udom are for current user (required).
14965: $caller is optional (can be "submission", if routine is called when storing
14966: an upoaded file when "Submit Answer" button was pressed).
14967:
14968: Returns array containing $path and $multiresp.
14969: $path is path in portfolio. $multiresp is 1 if this resource contains more
14970: than one file upload item. Callers of routine should append partid as a
14971: subdirectory to $path in cases where $multiresp is 1.
14972:
14973: Called by: homework/essayresponse.pm and homework/structuretags.pm
14974:
14975: =cut
14976:
14977: sub get_turnedin_filepath {
14978: my ($symb,$uname,$udom,$caller) = @_;
14979: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14980: my $turnindir;
14981: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14982: $turnindir = $userhash{'turnindir'};
14983: my ($path,$multiresp);
14984: if ($turnindir eq '') {
14985: if ($caller eq 'submission') {
14986: $turnindir = &mt('turned in');
14987: $turnindir =~ s/\W+/_/g;
14988: my %newhash = (
14989: 'turnindir' => $turnindir,
14990: );
14991: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14992: }
14993: }
14994: if ($turnindir ne '') {
14995: $path = '/'.$turnindir.'/';
14996: my ($multipart,$turnin,@pathitems);
14997: my $navmap = Apache::lonnavmaps::navmap->new();
14998: if (defined($navmap)) {
14999: my $mapres = $navmap->getResourceByUrl($map);
15000: if (ref($mapres)) {
15001: my $pcslist = $mapres->map_hierarchy();
15002: if ($pcslist ne '') {
15003: foreach my $pc (split(/,/,$pcslist)) {
15004: my $res = $navmap->getByMapPc($pc);
15005: if (ref($res)) {
15006: my $title = $res->compTitle();
15007: $title =~ s/\W+/_/g;
15008: if ($title ne '') {
1.1149 raeburn 15009: if (($pc > 1) && (length($title) > 12)) {
15010: $title = substr($title,0,12);
15011: }
1.1015 raeburn 15012: push(@pathitems,$title);
15013: }
15014: }
15015: }
15016: }
15017: my $maptitle = $mapres->compTitle();
15018: $maptitle =~ s/\W+/_/g;
15019: if ($maptitle ne '') {
1.1149 raeburn 15020: if (length($maptitle) > 12) {
15021: $maptitle = substr($maptitle,0,12);
15022: }
1.1015 raeburn 15023: push(@pathitems,$maptitle);
15024: }
15025: unless ($env{'request.state'} eq 'construct') {
15026: my $res = $navmap->getBySymb($symb);
15027: if (ref($res)) {
15028: my $partlist = $res->parts();
15029: my $totaluploads = 0;
15030: if (ref($partlist) eq 'ARRAY') {
15031: foreach my $part (@{$partlist}) {
15032: my @types = $res->responseType($part);
15033: my @ids = $res->responseIds($part);
15034: for (my $i=0; $i < scalar(@ids); $i++) {
15035: if ($types[$i] eq 'essay') {
15036: my $partid = $part.'_'.$ids[$i];
15037: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
15038: $totaluploads ++;
15039: }
15040: }
15041: }
15042: }
15043: if ($totaluploads > 1) {
15044: $multiresp = 1;
15045: }
15046: }
15047: }
15048: }
15049: } else {
15050: return;
15051: }
15052: } else {
15053: return;
15054: }
15055: my $restitle=&Apache::lonnet::gettitle($symb);
15056: $restitle =~ s/\W+/_/g;
15057: if ($restitle eq '') {
15058: $restitle = ($resurl =~ m{/[^/]+$});
15059: if ($restitle eq '') {
15060: $restitle = time;
15061: }
15062: }
1.1149 raeburn 15063: if (length($restitle) > 12) {
15064: $restitle = substr($restitle,0,12);
15065: }
1.1015 raeburn 15066: push(@pathitems,$restitle);
15067: $path .= join('/',@pathitems);
15068: }
15069: return ($path,$multiresp);
15070: }
15071:
15072: =pod
15073:
1.464 albertel 15074: =back
1.41 ng 15075:
1.112 bowersj2 15076: =head1 CSV Upload/Handling functions
1.38 albertel 15077:
1.41 ng 15078: =over 4
15079:
1.648 raeburn 15080: =item * &upfile_store($r)
1.41 ng 15081:
15082: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 15083: needs $env{'form.upfile'}
1.41 ng 15084: returns $datatoken to be put into hidden field
15085:
15086: =cut
1.31 albertel 15087:
15088: sub upfile_store {
15089: my $r=shift;
1.258 albertel 15090: $env{'form.upfile'}=~s/\r/\n/gs;
15091: $env{'form.upfile'}=~s/\f/\n/gs;
15092: $env{'form.upfile'}=~s/\n+/\n/gs;
15093: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 15094:
1.1299 raeburn 15095: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
15096: '_enroll_'.$env{'request.course.id'}.'_'.
15097: time.'_'.$$);
15098: return if ($datatoken eq '');
15099:
1.31 albertel 15100: {
1.158 raeburn 15101: my $datafile = $r->dir_config('lonDaemons').
15102: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15103: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 15104: print $fh $env{'form.upfile'};
1.158 raeburn 15105: close($fh);
15106: }
1.31 albertel 15107: }
15108: return $datatoken;
15109: }
15110:
1.56 matthew 15111: =pod
15112:
1.1290 raeburn 15113: =item * &load_tmp_file($r,$datatoken)
1.41 ng 15114:
15115: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 15116: $datatoken is the name to assign to the temporary file.
1.258 albertel 15117: sets $env{'form.upfile'} to the contents of the file
1.41 ng 15118:
15119: =cut
1.31 albertel 15120:
15121: sub load_tmp_file {
1.1290 raeburn 15122: my ($r,$datatoken) = @_;
15123: return if ($datatoken eq '');
1.31 albertel 15124: my @studentdata=();
15125: {
1.158 raeburn 15126: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 15127: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15128: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 15129: @studentdata=<$fh>;
15130: close($fh);
15131: }
1.31 albertel 15132: }
1.258 albertel 15133: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 15134: }
15135:
1.1290 raeburn 15136: sub valid_datatoken {
15137: my ($datatoken) = @_;
1.1325 raeburn 15138: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 15139: return $datatoken;
15140: }
15141: return;
15142: }
15143:
1.56 matthew 15144: =pod
15145:
1.648 raeburn 15146: =item * &upfile_record_sep()
1.41 ng 15147:
15148: Separate uploaded file into records
15149: returns array of records,
1.258 albertel 15150: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 15151:
15152: =cut
1.31 albertel 15153:
15154: sub upfile_record_sep {
1.258 albertel 15155: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 15156: } else {
1.248 albertel 15157: my @records;
1.258 albertel 15158: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 15159: if ($line=~/^\s*$/) { next; }
15160: push(@records,$line);
15161: }
15162: return @records;
1.31 albertel 15163: }
15164: }
15165:
1.56 matthew 15166: =pod
15167:
1.648 raeburn 15168: =item * &record_sep($record)
1.41 ng 15169:
1.258 albertel 15170: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 15171:
15172: =cut
15173:
1.263 www 15174: sub takeleft {
15175: my $index=shift;
15176: return substr('0000'.$index,-4,4);
15177: }
15178:
1.31 albertel 15179: sub record_sep {
15180: my $record=shift;
15181: my %components=();
1.258 albertel 15182: if ($env{'form.upfiletype'} eq 'xml') {
15183: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 15184: my $i=0;
1.356 albertel 15185: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 15186: $field=~s/^(\"|\')//;
15187: $field=~s/(\"|\')$//;
1.263 www 15188: $components{&takeleft($i)}=$field;
1.31 albertel 15189: $i++;
15190: }
1.258 albertel 15191: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 15192: my $i=0;
1.356 albertel 15193: foreach my $field (split(/\t/,$record)) {
1.31 albertel 15194: $field=~s/^(\"|\')//;
15195: $field=~s/(\"|\')$//;
1.263 www 15196: $components{&takeleft($i)}=$field;
1.31 albertel 15197: $i++;
15198: }
15199: } else {
1.561 www 15200: my $separator=',';
1.480 banghart 15201: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 15202: $separator=';';
1.480 banghart 15203: }
1.31 albertel 15204: my $i=0;
1.561 www 15205: # the character we are looking for to indicate the end of a quote or a record
15206: my $looking_for=$separator;
15207: # do not add the characters to the fields
15208: my $ignore=0;
15209: # we just encountered a separator (or the beginning of the record)
15210: my $just_found_separator=1;
15211: # store the field we are working on here
15212: my $field='';
15213: # work our way through all characters in record
15214: foreach my $character ($record=~/(.)/g) {
15215: if ($character eq $looking_for) {
15216: if ($character ne $separator) {
15217: # Found the end of a quote, again looking for separator
15218: $looking_for=$separator;
15219: $ignore=1;
15220: } else {
15221: # Found a separator, store away what we got
15222: $components{&takeleft($i)}=$field;
15223: $i++;
15224: $just_found_separator=1;
15225: $ignore=0;
15226: $field='';
15227: }
15228: next;
15229: }
15230: # single or double quotation marks after a separator indicate beginning of a quote
15231: # we are now looking for the end of the quote and need to ignore separators
15232: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
15233: $looking_for=$character;
15234: next;
15235: }
15236: # ignore would be true after we reached the end of a quote
15237: if ($ignore) { next; }
15238: if (($just_found_separator) && ($character=~/\s/)) { next; }
15239: $field.=$character;
15240: $just_found_separator=0;
1.31 albertel 15241: }
1.561 www 15242: # catch the very last entry, since we never encountered the separator
15243: $components{&takeleft($i)}=$field;
1.31 albertel 15244: }
15245: return %components;
15246: }
15247:
1.144 matthew 15248: ######################################################
15249: ######################################################
15250:
1.56 matthew 15251: =pod
15252:
1.648 raeburn 15253: =item * &upfile_select_html()
1.41 ng 15254:
1.144 matthew 15255: Return HTML code to select a file from the users machine and specify
15256: the file type.
1.41 ng 15257:
15258: =cut
15259:
1.144 matthew 15260: ######################################################
15261: ######################################################
1.31 albertel 15262: sub upfile_select_html {
1.144 matthew 15263: my %Types = (
15264: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 15265: semisv => &mt('Semicolon separated values'),
1.144 matthew 15266: space => &mt('Space separated'),
15267: tab => &mt('Tabulator separated'),
15268: # xml => &mt('HTML/XML'),
15269: );
15270: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 15271: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 15272: foreach my $type (sort(keys(%Types))) {
15273: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
15274: }
15275: $Str .= "</select>\n";
15276: return $Str;
1.31 albertel 15277: }
15278:
1.301 albertel 15279: sub get_samples {
15280: my ($records,$toget) = @_;
15281: my @samples=({});
15282: my $got=0;
15283: foreach my $rec (@$records) {
15284: my %temp = &record_sep($rec);
15285: if (! grep(/\S/, values(%temp))) { next; }
15286: if (%temp) {
15287: $samples[$got]=\%temp;
15288: $got++;
15289: if ($got == $toget) { last; }
15290: }
15291: }
15292: return \@samples;
15293: }
15294:
1.144 matthew 15295: ######################################################
15296: ######################################################
15297:
1.56 matthew 15298: =pod
15299:
1.648 raeburn 15300: =item * &csv_print_samples($r,$records)
1.41 ng 15301:
15302: Prints a table of sample values from each column uploaded $r is an
15303: Apache Request ref, $records is an arrayref from
15304: &Apache::loncommon::upfile_record_sep
15305:
15306: =cut
15307:
1.144 matthew 15308: ######################################################
15309: ######################################################
1.31 albertel 15310: sub csv_print_samples {
15311: my ($r,$records) = @_;
1.662 bisitz 15312: my $samples = &get_samples($records,5);
1.301 albertel 15313:
1.594 raeburn 15314: $r->print(&mt('Samples').'<br />'.&start_data_table().
15315: &start_data_table_header_row());
1.356 albertel 15316: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 15317: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 15318: $r->print(&end_data_table_header_row());
1.301 albertel 15319: foreach my $hash (@$samples) {
1.594 raeburn 15320: $r->print(&start_data_table_row());
1.356 albertel 15321: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 15322: $r->print('<td>');
1.356 albertel 15323: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 15324: $r->print('</td>');
15325: }
1.594 raeburn 15326: $r->print(&end_data_table_row());
1.31 albertel 15327: }
1.594 raeburn 15328: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 15329: }
15330:
1.144 matthew 15331: ######################################################
15332: ######################################################
15333:
1.56 matthew 15334: =pod
15335:
1.648 raeburn 15336: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 15337:
15338: Prints a table to create associations between values and table columns.
1.144 matthew 15339:
1.41 ng 15340: $r is an Apache Request ref,
15341: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 15342: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 15343:
15344: =cut
15345:
1.144 matthew 15346: ######################################################
15347: ######################################################
1.31 albertel 15348: sub csv_print_select_table {
15349: my ($r,$records,$d) = @_;
1.301 albertel 15350: my $i=0;
15351: my $samples = &get_samples($records,1);
1.144 matthew 15352: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 15353: &start_data_table().&start_data_table_header_row().
1.144 matthew 15354: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 15355: '<th>'.&mt('Column').'</th>'.
15356: &end_data_table_header_row()."\n");
1.356 albertel 15357: foreach my $array_ref (@$d) {
15358: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 15359: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 15360:
1.875 bisitz 15361: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 15362: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 15363: $r->print('<option value="none"></option>');
1.356 albertel 15364: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
15365: $r->print('<option value="'.$sample.'"'.
15366: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 15367: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 15368: }
1.594 raeburn 15369: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 15370: $i++;
15371: }
1.594 raeburn 15372: $r->print(&end_data_table());
1.31 albertel 15373: $i--;
15374: return $i;
15375: }
1.56 matthew 15376:
1.144 matthew 15377: ######################################################
15378: ######################################################
15379:
1.56 matthew 15380: =pod
1.31 albertel 15381:
1.648 raeburn 15382: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 15383:
15384: Prints a table of sample values from the upload and can make associate samples to internal names.
15385:
15386: $r is an Apache Request ref,
15387: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
15388: $d is an array of 2 element arrays (internal name, displayed name)
15389:
15390: =cut
15391:
1.144 matthew 15392: ######################################################
15393: ######################################################
1.31 albertel 15394: sub csv_samples_select_table {
15395: my ($r,$records,$d) = @_;
15396: my $i=0;
1.144 matthew 15397: #
1.662 bisitz 15398: my $max_samples = 5;
15399: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 15400: $r->print(&start_data_table().
15401: &start_data_table_header_row().'<th>'.
15402: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
15403: &end_data_table_header_row());
1.301 albertel 15404:
15405: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 15406: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 15407: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 15408: foreach my $option (@$d) {
15409: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 15410: $r->print('<option value="'.$value.'"'.
1.253 albertel 15411: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 15412: $display.'</option>');
1.31 albertel 15413: }
15414: $r->print('</select></td><td>');
1.662 bisitz 15415: foreach my $line (0..($max_samples-1)) {
1.301 albertel 15416: if (defined($samples->[$line]{$key})) {
15417: $r->print($samples->[$line]{$key}."<br />\n");
15418: }
15419: }
1.594 raeburn 15420: $r->print('</td>'.&end_data_table_row());
1.31 albertel 15421: $i++;
15422: }
1.594 raeburn 15423: $r->print(&end_data_table());
1.31 albertel 15424: $i--;
15425: return($i);
1.115 matthew 15426: }
15427:
1.144 matthew 15428: ######################################################
15429: ######################################################
15430:
1.115 matthew 15431: =pod
15432:
1.648 raeburn 15433: =item * &clean_excel_name($name)
1.115 matthew 15434:
15435: Returns a replacement for $name which does not contain any illegal characters.
15436:
15437: =cut
15438:
1.144 matthew 15439: ######################################################
15440: ######################################################
1.115 matthew 15441: sub clean_excel_name {
15442: my ($name) = @_;
15443: $name =~ s/[:\*\?\/\\]//g;
15444: if (length($name) > 31) {
15445: $name = substr($name,0,31);
15446: }
15447: return $name;
1.25 albertel 15448: }
1.84 albertel 15449:
1.85 albertel 15450: =pod
15451:
1.648 raeburn 15452: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 15453:
15454: Returns either 1 or undef
15455:
15456: 1 if the part is to be hidden, undef if it is to be shown
15457:
15458: Arguments are:
15459:
15460: $id the id of the part to be checked
15461: $symb, optional the symb of the resource to check
15462: $udom, optional the domain of the user to check for
15463: $uname, optional the username of the user to check for
15464:
15465: =cut
1.84 albertel 15466:
15467: sub check_if_partid_hidden {
15468: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 15469: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 15470: $symb,$udom,$uname);
1.141 albertel 15471: my $truth=1;
15472: #if the string starts with !, then the list is the list to show not hide
15473: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 15474: my @hiddenlist=split(/,/,$hiddenparts);
15475: foreach my $checkid (@hiddenlist) {
1.141 albertel 15476: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 15477: }
1.141 albertel 15478: return !$truth;
1.84 albertel 15479: }
1.127 matthew 15480:
1.138 matthew 15481:
15482: ############################################################
15483: ############################################################
15484:
15485: =pod
15486:
1.157 matthew 15487: =back
15488:
1.138 matthew 15489: =head1 cgi-bin script and graphing routines
15490:
1.157 matthew 15491: =over 4
15492:
1.648 raeburn 15493: =item * &get_cgi_id()
1.138 matthew 15494:
15495: Inputs: none
15496:
15497: Returns an id which can be used to pass environment variables
15498: to various cgi-bin scripts. These environment variables will
15499: be removed from the users environment after a given time by
15500: the routine &Apache::lonnet::transfer_profile_to_env.
15501:
15502: =cut
15503:
15504: ############################################################
15505: ############################################################
1.152 albertel 15506: my $uniq=0;
1.136 matthew 15507: sub get_cgi_id {
1.154 albertel 15508: $uniq=($uniq+1)%100000;
1.280 albertel 15509: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15510: }
15511:
1.127 matthew 15512: ############################################################
15513: ############################################################
15514:
15515: =pod
15516:
1.648 raeburn 15517: =item * &DrawBarGraph()
1.127 matthew 15518:
1.138 matthew 15519: Facilitates the plotting of data in a (stacked) bar graph.
15520: Puts plot definition data into the users environment in order for
15521: graph.png to plot it. Returns an <img> tag for the plot.
15522: The bars on the plot are labeled '1','2',...,'n'.
15523:
15524: Inputs:
15525:
15526: =over 4
15527:
15528: =item $Title: string, the title of the plot
15529:
15530: =item $xlabel: string, text describing the X-axis of the plot
15531:
15532: =item $ylabel: string, text describing the Y-axis of the plot
15533:
15534: =item $Max: scalar, the maximum Y value to use in the plot
15535: If $Max is < any data point, the graph will not be rendered.
15536:
1.140 matthew 15537: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15538: they are plotted. If undefined, default values will be used.
15539:
1.178 matthew 15540: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15541:
1.138 matthew 15542: =item @Values: An array of array references. Each array reference holds data
15543: to be plotted in a stacked bar chart.
15544:
1.239 matthew 15545: =item If the final element of @Values is a hash reference the key/value
15546: pairs will be added to the graph definition.
15547:
1.138 matthew 15548: =back
15549:
15550: Returns:
15551:
15552: An <img> tag which references graph.png and the appropriate identifying
15553: information for the plot.
15554:
1.127 matthew 15555: =cut
15556:
15557: ############################################################
15558: ############################################################
1.134 matthew 15559: sub DrawBarGraph {
1.178 matthew 15560: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15561: #
15562: if (! defined($colors)) {
15563: $colors = ['#33ff00',
15564: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15565: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15566: ];
15567: }
1.228 matthew 15568: my $extra_settings = {};
15569: if (ref($Values[-1]) eq 'HASH') {
15570: $extra_settings = pop(@Values);
15571: }
1.127 matthew 15572: #
1.136 matthew 15573: my $identifier = &get_cgi_id();
15574: my $id = 'cgi.'.$identifier;
1.129 matthew 15575: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15576: return '';
15577: }
1.225 matthew 15578: #
15579: my @Labels;
15580: if (defined($labels)) {
15581: @Labels = @$labels;
15582: } else {
15583: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15584: push(@Labels,$i+1);
1.225 matthew 15585: }
15586: }
15587: #
1.129 matthew 15588: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15589: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15590: my %ValuesHash;
15591: my $NumSets=1;
15592: foreach my $array (@Values) {
15593: next if (! ref($array));
1.136 matthew 15594: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15595: join(',',@$array);
1.129 matthew 15596: }
1.127 matthew 15597: #
1.136 matthew 15598: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15599: if ($NumBars < 3) {
15600: $width = 120+$NumBars*32;
1.220 matthew 15601: $xskip = 1;
1.225 matthew 15602: $bar_width = 30;
15603: } elsif ($NumBars < 5) {
15604: $width = 120+$NumBars*20;
15605: $xskip = 1;
15606: $bar_width = 20;
1.220 matthew 15607: } elsif ($NumBars < 10) {
1.136 matthew 15608: $width = 120+$NumBars*15;
15609: $xskip = 1;
15610: $bar_width = 15;
15611: } elsif ($NumBars <= 25) {
15612: $width = 120+$NumBars*11;
15613: $xskip = 5;
15614: $bar_width = 8;
15615: } elsif ($NumBars <= 50) {
15616: $width = 120+$NumBars*8;
15617: $xskip = 5;
15618: $bar_width = 4;
15619: } else {
15620: $width = 120+$NumBars*8;
15621: $xskip = 5;
15622: $bar_width = 4;
15623: }
15624: #
1.137 matthew 15625: $Max = 1 if ($Max < 1);
15626: if ( int($Max) < $Max ) {
15627: $Max++;
15628: $Max = int($Max);
15629: }
1.127 matthew 15630: $Title = '' if (! defined($Title));
15631: $xlabel = '' if (! defined($xlabel));
15632: $ylabel = '' if (! defined($ylabel));
1.369 www 15633: $ValuesHash{$id.'.title'} = &escape($Title);
15634: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15635: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15636: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15637: $ValuesHash{$id.'.NumBars'} = $NumBars;
15638: $ValuesHash{$id.'.NumSets'} = $NumSets;
15639: $ValuesHash{$id.'.PlotType'} = 'bar';
15640: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15641: $ValuesHash{$id.'.height'} = $height;
15642: $ValuesHash{$id.'.width'} = $width;
15643: $ValuesHash{$id.'.xskip'} = $xskip;
15644: $ValuesHash{$id.'.bar_width'} = $bar_width;
15645: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15646: #
1.228 matthew 15647: # Deal with other parameters
15648: while (my ($key,$value) = each(%$extra_settings)) {
15649: $ValuesHash{$id.'.'.$key} = $value;
15650: }
15651: #
1.646 raeburn 15652: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15653: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15654: }
15655:
15656: ############################################################
15657: ############################################################
15658:
15659: =pod
15660:
1.648 raeburn 15661: =item * &DrawXYGraph()
1.137 matthew 15662:
1.138 matthew 15663: Facilitates the plotting of data in an XY graph.
15664: Puts plot definition data into the users environment in order for
15665: graph.png to plot it. Returns an <img> tag for the plot.
15666:
15667: Inputs:
15668:
15669: =over 4
15670:
15671: =item $Title: string, the title of the plot
15672:
15673: =item $xlabel: string, text describing the X-axis of the plot
15674:
15675: =item $ylabel: string, text describing the Y-axis of the plot
15676:
15677: =item $Max: scalar, the maximum Y value to use in the plot
15678: If $Max is < any data point, the graph will not be rendered.
15679:
15680: =item $colors: Array ref containing the hex color codes for the data to be
15681: plotted in. If undefined, default values will be used.
15682:
15683: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15684:
15685: =item $Ydata: Array ref containing Array refs.
1.185 www 15686: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15687:
15688: =item %Values: hash indicating or overriding any default values which are
15689: passed to graph.png.
15690: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15691:
15692: =back
15693:
15694: Returns:
15695:
15696: An <img> tag which references graph.png and the appropriate identifying
15697: information for the plot.
15698:
1.137 matthew 15699: =cut
15700:
15701: ############################################################
15702: ############################################################
15703: sub DrawXYGraph {
15704: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15705: #
15706: # Create the identifier for the graph
15707: my $identifier = &get_cgi_id();
15708: my $id = 'cgi.'.$identifier;
15709: #
15710: $Title = '' if (! defined($Title));
15711: $xlabel = '' if (! defined($xlabel));
15712: $ylabel = '' if (! defined($ylabel));
15713: my %ValuesHash =
15714: (
1.369 www 15715: $id.'.title' => &escape($Title),
15716: $id.'.xlabel' => &escape($xlabel),
15717: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15718: $id.'.y_max_value'=> $Max,
15719: $id.'.labels' => join(',',@$Xlabels),
15720: $id.'.PlotType' => 'XY',
15721: );
15722: #
15723: if (defined($colors) && ref($colors) eq 'ARRAY') {
15724: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15725: }
15726: #
15727: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15728: return '';
15729: }
15730: my $NumSets=1;
1.138 matthew 15731: foreach my $array (@{$Ydata}){
1.137 matthew 15732: next if (! ref($array));
15733: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15734: }
1.138 matthew 15735: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15736: #
15737: # Deal with other parameters
15738: while (my ($key,$value) = each(%Values)) {
15739: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15740: }
15741: #
1.646 raeburn 15742: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15743: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15744: }
15745:
15746: ############################################################
15747: ############################################################
15748:
15749: =pod
15750:
1.648 raeburn 15751: =item * &DrawXYYGraph()
1.138 matthew 15752:
15753: Facilitates the plotting of data in an XY graph with two Y axes.
15754: Puts plot definition data into the users environment in order for
15755: graph.png to plot it. Returns an <img> tag for the plot.
15756:
15757: Inputs:
15758:
15759: =over 4
15760:
15761: =item $Title: string, the title of the plot
15762:
15763: =item $xlabel: string, text describing the X-axis of the plot
15764:
15765: =item $ylabel: string, text describing the Y-axis of the plot
15766:
15767: =item $colors: Array ref containing the hex color codes for the data to be
15768: plotted in. If undefined, default values will be used.
15769:
15770: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15771:
15772: =item $Ydata1: The first data set
15773:
15774: =item $Min1: The minimum value of the left Y-axis
15775:
15776: =item $Max1: The maximum value of the left Y-axis
15777:
15778: =item $Ydata2: The second data set
15779:
15780: =item $Min2: The minimum value of the right Y-axis
15781:
15782: =item $Max2: The maximum value of the left Y-axis
15783:
15784: =item %Values: hash indicating or overriding any default values which are
15785: passed to graph.png.
15786: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15787:
15788: =back
15789:
15790: Returns:
15791:
15792: An <img> tag which references graph.png and the appropriate identifying
15793: information for the plot.
1.136 matthew 15794:
15795: =cut
15796:
15797: ############################################################
15798: ############################################################
1.137 matthew 15799: sub DrawXYYGraph {
15800: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15801: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15802: #
15803: # Create the identifier for the graph
15804: my $identifier = &get_cgi_id();
15805: my $id = 'cgi.'.$identifier;
15806: #
15807: $Title = '' if (! defined($Title));
15808: $xlabel = '' if (! defined($xlabel));
15809: $ylabel = '' if (! defined($ylabel));
15810: my %ValuesHash =
15811: (
1.369 www 15812: $id.'.title' => &escape($Title),
15813: $id.'.xlabel' => &escape($xlabel),
15814: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15815: $id.'.labels' => join(',',@$Xlabels),
15816: $id.'.PlotType' => 'XY',
15817: $id.'.NumSets' => 2,
1.137 matthew 15818: $id.'.two_axes' => 1,
15819: $id.'.y1_max_value' => $Max1,
15820: $id.'.y1_min_value' => $Min1,
15821: $id.'.y2_max_value' => $Max2,
15822: $id.'.y2_min_value' => $Min2,
1.136 matthew 15823: );
15824: #
1.137 matthew 15825: if (defined($colors) && ref($colors) eq 'ARRAY') {
15826: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15827: }
15828: #
15829: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15830: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15831: return '';
15832: }
15833: my $NumSets=1;
1.137 matthew 15834: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15835: next if (! ref($array));
15836: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15837: }
15838: #
15839: # Deal with other parameters
15840: while (my ($key,$value) = each(%Values)) {
15841: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15842: }
15843: #
1.646 raeburn 15844: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15845: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15846: }
15847:
15848: ############################################################
15849: ############################################################
15850:
15851: =pod
15852:
1.157 matthew 15853: =back
15854:
1.139 matthew 15855: =head1 Statistics helper routines?
15856:
15857: Bad place for them but what the hell.
15858:
1.157 matthew 15859: =over 4
15860:
1.648 raeburn 15861: =item * &chartlink()
1.139 matthew 15862:
15863: Returns a link to the chart for a specific student.
15864:
15865: Inputs:
15866:
15867: =over 4
15868:
15869: =item $linktext: The text of the link
15870:
15871: =item $sname: The students username
15872:
15873: =item $sdomain: The students domain
15874:
15875: =back
15876:
1.157 matthew 15877: =back
15878:
1.139 matthew 15879: =cut
15880:
15881: ############################################################
15882: ############################################################
15883: sub chartlink {
15884: my ($linktext, $sname, $sdomain) = @_;
15885: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15886: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15887: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15888: '">'.$linktext.'</a>';
1.153 matthew 15889: }
15890:
15891: #######################################################
15892: #######################################################
15893:
15894: =pod
15895:
15896: =head1 Course Environment Routines
1.157 matthew 15897:
15898: =over 4
1.153 matthew 15899:
1.648 raeburn 15900: =item * &restore_course_settings()
1.153 matthew 15901:
1.648 raeburn 15902: =item * &store_course_settings()
1.153 matthew 15903:
15904: Restores/Store indicated form parameters from the course environment.
15905: Will not overwrite existing values of the form parameters.
15906:
15907: Inputs:
15908: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15909:
15910: a hash ref describing the data to be stored. For example:
15911:
15912: %Save_Parameters = ('Status' => 'scalar',
15913: 'chartoutputmode' => 'scalar',
15914: 'chartoutputdata' => 'scalar',
15915: 'Section' => 'array',
1.373 raeburn 15916: 'Group' => 'array',
1.153 matthew 15917: 'StudentData' => 'array',
15918: 'Maps' => 'array');
15919:
15920: Returns: both routines return nothing
15921:
1.631 raeburn 15922: =back
15923:
1.153 matthew 15924: =cut
15925:
15926: #######################################################
15927: #######################################################
15928: sub store_course_settings {
1.496 albertel 15929: return &store_settings($env{'request.course.id'},@_);
15930: }
15931:
15932: sub store_settings {
1.153 matthew 15933: # save to the environment
15934: # appenv the same items, just to be safe
1.300 albertel 15935: my $udom = $env{'user.domain'};
15936: my $uname = $env{'user.name'};
1.496 albertel 15937: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15938: my %SaveHash;
15939: my %AppHash;
15940: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15941: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15942: my $envname = 'environment.'.$basename;
1.258 albertel 15943: if (exists($env{'form.'.$setting})) {
1.153 matthew 15944: # Save this value away
15945: if ($type eq 'scalar' &&
1.258 albertel 15946: (! exists($env{$envname}) ||
15947: $env{$envname} ne $env{'form.'.$setting})) {
15948: $SaveHash{$basename} = $env{'form.'.$setting};
15949: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15950: } elsif ($type eq 'array') {
15951: my $stored_form;
1.258 albertel 15952: if (ref($env{'form.'.$setting})) {
1.153 matthew 15953: $stored_form = join(',',
15954: map {
1.369 www 15955: &escape($_);
1.258 albertel 15956: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15957: } else {
15958: $stored_form =
1.369 www 15959: &escape($env{'form.'.$setting});
1.153 matthew 15960: }
15961: # Determine if the array contents are the same.
1.258 albertel 15962: if ($stored_form ne $env{$envname}) {
1.153 matthew 15963: $SaveHash{$basename} = $stored_form;
15964: $AppHash{$envname} = $stored_form;
15965: }
15966: }
15967: }
15968: }
15969: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15970: $udom,$uname);
1.153 matthew 15971: if ($put_result !~ /^(ok|delayed)/) {
15972: &Apache::lonnet::logthis('unable to save form parameters, '.
15973: 'got error:'.$put_result);
15974: }
15975: # Make sure these settings stick around in this session, too
1.646 raeburn 15976: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15977: return;
15978: }
15979:
15980: sub restore_course_settings {
1.499 albertel 15981: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15982: }
15983:
15984: sub restore_settings {
15985: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15986: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15987: next if (exists($env{'form.'.$setting}));
1.496 albertel 15988: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15989: '.'.$setting;
1.258 albertel 15990: if (exists($env{$envname})) {
1.153 matthew 15991: if ($type eq 'scalar') {
1.258 albertel 15992: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15993: } elsif ($type eq 'array') {
1.258 albertel 15994: $env{'form.'.$setting} = [
1.153 matthew 15995: map {
1.369 www 15996: &unescape($_);
1.258 albertel 15997: } split(',',$env{$envname})
1.153 matthew 15998: ];
15999: }
16000: }
16001: }
1.127 matthew 16002: }
16003:
1.618 raeburn 16004: #######################################################
16005: #######################################################
16006:
16007: =pod
16008:
16009: =head1 Domain E-mail Routines
16010:
16011: =over 4
16012:
1.648 raeburn 16013: =item * &build_recipient_list()
1.618 raeburn 16014:
1.1144 raeburn 16015: Build recipient lists for following types of e-mail:
1.766 raeburn 16016: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 16017: (d) Help requests, (e) Course requests needing approval, (f) loncapa
16018: module change checking, student/employee ID conflict checks, as
16019: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
16020: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 16021:
16022: Inputs:
1.619 raeburn 16023: defmail (scalar - email address of default recipient),
1.1144 raeburn 16024: mailing type (scalar: errormail, packagesmail, helpdeskmail,
16025: requestsmail, updatesmail, or idconflictsmail).
16026:
1.619 raeburn 16027: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 16028:
1.619 raeburn 16029: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 16030: i.e., predates configuration by DC via domainprefs.pm
16031:
16032: $requname username of requester (if mailing type is helpdeskmail)
16033:
16034: $requdom domain of requester (if mailing type is helpdeskmail)
16035:
16036: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
16037:
1.618 raeburn 16038:
1.655 raeburn 16039: Returns: comma separated list of addresses to which to send e-mail.
16040:
16041: =back
1.618 raeburn 16042:
16043: =cut
16044:
16045: ############################################################
16046: ############################################################
16047: sub build_recipient_list {
1.1297 raeburn 16048: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 16049: my @recipients;
1.1270 raeburn 16050: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 16051: my %domconfig =
1.1270 raeburn 16052: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 16053: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 16054: if (exists($domconfig{'contacts'}{$mailing})) {
16055: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
16056: my @contacts = ('adminemail','supportemail');
16057: foreach my $item (@contacts) {
16058: if ($domconfig{'contacts'}{$mailing}{$item}) {
16059: my $addr = $domconfig{'contacts'}{$item};
16060: if (!grep(/^\Q$addr\E$/,@recipients)) {
16061: push(@recipients,$addr);
16062: }
1.619 raeburn 16063: }
1.1270 raeburn 16064: }
16065: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
16066: if ($mailing eq 'helpdeskmail') {
16067: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
16068: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
16069: my @ok_bccs;
16070: foreach my $bcc (@bccs) {
16071: $bcc =~ s/^\s+//g;
16072: $bcc =~ s/\s+$//g;
16073: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16074: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16075: push(@ok_bccs,$bcc);
16076: }
16077: }
16078: }
16079: if (@ok_bccs > 0) {
16080: $allbcc = join(', ',@ok_bccs);
16081: }
16082: }
16083: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 16084: }
16085: }
1.766 raeburn 16086: } elsif ($origmail ne '') {
1.1270 raeburn 16087: $lastresort = $origmail;
1.618 raeburn 16088: }
1.1297 raeburn 16089: if ($mailing eq 'helpdeskmail') {
16090: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
16091: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
16092: my ($inststatus,$inststatus_checked);
16093: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
16094: ($env{'user.domain'} ne 'public')) {
16095: $inststatus_checked = 1;
16096: $inststatus = $env{'environment.inststatus'};
16097: }
16098: unless ($inststatus_checked) {
16099: if (($requname ne '') && ($requdom ne '')) {
16100: if (($requname =~ /^$match_username$/) &&
16101: ($requdom =~ /^$match_domain$/) &&
16102: (&Apache::lonnet::domain($requdom))) {
16103: my $requhome = &Apache::lonnet::homeserver($requname,
16104: $requdom);
16105: unless ($requhome eq 'no_host') {
16106: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
16107: $inststatus = $userenv{'inststatus'};
16108: $inststatus_checked = 1;
16109: }
16110: }
16111: }
16112: }
16113: unless ($inststatus_checked) {
16114: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
16115: my %srch = (srchby => 'email',
16116: srchdomain => $defdom,
16117: srchterm => $reqemail,
16118: srchtype => 'exact');
16119: my %srch_results = &Apache::lonnet::usersearch(\%srch);
16120: foreach my $uname (keys(%srch_results)) {
16121: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16122: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16123: $inststatus_checked = 1;
16124: last;
16125: }
16126: }
16127: unless ($inststatus_checked) {
16128: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
16129: if ($dirsrchres eq 'ok') {
16130: foreach my $uname (keys(%srch_results)) {
16131: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16132: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16133: $inststatus_checked = 1;
16134: last;
16135: }
16136: }
16137: }
16138: }
16139: }
16140: }
16141: if ($inststatus ne '') {
16142: foreach my $status (split(/\:/,$inststatus)) {
16143: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
16144: my @contacts = ('adminemail','supportemail');
16145: foreach my $item (@contacts) {
16146: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
16147: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
16148: if (!grep(/^\Q$addr\E$/,@recipients)) {
16149: push(@recipients,$addr);
16150: }
16151: }
16152: }
16153: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
16154: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
16155: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
16156: my @ok_bccs;
16157: foreach my $bcc (@bccs) {
16158: $bcc =~ s/^\s+//g;
16159: $bcc =~ s/\s+$//g;
16160: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16161: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16162: push(@ok_bccs,$bcc);
16163: }
16164: }
16165: }
16166: if (@ok_bccs > 0) {
16167: $allbcc = join(', ',@ok_bccs);
16168: }
16169: }
16170: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
16171: last;
16172: }
16173: }
16174: }
16175: }
16176: }
1.619 raeburn 16177: } elsif ($origmail ne '') {
1.1270 raeburn 16178: $lastresort = $origmail;
16179: }
1.1297 raeburn 16180: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 16181: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
16182: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
16183: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
16184: my %what = (
16185: perlvar => 1,
16186: );
16187: my $primary = &Apache::lonnet::domain($defdom,'primary');
16188: if ($primary) {
16189: my $gotaddr;
16190: my ($result,$returnhash) =
16191: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
16192: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
16193: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
16194: $lastresort = $returnhash->{'lonSupportEMail'};
16195: $gotaddr = 1;
16196: }
16197: }
16198: unless ($gotaddr) {
16199: my $uintdom = &Apache::lonnet::internet_dom($primary);
16200: my $intdom = &Apache::lonnet::internet_dom($lonhost);
16201: unless ($uintdom eq $intdom) {
16202: my %domconfig =
16203: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
16204: if (ref($domconfig{'contacts'}) eq 'HASH') {
16205: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
16206: my @contacts = ('adminemail','supportemail');
16207: foreach my $item (@contacts) {
16208: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
16209: my $addr = $domconfig{'contacts'}{$item};
16210: if (!grep(/^\Q$addr\E$/,@recipients)) {
16211: push(@recipients,$addr);
16212: }
16213: }
16214: }
16215: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
16216: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
16217: }
16218: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
16219: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
16220: my @ok_bccs;
16221: foreach my $bcc (@bccs) {
16222: $bcc =~ s/^\s+//g;
16223: $bcc =~ s/\s+$//g;
16224: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16225: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16226: push(@ok_bccs,$bcc);
16227: }
16228: }
16229: }
16230: if (@ok_bccs > 0) {
16231: $allbcc = join(', ',@ok_bccs);
16232: }
16233: }
16234: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
16235: }
16236: }
16237: }
16238: }
16239: }
16240: }
1.618 raeburn 16241: }
1.688 raeburn 16242: if (defined($defmail)) {
16243: if ($defmail ne '') {
16244: push(@recipients,$defmail);
16245: }
1.618 raeburn 16246: }
16247: if ($otheremails) {
1.619 raeburn 16248: my @others;
16249: if ($otheremails =~ /,/) {
16250: @others = split(/,/,$otheremails);
1.618 raeburn 16251: } else {
1.619 raeburn 16252: push(@others,$otheremails);
16253: }
16254: foreach my $addr (@others) {
16255: if (!grep(/^\Q$addr\E$/,@recipients)) {
16256: push(@recipients,$addr);
16257: }
1.618 raeburn 16258: }
16259: }
1.1298 raeburn 16260: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 16261: if ((!@recipients) && ($lastresort ne '')) {
16262: push(@recipients,$lastresort);
16263: }
16264: } elsif ($lastresort ne '') {
16265: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
16266: push(@recipients,$lastresort);
16267: }
16268: }
1.1271 raeburn 16269: my $recipientlist = join(',',@recipients);
1.1270 raeburn 16270: if (wantarray) {
16271: return ($recipientlist,$allbcc,$addtext);
16272: } else {
16273: return $recipientlist;
16274: }
1.618 raeburn 16275: }
16276:
1.127 matthew 16277: ############################################################
16278: ############################################################
1.154 albertel 16279:
1.655 raeburn 16280: =pod
16281:
1.1224 musolffc 16282: =over 4
16283:
1.1223 musolffc 16284: =item * &mime_email()
16285:
16286: Sends an email with a possible attachment
16287:
16288: Inputs:
16289:
16290: =over 4
16291:
16292: from - Sender's email address
16293:
1.1343 raeburn 16294: replyto - Reply-To email address
16295:
1.1223 musolffc 16296: to - Email address of recipient
16297:
16298: subject - Subject of email
16299:
16300: body - Body of email
16301:
16302: cc_string - Carbon copy email address
16303:
16304: bcc - Blind carbon copy email address
16305:
16306: attachment_path - Path of file to be attached
16307:
16308: file_name - Name of file to be attached
16309:
16310: attachment_text - The body of an attachment of type "TEXT"
16311:
16312: =back
16313:
16314: =back
16315:
16316: =cut
16317:
16318: ############################################################
16319: ############################################################
16320:
16321: sub mime_email {
1.1343 raeburn 16322: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
16323: $file_name,$attachment_text) = @_;
16324:
1.1223 musolffc 16325: my $msg = MIME::Lite->new(
16326: From => $from,
16327: To => $to,
16328: Subject => $subject,
16329: Type =>'TEXT',
16330: Data => $body,
16331: );
1.1343 raeburn 16332: if ($replyto ne '') {
16333: $msg->add("Reply-To" => $replyto);
16334: }
1.1223 musolffc 16335: if ($cc_string ne '') {
16336: $msg->add("Cc" => $cc_string);
16337: }
16338: if ($bcc ne '') {
16339: $msg->add("Bcc" => $bcc);
16340: }
16341: $msg->attr("content-type" => "text/plain");
16342: $msg->attr("content-type.charset" => "UTF-8");
16343: # Attach file if given
16344: if ($attachment_path) {
16345: unless ($file_name) {
16346: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
16347: }
16348: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
16349: $msg->attach(Type => $type,
16350: Path => $attachment_path,
16351: Filename => $file_name
16352: );
16353: # Otherwise attach text if given
16354: } elsif ($attachment_text) {
16355: $msg->attach(Type => 'TEXT',
16356: Data => $attachment_text);
16357: }
16358: # Send it
16359: $msg->send('sendmail');
16360: }
16361:
16362: ############################################################
16363: ############################################################
16364:
16365: =pod
16366:
1.655 raeburn 16367: =head1 Course Catalog Routines
16368:
16369: =over 4
16370:
16371: =item * &gather_categories()
16372:
16373: Converts category definitions - keys of categories hash stored in
16374: coursecategories in configuration.db on the primary library server in a
16375: domain - to an array. Also generates javascript and idx hash used to
16376: generate Domain Coordinator interface for editing Course Categories.
16377:
16378: Inputs:
1.663 raeburn 16379:
1.655 raeburn 16380: categories (reference to hash of category definitions).
1.663 raeburn 16381:
1.655 raeburn 16382: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16383: categories and subcategories).
1.663 raeburn 16384:
1.655 raeburn 16385: idx (reference to hash of counters used in Domain Coordinator interface for
16386: editing Course Categories).
1.663 raeburn 16387:
1.655 raeburn 16388: jsarray (reference to array of categories used to create Javascript arrays for
16389: Domain Coordinator interface for editing Course Categories).
16390:
16391: Returns: nothing
16392:
16393: Side effects: populates cats, idx and jsarray.
16394:
16395: =cut
16396:
16397: sub gather_categories {
16398: my ($categories,$cats,$idx,$jsarray) = @_;
16399: my %counters;
16400: my $num = 0;
16401: foreach my $item (keys(%{$categories})) {
16402: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
16403: if ($container eq '' && $depth == 0) {
16404: $cats->[$depth][$categories->{$item}] = $cat;
16405: } else {
16406: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
16407: }
16408: my ($escitem,$tail) = split(/:/,$item,2);
16409: if ($counters{$tail} eq '') {
16410: $counters{$tail} = $num;
16411: $num ++;
16412: }
16413: if (ref($idx) eq 'HASH') {
16414: $idx->{$item} = $counters{$tail};
16415: }
16416: if (ref($jsarray) eq 'ARRAY') {
16417: push(@{$jsarray->[$counters{$tail}]},$item);
16418: }
16419: }
16420: return;
16421: }
16422:
16423: =pod
16424:
16425: =item * &extract_categories()
16426:
16427: Used to generate breadcrumb trails for course categories.
16428:
16429: Inputs:
1.663 raeburn 16430:
1.655 raeburn 16431: categories (reference to hash of category definitions).
1.663 raeburn 16432:
1.655 raeburn 16433: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16434: categories and subcategories).
1.663 raeburn 16435:
1.655 raeburn 16436: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 16437:
1.655 raeburn 16438: allitems (reference to hash - key is category key
16439: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16440:
1.655 raeburn 16441: idx (reference to hash of counters used in Domain Coordinator interface for
16442: editing Course Categories).
1.663 raeburn 16443:
1.655 raeburn 16444: jsarray (reference to array of categories used to create Javascript arrays for
16445: Domain Coordinator interface for editing Course Categories).
16446:
1.665 raeburn 16447: subcats (reference to hash of arrays containing all subcategories within each
16448: category, -recursive)
16449:
1.1321 raeburn 16450: maxd (reference to hash used to hold max depth for all top-level categories).
16451:
1.655 raeburn 16452: Returns: nothing
16453:
16454: Side effects: populates trails and allitems hash references.
16455:
16456: =cut
16457:
16458: sub extract_categories {
1.1321 raeburn 16459: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 16460: if (ref($categories) eq 'HASH') {
16461: &gather_categories($categories,$cats,$idx,$jsarray);
16462: if (ref($cats->[0]) eq 'ARRAY') {
16463: for (my $i=0; $i<@{$cats->[0]}; $i++) {
16464: my $name = $cats->[0][$i];
16465: my $item = &escape($name).'::0';
16466: my $trailstr;
16467: if ($name eq 'instcode') {
16468: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 16469: } elsif ($name eq 'communities') {
16470: $trailstr = &mt('Communities');
1.1239 raeburn 16471: } elsif ($name eq 'placement') {
16472: $trailstr = &mt('Placement Tests');
1.655 raeburn 16473: } else {
16474: $trailstr = $name;
16475: }
16476: if ($allitems->{$item} eq '') {
16477: push(@{$trails},$trailstr);
16478: $allitems->{$item} = scalar(@{$trails})-1;
16479: }
16480: my @parents = ($name);
16481: if (ref($cats->[1]{$name}) eq 'ARRAY') {
16482: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
16483: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 16484: if (ref($subcats) eq 'HASH') {
16485: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
16486: }
1.1321 raeburn 16487: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 16488: }
16489: } else {
16490: if (ref($subcats) eq 'HASH') {
16491: $subcats->{$item} = [];
1.655 raeburn 16492: }
1.1321 raeburn 16493: if (ref($maxd) eq 'HASH') {
16494: $maxd->{$name} = 1;
16495: }
1.655 raeburn 16496: }
16497: }
16498: }
16499: }
16500: return;
16501: }
16502:
16503: =pod
16504:
1.1162 raeburn 16505: =item * &recurse_categories()
1.655 raeburn 16506:
16507: Recursively used to generate breadcrumb trails for course categories.
16508:
16509: Inputs:
1.663 raeburn 16510:
1.655 raeburn 16511: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16512: categories and subcategories).
1.663 raeburn 16513:
1.655 raeburn 16514: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16515:
16516: category (current course category, for which breadcrumb trail is being generated).
16517:
16518: trails (reference to array of breadcrumb trails for each category).
16519:
1.655 raeburn 16520: allitems (reference to hash - key is category key
16521: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16522:
1.655 raeburn 16523: parents (array containing containers directories for current category,
16524: back to top level).
16525:
16526: Returns: nothing
16527:
16528: Side effects: populates trails and allitems hash references
16529:
16530: =cut
16531:
16532: sub recurse_categories {
1.1321 raeburn 16533: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16534: my $shallower = $depth - 1;
16535: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16536: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16537: my $name = $cats->[$depth]{$category}[$k];
16538: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16539: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16540: if ($allitems->{$item} eq '') {
16541: push(@{$trails},$trailstr);
16542: $allitems->{$item} = scalar(@{$trails})-1;
16543: }
16544: my $deeper = $depth+1;
16545: push(@{$parents},$category);
1.665 raeburn 16546: if (ref($subcats) eq 'HASH') {
16547: my $subcat = &escape($name).':'.$category.':'.$depth;
16548: for (my $j=@{$parents}; $j>=0; $j--) {
16549: my $higher;
16550: if ($j > 0) {
16551: $higher = &escape($parents->[$j]).':'.
16552: &escape($parents->[$j-1]).':'.$j;
16553: } else {
16554: $higher = &escape($parents->[$j]).'::'.$j;
16555: }
16556: push(@{$subcats->{$higher}},$subcat);
16557: }
16558: }
16559: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16560: $subcats,$maxd);
1.655 raeburn 16561: pop(@{$parents});
16562: }
16563: } else {
16564: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16565: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16566: if ($allitems->{$item} eq '') {
16567: push(@{$trails},$trailstr);
16568: $allitems->{$item} = scalar(@{$trails})-1;
16569: }
1.1321 raeburn 16570: if (ref($maxd) eq 'HASH') {
16571: if ($depth > $maxd->{$parents->[0]}) {
16572: $maxd->{$parents->[0]} = $depth;
16573: }
16574: }
1.655 raeburn 16575: }
16576: return;
16577: }
16578:
1.663 raeburn 16579: =pod
16580:
1.1162 raeburn 16581: =item * &assign_categories_table()
1.663 raeburn 16582:
16583: Create a datatable for display of hierarchical categories in a domain,
16584: with checkboxes to allow a course to be categorized.
16585:
16586: Inputs:
16587:
16588: cathash - reference to hash of categories defined for the domain (from
16589: configuration.db)
16590:
16591: currcat - scalar with an & separated list of categories assigned to a course.
16592:
1.919 raeburn 16593: type - scalar contains course type (Course or Community).
16594:
1.1260 raeburn 16595: disabled - scalar (optional) contains disabled="disabled" if input elements are
16596: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16597:
1.663 raeburn 16598: Returns: $output (markup to be displayed)
16599:
16600: =cut
16601:
16602: sub assign_categories_table {
1.1259 raeburn 16603: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16604: my $output;
16605: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16606: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16607: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16608: $maxdepth = scalar(@cats);
16609: if (@cats > 0) {
16610: my $itemcount = 0;
16611: if (ref($cats[0]) eq 'ARRAY') {
16612: my @currcategories;
16613: if ($currcat ne '') {
16614: @currcategories = split('&',$currcat);
16615: }
1.919 raeburn 16616: my $table;
1.663 raeburn 16617: for (my $i=0; $i<@{$cats[0]}; $i++) {
16618: my $parent = $cats[0][$i];
1.919 raeburn 16619: next if ($parent eq 'instcode');
16620: if ($type eq 'Community') {
16621: next unless ($parent eq 'communities');
1.1239 raeburn 16622: } elsif ($type eq 'Placement') {
16623: next unless ($parent eq 'placement');
1.919 raeburn 16624: } else {
1.1239 raeburn 16625: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16626: }
1.663 raeburn 16627: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16628: my $item = &escape($parent).'::0';
16629: my $checked = '';
16630: if (@currcategories > 0) {
16631: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16632: $checked = ' checked="checked"';
1.663 raeburn 16633: }
16634: }
1.919 raeburn 16635: my $parent_title = $parent;
16636: if ($parent eq 'communities') {
16637: $parent_title = &mt('Communities');
1.1239 raeburn 16638: } elsif ($parent eq 'placement') {
16639: $parent_title = &mt('Placement Tests');
1.919 raeburn 16640: }
16641: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16642: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16643: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16644: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16645: my $depth = 1;
16646: push(@path,$parent);
1.1259 raeburn 16647: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16648: pop(@path);
1.919 raeburn 16649: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16650: $itemcount ++;
16651: }
1.919 raeburn 16652: if ($itemcount) {
16653: $output = &Apache::loncommon::start_data_table().
16654: $table.
16655: &Apache::loncommon::end_data_table();
16656: }
1.663 raeburn 16657: }
16658: }
16659: }
16660: return $output;
16661: }
16662:
16663: =pod
16664:
1.1162 raeburn 16665: =item * &assign_category_rows()
1.663 raeburn 16666:
16667: Create a datatable row for display of nested categories in a domain,
16668: with checkboxes to allow a course to be categorized,called recursively.
16669:
16670: Inputs:
16671:
16672: itemcount - track row number for alternating colors
16673:
16674: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16675: categories and subcategories.
16676:
16677: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16678:
16679: parent - parent of current category item
16680:
16681: path - Array containing all categories back up through the hierarchy from the
16682: current category to the top level.
16683:
16684: currcategories - reference to array of current categories assigned to the course
16685:
1.1260 raeburn 16686: disabled - scalar (optional) contains disabled="disabled" if input elements are
16687: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16688:
1.663 raeburn 16689: Returns: $output (markup to be displayed).
16690:
16691: =cut
16692:
16693: sub assign_category_rows {
1.1259 raeburn 16694: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16695: my ($text,$name,$item,$chgstr);
16696: if (ref($cats) eq 'ARRAY') {
16697: my $maxdepth = scalar(@{$cats});
16698: if (ref($cats->[$depth]) eq 'HASH') {
16699: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16700: my $numchildren = @{$cats->[$depth]{$parent}};
16701: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16702: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16703: for (my $j=0; $j<$numchildren; $j++) {
16704: $name = $cats->[$depth]{$parent}[$j];
16705: $item = &escape($name).':'.&escape($parent).':'.$depth;
16706: my $deeper = $depth+1;
16707: my $checked = '';
16708: if (ref($currcategories) eq 'ARRAY') {
16709: if (@{$currcategories} > 0) {
16710: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16711: $checked = ' checked="checked"';
1.663 raeburn 16712: }
16713: }
16714: }
1.664 raeburn 16715: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16716: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16717: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16718: '<input type="hidden" name="catname" value="'.$name.'" />'.
16719: '</td><td>';
1.663 raeburn 16720: if (ref($path) eq 'ARRAY') {
16721: push(@{$path},$name);
1.1259 raeburn 16722: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16723: pop(@{$path});
16724: }
16725: $text .= '</td></tr>';
16726: }
16727: $text .= '</table></td>';
16728: }
16729: }
16730: }
16731: return $text;
16732: }
16733:
1.1181 raeburn 16734: =pod
16735:
16736: =back
16737:
16738: =cut
16739:
1.655 raeburn 16740: ############################################################
16741: ############################################################
16742:
16743:
1.443 albertel 16744: sub commit_customrole {
1.1408 raeburn 16745: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
1.1399 raeburn 16746: my $result = &Apache::lonnet::assigncustomrole(
1.1408 raeburn 16747: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
16748: $context,$othdomby,$requester);
1.630 raeburn 16749: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16750: ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399 raeburn 16751: ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
16752: if (wantarray) {
16753: return ($output,$result);
16754: } else {
16755: return $output;
16756: }
1.443 albertel 16757: }
16758:
16759: sub commit_standardrole {
1.1408 raeburn 16760: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits,
16761: $othdomby,$requester) = @_;
1.1399 raeburn 16762: my ($output,$logmsg,$linefeed,$result);
1.541 raeburn 16763: if ($context eq 'auto') {
16764: $linefeed = "\n";
16765: } else {
16766: $linefeed = "<br />\n";
16767: }
1.443 albertel 16768: if ($three eq 'st') {
1.1399 raeburn 16769: $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1408 raeburn 16770: $one,$two,$sec,$context,$credits,$othdomby,
16771: $requester);
1.541 raeburn 16772: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16773: ($result eq 'unknown_course') || ($result eq 'refused')) {
16774: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16775: } else {
1.541 raeburn 16776: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16777: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16778: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16779: if ($context eq 'auto') {
16780: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16781: } else {
16782: $output .= '<b>'.$result.'</b>'.$linefeed.
16783: &mt('Add to classlist').': <b>ok</b>';
16784: }
16785: $output .= $linefeed;
1.443 albertel 16786: }
16787: } else {
16788: $output = &mt('Assigning').' '.$three.' in '.$url.
16789: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16790: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1408 raeburn 16791: $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,
16792: '','',$context,$othdomby,$requester);
1.541 raeburn 16793: if ($context eq 'auto') {
16794: $output .= $result.$linefeed;
16795: } else {
16796: $output .= '<b>'.$result.'</b>'.$linefeed;
16797: }
1.443 albertel 16798: }
1.1399 raeburn 16799: if (wantarray) {
16800: return ($output,$result);
16801: } else {
16802: return $output;
16803: }
1.443 albertel 16804: }
16805:
16806: sub commit_studentrole {
1.1116 raeburn 16807: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
1.1408 raeburn 16808: $credits,$othdomby,$requester) = @_;
1.626 raeburn 16809: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16810: if ($context eq 'auto') {
16811: $linefeed = "\n";
16812: } else {
16813: $linefeed = '<br />'."\n";
16814: }
1.443 albertel 16815: if (defined($one) && defined($two)) {
16816: my $cid=$one.'_'.$two;
16817: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16818: my $secchange = 0;
16819: my $expire_role_result;
16820: my $modify_section_result;
1.628 raeburn 16821: if ($oldsec ne '-1') {
16822: if ($oldsec ne $sec) {
1.443 albertel 16823: $secchange = 1;
1.628 raeburn 16824: my $now = time;
1.443 albertel 16825: my $uurl='/'.$cid;
16826: $uurl=~s/\_/\//g;
16827: if ($oldsec) {
16828: $uurl.='/'.$oldsec;
16829: }
1.626 raeburn 16830: $oldsecurl = $uurl;
1.628 raeburn 16831: $expire_role_result =
1.1408 raeburn 16832: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
16833: '','','',$context,$othdomby,$requester);
16834: if ($env{'request.course.sec'} ne '') {
1.628 raeburn 16835: if ($expire_role_result eq 'refused') {
16836: my @roles = ('st');
16837: my @statuses = ('previous');
16838: my @roledoms = ($one);
16839: my $withsec = 1;
16840: my %roleshash =
16841: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16842: \@statuses,\@roles,\@roledoms,$withsec);
16843: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16844: my ($oldstart,$oldend) =
16845: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16846: if ($oldend > 0 && $oldend <= $now) {
16847: $expire_role_result = 'ok';
16848: }
16849: }
16850: }
16851: }
1.443 albertel 16852: $result = $expire_role_result;
16853: }
16854: }
16855: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 16856: $modify_section_result =
16857: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16858: undef,undef,undef,$sec,
16859: $end,$start,'','',$cid,
1.1408 raeburn 16860: '',$context,$credits,'',
16861: $othdomby,$requester);
1.443 albertel 16862: if ($modify_section_result =~ /^ok/) {
16863: if ($secchange == 1) {
1.628 raeburn 16864: if ($sec eq '') {
16865: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16866: } else {
16867: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16868: }
1.443 albertel 16869: } elsif ($oldsec eq '-1') {
1.628 raeburn 16870: if ($sec eq '') {
16871: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16872: } else {
16873: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16874: }
1.443 albertel 16875: } else {
1.628 raeburn 16876: if ($sec eq '') {
16877: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16878: } else {
16879: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16880: }
1.443 albertel 16881: }
16882: } else {
1.1115 raeburn 16883: if ($secchange) {
1.628 raeburn 16884: $$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;
16885: } else {
16886: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16887: }
1.443 albertel 16888: }
16889: $result = $modify_section_result;
16890: } elsif ($secchange == 1) {
1.628 raeburn 16891: if ($oldsec eq '') {
1.1103 raeburn 16892: $$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 16893: } else {
16894: $$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;
16895: }
1.626 raeburn 16896: if ($expire_role_result eq 'refused') {
16897: my $newsecurl = '/'.$cid;
16898: $newsecurl =~ s/\_/\//g;
16899: if ($sec ne '') {
16900: $newsecurl.='/'.$sec;
16901: }
16902: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16903: if ($sec eq '') {
16904: $$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;
16905: } else {
16906: $$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;
16907: }
16908: }
16909: }
1.443 albertel 16910: }
16911: } else {
1.626 raeburn 16912: $$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 16913: $result = "error: incomplete course id\n";
16914: }
16915: return $result;
16916: }
16917:
1.1108 raeburn 16918: sub show_role_extent {
16919: my ($scope,$context,$role) = @_;
16920: $scope =~ s{^/}{};
16921: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16922: push(@courseroles,'co');
16923: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16924: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16925: $scope =~ s{/}{_};
16926: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16927: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16928: my ($audom,$auname) = split(/\//,$scope);
16929: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16930: &Apache::loncommon::plainname($auname,$audom).'</span>');
16931: } else {
16932: $scope =~ s{/$}{};
16933: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16934: &Apache::lonnet::domain($scope,'description').'</span>');
16935: }
16936: }
16937:
1.443 albertel 16938: ############################################################
16939: ############################################################
16940:
1.566 albertel 16941: sub check_clone {
1.578 raeburn 16942: my ($args,$linefeed) = @_;
1.566 albertel 16943: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16944: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16945: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 16946: my $clonetitle;
16947: my @clonemsg;
1.566 albertel 16948: my $can_clone = 0;
1.944 raeburn 16949: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16950: if ($lctype ne 'community') {
16951: $lctype = 'course';
16952: }
1.566 albertel 16953: if ($clonehome eq 'no_host') {
1.944 raeburn 16954: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16955: push(@clonemsg,({
16956: mt => 'No new community created.',
16957: args => [],
16958: },
16959: {
16960: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16961: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16962: }));
1.908 raeburn 16963: } else {
1.1344 raeburn 16964: push(@clonemsg,({
16965: mt => 'No new course created.',
16966: args => [],
16967: },
16968: {
16969: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16970: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16971: }));
16972: }
1.566 albertel 16973: } else {
16974: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 16975: $clonetitle = $clonedesc{'description'};
1.944 raeburn 16976: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16977: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 16978: push(@clonemsg,({
16979: mt => 'No new community created.',
16980: args => [],
16981: },
16982: {
16983: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16984: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16985: }));
16986: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16987: }
16988: }
1.1262 raeburn 16989: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16990: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16991: $can_clone = 1;
16992: } else {
1.1221 raeburn 16993: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16994: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 16995: if ($clonehash{'cloners'} eq '') {
16996: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16997: if ($domdefs{'canclone'}) {
16998: unless ($domdefs{'canclone'} eq 'none') {
16999: if ($domdefs{'canclone'} eq 'domain') {
17000: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
17001: $can_clone = 1;
17002: }
17003: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
17004: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
17005: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
17006: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
17007: $can_clone = 1;
17008: }
17009: }
17010: }
17011: }
1.578 raeburn 17012: } else {
1.1221 raeburn 17013: my @cloners = split(/,/,$clonehash{'cloners'});
17014: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 17015: $can_clone = 1;
1.1221 raeburn 17016: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 17017: $can_clone = 1;
1.1225 raeburn 17018: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
17019: $can_clone = 1;
1.1221 raeburn 17020: }
17021: unless ($can_clone) {
1.1225 raeburn 17022: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
17023: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 17024: my (%gotdomdefaults,%gotcodedefaults);
17025: foreach my $cloner (@cloners) {
17026: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
17027: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
17028: my (%codedefaults,@code_order);
17029: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
17030: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
17031: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
17032: }
17033: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
17034: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
17035: }
17036: } else {
17037: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
17038: \%codedefaults,
17039: \@code_order);
17040: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
17041: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
17042: }
17043: if (@code_order > 0) {
17044: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
17045: $cloner,$clonehash{'internal.coursecode'},
17046: $args->{'crscode'})) {
17047: $can_clone = 1;
17048: last;
17049: }
17050: }
17051: }
17052: }
17053: }
1.1225 raeburn 17054: }
17055: }
17056: unless ($can_clone) {
17057: my $ccrole = 'cc';
17058: if ($args->{'crstype'} eq 'Community') {
17059: $ccrole = 'co';
17060: }
17061: my %roleshash =
17062: &Apache::lonnet::get_my_roles($args->{'ccuname'},
17063: $args->{'ccdomain'},
17064: 'userroles',['active'],[$ccrole],
17065: [$args->{'clonedomain'}]);
17066: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
17067: $can_clone = 1;
17068: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
17069: $args->{'ccuname'},$args->{'ccdomain'})) {
17070: $can_clone = 1;
1.1221 raeburn 17071: }
17072: }
17073: unless ($can_clone) {
17074: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 17075: push(@clonemsg,({
17076: mt => 'No new community created.',
17077: args => [],
17078: },
17079: {
17080: 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]).',
17081: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
17082: }));
1.942 raeburn 17083: } else {
1.1344 raeburn 17084: push(@clonemsg,({
17085: mt => 'No new course created.',
17086: args => [],
17087: },
17088: {
17089: 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]).',
17090: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
17091: }));
1.1221 raeburn 17092: }
1.566 albertel 17093: }
1.578 raeburn 17094: }
1.566 albertel 17095: }
1.1344 raeburn 17096: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17097: }
17098:
1.444 albertel 17099: sub construct_course {
1.1262 raeburn 17100: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 17101: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
17102: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 17103: my $linefeed = '<br />'."\n";
17104: if ($context eq 'auto') {
17105: $linefeed = "\n";
17106: }
1.566 albertel 17107:
17108: #
17109: # Are we cloning?
17110: #
1.1344 raeburn 17111: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17112: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 17113: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 17114: if (!$can_clone) {
1.1344 raeburn 17115: return (0,$outcome,$clonemsgref);
1.566 albertel 17116: }
17117: }
17118:
1.444 albertel 17119: #
17120: # Open course
17121: #
1.1239 raeburn 17122: my $showncrstype;
17123: if ($args->{'crstype'} eq 'Placement') {
17124: $showncrstype = 'placement test';
17125: } else {
17126: $showncrstype = lc($args->{'crstype'});
17127: }
1.444 albertel 17128: my %cenv=();
17129: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
17130: $args->{'cdescr'},
17131: $args->{'curl'},
17132: $args->{'course_home'},
17133: $args->{'nonstandard'},
17134: $args->{'crscode'},
17135: $args->{'ccuname'}.':'.
17136: $args->{'ccdomain'},
1.882 raeburn 17137: $args->{'crstype'},
1.1344 raeburn 17138: $cnum,$context,$category,
17139: $callercontext);
1.444 albertel 17140:
17141: # Note: The testing routines depend on this being output; see
17142: # Utils::Course. This needs to at least be output as a comment
17143: # if anyone ever decides to not show this, and Utils::Course::new
17144: # will need to be suitably modified.
1.1344 raeburn 17145: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17146: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17147: } else {
17148: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17149: }
1.943 raeburn 17150: if ($$courseid =~ /^error:/) {
1.1344 raeburn 17151: return (0,$outcome,$clonemsgref);
1.943 raeburn 17152: }
17153:
1.444 albertel 17154: #
17155: # Check if created correctly
17156: #
1.479 albertel 17157: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 17158: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 17159: if ($crsuhome eq 'no_host') {
1.1344 raeburn 17160: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17161: $outcome .= &mt_user($user_lh,
17162: 'Course creation failed, unrecognized course home server.');
17163: } else {
17164: $outcome .= &mt('Course creation failed, unrecognized course home server.');
17165: }
17166: $outcome .= $linefeed;
17167: return (0,$outcome,$clonemsgref);
1.943 raeburn 17168: }
1.541 raeburn 17169: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 17170:
1.444 albertel 17171: #
1.566 albertel 17172: # Do the cloning
17173: #
1.1344 raeburn 17174: my @clonemsg;
1.566 albertel 17175: if ($can_clone && $cloneid) {
1.1344 raeburn 17176: push(@clonemsg,
17177: {
17178: mt => 'Created [_1] by cloning from [_2]',
17179: args => [$showncrstype,$clonetitle],
17180: });
1.566 albertel 17181: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 17182: # Copy all files
1.1344 raeburn 17183: my @info =
17184: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
17185: $args->{'dateshift'},$args->{'crscode'},
17186: $args->{'ccuname'}.':'.$args->{'ccdomain'},
17187: $args->{'tinyurls'});
17188: if (@info) {
17189: push(@clonemsg,@info);
17190: }
1.444 albertel 17191: # Restore URL
1.566 albertel 17192: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 17193: # Restore title
1.566 albertel 17194: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 17195: # Restore creation date, creator and creation context.
17196: $cenv{'internal.created'}=$oldcenv{'internal.created'};
17197: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
17198: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 17199: # Mark as cloned
1.566 albertel 17200: $cenv{'clonedfrom'}=$cloneid;
1.638 www 17201: # Need to clone grading mode
17202: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
17203: $cenv{'grading'}=$newenv{'grading'};
17204: # Do not clone these environment entries
17205: &Apache::lonnet::del('environment',
17206: ['default_enrollment_start_date',
17207: 'default_enrollment_end_date',
17208: 'question.email',
17209: 'policy.email',
17210: 'comment.email',
17211: 'pch.users.denied',
1.725 raeburn 17212: 'plc.users.denied',
17213: 'hidefromcat',
1.1121 raeburn 17214: 'checkforpriv',
1.1355 raeburn 17215: 'categories'],
1.638 www 17216: $$crsudom,$$crsunum);
1.1170 raeburn 17217: if ($args->{'textbook'}) {
17218: $cenv{'internal.textbook'} = $args->{'textbook'};
17219: }
1.444 albertel 17220: }
1.566 albertel 17221:
1.444 albertel 17222: #
17223: # Set environment (will override cloned, if existing)
17224: #
17225: my @sections = ();
17226: my @xlists = ();
17227: if ($args->{'crstype'}) {
17228: $cenv{'type'}=$args->{'crstype'};
17229: }
1.1371 raeburn 17230: if ($args->{'lti'}) {
17231: $cenv{'internal.lti'}=$args->{'lti'};
17232: }
1.444 albertel 17233: if ($args->{'crsid'}) {
17234: $cenv{'courseid'}=$args->{'crsid'};
17235: }
17236: if ($args->{'crscode'}) {
17237: $cenv{'internal.coursecode'}=$args->{'crscode'};
17238: }
17239: if ($args->{'crsquota'} ne '') {
17240: $cenv{'internal.coursequota'}=$args->{'crsquota'};
17241: } else {
17242: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
17243: }
17244: if ($args->{'ccuname'}) {
17245: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
17246: ':'.$args->{'ccdomain'};
17247: } else {
17248: $cenv{'internal.courseowner'} = $args->{'curruser'};
17249: }
1.1116 raeburn 17250: if ($args->{'defaultcredits'}) {
17251: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
17252: }
1.444 albertel 17253: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1412 raeburn 17254: my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444 albertel 17255: if ($args->{'crssections'}) {
17256: $cenv{'internal.sectionnums'} = '';
17257: if ($args->{'crssections'} =~ m/,/) {
17258: @sections = split/,/,$args->{'crssections'};
17259: } else {
17260: $sections[0] = $args->{'crssections'};
17261: }
17262: if (@sections > 0) {
17263: foreach my $item (@sections) {
17264: my ($sec,$gp) = split/:/,$item;
17265: my $class = $args->{'crscode'}.$sec;
17266: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
17267: $cenv{'internal.sectionnums'} .= $item.',';
1.1412 raeburn 17268: if ($addcheck eq 'ok') {
17269: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17270: push(@oklcsecs,$gp);
17271: }
17272: } else {
1.1263 raeburn 17273: push(@badclasses,$class);
1.444 albertel 17274: }
17275: }
17276: $cenv{'internal.sectionnums'} =~ s/,$//;
17277: }
17278: }
17279: # do not hide course coordinator from staff listing,
17280: # even if privileged
17281: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 17282: # add course coordinator's domain to domains to check for privileged users
17283: # if different to course domain
17284: if ($$crsudom ne $args->{'ccdomain'}) {
17285: $cenv{'checkforpriv'} = $args->{'ccdomain'};
17286: }
1.444 albertel 17287: # add crosslistings
17288: if ($args->{'crsxlist'}) {
17289: $cenv{'internal.crosslistings'}='';
17290: if ($args->{'crsxlist'} =~ m/,/) {
17291: @xlists = split/,/,$args->{'crsxlist'};
17292: } else {
17293: $xlists[0] = $args->{'crsxlist'};
17294: }
17295: if (@xlists > 0) {
17296: foreach my $item (@xlists) {
17297: my ($xl,$gp) = split/:/,$item;
17298: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
17299: $cenv{'internal.crosslistings'} .= $item.',';
1.1412 raeburn 17300: if ($addcheck eq 'ok') {
17301: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17302: push(@oklcsecs,$gp);
17303: }
17304: } else {
1.1263 raeburn 17305: push(@badclasses,$xl);
1.444 albertel 17306: }
17307: }
17308: $cenv{'internal.crosslistings'} =~ s/,$//;
17309: }
17310: }
17311: if ($args->{'autoadds'}) {
17312: $cenv{'internal.autoadds'}=$args->{'autoadds'};
17313: }
17314: if ($args->{'autodrops'}) {
17315: $cenv{'internal.autodrops'}=$args->{'autodrops'};
17316: }
17317: # check for notification of enrollment changes
17318: my @notified = ();
17319: if ($args->{'notify_owner'}) {
17320: if ($args->{'ccuname'} ne '') {
17321: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
17322: }
17323: }
17324: if ($args->{'notify_dc'}) {
17325: if ($uname ne '') {
1.630 raeburn 17326: push(@notified,$uname.':'.$udom);
1.444 albertel 17327: }
17328: }
17329: if (@notified > 0) {
17330: my $notifylist;
17331: if (@notified > 1) {
17332: $notifylist = join(',',@notified);
17333: } else {
17334: $notifylist = $notified[0];
17335: }
17336: $cenv{'internal.notifylist'} = $notifylist;
17337: }
17338: if (@badclasses > 0) {
17339: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 17340: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
17341: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
17342: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 17343: );
1.1264 raeburn 17344: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
17345: &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 17346: if ($context eq 'auto') {
17347: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 17348: } else {
1.566 albertel 17349: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 17350: }
17351: foreach my $item (@badclasses) {
1.541 raeburn 17352: if ($context eq 'auto') {
1.1261 raeburn 17353: $outcome .= " - $item\n";
1.541 raeburn 17354: } else {
1.1261 raeburn 17355: $outcome .= "<li>$item</li>\n";
1.541 raeburn 17356: }
1.1261 raeburn 17357: }
17358: if ($context eq 'auto') {
17359: $outcome .= $linefeed;
17360: } else {
17361: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 17362: }
1.444 albertel 17363: }
17364: if ($args->{'no_end_date'}) {
17365: $args->{'endaccess'} = 0;
17366: }
1.1412 raeburn 17367: # If an official course with institutional sections is created by cloning
17368: # an existing course, section-specific hiding of course totals in student's
17369: # view of grades as copied from cloned course, will be checked for valid
17370: # sections.
17371: if (($can_clone && $cloneid) &&
17372: ($cenv{'internal.coursecode'} ne '') &&
17373: ($cenv{'grading'} eq 'standard') &&
17374: ($cenv{'hidetotals'} ne '') &&
17375: ($cenv{'hidetotals'} ne 'all')) {
17376: my @hidesecs;
17377: my $deletehidetotals;
17378: if (@oklcsecs) {
17379: foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
17380: if (grep(/^\Q$sec$/,@oklcsecs)) {
17381: push(@hidesecs,$sec);
17382: }
17383: }
17384: if (@hidesecs) {
17385: $cenv{'hidetotals'} = join(',',@hidesecs);
17386: } else {
17387: $deletehidetotals = 1;
17388: }
17389: } else {
17390: $deletehidetotals = 1;
17391: }
17392: if ($deletehidetotals) {
17393: delete($cenv{'hidetotals'});
17394: &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
17395: }
17396: }
1.444 albertel 17397: $cenv{'internal.autostart'}=$args->{'enrollstart'};
17398: $cenv{'internal.autoend'}=$args->{'enrollend'};
17399: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
17400: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
17401: if ($args->{'showphotos'}) {
17402: $cenv{'internal.showphotos'}=$args->{'showphotos'};
17403: }
17404: $cenv{'internal.authtype'} = $args->{'authtype'};
17405: $cenv{'internal.autharg'} = $args->{'autharg'};
17406: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
17407: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 17408: 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');
17409: if ($context eq 'auto') {
17410: $outcome .= $krb_msg;
17411: } else {
1.566 albertel 17412: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 17413: }
17414: $outcome .= $linefeed;
1.444 albertel 17415: }
17416: }
17417: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
17418: if ($args->{'setpolicy'}) {
17419: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17420: }
17421: if ($args->{'setcontent'}) {
17422: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17423: }
1.1251 raeburn 17424: if ($args->{'setcomment'}) {
17425: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17426: }
1.444 albertel 17427: }
17428: if ($args->{'reshome'}) {
17429: $cenv{'reshome'}=$args->{'reshome'}.'/';
17430: $cenv{'reshome'}=~s/\/+$/\//;
17431: }
17432: #
17433: # course has keyed access
17434: #
17435: if ($args->{'setkeys'}) {
17436: $cenv{'keyaccess'}='yes';
17437: }
17438: # if specified, key authority is not course, but user
17439: # only active if keyaccess is yes
17440: if ($args->{'keyauth'}) {
1.487 albertel 17441: my ($user,$domain) = split(':',$args->{'keyauth'});
17442: $user = &LONCAPA::clean_username($user);
17443: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 17444: if ($user ne '' && $domain ne '') {
1.487 albertel 17445: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 17446: }
17447: }
17448:
1.1166 raeburn 17449: #
1.1167 raeburn 17450: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 17451: #
17452: if ($args->{'uniquecode'}) {
17453: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
17454: if ($code) {
17455: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 17456: my %crsinfo =
17457: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
17458: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
17459: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
17460: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
17461: }
1.1166 raeburn 17462: if (ref($coderef)) {
17463: $$coderef = $code;
17464: }
17465: }
17466: }
17467:
1.444 albertel 17468: if ($args->{'disresdis'}) {
17469: $cenv{'pch.roles.denied'}='st';
17470: }
17471: if ($args->{'disablechat'}) {
17472: $cenv{'plc.roles.denied'}='st';
17473: }
17474:
17475: # Record we've not yet viewed the Course Initialization Helper for this
17476: # course
17477: $cenv{'course.helper.not.run'} = 1;
17478: #
17479: # Use new Randomseed
17480: #
17481: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
17482: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
17483: #
17484: # The encryption code and receipt prefix for this course
17485: #
17486: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
17487: $cenv{'internal.encpref'}=100+int(9*rand(99));
17488: #
17489: # By default, use standard grading
17490: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
17491:
1.541 raeburn 17492: $outcome .= $linefeed.&mt('Setting environment').': '.
17493: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17494: #
17495: # Open all assignments
17496: #
17497: if ($args->{'openall'}) {
1.1341 raeburn 17498: my $opendate = time;
17499: if ($args->{'openallfrom'} =~ /^\d+$/) {
17500: $opendate = $args->{'openallfrom'};
17501: }
1.444 albertel 17502: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 17503: my %storecontent = ($storeunder => $opendate,
1.444 albertel 17504: $storeunder.'.type' => 'date_start');
1.1341 raeburn 17505: $outcome .= &mt('All assignments open starting [_1]',
17506: &Apache::lonlocal::locallocaltime($opendate)).': '.
17507: &Apache::lonnet::cput
17508: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17509: }
17510: #
17511: # Set first page
17512: #
17513: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
17514: || ($cloneid)) {
17515: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 17516:
17517: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
17518: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
17519:
1.444 albertel 17520: $outcome .= ($fatal?$errtext:'read ok').' - ';
17521: my $title; my $url;
17522: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 17523: $title=&mt('Syllabus');
1.444 albertel 17524: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
17525: } else {
1.963 raeburn 17526: $title=&mt('Table of Contents');
1.444 albertel 17527: $url='/adm/navmaps';
17528: }
1.445 albertel 17529:
17530: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
17531: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
17532:
17533: if ($errtext) { $fatal=2; }
1.541 raeburn 17534: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 17535: }
1.566 albertel 17536:
1.1237 raeburn 17537: #
17538: # Set params for Placement Tests
17539: #
1.1239 raeburn 17540: if ($args->{'crstype'} eq 'Placement') {
17541: my %storecontent;
17542: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
17543: my %defaults = (
17544: buttonshide => { value => 'yes',
17545: type => 'string_yesno',},
17546: type => { value => 'randomizetry',
17547: type => 'string_questiontype',},
17548: maxtries => { value => 1,
17549: type => 'int_pos',},
17550: problemstatus => { value => 'no',
17551: type => 'string_problemstatus',},
17552: );
17553: foreach my $key (keys(%defaults)) {
17554: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
17555: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
17556: }
1.1237 raeburn 17557: &Apache::lonnet::cput
17558: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17559: }
17560:
1.1344 raeburn 17561: return (1,$outcome,\@clonemsg);
1.444 albertel 17562: }
17563:
1.1166 raeburn 17564: sub make_unique_code {
17565: my ($cdom,$cnum) = @_;
17566: # get lock on uniquecodes db
17567: my $lockhash = {
17568: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17569: ':'.$env{'user.domain'},
17570: };
17571: my $tries = 0;
17572: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17573: my ($code,$error);
17574:
17575: while (($gotlock ne 'ok') && ($tries<3)) {
17576: $tries ++;
17577: sleep 1;
17578: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17579: }
17580: if ($gotlock eq 'ok') {
17581: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17582: my $gotcode;
17583: my $attempts = 0;
17584: while ((!$gotcode) && ($attempts < 100)) {
17585: $code = &generate_code();
17586: if (!exists($currcodes{$code})) {
17587: $gotcode = 1;
17588: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17589: $error = 'nostore';
17590: }
17591: }
17592: $attempts ++;
17593: }
17594: my @del_lock = ($cnum."\0".'uniquecodes');
17595: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17596: } else {
17597: $error = 'nolock';
17598: }
17599: return ($code,$error);
17600: }
17601:
17602: sub generate_code {
17603: my $code;
17604: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17605: for (my $i=0; $i<6; $i++) {
17606: my $lettnum = int (rand 2);
17607: my $item = '';
17608: if ($lettnum) {
17609: $item = $letts[int( rand(18) )];
17610: } else {
17611: $item = 1+int( rand(8) );
17612: }
17613: $code .= $item;
17614: }
17615: return $code;
17616: }
17617:
1.444 albertel 17618: ############################################################
17619: ############################################################
17620:
1.1237 raeburn 17621: # Community, Course and Placement Test
1.378 raeburn 17622: sub course_type {
17623: my ($cid) = @_;
17624: if (!defined($cid)) {
17625: $cid = $env{'request.course.id'};
17626: }
1.404 albertel 17627: if (defined($env{'course.'.$cid.'.type'})) {
17628: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17629: } else {
17630: return 'Course';
1.377 raeburn 17631: }
17632: }
1.156 albertel 17633:
1.406 raeburn 17634: sub group_term {
17635: my $crstype = &course_type();
17636: my %names = (
17637: 'Course' => 'group',
1.865 raeburn 17638: 'Community' => 'group',
1.1237 raeburn 17639: 'Placement' => 'group',
1.406 raeburn 17640: );
17641: return $names{$crstype};
17642: }
17643:
1.902 raeburn 17644: sub course_types {
1.1310 raeburn 17645: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17646: my %typename = (
17647: official => 'Official course',
17648: unofficial => 'Unofficial course',
17649: community => 'Community',
1.1165 raeburn 17650: textbook => 'Textbook course',
1.1237 raeburn 17651: placement => 'Placement test',
1.1310 raeburn 17652: lti => 'LTI provider',
1.902 raeburn 17653: );
17654: return (\@types,\%typename);
17655: }
17656:
1.156 albertel 17657: sub icon {
17658: my ($file)=@_;
1.505 albertel 17659: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17660: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17661: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17662: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17663: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17664: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17665: $curfext.".gif") {
17666: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17667: $curfext.".gif";
17668: }
17669: }
1.249 albertel 17670: return &lonhttpdurl($iconname);
1.154 albertel 17671: }
1.84 albertel 17672:
1.575 albertel 17673: sub lonhttpdurl {
1.692 www 17674: #
17675: # Had been used for "small fry" static images on separate port 8080.
17676: # Modify here if lightweight http functionality desired again.
17677: # Currently eliminated due to increasing firewall issues.
17678: #
1.575 albertel 17679: my ($url)=@_;
1.692 www 17680: return $url;
1.215 albertel 17681: }
17682:
1.213 albertel 17683: sub connection_aborted {
17684: my ($r)=@_;
17685: $r->print(" ");$r->rflush();
17686: my $c = $r->connection;
17687: return $c->aborted();
17688: }
17689:
1.221 foxr 17690: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17691: # strings as 'strings'.
17692: sub escape_single {
1.221 foxr 17693: my ($input) = @_;
1.223 albertel 17694: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17695: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17696: return $input;
17697: }
1.223 albertel 17698:
1.222 foxr 17699: # Same as escape_single, but escape's "'s This
17700: # can be used for "strings"
17701: sub escape_double {
17702: my ($input) = @_;
17703: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17704: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17705: return $input;
17706: }
1.223 albertel 17707:
1.222 foxr 17708: # Escapes the last element of a full URL.
17709: sub escape_url {
17710: my ($url) = @_;
1.238 raeburn 17711: my @urlslices = split(/\//, $url,-1);
1.369 www 17712: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17713: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17714: }
1.462 albertel 17715:
1.820 raeburn 17716: sub compare_arrays {
17717: my ($arrayref1,$arrayref2) = @_;
17718: my (@difference,%count);
17719: @difference = ();
17720: %count = ();
17721: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17722: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17723: foreach my $element (keys(%count)) {
17724: if ($count{$element} == 1) {
17725: push(@difference,$element);
17726: }
17727: }
17728: }
17729: return @difference;
17730: }
17731:
1.1322 raeburn 17732: sub lon_status_items {
17733: my %defaults = (
17734: E => 100,
17735: W => 4,
17736: N => 1,
1.1324 raeburn 17737: U => 5,
1.1322 raeburn 17738: threshold => 200,
17739: sysmail => 2500,
17740: );
17741: my %names = (
17742: E => 'Errors',
17743: W => 'Warnings',
17744: N => 'Notices',
1.1324 raeburn 17745: U => 'Unsent',
1.1322 raeburn 17746: );
17747: return (\%defaults,\%names);
17748: }
17749:
1.817 bisitz 17750: # -------------------------------------------------------- Initialize user login
1.462 albertel 17751: sub init_user_environment {
1.463 albertel 17752: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17753: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17754:
17755: my $public=($username eq 'public' && $domain eq 'public');
17756:
1.1415 raeburn 17757: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
17758: $coauthorenv);
1.462 albertel 17759: my $now=time;
17760:
17761: if ($public) {
17762: my $max_public=100;
17763: my $oldest;
17764: my $oldest_time=0;
17765: for(my $next=1;$next<=$max_public;$next++) {
17766: if (-e $lonids."/publicuser_$next.id") {
17767: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17768: if ($mtime<$oldest_time || !$oldest_time) {
17769: $oldest_time=$mtime;
17770: $oldest=$next;
17771: }
17772: } else {
17773: $cookie="publicuser_$next";
17774: last;
17775: }
17776: }
17777: if (!$cookie) { $cookie="publicuser_$oldest"; }
17778: } else {
1.1275 raeburn 17779: # See if old ID present, if so, remove if this isn't a robot,
17780: # killing any existing non-robot sessions
1.463 albertel 17781: if (!$args->{'robot'}) {
17782: opendir(DIR,$lonids);
17783: while ($filename=readdir(DIR)) {
17784: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 17785: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17786: &GDBM_READER(),0640)) {
1.1295 raeburn 17787: my $linkedfile;
1.1320 raeburn 17788: if (exists($oldenv{'user.linkedenv'})) {
17789: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 17790: }
1.1320 raeburn 17791: untie(%oldenv);
17792: if (unlink("$lonids/$filename")) {
17793: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17794: if (-l "$lonids/$linkedfile.id") {
17795: unlink("$lonids/$linkedfile.id");
17796: }
1.1295 raeburn 17797: }
17798: }
17799: } else {
17800: unlink($lonids.'/'.$filename);
17801: }
1.463 albertel 17802: }
1.462 albertel 17803: }
1.463 albertel 17804: closedir(DIR);
1.1204 raeburn 17805: # If there is a undeleted lockfile for the user's paste buffer remove it.
17806: my $namespace = 'nohist_courseeditor';
17807: my $lockingkey = 'paste'."\0".'locked_num';
17808: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17809: $domain,$username);
17810: if (exists($lockhash{$lockingkey})) {
17811: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17812: unless ($delresult eq 'ok') {
17813: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17814: }
17815: }
1.462 albertel 17816: }
17817: # Give them a new cookie
1.463 albertel 17818: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17819: : $now.$$.int(rand(10000)));
1.463 albertel 17820: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17821:
17822: # Initialize roles
17823:
1.1414 raeburn 17824: ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
1.1062 raeburn 17825: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17826: }
17827: # ------------------------------------ Check browser type and MathML capability
17828:
1.1194 raeburn 17829: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17830: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17831:
17832: # ------------------------------------------------------------- Get environment
17833:
17834: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17835: my ($tmp) = keys(%userenv);
1.1275 raeburn 17836: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 17837: undef(%userenv);
17838: }
17839: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17840: $form->{'interface'}=$userenv{'interface'};
17841: }
17842: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17843:
17844: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17845: foreach my $option ('interface','localpath','localres') {
17846: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17847: }
17848: # --------------------------------------------------------- Write first profile
17849:
17850: {
1.1350 raeburn 17851: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 17852: my %initial_env =
17853: ("user.name" => $username,
17854: "user.domain" => $domain,
17855: "user.home" => $authhost,
17856: "browser.type" => $clientbrowser,
17857: "browser.version" => $clientversion,
17858: "browser.mathml" => $clientmathml,
17859: "browser.unicode" => $clientunicode,
17860: "browser.os" => $clientos,
1.1137 raeburn 17861: "browser.mobile" => $clientmobile,
1.1141 raeburn 17862: "browser.info" => $clientinfo,
1.1194 raeburn 17863: "browser.osversion" => $clientosversion,
1.462 albertel 17864: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17865: "request.course.fn" => '',
17866: "request.course.uri" => '',
17867: "request.course.sec" => '',
17868: "request.role" => 'cm',
17869: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 17870: "request.host" => $ip,);
1.462 albertel 17871:
17872: if ($form->{'localpath'}) {
17873: $initial_env{"browser.localpath"} = $form->{'localpath'};
17874: $initial_env{"browser.localres"} = $form->{'localres'};
17875: }
17876:
17877: if ($form->{'interface'}) {
17878: $form->{'interface'}=~s/\W//gs;
17879: $initial_env{"browser.interface"} = $form->{'interface'};
17880: $env{'browser.interface'}=$form->{'interface'};
17881: }
17882:
1.1157 raeburn 17883: if ($form->{'iptoken'}) {
17884: my $lonhost = $r->dir_config('lonHostID');
17885: $initial_env{"user.noloadbalance"} = $lonhost;
17886: $env{'user.noloadbalance'} = $lonhost;
17887: }
17888:
1.1268 raeburn 17889: if ($form->{'noloadbalance'}) {
17890: my @hosts = &Apache::lonnet::current_machine_ids();
17891: my $hosthere = $form->{'noloadbalance'};
17892: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17893: $initial_env{"user.noloadbalance"} = $hosthere;
17894: $env{'user.noloadbalance'} = $hosthere;
17895: }
17896: }
17897:
1.1016 raeburn 17898: unless ($domain eq 'public') {
1.1273 raeburn 17899: my %is_adv = ( is_adv => $env{'user.adv'} );
17900: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
17901:
1.1414 raeburn 17902: foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
17903: $userenv{'availabletools.'.$tool} =
1.1273 raeburn 17904: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17905: undef,\%userenv,\%domdef,\%is_adv);
17906: }
1.980 raeburn 17907:
1.1311 raeburn 17908: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 17909: $userenv{'canrequest.'.$crstype} =
17910: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17911: 'reload','requestcourses',
17912: \%userenv,\%domdef,\%is_adv);
17913: }
1.724 raeburn 17914:
1.1418 raeburn 17915: if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
17916: (exists($userroles->{"user.role.au./$domain/"}))) {
17917: if ($userenv{'authoreditors'}) {
17918: $userenv{'editors'} = $userenv{'authoreditors'};
17919: } elsif ($domdef{'editors'} ne '') {
17920: $userenv{'editors'} = $domdef{'editors'};
17921: } else {
17922: $userenv{'editors'} = 'edit,xml';
17923: }
17924: }
17925:
1.1273 raeburn 17926: $userenv{'canrequest.author'} =
17927: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17928: 'reload','requestauthor',
1.980 raeburn 17929: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 17930: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17931: $domain,$username);
17932: my $reqstatus = $reqauthor{'author_status'};
17933: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17934: if (ref($reqauthor{'author'}) eq 'HASH') {
17935: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17936: $reqauthor{'author'}{'timestamp'};
17937: }
1.1092 raeburn 17938: }
1.1287 raeburn 17939: my ($types,$typename) = &course_types();
17940: if (ref($types) eq 'ARRAY') {
17941: my @options = ('approval','validate','autolimit');
17942: my $optregex = join('|',@options);
17943: my (%willtrust,%trustchecked);
17944: foreach my $type (@{$types}) {
17945: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
17946: if ($dom_str ne '') {
17947: my $updatedstr = '';
17948: my @possdomains = split(',',$dom_str);
17949: foreach my $entry (@possdomains) {
17950: my ($extdom,$extopt) = split(':',$entry);
17951: unless ($trustchecked{$extdom}) {
17952: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
17953: $trustchecked{$extdom} = 1;
17954: }
17955: if ($willtrust{$extdom}) {
17956: $updatedstr .= $entry.',';
17957: }
17958: }
17959: $updatedstr =~ s/,$//;
17960: if ($updatedstr) {
17961: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
17962: } else {
17963: delete($userenv{'reqcrsotherdom.'.$type});
17964: }
17965: }
17966: }
17967: }
1.1092 raeburn 17968: }
1.462 albertel 17969: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17970:
1.462 albertel 17971: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17972: &GDBM_WRCREAT(),0640)) {
17973: &_add_to_env(\%disk_env,\%initial_env);
17974: &_add_to_env(\%disk_env,\%userenv,'environment.');
17975: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17976: if (ref($firstaccenv) eq 'HASH') {
17977: &_add_to_env(\%disk_env,$firstaccenv);
17978: }
17979: if (ref($timerintenv) eq 'HASH') {
17980: &_add_to_env(\%disk_env,$timerintenv);
17981: }
1.1414 raeburn 17982: if (ref($coauthorenv) eq 'HASH') {
17983: if (keys(%{$coauthorenv})) {
17984: &_add_to_env(\%disk_env,$coauthorenv);
17985: }
17986: }
1.463 albertel 17987: if (ref($args->{'extra_env'})) {
17988: &_add_to_env(\%disk_env,$args->{'extra_env'});
17989: }
1.462 albertel 17990: untie(%disk_env);
17991: } else {
1.705 tempelho 17992: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17993: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17994: return 'error: '.$!;
17995: }
17996: }
17997: $env{'request.role'}='cm';
17998: $env{'request.role.adv'}=$env{'user.adv'};
17999: $env{'browser.type'}=$clientbrowser;
18000:
18001: return $cookie;
18002:
18003: }
18004:
18005: sub _add_to_env {
18006: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 18007: if (ref($env_data) eq 'HASH') {
18008: while (my ($key,$value) = each(%$env_data)) {
18009: $idf->{$prefix.$key} = $value;
18010: $env{$prefix.$key} = $value;
18011: }
1.462 albertel 18012: }
18013: }
18014:
1.685 tempelho 18015: # --- Get the symbolic name of a problem and the url
18016: sub get_symb {
18017: my ($request,$silent) = @_;
1.726 raeburn 18018: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 18019: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
18020: if ($symb eq '') {
18021: if (!$silent) {
1.1071 raeburn 18022: if (ref($request)) {
18023: $request->print("Unable to handle ambiguous references:$url:.");
18024: }
1.685 tempelho 18025: return ();
18026: }
18027: }
18028: &Apache::lonenc::check_decrypt(\$symb);
18029: return ($symb);
18030: }
18031:
18032: # --------------------------------------------------------------Get annotation
18033:
18034: sub get_annotation {
18035: my ($symb,$enc) = @_;
18036:
18037: my $key = $symb;
18038: if (!$enc) {
18039: $key =
18040: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
18041: }
18042: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
18043: return $annotation{$key};
18044: }
18045:
18046: sub clean_symb {
1.731 raeburn 18047: my ($symb,$delete_enc) = @_;
1.685 tempelho 18048:
18049: &Apache::lonenc::check_decrypt(\$symb);
18050: my $enc = $env{'request.enc'};
1.731 raeburn 18051: if ($delete_enc) {
1.730 raeburn 18052: delete($env{'request.enc'});
18053: }
1.685 tempelho 18054:
18055: return ($symb,$enc);
18056: }
1.462 albertel 18057:
1.1181 raeburn 18058: ############################################################
18059: ############################################################
18060:
18061: =pod
18062:
18063: =head1 Routines for building display used to search for courses
18064:
18065:
18066: =over 4
18067:
18068: =item * &build_filters()
18069:
18070: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 18071: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
18072: and quotacheck.pl
18073:
1.1181 raeburn 18074:
18075: Inputs:
18076:
18077: filterlist - anonymous array of fields to include as potential filters
18078:
18079: crstype - course type
18080:
18081: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
18082: to pop-open a course selector (will contain "extra element").
18083:
18084: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
18085:
18086: filter - anonymous hash of criteria and their values
18087:
18088: action - form action
18089:
18090: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
18091:
1.1182 raeburn 18092: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 18093:
18094: cloneruname - username of owner of new course who wants to clone
18095:
18096: clonerudom - domain of owner of new course who wants to clone
18097:
18098: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
18099:
18100: codetitlesref - reference to array of titles of components in institutional codes (official courses)
18101:
18102: codedom - domain
18103:
18104: formname - value of form element named "form".
18105:
18106: fixeddom - domain, if fixed.
18107:
18108: prevphase - value to assign to form element named "phase" when going back to the previous screen
18109:
18110: cnameelement - name of form element in form on opener page which will receive title of selected course
18111:
18112: cnumelement - name of form element in form on opener page which will receive courseID of selected course
18113:
18114: cdomelement - name of form element in form on opener page which will receive domain of selected course
18115:
18116: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
18117:
18118: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
18119:
18120: clonewarning - warning message about missing information for intended course owner when DC creates a course
18121:
1.1182 raeburn 18122:
1.1181 raeburn 18123: Returns: $output - HTML for display of search criteria, and hidden form elements.
18124:
1.1182 raeburn 18125:
1.1181 raeburn 18126: Side Effects: None
18127:
18128: =cut
18129:
18130: # ---------------------------------------------- search for courses based on last activity etc.
18131:
18132: sub build_filters {
18133: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
18134: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
18135: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
18136: $cnameelement,$cnumelement,$cdomelement,$setroles,
18137: $clonetext,$clonewarning) = @_;
1.1182 raeburn 18138: my ($list,$jscript);
1.1181 raeburn 18139: my $onchange = 'javascript:updateFilters(this)';
18140: my ($domainselectform,$sincefilterform,$createdfilterform,
18141: $ownerdomselectform,$persondomselectform,$instcodeform,
18142: $typeselectform,$instcodetitle);
18143: if ($formname eq '') {
18144: $formname = $caller;
18145: }
18146: foreach my $item (@{$filterlist}) {
18147: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
18148: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
18149: if ($item eq 'domainfilter') {
18150: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
18151: } elsif ($item eq 'coursefilter') {
18152: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
18153: } elsif ($item eq 'ownerfilter') {
18154: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18155: } elsif ($item eq 'ownerdomfilter') {
18156: $filter->{'ownerdomfilter'} =
18157: &LONCAPA::clean_domain($filter->{$item});
18158: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
18159: 'ownerdomfilter',1);
18160: } elsif ($item eq 'personfilter') {
18161: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18162: } elsif ($item eq 'persondomfilter') {
18163: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
18164: 'persondomfilter',1);
18165: } else {
18166: $filter->{$item} =~ s/\W//g;
18167: }
18168: if (!$filter->{$item}) {
18169: $filter->{$item} = '';
18170: }
18171: }
18172: if ($item eq 'domainfilter') {
18173: my $allow_blank = 1;
18174: if ($formname eq 'portform') {
18175: $allow_blank=0;
18176: } elsif ($formname eq 'studentform') {
18177: $allow_blank=0;
18178: }
18179: if ($fixeddom) {
18180: $domainselectform = '<input type="hidden" name="domainfilter"'.
18181: ' value="'.$codedom.'" />'.
18182: &Apache::lonnet::domain($codedom,'description');
18183: } else {
18184: $domainselectform = &select_dom_form($filter->{$item},
18185: 'domainfilter',
18186: $allow_blank,'',$onchange);
18187: }
18188: } else {
18189: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
18190: }
18191: }
18192:
18193: # last course activity filter and selection
18194: $sincefilterform = &timebased_select_form('sincefilter',$filter);
18195:
18196: # course created filter and selection
18197: if (exists($filter->{'createdfilter'})) {
18198: $createdfilterform = &timebased_select_form('createdfilter',$filter);
18199: }
18200:
1.1239 raeburn 18201: my $prefix = $crstype;
18202: if ($crstype eq 'Placement') {
18203: $prefix = 'Placement Test'
18204: }
1.1181 raeburn 18205: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 18206: 'cac' => "$prefix Activity",
18207: 'ccr' => "$prefix Created",
18208: 'cde' => "$prefix Title",
18209: 'cdo' => "$prefix Domain",
1.1181 raeburn 18210: 'ins' => 'Institutional Code',
18211: 'inc' => 'Institutional Categorization',
1.1239 raeburn 18212: 'cow' => "$prefix Owner/Co-owner",
18213: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 18214: 'cog' => 'Type',
18215: );
18216:
18217: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18218: my $typeval = 'Course';
18219: if ($crstype eq 'Community') {
18220: $typeval = 'Community';
1.1239 raeburn 18221: } elsif ($crstype eq 'Placement') {
18222: $typeval = 'Placement';
1.1181 raeburn 18223: }
18224: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
18225: } else {
18226: $typeselectform = '<select name="type" size="1"';
18227: if ($onchange) {
18228: $typeselectform .= ' onchange="'.$onchange.'"';
18229: }
18230: $typeselectform .= '>'."\n";
1.1237 raeburn 18231: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 18232: my $shown;
18233: if ($posstype eq 'Placement') {
18234: $shown = &mt('Placement Test');
18235: } else {
18236: $shown = &mt($posstype);
18237: }
1.1181 raeburn 18238: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 18239: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 18240: }
18241: $typeselectform.="</select>";
18242: }
18243:
18244: my ($cloneableonlyform,$cloneabletitle);
18245: if (exists($filter->{'cloneableonly'})) {
18246: my $cloneableon = '';
18247: my $cloneableoff = ' checked="checked"';
18248: if ($filter->{'cloneableonly'}) {
18249: $cloneableon = $cloneableoff;
18250: $cloneableoff = '';
18251: }
18252: $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>';
18253: if ($formname eq 'ccrs') {
1.1187 bisitz 18254: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 18255: } else {
18256: $cloneabletitle = &mt('Cloneable by you');
18257: }
18258: }
18259: my $officialjs;
18260: if ($crstype eq 'Course') {
18261: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 18262: # if (($fixeddom) || ($formname eq 'requestcrs') ||
18263: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
18264: if ($codedom) {
1.1181 raeburn 18265: $officialjs = 1;
18266: ($instcodeform,$jscript,$$numtitlesref) =
18267: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
18268: $officialjs,$codetitlesref);
18269: if ($jscript) {
1.1182 raeburn 18270: $jscript = '<script type="text/javascript">'."\n".
18271: '// <![CDATA['."\n".
18272: $jscript."\n".
18273: '// ]]>'."\n".
18274: '</script>'."\n";
1.1181 raeburn 18275: }
18276: }
18277: if ($instcodeform eq '') {
18278: $instcodeform =
18279: '<input type="text" name="instcodefilter" size="10" value="'.
18280: $list->{'instcodefilter'}.'" />';
18281: $instcodetitle = $lt{'ins'};
18282: } else {
18283: $instcodetitle = $lt{'inc'};
18284: }
18285: if ($fixeddom) {
18286: $instcodetitle .= '<br />('.$codedom.')';
18287: }
18288: }
18289: }
18290: my $output = qq|
18291: <form method="post" name="filterpicker" action="$action">
18292: <input type="hidden" name="form" value="$formname" />
18293: |;
18294: if ($formname eq 'modifycourse') {
18295: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
18296: '<input type="hidden" name="prevphase" value="'.
18297: $prevphase.'" />'."\n";
1.1198 musolffc 18298: } elsif ($formname eq 'quotacheck') {
18299: $output .= qq|
18300: <input type="hidden" name="sortby" value="" />
18301: <input type="hidden" name="sortorder" value="" />
18302: |;
18303: } else {
1.1181 raeburn 18304: my $name_input;
18305: if ($cnameelement ne '') {
18306: $name_input = '<input type="hidden" name="cnameelement" value="'.
18307: $cnameelement.'" />';
18308: }
18309: $output .= qq|
1.1182 raeburn 18310: <input type="hidden" name="cnumelement" value="$cnumelement" />
18311: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 18312: $name_input
18313: $roleelement
18314: $multelement
18315: $typeelement
18316: |;
18317: if ($formname eq 'portform') {
18318: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
18319: }
18320: }
18321: if ($fixeddom) {
18322: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
18323: }
18324: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
18325: if ($sincefilterform) {
18326: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
18327: .$sincefilterform
18328: .&Apache::lonhtmlcommon::row_closure();
18329: }
18330: if ($createdfilterform) {
18331: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
18332: .$createdfilterform
18333: .&Apache::lonhtmlcommon::row_closure();
18334: }
18335: if ($domainselectform) {
18336: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
18337: .$domainselectform
18338: .&Apache::lonhtmlcommon::row_closure();
18339: }
18340: if ($typeselectform) {
18341: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18342: $output .= $typeselectform;
18343: } else {
18344: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
18345: .$typeselectform
18346: .&Apache::lonhtmlcommon::row_closure();
18347: }
18348: }
18349: if ($instcodeform) {
18350: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
18351: .$instcodeform
18352: .&Apache::lonhtmlcommon::row_closure();
18353: }
18354: if (exists($filter->{'ownerfilter'})) {
18355: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
18356: '<table><tr><td>'.&mt('Username').'<br />'.
18357: '<input type="text" name="ownerfilter" size="20" value="'.
18358: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18359: $ownerdomselectform.'</td></tr></table>'.
18360: &Apache::lonhtmlcommon::row_closure();
18361: }
18362: if (exists($filter->{'personfilter'})) {
18363: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
18364: '<table><tr><td>'.&mt('Username').'<br />'.
18365: '<input type="text" name="personfilter" size="20" value="'.
18366: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18367: $persondomselectform.'</td></tr></table>'.
18368: &Apache::lonhtmlcommon::row_closure();
18369: }
18370: if (exists($filter->{'coursefilter'})) {
18371: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
18372: .'<input type="text" name="coursefilter" size="25" value="'
18373: .$list->{'coursefilter'}.'" />'
18374: .&Apache::lonhtmlcommon::row_closure();
18375: }
18376: if ($cloneableonlyform) {
18377: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
18378: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
18379: }
18380: if (exists($filter->{'descriptfilter'})) {
18381: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
18382: .'<input type="text" name="descriptfilter" size="40" value="'
18383: .$list->{'descriptfilter'}.'" />'
18384: .&Apache::lonhtmlcommon::row_closure(1);
18385: }
18386: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
18387: '<input type="hidden" name="updater" value="" />'."\n".
18388: '<input type="submit" name="gosearch" value="'.
18389: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
18390: return $jscript.$clonewarning.$output;
18391: }
18392:
18393: =pod
18394:
18395: =item * &timebased_select_form()
18396:
1.1182 raeburn 18397: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 18398: filter e.g., Course Activity, Course Created, when searching for courses
18399: or communities
18400:
18401: Inputs:
18402:
18403: item - name of form element (sincefilter or createdfilter)
18404:
18405: filter - anonymous hash of criteria and their values
18406:
18407: Returns: HTML for a select box contained a blank, then six time selections,
18408: with value set in incoming form variables currently selected.
18409:
18410: Side Effects: None
18411:
18412: =cut
18413:
18414: sub timebased_select_form {
18415: my ($item,$filter) = @_;
18416: if (ref($filter) eq 'HASH') {
18417: $filter->{$item} =~ s/[^\d-]//g;
18418: if (!$filter->{$item}) { $filter->{$item}=-1; }
18419: return &select_form(
18420: $filter->{$item},
18421: $item,
18422: { '-1' => '',
18423: '86400' => &mt('today'),
18424: '604800' => &mt('last week'),
18425: '2592000' => &mt('last month'),
18426: '7776000' => &mt('last three months'),
18427: '15552000' => &mt('last six months'),
18428: '31104000' => &mt('last year'),
18429: 'select_form_order' =>
18430: ['-1','86400','604800','2592000','7776000',
18431: '15552000','31104000']});
18432: }
18433: }
18434:
18435: =pod
18436:
18437: =item * &js_changer()
18438:
18439: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 18440: when course type or domain is changed, and also to hide 'Searching ...' on
18441: page load completion for page showing search result.
1.1181 raeburn 18442:
18443: Inputs: None
18444:
1.1183 raeburn 18445: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 18446:
18447: Side Effects: None
18448:
18449: =cut
18450:
18451: sub js_changer {
18452: return <<ENDJS;
18453: <script type="text/javascript">
18454: // <![CDATA[
18455: function updateFilters(caller) {
18456: if (typeof(caller) != "undefined") {
18457: document.filterpicker.updater.value = caller.name;
18458: }
18459: document.filterpicker.submit();
18460: }
1.1183 raeburn 18461:
18462: function hideSearching() {
18463: if (document.getElementById('searching')) {
18464: document.getElementById('searching').style.display = 'none';
18465: }
18466: return;
18467: }
18468:
1.1181 raeburn 18469: // ]]>
18470: </script>
18471:
18472: ENDJS
18473: }
18474:
18475: =pod
18476:
1.1182 raeburn 18477: =item * &search_courses()
18478:
18479: Process selected filters form course search form and pass to lonnet::courseiddump
18480: to retrieve a hash for which keys are courseIDs which match the selected filters.
18481:
18482: Inputs:
18483:
18484: dom - domain being searched
18485:
18486: type - course type ('Course' or 'Community' or '.' if any).
18487:
18488: filter - anonymous hash of criteria and their values
18489:
18490: numtitles - for institutional codes - number of categories
18491:
18492: cloneruname - optional username of new course owner
18493:
18494: clonerudom - optional domain of new course owner
18495:
1.1221 raeburn 18496: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 18497: (used when DC is using course creation form)
18498:
18499: codetitles - reference to array of titles of components in institutional codes (official courses).
18500:
1.1221 raeburn 18501: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
18502: (and so can clone automatically)
18503:
18504: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
18505:
18506: reqinstcode - institutional code of new course, where search_courses is used to identify potential
18507: courses to clone
1.1182 raeburn 18508:
18509: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
18510:
18511:
18512: Side Effects: None
18513:
18514: =cut
18515:
18516:
18517: sub search_courses {
1.1221 raeburn 18518: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
18519: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 18520: my (%courses,%showcourses,$cloner);
18521: if (($filter->{'ownerfilter'} ne '') ||
18522: ($filter->{'ownerdomfilter'} ne '')) {
18523: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
18524: $filter->{'ownerdomfilter'};
18525: }
18526: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
18527: if (!$filter->{$item}) {
18528: $filter->{$item}='.';
18529: }
18530: }
18531: my $now = time;
18532: my $timefilter =
18533: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
18534: my ($createdbefore,$createdafter);
18535: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
18536: $createdbefore = $now;
18537: $createdafter = $now-$filter->{'createdfilter'};
18538: }
18539: my ($instcodefilter,$regexpok);
18540: if ($numtitles) {
18541: if ($env{'form.official'} eq 'on') {
18542: $instcodefilter =
18543: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18544: $regexpok = 1;
18545: } elsif ($env{'form.official'} eq 'off') {
18546: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18547: unless ($instcodefilter eq '') {
18548: $regexpok = -1;
18549: }
18550: }
18551: } else {
18552: $instcodefilter = $filter->{'instcodefilter'};
18553: }
18554: if ($instcodefilter eq '') { $instcodefilter = '.'; }
18555: if ($type eq '') { $type = '.'; }
18556:
18557: if (($clonerudom ne '') && ($cloneruname ne '')) {
18558: $cloner = $cloneruname.':'.$clonerudom;
18559: }
18560: %courses = &Apache::lonnet::courseiddump($dom,
18561: $filter->{'descriptfilter'},
18562: $timefilter,
18563: $instcodefilter,
18564: $filter->{'combownerfilter'},
18565: $filter->{'coursefilter'},
18566: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 18567: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 18568: $filter->{'cloneableonly'},
18569: $createdbefore,$createdafter,undef,
1.1221 raeburn 18570: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 18571: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18572: my $ccrole;
18573: if ($type eq 'Community') {
18574: $ccrole = 'co';
18575: } else {
18576: $ccrole = 'cc';
18577: }
18578: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18579: $filter->{'persondomfilter'},
18580: 'userroles',undef,
18581: [$ccrole,'in','ad','ep','ta','cr'],
18582: $dom);
18583: foreach my $role (keys(%rolehash)) {
18584: my ($cnum,$cdom,$courserole) = split(':',$role);
18585: my $cid = $cdom.'_'.$cnum;
18586: if (exists($courses{$cid})) {
18587: if (ref($courses{$cid}) eq 'HASH') {
18588: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18589: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18590: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18591: }
18592: } else {
18593: $courses{$cid}{roles} = [$courserole];
18594: }
18595: $showcourses{$cid} = $courses{$cid};
18596: }
18597: }
18598: }
18599: %courses = %showcourses;
18600: }
18601: return %courses;
18602: }
18603:
18604: =pod
18605:
1.1181 raeburn 18606: =back
18607:
1.1207 raeburn 18608: =head1 Routines for version requirements for current course.
18609:
18610: =over 4
18611:
18612: =item * &check_release_required()
18613:
18614: Compares required LON-CAPA version with version on server, and
18615: if required version is newer looks for a server with the required version.
18616:
18617: Looks first at servers in user's owen domain; if none suitable, looks at
18618: servers in course's domain are permitted to host sessions for user's domain.
18619:
18620: Inputs:
18621:
18622: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18623:
18624: $courseid - Course ID of current course
18625:
18626: $rolecode - User's current role in course (for switchserver query string).
18627:
18628: $required - LON-CAPA version needed by course (format: Major.Minor).
18629:
18630:
18631: Returns:
18632:
18633: $switchserver - query string tp append to /adm/switchserver call (if
18634: current server's LON-CAPA version is too old.
18635:
18636: $warning - Message is displayed if no suitable server could be found.
18637:
18638: =cut
18639:
18640: sub check_release_required {
18641: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18642: my ($switchserver,$warning);
18643: if ($required ne '') {
18644: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18645: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18646: if ($reqdmajor ne '' && $reqdminor ne '') {
18647: my $otherserver;
18648: if (($major eq '' && $minor eq '') ||
18649: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18650: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18651: my $switchlcrev =
18652: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18653: $userdomserver);
18654: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18655: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18656: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18657: my $cdom = $env{'course.'.$courseid.'.domain'};
18658: if ($cdom ne $env{'user.domain'}) {
18659: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18660: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18661: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18662: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18663: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18664: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18665: my $canhost =
18666: &Apache::lonnet::can_host_session($env{'user.domain'},
18667: $coursedomserver,
18668: $remoterev,
18669: $udomdefaults{'remotesessions'},
18670: $defdomdefaults{'hostedsessions'});
18671:
18672: if ($canhost) {
18673: $otherserver = $coursedomserver;
18674: } else {
18675: $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.");
18676: }
18677: } else {
18678: $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).");
18679: }
18680: } else {
18681: $otherserver = $userdomserver;
18682: }
18683: }
18684: if ($otherserver ne '') {
18685: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18686: }
18687: }
18688: }
18689: return ($switchserver,$warning);
18690: }
18691:
18692: =pod
18693:
18694: =item * &check_release_result()
18695:
18696: Inputs:
18697:
18698: $switchwarning - Warning message if no suitable server found to host session.
18699:
18700: $switchserver - query string to append to /adm/switchserver containing lonHostID
18701: and current role.
18702:
18703: Returns: HTML to display with information about requirement to switch server.
18704: Either displaying warning with link to Roles/Courses screen or
18705: display link to switchserver.
18706:
1.1181 raeburn 18707: =cut
18708:
1.1207 raeburn 18709: sub check_release_result {
18710: my ($switchwarning,$switchserver) = @_;
18711: my $output = &start_page('Selected course unavailable on this server').
18712: '<p class="LC_warning">';
18713: if ($switchwarning) {
18714: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18715: if (&show_course()) {
18716: $output .= &mt('Display courses');
18717: } else {
18718: $output .= &mt('Display roles');
18719: }
18720: $output .= '</a>';
18721: } elsif ($switchserver) {
18722: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18723: '<br />'.
18724: '<a href="/adm/switchserver?'.$switchserver.'">'.
18725: &mt('Switch Server').
18726: '</a>';
18727: }
18728: $output .= '</p>'.&end_page();
18729: return $output;
18730: }
18731:
18732: =pod
18733:
18734: =item * &needs_coursereinit()
18735:
18736: Determine if course contents stored for user's session needs to be
18737: refreshed, because content has changed since "Big Hash" last tied.
18738:
18739: Check for change is made if time last checked is more than 10 minutes ago
18740: (by default).
18741:
18742: Inputs:
18743:
18744: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18745:
18746: $interval (optional) - Time which may elapse (in s) between last check for content
18747: change in current course. (default: 600 s).
18748:
18749: Returns: an array; first element is:
18750:
18751: =over 4
18752:
18753: 'switch' - if content updates mean user's session
18754: needs to be switched to a server running a newer LON-CAPA version
18755:
18756: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18757: on current server hosting user's session
18758:
18759: '' - if no action required.
18760:
18761: =back
18762:
18763: If first item element is 'switch':
18764:
18765: second item is $switchwarning - Warning message if no suitable server found to host session.
18766:
18767: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18768: and current role.
18769:
18770: otherwise: no other elements returned.
18771:
18772: =back
18773:
18774: =cut
18775:
18776: sub needs_coursereinit {
18777: my ($loncaparev,$interval) = @_;
18778: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18779: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18780: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18781: my $now = time;
18782: if ($interval eq '') {
18783: $interval = 600;
18784: }
18785: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 18786: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 18787: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18788: if ($blocked) {
18789: return ();
18790: }
1.1391 raeburn 18791: my $update;
18792: my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18793: my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
18794: if ($lastmainchange > $env{'request.course.tied'}) {
18795: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18796: if ($needswitch) {
18797: return ('switch',$switchwarning,$switchserver);
18798: }
18799: $update = 'main';
18800: }
18801: if ($lastsuppchange > $env{'request.course.suppupdated'}) {
18802: if ($update) {
18803: $update = 'both';
18804: } else {
18805: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18806: if ($needswitch) {
18807: return ('switch',$switchwarning,$switchserver);
18808: } else {
18809: $update = 'supp';
1.1207 raeburn 18810: }
18811: }
1.1391 raeburn 18812: return ($update);
18813: }
18814: }
18815: return ();
18816: }
18817:
18818: sub switch_for_update {
18819: my ($loncaparev,$cdom,$cnum) = @_;
18820: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18821: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18822: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18823: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18824: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18825: $curr_reqd_hash{'internal.releaserequired'}});
18826: my ($switchserver,$switchwarning) =
18827: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18828: $curr_reqd_hash{'internal.releaserequired'});
18829: if ($switchwarning ne '' || $switchserver ne '') {
18830: return ('switch',$switchwarning,$switchserver);
18831: }
1.1207 raeburn 18832: }
18833: }
18834: return ();
18835: }
1.1181 raeburn 18836:
1.1083 raeburn 18837: sub update_content_constraints {
1.1395 raeburn 18838: my ($cdom,$cnum,$chome,$cid) = @_;
1.1083 raeburn 18839: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18840: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 18841: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 18842: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 18843: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 18844: if ($item eq 'resourcetag') {
18845: if ($name eq 'responsetype') {
18846: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18847: }
1.1307 raeburn 18848: } elsif ($item eq 'course') {
18849: if ($name eq 'courserestype') {
18850: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
18851: }
1.1083 raeburn 18852: }
18853: }
18854: my $navmap = Apache::lonnavmaps::navmap->new();
18855: if (defined($navmap)) {
1.1307 raeburn 18856: my (%allresponses,%allcrsrestypes);
18857: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
18858: if ($res->is_tool()) {
18859: if ($allcrsrestypes{'exttool'}) {
18860: $allcrsrestypes{'exttool'} ++;
18861: } else {
18862: $allcrsrestypes{'exttool'} = 1;
18863: }
18864: next;
18865: }
1.1083 raeburn 18866: my %responses = $res->responseTypes();
18867: foreach my $key (keys(%responses)) {
18868: next unless(exists($checkresponsetypes{$key}));
18869: $allresponses{$key} += $responses{$key};
18870: }
18871: }
18872: foreach my $key (keys(%allresponses)) {
18873: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18874: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18875: ($reqdmajor,$reqdminor) = ($major,$minor);
18876: }
18877: }
1.1307 raeburn 18878: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 18879: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 18880: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18881: ($reqdmajor,$reqdminor) = ($major,$minor);
18882: }
18883: }
1.1083 raeburn 18884: undef($navmap);
18885: }
1.1391 raeburn 18886: if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308 raeburn 18887: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
18888: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18889: ($reqdmajor,$reqdminor) = ($major,$minor);
18890: }
18891: }
1.1083 raeburn 18892: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18893: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18894: }
18895: return;
18896: }
18897:
1.1110 raeburn 18898: sub allmaps_incourse {
18899: my ($cdom,$cnum,$chome,$cid) = @_;
18900: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18901: $cid = $env{'request.course.id'};
18902: $cdom = $env{'course.'.$cid.'.domain'};
18903: $cnum = $env{'course.'.$cid.'.num'};
18904: $chome = $env{'course.'.$cid.'.home'};
18905: }
18906: my %allmaps = ();
18907: my $lastchange =
18908: &Apache::lonnet::get_coursechange($cdom,$cnum);
18909: if ($lastchange > $env{'request.course.tied'}) {
18910: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18911: unless ($ferr) {
1.1395 raeburn 18912: &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110 raeburn 18913: }
18914: }
18915: my $navmap = Apache::lonnavmaps::navmap->new();
18916: if (defined($navmap)) {
18917: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18918: $allmaps{$res->src()} = 1;
18919: }
18920: }
18921: return \%allmaps;
18922: }
18923:
1.1083 raeburn 18924: sub parse_supplemental_title {
18925: my ($title) = @_;
18926:
18927: my ($foldertitle,$renametitle);
18928: if ($title =~ /&&&/) {
18929: $title = &HTML::Entites::decode($title);
18930: }
18931: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18932: $renametitle=$4;
18933: my ($time,$uname,$udom) = ($1,$2,$3);
18934: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18935: my $name = &plainname($uname,$udom);
18936: $name = &HTML::Entities::encode($name,'"<>&\'');
18937: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1401 raeburn 18938: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
1.1402 raeburn 18939: if ($foldertitle ne '') {
1.1401 raeburn 18940: $title .= ': <br />'.$foldertitle;
18941: }
1.1083 raeburn 18942: }
18943: if (wantarray) {
18944: return ($title,$foldertitle,$renametitle);
18945: }
18946: return $title;
18947: }
18948:
1.1395 raeburn 18949: sub get_supplemental {
18950: my ($cnum,$cdom,$ignorecache,$possdel)=@_;
18951: my $hashid=$cnum.':'.$cdom;
18952: my ($supplemental,$cached,$set_httprefs);
18953: unless ($ignorecache) {
18954: ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
18955: }
18956: unless (defined($cached)) {
18957: my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
18958: unless ($chome eq 'no_host') {
18959: my @order = @LONCAPA::map::order;
18960: my @resources = @LONCAPA::map::resources;
18961: my @resparms = @LONCAPA::map::resparms;
18962: my @zombies = @LONCAPA::map::zombies;
18963: my ($errors,%ids,%hidden);
18964: $errors =
18965: &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
18966: $errors,$possdel,\%ids,\%hidden);
18967: @LONCAPA::map::order = @order;
18968: @LONCAPA::map::resources = @resources;
18969: @LONCAPA::map::resparms = @resparms;
18970: @LONCAPA::map::zombies = @zombies;
18971: $set_httprefs = 1;
18972: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18973: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18974: }
18975: $supplemental = {
18976: ids => \%ids,
18977: hidden => \%hidden,
18978: };
18979: &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
18980: }
18981: }
18982: return ($supplemental,$set_httprefs);
18983: }
18984:
1.1143 raeburn 18985: sub recurse_supplemental {
1.1391 raeburn 18986: my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
18987: if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
18988: my $mapnum;
18989: if ($suppmap eq 'supplemental.sequence') {
18990: $mapnum = 0;
18991: } else {
18992: ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
18993: }
1.1143 raeburn 18994: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18995: if ($fatal) {
18996: $errors ++;
18997: } else {
1.1389 raeburn 18998: my @order = @LONCAPA::map::order;
18999: if (@order > 0) {
19000: my @resources = @LONCAPA::map::resources;
1.1391 raeburn 19001: my @resparms = @LONCAPA::map::resparms;
1.1389 raeburn 19002: foreach my $idx (@order) {
19003: my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143 raeburn 19004: if (($src ne '') && ($status eq 'res')) {
1.1391 raeburn 19005: my $id = $mapnum.':'.$idx;
19006: push(@{$suppids->{$src}},$id);
19007: if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
19008: $hiddensupp->{$id} = 1;
19009: }
1.1146 raeburn 19010: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391 raeburn 19011: $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
19012: $hiddensupp,$hiddensupp->{$id});
1.1143 raeburn 19013: } else {
1.1391 raeburn 19014: my $allowed;
19015: if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
19016: $allowed = 1;
19017: } elsif ($possdel) {
19018: foreach my $item (@{$suppids->{$src}}) {
19019: next if ($item eq $id);
19020: unless ($hiddensupp->{$item}) {
19021: $allowed = 1;
19022: last;
19023: }
19024: }
19025: if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
19026: &Apache::lonnet::delenv('httpref.'.$src);
19027: }
19028: }
19029: if ($allowed && (!exists($env{'httpref.'.$src}))) {
19030: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308 raeburn 19031: }
1.1143 raeburn 19032: }
19033: }
19034: }
19035: }
19036: }
19037: }
1.1391 raeburn 19038: return $errors;
19039: }
19040:
19041: sub set_supp_httprefs {
19042: my ($cnum,$cdom,$supplemental,$possdel) = @_;
19043: if (ref($supplemental) eq 'HASH') {
19044: if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
19045: foreach my $src (keys(%{$supplemental->{'ids'}})) {
19046: next if ($src =~ /\.sequence$/);
19047: if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
19048: my $allowed;
19049: if ($env{'request.role.adv'}) {
19050: $allowed = 1;
19051: } else {
19052: foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
19053: unless ($supplemental->{'hidden'}->{$id}) {
19054: $allowed = 1;
19055: last;
19056: }
19057: }
19058: }
19059: if (exists($env{'httpref.'.$src})) {
19060: if ($possdel) {
19061: unless ($allowed) {
19062: &Apache::lonnet::delenv('httpref.'.$src);
19063: }
19064: }
19065: } elsif ($allowed) {
19066: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
19067: }
19068: }
19069: }
19070: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
19071: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
19072: }
19073: }
19074: }
19075: }
19076:
19077: sub get_supp_parameter {
19078: my ($resparm,$name)=@_;
19079: return if ($resparm eq '');
19080: my $value=undef;
19081: my $ptype=undef;
19082: foreach (split('&&&',$resparm)) {
19083: my ($thistype,$thisname,$thisvalue)=split('___',$_);
19084: if ($thisname eq $name) {
19085: $value=$thisvalue;
19086: $ptype=$thistype;
19087: }
19088: }
19089: return $value;
1.1143 raeburn 19090: }
19091:
1.1101 raeburn 19092: sub symb_to_docspath {
1.1267 raeburn 19093: my ($symb,$navmapref) = @_;
19094: return unless ($symb && ref($navmapref));
1.1101 raeburn 19095: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
19096: if ($resurl=~/\.(sequence|page)$/) {
19097: $mapurl=$resurl;
19098: } elsif ($resurl eq 'adm/navmaps') {
19099: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
19100: }
19101: my $mapresobj;
1.1267 raeburn 19102: unless (ref($$navmapref)) {
19103: $$navmapref = Apache::lonnavmaps::navmap->new();
19104: }
19105: if (ref($$navmapref)) {
19106: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 19107: }
19108: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
19109: my $type=$2;
19110: my $path;
19111: if (ref($mapresobj)) {
19112: my $pcslist = $mapresobj->map_hierarchy();
19113: if ($pcslist ne '') {
19114: foreach my $pc (split(/,/,$pcslist)) {
19115: next if ($pc <= 1);
1.1267 raeburn 19116: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 19117: if (ref($res)) {
19118: my $thisurl = $res->src();
19119: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
19120: my $thistitle = $res->title();
19121: $path .= '&'.
19122: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 19123: &escape($thistitle).
1.1101 raeburn 19124: ':'.$res->randompick().
19125: ':'.$res->randomout().
19126: ':'.$res->encrypted().
19127: ':'.$res->randomorder().
19128: ':'.$res->is_page();
19129: }
19130: }
19131: }
19132: $path =~ s/^\&//;
19133: my $maptitle = $mapresobj->title();
19134: if ($mapurl eq 'default') {
1.1129 raeburn 19135: $maptitle = 'Main Content';
1.1101 raeburn 19136: }
19137: $path .= (($path ne '')? '&' : '').
19138: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19139: &escape($maptitle).
1.1101 raeburn 19140: ':'.$mapresobj->randompick().
19141: ':'.$mapresobj->randomout().
19142: ':'.$mapresobj->encrypted().
19143: ':'.$mapresobj->randomorder().
19144: ':'.$mapresobj->is_page();
19145: } else {
19146: my $maptitle = &Apache::lonnet::gettitle($mapurl);
19147: my $ispage = (($type eq 'page')? 1 : '');
19148: if ($mapurl eq 'default') {
1.1129 raeburn 19149: $maptitle = 'Main Content';
1.1101 raeburn 19150: }
19151: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19152: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 19153: }
19154: unless ($mapurl eq 'default') {
19155: $path = 'default&'.
1.1146 raeburn 19156: &escape('Main Content').
1.1101 raeburn 19157: ':::::&'.$path;
19158: }
19159: return $path;
19160: }
19161:
1.1393 raeburn 19162: sub validate_folderpath {
19163: my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
19164: if ($env{'form.folderpath'} ne '') {
19165: my @items = split(/\&/,$env{'form.folderpath'});
1.1394 raeburn 19166: my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393 raeburn 19167: for (my $i=0; $i<@items; $i++) {
19168: my $odd = $i%2;
19169: if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
19170: $badpath = 1;
1.1394 raeburn 19171: } elsif ($odd && $supplementalflag) {
1.1393 raeburn 19172: my $idx = $i-1;
1.1394 raeburn 19173: if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
19174: my $esc_name = $1;
19175: if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
19176: $supppath .= '&'.$esc_name;
19177: $changed = 1;
19178: } else {
19179: $supppath .= '&'.$items[$i];
19180: }
19181: } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
19182: $changed = 1;
1.1393 raeburn 19183: my $is_hidden;
19184: unless ($got_supp) {
1.1395 raeburn 19185: my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393 raeburn 19186: if (ref($supplemental) eq 'HASH') {
19187: if (ref($supplemental->{'hidden'}) eq 'HASH') {
19188: %supphidden = %{$supplemental->{'hidden'}};
19189: }
19190: if (ref($supplemental->{'ids'}) eq 'HASH') {
19191: %suppids = %{$supplemental->{'ids'}};
19192: }
19193: }
19194: $got_supp = 1;
19195: }
19196: if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
19197: my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
19198: if ($supphidden{$mapid}) {
19199: $is_hidden = 1;
19200: }
19201: }
1.1394 raeburn 19202: $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
19203: } else {
19204: $supppath .= '&'.$items[$i];
1.1393 raeburn 19205: }
19206: } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
19207: $badpath = 1;
1.1394 raeburn 19208: } elsif ($supplementalflag) {
1.1393 raeburn 19209: $supppath .= '&'.$items[$i];
19210: }
19211: last if ($badpath);
19212: }
19213: if ($badpath) {
19214: delete($env{'form.folderpath'});
1.1394 raeburn 19215: } elsif ($changed && $supplementalflag) {
1.1393 raeburn 19216: $supppath =~ s/^\&//;
19217: $env{'form.folderpath'} = $supppath;
19218: }
19219: }
19220: return;
19221: }
19222:
1.1094 raeburn 19223: sub captcha_display {
1.1327 raeburn 19224: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19225: my ($output,$error);
1.1234 raeburn 19226: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 19227: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19228: if ($captcha eq 'original') {
1.1094 raeburn 19229: $output = &create_captcha();
19230: unless ($output) {
1.1172 raeburn 19231: $error = 'captcha';
1.1094 raeburn 19232: }
19233: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19234: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 19235: unless ($output) {
1.1172 raeburn 19236: $error = 'recaptcha';
1.1094 raeburn 19237: }
19238: }
1.1234 raeburn 19239: return ($output,$error,$captcha,$version);
1.1094 raeburn 19240: }
19241:
19242: sub captcha_response {
1.1327 raeburn 19243: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19244: my ($captcha_chk,$captcha_error);
1.1327 raeburn 19245: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19246: if ($captcha eq 'original') {
1.1094 raeburn 19247: ($captcha_chk,$captcha_error) = &check_captcha();
19248: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19249: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 19250: } else {
19251: $captcha_chk = 1;
19252: }
19253: return ($captcha_chk,$captcha_error);
19254: }
19255:
19256: sub get_captcha_config {
1.1327 raeburn 19257: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 19258: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 19259: my $hostname = &Apache::lonnet::hostname($lonhost);
19260: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
19261: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 19262: if ($context eq 'usercreation') {
19263: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
19264: if (ref($domconfig{$context}) eq 'HASH') {
19265: $hashtocheck = $domconfig{$context}{'cancreate'};
19266: if (ref($hashtocheck) eq 'HASH') {
19267: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
19268: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
19269: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
19270: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
19271: }
19272: if ($privkey && $pubkey) {
19273: $captcha = 'recaptcha';
1.1234 raeburn 19274: $version = $hashtocheck->{'recaptchaversion'};
19275: if ($version ne '2') {
19276: $version = 1;
19277: }
1.1095 raeburn 19278: } else {
19279: $captcha = 'original';
19280: }
19281: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
19282: $captcha = 'original';
19283: }
1.1094 raeburn 19284: }
1.1095 raeburn 19285: } else {
19286: $captcha = 'captcha';
19287: }
19288: } elsif ($context eq 'login') {
19289: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
19290: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
19291: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
19292: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 19293: if ($privkey && $pubkey) {
19294: $captcha = 'recaptcha';
1.1234 raeburn 19295: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
19296: if ($version ne '2') {
19297: $version = 1;
19298: }
1.1095 raeburn 19299: } else {
19300: $captcha = 'original';
1.1094 raeburn 19301: }
1.1095 raeburn 19302: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
19303: $captcha = 'original';
1.1094 raeburn 19304: }
1.1327 raeburn 19305: } elsif ($context eq 'passwords') {
19306: if ($dom_in_effect) {
19307: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
19308: if ($passwdconf{'captcha'} eq 'recaptcha') {
19309: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
19310: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
19311: $privkey = $passwdconf{'recaptchakeys'}{'private'};
19312: }
19313: if ($privkey && $pubkey) {
19314: $captcha = 'recaptcha';
19315: $version = $passwdconf{'recaptchaversion'};
19316: if ($version ne '2') {
19317: $version = 1;
19318: }
19319: } else {
19320: $captcha = 'original';
19321: }
19322: } elsif ($passwdconf{'captcha'} ne 'notused') {
19323: $captcha = 'original';
19324: }
19325: }
19326: }
1.1234 raeburn 19327: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 19328: }
19329:
19330: sub create_captcha {
19331: my %captcha_params = &captcha_settings();
19332: my ($output,$maxtries,$tries) = ('',10,0);
19333: while ($tries < $maxtries) {
19334: $tries ++;
19335: my $captcha = Authen::Captcha->new (
19336: output_folder => $captcha_params{'output_dir'},
19337: data_folder => $captcha_params{'db_dir'},
19338: );
19339: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
19340:
19341: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
19342: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 19343: '<span class="LC_nobreak">'.
1.1094 raeburn 19344: &mt('Type in the letters/numbers shown below').' '.
1.1390 raeburn 19345: '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367 raeburn 19346: '</span><br />'.
1.1176 raeburn 19347: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 19348: last;
19349: }
19350: }
1.1323 raeburn 19351: if ($output eq '') {
19352: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
19353: }
1.1094 raeburn 19354: return $output;
19355: }
19356:
19357: sub captcha_settings {
19358: my %captcha_params = (
19359: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
19360: www_output_dir => "/captchaspool",
19361: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
19362: numchars => '5',
19363: );
19364: return %captcha_params;
19365: }
19366:
19367: sub check_captcha {
19368: my ($captcha_chk,$captcha_error);
19369: my $code = $env{'form.code'};
19370: my $md5sum = $env{'form.crypt'};
19371: my %captcha_params = &captcha_settings();
19372: my $captcha = Authen::Captcha->new(
19373: output_folder => $captcha_params{'output_dir'},
19374: data_folder => $captcha_params{'db_dir'},
19375: );
1.1109 raeburn 19376: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 19377: my %captcha_hash = (
19378: 0 => 'Code not checked (file error)',
19379: -1 => 'Failed: code expired',
19380: -2 => 'Failed: invalid code (not in database)',
19381: -3 => 'Failed: invalid code (code does not match crypt)',
19382: );
19383: if ($captcha_chk != 1) {
19384: $captcha_error = $captcha_hash{$captcha_chk}
19385: }
19386: return ($captcha_chk,$captcha_error);
19387: }
19388:
19389: sub create_recaptcha {
1.1234 raeburn 19390: my ($pubkey,$version) = @_;
19391: if ($version >= 2) {
1.1367 raeburn 19392: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
19393: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 19394: } else {
19395: my $use_ssl;
19396: if ($ENV{'SERVER_PORT'} == 443) {
19397: $use_ssl = 1;
19398: }
19399: my $captcha = Captcha::reCAPTCHA->new;
19400: return $captcha->get_options_setter({theme => 'white'})."\n".
19401: $captcha->get_html($pubkey,undef,$use_ssl).
19402: &mt('If the text is hard to read, [_1] will replace them.',
19403: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
19404: '<br /><br />';
19405: }
1.1094 raeburn 19406: }
19407:
19408: sub check_recaptcha {
1.1234 raeburn 19409: my ($privkey,$version) = @_;
1.1094 raeburn 19410: my $captcha_chk;
1.1350 raeburn 19411: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 19412: if ($version >= 2) {
19413: my %info = (
19414: secret => $privkey,
19415: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 19416: remoteip => $ip,
1.1234 raeburn 19417: );
1.1280 raeburn 19418: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
19419: $request->content(join('&',map {
19420: my $name = escape($_);
19421: "$name=" . ( ref($info{$_}) eq 'ARRAY'
19422: ? join("&$name=", map {escape($_) } @{$info{$_}})
19423: : &escape($info{$_}) );
19424: } keys(%info)));
19425: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 19426: if ($response->is_success) {
19427: my $data = JSON::DWIW->from_json($response->decoded_content);
19428: if (ref($data) eq 'HASH') {
19429: if ($data->{'success'}) {
19430: $captcha_chk = 1;
19431: }
19432: }
19433: }
19434: } else {
19435: my $captcha = Captcha::reCAPTCHA->new;
19436: my $captcha_result =
19437: $captcha->check_answer(
19438: $privkey,
1.1350 raeburn 19439: $ip,
1.1234 raeburn 19440: $env{'form.recaptcha_challenge_field'},
19441: $env{'form.recaptcha_response_field'},
19442: );
19443: if ($captcha_result->{is_valid}) {
19444: $captcha_chk = 1;
19445: }
1.1094 raeburn 19446: }
19447: return $captcha_chk;
19448: }
19449:
1.1174 raeburn 19450: sub emailusername_info {
1.1244 raeburn 19451: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 19452: my %titles = &Apache::lonlocal::texthash (
19453: lastname => 'Last Name',
19454: firstname => 'First Name',
19455: institution => 'School/college/university',
19456: location => "School's city, state/province, country",
19457: web => "School's web address",
19458: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 19459: id => 'Student/Employee ID',
1.1174 raeburn 19460: );
19461: return (\@fields,\%titles);
19462: }
19463:
1.1161 raeburn 19464: sub cleanup_html {
19465: my ($incoming) = @_;
19466: my $outgoing;
19467: if ($incoming ne '') {
19468: $outgoing = $incoming;
19469: $outgoing =~ s/;/;/g;
19470: $outgoing =~ s/\#/#/g;
19471: $outgoing =~ s/\&/&/g;
19472: $outgoing =~ s/</</g;
19473: $outgoing =~ s/>/>/g;
19474: $outgoing =~ s/\(/(/g;
19475: $outgoing =~ s/\)/)/g;
19476: $outgoing =~ s/"/"/g;
19477: $outgoing =~ s/'/'/g;
19478: $outgoing =~ s/\$/$/g;
19479: $outgoing =~ s{/}{/}g;
19480: $outgoing =~ s/=/=/g;
19481: $outgoing =~ s/\\/\/g
19482: }
19483: return $outgoing;
19484: }
19485:
1.1190 musolffc 19486: # Checks for critical messages and returns a redirect url if one exists.
19487: # $interval indicates how often to check for messages.
1.1282 raeburn 19488: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 19489: sub critical_redirect {
1.1282 raeburn 19490: my ($interval,$context) = @_;
1.1356 raeburn 19491: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
19492: return ();
19493: }
1.1190 musolffc 19494: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 19495: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
19496: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
19497: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 19498: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 19499: if ($blocked) {
19500: my $checkrole = "cm./$cdom/$cnum";
19501: if ($env{'request.course.sec'} ne '') {
19502: $checkrole .= "/$env{'request.course.sec'}";
19503: }
19504: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
19505: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
19506: return;
19507: }
19508: }
19509: }
1.1190 musolffc 19510: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
19511: $env{'user.name'});
19512: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 19513: my $redirecturl;
1.1190 musolffc 19514: if ($what[0]) {
1.1356 raeburn 19515: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 19516: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 19517: my $url=&Apache::lonnet::absolute_url().$redirecturl;
19518: return (1, $url);
1.1190 musolffc 19519: }
1.1191 raeburn 19520: }
19521: }
19522: return ();
1.1190 musolffc 19523: }
19524:
1.1174 raeburn 19525: # Use:
19526: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
19527: #
19528: ##################################################
19529: # password associated functions #
19530: ##################################################
19531: sub des_keys {
19532: # Make a new key for DES encryption.
19533: # Each key has two parts which are returned separately.
19534: # Please note: Each key must be passed through the &hex function
19535: # before it is output to the web browser. The hex versions cannot
19536: # be used to decrypt.
19537: my @hexstr=('0','1','2','3','4','5','6','7',
19538: '8','9','a','b','c','d','e','f');
19539: my $lkey='';
19540: for (0..7) {
19541: $lkey.=$hexstr[rand(15)];
19542: }
19543: my $ukey='';
19544: for (0..7) {
19545: $ukey.=$hexstr[rand(15)];
19546: }
19547: return ($lkey,$ukey);
19548: }
19549:
19550: sub des_decrypt {
19551: my ($key,$cyphertext) = @_;
19552: my $keybin=pack("H16",$key);
19553: my $cypher;
19554: if ($Crypt::DES::VERSION>=2.03) {
19555: $cypher=new Crypt::DES $keybin;
19556: } else {
19557: $cypher=new DES $keybin;
19558: }
1.1233 raeburn 19559: my $plaintext='';
19560: my $cypherlength = length($cyphertext);
19561: my $numchunks = int($cypherlength/32);
19562: for (my $j=0; $j<$numchunks; $j++) {
19563: my $start = $j*32;
19564: my $cypherblock = substr($cyphertext,$start,32);
19565: my $chunk =
19566: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
19567: $chunk .=
19568: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
19569: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
19570: $plaintext .= $chunk;
19571: }
1.1174 raeburn 19572: return $plaintext;
19573: }
19574:
1.1344 raeburn 19575: sub get_requested_shorturls {
1.1309 raeburn 19576: my ($cdom,$cnum,$navmap) = @_;
19577: return unless (ref($navmap));
1.1344 raeburn 19578: my ($numnew,$errors);
1.1309 raeburn 19579: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
19580: if (@toshorten) {
19581: my (%maps,%resources,%titles);
19582: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
19583: 'shorturls',$cdom,$cnum);
19584: if (keys(%resources)) {
1.1344 raeburn 19585: my %tocreate;
1.1309 raeburn 19586: foreach my $item (sort {$a <=> $b} (@toshorten)) {
19587: my $symb = $resources{$item};
19588: if ($symb) {
19589: $tocreate{$cnum.'&'.$symb} = 1;
19590: }
19591: }
1.1344 raeburn 19592: if (keys(%tocreate)) {
19593: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
19594: \%tocreate);
19595: }
1.1309 raeburn 19596: }
1.1344 raeburn 19597: }
19598: return ($numnew,$errors);
19599: }
19600:
19601: sub make_short_symbs {
19602: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
19603: my ($numnew,@errors);
19604: if (ref($tocreateref) eq 'HASH') {
19605: my %tocreate = %{$tocreateref};
1.1309 raeburn 19606: if (keys(%tocreate)) {
19607: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
19608: my $su = Short::URL->new(no_vowels => 1);
19609: my $init = '';
19610: my (%newunique,%addcourse,%courseonly,%failed);
19611: # get lock on tiny db
19612: my $now = time;
1.1344 raeburn 19613: if ($lockuser eq '') {
19614: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
19615: }
1.1309 raeburn 19616: my $lockhash = {
1.1344 raeburn 19617: "lock\0$now" => $lockuser,
1.1309 raeburn 19618: };
19619: my $tries = 0;
19620: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19621: my ($code,$error);
19622: while (($gotlock ne 'ok') && ($tries<3)) {
19623: $tries ++;
19624: sleep 1;
1.1319 raeburn 19625: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 19626: }
19627: if ($gotlock eq 'ok') {
19628: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
19629: \%addcourse,\%courseonly,\%failed);
19630: if (keys(%failed)) {
19631: my $numfailed = scalar(keys(%failed));
19632: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
19633: }
19634: if (keys(%newunique)) {
19635: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
19636: if ($putres eq 'ok') {
19637: $numnew = scalar(keys(%newunique));
19638: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
19639: unless ($newputres eq 'ok') {
19640: push(@errors,&mt('error: could not store course look-up of short URLs'));
19641: }
19642: } else {
19643: push(@errors,&mt('error: could not store unique six character URLs'));
19644: }
19645: }
19646: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
19647: unless ($dellockres eq 'ok') {
19648: push(@errors,&mt('error: could not release lockfile'));
19649: }
19650: } else {
19651: push(@errors,&mt('error: could not obtain lockfile'));
19652: }
19653: if (keys(%courseonly)) {
19654: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
19655: if ($result ne 'ok') {
19656: push(@errors,&mt('error: could not update course look-up of short URLs'));
19657: }
19658: }
19659: }
19660: }
19661: return ($numnew,\@errors);
19662: }
19663:
19664: sub shorten_symbs {
19665: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
19666: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
19667: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
19668: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
19669: my (%possibles,%collisions);
19670: foreach my $key (keys(%{$tocreate})) {
19671: my $num = String::CRC32::crc32($key);
19672: my $tiny = $su->encode($num,$init);
19673: if ($tiny) {
19674: $possibles{$tiny} = $key;
19675: }
19676: }
19677: if (!$init) {
19678: $init = 1;
19679: } else {
19680: $init ++;
19681: }
19682: if (keys(%possibles)) {
19683: my @posstiny = keys(%possibles);
19684: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
19685: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
19686: if (keys(%currtiny)) {
19687: foreach my $key (keys(%currtiny)) {
19688: next if ($currtiny{$key} eq '');
19689: if ($currtiny{$key} eq $possibles{$key}) {
19690: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
19691: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19692: $courseonly->{$tsymb} = $key;
19693: }
19694: } else {
19695: $collisions{$possibles{$key}} = 1;
19696: }
19697: delete($possibles{$key});
19698: }
19699: }
19700: foreach my $key (keys(%possibles)) {
19701: $newunique->{$key} = $possibles{$key};
19702: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
19703: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19704: $addcourse->{$tsymb} = $key;
19705: }
19706: }
19707: }
19708: if (keys(%collisions)) {
19709: if ($init <5) {
19710: if (!$init) {
19711: $init = 1;
19712: } else {
19713: $init ++;
19714: }
19715: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
19716: $newunique,$addcourse,$courseonly,$failed);
19717: } else {
19718: foreach my $key (keys(%collisions)) {
19719: $failed->{$key} = 1;
19720: }
19721: }
19722: }
19723: return $init;
19724: }
19725:
1.1328 raeburn 19726: sub is_nonframeable {
1.1329 raeburn 19727: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
19728: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 19729: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 19730:
19731: $remprotocol = lc($remprotocol);
19732: $remhost = lc($remhost);
19733: my $remport = 80;
19734: if ($remprotocol eq 'https') {
19735: $remport = 443;
19736: }
1.1330 raeburn 19737: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 19738: if ($cached) {
19739: unless ($nocache) {
19740: if ($result) {
19741: return 1;
19742: } else {
19743: return 0;
19744: }
19745: }
19746: }
1.1328 raeburn 19747: my $uselink;
19748: my $request = new HTTP::Request('HEAD',$url);
19749: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
19750: if ($response->is_success()) {
19751: my $secpolicy = lc($response->header('content-security-policy'));
19752: my $xframeop = lc($response->header('x-frame-options'));
19753: $secpolicy =~ s/^\s+|\s+$//g;
19754: $xframeop =~ s/^\s+|\s+$//g;
19755: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 19756: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 19757: my ($origin,$protocol,$port);
19758: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19759: $port = $ENV{'SERVER_PORT'};
19760: } else {
19761: $port = 80;
19762: }
19763: if ($absolute eq '') {
19764: $protocol = 'http:';
19765: if ($port == 443) {
19766: $protocol = 'https:';
19767: }
19768: $origin = $protocol.'//'.lc($hostname);
19769: } else {
19770: $origin = lc($absolute);
19771: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19772: }
19773: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19774: my $framepolicy = $1;
19775: $framepolicy =~ s/^\s+|\s+$//g;
19776: my @policies = split(/\s+/,$framepolicy);
19777: if (@policies) {
19778: if (grep(/^\Q'none'\E$/,@policies)) {
19779: $uselink = 1;
19780: } else {
19781: $uselink = 1;
19782: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19783: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19784: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19785: undef($uselink);
19786: }
19787: if ($uselink) {
19788: if (grep(/^\Q'self'\E$/,@policies)) {
19789: if (($origin ne '') && ($remotehost eq $origin)) {
19790: undef($uselink);
19791: }
19792: }
19793: }
19794: if ($uselink) {
19795: my @possok;
19796: if ($ip ne '') {
19797: push(@possok,$ip);
19798: }
19799: my $hoststr = '';
19800: foreach my $part (reverse(split(/\./,$hostname))) {
19801: if ($hoststr eq '') {
19802: $hoststr = $part;
19803: } else {
19804: $hoststr = "$part.$hoststr";
19805: }
19806: if ($hoststr eq $hostname) {
19807: push(@possok,$hostname);
19808: } else {
19809: push(@possok,"*.$hoststr");
19810: }
19811: }
19812: if (@possok) {
19813: foreach my $poss (@possok) {
19814: last if (!$uselink);
19815: foreach my $policy (@policies) {
19816: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19817: undef($uselink);
19818: last;
19819: }
19820: }
19821: }
19822: }
19823: }
19824: }
19825: }
19826: } elsif ($xframeop ne '') {
19827: $uselink = 1;
19828: my @policies = split(/\s*,\s*/,$xframeop);
19829: if (@policies) {
19830: unless (grep(/^deny$/,@policies)) {
19831: if ($origin ne '') {
19832: if (grep(/^sameorigin$/,@policies)) {
19833: if ($remotehost eq $origin) {
19834: undef($uselink);
19835: }
19836: }
19837: if ($uselink) {
19838: foreach my $policy (@policies) {
19839: if ($policy =~ /^allow-from\s*(.+)$/) {
19840: my $allowfrom = $1;
19841: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19842: undef($uselink);
19843: last;
19844: }
19845: }
19846: }
19847: }
19848: }
19849: }
19850: }
19851: }
19852: }
19853: }
1.1329 raeburn 19854: if ($nocache) {
19855: if ($cached) {
19856: my $devalidate;
19857: if ($uselink && !$result) {
19858: $devalidate = 1;
19859: } elsif (!$uselink && $result) {
19860: $devalidate = 1;
19861: }
19862: if ($devalidate) {
19863: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19864: }
19865: }
19866: } else {
19867: if ($uselink) {
19868: $result = 1;
19869: } else {
19870: $result = 0;
19871: }
19872: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19873: }
1.1328 raeburn 19874: return $uselink;
19875: }
19876:
1.1359 raeburn 19877: sub page_menu {
19878: my ($menucolls,$menunum) = @_;
19879: my %menu;
19880: foreach my $item (split(/;/,$menucolls)) {
19881: my ($num,$value) = split(/\%/,$item);
19882: if ($num eq $menunum) {
19883: my @entries = split(/\&/,$value);
19884: foreach my $entry (@entries) {
19885: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 19886: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 19887: $menu{$name} = $fields;
19888: } else {
19889: my @shown;
19890: if ($fields =~ /,/) {
19891: @shown = split(/,/,$fields);
19892: } else {
19893: @shown = ($fields);
19894: }
19895: if (@shown) {
19896: foreach my $field (@shown) {
19897: next if ($field eq '');
19898: $menu{$field} = 1;
19899: }
19900: }
19901: }
19902: }
19903: }
19904: }
19905: return %menu;
19906: }
19907:
1.112 bowersj2 19908: 1;
19909: __END__;
1.41 ng 19910:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>