Annotation of loncom/interface/loncommon.pm, revision 1.1450
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1450 ! raeburn 4: # $Id: loncommon.pm,v 1.1449 2025/02/03 19:07:54 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,
1.1450 ! raeburn 1177: $suffix,
! 1178: $haslabel
1.36 matthew 1179: ) = @_;
1180: my $second = "document.$formname.$secondselectname";
1181: my $first = "document.$formname.$firstselectname";
1182: # output the javascript to do the changing
1183: my $result = '';
1.776 bisitz 1184: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1185: $result.="// <![CDATA[\n";
1.1245 raeburn 1186: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1187: $" = '","';
1188: my $debug = '';
1189: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1190: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1191: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1192: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1193: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1194: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1195: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1196: @s2values = @{$hashref->{$s1}->{'order'}};
1197: }
1.36 matthew 1198: $result.="\"@s2values\");\n";
1.1245 raeburn 1199: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1200: my @s2texts;
1201: foreach my $value (@s2values) {
1.1263 raeburn 1202: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1203: }
1204: $result.="\"@s2texts\");\n";
1205: }
1206: $"=' ';
1207: $result.= <<"END";
1208:
1.1245 raeburn 1209: function select1${suffix}_changed() {
1.36 matthew 1210: // Determine new choice
1.1245 raeburn 1211: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1212: // update select2
1.1245 raeburn 1213: var values = select2data${suffix}[newvalue].values;
1214: var texts = select2data${suffix}[newvalue].texts;
1215: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1216: var i;
1217: // out with the old
1.1245 raeburn 1218: $second.options.length = 0;
1219: // in with the new
1.36 matthew 1220: for (i=0;i<values.length; i++) {
1221: $second.options[i] = new Option(values[i]);
1.143 matthew 1222: $second.options[i].value = values[i];
1.36 matthew 1223: $second.options[i].text = texts[i];
1224: if (values[i] == select2def) {
1225: $second.options[i].selected = true;
1226: }
1227: }
1228: }
1.824 bisitz 1229: // ]]>
1.36 matthew 1230: </script>
1231: END
1232: # output the initial values for the selection lists
1.1245 raeburn 1233: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1234: my @order = sort(keys(%{$hashref}));
1235: if (ref($menuorder) eq 'ARRAY') {
1236: @order = @{$menuorder};
1237: }
1238: foreach my $value (@order) {
1.36 matthew 1239: $result.=" <option value=\"$value\" ";
1.253 albertel 1240: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1241: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1242: }
1243: $result .= "</select>\n";
1.1450 ! raeburn 1244: if ($haslabel) {
! 1245: $result .= '</label>';
! 1246: }
1.1400 raeburn 1247: my %select2;
1248: if (ref($hashref->{$firstdefault}) eq 'HASH') {
1249: if (ref($hashref->{$firstdefault}->{'select2'}) eq 'HASH') {
1250: %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1251: }
1252: }
1.36 matthew 1253: $result .= $middletext;
1.1450 ! raeburn 1254: if ($middletext ne '') {
! 1255: $result .= '<label>';
! 1256: }
1.1115 raeburn 1257: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1258: if ($onchangesecond) {
1259: $result .= ' onchange="'.$onchangesecond.'"';
1260: }
1261: $result .= ">\n";
1.36 matthew 1262: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1263:
1264: my @secondorder = sort(keys(%select2));
1265: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1266: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1267: }
1268: foreach my $value (@secondorder) {
1.36 matthew 1269: $result.=" <option value=\"$value\" ";
1.253 albertel 1270: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1271: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1272: }
1273: $result .= "</select>\n";
1.1450 ! raeburn 1274: if ($middletext ne '') {
! 1275: $result .= '</label>';
! 1276: }
1.36 matthew 1277: # return $debug;
1278: return $result;
1279: } # end of sub linked_select_forms {
1280:
1.45 matthew 1281: =pod
1.44 bowersj2 1282:
1.1381 raeburn 1283: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44 bowersj2 1284:
1.112 bowersj2 1285: Returns a string corresponding to an HTML link to the given help
1286: $topic, where $topic corresponds to the name of a .tex file in
1287: /home/httpd/html/adm/help/tex, with underscores replaced by
1288: spaces.
1289:
1290: $text will optionally be linked to the same topic, allowing you to
1291: link text in addition to the graphic. If you do not want to link
1292: text, but wish to specify one of the later parameters, pass an
1293: empty string.
1294:
1295: $stayOnPage is a value that will be interpreted as a boolean. If true,
1296: the link will not open a new window. If false, the link will open
1297: a new window using Javascript. (Default is false.)
1298:
1299: $width and $height are optional numerical parameters that will
1300: override the width and height of the popped up window, which may
1.973 raeburn 1301: be useful for certain help topics with big pictures included.
1302:
1303: $imgid is the id of the img tag used for the help icon. This may be
1304: used in a javascript call to switch the image src. See
1305: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1306:
1.1381 raeburn 1307: $links_target will optionally be set to a target (_top, _parent or _self).
1308:
1.44 bowersj2 1309: =cut
1310:
1311: sub help_open_topic {
1.1381 raeburn 1312: my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48 bowersj2 1313: $text = "" if (not defined $text);
1.44 bowersj2 1314: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1315: $width = 500 if (not defined $width);
1.44 bowersj2 1316: $height = 400 if (not defined $height);
1317: my $filename = $topic;
1318: $filename =~ s/ /_/g;
1319:
1.48 bowersj2 1320: my $template = "";
1321: my $link;
1.572 banghart 1322:
1.159 www 1323: $topic=~s/\W/\_/g;
1.44 bowersj2 1324:
1.572 banghart 1325: if (!$stayOnPage) {
1.1033 www 1326: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1327: } elsif ($stayOnPage eq 'popup') {
1328: $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 1329: } else {
1.48 bowersj2 1330: $link = "/adm/help/${filename}.hlp";
1331: }
1332:
1333: # Add the text
1.1314 raeburn 1334: my $target = ' target="_top"';
1.1381 raeburn 1335: if ($links_target) {
1336: $target = ' target="'.$links_target.'"';
1337: } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1338: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1339: $target = '';
1.1378 raeburn 1340: }
1.1380 raeburn 1341: if ($text ne "") {
1.763 bisitz 1342: $template.='<span class="LC_help_open_topic">'
1.1314 raeburn 1343: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1344: .$text.'</a>';
1.48 bowersj2 1345: }
1346:
1.763 bisitz 1347: # (Always) Add the graphic
1.179 matthew 1348: my $title = &mt('Online Help');
1.667 raeburn 1349: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1350: if ($imgid ne '') {
1351: $imgid = ' id="'.$imgid.'"';
1352: }
1.1314 raeburn 1353: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1354: .'<img src="'.$helpicon.'" border="0"'
1355: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1356: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1357: .' /></a>';
1358: if ($text ne "") {
1359: $template.='</span>';
1360: }
1.44 bowersj2 1361: return $template;
1362:
1.106 bowersj2 1363: }
1364:
1365: # This is a quicky function for Latex cheatsheet editing, since it
1366: # appears in at least four places
1367: sub helpLatexCheatsheet {
1.1037 www 1368: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1369: my $out;
1.106 bowersj2 1370: my $addOther = '';
1.732 raeburn 1371: if ($topic) {
1.1037 www 1372: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1373: }
1374: $out = '<span>' # Start cheatsheet
1375: .$addOther
1376: .'<span>'
1.1037 www 1377: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1378: .'</span> <span>'
1.1037 www 1379: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1380: .'</span>';
1.732 raeburn 1381: unless ($not_author) {
1.1186 kruse 1382: $out .= '<span>'
1383: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1384: .'</span> <span>'
1.1424 raeburn 1385: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.763 bisitz 1386: .'</span>';
1.732 raeburn 1387: }
1.763 bisitz 1388: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1389: return $out;
1.172 www 1390: }
1391:
1.430 albertel 1392: sub general_help {
1393: my $helptopic='Student_Intro';
1394: if ($env{'request.role'}=~/^(ca|au)/) {
1395: $helptopic='Authoring_Intro';
1.907 raeburn 1396: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1397: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1398: } elsif ($env{'request.role'}=~/^dc/) {
1399: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1400: }
1401: return $helptopic;
1402: }
1403:
1404: sub update_help_link {
1405: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1406: my $origurl = $ENV{'REQUEST_URI'};
1407: $origurl=~s|^/~|/priv/|;
1408: my $timestamp = time;
1409: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1410: $$datum = &escape($$datum);
1411: }
1412:
1413: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1414: my $output .= <<"ENDOUTPUT";
1415: <script type="text/javascript">
1.824 bisitz 1416: // <![CDATA[
1.430 albertel 1417: banner_link = '$banner_link';
1.824 bisitz 1418: // ]]>
1.430 albertel 1419: </script>
1420: ENDOUTPUT
1421: return $output;
1422: }
1423:
1424: # now just updates the help link and generates a blue icon
1.193 raeburn 1425: sub help_open_menu {
1.1381 raeburn 1426: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)
1.552 banghart 1427: = @_;
1.949 droeschl 1428: $stayOnPage = 1;
1.430 albertel 1429: my $output;
1430: if ($component_help) {
1431: if (!$text) {
1432: $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1381 raeburn 1433: $width,$height,'',$links_target);
1.430 albertel 1434: } else {
1435: my $help_text;
1436: $help_text=&unescape($topic);
1437: $output='<table><tr><td>'.
1438: &help_open_topic($component_help,$help_text,$stayOnPage,
1.1381 raeburn 1439: $width,$height,'',$links_target).'</td></tr></table>';
1.430 albertel 1440: }
1441: }
1442: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1443: return $output.$banner_link;
1444: }
1445:
1446: sub top_nav_help {
1.1369 raeburn 1447: my ($text,$linkattr) = @_;
1.436 albertel 1448: $text = &mt($text);
1.949 droeschl 1449: my $stay_on_page = 1;
1450:
1.1168 raeburn 1451: my ($link,$banner_link);
1452: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1453: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1454: : "javascript:helpMenu('open')";
1455: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1456: }
1.201 raeburn 1457: my $title = &mt('Get help');
1.1168 raeburn 1458: if ($link) {
1459: return <<"END";
1.436 albertel 1460: $banner_link
1.1369 raeburn 1461: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1462: END
1.1168 raeburn 1463: } else {
1464: return ' '.$text.' ';
1465: }
1.436 albertel 1466: }
1467:
1468: sub help_menu_js {
1.1154 raeburn 1469: my ($httphost) = @_;
1.949 droeschl 1470: my $stayOnPage = 1;
1.436 albertel 1471: my $width = 620;
1472: my $height = 600;
1.430 albertel 1473: my $helptopic=&general_help();
1.1154 raeburn 1474: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1475: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1476: my $start_page =
1477: &Apache::loncommon::start_page('Help Menu', undef,
1478: {'frameset' => 1,
1479: 'js_ready' => 1,
1.1154 raeburn 1480: 'use_absolute' => $httphost,
1.331 albertel 1481: 'add_entries' => {
1.1168 raeburn 1482: 'border' => '0',
1.579 raeburn 1483: 'rows' => "110,*",},});
1.331 albertel 1484: my $end_page =
1485: &Apache::loncommon::end_page({'frameset' => 1,
1486: 'js_ready' => 1,});
1487:
1.436 albertel 1488: my $template .= <<"ENDTEMPLATE";
1489: <script type="text/javascript">
1.877 bisitz 1490: // <![CDATA[
1.253 albertel 1491: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1492: var banner_link = '';
1.243 raeburn 1493: function helpMenu(target) {
1494: var caller = this;
1495: if (target == 'open') {
1496: var newWindow = null;
1497: try {
1.262 albertel 1498: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1499: }
1500: catch(error) {
1501: writeHelp(caller);
1502: return;
1503: }
1504: if (newWindow) {
1505: caller = newWindow;
1506: }
1.193 raeburn 1507: }
1.243 raeburn 1508: writeHelp(caller);
1509: return;
1510: }
1511: function writeHelp(caller) {
1.1168 raeburn 1512: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1513: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1514: caller.document.close();
1515: caller.focus();
1.193 raeburn 1516: }
1.877 bisitz 1517: // END LON-CAPA Internal -->
1.253 albertel 1518: // ]]>
1.436 albertel 1519: </script>
1.193 raeburn 1520: ENDTEMPLATE
1521: return $template;
1522: }
1523:
1.172 www 1524: sub help_open_bug {
1525: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1526: unless ($env{'user.adv'}) { return ''; }
1.172 www 1527: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1528: $text = "" if (not defined $text);
1529: $stayOnPage=1;
1.184 albertel 1530: $width = 600 if (not defined $width);
1531: $height = 600 if (not defined $height);
1.172 www 1532:
1533: $topic=~s/\W+/\+/g;
1534: my $link='';
1535: my $template='';
1.379 albertel 1536: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1537: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1538: if (!$stayOnPage)
1539: {
1540: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1541: }
1542: else
1543: {
1544: $link = $url;
1545: }
1.1314 raeburn 1546:
1.1382 raeburn 1547: my $target = '_top';
1548: if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1549: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1550: $target = '_blank';
1.1378 raeburn 1551: }
1.1382 raeburn 1552:
1.172 www 1553: # Add the text
1554: if ($text ne "")
1555: {
1556: $template .=
1557: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1382 raeburn 1558: "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1559: }
1560:
1561: # Add the graphic
1.179 matthew 1562: my $title = &mt('Report a Bug');
1.215 albertel 1563: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1564: $template .= <<"ENDTEMPLATE";
1.1382 raeburn 1565: <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1566: ENDTEMPLATE
1567: if ($text ne '') { $template.='</td></tr></table>' };
1568: return $template;
1569:
1570: }
1571:
1572: sub help_open_faq {
1573: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1574: unless ($env{'user.adv'}) { return ''; }
1.172 www 1575: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1576: $text = "" if (not defined $text);
1577: $stayOnPage=1;
1578: $width = 350 if (not defined $width);
1579: $height = 400 if (not defined $height);
1580:
1581: $topic=~s/\W+/\+/g;
1582: my $link='';
1583: my $template='';
1584: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1585: if (!$stayOnPage)
1586: {
1587: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1588: }
1589: else
1590: {
1591: $link = $url;
1592: }
1593:
1594: # Add the text
1595: if ($text ne "")
1596: {
1597: $template .=
1.173 www 1598: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1599: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1600: }
1601:
1602: # Add the graphic
1.179 matthew 1603: my $title = &mt('View the FAQ');
1.215 albertel 1604: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1605: $template .= <<"ENDTEMPLATE";
1.436 albertel 1606: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1607: ENDTEMPLATE
1608: if ($text ne '') { $template.='</td></tr></table>' };
1609: return $template;
1610:
1.44 bowersj2 1611: }
1.37 matthew 1612:
1.180 matthew 1613: ###############################################################
1614: ###############################################################
1615:
1.45 matthew 1616: =pod
1617:
1.648 raeburn 1618: =item * &change_content_javascript():
1.256 matthew 1619:
1620: This and the next function allow you to create small sections of an
1621: otherwise static HTML page that you can update on the fly with
1622: Javascript, even in Netscape 4.
1623:
1624: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1625: must be written to the HTML page once. It will prove the Javascript
1626: function "change(name, content)". Calling the change function with the
1627: name of the section
1628: you want to update, matching the name passed to C<changable_area>, and
1629: the new content you want to put in there, will put the content into
1630: that area.
1631:
1632: B<Note>: Netscape 4 only reserves enough space for the changable area
1633: to contain room for the original contents. You need to "make space"
1634: for whatever changes you wish to make, and be B<sure> to check your
1635: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1636: it's adequate for updating a one-line status display, but little more.
1637: This script will set the space to 100% width, so you only need to
1638: worry about height in Netscape 4.
1639:
1640: Modern browsers are much less limiting, and if you can commit to the
1641: user not using Netscape 4, this feature may be used freely with
1642: pretty much any HTML.
1643:
1644: =cut
1645:
1646: sub change_content_javascript {
1647: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1648: if ($env{'browser.type'} eq 'netscape' &&
1649: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1650: return (<<NETSCAPE4);
1651: function change(name, content) {
1652: doc = document.layers[name+"___escape"].layers[0].document;
1653: doc.open();
1654: doc.write(content);
1655: doc.close();
1656: }
1657: NETSCAPE4
1658: } else {
1659: # Otherwise, we need to use semi-standards-compliant code
1660: # (technically, "innerHTML" isn't standard but the equivalent
1661: # is really scary, and every useful browser supports it
1662: return (<<DOMBASED);
1663: function change(name, content) {
1664: element = document.getElementById(name);
1665: element.innerHTML = content;
1666: }
1667: DOMBASED
1668: }
1669: }
1670:
1671: =pod
1672:
1.648 raeburn 1673: =item * &changable_area($name,$origContent):
1.256 matthew 1674:
1675: This provides a "changable area" that can be modified on the fly via
1676: the Javascript code provided in C<change_content_javascript>. $name is
1677: the name you will use to reference the area later; do not repeat the
1678: same name on a given HTML page more then once. $origContent is what
1679: the area will originally contain, which can be left blank.
1680:
1681: =cut
1682:
1683: sub changable_area {
1684: my ($name, $origContent) = @_;
1685:
1.258 albertel 1686: if ($env{'browser.type'} eq 'netscape' &&
1687: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1688: # If this is netscape 4, we need to use the Layer tag
1689: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1690: } else {
1691: return "<span id='$name'>$origContent</span>";
1692: }
1693: }
1694:
1695: =pod
1696:
1.648 raeburn 1697: =item * &viewport_geometry_js
1.590 raeburn 1698:
1699: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1700:
1701: =cut
1702:
1703:
1704: sub viewport_geometry_js {
1705: return <<"GEOMETRY";
1706: var Geometry = {};
1707: function init_geometry() {
1708: if (Geometry.init) { return };
1709: Geometry.init=1;
1710: if (window.innerHeight) {
1711: Geometry.getViewportHeight = function() { return window.innerHeight; };
1712: Geometry.getViewportWidth = function() { return window.innerWidth; };
1713: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1714: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1715: }
1716: else if (document.documentElement && document.documentElement.clientHeight) {
1717: Geometry.getViewportHeight =
1718: function() { return document.documentElement.clientHeight; };
1719: Geometry.getViewportWidth =
1720: function() { return document.documentElement.clientWidth; };
1721:
1722: Geometry.getHorizontalScroll =
1723: function() { return document.documentElement.scrollLeft; };
1724: Geometry.getVerticalScroll =
1725: function() { return document.documentElement.scrollTop; };
1726: }
1727: else if (document.body.clientHeight) {
1728: Geometry.getViewportHeight =
1729: function() { return document.body.clientHeight; };
1730: Geometry.getViewportWidth =
1731: function() { return document.body.clientWidth; };
1732: Geometry.getHorizontalScroll =
1733: function() { return document.body.scrollLeft; };
1734: Geometry.getVerticalScroll =
1735: function() { return document.body.scrollTop; };
1736: }
1737: }
1738:
1739: GEOMETRY
1740: }
1741:
1742: =pod
1743:
1.648 raeburn 1744: =item * &viewport_size_js()
1.590 raeburn 1745:
1746: 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.
1747:
1748: =cut
1749:
1750: sub viewport_size_js {
1751: my $geometry = &viewport_geometry_js();
1752: return <<"DIMS";
1753:
1754: $geometry
1755:
1756: function getViewportDims(width,height) {
1757: init_geometry();
1758: width.value = Geometry.getViewportWidth();
1759: height.value = Geometry.getViewportHeight();
1760: return;
1761: }
1762:
1763: DIMS
1764: }
1765:
1766: =pod
1767:
1.648 raeburn 1768: =item * &resize_textarea_js()
1.565 albertel 1769:
1770: emits the needed javascript to resize a textarea to be as big as possible
1771:
1772: creates a function resize_textrea that takes two IDs first should be
1773: the id of the element to resize, second should be the id of a div that
1774: surrounds everything that comes after the textarea, this routine needs
1775: to be attached to the <body> for the onload and onresize events.
1776:
1777: =cut
1778:
1779: sub resize_textarea_js {
1.590 raeburn 1780: my $geometry = &viewport_geometry_js();
1.565 albertel 1781: return <<"RESIZE";
1782: <script type="text/javascript">
1.824 bisitz 1783: // <![CDATA[
1.590 raeburn 1784: $geometry
1.565 albertel 1785:
1.588 albertel 1786: function getX(element) {
1787: var x = 0;
1788: while (element) {
1789: x += element.offsetLeft;
1790: element = element.offsetParent;
1791: }
1792: return x;
1793: }
1794: function getY(element) {
1795: var y = 0;
1796: while (element) {
1797: y += element.offsetTop;
1798: element = element.offsetParent;
1799: }
1800: return y;
1801: }
1802:
1803:
1.565 albertel 1804: function resize_textarea(textarea_id,bottom_id) {
1805: init_geometry();
1806: var textarea = document.getElementById(textarea_id);
1807: //alert(textarea);
1808:
1.588 albertel 1809: var textarea_top = getY(textarea);
1.565 albertel 1810: var textarea_height = textarea.offsetHeight;
1811: var bottom = document.getElementById(bottom_id);
1.588 albertel 1812: var bottom_top = getY(bottom);
1.565 albertel 1813: var bottom_height = bottom.offsetHeight;
1814: var window_height = Geometry.getViewportHeight();
1.588 albertel 1815: var fudge = 23;
1.565 albertel 1816: var new_height = window_height-fudge-textarea_top-bottom_height;
1817: if (new_height < 300) {
1818: new_height = 300;
1819: }
1820: textarea.style.height=new_height+'px';
1821: }
1.824 bisitz 1822: // ]]>
1.565 albertel 1823: </script>
1824: RESIZE
1825:
1826: }
1827:
1.1205 golterma 1828: sub colorfuleditor_js {
1.1248 raeburn 1829: my $browse_or_search;
1830: my $respath;
1831: my ($cnum,$cdom) = &crsauthor_url();
1832: if ($cnum) {
1833: $respath = "/res/$cdom/$cnum/";
1834: my %js_lt = &Apache::lonlocal::texthash(
1835: sunm => 'Sub-directory name',
1836: save => 'Save page to make this permanent',
1837: );
1838: &js_escape(\%js_lt);
1.1400 raeburn 1839: my $showfile_js = &show_crsfiles_js();
1.1248 raeburn 1840: $browse_or_search = <<"END";
1841:
1.1400 raeburn 1842: $showfile_js
1843:
1.1248 raeburn 1844: function toggleChooser(form,element,titleid,only,search) {
1845: var disp = 'none';
1846: if (document.getElementById('chooser_'+element)) {
1847: var curr = document.getElementById('chooser_'+element).style.display;
1848: if (curr == 'none') {
1849: disp='inline';
1850: if (form.elements['chooser_'+element].length) {
1851: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1852: form.elements['chooser_'+element][i].checked = false;
1853: }
1854: }
1855: toggleResImport(form,element);
1856: }
1857: document.getElementById('chooser_'+element).style.display = disp;
1.1400 raeburn 1858: var dirsel = '';
1859: var filesel = '';
1860: if (document.getElementById('chooser_'+element+'_crsres')) {
1861: var currcrsres = document.getElementById('chooser_'+element+'_crsres').style.display;
1862: if (currcrsres == 'none') {
1863: dirsel = 'coursepath_'+element;
1864: var filesel = 'coursefile_'+element;
1865: var include;
1866: if (document.getElementById('crsres_include_'+element)) {
1867: include = document.getElementById('crsres_include_'+element).value;
1868: }
1.1402 raeburn 1869: populateCrsSelects(form,dirsel,filesel,1,include,1,0,1,1,0);
1.1400 raeburn 1870: }
1871: }
1872: if (document.getElementById('chooser_'+element+'_upload')) {
1873: var currcrsupload = document.getElementById('chooser_'+element+'_upload').style.display;
1874: if (currcrsupload == 'none') {
1875: dirsel = 'crsauthorpath_'+element;
1876: filesel = '';
1.1402 raeburn 1877: populateCrsSelects(form,dirsel,filesel,0,'',1,0,1,0,1);
1.1400 raeburn 1878: }
1879: }
1.1248 raeburn 1880: }
1881: }
1882:
1.1400 raeburn 1883: function toggleCrsFile(form,element) {
1.1248 raeburn 1884: if (document.getElementById('chooser_'+element+'_crsres')) {
1885: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1886: if (curr == 'none') {
1.1400 raeburn 1887: if (document.getElementById('coursepath_'+element)) {
1888: var numdirs;
1889: if (document.getElementById('coursepath_'+element).length) {
1890: numdirs = document.getElementById('coursepath_'+element).length;
1891: }
1.1402 raeburn 1892: if ((document.getElementById('hascrsres_'+element)) &&
1893: (document.getElementById('nocrsres_'+element))) {
1894: if (numdirs) {
1895: document.getElementById('hascrsres_'+element).style.display='inline-block';
1896: document.getElementById('nocrsres_'+element).style.display='none';
1897: } else {
1898: document.getElementById('hascrsres_'+element).style.display='none';
1899: document.getElementById('nocrsres_'+element).style.display='inline-block';
1900: }
1901: }
1.1248 raeburn 1902: form.elements['coursepath_'+element].selectedIndex = 0;
1903: if (numdirs > 1) {
1.1400 raeburn 1904: var selelem = form.elements['coursefile_'+element];
1905: var i, len = selelem.options.length -1;
1906: if (len >=0) {
1907: for (i = len; i >= 0; i--) {
1908: selelem.remove(i);
1909: }
1910: selelem.options[0] = new Option('','');
1911: }
1.1248 raeburn 1912: }
1913: }
1.1400 raeburn 1914: }
1.1248 raeburn 1915: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1916: }
1917: if (document.getElementById('chooser_'+element+'_upload')) {
1918: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1919: if (document.getElementById('uploadcrsres_'+element)) {
1920: document.getElementById('uploadcrsres_'+element).value = '';
1921: }
1922: }
1923: return;
1924: }
1925:
1.1400 raeburn 1926: function toggleCrsUpload(form,element) {
1.1248 raeburn 1927: if (document.getElementById('chooser_'+element+'_crsres')) {
1928: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1929: }
1930: if (document.getElementById('chooser_'+element+'_upload')) {
1931: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1932: if (curr == 'none') {
1.1400 raeburn 1933: form.elements['newsubdir_'+element][0].checked = true;
1934: toggleNewsubdir(form,element);
1935: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1936: if (document.getElementById('uploadcrsres_'+element)) {
1937: document.getElementById('uploadcrsres_'+element).value = '';
1.1248 raeburn 1938: }
1939: }
1940: }
1941: return;
1942: }
1943:
1944: function toggleResImport(form,element) {
1945: var choices = new Array('crsres','upload');
1946: for (var i=0; i<choices.length; i++) {
1947: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1948: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1949: }
1950: }
1951: }
1952:
1953: function toggleNewsubdir(form,element) {
1954: var newsub = form.elements['newsubdir_'+element];
1955: if (newsub) {
1956: if (newsub.length) {
1957: for (var j=0; j<newsub.length; j++) {
1958: if (newsub[j].checked) {
1959: if (document.getElementById('newsubdirname_'+element)) {
1960: if (newsub[j].value == '1') {
1961: document.getElementById('newsubdirname_'+element).type = "text";
1962: if (document.getElementById('newsubdir_'+element)) {
1963: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1964: }
1965: } else {
1966: document.getElementById('newsubdirname_'+element).type = "hidden";
1967: document.getElementById('newsubdirname_'+element).value = "";
1968: document.getElementById('newsubdir_'+element).innerHTML = "";
1969: }
1970: }
1971: break;
1972: }
1973: }
1974: }
1975: }
1976: }
1977:
1978: function updateCrsFile(form,element) {
1979: var directory = form.elements['coursepath_'+element];
1980: var filename = form.elements['coursefile_'+element];
1981: var path = directory.options[directory.selectedIndex].value;
1982: var file = filename.options[filename.selectedIndex].value;
1.1400 raeburn 1983: if (file != '') {
1984: form.elements[element].value = '$respath';
1985: if (path == '/') {
1986: form.elements[element].value += file;
1987: } else {
1988: form.elements[element].value += path+'/'+file;
1989: }
1990: unClean();
1991: if (document.getElementById('previewimg_'+element)) {
1992: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1993: var newsrc = document.getElementById('previewimg_'+element).src;
1994: }
1995: if (document.getElementById('showimg_'+element)) {
1996: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1997: }
1.1248 raeburn 1998: }
1999: toggleChooser(form,element);
2000: return;
2001: }
2002:
2003: function uploadDone(suffix,name) {
2004: if (name) {
2005: document.forms["lonhomework"].elements[suffix].value = name;
2006: unClean();
2007: toggleChooser(document.forms["lonhomework"],suffix);
2008: }
2009: }
2010:
2011: \$(document).ready(function(){
2012:
2013: \$(document).delegate('form :submit', 'click', function( event ) {
2014: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
2015: var buttonId = this.id;
2016: var suffix = buttonId.toString();
2017: suffix = suffix.replace(/^crsupload_/,'');
2018: event.preventDefault();
2019: document.lonhomework.target = 'crsupload_target_'+suffix;
2020: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
2021: \$(this.form).submit();
2022: document.lonhomework.target = '';
2023: if (document.getElementById('crsuploadto_'+suffix)) {
2024: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
2025: }
2026: return false;
2027: }
2028: });
2029: });
2030: END
2031: }
1.1205 golterma 2032: return <<"COLORFULEDIT"
2033: <script type="text/javascript">
2034: // <![CDATA[>
2035: function fold_box(curDepth, lastresource){
2036:
2037: // we need a list because there can be several blocks you need to fold in one tag
2038: var block = document.getElementsByName('foldblock_'+curDepth);
2039: // but there is only one folding button per tag
2040: var foldbutton = document.getElementById('folding_btn_'+curDepth);
2041:
2042: if(block.item(0).style.display == 'none'){
2043:
2044: foldbutton.value = '@{[&mt("Hide")]}';
2045: for (i = 0; i < block.length; i++){
2046: block.item(i).style.display = '';
2047: }
2048: }else{
2049:
2050: foldbutton.value = '@{[&mt("Show")]}';
2051: for (i = 0; i < block.length; i++){
2052: // block.item(i).style.visibility = 'collapse';
2053: block.item(i).style.display = 'none';
2054: }
2055: };
2056: saveState(lastresource);
2057: }
2058:
2059: function saveState (lastresource) {
2060:
2061: var tag_list = getTagList();
2062: if(tag_list != null){
2063: var timestamp = new Date().getTime();
2064: var key = lastresource;
2065:
2066: // the value pattern is: 'time;key1,value1;key2,value2; ... '
2067: // starting with timestamp
2068: var value = timestamp+';';
2069:
2070: // building the list of key-value pairs
2071: for(var i = 0; i < tag_list.length; i++){
2072: value += tag_list[i]+',';
2073: value += document.getElementsByName(tag_list[i])[0].style.display+';';
2074: }
2075:
2076: // only iterate whole storage if nothing to override
2077: if(localStorage.getItem(key) == null){
2078:
2079: // prevent storage from growing large
2080: if(localStorage.length > 50){
2081: var regex_getTimestamp = /^(?:\d)+;/;
2082: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
2083: var oldest_key;
2084:
2085: for(var i = 1; i < localStorage.length; i++){
2086: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2087: oldest_key = localStorage.key(i);
2088: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2089: }
2090: }
2091: localStorage.removeItem(oldest_key);
2092: }
2093: }
2094: localStorage.setItem(key,value);
2095: }
2096: }
2097:
2098: // restore folding status of blocks (on page load)
2099: function restoreState (lastresource) {
2100: if(localStorage.getItem(lastresource) != null){
2101: var key = lastresource;
2102: var value = localStorage.getItem(key);
2103: var regex_delTimestamp = /^\d+;/;
2104:
2105: value.replace(regex_delTimestamp, '');
2106:
2107: var valueArr = value.split(';');
2108: var pairs;
2109: var elements;
2110: for (var i = 0; i < valueArr.length; i++){
2111: pairs = valueArr[i].split(',');
2112: elements = document.getElementsByName(pairs[0]);
2113:
2114: for (var j = 0; j < elements.length; j++){
2115: elements[j].style.display = pairs[1];
2116: if (pairs[1] == "none"){
2117: var regex_id = /([_\\d]+)\$/;
2118: regex_id.exec(pairs[0]);
2119: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2120: }
2121: }
2122: }
2123: }
2124: }
2125:
2126: function getTagList () {
2127:
2128: var stringToSearch = document.lonhomework.innerHTML;
2129:
2130: var ret = new Array();
2131: var regex_findBlock = /(foldblock_.*?)"/g;
2132: var tag_list = stringToSearch.match(regex_findBlock);
2133:
2134: if(tag_list != null){
2135: for(var i = 0; i < tag_list.length; i++){
2136: ret.push(tag_list[i].replace(/"/, ''));
2137: }
2138: }
2139: return ret;
2140: }
2141:
2142: function saveScrollPosition (resource) {
2143: var tag_list = getTagList();
2144:
2145: // we dont always want to jump to the first block
2146: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2147: if(\$(window).scrollTop() > 170){
2148: if(tag_list != null){
2149: var result;
2150: for(var i = 0; i < tag_list.length; i++){
2151: if(isElementInViewport(tag_list[i])){
2152: result += tag_list[i]+';';
2153: }
2154: }
2155: sessionStorage.setItem('anchor_'+resource, result);
2156: }
2157: } else {
2158: // we dont need to save zero, just delete the item to leave everything tidy
2159: sessionStorage.removeItem('anchor_'+resource);
2160: }
2161: }
2162:
2163: function restoreScrollPosition(resource){
2164:
2165: var elem = sessionStorage.getItem('anchor_'+resource);
2166: if(elem != null){
2167: var tag_list = elem.split(';');
2168: var elem_list;
2169:
2170: for(var i = 0; i < tag_list.length; i++){
2171: elem_list = document.getElementsByName(tag_list[i]);
2172:
2173: if(elem_list.length > 0){
2174: elem = elem_list[0];
2175: break;
2176: }
2177: }
2178: elem.scrollIntoView();
2179: }
2180: }
2181:
2182: function isElementInViewport(el) {
2183:
2184: // change to last element instead of first
2185: var elem = document.getElementsByName(el);
2186: var rect = elem[0].getBoundingClientRect();
2187:
2188: return (
2189: rect.top >= 0 &&
2190: rect.left >= 0 &&
2191: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2192: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2193: );
2194: }
2195:
2196: function autosize(depth){
2197: var cmInst = window['cm'+depth];
2198: var fitsizeButton = document.getElementById('fitsize'+depth);
2199:
2200: // is fixed size, switching to dynamic
2201: if (sessionStorage.getItem("autosized_"+depth) == null) {
2202: cmInst.setSize("","auto");
2203: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2204: sessionStorage.setItem("autosized_"+depth, "yes");
2205:
2206: // is dynamic size, switching to fixed
2207: } else {
2208: cmInst.setSize("","300px");
2209: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2210: sessionStorage.removeItem("autosized_"+depth);
2211: }
2212: }
2213:
1.1248 raeburn 2214: $browse_or_search
1.1205 golterma 2215:
2216: // ]]>
2217: </script>
2218: COLORFULEDIT
2219: }
2220:
2221: sub xmleditor_js {
2222: return <<XMLEDIT
2223: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2224: <script type="text/javascript">
2225: // <![CDATA[>
2226:
2227: function saveScrollPosition (resource) {
2228:
2229: var scrollPos = \$(window).scrollTop();
2230: sessionStorage.setItem(resource,scrollPos);
2231: }
2232:
2233: function restoreScrollPosition(resource){
2234:
2235: var scrollPos = sessionStorage.getItem(resource);
2236: \$(window).scrollTop(scrollPos);
2237: }
2238:
2239: // unless internet explorer
2240: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2241:
2242: \$(document).ready(function() {
2243: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2244: });
2245: }
2246:
2247: // inserts text at cursor position into codemirror (xml editor only)
2248: function insertText(text){
2249: cm.focus();
2250: var curPos = cm.getCursor();
2251: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2252: }
2253: // ]]>
2254: </script>
2255: XMLEDIT
2256: }
2257:
2258: sub insert_folding_button {
2259: my $curDepth = $Apache::lonxml::curdepth;
2260: my $lastresource = $env{'request.ambiguous'};
2261:
2262: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2263: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2264: }
2265:
1.1248 raeburn 2266: sub crsauthor_url {
2267: my ($url) = @_;
2268: if ($url eq '') {
2269: $url = $ENV{'REQUEST_URI'};
2270: }
2271: my ($cnum,$cdom);
2272: if ($env{'request.course.id'}) {
2273: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2274: if ($audom ne '' && $auname ne '') {
2275: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2276: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2277: $cnum = $auname;
2278: $cdom = $audom;
2279: }
2280: }
2281: }
2282: return ($cnum,$cdom);
2283: }
2284:
2285: sub import_crsauthor_form {
1.1400 raeburn 2286: my ($firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2287: return (0) unless ($env{'request.course.id'});
2288: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2289: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2290: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2291: return (0) unless (($cnum ne '') && ($cdom ne ''));
2292: my @ids=&Apache::lonnet::current_machine_ids();
1.1400 raeburn 2293: my ($output,$is_home,$toppath,%subdirs,%files,%selimport_menus,$include,$exclude);
1.1402 raeburn 2294:
1.1248 raeburn 2295: if (grep(/^\Q$crshome\E$/,@ids)) {
2296: $is_home = 1;
2297: }
1.1400 raeburn 2298: $toppath = "/priv/$cdom/$cnum";
2299: my $nonemptydir = 1;
2300: my $js_only;
2301: if ($only) {
2302: map { $include->{$_} = 1; } split(/\s*,\s*/,$only);
2303: $js_only = join(',',map { &js_escape($_); } sort(keys(%{$include})));
2304: }
2305: $exclude = &Apache::lonnet::priv_exclude();
1.1402 raeburn 2306: &Apache::lonnet::recursedirs($is_home,1,$include,$exclude,1,0,$toppath,'',\%subdirs,\%files);
1.1400 raeburn 2307: my $numdirs = scalar(keys(%files));
1.1248 raeburn 2308: my %lt = &Apache::lonlocal::texthash (
2309: fnam => 'Filename',
2310: dire => 'Directory',
1.1400 raeburn 2311: se => 'Select',
1.1248 raeburn 2312: );
1.1450 ! raeburn 2313: $output = '<label>'.$lt{'dire'}.': '.
1.1400 raeburn 2314: '<select id="'.$firstselectname.'" name="'.$firstselectname.'" '.
1.1402 raeburn 2315: 'onchange="populateCrsSelects(this.form,'."'$firstselectname','$secondselectname',1,'$js_only',0,1,0,0,0".');">'.
1.1400 raeburn 2316: '<option value="" selected="selected">'.$lt{'se'}.'</option>';
1.1402 raeburn 2317: if ($files{'/'}) {
2318: $output .= '<option value="/">/</option>'."\n";
2319: }
1.1400 raeburn 2320: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
1.1402 raeburn 2321: next if ($key eq '/');
1.1400 raeburn 2322: $output .= '<option value="'.$key.'">'.$key.'</option>'."\n";
2323: }
1.1450 ! raeburn 2324: $output .= '</select></label><br /><label>'."\n".
1.1402 raeburn 2325: $lt{'fnam'}.': <select id="'.$secondselectname.'" name="'.$secondselectname.'">'."\n".
1.1400 raeburn 2326: '<option value="" selected="selected"></option>'."\n".
1.1450 ! raeburn 2327: '</select></label>'."\n".
1.1402 raeburn 2328: '<input type="hidden" id="crsres_include_'.$suffix.'" value="'.$only.'" />';
1.1400 raeburn 2329: return ($numdirs,$output);
2330: }
2331:
2332: sub show_crsfiles_js {
2333: my $excluderef = &Apache::lonnet::priv_exclude();
2334: my $se = &js_escape(&mt('Select'));
2335: my $exclude;
2336: if (ref($excluderef) eq 'HASH') {
2337: $exclude = join(',', map { &js_escape($_); } sort(keys(%{$excluderef})));
2338: }
2339: my $js = <<"END";
2340:
2341:
1.1402 raeburn 2342: function populateCrsSelects (form,dirsel,filesel,exc,include,setdir,setfile,recurse,nonemptydir,addtopdir) {
1.1400 raeburn 2343: var relpath = '';
2344: if ((setfile) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
2345: var currdir = form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value;
2346: if (currdir == '') {
2347: if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2348: selelem = form.elements[filesel];
2349: var j, numfiles = selelem.options.length -1;
2350: if (numfiles >=0) {
2351: for (j = numfiles; j >= 0; j--) {
2352: selelem.remove(j);
2353: }
2354: }
2355: if (selelem.options.length == 0) {
2356: selelem.options[selelem.options.length] = new Option('','');
2357: selelem.selectedIndex = 0;
1.1248 raeburn 2358: }
2359: }
1.1400 raeburn 2360: return;
2361: } else {
2362: relpath = encodeURIComponent(form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value);
1.1248 raeburn 2363: }
2364: }
1.1400 raeburn 2365: var http = new XMLHttpRequest();
2366: var url = "/adm/courseauthor";
2367: var crsrole = "$env{'request.role'}";
2368: var exclude = '';
2369: if (exc) {
2370: exclude = '$exclude';
2371: }
1.1402 raeburn 2372: var params = "role=course&files=1&rec="+recurse+"&nonempty="+nonemptydir+"&exc="+exclude+"&inc="+include+"&addtop="+addtopdir+"&path="+relpath;
1.1400 raeburn 2373: http.open("POST", url, true);
2374: http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
2375: http.onreadystatechange = function() {
2376: if (http.readyState == 4 && http.status == 200) {
2377: var data = JSON.parse(http.responseText);
2378: var selelem;
2379: if ((setdir) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
2380: if (Array.isArray(data.dirs)) {
2381: selelem = form.elements[dirsel];
2382: var i, numdirs = selelem.options.length -1;
2383: if (numdirs >=0) {
2384: for (i = numdirs; i >= 0; i--) {
2385: selelem.remove(i);
2386: }
2387: }
2388: var len = data.dirs.length;
2389: if (len) {
1.1402 raeburn 2390: selelem.options[selelem.options.length] = new Option('$se','');
1.1400 raeburn 2391: var j;
2392: for (j = 0; j < len; j++) {
2393: selelem.options[selelem.options.length] = new Option(data.dirs[j],data.dirs[j]);
2394: }
2395: selelem.selectedIndex = 0;
2396: }
2397: if (!setfile) {
2398: if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2399: selelem = form.elements[filesel];
2400: var j, numfiles = selelem.options.length -1;
2401: if (numfiles >=0) {
2402: for (j = numfiles; j >= 0; j--) {
2403: selelem.remove(j);
2404: }
2405: }
2406: if (selelem.options.length == 0) {
2407: selelem.options[selelem.options.length] = new Option('','');
2408: selelem.selectedIndex = 0;
2409: }
2410: }
2411: }
2412: }
2413: }
2414: if ((setfile) && (filesel != null) && (filesel != 'undefined') && (filesel != '')) {
2415: selelem = form.elements[filesel];
2416: var i, numfiles = selelem.options.length -1;
2417: if (numfiles >=0) {
2418: for (i = numfiles; i >= 0; i--) {
2419: selelem.remove(i);
2420: }
2421: }
2422: var x;
2423: for (x in data.files) {
2424: if (Array.isArray(data.files[x])) {
2425: if (data.files[x].length > 1) {
2426: selelem.options[selelem.options.length] = new Option('$se','');
2427: }
2428: var len = data.files[x].length;
2429: if (len) {
2430: var k;
2431: for (k = 0; k < len; k++) {
2432: selelem.options[selelem.options.length] = new Option(data.files[x][k],data.files[x][k]);
2433: }
2434: selelem.selectedIndex = 0;
2435: }
2436: }
2437: }
2438: if (selelem.options.length == 0) {
2439: selelem.options[selelem.options.length] = new Option('','');
2440: selelem.selectedIndex = 0;
2441: }
1.1248 raeburn 2442: }
2443: }
2444: }
1.1400 raeburn 2445: http.send(params);
1.1248 raeburn 2446: }
1.1400 raeburn 2447: END
1.1248 raeburn 2448: }
2449:
1.1426 raeburn 2450: sub crsauthor_rights {
2451: my ($rightsfile,$path,$docroot,$cnum,$cdom) = @_;
2452: my $sourcerights = "$path/$rightsfile";
2453: my $now = time;
2454: if (!-e $sourcerights) {
2455: my $cid = $cdom.'_'.$cnum;
2456: if (!-e "$docroot/priv/$cdom") {
2457: mkdir("$docroot/priv/$cdom",0755);
2458: }
2459: if (!-e "$docroot/priv/$cdom/$cnum") {
2460: mkdir("$docroot/priv/$cdom/$cnum",0755);
2461: }
2462: if (open(my $fh,">$sourcerights")) {
2463: print $fh <<END;
2464: <accessrule effect="deny" realm="" type="course" role="" />
2465: <accessrule effect="allow" realm="$cid" type="course" role="" />
2466: END
2467: close($fh);
2468: }
2469: }
2470: if (!-e "$sourcerights.meta") {
2471: if (open(my $fh,">$sourcerights.meta")) {
2472: my $author=$env{'environment.firstname'}.' '.
2473: $env{'environment.middlename'}.' '.
2474: $env{'environment.lastname'}.' '.
2475: $env{'environment.generation'};
2476: $author =~ s/\s+$//;
2477: print $fh <<"END";
2478:
2479: <abstract></abstract>
2480: <author>$author</author>
2481: <authorspace>$cnum:$cdom</authorspace>
2482: <copyright>private</copyright>
2483: <creationdate>$now</creationdate>
2484: <customdistributionfile></customdistributionfile>
2485: <dependencies></dependencies>
2486: <domain>$cdom</domain>
2487: <highestgradelevel>0</highestgradelevel>
2488: <keywords></keywords>
1.1445 raeburn 2489: <language>notset</language>
1.1426 raeburn 2490: <lastrevisiondate>$now</lastrevisiondate>
2491: <lowestgradelevel>0</lowestgradelevel>
2492: <mime>rights</mime>
2493: <modifyinguser>$env{'user.name'}:$env{'user.domain'}</modifyinguser>
2494: <notes></notes>
2495: <obsolete></obsolete>
2496: <obsoletereplacement></obsoletereplacement>
2497: <owner>$cnum:$cdom</owner>
2498: <rule>deny:::course,allow:$cid::course</rule>
2499: <sourceavail></sourceavail>
2500: <standards></standards>
2501: <subject></subject>
2502: <title>Course Authoring Rights</title>
2503: END
2504: close($fh);
2505: }
2506: }
2507: return;
2508: }
2509:
1.565 albertel 2510: =pod
2511:
1.1420 raeburn 2512: =item * &iframe_wrapper_headjs()
2513:
1.1425 raeburn 2514: emits javascript containing two global vars to facilitate handling of resizing
2515: by code in iframe_wrapper_resizejs() used when an iframe is present in a page
2516: with standard LON-CAPA menus.
2517:
2518: =cut
2519:
1.1420 raeburn 2520: #
2521: # Where iframe is in use, if window.onload() executes before the custom resize function
2522: # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)
2523: # are used to ensure document.ready() triggers a call to resize, so the iframe contents
2524: # do not obscure the Functions menu.
2525: #
2526:
2527: sub iframe_wrapper_headjs {
2528: return <<"ENDJS";
2529: <script type="text/javascript">
2530: // <![CDATA[
2531: var LCnotready = 0;
2532: var LCresizedef = 0;
2533: // ]]>
2534: </script>
2535:
2536: ENDJS
2537:
2538: }
2539:
2540: =pod
2541:
2542: =item * &iframe_wrapper_resizejs()
2543:
1.1425 raeburn 2544: emits javascript used to handle resizing for a page containing
2545: an iframe, to ensure that the iframe does not obscure any
2546: standard LON-CAPA menu items.
2547:
2548: =back
2549:
2550: =cut
2551:
1.1420 raeburn 2552: #
2553: # jQuery to use when iframe is in use and a page resize occurs.
2554: # This script will ensure that the iframe does not obscure any
2555: # standard LON-CAPA inline menus (primary, secondary, and/or
2556: # breadcrumbs and Functions menus. Expects javascript from
2557: # &iframe_wrapper_headjs() to be in head portion of the web page,
2558: # e.g., by inclusion in second arg passed to &start_page().
2559: #
2560:
2561: sub iframe_wrapper_resizejs {
2562: my $offset = 5;
2563: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
2564: if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
2565: $offset = 0;
2566: }
2567: return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);
2568: \$(document).ready( function() {
2569: \$(window).unbind('resize').resize(function(){
2570: var header = null;
2571: var offset = $offset;
2572: var height = 0;
2573: var hdrtop = 0;
1.1421 raeburn 2574: if (\$('div.LC_menus_content:first').length) {
2575: if (\$('div.LC_menus_content:first').hasClass ("shown")) {
2576: header = \$('div.LC_menus_content:first');
1.1423 raeburn 2577: offset = 12;
1.1421 raeburn 2578: }
2579: } else if (\$('div.LC_head_subbox:first').length) {
1.1420 raeburn 2580: header = \$('div.LC_head_subbox:first');
2581: offset = 9;
2582: } else {
2583: if (\$('#LC_breadcrumbs').length) {
2584: header = \$('#LC_breadcrumbs');
2585: }
2586: }
2587: if (header != null && header.length) {
2588: height = header.height();
2589: hdrtop = header.position().top;
2590: }
2591: var pos = height + hdrtop + offset;
2592: \$('.LC_iframecontainer').css('top', pos);
2593: });
2594: LCresizedef = 1;
2595: if (LCnotready == 1) {
2596: LCnotready = 0;
2597: \$(window).trigger('resize');
2598: }
2599: });
2600: window.onload = function(){
2601: if (LCresizedef) {
2602: LCnotready = 0;
2603: \$(window).trigger('resize');
2604: } else {
2605: LCnotready = 1;
2606: }
2607: };
2608: SCRIPT
2609:
2610: }
2611:
2612: =pod
2613:
1.256 matthew 2614: =head1 Excel and CSV file utility routines
2615:
2616: =cut
2617:
2618: ###############################################################
2619: ###############################################################
2620:
2621: =pod
2622:
1.1162 raeburn 2623: =over 4
2624:
1.648 raeburn 2625: =item * &csv_translate($text)
1.37 matthew 2626:
1.185 www 2627: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2628: format.
2629:
2630: =cut
2631:
1.180 matthew 2632: ###############################################################
2633: ###############################################################
1.37 matthew 2634: sub csv_translate {
2635: my $text = shift;
2636: $text =~ s/\"/\"\"/g;
1.209 albertel 2637: $text =~ s/\n/ /g;
1.37 matthew 2638: return $text;
2639: }
1.180 matthew 2640:
2641: ###############################################################
2642: ###############################################################
2643:
2644: =pod
2645:
1.648 raeburn 2646: =item * &define_excel_formats()
1.180 matthew 2647:
2648: Define some commonly used Excel cell formats.
2649:
2650: Currently supported formats:
2651:
2652: =over 4
2653:
2654: =item header
2655:
2656: =item bold
2657:
2658: =item h1
2659:
2660: =item h2
2661:
2662: =item h3
2663:
1.256 matthew 2664: =item h4
2665:
2666: =item i
2667:
1.180 matthew 2668: =item date
2669:
2670: =back
2671:
2672: Inputs: $workbook
2673:
2674: Returns: $format, a hash reference.
2675:
1.1057 foxr 2676:
1.180 matthew 2677: =cut
2678:
2679: ###############################################################
2680: ###############################################################
2681: sub define_excel_formats {
2682: my ($workbook) = @_;
2683: my $format;
2684: $format->{'header'} = $workbook->add_format(bold => 1,
2685: bottom => 1,
2686: align => 'center');
2687: $format->{'bold'} = $workbook->add_format(bold=>1);
2688: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2689: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2690: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2691: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2692: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2693: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2694: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2695: return $format;
2696: }
2697:
2698: ###############################################################
2699: ###############################################################
1.113 bowersj2 2700:
2701: =pod
2702:
1.648 raeburn 2703: =item * &create_workbook()
1.255 matthew 2704:
2705: Create an Excel worksheet. If it fails, output message on the
2706: request object and return undefs.
2707:
2708: Inputs: Apache request object
2709:
2710: Returns (undef) on failure,
2711: Excel worksheet object, scalar with filename, and formats
2712: from &Apache::loncommon::define_excel_formats on success
2713:
2714: =cut
2715:
2716: ###############################################################
2717: ###############################################################
2718: sub create_workbook {
2719: my ($r) = @_;
2720: #
2721: # Create the excel spreadsheet
2722: my $filename = '/prtspool/'.
1.258 albertel 2723: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2724: time.'_'.rand(1000000000).'.xls';
2725: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2726: if (! defined($workbook)) {
2727: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2728: $r->print(
2729: '<p class="LC_error">'
2730: .&mt('Problems occurred in creating the new Excel file.')
2731: .' '.&mt('This error has been logged.')
2732: .' '.&mt('Please alert your LON-CAPA administrator.')
2733: .'</p>'
2734: );
1.255 matthew 2735: return (undef);
2736: }
2737: #
1.1014 foxr 2738: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2739: #
2740: my $format = &Apache::loncommon::define_excel_formats($workbook);
2741: return ($workbook,$filename,$format);
2742: }
2743:
2744: ###############################################################
2745: ###############################################################
2746:
2747: =pod
2748:
1.648 raeburn 2749: =item * &create_text_file()
1.113 bowersj2 2750:
1.542 raeburn 2751: Create a file to write to and eventually make available to the user.
1.256 matthew 2752: If file creation fails, outputs an error message on the request object and
2753: return undefs.
1.113 bowersj2 2754:
1.256 matthew 2755: Inputs: Apache request object, and file suffix
1.113 bowersj2 2756:
1.256 matthew 2757: Returns (undef) on failure,
2758: Filehandle and filename on success.
1.113 bowersj2 2759:
2760: =cut
2761:
1.256 matthew 2762: ###############################################################
2763: ###############################################################
2764: sub create_text_file {
2765: my ($r,$suffix) = @_;
2766: if (! defined($suffix)) { $suffix = 'txt'; };
2767: my $fh;
2768: my $filename = '/prtspool/'.
1.258 albertel 2769: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2770: time.'_'.rand(1000000000).'.'.$suffix;
2771: $fh = Apache::File->new('>/home/httpd'.$filename);
2772: if (! defined($fh)) {
2773: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2774: $r->print(
2775: '<p class="LC_error">'
2776: .&mt('Problems occurred in creating the output file.')
2777: .' '.&mt('This error has been logged.')
2778: .' '.&mt('Please alert your LON-CAPA administrator.')
2779: .'</p>'
2780: );
1.113 bowersj2 2781: }
1.256 matthew 2782: return ($fh,$filename)
1.113 bowersj2 2783: }
2784:
2785:
1.256 matthew 2786: =pod
1.113 bowersj2 2787:
2788: =back
2789:
2790: =cut
1.37 matthew 2791:
2792: ###############################################################
1.33 matthew 2793: ## Home server <option> list generating code ##
2794: ###############################################################
1.35 matthew 2795:
1.169 www 2796: # ------------------------------------------
2797:
2798: sub domain_select {
1.1289 raeburn 2799: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2800: my @possdoms;
2801: if (ref($incdoms) eq 'ARRAY') {
2802: @possdoms = @{$incdoms};
2803: } else {
2804: @possdoms = &Apache::lonnet::all_domains();
2805: }
2806:
1.169 www 2807: my %domains=map {
1.514 albertel 2808: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2809: } @possdoms;
2810:
2811: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2812: foreach my $dom (@{$excdoms}) {
2813: delete($domains{$dom});
2814: }
2815: }
2816:
1.169 www 2817: if ($multiple) {
2818: $domains{''}=&mt('Any domain');
1.550 albertel 2819: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2820: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2821: } else {
1.550 albertel 2822: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2823: return &select_form($name,$value,\%domains);
1.169 www 2824: }
2825: }
2826:
1.282 albertel 2827: #-------------------------------------------
2828:
2829: =pod
2830:
1.519 raeburn 2831: =head1 Routines for form select boxes
2832:
2833: =over 4
2834:
1.648 raeburn 2835: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2836:
2837: Returns a string containing a <select> element int multiple mode
2838:
2839:
2840: Args:
2841: $name - name of the <select> element
1.506 raeburn 2842: $value - scalar or array ref of values that should already be selected
1.282 albertel 2843: $size - number of rows long the select element is
1.283 albertel 2844: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2845: (shown text should already have been &mt())
1.506 raeburn 2846: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2847:
1.282 albertel 2848: =cut
2849:
2850: #-------------------------------------------
1.169 www 2851: sub multiple_select_form {
1.284 albertel 2852: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2853: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2854: my $output='';
1.191 matthew 2855: if (! defined($size)) {
2856: $size = 4;
1.283 albertel 2857: if (scalar(keys(%$hash))<4) {
2858: $size = scalar(keys(%$hash));
1.191 matthew 2859: }
2860: }
1.734 bisitz 2861: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2862: my @order;
1.506 raeburn 2863: if (ref($order) eq 'ARRAY') {
2864: @order = @{$order};
2865: } else {
2866: @order = sort(keys(%$hash));
1.501 banghart 2867: }
2868: if (exists($$hash{'select_form_order'})) {
2869: @order = @{$$hash{'select_form_order'}};
2870: }
2871:
1.284 albertel 2872: foreach my $key (@order) {
1.356 albertel 2873: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2874: $output.='selected="selected" ' if ($selected{$key});
2875: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2876: }
2877: $output.="</select>\n";
2878: return $output;
2879: }
2880:
1.88 www 2881: #-------------------------------------------
2882:
2883: =pod
2884:
1.1254 raeburn 2885: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2886:
2887: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2888: allow a user to select options from a ref to a hash containing:
2889: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2890: a javascript onchange item, e.g., onchange="this.form.submit();".
2891: An optional arg -- $readonly -- if true will cause the select form
2892: to be disabled, e.g., for the case where an instructor has a section-
2893: specific role, and is viewing/modifying parameters.
1.970 raeburn 2894:
1.88 www 2895: See lonrights.pm for an example invocation and use.
2896:
2897: =cut
2898:
2899: #-------------------------------------------
2900: sub select_form {
1.1228 raeburn 2901: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2902: return unless (ref($hashref) eq 'HASH');
2903: if ($onchange) {
2904: $onchange = ' onchange="'.$onchange.'"';
2905: }
1.1228 raeburn 2906: my $disabled;
2907: if ($readonly) {
2908: $disabled = ' disabled="disabled"';
2909: }
2910: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2911: my @keys;
1.970 raeburn 2912: if (exists($hashref->{'select_form_order'})) {
2913: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2914: } else {
1.970 raeburn 2915: @keys=sort(keys(%{$hashref}));
1.128 albertel 2916: }
1.356 albertel 2917: foreach my $key (@keys) {
2918: $selectform.=
2919: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2920: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2921: ">".$hashref->{$key}."</option>\n";
1.88 www 2922: }
2923: $selectform.="</select>";
2924: return $selectform;
2925: }
2926:
1.475 www 2927: # For display filters
2928:
2929: sub display_filter {
1.1074 raeburn 2930: my ($context) = @_;
1.475 www 2931: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2932: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2933: my $phraseinput = 'hidden';
2934: my $includeinput = 'hidden';
2935: my ($checked,$includetypestext);
2936: if ($env{'form.displayfilter'} eq 'containing') {
2937: $phraseinput = 'text';
2938: if ($context eq 'parmslog') {
2939: $includeinput = 'checkbox';
2940: if ($env{'form.includetypes'}) {
2941: $checked = ' checked="checked"';
2942: }
2943: $includetypestext = &mt('Include parameter types');
2944: }
2945: } else {
2946: $includetypestext = ' ';
2947: }
2948: my ($additional,$secondid,$thirdid);
2949: if ($context eq 'parmslog') {
2950: $additional =
2951: '<label><input type="'.$includeinput.'" name="includetypes"'.
2952: $checked.' name="includetypes" value="1" id="includetypes" />'.
2953: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2954: '</label>';
2955: $secondid = 'includetypes';
2956: $thirdid = 'includetypestext';
2957: }
2958: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2959: '$secondid','$thirdid')";
2960: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.1403 raeburn 2961: &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
1.475 www 2962: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2963: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2964: &mt('Filter: [_1]',
1.477 www 2965: &select_form($env{'form.displayfilter'},
2966: 'displayfilter',
1.970 raeburn 2967: {'currentfolder' => 'Current folder/page',
1.477 www 2968: 'containing' => 'Containing phrase',
1.1074 raeburn 2969: 'none' => 'None'},$onchange)).' '.
2970: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2971: &HTML::Entities::encode($env{'form.containingphrase'}).
2972: '" />'.$additional;
2973: }
2974:
2975: sub display_filter_js {
2976: my $includetext = &mt('Include parameter types');
2977: return <<"ENDJS";
2978:
2979: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2980: var firstType = 'hidden';
2981: if (setter.options[setter.selectedIndex].value == 'containing') {
2982: firstType = 'text';
2983: }
2984: firstObject = document.getElementById(firstid);
2985: if (typeof(firstObject) == 'object') {
2986: if (firstObject.type != firstType) {
2987: changeInputType(firstObject,firstType);
2988: }
2989: }
2990: if (context == 'parmslog') {
2991: var secondType = 'hidden';
2992: if (firstType == 'text') {
2993: secondType = 'checkbox';
2994: }
2995: secondObject = document.getElementById(secondid);
2996: if (typeof(secondObject) == 'object') {
2997: if (secondObject.type != secondType) {
2998: changeInputType(secondObject,secondType);
2999: }
3000: }
3001: var textItem = document.getElementById(thirdid);
3002: var currtext = textItem.innerHTML;
3003: var newtext;
3004: if (firstType == 'text') {
3005: newtext = '$includetext';
3006: } else {
3007: newtext = ' ';
3008: }
3009: if (currtext != newtext) {
3010: textItem.innerHTML = newtext;
3011: }
3012: }
3013: return;
3014: }
3015:
3016: function changeInputType(oldObject,newType) {
3017: var newObject = document.createElement('input');
3018: newObject.type = newType;
3019: if (oldObject.size) {
3020: newObject.size = oldObject.size;
3021: }
3022: if (oldObject.value) {
3023: newObject.value = oldObject.value;
3024: }
3025: if (oldObject.name) {
3026: newObject.name = oldObject.name;
3027: }
3028: if (oldObject.id) {
3029: newObject.id = oldObject.id;
3030: }
3031: oldObject.parentNode.replaceChild(newObject,oldObject);
3032: return;
3033: }
3034:
3035: ENDJS
1.475 www 3036: }
3037:
1.167 www 3038: sub gradeleveldescription {
3039: my $gradelevel=shift;
3040: my %gradelevels=(0 => 'Not specified',
3041: 1 => 'Grade 1',
3042: 2 => 'Grade 2',
3043: 3 => 'Grade 3',
3044: 4 => 'Grade 4',
3045: 5 => 'Grade 5',
3046: 6 => 'Grade 6',
3047: 7 => 'Grade 7',
3048: 8 => 'Grade 8',
3049: 9 => 'Grade 9',
3050: 10 => 'Grade 10',
3051: 11 => 'Grade 11',
3052: 12 => 'Grade 12',
3053: 13 => 'Grade 13',
3054: 14 => '100 Level',
3055: 15 => '200 Level',
3056: 16 => '300 Level',
3057: 17 => '400 Level',
3058: 18 => 'Graduate Level');
3059: return &mt($gradelevels{$gradelevel});
3060: }
3061:
1.163 www 3062: sub select_level_form {
3063: my ($deflevel,$name)=@_;
3064: unless ($deflevel) { $deflevel=0; }
1.167 www 3065: my $selectform = "<select name=\"$name\" size=\"1\">\n";
3066: for (my $i=0; $i<=18; $i++) {
3067: $selectform.="<option value=\"$i\" ".
1.253 albertel 3068: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 3069: ">".&gradeleveldescription($i)."</option>\n";
3070: }
3071: $selectform.="</select>";
3072: return $selectform;
1.163 www 3073: }
1.167 www 3074:
1.35 matthew 3075: #-------------------------------------------
3076:
1.45 matthew 3077: =pod
3078:
1.1256 raeburn 3079: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 3080:
3081: Returns a string containing a <select name='$name' size='1'> form to
3082: allow a user to select the domain to preform an operation in.
3083: See loncreateuser.pm for an example invocation and use.
3084:
1.90 www 3085: If the $includeempty flag is set, it also includes an empty choice ("no domain
3086: selected");
3087:
1.743 raeburn 3088: If the $showdomdesc flag is set, the domain name is followed by the domain description.
3089:
1.910 raeburn 3090: 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.
3091:
1.1121 raeburn 3092: The optional $incdoms is a reference to an array of domains which will be the only available options.
3093:
3094: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 3095:
1.1256 raeburn 3096: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
3097:
1.35 matthew 3098: =cut
3099:
3100: #-------------------------------------------
1.34 matthew 3101: sub select_dom_form {
1.1256 raeburn 3102: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 3103: if ($onchange) {
1.874 raeburn 3104: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 3105: }
1.1256 raeburn 3106: if ($disabled) {
3107: $disabled = ' disabled="disabled"';
3108: }
1.1121 raeburn 3109: my (@domains,%exclude);
1.910 raeburn 3110: if (ref($incdoms) eq 'ARRAY') {
3111: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
3112: } else {
3113: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
3114: }
1.90 www 3115: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 3116: if (ref($excdoms) eq 'ARRAY') {
3117: map { $exclude{$_} = 1; } @{$excdoms};
3118: }
1.1256 raeburn 3119: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 3120: foreach my $dom (@domains) {
1.1121 raeburn 3121: next if ($exclude{$dom});
1.356 albertel 3122: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 3123: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
3124: if ($showdomdesc) {
3125: if ($dom ne '') {
3126: my $domdesc = &Apache::lonnet::domain($dom,'description');
3127: if ($domdesc ne '') {
3128: $selectdomain .= ' ('.$domdesc.')';
3129: }
3130: }
3131: }
3132: $selectdomain .= "</option>\n";
1.34 matthew 3133: }
3134: $selectdomain.="</select>";
3135: return $selectdomain;
3136: }
3137:
1.35 matthew 3138: #-------------------------------------------
3139:
1.45 matthew 3140: =pod
3141:
1.648 raeburn 3142: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 3143:
1.586 raeburn 3144: input: 4 arguments (two required, two optional) -
3145: $domain - domain of new user
3146: $name - name of form element
3147: $default - Value of 'default' causes a default item to be first
3148: option, and selected by default.
3149: $hide - Value of 'hide' causes hiding of the name of the server,
3150: if 1 server found, or default, if 0 found.
1.594 raeburn 3151: output: returns 2 items:
1.586 raeburn 3152: (a) form element which contains either:
3153: (i) <select name="$name">
3154: <option value="$hostid1">$hostid $servers{$hostid}</option>
3155: <option value="$hostid2">$hostid $servers{$hostid}</option>
3156: </select>
3157: form item if there are multiple library servers in $domain, or
3158: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
3159: if there is only one library server in $domain.
3160:
3161: (b) number of library servers found.
3162:
3163: See loncreateuser.pm for example of use.
1.35 matthew 3164:
3165: =cut
3166:
3167: #-------------------------------------------
1.586 raeburn 3168: sub home_server_form_item {
3169: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 3170: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 3171: my $result;
3172: my $numlib = keys(%servers);
3173: if ($numlib > 1) {
3174: $result .= '<select name="'.$name.'" />'."\n";
3175: if ($default) {
1.804 bisitz 3176: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 3177: '</option>'."\n";
3178: }
3179: foreach my $hostid (sort(keys(%servers))) {
3180: $result.= '<option value="'.$hostid.'">'.
3181: $hostid.' '.$servers{$hostid}."</option>\n";
3182: }
3183: $result .= '</select>'."\n";
3184: } elsif ($numlib == 1) {
3185: my $hostid;
3186: foreach my $item (keys(%servers)) {
3187: $hostid = $item;
3188: }
3189: $result .= '<input type="hidden" name="'.$name.'" value="'.
3190: $hostid.'" />';
3191: if (!$hide) {
3192: $result .= $hostid.' '.$servers{$hostid};
3193: }
3194: $result .= "\n";
3195: } elsif ($default) {
3196: $result .= '<input type="hidden" name="'.$name.
3197: '" value="default" />';
3198: if (!$hide) {
3199: $result .= &mt('default');
3200: }
3201: $result .= "\n";
1.33 matthew 3202: }
1.586 raeburn 3203: return ($result,$numlib);
1.33 matthew 3204: }
1.112 bowersj2 3205:
3206: =pod
3207:
1.534 albertel 3208: =back
3209:
1.112 bowersj2 3210: =cut
1.87 matthew 3211:
3212: ###############################################################
1.112 bowersj2 3213: ## Decoding User Agent ##
1.87 matthew 3214: ###############################################################
3215:
3216: =pod
3217:
1.112 bowersj2 3218: =head1 Decoding the User Agent
3219:
3220: =over 4
3221:
3222: =item * &decode_user_agent()
1.87 matthew 3223:
3224: Inputs: $r
3225:
3226: Outputs:
3227:
3228: =over 4
3229:
1.112 bowersj2 3230: =item * $httpbrowser
1.87 matthew 3231:
1.112 bowersj2 3232: =item * $clientbrowser
1.87 matthew 3233:
1.112 bowersj2 3234: =item * $clientversion
1.87 matthew 3235:
1.112 bowersj2 3236: =item * $clientmathml
1.87 matthew 3237:
1.112 bowersj2 3238: =item * $clientunicode
1.87 matthew 3239:
1.112 bowersj2 3240: =item * $clientos
1.87 matthew 3241:
1.1137 raeburn 3242: =item * $clientmobile
3243:
1.1141 raeburn 3244: =item * $clientinfo
3245:
1.1194 raeburn 3246: =item * $clientosversion
3247:
1.87 matthew 3248: =back
3249:
1.157 matthew 3250: =back
3251:
1.87 matthew 3252: =cut
3253:
3254: ###############################################################
3255: ###############################################################
3256: sub decode_user_agent {
1.247 albertel 3257: my ($r)=@_;
1.87 matthew 3258: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
3259: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
3260: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 3261: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 3262: my $clientbrowser='unknown';
3263: my $clientversion='0';
3264: my $clientmathml='';
3265: my $clientunicode='0';
1.1137 raeburn 3266: my $clientmobile=0;
1.1194 raeburn 3267: my $clientosversion='';
1.87 matthew 3268: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 3269: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 3270: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
3271: $clientbrowser=$bname;
3272: $httpbrowser=~/$vreg/i;
3273: $clientversion=$1;
3274: $clientmathml=($clientversion>=$minv);
3275: $clientunicode=($clientversion>=$univ);
3276: }
3277: }
3278: my $clientos='unknown';
1.1141 raeburn 3279: my $clientinfo;
1.87 matthew 3280: if (($httpbrowser=~/linux/i) ||
3281: ($httpbrowser=~/unix/i) ||
3282: ($httpbrowser=~/ux/i) ||
3283: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
3284: if (($httpbrowser=~/vax/i) ||
3285: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
3286: if ($httpbrowser=~/next/i) { $clientos='next'; }
3287: if (($httpbrowser=~/mac/i) ||
3288: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 3289: if ($httpbrowser=~/win/i) {
3290: $clientos='win';
3291: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
3292: $clientosversion = $1;
3293: }
3294: }
1.87 matthew 3295: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3296: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3297: $clientmobile=lc($1);
3298: }
1.1141 raeburn 3299: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3300: $clientinfo = 'firefox-'.$1;
3301: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3302: $clientinfo = 'chromeframe-'.$1;
3303: }
1.87 matthew 3304: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3305: $clientunicode,$clientos,$clientmobile,$clientinfo,
3306: $clientosversion);
1.87 matthew 3307: }
3308:
1.32 matthew 3309: ###############################################################
3310: ## Authentication changing form generation subroutines ##
3311: ###############################################################
3312: ##
3313: ## All of the authform_xxxxxxx subroutines take their inputs in a
3314: ## hash, and have reasonable default values.
3315: ##
3316: ## formname = the name given in the <form> tag.
1.35 matthew 3317: #-------------------------------------------
3318:
1.45 matthew 3319: =pod
3320:
1.112 bowersj2 3321: =head1 Authentication Routines
3322:
3323: =over 4
3324:
1.648 raeburn 3325: =item * &authform_xxxxxx()
1.35 matthew 3326:
3327: The authform_xxxxxx subroutines provide javascript and html forms which
3328: handle some of the conveniences required for authentication forms.
3329: This is not an optimal method, but it works.
3330:
3331: =over 4
3332:
1.112 bowersj2 3333: =item * authform_header
1.35 matthew 3334:
1.112 bowersj2 3335: =item * authform_authorwarning
1.35 matthew 3336:
1.112 bowersj2 3337: =item * authform_nochange
1.35 matthew 3338:
1.112 bowersj2 3339: =item * authform_kerberos
1.35 matthew 3340:
1.112 bowersj2 3341: =item * authform_internal
1.35 matthew 3342:
1.112 bowersj2 3343: =item * authform_filesystem
1.35 matthew 3344:
1.1310 raeburn 3345: =item * authform_lti
3346:
1.35 matthew 3347: =back
3348:
1.648 raeburn 3349: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3350:
1.35 matthew 3351: =cut
3352:
3353: #-------------------------------------------
1.32 matthew 3354: sub authform_header{
3355: my %in = (
3356: formname => 'cu',
1.80 albertel 3357: kerb_def_dom => '',
1.32 matthew 3358: @_,
3359: );
3360: $in{'formname'} = 'document.' . $in{'formname'};
3361: my $result='';
1.80 albertel 3362:
3363: #---------------------------------------------- Code for upper case translation
3364: my $Javascript_toUpperCase;
3365: unless ($in{kerb_def_dom}) {
3366: $Javascript_toUpperCase =<<"END";
3367: switch (choice) {
3368: case 'krb': currentform.elements[choicearg].value =
3369: currentform.elements[choicearg].value.toUpperCase();
3370: break;
3371: default:
3372: }
3373: END
3374: } else {
3375: $Javascript_toUpperCase = "";
3376: }
3377:
1.165 raeburn 3378: my $radioval = "'nochange'";
1.591 raeburn 3379: if (defined($in{'curr_authtype'})) {
3380: if ($in{'curr_authtype'} ne '') {
3381: $radioval = "'".$in{'curr_authtype'}."arg'";
3382: }
1.174 matthew 3383: }
1.165 raeburn 3384: my $argfield = 'null';
1.591 raeburn 3385: if (defined($in{'mode'})) {
1.165 raeburn 3386: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3387: if (defined($in{'curr_autharg'})) {
3388: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3389: $argfield = "'$in{'curr_autharg'}'";
3390: }
3391: }
3392: }
3393: }
3394:
1.32 matthew 3395: $result.=<<"END";
3396: var current = new Object();
1.165 raeburn 3397: current.radiovalue = $radioval;
3398: current.argfield = $argfield;
1.32 matthew 3399:
3400: function changed_radio(choice,currentform) {
3401: var choicearg = choice + 'arg';
3402: // If a radio button in changed, we need to change the argfield
3403: if (current.radiovalue != choice) {
3404: current.radiovalue = choice;
3405: if (current.argfield != null) {
3406: currentform.elements[current.argfield].value = '';
3407: }
3408: if (choice == 'nochange') {
3409: current.argfield = null;
3410: } else {
3411: current.argfield = choicearg;
3412: switch(choice) {
3413: case 'krb':
3414: currentform.elements[current.argfield].value =
3415: "$in{'kerb_def_dom'}";
3416: break;
3417: default:
3418: break;
3419: }
3420: }
3421: }
3422: return;
3423: }
1.22 www 3424:
1.32 matthew 3425: function changed_text(choice,currentform) {
3426: var choicearg = choice + 'arg';
3427: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3428: $Javascript_toUpperCase
1.32 matthew 3429: // clear old field
3430: if ((current.argfield != choicearg) && (current.argfield != null)) {
3431: currentform.elements[current.argfield].value = '';
3432: }
3433: current.argfield = choicearg;
3434: }
3435: set_auth_radio_buttons(choice,currentform);
3436: return;
1.20 www 3437: }
1.32 matthew 3438:
3439: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3440: var numauthchoices = currentform.login.length;
3441: if (typeof numauthchoices == "undefined") {
3442: return;
3443: }
1.32 matthew 3444: var i=0;
1.986 raeburn 3445: while (i < numauthchoices) {
1.32 matthew 3446: if (currentform.login[i].value == newvalue) { break; }
3447: i++;
3448: }
1.986 raeburn 3449: if (i == numauthchoices) {
1.32 matthew 3450: return;
3451: }
3452: current.radiovalue = newvalue;
3453: currentform.login[i].checked = true;
3454: return;
3455: }
3456: END
3457: return $result;
3458: }
3459:
1.1106 raeburn 3460: sub authform_authorwarning {
1.32 matthew 3461: my $result='';
1.144 matthew 3462: $result='<i>'.
3463: &mt('As a general rule, only authors or co-authors should be '.
3464: 'filesystem authenticated '.
3465: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3466: return $result;
3467: }
3468:
1.1106 raeburn 3469: sub authform_nochange {
1.32 matthew 3470: my %in = (
3471: formname => 'document.cu',
3472: kerb_def_dom => 'MSU.EDU',
3473: @_,
3474: );
1.1106 raeburn 3475: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3476: my $result;
1.1104 raeburn 3477: if (!$authnum) {
1.1105 raeburn 3478: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3479: } else {
3480: $result = '<label>'.&mt('[_1] Do not change login data',
3481: '<input type="radio" name="login" value="nochange" '.
3482: 'checked="checked" onclick="'.
1.281 albertel 3483: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3484: '</label>';
1.586 raeburn 3485: }
1.32 matthew 3486: return $result;
3487: }
3488:
1.591 raeburn 3489: sub authform_kerberos {
1.32 matthew 3490: my %in = (
3491: formname => 'document.cu',
3492: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3493: kerb_def_auth => 'krb4',
1.32 matthew 3494: @_,
3495: );
1.586 raeburn 3496: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3497: $autharg,$jscall,$disabled);
1.1106 raeburn 3498: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3499: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3500: $check5 = ' checked="checked"';
1.80 albertel 3501: } else {
1.772 bisitz 3502: $check4 = ' checked="checked"';
1.80 albertel 3503: }
1.1259 raeburn 3504: if ($in{'readonly'}) {
3505: $disabled = ' disabled="disabled"';
3506: }
1.165 raeburn 3507: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3508: if (defined($in{'curr_authtype'})) {
3509: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3510: $krbcheck = ' checked="checked"';
1.623 raeburn 3511: if (defined($in{'mode'})) {
3512: if ($in{'mode'} eq 'modifyuser') {
3513: $krbcheck = '';
3514: }
3515: }
1.591 raeburn 3516: if (defined($in{'curr_kerb_ver'})) {
3517: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3518: $check5 = ' checked="checked"';
1.591 raeburn 3519: $check4 = '';
3520: } else {
1.772 bisitz 3521: $check4 = ' checked="checked"';
1.591 raeburn 3522: $check5 = '';
3523: }
1.586 raeburn 3524: }
1.591 raeburn 3525: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3526: $krbarg = $in{'curr_autharg'};
3527: }
1.586 raeburn 3528: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3529: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3530: $result =
3531: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3532: $in{'curr_autharg'},$krbver);
3533: } else {
3534: $result =
3535: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3536: }
3537: return $result;
3538: }
3539: }
3540: } else {
3541: if ($authnum == 1) {
1.784 bisitz 3542: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3543: }
3544: }
1.586 raeburn 3545: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3546: return;
1.587 raeburn 3547: } elsif ($authtype eq '') {
1.591 raeburn 3548: if (defined($in{'mode'})) {
1.587 raeburn 3549: if ($in{'mode'} eq 'modifycourse') {
3550: if ($authnum == 1) {
1.1259 raeburn 3551: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3552: }
3553: }
3554: }
1.586 raeburn 3555: }
3556: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3557: if ($authtype eq '') {
3558: $authtype = '<input type="radio" name="login" value="krb" '.
3559: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3560: $krbcheck.$disabled.' />';
1.586 raeburn 3561: }
3562: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3563: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3564: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3565: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3566: $in{'curr_authtype'} eq 'krb4')) {
3567: $result .= &mt
1.144 matthew 3568: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3569: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3570: '<label>'.$authtype,
1.281 albertel 3571: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3572: 'value="'.$krbarg.'" '.
1.1259 raeburn 3573: 'onchange="'.$jscall.'"'.$disabled.' />',
3574: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3575: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3576: '</label>');
1.586 raeburn 3577: } elsif ($can_assign{'krb4'}) {
3578: $result .= &mt
3579: ('[_1] Kerberos authenticated with domain [_2] '.
3580: '[_3] Version 4 [_4]',
3581: '<label>'.$authtype,
3582: '</label><input type="text" size="10" name="krbarg" '.
3583: 'value="'.$krbarg.'" '.
1.1259 raeburn 3584: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3585: '<label><input type="hidden" name="krbver" value="4" />',
3586: '</label>');
3587: } elsif ($can_assign{'krb5'}) {
3588: $result .= &mt
3589: ('[_1] Kerberos authenticated with domain [_2] '.
3590: '[_3] Version 5 [_4]',
3591: '<label>'.$authtype,
3592: '</label><input type="text" size="10" name="krbarg" '.
3593: 'value="'.$krbarg.'" '.
1.1259 raeburn 3594: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3595: '<label><input type="hidden" name="krbver" value="5" />',
3596: '</label>');
3597: }
1.32 matthew 3598: return $result;
3599: }
3600:
1.1106 raeburn 3601: sub authform_internal {
1.586 raeburn 3602: my %in = (
1.32 matthew 3603: formname => 'document.cu',
3604: kerb_def_dom => 'MSU.EDU',
3605: @_,
3606: );
1.1259 raeburn 3607: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3608: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3609: if ($in{'readonly'}) {
3610: $disabled = ' disabled="disabled"';
3611: }
1.591 raeburn 3612: if (defined($in{'curr_authtype'})) {
3613: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3614: if ($can_assign{'int'}) {
1.772 bisitz 3615: $intcheck = 'checked="checked" ';
1.623 raeburn 3616: if (defined($in{'mode'})) {
3617: if ($in{'mode'} eq 'modifyuser') {
3618: $intcheck = '';
3619: }
3620: }
1.591 raeburn 3621: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3622: $intarg = $in{'curr_autharg'};
3623: }
3624: } else {
3625: $result = &mt('Currently internally authenticated.');
3626: return $result;
1.165 raeburn 3627: }
3628: }
1.586 raeburn 3629: } else {
3630: if ($authnum == 1) {
1.784 bisitz 3631: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3632: }
3633: }
3634: if (!$can_assign{'int'}) {
3635: return;
1.587 raeburn 3636: } elsif ($authtype eq '') {
1.591 raeburn 3637: if (defined($in{'mode'})) {
1.587 raeburn 3638: if ($in{'mode'} eq 'modifycourse') {
3639: if ($authnum == 1) {
1.1259 raeburn 3640: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3641: }
3642: }
3643: }
1.165 raeburn 3644: }
1.586 raeburn 3645: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3646: if ($authtype eq '') {
3647: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3648: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3649: }
1.605 bisitz 3650: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3651: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3652: $result = &mt
1.144 matthew 3653: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3654: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3655: $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 3656: return $result;
3657: }
3658:
1.1104 raeburn 3659: sub authform_local {
1.32 matthew 3660: my %in = (
3661: formname => 'document.cu',
3662: kerb_def_dom => 'MSU.EDU',
3663: @_,
3664: );
1.1259 raeburn 3665: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3666: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3667: if ($in{'readonly'}) {
3668: $disabled = ' disabled="disabled"';
3669: }
1.591 raeburn 3670: if (defined($in{'curr_authtype'})) {
3671: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3672: if ($can_assign{'loc'}) {
1.772 bisitz 3673: $loccheck = 'checked="checked" ';
1.623 raeburn 3674: if (defined($in{'mode'})) {
3675: if ($in{'mode'} eq 'modifyuser') {
3676: $loccheck = '';
3677: }
3678: }
1.591 raeburn 3679: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3680: $locarg = $in{'curr_autharg'};
3681: }
3682: } else {
3683: $result = &mt('Currently using local (institutional) authentication.');
3684: return $result;
1.165 raeburn 3685: }
3686: }
1.586 raeburn 3687: } else {
3688: if ($authnum == 1) {
1.784 bisitz 3689: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3690: }
3691: }
3692: if (!$can_assign{'loc'}) {
3693: return;
1.587 raeburn 3694: } elsif ($authtype eq '') {
1.591 raeburn 3695: if (defined($in{'mode'})) {
1.587 raeburn 3696: if ($in{'mode'} eq 'modifycourse') {
3697: if ($authnum == 1) {
1.1259 raeburn 3698: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3699: }
3700: }
3701: }
1.165 raeburn 3702: }
1.586 raeburn 3703: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3704: if ($authtype eq '') {
3705: $authtype = '<input type="radio" name="login" value="loc" '.
3706: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3707: $jscall.'"'.$disabled.' />';
1.586 raeburn 3708: }
3709: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3710: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3711: $result = &mt('[_1] Local Authentication with argument [_2]',
3712: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3713: return $result;
3714: }
3715:
1.1106 raeburn 3716: sub authform_filesystem {
1.32 matthew 3717: my %in = (
3718: formname => 'document.cu',
3719: kerb_def_dom => 'MSU.EDU',
3720: @_,
3721: );
1.1259 raeburn 3722: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3723: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3724: if ($in{'readonly'}) {
3725: $disabled = ' disabled="disabled"';
3726: }
1.591 raeburn 3727: if (defined($in{'curr_authtype'})) {
3728: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3729: if ($can_assign{'fsys'}) {
1.772 bisitz 3730: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3731: if (defined($in{'mode'})) {
3732: if ($in{'mode'} eq 'modifyuser') {
3733: $fsyscheck = '';
3734: }
3735: }
1.586 raeburn 3736: } else {
3737: $result = &mt('Currently Filesystem Authenticated.');
3738: return $result;
1.1259 raeburn 3739: }
1.586 raeburn 3740: }
3741: } else {
3742: if ($authnum == 1) {
1.784 bisitz 3743: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3744: }
3745: }
3746: if (!$can_assign{'fsys'}) {
3747: return;
1.587 raeburn 3748: } elsif ($authtype eq '') {
1.591 raeburn 3749: if (defined($in{'mode'})) {
1.587 raeburn 3750: if ($in{'mode'} eq 'modifycourse') {
3751: if ($authnum == 1) {
1.1259 raeburn 3752: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3753: }
3754: }
3755: }
1.586 raeburn 3756: }
3757: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3758: if ($authtype eq '') {
3759: $authtype = '<input type="radio" name="login" value="fsys" '.
3760: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3761: $jscall.'"'.$disabled.' />';
1.586 raeburn 3762: }
1.1310 raeburn 3763: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3764: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3765: $result = &mt
1.144 matthew 3766: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3767: '<label>'.$authtype,'</label>'.$autharg);
3768: return $result;
3769: }
3770:
3771: sub authform_lti {
3772: my %in = (
3773: formname => 'document.cu',
3774: kerb_def_dom => 'MSU.EDU',
3775: @_,
3776: );
3777: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3778: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3779: if ($in{'readonly'}) {
3780: $disabled = ' disabled="disabled"';
3781: }
3782: if (defined($in{'curr_authtype'})) {
3783: if ($in{'curr_authtype'} eq 'lti') {
3784: if ($can_assign{'lti'}) {
3785: $lticheck = 'checked="checked" ';
3786: if (defined($in{'mode'})) {
3787: if ($in{'mode'} eq 'modifyuser') {
3788: $lticheck = '';
3789: }
3790: }
3791: } else {
3792: $result = &mt('Currently LTI Authenticated.');
3793: return $result;
3794: }
3795: }
3796: } else {
3797: if ($authnum == 1) {
3798: $authtype = '<input type="hidden" name="login" value="lti" />';
3799: }
3800: }
3801: if (!$can_assign{'lti'}) {
3802: return;
3803: } elsif ($authtype eq '') {
3804: if (defined($in{'mode'})) {
3805: if ($in{'mode'} eq 'modifycourse') {
3806: if ($authnum == 1) {
3807: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3808: }
3809: }
3810: }
3811: }
3812: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3813: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3814: $authtype = '<input type="radio" name="login" value="lti" '.
3815: $lticheck.' onchange="'.$jscall.'" onclick="'.
3816: $jscall.'"'.$disabled.' />';
3817: }
3818: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3819: if ($authtype) {
3820: $result = &mt('[_1] LTI Authenticated',
3821: '<label>'.$authtype.'</label>'.$autharg);
3822: } else {
3823: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3824: $autharg;
3825: }
1.32 matthew 3826: return $result;
3827: }
3828:
1.586 raeburn 3829: sub get_assignable_auth {
3830: my ($dom) = @_;
3831: if ($dom eq '') {
3832: $dom = $env{'request.role.domain'};
3833: }
3834: my %can_assign = (
3835: krb4 => 1,
3836: krb5 => 1,
3837: int => 1,
3838: loc => 1,
1.1310 raeburn 3839: lti => 1,
1.586 raeburn 3840: );
3841: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3842: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3843: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3844: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3845: my $context;
3846: if ($env{'request.role'} =~ /^au/) {
3847: $context = 'author';
1.1259 raeburn 3848: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3849: $context = 'domain';
3850: } elsif ($env{'request.course.id'}) {
3851: $context = 'course';
3852: }
3853: if ($context) {
3854: if (ref($authhash->{$context}) eq 'HASH') {
3855: %can_assign = %{$authhash->{$context}};
3856: }
3857: }
3858: }
3859: }
3860: my $authnum = 0;
3861: foreach my $key (keys(%can_assign)) {
3862: if ($can_assign{$key}) {
3863: $authnum ++;
3864: }
3865: }
3866: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3867: $authnum --;
3868: }
3869: return ($authnum,%can_assign);
3870: }
3871:
1.1331 raeburn 3872: sub check_passwd_rules {
3873: my ($domain,$plainpass) = @_;
3874: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3875: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3876: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3877: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3878: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3879: if ($passwdconf{'min'} > $min) {
3880: $min = $passwdconf{'min'};
3881: }
1.1331 raeburn 3882: }
3883: if ($passwdconf{'max'} =~ /^\d+$/) {
3884: $max = $passwdconf{'max'};
3885: }
3886: @chars = @{$passwdconf{'chars'}};
3887: }
3888: if (($min) && (length($plainpass) < $min)) {
3889: push(@brokerule,'min');
3890: }
3891: if (($max) && (length($plainpass) > $max)) {
3892: push(@brokerule,'max');
3893: }
3894: if (@chars) {
3895: my %rules;
3896: map { $rules{$_} = 1; } @chars;
3897: if ($rules{'uc'}) {
3898: unless ($plainpass =~ /[A-Z]/) {
3899: push(@brokerule,'uc');
3900: }
3901: }
3902: if ($rules{'lc'}) {
1.1332 raeburn 3903: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3904: push(@brokerule,'lc');
3905: }
3906: }
3907: if ($rules{'num'}) {
3908: unless ($plainpass =~ /\d/) {
3909: push(@brokerule,'num');
3910: }
3911: }
3912: if ($rules{'spec'}) {
3913: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3914: push(@brokerule,'spec');
3915: }
3916: }
3917: }
3918: if (@brokerule) {
3919: my %rulenames = &Apache::lonlocal::texthash(
3920: uc => 'At least one upper case letter',
3921: lc => 'At least one lower case letter',
3922: num => 'At least one number',
3923: spec => 'At least one non-alphanumeric',
3924: );
3925: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3926: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3927: $rulenames{'num'} .= ': 0123456789';
3928: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3929: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3930: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3931: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3932: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3933: if (grep(/^$rule$/,@brokerule)) {
3934: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3935: }
3936: }
3937: $warning .= '</ul>';
3938: }
1.1332 raeburn 3939: if (wantarray) {
3940: return @brokerule;
3941: }
1.1331 raeburn 3942: return $warning;
3943: }
3944:
1.1376 raeburn 3945: sub passwd_validation_js {
1.1377 raeburn 3946: my ($currpasswdval,$domain,$context,$id) = @_;
3947: my (%passwdconf,$alertmsg);
3948: if ($context eq 'linkprot') {
3949: my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3950: if (ref($domconfig{'ltisec'}) eq 'HASH') {
3951: if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3952: %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3953: }
3954: }
3955: if ($id eq 'add') {
3956: $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3957: } elsif ($id =~ /^\d+$/) {
3958: my $pos = $id+1;
3959: $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3960: } else {
3961: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3962: }
1.1434 raeburn 3963: } elsif ($context eq 'ltitools') {
3964: my %domconfig = &Apache::lonnet::get_dom('configuration',['toolsec'],$domain);
3965: if (ref($domconfig{'toolsec'}) eq 'HASH') {
3966: if (ref($domconfig{'toolsec'}{'rules'}) eq 'HASH') {
3967: %passwdconf = %{$domconfig{'toolsec'}{'rules'}};
3968: }
3969: }
3970: if ($id eq 'add') {
3971: $alertmsg = &mt('Secret for added external tool did not satisfy requirement(s):').'\n\n';
3972: } elsif ($id =~ /^\d+$/) {
3973: my $pos = $id+1;
3974: $alertmsg = &mt('Secret for external tool [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3975: } else {
3976: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3977: }
1.1377 raeburn 3978: } else {
3979: %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3980: $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3981: }
1.1376 raeburn 3982: my ($min,$max,@chars,$numrules,$intargjs,%alert);
3983: $numrules = 0;
3984: $min = $Apache::lonnet::passwdmin;
3985: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3986: if ($passwdconf{'min'} =~ /^\d+$/) {
3987: if ($passwdconf{'min'} > $min) {
3988: $min = $passwdconf{'min'};
3989: }
3990: }
3991: if ($passwdconf{'max'} =~ /^\d+$/) {
3992: $max = $passwdconf{'max'};
3993: $numrules ++;
3994: }
3995: @chars = @{$passwdconf{'chars'}};
3996: if (@chars) {
3997: $numrules ++;
3998: }
3999: }
4000: if ($min > 0) {
4001: $numrules ++;
4002: }
4003: if (($min > 0) || ($max ne '') || (@chars > 0)) {
4004: if ($min) {
4005: $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
4006: }
4007: if ($max) {
4008: $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
4009: }
4010: my (@charalerts,@charrules);
4011: if (@chars) {
4012: if (grep(/^uc$/,@chars)) {
4013: push(@charalerts,&mt('contain at least one upper case letter'));
4014: push(@charrules,'uc');
4015: }
4016: if (grep(/^lc$/,@chars)) {
4017: push(@charalerts,&mt('contain at least one lower case letter'));
4018: push(@charrules,'lc');
4019: }
4020: if (grep(/^num$/,@chars)) {
4021: push(@charalerts,&mt('contain at least one number'));
4022: push(@charrules,'num');
4023: }
4024: if (grep(/^spec$/,@chars)) {
4025: push(@charalerts,&mt('contain at least one non-alphanumeric'));
4026: push(@charrules,'spec');
4027: }
4028: }
4029: $intargjs = qq| var rulesmsg = '';\n|.
4030: qq| var currpwval = $currpasswdval;\n|;
4031: if ($min) {
4032: $intargjs .= qq|
4033: if (currpwval.length < $min) {
4034: rulesmsg += ' - $alert{min}';
4035: }
4036: |;
4037: }
4038: if ($max) {
4039: $intargjs .= qq|
4040: if (currpwval.length > $max) {
4041: rulesmsg += ' - $alert{max}';
4042: }
4043: |;
4044: }
4045: if (@chars > 0) {
4046: my $charrulestr = '"'.join('","',@charrules).'"';
4047: my $charalertstr = '"'.join('","',@charalerts).'"';
4048: $intargjs .= qq| var brokerules = new Array();\n|.
4049: qq| var charrules = new Array($charrulestr);\n|.
4050: qq| var charalerts = new Array($charalertstr);\n|;
4051: my %rules;
4052: map { $rules{$_} = 1; } @chars;
4053: if ($rules{'uc'}) {
4054: $intargjs .= qq|
4055: var ucRegExp = /[A-Z]/;
4056: if (!ucRegExp.test(currpwval)) {
4057: brokerules.push('uc');
4058: }
4059: |;
4060: }
4061: if ($rules{'lc'}) {
4062: $intargjs .= qq|
4063: var lcRegExp = /[a-z]/;
4064: if (!lcRegExp.test(currpwval)) {
4065: brokerules.push('lc');
4066: }
4067: |;
4068: }
4069: if ($rules{'num'}) {
4070: $intargjs .= qq|
4071: var numRegExp = /[0-9]/;
4072: if (!numRegExp.test(currpwval)) {
4073: brokerules.push('num');
4074: }
4075: |;
4076: }
4077: if ($rules{'spec'}) {
4078: $intargjs .= q|
4079: var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
4080: if (!specRegExp.test(currpwval)) {
4081: brokerules.push('spec');
4082: }
4083: |;
4084: }
4085: $intargjs .= qq|
4086: if (brokerules.length > 0) {
4087: for (var i=0; i<brokerules.length; i++) {
4088: for (var j=0; j<charrules.length; j++) {
4089: if (brokerules[i] == charrules[j]) {
4090: rulesmsg += ' - '+charalerts[j]+'\\n';
4091: break;
4092: }
4093: }
4094: }
4095: }
4096: |;
4097: }
4098: $intargjs .= qq|
4099: if (rulesmsg != '') {
4100: rulesmsg = '$alertmsg'+rulesmsg;
4101: alert(rulesmsg);
4102: return false;
4103: }
4104: |;
4105: }
4106: return ($numrules,$intargjs);
4107: }
4108:
1.80 albertel 4109: ###############################################################
4110: ## Get Kerberos Defaults for Domain ##
4111: ###############################################################
4112: ##
4113: ## Returns default kerberos version and an associated argument
4114: ## as listed in file domain.tab. If not listed, provides
4115: ## appropriate default domain and kerberos version.
4116: ##
4117: #-------------------------------------------
4118:
4119: =pod
4120:
1.648 raeburn 4121: =item * &get_kerberos_defaults()
1.80 albertel 4122:
4123: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 4124: version and domain. If not found, it defaults to version 4 and the
4125: domain of the server.
1.80 albertel 4126:
1.648 raeburn 4127: =over 4
4128:
1.80 albertel 4129: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
4130:
1.648 raeburn 4131: =back
4132:
4133: =back
4134:
1.80 albertel 4135: =cut
4136:
4137: #-------------------------------------------
4138: sub get_kerberos_defaults {
4139: my $domain=shift;
1.641 raeburn 4140: my ($krbdef,$krbdefdom);
4141: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
4142: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
4143: $krbdef = $domdefaults{'auth_def'};
4144: $krbdefdom = $domdefaults{'auth_arg_def'};
4145: } else {
1.80 albertel 4146: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
4147: my $krbdefdom=$1;
4148: $krbdefdom=~tr/a-z/A-Z/;
4149: $krbdef = "krb4";
4150: }
4151: return ($krbdef,$krbdefdom);
4152: }
1.112 bowersj2 4153:
1.32 matthew 4154:
1.46 matthew 4155: ###############################################################
4156: ## Thesaurus Functions ##
4157: ###############################################################
1.20 www 4158:
1.46 matthew 4159: =pod
1.20 www 4160:
1.112 bowersj2 4161: =head1 Thesaurus Functions
4162:
4163: =over 4
4164:
1.648 raeburn 4165: =item * &initialize_keywords()
1.46 matthew 4166:
4167: Initializes the package variable %Keywords if it is empty. Uses the
4168: package variable $thesaurus_db_file.
4169:
4170: =cut
4171:
4172: ###################################################
4173:
4174: sub initialize_keywords {
4175: return 1 if (scalar keys(%Keywords));
4176: # If we are here, %Keywords is empty, so fill it up
4177: # Make sure the file we need exists...
4178: if (! -e $thesaurus_db_file) {
4179: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
4180: " failed because it does not exist");
4181: return 0;
4182: }
4183: # Set up the hash as a database
4184: my %thesaurus_db;
4185: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4186: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4187: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
4188: $thesaurus_db_file);
4189: return 0;
4190: }
4191: # Get the average number of appearances of a word.
4192: my $avecount = $thesaurus_db{'average.count'};
4193: # Put keywords (those that appear > average) into %Keywords
4194: while (my ($word,$data)=each (%thesaurus_db)) {
4195: my ($count,undef) = split /:/,$data;
4196: $Keywords{$word}++ if ($count > $avecount);
4197: }
4198: untie %thesaurus_db;
4199: # Remove special values from %Keywords.
1.356 albertel 4200: foreach my $value ('total.count','average.count') {
4201: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 4202: }
1.46 matthew 4203: return 1;
4204: }
4205:
4206: ###################################################
4207:
4208: =pod
4209:
1.648 raeburn 4210: =item * &keyword($word)
1.46 matthew 4211:
4212: Returns true if $word is a keyword. A keyword is a word that appears more
4213: than the average number of times in the thesaurus database. Calls
4214: &initialize_keywords
4215:
4216: =cut
4217:
4218: ###################################################
1.20 www 4219:
4220: sub keyword {
1.46 matthew 4221: return if (!&initialize_keywords());
4222: my $word=lc(shift());
4223: $word=~s/\W//g;
4224: return exists($Keywords{$word});
1.20 www 4225: }
1.46 matthew 4226:
4227: ###############################################################
4228:
4229: =pod
1.20 www 4230:
1.648 raeburn 4231: =item * &get_related_words()
1.46 matthew 4232:
1.160 matthew 4233: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 4234: an array of words. If the keyword is not in the thesaurus, an empty array
4235: will be returned. The order of the words returned is determined by the
4236: database which holds them.
4237:
4238: Uses global $thesaurus_db_file.
4239:
1.1057 foxr 4240:
1.46 matthew 4241: =cut
4242:
4243: ###############################################################
4244: sub get_related_words {
4245: my $keyword = shift;
4246: my %thesaurus_db;
4247: if (! -e $thesaurus_db_file) {
4248: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
4249: "failed because the file does not exist");
4250: return ();
4251: }
4252: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 4253: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 4254: return ();
4255: }
4256: my @Words=();
1.429 www 4257: my $count=0;
1.46 matthew 4258: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 4259: # The first element is the number of times
4260: # the word appears. We do not need it now.
1.429 www 4261: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
4262: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
4263: my $threshold=$mostfrequentcount/10;
4264: foreach my $possibleword (@RelatedWords) {
4265: my ($word,$wordcount)=split(/\,/,$possibleword);
4266: if ($wordcount>$threshold) {
4267: push(@Words,$word);
4268: $count++;
4269: if ($count>10) { last; }
4270: }
1.20 www 4271: }
4272: }
1.46 matthew 4273: untie %thesaurus_db;
4274: return @Words;
1.14 harris41 4275: }
1.1090 foxr 4276: ###############################################################
4277: #
4278: # Spell checking
4279: #
4280:
4281: =pod
4282:
1.1142 raeburn 4283: =back
4284:
1.1090 foxr 4285: =head1 Spell checking
4286:
4287: =over 4
4288:
4289: =item * &check_spelling($wordlist $language)
4290:
4291: Takes a string containing words and feeds it to an external
4292: spellcheck program via a pipeline. Returns a string containing
4293: them mis-spelled words.
4294:
4295: Parameters:
4296:
4297: =over 4
4298:
4299: =item - $wordlist
4300:
4301: String that will be fed into the spellcheck program.
4302:
4303: =item - $language
4304:
4305: Language string that specifies the language for which the spell
4306: check will be performed.
4307:
4308: =back
4309:
4310: =back
4311:
4312: Note: This sub assumes that aspell is installed.
4313:
4314:
4315: =cut
4316:
1.46 matthew 4317:
1.1090 foxr 4318: sub check_spelling {
4319: my ($wordlist, $language) = @_;
1.1091 foxr 4320: my @misspellings;
4321:
4322: # Generate the speller and set the langauge.
4323: # if explicitly selected:
1.1090 foxr 4324:
1.1091 foxr 4325: my $speller = Text::Aspell->new;
1.1090 foxr 4326: if ($language) {
1.1091 foxr 4327: $speller->set_option('lang', $language);
1.1090 foxr 4328: }
4329:
1.1091 foxr 4330: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 4331:
1.1091 foxr 4332: my @words = split(/\s+/, $wordlist);
1.1090 foxr 4333:
1.1091 foxr 4334: foreach my $word (@words) {
4335: if(! $speller->check($word)) {
4336: push(@misspellings, $word);
1.1090 foxr 4337: }
4338: }
1.1091 foxr 4339: return join(' ', @misspellings);
4340:
1.1090 foxr 4341: }
4342:
1.61 www 4343: # -------------------------------------------------------------- Plaintext name
1.81 albertel 4344: =pod
4345:
1.112 bowersj2 4346: =head1 User Name Functions
4347:
4348: =over 4
4349:
1.648 raeburn 4350: =item * &plainname($uname,$udom,$first)
1.81 albertel 4351:
1.112 bowersj2 4352: Takes a users logon name and returns it as a string in
1.226 albertel 4353: "first middle last generation" form
4354: if $first is set to 'lastname' then it returns it as
4355: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 4356:
4357: =cut
1.61 www 4358:
1.295 www 4359:
1.81 albertel 4360: ###############################################################
1.61 www 4361: sub plainname {
1.226 albertel 4362: my ($uname,$udom,$first)=@_;
1.537 albertel 4363: return if (!defined($uname) || !defined($udom));
1.295 www 4364: my %names=&getnames($uname,$udom);
1.226 albertel 4365: my $name=&Apache::lonnet::format_name($names{'firstname'},
4366: $names{'middlename'},
4367: $names{'lastname'},
4368: $names{'generation'},$first);
4369: $name=~s/^\s+//;
1.62 www 4370: $name=~s/\s+$//;
4371: $name=~s/\s+/ /g;
1.353 albertel 4372: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 4373: return $name;
1.61 www 4374: }
1.66 www 4375:
4376: # -------------------------------------------------------------------- Nickname
1.81 albertel 4377: =pod
4378:
1.648 raeburn 4379: =item * &nickname($uname,$udom)
1.81 albertel 4380:
4381: Gets a users name and returns it as a string as
4382:
4383: ""nickname""
1.66 www 4384:
1.81 albertel 4385: if the user has a nickname or
4386:
4387: "first middle last generation"
4388:
4389: if the user does not
4390:
4391: =cut
1.66 www 4392:
4393: sub nickname {
4394: my ($uname,$udom)=@_;
1.537 albertel 4395: return if (!defined($uname) || !defined($udom));
1.295 www 4396: my %names=&getnames($uname,$udom);
1.68 albertel 4397: my $name=$names{'nickname'};
1.66 www 4398: if ($name) {
4399: $name='"'.$name.'"';
4400: } else {
4401: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
4402: $names{'lastname'}.' '.$names{'generation'};
4403: $name=~s/\s+$//;
4404: $name=~s/\s+/ /g;
4405: }
4406: return $name;
4407: }
4408:
1.295 www 4409: sub getnames {
4410: my ($uname,$udom)=@_;
1.537 albertel 4411: return if (!defined($uname) || !defined($udom));
1.433 albertel 4412: if ($udom eq 'public' && $uname eq 'public') {
4413: return ('lastname' => &mt('Public'));
4414: }
1.295 www 4415: my $id=$uname.':'.$udom;
4416: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
4417: if ($cached) {
4418: return %{$names};
4419: } else {
4420: my %loadnames=&Apache::lonnet::get('environment',
4421: ['firstname','middlename','lastname','generation','nickname'],
4422: $udom,$uname);
4423: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
4424: return %loadnames;
4425: }
4426: }
1.61 www 4427:
1.542 raeburn 4428: # -------------------------------------------------------------------- getemails
1.648 raeburn 4429:
1.542 raeburn 4430: =pod
4431:
1.648 raeburn 4432: =item * &getemails($uname,$udom)
1.542 raeburn 4433:
4434: Gets a user's email information and returns it as a hash with keys:
4435: notification, critnotification, permanentemail
4436:
4437: For notification and critnotification, values are comma-separated lists
1.648 raeburn 4438: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 4439:
1.648 raeburn 4440:
1.542 raeburn 4441: =cut
4442:
1.648 raeburn 4443:
1.466 albertel 4444: sub getemails {
4445: my ($uname,$udom)=@_;
4446: if ($udom eq 'public' && $uname eq 'public') {
4447: return;
4448: }
1.467 www 4449: if (!$udom) { $udom=$env{'user.domain'}; }
4450: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 4451: my $id=$uname.':'.$udom;
4452: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
4453: if ($cached) {
4454: return %{$names};
4455: } else {
4456: my %loadnames=&Apache::lonnet::get('environment',
4457: ['notification','critnotification',
4458: 'permanentemail'],
4459: $udom,$uname);
4460: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4461: return %loadnames;
4462: }
4463: }
4464:
1.551 albertel 4465: sub flush_email_cache {
4466: my ($uname,$udom)=@_;
4467: if (!$udom) { $udom =$env{'user.domain'}; }
4468: if (!$uname) { $uname=$env{'user.name'}; }
4469: return if ($udom eq 'public' && $uname eq 'public');
4470: my $id=$uname.':'.$udom;
4471: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4472: }
4473:
1.728 raeburn 4474: # -------------------------------------------------------------------- getlangs
4475:
4476: =pod
4477:
4478: =item * &getlangs($uname,$udom)
4479:
4480: Gets a user's language preference and returns it as a hash with key:
4481: language.
4482:
4483: =cut
4484:
4485:
4486: sub getlangs {
4487: my ($uname,$udom) = @_;
4488: if (!$udom) { $udom =$env{'user.domain'}; }
4489: if (!$uname) { $uname=$env{'user.name'}; }
4490: my $id=$uname.':'.$udom;
4491: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4492: if ($cached) {
4493: return %{$langs};
4494: } else {
4495: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4496: $udom,$uname);
4497: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4498: return %loadlangs;
4499: }
4500: }
4501:
4502: sub flush_langs_cache {
4503: my ($uname,$udom)=@_;
4504: if (!$udom) { $udom =$env{'user.domain'}; }
4505: if (!$uname) { $uname=$env{'user.name'}; }
4506: return if ($udom eq 'public' && $uname eq 'public');
4507: my $id=$uname.':'.$udom;
4508: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4509: }
4510:
1.61 www 4511: # ------------------------------------------------------------------ Screenname
1.81 albertel 4512:
4513: =pod
4514:
1.648 raeburn 4515: =item * &screenname($uname,$udom)
1.81 albertel 4516:
4517: Gets a users screenname and returns it as a string
4518:
4519: =cut
1.61 www 4520:
4521: sub screenname {
4522: my ($uname,$udom)=@_;
1.258 albertel 4523: if ($uname eq $env{'user.name'} &&
4524: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4525: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4526: return $names{'screenname'};
1.62 www 4527: }
4528:
1.212 albertel 4529:
1.802 bisitz 4530: # ------------------------------------------------------------- Confirm Wrapper
4531: =pod
4532:
1.1142 raeburn 4533: =item * &confirmwrapper($message)
1.802 bisitz 4534:
4535: Wrap messages about completion of operation in box
4536:
4537: =cut
4538:
4539: sub confirmwrapper {
4540: my ($message)=@_;
4541: if ($message) {
4542: return "\n".'<div class="LC_confirm_box">'."\n"
4543: .$message."\n"
4544: .'</div>'."\n";
4545: } else {
4546: return $message;
4547: }
4548: }
4549:
1.62 www 4550: # ------------------------------------------------------------- Message Wrapper
4551:
4552: sub messagewrapper {
1.369 www 4553: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4554: return
1.441 albertel 4555: '<a href="/adm/email?compose=individual&'.
4556: 'recname='.$username.'&recdom='.$domain.
4557: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4558: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4559: }
1.802 bisitz 4560:
1.74 www 4561: # --------------------------------------------------------------- Notes Wrapper
4562:
4563: sub noteswrapper {
4564: my ($link,$un,$do)=@_;
4565: return
1.896 amueller 4566: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4567: }
1.802 bisitz 4568:
1.62 www 4569: # ------------------------------------------------------------- Aboutme Wrapper
4570:
4571: sub aboutmewrapper {
1.1070 raeburn 4572: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4573: if (!defined($username) && !defined($domain)) {
4574: return;
4575: }
1.1096 raeburn 4576: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4577: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4578: }
4579:
4580: # ------------------------------------------------------------ Syllabus Wrapper
4581:
4582: sub syllabuswrapper {
1.707 bisitz 4583: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4584: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4585: }
1.14 harris41 4586:
1.1397 raeburn 4587: # -----------------------------------------------------------------------------
4588:
1.1396 raeburn 4589: sub aboutme_on {
4590: my ($uname,$udom)=@_;
4591: unless ($uname) { $uname=$env{'user.name'}; }
4592: unless ($udom) { $udom=$env{'user.domain'}; }
4593: return if ($udom eq 'public' && $uname eq 'public');
4594: my $hashkey=$uname.':'.$udom;
4595: my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
4596: if ($cached) {
4597: return $aboutme;
4598: }
4599: $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
4600: &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
4601: return $aboutme;
4602: }
4603:
4604: sub devalidate_aboutme_cache {
4605: my ($uname,$udom)=@_;
4606: if (!$udom) { $udom =$env{'user.domain'}; }
4607: if (!$uname) { $uname=$env{'user.name'}; }
4608: return if ($udom eq 'public' && $uname eq 'public');
4609: my $id=$uname.':'.$udom;
4610: &Apache::lonnet::devalidate_cache_new('aboutme',$id);
4611: }
4612:
1.208 matthew 4613: sub track_student_link {
1.887 raeburn 4614: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4615: my $link ="/adm/trackstudent?";
1.208 matthew 4616: my $title = 'View recent activity';
4617: if (defined($sname) && $sname !~ /^\s*$/ &&
4618: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4619: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4620: $title .= ' of this student';
1.268 albertel 4621: }
1.208 matthew 4622: if (defined($target) && $target !~ /^\s*$/) {
4623: $target = qq{target="$target"};
4624: } else {
4625: $target = '';
4626: }
1.268 albertel 4627: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4628: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4629: $title = &mt($title);
4630: $linktext = &mt($linktext);
1.448 albertel 4631: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4632: &help_open_topic('View_recent_activity');
1.208 matthew 4633: }
4634:
1.781 raeburn 4635: sub slot_reservations_link {
4636: my ($linktext,$sname,$sdom,$target) = @_;
4637: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4638: my $title = 'View slot reservation history';
4639: if (defined($sname) && $sname !~ /^\s*$/ &&
4640: defined($sdom) && $sdom !~ /^\s*$/) {
4641: $link .= "&uname=$sname&udom=$sdom";
4642: $title .= ' of this student';
4643: }
4644: if (defined($target) && $target !~ /^\s*$/) {
4645: $target = qq{target="$target"};
4646: } else {
4647: $target = '';
4648: }
4649: $title = &mt($title);
4650: $linktext = &mt($linktext);
4651: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4652: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4653:
4654: }
4655:
1.508 www 4656: # ===================================================== Display a student photo
4657:
4658:
1.509 albertel 4659: sub student_image_tag {
1.508 www 4660: my ($domain,$user)=@_;
4661: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4662: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4663: return '<img src="'.$imgsrc.'" align="right" />';
4664: } else {
4665: return '';
4666: }
4667: }
4668:
1.112 bowersj2 4669: =pod
4670:
4671: =back
4672:
4673: =head1 Access .tab File Data
4674:
4675: =over 4
4676:
1.648 raeburn 4677: =item * &languageids()
1.112 bowersj2 4678:
4679: returns list of all language ids
4680:
4681: =cut
4682:
1.14 harris41 4683: sub languageids {
1.16 harris41 4684: return sort(keys(%language));
1.14 harris41 4685: }
4686:
1.112 bowersj2 4687: =pod
4688:
1.648 raeburn 4689: =item * &languagedescription()
1.112 bowersj2 4690:
4691: returns description of a specified language id
4692:
4693: =cut
4694:
1.14 harris41 4695: sub languagedescription {
1.125 www 4696: my $code=shift;
4697: return ($supported_language{$code}?'* ':'').
4698: $language{$code}.
1.126 www 4699: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4700: }
4701:
1.1048 foxr 4702: =pod
4703:
4704: =item * &plainlanguagedescription
4705:
4706: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4707: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4708:
4709: =cut
4710:
1.145 www 4711: sub plainlanguagedescription {
4712: my $code=shift;
4713: return $language{$code};
4714: }
4715:
1.1048 foxr 4716: =pod
4717:
4718: =item * &supportedlanguagecode
4719:
4720: Returns the supported language code (e.g. sptutf maps to pt) given a language
4721: code.
4722:
4723: =cut
4724:
1.145 www 4725: sub supportedlanguagecode {
4726: my $code=shift;
4727: return $supported_language{$code};
1.97 www 4728: }
4729:
1.112 bowersj2 4730: =pod
4731:
1.1048 foxr 4732: =item * &latexlanguage()
4733:
4734: Given a language key code returns the correspondnig language to use
4735: to select the correct hyphenation on LaTeX printouts. This is undef if there
4736: is no supported hyphenation for the language code.
4737:
4738: =cut
4739:
4740: sub latexlanguage {
4741: my $code = shift;
4742: return $latex_language{$code};
4743: }
4744:
4745: =pod
4746:
4747: =item * &latexhyphenation()
4748:
4749: Same as above but what's supplied is the language as it might be stored
4750: in the metadata.
4751:
4752: =cut
4753:
4754: sub latexhyphenation {
4755: my $key = shift;
4756: return $latex_language_bykey{$key};
4757: }
4758:
4759: =pod
4760:
1.648 raeburn 4761: =item * ©rightids()
1.112 bowersj2 4762:
4763: returns list of all copyrights
4764:
4765: =cut
4766:
4767: sub copyrightids {
4768: return sort(keys(%cprtag));
4769: }
4770:
4771: =pod
4772:
1.648 raeburn 4773: =item * ©rightdescription()
1.112 bowersj2 4774:
4775: returns description of a specified copyright id
4776:
4777: =cut
4778:
4779: sub copyrightdescription {
1.166 www 4780: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4781: }
1.197 matthew 4782:
4783: =pod
4784:
1.648 raeburn 4785: =item * &source_copyrightids()
1.192 taceyjo1 4786:
4787: returns list of all source copyrights
4788:
4789: =cut
4790:
4791: sub source_copyrightids {
4792: return sort(keys(%scprtag));
4793: }
4794:
4795: =pod
4796:
1.648 raeburn 4797: =item * &source_copyrightdescription()
1.192 taceyjo1 4798:
4799: returns description of a specified source copyright id
4800:
4801: =cut
4802:
4803: sub source_copyrightdescription {
4804: return &mt($scprtag{shift(@_)});
4805: }
1.112 bowersj2 4806:
4807: =pod
4808:
1.648 raeburn 4809: =item * &filecategories()
1.112 bowersj2 4810:
4811: returns list of all file categories
4812:
4813: =cut
4814:
4815: sub filecategories {
4816: return sort(keys(%category_extensions));
4817: }
4818:
4819: =pod
4820:
1.648 raeburn 4821: =item * &filecategorytypes()
1.112 bowersj2 4822:
4823: returns list of file types belonging to a given file
4824: category
4825:
4826: =cut
4827:
4828: sub filecategorytypes {
1.356 albertel 4829: my ($cat) = @_;
1.1248 raeburn 4830: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4831: return @{$category_extensions{lc($cat)}};
4832: } else {
4833: return ();
4834: }
1.112 bowersj2 4835: }
4836:
4837: =pod
4838:
1.648 raeburn 4839: =item * &fileembstyle()
1.112 bowersj2 4840:
4841: returns embedding style for a specified file type
4842:
4843: =cut
4844:
4845: sub fileembstyle {
4846: return $fe{lc(shift(@_))};
1.169 www 4847: }
4848:
1.351 www 4849: sub filemimetype {
4850: return $fm{lc(shift(@_))};
4851: }
4852:
1.169 www 4853:
4854: sub filecategoryselect {
4855: my ($name,$value)=@_;
1.189 matthew 4856: return &select_form($value,$name,
1.970 raeburn 4857: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4858: }
4859:
4860: =pod
4861:
1.648 raeburn 4862: =item * &filedescription()
1.112 bowersj2 4863:
4864: returns description for a specified file type
4865:
4866: =cut
4867:
4868: sub filedescription {
1.188 matthew 4869: my $file_description = $fd{lc(shift())};
4870: $file_description =~ s:([\[\]]):~$1:g;
4871: return &mt($file_description);
1.112 bowersj2 4872: }
4873:
4874: =pod
4875:
1.648 raeburn 4876: =item * &filedescriptionex()
1.112 bowersj2 4877:
4878: returns description for a specified file type with
4879: extra formatting
4880:
4881: =cut
4882:
4883: sub filedescriptionex {
4884: my $ex=shift;
1.188 matthew 4885: my $file_description = $fd{lc($ex)};
4886: $file_description =~ s:([\[\]]):~$1:g;
4887: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4888: }
4889:
4890: # End of .tab access
4891: =pod
4892:
4893: =back
4894:
4895: =cut
4896:
4897: # ------------------------------------------------------------------ File Types
4898: sub fileextensions {
4899: return sort(keys(%fe));
4900: }
4901:
1.97 www 4902: # ----------------------------------------------------------- Display Languages
4903: # returns a hash with all desired display languages
4904: #
4905:
4906: sub display_languages {
4907: my %languages=();
1.695 raeburn 4908: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4909: $languages{$lang}=1;
1.97 www 4910: }
4911: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4912: if ($env{'form.displaylanguage'}) {
1.356 albertel 4913: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4914: $languages{$lang}=1;
1.97 www 4915: }
4916: }
4917: return %languages;
1.14 harris41 4918: }
4919:
1.582 albertel 4920: sub languages {
4921: my ($possible_langs) = @_;
1.695 raeburn 4922: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4923: if (!ref($possible_langs)) {
4924: if( wantarray ) {
4925: return @preferred_langs;
4926: } else {
4927: return $preferred_langs[0];
4928: }
4929: }
4930: my %possibilities = map { $_ => 1 } (@$possible_langs);
4931: my @preferred_possibilities;
4932: foreach my $preferred_lang (@preferred_langs) {
4933: if (exists($possibilities{$preferred_lang})) {
4934: push(@preferred_possibilities, $preferred_lang);
4935: }
4936: }
4937: if( wantarray ) {
4938: return @preferred_possibilities;
4939: }
4940: return $preferred_possibilities[0];
4941: }
4942:
1.742 raeburn 4943: sub user_lang {
4944: my ($touname,$toudom,$fromcid) = @_;
4945: my @userlangs;
4946: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4947: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4948: $env{'course.'.$fromcid.'.languages'}));
4949: } else {
4950: my %langhash = &getlangs($touname,$toudom);
4951: if ($langhash{'languages'} ne '') {
4952: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4953: } else {
4954: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4955: if ($domdefs{'lang_def'} ne '') {
4956: @userlangs = ($domdefs{'lang_def'});
4957: }
4958: }
4959: }
4960: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4961: my $user_lh = Apache::localize->get_handle(@languages);
4962: return $user_lh;
4963: }
4964:
4965:
1.112 bowersj2 4966: ###############################################################
4967: ## Student Answer Attempts ##
4968: ###############################################################
4969:
4970: =pod
4971:
4972: =head1 Alternate Problem Views
4973:
4974: =over 4
4975:
1.648 raeburn 4976: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4977: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4978:
4979: Return string with previous attempt on problem. Arguments:
4980:
4981: =over 4
4982:
4983: =item * $symb: Problem, including path
4984:
4985: =item * $username: username of the desired student
4986:
4987: =item * $domain: domain of the desired student
1.14 harris41 4988:
1.112 bowersj2 4989: =item * $course: Course ID
1.14 harris41 4990:
1.112 bowersj2 4991: =item * $getattempt: Leave blank for all attempts, otherwise put
4992: something
1.14 harris41 4993:
1.112 bowersj2 4994: =item * $regexp: if string matches this regexp, the string will be
4995: sent to $gradesub
1.14 harris41 4996:
1.112 bowersj2 4997: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4998:
1.1199 raeburn 4999: =item * $usec: section of the desired student
5000:
5001: =item * $identifier: counter for student (multiple students one problem) or
5002: problem (one student; whole sequence).
5003:
1.112 bowersj2 5004: =back
1.14 harris41 5005:
1.112 bowersj2 5006: The output string is a table containing all desired attempts, if any.
1.16 harris41 5007:
1.112 bowersj2 5008: =cut
1.1 albertel 5009:
5010: sub get_previous_attempt {
1.1199 raeburn 5011: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 5012: my $prevattempts='';
1.43 ng 5013: no strict 'refs';
1.1 albertel 5014: if ($symb) {
1.3 albertel 5015: my (%returnhash)=
5016: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 5017: if ($returnhash{'version'}) {
5018: my %lasthash=();
5019: my $version;
5020: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 5021: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
5022: if ($key =~ /\.rawrndseed$/) {
5023: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
5024: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
5025: } else {
5026: $lasthash{$key}=$returnhash{$version.':'.$key};
5027: }
1.19 harris41 5028: }
1.1 albertel 5029: }
1.596 albertel 5030: $prevattempts=&start_data_table().&start_data_table_header_row();
5031: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 5032: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 5033: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 5034: foreach my $key (sort(keys(%lasthash))) {
5035: my ($ign,@parts) = split(/\./,$key);
1.41 ng 5036: if ($#parts > 0) {
1.31 albertel 5037: my $data=$parts[-1];
1.989 raeburn 5038: next if ($data eq 'foilorder');
1.31 albertel 5039: pop(@parts);
1.1010 www 5040: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 5041: if ($data eq 'type') {
5042: unless ($showsurv) {
5043: my $id = join(',',@parts);
5044: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 5045: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
5046: $lasthidden{$ign.'.'.$id} = 1;
5047: }
1.945 raeburn 5048: }
1.1199 raeburn 5049: if ($identifier ne '') {
5050: my $id = join(',',@parts);
5051: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
5052: $domain,$username,$usec,undef,$course) =~ /^no/) {
5053: $hidestatus{$ign.'.'.$id} = 1;
5054: }
5055: }
5056: } elsif ($data eq 'regrader') {
5057: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 5058: my $id = join(',',@parts);
5059: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 5060: }
1.1010 www 5061: }
1.31 albertel 5062: } else {
1.41 ng 5063: if ($#parts == 0) {
5064: $prevattempts.='<th>'.$parts[0].'</th>';
5065: } else {
5066: $prevattempts.='<th>'.$ign.'</th>';
5067: }
1.31 albertel 5068: }
1.16 harris41 5069: }
1.596 albertel 5070: $prevattempts.=&end_data_table_header_row();
1.40 ng 5071: if ($getattempt eq '') {
1.1199 raeburn 5072: my (%solved,%resets,%probstatus);
1.1200 raeburn 5073: if (($identifier ne '') && (keys(%regraded) > 0)) {
5074: for ($version=1;$version<=$returnhash{'version'};$version++) {
5075: foreach my $id (keys(%regraded)) {
5076: if (($returnhash{$version.':'.$id.'.regrader'}) &&
5077: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
5078: ($returnhash{$version.':'.$id.'.award'} eq '')) {
5079: push(@{$resets{$id}},$version);
1.1199 raeburn 5080: }
5081: }
5082: }
1.1200 raeburn 5083: }
5084: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 5085: my (@hidden,@unsolved);
1.945 raeburn 5086: if (%typeparts) {
5087: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 5088: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
5089: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 5090: push(@hidden,$id);
1.1199 raeburn 5091: } elsif ($identifier ne '') {
5092: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
5093: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
5094: ($hidestatus{$id})) {
1.1200 raeburn 5095: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 5096: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
5097: push(@{$solved{$id}},$version);
5098: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
5099: (ref($solved{$id}) eq 'ARRAY')) {
5100: my $skip;
5101: if (ref($resets{$id}) eq 'ARRAY') {
5102: foreach my $reset (@{$resets{$id}}) {
5103: if ($reset > $solved{$id}[-1]) {
5104: $skip=1;
5105: last;
5106: }
5107: }
5108: }
5109: unless ($skip) {
5110: my ($ign,$partslist) = split(/\./,$id,2);
5111: push(@unsolved,$partslist);
5112: }
5113: }
5114: }
1.945 raeburn 5115: }
5116: }
5117: }
5118: $prevattempts.=&start_data_table_row().
1.1199 raeburn 5119: '<td>'.&mt('Transaction [_1]',$version);
5120: if (@unsolved) {
5121: $prevattempts .= '<span class="LC_nobreak"><label>'.
5122: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
5123: &mt('Hide').'</label></span>';
5124: }
5125: $prevattempts .= '</td>';
1.945 raeburn 5126: if (@hidden) {
5127: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5128: next if ($key =~ /\.foilorder$/);
1.945 raeburn 5129: my $hide;
5130: foreach my $id (@hidden) {
5131: if ($key =~ /^\Q$id\E/) {
5132: $hide = 1;
5133: last;
5134: }
5135: }
5136: if ($hide) {
5137: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
5138: if (($data eq 'award') || ($data eq 'awarddetail')) {
5139: my $value = &format_previous_attempt_value($key,
5140: $returnhash{$version.':'.$key});
1.1173 kruse 5141: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5142: } else {
5143: $prevattempts.='<td> </td>';
5144: }
5145: } else {
5146: if ($key =~ /\./) {
1.1212 raeburn 5147: my $value = $returnhash{$version.':'.$key};
5148: if ($key =~ /\.rndseed$/) {
5149: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
5150: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
5151: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
5152: }
5153: }
5154: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
5155: ' </td>';
1.945 raeburn 5156: } else {
5157: $prevattempts.='<td> </td>';
5158: }
5159: }
5160: }
5161: } else {
5162: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5163: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 5164: my $value = $returnhash{$version.':'.$key};
5165: if ($key =~ /\.rndseed$/) {
5166: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
5167: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
5168: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
5169: }
5170: }
5171: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
5172: ' </td>';
1.945 raeburn 5173: }
5174: }
5175: $prevattempts.=&end_data_table_row();
1.40 ng 5176: }
1.1 albertel 5177: }
1.945 raeburn 5178: my @currhidden = keys(%lasthidden);
1.596 albertel 5179: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 5180: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 5181: next if ($key =~ /\.foilorder$/);
1.945 raeburn 5182: if (%typeparts) {
5183: my $hidden;
5184: foreach my $id (@currhidden) {
5185: if ($key =~ /^\Q$id\E/) {
5186: $hidden = 1;
5187: last;
5188: }
5189: }
5190: if ($hidden) {
5191: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
5192: if (($data eq 'award') || ($data eq 'awarddetail')) {
5193: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5194: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5195: $value = &$gradesub($value);
5196: }
1.1173 kruse 5197: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 5198: } else {
5199: $prevattempts.='<td> </td>';
5200: }
5201: } else {
5202: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5203: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5204: $value = &$gradesub($value);
5205: }
1.1173 kruse 5206: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5207: }
5208: } else {
5209: my $value = &format_previous_attempt_value($key,$lasthash{$key});
5210: if ($key =~/$regexp$/ && (defined &$gradesub)) {
5211: $value = &$gradesub($value);
5212: }
1.1173 kruse 5213: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 5214: }
1.16 harris41 5215: }
1.596 albertel 5216: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 5217: } else {
1.1305 raeburn 5218: my $msg;
5219: if ($symb =~ /ext\.tool$/) {
5220: $msg = &mt('No grade passed back.');
5221: } else {
5222: $msg = &mt('Nothing submitted - no attempts.');
5223: }
1.596 albertel 5224: $prevattempts=
5225: &start_data_table().&start_data_table_row().
1.1305 raeburn 5226: '<td>'.$msg.'</td>'.
1.596 albertel 5227: &end_data_table_row().&end_data_table();
1.1 albertel 5228: }
5229: } else {
1.596 albertel 5230: $prevattempts=
5231: &start_data_table().&start_data_table_row().
5232: '<td>'.&mt('No data.').'</td>'.
5233: &end_data_table_row().&end_data_table();
1.1 albertel 5234: }
1.10 albertel 5235: }
5236:
1.581 albertel 5237: sub format_previous_attempt_value {
5238: my ($key,$value) = @_;
1.1011 www 5239: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 5240: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 5241: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 5242: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 5243: } elsif ($key =~ /answerstring$/) {
5244: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 5245: my @answer = %answers;
5246: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 5247: my @anskeys = sort(keys(%answers));
5248: if (@anskeys == 1) {
5249: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 5250: if ($answer =~ m{\0}) {
5251: $answer =~ s{\0}{,}g;
1.988 raeburn 5252: }
5253: my $tag_internal_answer_name = 'INTERNAL';
5254: if ($anskeys[0] eq $tag_internal_answer_name) {
5255: $value = $answer;
5256: } else {
5257: $value = $anskeys[0].'='.$answer;
5258: }
5259: } else {
5260: foreach my $ans (@anskeys) {
5261: my $answer = $answers{$ans};
1.1001 raeburn 5262: if ($answer =~ m{\0}) {
5263: $answer =~ s{\0}{,}g;
1.988 raeburn 5264: }
5265: $value .= $ans.'='.$answer.'<br />';;
5266: }
5267: }
1.581 albertel 5268: } else {
1.1173 kruse 5269: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 5270: }
5271: return $value;
5272: }
5273:
5274:
1.107 albertel 5275: sub relative_to_absolute {
5276: my ($url,$output)=@_;
5277: my $parser=HTML::TokeParser->new(\$output);
5278: my $token;
5279: my $thisdir=$url;
5280: my @rlinks=();
5281: while ($token=$parser->get_token) {
5282: if ($token->[0] eq 'S') {
5283: if ($token->[1] eq 'a') {
5284: if ($token->[2]->{'href'}) {
5285: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
5286: }
5287: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
5288: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
5289: } elsif ($token->[1] eq 'base') {
5290: $thisdir=$token->[2]->{'href'};
5291: }
5292: }
5293: }
5294: $thisdir=~s-/[^/]*$--;
1.356 albertel 5295: foreach my $link (@rlinks) {
1.726 raeburn 5296: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 5297: ($link=~/^\//) ||
5298: ($link=~/^javascript:/i) ||
5299: ($link=~/^mailto:/i) ||
5300: ($link=~/^\#/)) {
5301: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
5302: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 5303: }
5304: }
5305: # -------------------------------------------------- Deal with Applet codebases
5306: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
5307: return $output;
5308: }
5309:
1.112 bowersj2 5310: =pod
5311:
1.648 raeburn 5312: =item * &get_student_view()
1.112 bowersj2 5313:
5314: show a snapshot of what student was looking at
5315:
5316: =cut
5317:
1.10 albertel 5318: sub get_student_view {
1.186 albertel 5319: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 5320: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5321: my (%form);
1.10 albertel 5322: my @elements=('symb','courseid','domain','username');
5323: foreach my $element (@elements) {
1.186 albertel 5324: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5325: }
1.186 albertel 5326: if (defined($moreenv)) {
5327: %form=(%form,%{$moreenv});
5328: }
1.236 albertel 5329: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 5330: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 5331: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
5332: $feedurl =~ s{^/adm/wrapper}{};
5333: }
1.650 www 5334: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 5335: $userview=~s/\<body[^\>]*\>//gi;
5336: $userview=~s/\<\/body\>//gi;
5337: $userview=~s/\<html\>//gi;
5338: $userview=~s/\<\/html\>//gi;
5339: $userview=~s/\<head\>//gi;
5340: $userview=~s/\<\/head\>//gi;
5341: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 5342: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 5343: if (wantarray) {
5344: return ($userview,$response);
5345: } else {
5346: return $userview;
5347: }
5348: }
5349:
5350: sub get_student_view_with_retries {
5351: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
5352:
5353: my $ok = 0; # True if we got a good response.
5354: my $content;
5355: my $response;
5356:
5357: # Try to get the student_view done. within the retries count:
5358:
5359: do {
5360: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
5361: $ok = $response->is_success;
5362: if (!$ok) {
5363: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
5364: }
5365: $retries--;
5366: } while (!$ok && ($retries > 0));
5367:
5368: if (!$ok) {
5369: $content = ''; # On error return an empty content.
5370: }
1.651 www 5371: if (wantarray) {
5372: return ($content, $response);
5373: } else {
5374: return $content;
5375: }
1.11 albertel 5376: }
5377:
1.1349 raeburn 5378: sub css_links {
5379: my ($currsymb,$level) = @_;
5380: my ($links,@symbs,%cssrefs,%httpref);
5381: if ($level eq 'map') {
5382: my $navmap = Apache::lonnavmaps::navmap->new();
5383: if (ref($navmap)) {
5384: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
5385: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
5386: foreach my $res (@resources) {
5387: if (ref($res) && $res->symb()) {
5388: push(@symbs,$res->symb());
5389: }
5390: }
5391: }
5392: } else {
5393: @symbs = ($currsymb);
5394: }
5395: foreach my $symb (@symbs) {
5396: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
5397: if ($css_href =~ /\S/) {
5398: unless ($css_href =~ m{https?://}) {
5399: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
5400: my $proburl = &Apache::lonnet::clutter($url);
5401: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
5402: unless ($css_href =~ m{^/}) {
5403: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
5404: }
5405: if ($css_href =~ m{^/(res|uploaded)/}) {
5406: unless (($httpref{'httpref.'.$css_href}) ||
5407: (&Apache::lonnet::is_on_map($css_href))) {
5408: my $thisurl = $proburl;
5409: if ($env{'httpref.'.$proburl}) {
5410: $thisurl = $env{'httpref.'.$proburl};
5411: }
5412: $httpref{'httpref.'.$css_href} = $thisurl;
5413: }
5414: }
5415: }
5416: $cssrefs{$css_href} = 1;
5417: }
5418: }
5419: if (keys(%httpref)) {
5420: &Apache::lonnet::appenv(\%httpref);
5421: }
5422: if (keys(%cssrefs)) {
5423: foreach my $css_href (keys(%cssrefs)) {
5424: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
5425: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
5426: }
5427: }
5428: return $links;
5429: }
5430:
1.112 bowersj2 5431: =pod
5432:
1.648 raeburn 5433: =item * &get_student_answers()
1.112 bowersj2 5434:
5435: show a snapshot of how student was answering problem
5436:
5437: =cut
5438:
1.11 albertel 5439: sub get_student_answers {
1.100 sakharuk 5440: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 5441: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5442: my (%moreenv);
1.11 albertel 5443: my @elements=('symb','courseid','domain','username');
5444: foreach my $element (@elements) {
1.186 albertel 5445: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5446: }
1.186 albertel 5447: $moreenv{'grade_target'}='answer';
5448: %moreenv=(%form,%moreenv);
1.497 raeburn 5449: $feedurl = &Apache::lonnet::clutter($feedurl);
5450: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 5451: return $userview;
1.1 albertel 5452: }
1.116 albertel 5453:
5454: =pod
5455:
5456: =item * &submlink()
5457:
1.242 albertel 5458: Inputs: $text $uname $udom $symb $target
1.116 albertel 5459:
5460: Returns: A link to grades.pm such as to see the SUBM view of a student
5461:
5462: =cut
5463:
5464: ###############################################
5465: sub submlink {
1.242 albertel 5466: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 5467: if (!($uname && $udom)) {
5468: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5469: &Apache::lonnet::whichuser($symb);
1.116 albertel 5470: if (!$symb) { $symb=$cursymb; }
5471: }
1.254 matthew 5472: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5473: $symb=&escape($symb);
1.960 bisitz 5474: if ($target) { $target=" target=\"$target\""; }
5475: return
5476: '<a href="/adm/grades?command=submission'.
5477: '&symb='.$symb.
5478: '&student='.$uname.
5479: '&userdom='.$udom.'"'.
5480: $target.'>'.$text.'</a>';
1.242 albertel 5481: }
5482: ##############################################
5483:
5484: =pod
5485:
5486: =item * &pgrdlink()
5487:
5488: Inputs: $text $uname $udom $symb $target
5489:
5490: Returns: A link to grades.pm such as to see the PGRD view of a student
5491:
5492: =cut
5493:
5494: ###############################################
5495: sub pgrdlink {
5496: my $link=&submlink(@_);
5497: $link=~s/(&command=submission)/$1&showgrading=yes/;
5498: return $link;
5499: }
5500: ##############################################
5501:
5502: =pod
5503:
5504: =item * &pprmlink()
5505:
5506: Inputs: $text $uname $udom $symb $target
5507:
5508: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 5509: student and a specific resource
1.242 albertel 5510:
5511: =cut
5512:
5513: ###############################################
5514: sub pprmlink {
5515: my ($text,$uname,$udom,$symb,$target)=@_;
5516: if (!($uname && $udom)) {
5517: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5518: &Apache::lonnet::whichuser($symb);
1.242 albertel 5519: if (!$symb) { $symb=$cursymb; }
5520: }
1.254 matthew 5521: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5522: $symb=&escape($symb);
1.242 albertel 5523: if ($target) { $target="target=\"$target\""; }
1.595 albertel 5524: return '<a href="/adm/parmset?command=set&'.
5525: 'symb='.$symb.'&uname='.$uname.
5526: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 5527: }
5528: ##############################################
1.37 matthew 5529:
1.112 bowersj2 5530: =pod
5531:
5532: =back
5533:
5534: =cut
5535:
1.37 matthew 5536: ###############################################
1.51 www 5537:
5538:
5539: sub timehash {
1.687 raeburn 5540: my ($thistime) = @_;
5541: my $timezone = &Apache::lonlocal::gettimezone();
5542: my $dt = DateTime->from_epoch(epoch => $thistime)
5543: ->set_time_zone($timezone);
5544: my $wday = $dt->day_of_week();
5545: if ($wday == 7) { $wday = 0; }
5546: return ( 'second' => $dt->second(),
5547: 'minute' => $dt->minute(),
5548: 'hour' => $dt->hour(),
5549: 'day' => $dt->day_of_month(),
5550: 'month' => $dt->month(),
5551: 'year' => $dt->year(),
5552: 'weekday' => $wday,
5553: 'dayyear' => $dt->day_of_year(),
5554: 'dlsav' => $dt->is_dst() );
1.51 www 5555: }
5556:
1.370 www 5557: sub utc_string {
5558: my ($date)=@_;
1.371 www 5559: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5560: }
5561:
1.51 www 5562: sub maketime {
5563: my %th=@_;
1.687 raeburn 5564: my ($epoch_time,$timezone,$dt);
5565: $timezone = &Apache::lonlocal::gettimezone();
5566: eval {
5567: $dt = DateTime->new( year => $th{'year'},
5568: month => $th{'month'},
5569: day => $th{'day'},
5570: hour => $th{'hour'},
5571: minute => $th{'minute'},
5572: second => $th{'second'},
5573: time_zone => $timezone,
5574: );
5575: };
5576: if (!$@) {
5577: $epoch_time = $dt->epoch;
5578: if ($epoch_time) {
5579: return $epoch_time;
5580: }
5581: }
1.51 www 5582: return POSIX::mktime(
5583: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5584: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5585: }
5586:
5587: #########################################
1.51 www 5588:
5589: sub findallcourses {
1.482 raeburn 5590: my ($roles,$uname,$udom) = @_;
1.355 albertel 5591: my %roles;
5592: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5593: my %courses;
1.51 www 5594: my $now=time;
1.482 raeburn 5595: if (!defined($uname)) {
5596: $uname = $env{'user.name'};
5597: }
5598: if (!defined($udom)) {
5599: $udom = $env{'user.domain'};
5600: }
5601: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5602: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5603: if (!%roles) {
5604: %roles = (
5605: cc => 1,
1.907 raeburn 5606: co => 1,
1.482 raeburn 5607: in => 1,
5608: ep => 1,
5609: ta => 1,
5610: cr => 1,
5611: st => 1,
5612: );
5613: }
5614: foreach my $entry (keys(%roleshash)) {
5615: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5616: if ($trole =~ /^cr/) {
5617: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5618: } else {
5619: next if (!exists($roles{$trole}));
5620: }
5621: if ($tend) {
5622: next if ($tend < $now);
5623: }
5624: if ($tstart) {
5625: next if ($tstart > $now);
5626: }
1.1058 raeburn 5627: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5628: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5629: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5630: if ($secpart eq '') {
5631: ($cnum,$role) = split(/_/,$cnumpart);
5632: $sec = 'none';
1.1058 raeburn 5633: $value .= $cnum.'/';
1.482 raeburn 5634: } else {
5635: $cnum = $cnumpart;
5636: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5637: $value .= $cnum.'/'.$sec;
5638: }
5639: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5640: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5641: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5642: }
5643: } else {
5644: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5645: }
1.482 raeburn 5646: }
5647: } else {
5648: foreach my $key (keys(%env)) {
1.483 albertel 5649: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5650: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5651: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5652: next if ($role eq 'ca' || $role eq 'aa');
5653: next if (%roles && !exists($roles{$role}));
5654: my ($starttime,$endtime)=split(/\./,$env{$key});
5655: my $active=1;
5656: if ($starttime) {
5657: if ($now<$starttime) { $active=0; }
5658: }
5659: if ($endtime) {
5660: if ($now>$endtime) { $active=0; }
5661: }
5662: if ($active) {
1.1058 raeburn 5663: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5664: if ($sec eq '') {
5665: $sec = 'none';
1.1058 raeburn 5666: } else {
5667: $value .= $sec;
5668: }
5669: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5670: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5671: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5672: }
5673: } else {
5674: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5675: }
1.474 raeburn 5676: }
5677: }
1.51 www 5678: }
5679: }
1.474 raeburn 5680: return %courses;
1.51 www 5681: }
1.37 matthew 5682:
1.54 www 5683: ###############################################
1.474 raeburn 5684:
5685: sub blockcheck {
1.1372 raeburn 5686: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
5687: unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
5688: my ($has_evb,$check_ipaccess);
5689: my $dom = $env{'user.domain'};
5690: if ($env{'request.course.id'}) {
5691: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5692: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5693: my $checkrole = "cm./$cdom/$cnum";
5694: my $sec = $env{'request.course.sec'};
5695: if ($sec ne '') {
5696: $checkrole .= "/$sec";
5697: }
5698: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5699: ($env{'request.role'} !~ /^st/)) {
5700: $has_evb = 1;
5701: }
5702: unless ($has_evb) {
5703: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
1.1444 raeburn 5704: ($activity eq 'index') || ($activity eq 'boards') || ($activity eq 'groups') ||
5705: ($activity eq 'chat')) {
1.1372 raeburn 5706: if ($udom eq $cdom) {
5707: $check_ipaccess = 1;
5708: }
5709: }
5710: }
1.1375 raeburn 5711: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5712: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5713: my $checkrole;
5714: if ($env{'request.role.domain'} eq '') {
5715: $checkrole = "cm./$env{'user.domain'}/";
5716: } else {
5717: $checkrole = "cm./$env{'request.role.domain'}/";
5718: }
5719: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5720: $has_evb = 1;
5721: }
1.1372 raeburn 5722: }
5723: unless ($has_evb || $check_ipaccess) {
5724: my @machinedoms = &Apache::lonnet::current_machine_domains();
5725: if (($dom eq 'public') && ($activity eq 'port')) {
5726: $dom = $udom;
5727: }
5728: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5729: $check_ipaccess = 1;
5730: } else {
5731: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5732: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5733: my $prim = &Apache::lonnet::domain($dom,'primary');
5734: my $intdom = &Apache::lonnet::internet_dom($prim);
5735: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5736: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5737: $check_ipaccess = 1;
5738: }
5739: }
5740: }
5741: }
5742: if ($check_ipaccess) {
5743: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5744: unless (defined($cached)) {
5745: my %domconfig =
5746: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5747: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5748: }
5749: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5750: foreach my $id (keys(%{$ipaccessref})) {
5751: if (ref($ipaccessref->{$id}) eq 'HASH') {
5752: my $range = $ipaccessref->{$id}->{'ip'};
5753: if ($range) {
5754: if (&Apache::lonnet::ip_match($clientip,$range)) {
5755: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5756: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5757: return ('','','',$id,$dom);
5758: last;
5759: }
5760: }
5761: }
5762: }
5763: }
5764: }
5765: }
5766: }
1.1373 raeburn 5767: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5768: return ();
5769: }
1.1372 raeburn 5770: }
1.1189 raeburn 5771: if (defined($udom) && defined($uname)) {
5772: # If uname and udom are for a course, check for blocks in the course.
5773: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5774: my ($startblock,$endblock,$triggerblock) =
1.1347 raeburn 5775: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189 raeburn 5776: return ($startblock,$endblock,$triggerblock);
5777: }
5778: } else {
1.490 raeburn 5779: $udom = $env{'user.domain'};
5780: $uname = $env{'user.name'};
5781: }
5782:
1.502 raeburn 5783: my $startblock = 0;
5784: my $endblock = 0;
1.1062 raeburn 5785: my $triggerblock = '';
1.1373 raeburn 5786: my %live_courses;
5787: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5788: %live_courses = &findallcourses(undef,$uname,$udom);
5789: }
1.474 raeburn 5790:
1.490 raeburn 5791: # If uname is for a user, and activity is course-specific, i.e.,
5792: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5793:
1.490 raeburn 5794: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5795: $activity eq 'groups' || $activity eq 'printout' ||
1.1444 raeburn 5796: $activity eq 'search' || $activity eq 'index' ||
5797: $activity eq 'reinit' || $activity eq 'alert') &&
1.1189 raeburn 5798: ($env{'request.course.id'})) {
1.490 raeburn 5799: foreach my $key (keys(%live_courses)) {
5800: if ($key ne $env{'request.course.id'}) {
5801: delete($live_courses{$key});
5802: }
5803: }
5804: }
5805:
5806: my $otheruser = 0;
5807: my %own_courses;
5808: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5809: # Resource belongs to user other than current user.
5810: $otheruser = 1;
5811: # Gather courses for current user
5812: %own_courses =
5813: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5814: }
5815:
5816: # Gather active course roles - course coordinator, instructor,
5817: # exam proctor, ta, student, or custom role.
1.474 raeburn 5818:
5819: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5820: my ($cdom,$cnum);
5821: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5822: $cdom = $env{'course.'.$course.'.domain'};
5823: $cnum = $env{'course.'.$course.'.num'};
5824: } else {
1.490 raeburn 5825: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5826: }
5827: my $no_ownblock = 0;
5828: my $no_userblock = 0;
1.533 raeburn 5829: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5830: # Check if current user has 'evb' priv for this
5831: if (defined($own_courses{$course})) {
5832: foreach my $sec (keys(%{$own_courses{$course}})) {
5833: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5834: if ($sec ne 'none') {
5835: $checkrole .= '/'.$sec;
5836: }
5837: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5838: $no_ownblock = 1;
5839: last;
5840: }
5841: }
5842: }
5843: # if they have 'evb' priv and are currently not playing student
5844: next if (($no_ownblock) &&
5845: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5846: }
1.474 raeburn 5847: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5848: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5849: if ($sec ne 'none') {
1.482 raeburn 5850: $checkrole .= '/'.$sec;
1.474 raeburn 5851: }
1.490 raeburn 5852: if ($otheruser) {
5853: # Resource belongs to user other than current user.
5854: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5855: my (%allroles,%userroles);
5856: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5857: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5858: my ($trole,$tdom,$tnum,$tsec);
5859: if ($entry =~ /^cr/) {
5860: ($trole,$tdom,$tnum,$tsec) =
5861: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5862: } else {
5863: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5864: }
5865: my ($spec,$area,$trest);
5866: $area = '/'.$tdom.'/'.$tnum;
5867: $trest = $tnum;
5868: if ($tsec ne '') {
5869: $area .= '/'.$tsec;
5870: $trest .= '/'.$tsec;
5871: }
5872: $spec = $trole.'.'.$area;
5873: if ($trole =~ /^cr/) {
5874: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5875: $tdom,$spec,$trest,$area);
5876: } else {
5877: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5878: $tdom,$spec,$trest,$area);
5879: }
5880: }
1.1276 raeburn 5881: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5882: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5883: if ($1) {
5884: $no_userblock = 1;
5885: last;
5886: }
1.486 raeburn 5887: }
5888: }
1.490 raeburn 5889: } else {
5890: # Resource belongs to current user
5891: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5892: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5893: $no_ownblock = 1;
5894: last;
5895: }
1.474 raeburn 5896: }
5897: }
5898: # if they have the evb priv and are currently not playing student
1.482 raeburn 5899: next if (($no_ownblock) &&
1.491 albertel 5900: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5901: next if ($no_userblock);
1.474 raeburn 5902:
1.1303 raeburn 5903: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5904: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5905:
1.1062 raeburn 5906: my ($start,$end,$trigger) =
1.1347 raeburn 5907: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5908: if (($start != 0) &&
5909: (($startblock == 0) || ($startblock > $start))) {
5910: $startblock = $start;
1.1062 raeburn 5911: if ($trigger ne '') {
5912: $triggerblock = $trigger;
5913: }
1.502 raeburn 5914: }
5915: if (($end != 0) &&
5916: (($endblock == 0) || ($endblock < $end))) {
5917: $endblock = $end;
1.1062 raeburn 5918: if ($trigger ne '') {
5919: $triggerblock = $trigger;
5920: }
1.502 raeburn 5921: }
1.490 raeburn 5922: }
1.1062 raeburn 5923: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5924: }
5925:
5926: sub get_blocks {
1.1347 raeburn 5927: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5928: my $startblock = 0;
5929: my $endblock = 0;
1.1062 raeburn 5930: my $triggerblock = '';
1.490 raeburn 5931: my $course = $cdom.'_'.$cnum;
5932: $setters->{$course} = {};
5933: $setters->{$course}{'staff'} = [];
5934: $setters->{$course}{'times'} = [];
1.1062 raeburn 5935: $setters->{$course}{'triggers'} = [];
5936: my (@blockers,%triggered);
5937: my $now = time;
5938: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5939: if ($activity eq 'docs') {
1.1348 raeburn 5940: my ($blocked,$nosymbcache,$noenccheck);
1.1347 raeburn 5941: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5942: $blocked = 1;
5943: $nosymbcache = 1;
1.1348 raeburn 5944: $noenccheck = 1;
1.1347 raeburn 5945: }
1.1348 raeburn 5946: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5947: foreach my $block (@blockers) {
5948: if ($block =~ /^firstaccess____(.+)$/) {
5949: my $item = $1;
5950: my $type = 'map';
5951: my $timersymb = $item;
5952: if ($item eq 'course') {
5953: $type = 'course';
5954: } elsif ($item =~ /___\d+___/) {
5955: $type = 'resource';
5956: } else {
5957: $timersymb = &Apache::lonnet::symbread($item);
5958: }
5959: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5960: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5961: $triggered{$block} = {
5962: start => $start,
5963: end => $end,
5964: type => $type,
5965: };
5966: }
5967: }
5968: } else {
5969: foreach my $block (keys(%commblocks)) {
5970: if ($block =~ m/^(\d+)____(\d+)$/) {
5971: my ($start,$end) = ($1,$2);
5972: if ($start <= time && $end >= time) {
5973: if (ref($commblocks{$block}) eq 'HASH') {
5974: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5975: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5976: unless(grep(/^\Q$block\E$/,@blockers)) {
5977: push(@blockers,$block);
5978: }
5979: }
5980: }
5981: }
5982: }
5983: } elsif ($block =~ /^firstaccess____(.+)$/) {
5984: my $item = $1;
5985: my $timersymb = $item;
5986: my $type = 'map';
5987: if ($item eq 'course') {
5988: $type = 'course';
5989: } elsif ($item =~ /___\d+___/) {
5990: $type = 'resource';
5991: } else {
5992: $timersymb = &Apache::lonnet::symbread($item);
5993: }
5994: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5995: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5996: if ($start && $end) {
5997: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5998: if (ref($commblocks{$block}) eq 'HASH') {
5999: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
6000: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
6001: unless(grep(/^\Q$block\E$/,@blockers)) {
6002: push(@blockers,$block);
6003: $triggered{$block} = {
6004: start => $start,
6005: end => $end,
6006: type => $type,
6007: };
6008: }
6009: }
6010: }
1.1062 raeburn 6011: }
6012: }
1.490 raeburn 6013: }
1.1062 raeburn 6014: }
6015: }
6016: }
6017: foreach my $blocker (@blockers) {
6018: my ($staff_name,$staff_dom,$title,$blocks) =
6019: &parse_block_record($commblocks{$blocker});
6020: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
6021: my ($start,$end,$triggertype);
6022: if ($blocker =~ m/^(\d+)____(\d+)$/) {
6023: ($start,$end) = ($1,$2);
6024: } elsif (ref($triggered{$blocker}) eq 'HASH') {
6025: $start = $triggered{$blocker}{'start'};
6026: $end = $triggered{$blocker}{'end'};
6027: $triggertype = $triggered{$blocker}{'type'};
6028: }
6029: if ($start) {
6030: push(@{$$setters{$course}{'times'}}, [$start,$end]);
6031: if ($triggertype) {
6032: push(@{$$setters{$course}{'triggers'}},$triggertype);
6033: } else {
6034: push(@{$$setters{$course}{'triggers'}},0);
6035: }
6036: if ( ($startblock == 0) || ($startblock > $start) ) {
6037: $startblock = $start;
6038: if ($triggertype) {
6039: $triggerblock = $blocker;
1.474 raeburn 6040: }
6041: }
1.1062 raeburn 6042: if ( ($endblock == 0) || ($endblock < $end) ) {
6043: $endblock = $end;
6044: if ($triggertype) {
6045: $triggerblock = $blocker;
6046: }
6047: }
1.474 raeburn 6048: }
6049: }
1.1062 raeburn 6050: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 6051: }
6052:
6053: sub parse_block_record {
6054: my ($record) = @_;
6055: my ($setuname,$setudom,$title,$blocks);
6056: if (ref($record) eq 'HASH') {
6057: ($setuname,$setudom) = split(/:/,$record->{'setter'});
6058: $title = &unescape($record->{'event'});
6059: $blocks = $record->{'blocks'};
6060: } else {
6061: my @data = split(/:/,$record,3);
6062: if (scalar(@data) eq 2) {
6063: $title = $data[1];
6064: ($setuname,$setudom) = split(/@/,$data[0]);
6065: } else {
6066: ($setuname,$setudom,$title) = @data;
6067: }
6068: $blocks = { 'com' => 'on' };
6069: }
6070: return ($setuname,$setudom,$title,$blocks);
6071: }
6072:
1.854 kalberla 6073: sub blocking_status {
1.1372 raeburn 6074: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 6075: my %setters;
1.890 droeschl 6076:
1.1061 raeburn 6077: # check for active blocking
1.1372 raeburn 6078: if ($clientip eq '') {
6079: $clientip = &Apache::lonnet::get_requestor_ip();
6080: }
6081: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
6082: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 6083: my $blocked = 0;
1.1372 raeburn 6084: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 6085: $blocked = 1;
6086: }
1.890 droeschl 6087:
1.1061 raeburn 6088: # caller just wants to know whether a block is active
6089: if (!wantarray) { return $blocked; }
6090:
6091: # build a link to a popup window containing the details
6092: my $querystring = "?activity=$activity";
1.1351 raeburn 6093: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
6094: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232 raeburn 6095: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
6096: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 6097: } elsif ($activity eq 'docs') {
1.1347 raeburn 6098: my $showurl = &Apache::lonenc::check_encrypt($url);
6099: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
6100: if ($symb) {
6101: my $showsymb = &Apache::lonenc::check_encrypt($symb);
6102: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
6103: }
1.1062 raeburn 6104: }
1.1061 raeburn 6105:
6106: my $output .= <<'END_MYBLOCK';
6107: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
6108: var options = "width=" + w + ",height=" + h + ",";
6109: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
6110: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
6111: var newWin = window.open(url, wdwName, options);
6112: newWin.focus();
6113: }
1.890 droeschl 6114: END_MYBLOCK
1.854 kalberla 6115:
1.1061 raeburn 6116: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 6117:
1.1061 raeburn 6118: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 6119: my $text = &mt('Communication Blocked');
1.1217 raeburn 6120: my $class = 'LC_comblock';
1.1062 raeburn 6121: if ($activity eq 'docs') {
6122: $text = &mt('Content Access Blocked');
1.1217 raeburn 6123: $class = '';
1.1063 raeburn 6124: } elsif ($activity eq 'printout') {
6125: $text = &mt('Printing Blocked');
1.1232 raeburn 6126: } elsif ($activity eq 'passwd') {
6127: $text = &mt('Password Changing Blocked');
1.1345 raeburn 6128: } elsif ($activity eq 'grades') {
6129: $text = &mt('Gradebook Blocked');
1.1346 raeburn 6130: } elsif ($activity eq 'search') {
6131: $text = &mt('Search Blocked');
1.1444 raeburn 6132: } elsif ($activity eq 'index') {
6133: $text = &mt('Content Index Blocked');
1.1282 raeburn 6134: } elsif ($activity eq 'alert') {
6135: $text = &mt('Checking Critical Messages Blocked');
6136: } elsif ($activity eq 'reinit') {
6137: $text = &mt('Checking Course Update Blocked');
1.1351 raeburn 6138: } elsif ($activity eq 'about') {
6139: $text = &mt('Access to User Information Pages Blocked');
1.1373 raeburn 6140: } elsif ($activity eq 'wishlist') {
6141: $text = &mt('Access to Stored Links Blocked');
6142: } elsif ($activity eq 'annotate') {
6143: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 6144: }
1.1061 raeburn 6145: $output .= <<"END_BLOCK";
1.1217 raeburn 6146: <div class='$class'>
1.869 kalberla 6147: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 6148: title='$text'>
6149: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 6150: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 6151: title='$text'>$text</a>
1.867 kalberla 6152: </div>
6153:
6154: END_BLOCK
1.474 raeburn 6155:
1.1061 raeburn 6156: return ($blocked, $output);
1.854 kalberla 6157: }
1.490 raeburn 6158:
1.60 matthew 6159: ###############################################
6160:
1.682 raeburn 6161: sub check_ip_acc {
1.1201 raeburn 6162: my ($acc,$clientip)=@_;
1.682 raeburn 6163: &Apache::lonxml::debug("acc is $acc");
6164: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
6165: return 1;
6166: }
1.1339 raeburn 6167: my ($ip,$allowed);
6168: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
6169: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
6170: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
6171: } else {
1.1350 raeburn 6172: my $remote_ip = &Apache::lonnet::get_requestor_ip();
6173: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339 raeburn 6174: }
1.682 raeburn 6175:
6176: my $name;
1.1219 raeburn 6177: my %access = (
6178: allowfrom => 1,
6179: denyfrom => 0,
6180: );
6181: my @allows;
6182: my @denies;
6183: foreach my $item (split(',',$acc)) {
6184: $item =~ s/^\s*//;
6185: $item =~ s/\s*$//;
6186: my $pattern;
6187: if ($item =~ /^\!(.+)$/) {
6188: push(@denies,$1);
6189: } else {
6190: push(@allows,$item);
6191: }
6192: }
6193: my $numdenies = scalar(@denies);
6194: my $numallows = scalar(@allows);
6195: my $count = 0;
6196: foreach my $pattern (@denies,@allows) {
6197: $count ++;
6198: my $acctype = 'allowfrom';
6199: if ($count <= $numdenies) {
6200: $acctype = 'denyfrom';
6201: }
1.682 raeburn 6202: if ($pattern =~ /\*$/) {
6203: #35.8.*
6204: $pattern=~s/\*//;
1.1219 raeburn 6205: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6206: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
6207: #35.8.3.[34-56]
6208: my $low=$2;
6209: my $high=$3;
6210: $pattern=$1;
6211: if ($ip =~ /^\Q$pattern\E/) {
6212: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 6213: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 6214: }
6215: } elsif ($pattern =~ /^\*/) {
6216: #*.msu.edu
6217: $pattern=~s/\*//;
6218: if (!defined($name)) {
6219: use Socket;
6220: my $netaddr=inet_aton($ip);
6221: ($name)=gethostbyaddr($netaddr,AF_INET);
6222: }
1.1219 raeburn 6223: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 6224: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
6225: #127.0.0.1
1.1219 raeburn 6226: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 6227: } else {
6228: #some.name.com
6229: if (!defined($name)) {
6230: use Socket;
6231: my $netaddr=inet_aton($ip);
6232: ($name)=gethostbyaddr($netaddr,AF_INET);
6233: }
1.1219 raeburn 6234: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
6235: }
6236: if ($allowed =~ /^(0|1)$/) { last; }
6237: }
6238: if ($allowed eq '') {
6239: if ($numdenies && !$numallows) {
6240: $allowed = 1;
6241: } else {
6242: $allowed = 0;
1.682 raeburn 6243: }
6244: }
6245: return $allowed;
6246: }
6247:
6248: ###############################################
6249:
1.60 matthew 6250: =pod
6251:
1.112 bowersj2 6252: =head1 Domain Template Functions
6253:
6254: =over 4
6255:
6256: =item * &determinedomain()
1.60 matthew 6257:
6258: Inputs: $domain (usually will be undef)
6259:
1.63 www 6260: Returns: Determines which domain should be used for designs
1.60 matthew 6261:
6262: =cut
1.54 www 6263:
1.60 matthew 6264: ###############################################
1.63 www 6265: sub determinedomain {
6266: my $domain=shift;
1.531 albertel 6267: if (! $domain) {
1.60 matthew 6268: # Determine domain if we have not been given one
1.893 raeburn 6269: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 6270: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
6271: if ($env{'request.role.domain'}) {
6272: $domain=$env{'request.role.domain'};
1.60 matthew 6273: }
6274: }
1.63 www 6275: return $domain;
6276: }
6277: ###############################################
1.517 raeburn 6278:
1.518 albertel 6279: sub devalidate_domconfig_cache {
6280: my ($udom)=@_;
6281: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
6282: }
6283:
6284: # ---------------------- Get domain configuration for a domain
6285: sub get_domainconf {
6286: my ($udom) = @_;
6287: my $cachetime=1800;
6288: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
6289: if (defined($cached)) { return %{$result}; }
6290:
6291: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 6292: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 6293: my (%designhash,%legacy);
1.518 albertel 6294: if (keys(%domconfig) > 0) {
6295: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 6296: if (keys(%{$domconfig{'login'}})) {
6297: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 6298: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 6299: if (($key eq 'loginvia') || ($key eq 'headtag')) {
6300: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6301: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
6302: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
6303: if ($key eq 'loginvia') {
6304: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
6305: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
6306: $designhash{$udom.'.login.loginvia'} = $server;
6307: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
6308:
6309: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
6310: } else {
6311: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
6312: }
1.948 raeburn 6313: }
1.1208 raeburn 6314: } elsif ($key eq 'headtag') {
6315: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
6316: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 6317: }
1.946 raeburn 6318: }
1.1208 raeburn 6319: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
6320: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
6321: }
1.946 raeburn 6322: }
6323: }
6324: }
1.1366 raeburn 6325: } elsif ($key eq 'saml') {
6326: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6327: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
6328: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
6329: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386 raeburn 6330: foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366 raeburn 6331: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
6332: }
6333: }
6334: }
6335: }
1.946 raeburn 6336: } else {
6337: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
6338: $designhash{$udom.'.login.'.$key.'_'.$img} =
6339: $domconfig{'login'}{$key}{$img};
6340: }
1.699 raeburn 6341: }
6342: } else {
6343: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
6344: }
1.632 raeburn 6345: }
6346: } else {
6347: $legacy{'login'} = 1;
1.518 albertel 6348: }
1.632 raeburn 6349: } else {
6350: $legacy{'login'} = 1;
1.518 albertel 6351: }
6352: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 6353: if (keys(%{$domconfig{'rolecolors'}})) {
6354: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
6355: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
6356: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
6357: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
6358: }
1.518 albertel 6359: }
6360: }
1.632 raeburn 6361: } else {
6362: $legacy{'rolecolors'} = 1;
1.518 albertel 6363: }
1.632 raeburn 6364: } else {
6365: $legacy{'rolecolors'} = 1;
1.518 albertel 6366: }
1.948 raeburn 6367: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
6368: if ($domconfig{'autoenroll'}{'co-owners'}) {
6369: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
6370: }
6371: }
1.632 raeburn 6372: if (keys(%legacy) > 0) {
6373: my %legacyhash = &get_legacy_domconf($udom);
6374: foreach my $item (keys(%legacyhash)) {
6375: if ($item =~ /^\Q$udom\E\.login/) {
6376: if ($legacy{'login'}) {
6377: $designhash{$item} = $legacyhash{$item};
6378: }
6379: } else {
6380: if ($legacy{'rolecolors'}) {
6381: $designhash{$item} = $legacyhash{$item};
6382: }
1.518 albertel 6383: }
6384: }
6385: }
1.632 raeburn 6386: } else {
6387: %designhash = &get_legacy_domconf($udom);
1.518 albertel 6388: }
6389: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
6390: $cachetime);
6391: return %designhash;
6392: }
6393:
1.632 raeburn 6394: sub get_legacy_domconf {
6395: my ($udom) = @_;
6396: my %legacyhash;
6397: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
6398: my $designfile = $designdir.'/'.$udom.'.tab';
6399: if (-e $designfile) {
1.1317 raeburn 6400: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 6401: while (my $line = <$fh>) {
6402: next if ($line =~ /^\#/);
6403: chomp($line);
6404: my ($key,$val)=(split(/\=/,$line));
6405: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
6406: }
6407: close($fh);
6408: }
6409: }
1.1026 raeburn 6410: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 6411: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
6412: }
6413: return %legacyhash;
6414: }
6415:
1.63 www 6416: =pod
6417:
1.112 bowersj2 6418: =item * &domainlogo()
1.63 www 6419:
6420: Inputs: $domain (usually will be undef)
6421:
6422: Returns: A link to a domain logo, if the domain logo exists.
6423: If the domain logo does not exist, a description of the domain.
6424:
6425: =cut
1.112 bowersj2 6426:
1.63 www 6427: ###############################################
6428: sub domainlogo {
1.517 raeburn 6429: my $domain = &determinedomain(shift);
1.518 albertel 6430: my %designhash = &get_domainconf($domain);
1.517 raeburn 6431: # See if there is a logo
6432: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 6433: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 6434: if ($imgsrc =~ m{^/(adm|res)/}) {
6435: if ($imgsrc =~ m{^/res/}) {
6436: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
6437: &Apache::lonnet::repcopy($local_name);
6438: }
6439: $imgsrc = &lonhttpdurl($imgsrc);
1.1374 raeburn 6440: }
6441: my $alttext = $domain;
6442: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
6443: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
6444: }
6445: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 6446: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
6447: return &Apache::lonnet::domain($domain,'description');
1.59 www 6448: } else {
1.60 matthew 6449: return '';
1.59 www 6450: }
6451: }
1.63 www 6452: ##############################################
6453:
6454: =pod
6455:
1.112 bowersj2 6456: =item * &designparm()
1.63 www 6457:
6458: Inputs: $which parameter; $domain (usually will be undef)
6459:
6460: Returns: value of designparamter $which
6461:
6462: =cut
1.112 bowersj2 6463:
1.397 albertel 6464:
1.400 albertel 6465: ##############################################
1.397 albertel 6466: sub designparm {
6467: my ($which,$domain)=@_;
6468: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 6469: return $env{'environment.color.'.$which};
1.96 www 6470: }
1.63 www 6471: $domain=&determinedomain($domain);
1.1016 raeburn 6472: my %domdesign;
6473: unless ($domain eq 'public') {
6474: %domdesign = &get_domainconf($domain);
6475: }
1.520 raeburn 6476: my $output;
1.517 raeburn 6477: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 6478: $output = $domdesign{$domain.'.'.$which};
1.63 www 6479: } else {
1.520 raeburn 6480: $output = $defaultdesign{$which};
6481: }
6482: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 6483: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 6484: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 6485: if ($output =~ m{^/res/}) {
6486: my $local_name = &Apache::lonnet::filelocation('',$output);
6487: &Apache::lonnet::repcopy($local_name);
6488: }
1.520 raeburn 6489: $output = &lonhttpdurl($output);
6490: }
1.63 www 6491: }
1.520 raeburn 6492: return $output;
1.63 www 6493: }
1.59 www 6494:
1.822 bisitz 6495: ##############################################
6496: =pod
6497:
1.832 bisitz 6498: =item * &authorspace()
6499:
1.1028 raeburn 6500: Inputs: $url (usually will be undef).
1.832 bisitz 6501:
1.1132 raeburn 6502: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 6503: directory being viewed (or for which action is being taken).
6504: If $url is provided, and begins /priv/<domain>/<uname>
6505: the path will be that portion of the $context argument.
6506: Otherwise the path will be for the author space of the current
6507: user when the current role is author, or for that of the
6508: co-author/assistant co-author space when the current role
6509: is co-author or assistant co-author.
1.832 bisitz 6510:
6511: =cut
6512:
6513: sub authorspace {
1.1028 raeburn 6514: my ($url) = @_;
6515: if ($url ne '') {
6516: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
6517: return $1;
6518: }
6519: }
1.832 bisitz 6520: my $caname = '';
1.1024 www 6521: my $cadom = '';
1.1028 raeburn 6522: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 6523: ($cadom,$caname) =
1.832 bisitz 6524: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 6525: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 6526: $caname = $env{'user.name'};
1.1024 www 6527: $cadom = $env{'user.domain'};
1.832 bisitz 6528: }
1.1028 raeburn 6529: if (($caname ne '') && ($cadom ne '')) {
6530: return "/priv/$cadom/$caname/";
6531: }
6532: return;
1.832 bisitz 6533: }
6534:
6535: ##############################################
6536: =pod
6537:
1.822 bisitz 6538: =item * &head_subbox()
6539:
6540: Inputs: $content (contains HTML code with page functions, etc.)
6541:
6542: Returns: HTML div with $content
6543: To be included in page header
6544:
6545: =cut
6546:
6547: sub head_subbox {
6548: my ($content)=@_;
6549: my $output =
1.993 raeburn 6550: '<div class="LC_head_subbox">'
1.822 bisitz 6551: .$content
6552: .'</div>'
6553: }
6554:
6555: ##############################################
6556: =pod
6557:
6558: =item * &CSTR_pageheader()
6559:
1.1026 raeburn 6560: Input: (optional) filename from which breadcrumb trail is built.
6561: In most cases no input as needed, as $env{'request.filename'}
6562: is appropriate for use in building the breadcrumb trail.
1.1379 raeburn 6563: frameset flag
6564: If page header is being requested for use in a frameset, then
6565: the second (option) argument -- frameset will be true, and
6566: the target attribute set for links should be target="_parent".
1.1433 raeburn 6567: If $title is supplied as the third arg, that will be used to
1.1407 raeburn 6568: the left of the breadcrumbs tail for the current path.
1.822 bisitz 6569:
6570: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6571: To be included on Authoring Space pages
1.822 bisitz 6572:
6573: =cut
6574:
6575: sub CSTR_pageheader {
1.1407 raeburn 6576: my ($trailfile,$frameset,$title) = @_;
1.1026 raeburn 6577: if ($trailfile eq '') {
6578: $trailfile = $env{'request.filename'};
6579: }
6580:
6581: # this is for resources; directories have customtitle, and crumbs
6582: # and select recent are created in lonpubdir.pm
6583:
6584: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6585: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6586: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6587: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6588: $formaction =~ s{/+}{/}g;
1.822 bisitz 6589:
6590: my $parentpath = '';
6591: my $lastitem = '';
6592: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6593: $parentpath = $1;
6594: $lastitem = $2;
6595: } else {
6596: $lastitem = $thisdisfn;
6597: }
1.921 bisitz 6598:
1.1406 raeburn 6599: my $crsauthor;
1.1246 raeburn 6600: if (($env{'request.course.id'}) &&
6601: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6602: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6603: $crsauthor = 1;
1.1406 raeburn 6604: if ($title eq '') {
6605: $title = &mt('Course Authoring Space');
6606: }
6607: } elsif ($title eq '') {
1.1246 raeburn 6608: $title = &mt('Authoring Space');
6609: }
6610:
1.1379 raeburn 6611: my ($target,$crumbtarget) = (' target="_top"','_top');
6612: if ($frameset) {
6613: $target = ' target="_parent"';
6614: $crumbtarget = '_parent';
6615: } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6616: $target = '';
6617: $crumbtarget = '';
1.1379 raeburn 6618: } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378 raeburn 6619: $target = ' target="'.$env{'request.deeplink.target'}.'"';
6620: $crumbtarget = $env{'request.deeplink.target'};
6621: }
1.1313 raeburn 6622:
1.921 bisitz 6623: my $output =
1.1407 raeburn 6624: '<div>'
1.822 bisitz 6625: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6626: .'<b>'.$title.'</b> '
1.1314 raeburn 6627: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6628: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6629:
6630: if ($lastitem) {
6631: $output .=
6632: '<span class="LC_filename">'
6633: .$lastitem
6634: .'</span>';
6635: }
1.1245 raeburn 6636:
1.1246 raeburn 6637: if ($crsauthor) {
1.1379 raeburn 6638: $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6639: } else {
6640: $output .=
6641: '<br />'
1.1314 raeburn 6642: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6643: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6644: .'</form>'
1.1379 raeburn 6645: .&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6646: }
1.1407 raeburn 6647: $output .= '</div>';
1.921 bisitz 6648:
6649: return $output;
1.822 bisitz 6650: }
6651:
1.1419 raeburn 6652: ##############################################
6653: =pod
6654:
6655: =item * &nocodemirror()
6656:
6657: Input: None
6658:
6659: Returns: 1 if CodeMirror is deactivated based on
6660: user's preference, or domain default,
6661: if user indicated use of default.
6662:
6663: =cut
6664:
1.1416 raeburn 6665: sub nocodemirror {
6666: my $nocodem = $env{'environment.nocodemirror'};
6667: unless ($nocodem) {
6668: my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
6669: if ($domdefs{'nocodemirror'}) {
6670: $nocodem = 'yes';
6671: }
6672: }
1.1417 raeburn 6673: if ($nocodem eq 'yes') {
6674: return 1;
6675: }
6676: return;
1.1416 raeburn 6677: }
6678:
1.1419 raeburn 6679: ##############################################
6680: =pod
6681:
6682: =item * &permitted_editors()
6683:
1.1422 raeburn 6684: Input: $uri (optional)
1.1419 raeburn 6685:
6686: Returns: %editors hash in which keys are editors
1.1429 raeburn 6687: permitted in current Authoring Space,
6688: or in current course for web pages
6689: created in a course.
6690:
1.1419 raeburn 6691: Value for each key is 1. Possible keys
1.1429 raeburn 6692: are: edit, xml, and daxe.
6693:
6694: For a regular Authoring Space, if no specific
1.1419 raeburn 6695: set of editors has been set for the Author
6696: who owns the Authoring Space, then the
6697: domain default will be used. If no domain
6698: default has been set, then the keys will be
6699: edit and xml.
6700:
1.1429 raeburn 6701: For a course author, or for web pages created
6702: in a course, if no specific set of editors has
6703: been set for the course, then the domain
6704: course default will be used. If no domain
6705: course default has been set, then the keys
6706: will be edit and xml.
6707:
1.1419 raeburn 6708: =cut
6709:
1.1418 raeburn 6710: sub permitted_editors {
1.1422 raeburn 6711: my ($uri) = @_;
1.1429 raeburn 6712: my ($is_author,$is_coauthor,$is_course,$auname,$audom,%editors);
1.1418 raeburn 6713: if ($env{'request.role'} =~ m{^au\./}) {
6714: $is_author = 1;
6715: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
6716: ($audom,$auname) = ($1,$2);
6717: if (($audom ne '') && ($auname ne '')) {
6718: if (($env{'user.domain'} eq $audom) &&
6719: ($env{'user.name'} eq $auname)) {
6720: $is_author = 1;
6721: } else {
6722: $is_coauthor = 1;
6723: }
6724: }
6725: } elsif ($env{'request.course.id'}) {
1.1429 raeburn 6726: my ($cdom,$cnum);
6727: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
6728: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
6729: if (($env{'request.editurl'} =~ m{^/priv/\Q$cdom/$cnum\E/}) ||
1.1430 raeburn 6730: ($env{'request.editurl'} =~ m{^/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/}) ||
6731: ($uri =~ m{^/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/})) {
1.1429 raeburn 6732: $is_course = 1;
6733: } elsif ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
1.1418 raeburn 6734: ($audom,$auname) = ($1,$2);
6735: } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6736: ($audom,$auname) = ($1,$2);
1.1422 raeburn 6737: } elsif (($uri eq '/daxesave') &&
1.1429 raeburn 6738: (($env{'form.path'} =~ m{^/daxeopen/priv/\Q$cdom/$cnum\E/}) ||
6739: ($env{'form.path'} =~ m{^/daxeopen/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/}))) {
6740: $is_course = 1;
6741: } elsif (($uri eq '/daxesave') &&
1.1422 raeburn 6742: ($env{'form.path'} =~ m{^/daxeopen/priv/($match_domain)/($match_username)/})) {
6743: ($audom,$auname) = ($1,$2);
1.1418 raeburn 6744: }
1.1429 raeburn 6745: unless ($is_course) {
6746: if (($audom ne '') && ($auname ne '')) {
6747: if (($env{'user.domain'} eq $audom) &&
6748: ($env{'user.name'} eq $auname)) {
6749: $is_author = 1;
6750: } else {
6751: $is_coauthor = 1;
6752: }
1.1418 raeburn 6753: }
6754: }
6755: }
6756: if ($is_author) {
6757: if (exists($env{'environment.editors'})) {
6758: map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
6759: } else {
6760: %editors = ( edit => 1,
6761: xml => 1,
6762: );
6763: }
6764: } elsif ($is_coauthor) {
6765: if (exists($env{"environment.internal.editors./$audom/$auname"})) {
6766: map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
6767: } else {
6768: %editors = ( edit => 1,
6769: xml => 1,
6770: );
6771: }
1.1429 raeburn 6772: } elsif ($is_course) {
6773: if (exists($env{'course.'.$env{'request.course.id'}.'.internal.crseditors'})) {
6774: map { $editors{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.internal.crseditors'});
6775: } else {
6776: my %domdefaults = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'});
6777: if (exists($domdefaults{'crseditors'})) {
6778: map { $editors{$_} = 1; } split(/,/,$domdefaults{'crseditors'});
6779: } else {
6780: %editors = ( edit => 1,
6781: xml => 1,
6782: );
6783: }
6784: }
1.1418 raeburn 6785: } else {
6786: %editors = ( edit => 1,
6787: xml => 1,
6788: );
6789: }
6790: return %editors;
6791: }
6792:
1.60 matthew 6793: ###############################################
6794: ###############################################
6795:
6796: =pod
6797:
1.112 bowersj2 6798: =back
6799:
1.549 albertel 6800: =head1 HTML Helpers
1.112 bowersj2 6801:
6802: =over 4
6803:
6804: =item * &bodytag()
1.60 matthew 6805:
6806: Returns a uniform header for LON-CAPA web pages.
6807:
6808: Inputs:
6809:
1.112 bowersj2 6810: =over 4
6811:
6812: =item * $title, A title to be displayed on the page.
6813:
6814: =item * $function, the current role (can be undef).
6815:
6816: =item * $addentries, extra parameters for the <body> tag.
6817:
6818: =item * $bodyonly, if defined, only return the <body> tag.
6819:
6820: =item * $domain, if defined, force a given domain.
6821:
6822: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6823: text interface only)
1.60 matthew 6824:
1.814 bisitz 6825: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6826: navigational links
1.317 albertel 6827:
1.338 albertel 6828: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6829:
1.460 albertel 6830: =item * $args, optional argument valid values are
6831: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6832: use_absolute -> for external resource or syllabus, this will
6833: contain https://<hostname> if server uses
6834: https (as per hosts.tab), but request is for http
6835: hostname -> hostname, from $r->hostname().
1.460 albertel 6836:
1.1096 raeburn 6837: =item * $advtoolsref, optional argument, ref to an array containing
6838: inlineremote items to be added in "Functions" menu below
6839: breadcrumbs.
6840:
1.1316 raeburn 6841: =item * $ltiscope, optional argument, will be one of: resource, map or
6842: course, if LON-CAPA is in LTI Provider context. Value is
6843: the scope of use, i.e., launch was for access to a single, a map
6844: or the entire course.
6845:
6846: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6847: context, this will contain the URL for the landing item in
6848: the course, after launch from an LTI Consumer
6849:
1.1318 raeburn 6850: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6851: context, this will contain a reference to hash of items
6852: to be included in the page header and/or inline menu.
6853:
1.1385 raeburn 6854: =item * $menucoll, optional argument, if specific menu collection is in
6855: effect, either set as the default for the course, or set for
6856: the deeplink paramater for $env{'request.deeplink.login'}
6857: then $menucoll will be the number of that collection.
6858:
6859: =item * $menuref, optional argument, reference to a hash, containing the
6860: menu options included for the menu in effect, based on the
6861: configuration for the numbered menu collection in use.
6862:
6863: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
6864: within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
6865: if so, $showncrumbsref is set there to 1, and will propagate back
6866: via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
6867: being called a second time.
6868:
1.112 bowersj2 6869: =back
6870:
1.60 matthew 6871: Returns: A uniform header for LON-CAPA web pages.
6872: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6873: If $bodyonly is undef or zero, an html string containing a <body> tag and
6874: other decorations will be returned.
6875:
6876: =cut
6877:
1.54 www 6878: sub bodytag {
1.831 bisitz 6879: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6880: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385 raeburn 6881: $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339 albertel 6882:
1.954 raeburn 6883: my $public;
6884: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6885: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6886: $public = 1;
6887: }
1.460 albertel 6888: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6889: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6890: my $hostname = $args->{'hostname'};
1.339 albertel 6891:
1.183 matthew 6892: $function = &get_users_function() if (!$function);
1.339 albertel 6893: my $font = &designparm($function.'.font',$domain);
6894: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6895:
1.803 bisitz 6896: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6897: 'bgcolor' => $pgbg,
1.339 albertel 6898: 'text' => $font,
6899: 'alink' => &designparm($function.'.alink',$domain),
6900: 'vlink' => &designparm($function.'.vlink',$domain),
6901: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6902: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6903:
1.63 www 6904: # role and realm
1.1178 raeburn 6905: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6906: if ($realm) {
6907: $realm = '/'.$realm;
6908: }
1.1357 raeburn 6909: if ($role eq 'ca') {
1.479 albertel 6910: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6911: $realm = &plainname($rname,$rdom);
1.378 raeburn 6912: }
1.55 www 6913: # realm
1.1357 raeburn 6914: my ($cid,$sec);
1.258 albertel 6915: if ($env{'request.course.id'}) {
1.1357 raeburn 6916: $cid = $env{'request.course.id'};
6917: if ($env{'request.course.sec'}) {
6918: $sec = $env{'request.course.sec'};
6919: }
6920: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6921: if (&Apache::lonnet::is_course($1,$2)) {
6922: $cid = $1.'_'.$2;
6923: $sec = $3;
6924: }
6925: }
6926: if ($cid) {
1.378 raeburn 6927: if ($env{'request.role'} !~ /^cr/) {
6928: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6929: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6930: if ($env{'request.role.desc'}) {
6931: $role = $env{'request.role.desc'};
6932: } else {
6933: $role = &mt('Helpdesk[_1]',' '.$2);
6934: }
1.1257 raeburn 6935: } else {
6936: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6937: }
1.1357 raeburn 6938: if ($sec) {
6939: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6940: }
1.1357 raeburn 6941: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6942: } else {
6943: $role = &Apache::lonnet::plaintext($role);
1.54 www 6944: }
1.433 albertel 6945:
1.359 albertel 6946: if (!$realm) { $realm=' '; }
1.330 albertel 6947:
1.438 albertel 6948: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6949:
1.101 www 6950: # construct main body tag
1.359 albertel 6951: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6952: &Apache::lontexconvert::init_math_support();
1.252 albertel 6953:
1.1131 raeburn 6954: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6955:
1.1130 raeburn 6956: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6957: return $bodytag;
1.1130 raeburn 6958: }
1.359 albertel 6959:
1.954 raeburn 6960: if ($public) {
1.433 albertel 6961: undef($role);
6962: }
1.1318 raeburn 6963:
1.1359 raeburn 6964: my $showcrstitle = 1;
1.1357 raeburn 6965: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6966: if (ref($ltimenu) eq 'HASH') {
6967: unless ($ltimenu->{'role'}) {
6968: undef($role);
6969: }
6970: unless ($ltimenu->{'coursetitle'}) {
6971: $realm=' ';
1.1359 raeburn 6972: $showcrstitle = 0;
6973: }
6974: }
6975: } elsif (($cid) && ($menucoll)) {
6976: if (ref($menuref) eq 'HASH') {
6977: unless ($menuref->{'role'}) {
6978: undef($role);
6979: }
6980: unless ($menuref->{'crs'}) {
6981: $realm=' ';
6982: $showcrstitle = 0;
1.1318 raeburn 6983: }
6984: }
6985: }
6986:
1.762 bisitz 6987: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6988: #
6989: # Extra info if you are the DC
6990: my $dc_info = '';
1.1359 raeburn 6991: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6992: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6993: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6994: $dc_info =~ s/\s+$//;
1.359 albertel 6995: }
6996:
1.1237 raeburn 6997: my $crstype;
1.1357 raeburn 6998: if ($cid) {
6999: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 7000: } elsif ($args->{'crstype'}) {
7001: $crstype = $args->{'crstype'};
7002: }
7003: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
7004: undef($role);
7005: } else {
1.1242 raeburn 7006: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 7007: }
1.853 droeschl 7008:
1.903 droeschl 7009: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
7010:
7011: # if ($env{'request.state'} eq 'construct') {
7012: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
7013: # }
7014:
1.1440 raeburn 7015: my $need_endlcint;
7016: unless ($args->{'switchserver'}) {
7017: $bodytag .= Apache::lonhtmlcommon::scripttag(
7018: Apache::lonmenu::utilityfunctions($httphost), 'start');
7019: $need_endlcint = 1;
7020: }
1.359 albertel 7021:
1.1427 raeburn 7022: my $collapsible;
1.1423 raeburn 7023: if ($args->{'collapsible_header'} ne '') {
1.1427 raeburn 7024: $collapsible = 1;
7025: my ($menustate,$tiptext,$divclass);
7026: if ($args->{'start_collapsed'}) {
7027: $menustate = 'collapsed';
7028: $tiptext = 'display';
7029: $divclass = 'hidden';
7030: } else {
7031: $menustate = 'expanded';
7032: $tiptext = 'hide';
7033: $divclass = 'shown';
7034: }
7035: my $alttext = &mt('menu state: '.$menustate);
7036: my $tooltip = &mt($tiptext.' standard menus');
1.1421 raeburn 7037: $bodytag .= <<"END";
7038: <div id="LC_expandingContainer" style="display:inline;">
7039: <div id="LC_collapsible" class="LC_collapse_trigger" style="position: absolute;top: -5px;left: 0px; z-index:101; display:inline;">
1.1427 raeburn 7040: <a href="#" style="text-decoration:none;"><img class="LC_collapsible_indicator" alt="$alttext" title="$tooltip" src="/res/adm/pages/$menustate.png" style="border:0;margin:0;padding:0;max-width:100%;height:auto" /></a></div>
7041: <div class="LC_menus_content $divclass">
1.1421 raeburn 7042: END
7043: }
1.1318 raeburn 7044: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 7045: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380 raeburn 7046: $args->{'links_disabled'},
1.1421 raeburn 7047: $args->{'links_target'},
1.1427 raeburn 7048: $collapsible);
1.359 albertel 7049:
1.1318 raeburn 7050: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
7051: if ($dc_info) {
7052: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
7053: }
7054: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
7055: <em>$realm</em> $dc_info</div>|;
1.1440 raeburn 7056: if ($need_endlcint) {
7057: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
7058: }
1.1318 raeburn 7059: return $bodytag;
7060: }
1.894 droeschl 7061:
1.1318 raeburn 7062: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
7063: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
7064: }
1.916 droeschl 7065:
1.1318 raeburn 7066: $bodytag .= $right;
1.852 droeschl 7067:
1.1318 raeburn 7068: if ($dc_info) {
7069: $dc_info = &dc_courseid_toggle($dc_info);
7070: }
7071: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 7072: }
1.916 droeschl 7073:
1.1169 raeburn 7074: #if directed to not display the secondary menu, don't.
1.1168 raeburn 7075: if ($args->{'no_secondary_menu'}) {
1.1440 raeburn 7076: if ($need_endlcint) {
7077: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
7078: }
1.1168 raeburn 7079: return $bodytag;
7080: }
1.1169 raeburn 7081: #don't show menus for public users
1.954 raeburn 7082: if (!$public){
1.1318 raeburn 7083: unless ($args->{'no_inline_menu'}) {
7084: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 7085: $args->{'no_primary_menu'},
1.1369 raeburn 7086: $menucoll,$menuref,
1.1380 raeburn 7087: $args->{'links_disabled'},
7088: $args->{'links_target'});
1.1318 raeburn 7089: }
1.903 droeschl 7090: $bodytag .= Apache::lonmenu::serverform();
1.1440 raeburn 7091: if ($need_endlcint) {
7092: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
7093: }
1.920 raeburn 7094: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 7095: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385 raeburn 7096: $args->{'bread_crumbs'},'','',$hostname,
7097: $ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 7098: } elsif ($forcereg) {
7099: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385 raeburn 7100: $args->{'group'},$args->{'hide_buttons'},
7101: $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 7102: } else {
7103: $bodytag .=
7104: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
7105: $forcereg,$args->{'group'},
7106: $args->{'bread_crumbs'},
1.1274 raeburn 7107: $advtoolsref,'',$hostname);
1.920 raeburn 7108: }
1.1440 raeburn 7109: } else {
7110: # this is to separate menu from content when there's no secondary
1.1441 raeburn 7111: # menu. Especially needed for publicly accessible resources.
1.903 droeschl 7112: $bodytag .= '<hr style="clear:both" />';
1.1440 raeburn 7113: if ($need_endlcint) {
7114: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
7115: }
1.235 raeburn 7116: }
1.1423 raeburn 7117: if ($args->{'collapsible_header'} ne '') {
7118: $bodytag .= $args->{'collapsible_header'}.
7119: '<div id="LC_collapsible_separator"></div>'.
1.1421 raeburn 7120: '</div></div>';
7121: }
1.235 raeburn 7122: return $bodytag;
1.182 matthew 7123: }
7124:
1.917 raeburn 7125: sub dc_courseid_toggle {
7126: my ($dc_info) = @_;
1.980 raeburn 7127: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 7128: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 7129: &mt('(More ...)').'</a></span>'.
7130: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
7131: }
7132:
1.330 albertel 7133: sub make_attr_string {
7134: my ($register,$attr_ref) = @_;
7135:
7136: if ($attr_ref && !ref($attr_ref)) {
7137: die("addentries Must be a hash ref ".
7138: join(':',caller(1))." ".
7139: join(':',caller(0))." ");
7140: }
7141:
7142: if ($register) {
1.339 albertel 7143: my ($on_load,$on_unload);
7144: foreach my $key (keys(%{$attr_ref})) {
7145: if (lc($key) eq 'onload') {
7146: $on_load.=$attr_ref->{$key}.';';
7147: delete($attr_ref->{$key});
7148:
7149: } elsif (lc($key) eq 'onunload') {
7150: $on_unload.=$attr_ref->{$key}.';';
7151: delete($attr_ref->{$key});
7152: }
7153: }
1.953 droeschl 7154: $attr_ref->{'onload'} = $on_load;
7155: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 7156: }
1.339 albertel 7157:
1.330 albertel 7158: my $attr_string;
1.1159 raeburn 7159: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 7160: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
7161: }
7162: return $attr_string;
7163: }
7164:
7165:
1.182 matthew 7166: ###############################################
1.251 albertel 7167: ###############################################
7168:
7169: =pod
7170:
7171: =item * &endbodytag()
7172:
7173: Returns a uniform footer for LON-CAPA web pages.
7174:
1.635 raeburn 7175: Inputs: 1 - optional reference to an args hash
7176: If in the hash, key for noredirectlink has a value which evaluates to true,
7177: a 'Continue' link is not displayed if the page contains an
7178: internal redirect in the <head></head> section,
7179: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 7180:
7181: =cut
7182:
7183: sub endbodytag {
1.635 raeburn 7184: my ($args) = @_;
1.1080 raeburn 7185: my $endbodytag;
7186: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
7187: $endbodytag='</body>';
7188: }
1.315 albertel 7189: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 7190: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386 raeburn 7191: my ($endbodyjs,$idattr);
7192: if ($env{'internal.head.to_opener'}) {
7193: my $linkid = 'LC_continue_link';
7194: $idattr = ' id="'.$linkid.'"';
7195: my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
7196: $endbodyjs=<<ENDJS;
7197: <script type="text/javascript">
7198: // <![CDATA[
7199: function ebFunction(evt) {
7200: evt.preventDefault();
7201: var dest = '$redirect_for_js';
7202: if (window.opener != null && !window.opener.closed) {
7203: window.opener.location.href=dest;
7204: window.close();
7205: } else {
7206: window.location.href=dest;
7207: }
7208: return false;
7209: }
7210:
7211: \$(document).ready(function () {
7212: if (document.getElementById('$linkid')) {
7213: var clickelem = document.getElementById('$linkid');
7214: clickelem.addEventListener('click',ebFunction,false);
7215: }
7216: });
7217: // ]]>
7218: </script>
7219: ENDJS
7220: }
1.635 raeburn 7221: $endbodytag=
1.1386 raeburn 7222: "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635 raeburn 7223: &mt('Continue').'</a>'.
7224: $endbodytag;
7225: }
1.315 albertel 7226: }
1.1411 raeburn 7227: if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
7228: $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
7229: }
1.251 albertel 7230: return $endbodytag;
7231: }
7232:
1.352 albertel 7233: =pod
7234:
7235: =item * &standard_css()
7236:
7237: Returns a style sheet
7238:
7239: Inputs: (all optional)
7240: domain -> force to color decorate a page for a specific
7241: domain
7242: function -> force usage of a specific rolish color scheme
7243: bgcolor -> override the default page bgcolor
7244:
7245: =cut
7246:
1.343 albertel 7247: sub standard_css {
1.345 albertel 7248: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 7249: $function = &get_users_function() if (!$function);
7250: my $tabbg = &designparm($function.'.tabbg', $domain);
7251: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 7252: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 7253: #second colour for later usage
1.345 albertel 7254: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 7255: my $pgbg_or_bgcolor =
7256: $bgcolor ||
1.352 albertel 7257: &designparm($function.'.pgbg', $domain);
1.382 albertel 7258: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 7259: my $alink = &designparm($function.'.alink', $domain);
7260: my $vlink = &designparm($function.'.vlink', $domain);
7261: my $link = &designparm($function.'.link', $domain);
7262:
1.602 albertel 7263: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 7264: my $mono = 'monospace';
1.850 bisitz 7265: my $data_table_head = $sidebg;
7266: my $data_table_light = '#FAFAFA';
1.1060 bisitz 7267: my $data_table_dark = '#E0E0E0';
1.470 banghart 7268: my $data_table_darker = '#CCCCCC';
1.349 albertel 7269: my $data_table_highlight = '#FFFF00';
1.352 albertel 7270: my $mail_new = '#FFBB77';
7271: my $mail_new_hover = '#DD9955';
7272: my $mail_read = '#BBBB77';
7273: my $mail_read_hover = '#999944';
7274: my $mail_replied = '#AAAA88';
7275: my $mail_replied_hover = '#888855';
7276: my $mail_other = '#99BBBB';
7277: my $mail_other_hover = '#669999';
1.391 albertel 7278: my $table_header = '#DDDDDD';
1.489 raeburn 7279: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 7280: my $lg_border_color = '#C8C8C8';
1.952 onken 7281: my $button_hover = '#BF2317';
1.392 albertel 7282:
1.608 albertel 7283: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 7284: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
7285: : '0 3px 0 4px';
1.448 albertel 7286:
1.523 albertel 7287:
1.343 albertel 7288: return <<END;
1.947 droeschl 7289:
7290: /* needed for iframe to allow 100% height in FF */
7291: body, html {
7292: margin: 0;
7293: padding: 0 0.5%;
7294: height: 99%; /* to avoid scrollbars */
7295: }
7296:
1.795 www 7297: body {
1.911 bisitz 7298: font-family: $sans;
7299: line-height:130%;
7300: font-size:0.83em;
7301: color:$font;
1.1436 raeburn 7302: background-color: $pgbg_or_bgcolor;
1.795 www 7303: }
7304:
1.959 onken 7305: a:focus,
7306: a:focus img {
1.795 www 7307: color: red;
7308: }
1.698 harmsja 7309:
1.911 bisitz 7310: form, .inline {
7311: display: inline;
1.795 www 7312: }
1.721 harmsja 7313:
1.1443 raeburn 7314: .LC_visually_hidden:not(:focus):not(:active) {
7315: clip-path: inset(50%);
7316: height: 1px;
7317: overflow: hidden;
7318: position: absolute;
7319: white-space: nowrap;
7320: width: 1px;
7321: display: inline;
7322: }
7323:
1.1421 raeburn 7324: .LC_menus_content.shown{
1.1428 raeburn 7325: display: block;
1.1421 raeburn 7326: }
7327:
7328: .LC_menus_content.hidden {
7329: display: none;
7330: }
7331:
1.795 www 7332: .LC_right {
1.911 bisitz 7333: text-align:right;
1.795 www 7334: }
7335:
1.1449 raeburn 7336: .LC_center {
7337: text-align:center;
7338: }
7339:
1.795 www 7340: .LC_middle {
1.911 bisitz 7341: vertical-align:middle;
1.795 www 7342: }
1.721 harmsja 7343:
1.1130 raeburn 7344: .LC_floatleft {
7345: float: left;
7346: }
7347:
7348: .LC_floatright {
7349: float: right;
7350: }
7351:
1.911 bisitz 7352: .LC_400Box {
7353: width:400px;
7354: }
1.721 harmsja 7355:
1.1421 raeburn 7356: #LC_collapsible_separator {
7357: border: 1px solid black;
7358: width: 99.9%;
7359: height: 0px;
7360: }
7361:
1.947 droeschl 7362: .LC_iframecontainer {
7363: width: 98%;
7364: margin: 0;
7365: position: fixed;
7366: top: 8.5em;
7367: bottom: 0;
7368: }
7369:
7370: .LC_iframecontainer iframe{
7371: border: none;
7372: width: 100%;
7373: height: 100%;
7374: }
7375:
1.778 bisitz 7376: .LC_filename {
7377: font-family: $mono;
7378: white-space:pre;
1.921 bisitz 7379: font-size: 120%;
1.778 bisitz 7380: }
7381:
7382: .LC_fileicon {
7383: border: none;
7384: height: 1.3em;
7385: vertical-align: text-bottom;
7386: margin-right: 0.3em;
7387: text-decoration:none;
7388: }
7389:
1.1008 www 7390: .LC_setting {
7391: text-decoration:underline;
7392: }
7393:
1.350 albertel 7394: .LC_error {
7395: color: red;
7396: }
1.795 www 7397:
1.1097 bisitz 7398: .LC_warning {
7399: color: darkorange;
7400: }
7401:
1.457 albertel 7402: .LC_diff_removed {
1.733 bisitz 7403: color: red;
1.394 albertel 7404: }
1.532 albertel 7405:
7406: .LC_info,
1.457 albertel 7407: .LC_success,
7408: .LC_diff_added {
1.350 albertel 7409: color: green;
7410: }
1.795 www 7411:
1.802 bisitz 7412: div.LC_confirm_box {
7413: background-color: #FAFAFA;
7414: border: 1px solid $lg_border_color;
7415: margin-right: 0;
7416: padding: 5px;
7417: }
7418:
7419: div.LC_confirm_box .LC_error img,
7420: div.LC_confirm_box .LC_success img {
7421: vertical-align: middle;
7422: }
7423:
1.1242 raeburn 7424: .LC_maxwidth {
7425: max-width: 100%;
7426: height: auto;
7427: }
7428:
1.1243 raeburn 7429: .LC_textsize_mobile {
7430: \@media only screen and (max-device-width: 480px) {
7431: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
7432: }
7433: }
7434:
1.440 albertel 7435: .LC_icon {
1.771 droeschl 7436: border: none;
1.790 droeschl 7437: vertical-align: middle;
1.771 droeschl 7438: }
7439:
1.543 albertel 7440: .LC_docs_spacer {
7441: width: 25px;
7442: height: 1px;
1.771 droeschl 7443: border: none;
1.543 albertel 7444: }
1.346 albertel 7445:
1.532 albertel 7446: .LC_internal_info {
1.735 bisitz 7447: color: #999999;
1.532 albertel 7448: }
7449:
1.794 www 7450: .LC_discussion {
1.1050 www 7451: background: $data_table_dark;
1.911 bisitz 7452: border: 1px solid black;
7453: margin: 2px;
1.794 www 7454: }
7455:
7456: .LC_disc_action_left {
1.1050 www 7457: background: $sidebg;
1.911 bisitz 7458: text-align: left;
1.1050 www 7459: padding: 4px;
7460: margin: 2px;
1.794 www 7461: }
7462:
7463: .LC_disc_action_right {
1.1050 www 7464: background: $sidebg;
1.911 bisitz 7465: text-align: right;
1.1050 www 7466: padding: 4px;
7467: margin: 2px;
1.794 www 7468: }
7469:
7470: .LC_disc_new_item {
1.911 bisitz 7471: background: white;
7472: border: 2px solid red;
1.1050 www 7473: margin: 4px;
7474: padding: 4px;
1.794 www 7475: }
7476:
7477: .LC_disc_old_item {
1.911 bisitz 7478: background: white;
1.1050 www 7479: margin: 4px;
7480: padding: 4px;
1.794 www 7481: }
7482:
1.458 albertel 7483: table.LC_pastsubmission {
7484: border: 1px solid black;
7485: margin: 2px;
7486: }
7487:
1.924 bisitz 7488: table#LC_menubuttons {
1.345 albertel 7489: width: 100%;
7490: background: $pgbg;
1.392 albertel 7491: border: 2px;
1.402 albertel 7492: border-collapse: separate;
1.803 bisitz 7493: padding: 0;
1.345 albertel 7494: }
1.392 albertel 7495:
1.801 tempelho 7496: table#LC_title_bar a {
7497: color: $fontmenu;
7498: }
1.836 bisitz 7499:
1.807 droeschl 7500: table#LC_title_bar {
1.819 tempelho 7501: clear: both;
1.836 bisitz 7502: display: none;
1.807 droeschl 7503: }
7504:
1.795 www 7505: table#LC_title_bar,
1.933 droeschl 7506: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 7507: table#LC_title_bar.LC_with_remote {
1.359 albertel 7508: width: 100%;
1.392 albertel 7509: border-color: $pgbg;
7510: border-style: solid;
7511: border-width: $border;
1.379 albertel 7512: background: $pgbg;
1.801 tempelho 7513: color: $fontmenu;
1.392 albertel 7514: border-collapse: collapse;
1.803 bisitz 7515: padding: 0;
1.819 tempelho 7516: margin: 0;
1.359 albertel 7517: }
1.795 www 7518:
1.933 droeschl 7519: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 7520: margin: 0;
7521: padding: 0;
1.933 droeschl 7522: position: relative;
7523: list-style: none;
1.913 droeschl 7524: }
1.933 droeschl 7525: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 7526: display: inline;
7527: }
1.933 droeschl 7528:
7529: .LC_breadcrumb_tools_navigation {
1.913 droeschl 7530: padding: 0;
1.933 droeschl 7531: margin: 0;
7532: float: left;
1.913 droeschl 7533: }
1.933 droeschl 7534: .LC_breadcrumb_tools_tools {
7535: padding: 0;
7536: margin: 0;
1.913 droeschl 7537: float: right;
7538: }
7539:
1.1240 raeburn 7540: .LC_placement_prog {
7541: padding-right: 20px;
7542: font-weight: bold;
7543: font-size: 90%;
7544: }
7545:
1.359 albertel 7546: table#LC_title_bar td {
7547: background: $tabbg;
7548: }
1.795 www 7549:
1.911 bisitz 7550: table#LC_menubuttons img {
1.803 bisitz 7551: border: none;
1.346 albertel 7552: }
1.795 www 7553:
1.842 droeschl 7554: .LC_breadcrumbs_component {
1.911 bisitz 7555: float: right;
7556: margin: 0 1em;
1.357 albertel 7557: }
1.842 droeschl 7558: .LC_breadcrumbs_component img {
1.911 bisitz 7559: vertical-align: middle;
1.777 tempelho 7560: }
1.795 www 7561:
1.1243 raeburn 7562: .LC_breadcrumbs_hoverable {
7563: background: $sidebg;
7564: }
7565:
1.383 albertel 7566: td.LC_table_cell_checkbox {
7567: text-align: center;
7568: }
1.795 www 7569:
7570: .LC_fontsize_small {
1.911 bisitz 7571: font-size: 70%;
1.705 tempelho 7572: }
7573:
1.844 bisitz 7574: #LC_breadcrumbs {
1.911 bisitz 7575: clear:both;
7576: background: $sidebg;
7577: border-bottom: 1px solid $lg_border_color;
7578: line-height: 2.5em;
1.933 droeschl 7579: overflow: hidden;
1.911 bisitz 7580: margin: 0;
7581: padding: 0;
1.995 raeburn 7582: text-align: left;
1.819 tempelho 7583: }
1.862 bisitz 7584:
1.1098 bisitz 7585: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 7586: clear:both;
7587: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 7588: border: 1px solid $sidebg;
1.1098 bisitz 7589: margin: 0 0 10px 0;
1.966 bisitz 7590: padding: 3px;
1.995 raeburn 7591: text-align: left;
1.822 bisitz 7592: }
7593:
1.795 www 7594: .LC_fontsize_medium {
1.911 bisitz 7595: font-size: 85%;
1.705 tempelho 7596: }
7597:
1.795 www 7598: .LC_fontsize_large {
1.911 bisitz 7599: font-size: 120%;
1.705 tempelho 7600: }
7601:
1.346 albertel 7602: .LC_menubuttons_inline_text {
7603: color: $font;
1.698 harmsja 7604: font-size: 90%;
1.701 harmsja 7605: padding-left:3px;
1.346 albertel 7606: }
7607:
1.934 droeschl 7608: .LC_menubuttons_inline_text img{
7609: vertical-align: middle;
7610: }
7611:
1.1051 www 7612: li.LC_menubuttons_inline_text img {
1.951 onken 7613: cursor:pointer;
1.1002 droeschl 7614: text-decoration: none;
1.951 onken 7615: }
7616:
1.526 www 7617: .LC_menubuttons_link {
7618: text-decoration: none;
7619: }
1.795 www 7620:
1.522 albertel 7621: .LC_menubuttons_category {
1.521 www 7622: color: $font;
1.526 www 7623: background: $pgbg;
1.521 www 7624: font-size: larger;
7625: font-weight: bold;
7626: }
7627:
1.346 albertel 7628: td.LC_menubuttons_text {
1.911 bisitz 7629: color: $font;
1.346 albertel 7630: }
1.706 harmsja 7631:
1.346 albertel 7632: .LC_current_location {
7633: background: $tabbg;
7634: }
1.795 www 7635:
1.1286 raeburn 7636: td.LC_zero_height {
7637: line-height: 0;
7638: cellpadding: 0;
7639: }
7640:
1.938 bisitz 7641: table.LC_data_table {
1.347 albertel 7642: border: 1px solid #000000;
1.402 albertel 7643: border-collapse: separate;
1.426 albertel 7644: border-spacing: 1px;
1.610 albertel 7645: background: $pgbg;
1.347 albertel 7646: }
1.795 www 7647:
1.422 albertel 7648: .LC_data_table_dense {
7649: font-size: small;
7650: }
1.795 www 7651:
1.507 raeburn 7652: table.LC_nested_outer {
7653: border: 1px solid #000000;
1.589 raeburn 7654: border-collapse: collapse;
1.803 bisitz 7655: border-spacing: 0;
1.507 raeburn 7656: width: 100%;
7657: }
1.795 www 7658:
1.879 raeburn 7659: table.LC_innerpickbox,
1.507 raeburn 7660: table.LC_nested {
1.803 bisitz 7661: border: none;
1.589 raeburn 7662: border-collapse: collapse;
1.803 bisitz 7663: border-spacing: 0;
1.507 raeburn 7664: width: 100%;
7665: }
1.795 www 7666:
1.911 bisitz 7667: table.LC_data_table tr th,
7668: table.LC_calendar tr th,
1.879 raeburn 7669: table.LC_prior_tries tr th,
7670: table.LC_innerpickbox tr th {
1.349 albertel 7671: font-weight: bold;
7672: background-color: $data_table_head;
1.801 tempelho 7673: color:$fontmenu;
1.701 harmsja 7674: font-size:90%;
1.347 albertel 7675: }
1.795 www 7676:
1.879 raeburn 7677: table.LC_innerpickbox tr th,
7678: table.LC_innerpickbox tr td {
7679: vertical-align: top;
7680: }
7681:
1.711 raeburn 7682: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7683: background-color: #CCCCCC;
1.711 raeburn 7684: font-weight: bold;
7685: text-align: left;
7686: }
1.795 www 7687:
1.912 bisitz 7688: table.LC_data_table tr.LC_odd_row > td {
7689: background-color: $data_table_light;
7690: padding: 2px;
7691: vertical-align: top;
7692: }
7693:
1.809 bisitz 7694: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7695: background-color: $data_table_light;
1.912 bisitz 7696: vertical-align: top;
7697: }
7698:
7699: table.LC_data_table tr.LC_even_row > td {
7700: background-color: $data_table_dark;
1.425 albertel 7701: padding: 2px;
1.900 bisitz 7702: vertical-align: top;
1.347 albertel 7703: }
1.795 www 7704:
1.809 bisitz 7705: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7706: background-color: $data_table_dark;
1.900 bisitz 7707: vertical-align: top;
1.347 albertel 7708: }
1.795 www 7709:
1.425 albertel 7710: table.LC_data_table tr.LC_data_table_highlight td {
7711: background-color: $data_table_darker;
7712: }
1.795 www 7713:
1.639 raeburn 7714: table.LC_data_table tr td.LC_leftcol_header {
7715: background-color: $data_table_head;
7716: font-weight: bold;
7717: }
1.795 www 7718:
1.451 albertel 7719: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7720: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7721: font-weight: bold;
7722: font-style: italic;
7723: text-align: center;
7724: padding: 8px;
1.347 albertel 7725: }
1.795 www 7726:
1.1114 raeburn 7727: table.LC_data_table tr.LC_empty_row td,
7728: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7729: background-color: $sidebg;
7730: }
7731:
7732: table.LC_nested tr.LC_empty_row td {
7733: background-color: #FFFFFF;
7734: }
7735:
1.890 droeschl 7736: table.LC_caption {
7737: }
7738:
1.507 raeburn 7739: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7740: padding: 4ex
7741: }
1.795 www 7742:
1.507 raeburn 7743: table.LC_nested_outer tr th {
7744: font-weight: bold;
1.801 tempelho 7745: color:$fontmenu;
1.507 raeburn 7746: background-color: $data_table_head;
1.701 harmsja 7747: font-size: small;
1.507 raeburn 7748: border-bottom: 1px solid #000000;
7749: }
1.795 www 7750:
1.507 raeburn 7751: table.LC_nested_outer tr td.LC_subheader {
7752: background-color: $data_table_head;
7753: font-weight: bold;
7754: font-size: small;
7755: border-bottom: 1px solid #000000;
7756: text-align: right;
1.451 albertel 7757: }
1.795 www 7758:
1.507 raeburn 7759: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7760: background-color: #CCCCCC;
1.451 albertel 7761: font-weight: bold;
7762: font-size: small;
1.507 raeburn 7763: text-align: center;
7764: }
1.795 www 7765:
1.589 raeburn 7766: table.LC_nested tr.LC_info_row td.LC_left_item,
7767: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7768: text-align: left;
1.451 albertel 7769: }
1.795 www 7770:
1.507 raeburn 7771: table.LC_nested td {
1.735 bisitz 7772: background-color: #FFFFFF;
1.451 albertel 7773: font-size: small;
1.507 raeburn 7774: }
1.795 www 7775:
1.507 raeburn 7776: table.LC_nested_outer tr th.LC_right_item,
7777: table.LC_nested tr.LC_info_row td.LC_right_item,
7778: table.LC_nested tr.LC_odd_row td.LC_right_item,
7779: table.LC_nested tr td.LC_right_item {
1.451 albertel 7780: text-align: right;
7781: }
7782:
1.507 raeburn 7783: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7784: background-color: #EEEEEE;
1.451 albertel 7785: }
7786:
1.473 raeburn 7787: table.LC_createuser {
7788: }
7789:
7790: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7791: font-size: small;
1.473 raeburn 7792: }
7793:
7794: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7795: background-color: #CCCCCC;
1.473 raeburn 7796: font-weight: bold;
7797: text-align: center;
7798: }
7799:
1.349 albertel 7800: table.LC_calendar {
7801: border: 1px solid #000000;
7802: border-collapse: collapse;
1.917 raeburn 7803: width: 98%;
1.349 albertel 7804: }
1.795 www 7805:
1.349 albertel 7806: table.LC_calendar_pickdate {
7807: font-size: xx-small;
7808: }
1.795 www 7809:
1.349 albertel 7810: table.LC_calendar tr td {
7811: border: 1px solid #000000;
7812: vertical-align: top;
1.917 raeburn 7813: width: 14%;
1.349 albertel 7814: }
1.795 www 7815:
1.349 albertel 7816: table.LC_calendar tr td.LC_calendar_day_empty {
7817: background-color: $data_table_dark;
7818: }
1.795 www 7819:
1.779 bisitz 7820: table.LC_calendar tr td.LC_calendar_day_current {
7821: background-color: $data_table_highlight;
1.777 tempelho 7822: }
1.795 www 7823:
1.938 bisitz 7824: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7825: background-color: $mail_new;
7826: }
1.795 www 7827:
1.938 bisitz 7828: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7829: background-color: $mail_new_hover;
7830: }
1.795 www 7831:
1.938 bisitz 7832: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7833: background-color: $mail_read;
7834: }
1.795 www 7835:
1.938 bisitz 7836: /*
7837: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7838: background-color: $mail_read_hover;
7839: }
1.938 bisitz 7840: */
1.795 www 7841:
1.938 bisitz 7842: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7843: background-color: $mail_replied;
7844: }
1.795 www 7845:
1.938 bisitz 7846: /*
7847: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7848: background-color: $mail_replied_hover;
7849: }
1.938 bisitz 7850: */
1.795 www 7851:
1.938 bisitz 7852: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7853: background-color: $mail_other;
7854: }
1.795 www 7855:
1.938 bisitz 7856: /*
7857: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7858: background-color: $mail_other_hover;
7859: }
1.938 bisitz 7860: */
1.494 raeburn 7861:
1.777 tempelho 7862: table.LC_data_table tr > td.LC_browser_file,
7863: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7864: background: #AAEE77;
1.389 albertel 7865: }
1.795 www 7866:
1.777 tempelho 7867: table.LC_data_table tr > td.LC_browser_file_locked,
7868: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7869: background: #FFAA99;
1.387 albertel 7870: }
1.795 www 7871:
1.777 tempelho 7872: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7873: background: #888888;
1.779 bisitz 7874: }
1.795 www 7875:
1.777 tempelho 7876: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7877: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7878: background: #F8F866;
1.777 tempelho 7879: }
1.795 www 7880:
1.696 bisitz 7881: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7882: background: #E0E8FF;
1.387 albertel 7883: }
1.696 bisitz 7884:
1.707 bisitz 7885: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7886: /* background: #77FF77; */
1.707 bisitz 7887: }
1.795 www 7888:
1.707 bisitz 7889: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7890: border-right: 8px solid #FFFF77;
1.707 bisitz 7891: }
1.795 www 7892:
1.707 bisitz 7893: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7894: border-right: 8px solid #FFAA77;
1.707 bisitz 7895: }
1.795 www 7896:
1.707 bisitz 7897: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7898: border-right: 8px solid #FF7777;
1.707 bisitz 7899: }
1.795 www 7900:
1.707 bisitz 7901: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7902: border-right: 8px solid #AAFF77;
1.707 bisitz 7903: }
1.795 www 7904:
1.707 bisitz 7905: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7906: border-right: 8px solid #11CC55;
1.707 bisitz 7907: }
7908:
1.388 albertel 7909: span.LC_current_location {
1.701 harmsja 7910: font-size:larger;
1.388 albertel 7911: background: $pgbg;
7912: }
1.387 albertel 7913:
1.1029 www 7914: span.LC_current_nav_location {
7915: font-weight:bold;
7916: background: $sidebg;
7917: }
7918:
1.395 albertel 7919: span.LC_parm_menu_item {
7920: font-size: larger;
7921: }
1.795 www 7922:
1.395 albertel 7923: span.LC_parm_scope_all {
7924: color: red;
7925: }
1.795 www 7926:
1.395 albertel 7927: span.LC_parm_scope_folder {
7928: color: green;
7929: }
1.795 www 7930:
1.395 albertel 7931: span.LC_parm_scope_resource {
7932: color: orange;
7933: }
1.795 www 7934:
1.395 albertel 7935: span.LC_parm_part {
7936: color: blue;
7937: }
1.795 www 7938:
1.911 bisitz 7939: span.LC_parm_folder,
7940: span.LC_parm_symb {
1.395 albertel 7941: font-size: x-small;
7942: font-family: $mono;
7943: color: #AAAAAA;
7944: }
7945:
1.977 bisitz 7946: ul.LC_parm_parmlist li {
7947: display: inline-block;
7948: padding: 0.3em 0.8em;
7949: vertical-align: top;
7950: width: 150px;
7951: border-top:1px solid $lg_border_color;
7952: }
7953:
1.795 www 7954: td.LC_parm_overview_level_menu,
7955: td.LC_parm_overview_map_menu,
7956: td.LC_parm_overview_parm_selectors,
7957: td.LC_parm_overview_restrictions {
1.396 albertel 7958: border: 1px solid black;
7959: border-collapse: collapse;
7960: }
1.795 www 7961:
1.1285 raeburn 7962: span.LC_parm_recursive,
7963: td.LC_parm_recursive {
7964: font-weight: bold;
7965: font-size: smaller;
7966: }
7967:
1.396 albertel 7968: table.LC_parm_overview_restrictions td {
7969: border-width: 1px 4px 1px 4px;
7970: border-style: solid;
7971: border-color: $pgbg;
7972: text-align: center;
7973: }
1.795 www 7974:
1.396 albertel 7975: table.LC_parm_overview_restrictions th {
7976: background: $tabbg;
7977: border-width: 1px 4px 1px 4px;
7978: border-style: solid;
7979: border-color: $pgbg;
7980: }
1.795 www 7981:
1.398 albertel 7982: table#LC_helpmenu {
1.803 bisitz 7983: border: none;
1.398 albertel 7984: height: 55px;
1.803 bisitz 7985: border-spacing: 0;
1.398 albertel 7986: }
7987:
7988: table#LC_helpmenu fieldset legend {
7989: font-size: larger;
7990: }
1.795 www 7991:
1.397 albertel 7992: table#LC_helpmenu_links {
7993: width: 100%;
7994: border: 1px solid black;
7995: background: $pgbg;
1.803 bisitz 7996: padding: 0;
1.397 albertel 7997: border-spacing: 1px;
7998: }
1.795 www 7999:
1.397 albertel 8000: table#LC_helpmenu_links tr td {
8001: padding: 1px;
8002: background: $tabbg;
1.399 albertel 8003: text-align: center;
8004: font-weight: bold;
1.397 albertel 8005: }
1.396 albertel 8006:
1.795 www 8007: table#LC_helpmenu_links a:link,
8008: table#LC_helpmenu_links a:visited,
1.397 albertel 8009: table#LC_helpmenu_links a:active {
8010: text-decoration: none;
8011: color: $font;
8012: }
1.795 www 8013:
1.397 albertel 8014: table#LC_helpmenu_links a:hover {
8015: text-decoration: underline;
8016: color: $vlink;
8017: }
1.396 albertel 8018:
1.417 albertel 8019: .LC_chrt_popup_exists {
8020: border: 1px solid #339933;
8021: margin: -1px;
8022: }
1.795 www 8023:
1.417 albertel 8024: .LC_chrt_popup_up {
8025: border: 1px solid yellow;
8026: margin: -1px;
8027: }
1.795 www 8028:
1.417 albertel 8029: .LC_chrt_popup {
8030: border: 1px solid #8888FF;
8031: background: #CCCCFF;
8032: }
1.795 www 8033:
1.421 albertel 8034: table.LC_pick_box {
8035: border-collapse: separate;
8036: background: white;
8037: border: 1px solid black;
8038: border-spacing: 1px;
8039: }
1.795 www 8040:
1.421 albertel 8041: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 8042: background: $sidebg;
1.421 albertel 8043: font-weight: bold;
1.900 bisitz 8044: text-align: left;
1.740 bisitz 8045: vertical-align: top;
1.421 albertel 8046: width: 184px;
8047: padding: 8px;
8048: }
1.795 www 8049:
1.579 raeburn 8050: table.LC_pick_box td.LC_pick_box_value {
8051: text-align: left;
8052: padding: 8px;
8053: }
1.795 www 8054:
1.579 raeburn 8055: table.LC_pick_box td.LC_pick_box_select {
8056: text-align: left;
8057: padding: 8px;
8058: }
1.795 www 8059:
1.424 albertel 8060: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 8061: padding: 0;
1.421 albertel 8062: height: 1px;
8063: background: black;
8064: }
1.795 www 8065:
1.421 albertel 8066: table.LC_pick_box td.LC_pick_box_submit {
8067: text-align: right;
8068: }
1.795 www 8069:
1.579 raeburn 8070: table.LC_pick_box td.LC_evenrow_value {
8071: text-align: left;
8072: padding: 8px;
8073: background-color: $data_table_light;
8074: }
1.795 www 8075:
1.579 raeburn 8076: table.LC_pick_box td.LC_oddrow_value {
8077: text-align: left;
8078: padding: 8px;
8079: background-color: $data_table_light;
8080: }
1.795 www 8081:
1.579 raeburn 8082: span.LC_helpform_receipt_cat {
8083: font-weight: bold;
8084: }
1.795 www 8085:
1.424 albertel 8086: table.LC_group_priv_box {
8087: background: white;
8088: border: 1px solid black;
8089: border-spacing: 1px;
8090: }
1.795 www 8091:
1.424 albertel 8092: table.LC_group_priv_box td.LC_pick_box_title {
8093: background: $tabbg;
8094: font-weight: bold;
8095: text-align: right;
8096: width: 184px;
8097: }
1.795 www 8098:
1.424 albertel 8099: table.LC_group_priv_box td.LC_groups_fixed {
8100: background: $data_table_light;
8101: text-align: center;
8102: }
1.795 www 8103:
1.424 albertel 8104: table.LC_group_priv_box td.LC_groups_optional {
8105: background: $data_table_dark;
8106: text-align: center;
8107: }
1.795 www 8108:
1.424 albertel 8109: table.LC_group_priv_box td.LC_groups_functionality {
8110: background: $data_table_darker;
8111: text-align: center;
8112: font-weight: bold;
8113: }
1.795 www 8114:
1.424 albertel 8115: table.LC_group_priv td {
8116: text-align: left;
1.803 bisitz 8117: padding: 0;
1.424 albertel 8118: }
8119:
8120: .LC_navbuttons {
8121: margin: 2ex 0ex 2ex 0ex;
8122: }
1.795 www 8123:
1.423 albertel 8124: .LC_topic_bar {
8125: font-weight: bold;
8126: background: $tabbg;
1.918 wenzelju 8127: margin: 1em 0em 1em 2em;
1.805 bisitz 8128: padding: 3px;
1.918 wenzelju 8129: font-size: 1.2em;
1.423 albertel 8130: }
1.795 www 8131:
1.423 albertel 8132: .LC_topic_bar span {
1.918 wenzelju 8133: left: 0.5em;
8134: position: absolute;
1.423 albertel 8135: vertical-align: middle;
1.918 wenzelju 8136: font-size: 1.2em;
1.423 albertel 8137: }
1.795 www 8138:
1.423 albertel 8139: table.LC_course_group_status {
8140: margin: 20px;
8141: }
1.795 www 8142:
1.423 albertel 8143: table.LC_status_selector td {
8144: vertical-align: top;
8145: text-align: center;
1.424 albertel 8146: padding: 4px;
8147: }
1.795 www 8148:
1.599 albertel 8149: div.LC_feedback_link {
1.616 albertel 8150: clear: both;
1.829 kalberla 8151: background: $sidebg;
1.779 bisitz 8152: width: 100%;
1.829 kalberla 8153: padding-bottom: 10px;
8154: border: 1px $tabbg solid;
1.833 kalberla 8155: height: 22px;
8156: line-height: 22px;
8157: padding-top: 5px;
8158: }
8159:
8160: div.LC_feedback_link img {
8161: height: 22px;
1.867 kalberla 8162: vertical-align:middle;
1.829 kalberla 8163: }
8164:
1.911 bisitz 8165: div.LC_feedback_link a {
1.829 kalberla 8166: text-decoration: none;
1.489 raeburn 8167: }
1.795 www 8168:
1.867 kalberla 8169: div.LC_comblock {
1.911 bisitz 8170: display:inline;
1.867 kalberla 8171: color:$font;
8172: font-size:90%;
8173: }
8174:
8175: div.LC_feedback_link div.LC_comblock {
8176: padding-left:5px;
8177: }
8178:
8179: div.LC_feedback_link div.LC_comblock a {
8180: color:$font;
8181: }
8182:
1.489 raeburn 8183: span.LC_feedback_link {
1.858 bisitz 8184: /* background: $feedback_link_bg; */
1.599 albertel 8185: font-size: larger;
8186: }
1.795 www 8187:
1.599 albertel 8188: span.LC_message_link {
1.858 bisitz 8189: /* background: $feedback_link_bg; */
1.599 albertel 8190: font-size: larger;
8191: position: absolute;
8192: right: 1em;
1.489 raeburn 8193: }
1.421 albertel 8194:
1.515 albertel 8195: table.LC_prior_tries {
1.524 albertel 8196: border: 1px solid #000000;
8197: border-collapse: separate;
8198: border-spacing: 1px;
1.515 albertel 8199: }
1.523 albertel 8200:
1.515 albertel 8201: table.LC_prior_tries td {
1.524 albertel 8202: padding: 2px;
1.515 albertel 8203: }
1.523 albertel 8204:
8205: .LC_answer_correct {
1.795 www 8206: background: lightgreen;
8207: color: darkgreen;
8208: padding: 6px;
1.523 albertel 8209: }
1.795 www 8210:
1.523 albertel 8211: .LC_answer_charged_try {
1.797 www 8212: background: #FFAAAA;
1.795 www 8213: color: darkred;
8214: padding: 6px;
1.523 albertel 8215: }
1.795 www 8216:
1.779 bisitz 8217: .LC_answer_not_charged_try,
1.523 albertel 8218: .LC_answer_no_grade,
8219: .LC_answer_late {
1.795 www 8220: background: lightyellow;
1.523 albertel 8221: color: black;
1.795 www 8222: padding: 6px;
1.523 albertel 8223: }
1.795 www 8224:
1.523 albertel 8225: .LC_answer_previous {
1.795 www 8226: background: lightblue;
8227: color: darkblue;
8228: padding: 6px;
1.523 albertel 8229: }
1.795 www 8230:
1.779 bisitz 8231: .LC_answer_no_message {
1.777 tempelho 8232: background: #FFFFFF;
8233: color: black;
1.795 www 8234: padding: 6px;
1.779 bisitz 8235: }
1.795 www 8236:
1.1334 raeburn 8237: .LC_answer_unknown,
8238: .LC_answer_warning {
1.779 bisitz 8239: background: orange;
8240: color: black;
1.795 www 8241: padding: 6px;
1.777 tempelho 8242: }
1.795 www 8243:
1.1446 raeburn 8244: .LC_prob_status {
1.1447 raeburn 8245: margin-top: 5px;
1.1446 raeburn 8246: padding-top: 0;
8247: padding-left: 0;
8248: padding-bottom: 0;
8249: padding-right: 5px;
8250: }
8251:
1.1448 raeburn 8252: .LC_mail_actions {
8253: float: left;
8254: padding: 0;
8255: margin: 6px;
8256: }
8257:
8258: .LC_vertical_line {
8259: width: 1px;
8260: background-color: black;
8261: height: 4em;
8262: float: left;
8263: margin: 0;
8264: padding: 0;
8265: }
8266:
1.529 albertel 8267: span.LC_prior_numerical,
8268: span.LC_prior_string,
8269: span.LC_prior_custom,
8270: span.LC_prior_reaction,
8271: span.LC_prior_math {
1.925 bisitz 8272: font-family: $mono;
1.523 albertel 8273: white-space: pre;
8274: }
8275:
1.525 albertel 8276: span.LC_prior_string {
1.925 bisitz 8277: font-family: $mono;
1.525 albertel 8278: white-space: pre;
8279: }
8280:
1.523 albertel 8281: table.LC_prior_option {
8282: width: 100%;
8283: border-collapse: collapse;
8284: }
1.795 www 8285:
1.911 bisitz 8286: table.LC_prior_rank,
1.795 www 8287: table.LC_prior_match {
1.528 albertel 8288: border-collapse: collapse;
8289: }
1.795 www 8290:
1.528 albertel 8291: table.LC_prior_option tr td,
8292: table.LC_prior_rank tr td,
8293: table.LC_prior_match tr td {
1.524 albertel 8294: border: 1px solid #000000;
1.515 albertel 8295: }
8296:
1.855 bisitz 8297: .LC_nobreak {
1.544 albertel 8298: white-space: nowrap;
1.519 raeburn 8299: }
8300:
1.576 raeburn 8301: span.LC_cusr_emph {
8302: font-style: italic;
8303: }
8304:
1.633 raeburn 8305: span.LC_cusr_subheading {
8306: font-weight: normal;
8307: font-size: 85%;
8308: }
8309:
1.861 bisitz 8310: div.LC_docs_entry_move {
1.859 bisitz 8311: border: 1px solid #BBBBBB;
1.545 albertel 8312: background: #DDDDDD;
1.861 bisitz 8313: width: 22px;
1.859 bisitz 8314: padding: 1px;
8315: margin: 0;
1.545 albertel 8316: }
8317:
1.861 bisitz 8318: table.LC_data_table tr > td.LC_docs_entry_commands,
8319: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 8320: font-size: x-small;
8321: }
1.795 www 8322:
1.861 bisitz 8323: .LC_docs_entry_parameter {
8324: white-space: nowrap;
8325: }
8326:
1.544 albertel 8327: .LC_docs_copy {
1.545 albertel 8328: color: #000099;
1.544 albertel 8329: }
1.795 www 8330:
1.544 albertel 8331: .LC_docs_cut {
1.545 albertel 8332: color: #550044;
1.544 albertel 8333: }
1.795 www 8334:
1.544 albertel 8335: .LC_docs_rename {
1.545 albertel 8336: color: #009900;
1.544 albertel 8337: }
1.795 www 8338:
1.544 albertel 8339: .LC_docs_remove {
1.545 albertel 8340: color: #990000;
8341: }
8342:
1.1284 raeburn 8343: .LC_docs_alias {
8344: color: #440055;
8345: }
8346:
1.1286 raeburn 8347: .LC_domprefs_email,
1.1284 raeburn 8348: .LC_docs_alias_name,
1.547 albertel 8349: .LC_docs_reinit_warn,
8350: .LC_docs_ext_edit {
8351: font-size: x-small;
8352: }
8353:
1.545 albertel 8354: table.LC_docs_adddocs td,
8355: table.LC_docs_adddocs th {
8356: border: 1px solid #BBBBBB;
8357: padding: 4px;
8358: background: #DDDDDD;
1.543 albertel 8359: }
8360:
1.584 albertel 8361: table.LC_sty_begin {
8362: background: #BBFFBB;
8363: }
1.795 www 8364:
1.584 albertel 8365: table.LC_sty_end {
8366: background: #FFBBBB;
8367: }
8368:
1.589 raeburn 8369: table.LC_double_column {
1.803 bisitz 8370: border-width: 0;
1.589 raeburn 8371: border-collapse: collapse;
8372: width: 100%;
8373: padding: 2px;
8374: }
8375:
8376: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 8377: top: 2px;
1.589 raeburn 8378: left: 2px;
8379: width: 47%;
8380: vertical-align: top;
8381: }
8382:
8383: table.LC_double_column tr td.LC_right_col {
8384: top: 2px;
1.779 bisitz 8385: right: 2px;
1.589 raeburn 8386: width: 47%;
8387: vertical-align: top;
8388: }
8389:
1.591 raeburn 8390: div.LC_left_float {
8391: float: left;
8392: padding-right: 5%;
1.597 albertel 8393: padding-bottom: 4px;
1.591 raeburn 8394: }
8395:
8396: div.LC_clear_float_header {
1.597 albertel 8397: padding-bottom: 2px;
1.591 raeburn 8398: }
8399:
8400: div.LC_clear_float_footer {
1.597 albertel 8401: padding-top: 10px;
1.591 raeburn 8402: clear: both;
8403: }
8404:
1.597 albertel 8405: div.LC_grade_show_user {
1.941 bisitz 8406: /* border-left: 5px solid $sidebg; */
8407: border-top: 5px solid #000000;
8408: margin: 50px 0 0 0;
1.936 bisitz 8409: padding: 15px 0 5px 10px;
1.597 albertel 8410: }
1.795 www 8411:
1.936 bisitz 8412: div.LC_grade_show_user_odd_row {
1.941 bisitz 8413: /* border-left: 5px solid #000000; */
8414: }
8415:
8416: div.LC_grade_show_user div.LC_Box {
8417: margin-right: 50px;
1.597 albertel 8418: }
8419:
8420: div.LC_grade_submissions,
8421: div.LC_grade_message_center,
1.936 bisitz 8422: div.LC_grade_info_links {
1.597 albertel 8423: margin: 5px;
8424: width: 99%;
8425: background: #FFFFFF;
8426: }
1.795 www 8427:
1.597 albertel 8428: div.LC_grade_submissions_header,
1.936 bisitz 8429: div.LC_grade_message_center_header {
1.705 tempelho 8430: font-weight: bold;
8431: font-size: large;
1.597 albertel 8432: }
1.795 www 8433:
1.597 albertel 8434: div.LC_grade_submissions_body,
1.936 bisitz 8435: div.LC_grade_message_center_body {
1.597 albertel 8436: border: 1px solid black;
8437: width: 99%;
8438: background: #FFFFFF;
8439: }
1.795 www 8440:
1.613 albertel 8441: table.LC_scantron_action {
8442: width: 100%;
8443: }
1.795 www 8444:
1.613 albertel 8445: table.LC_scantron_action tr th {
1.698 harmsja 8446: font-weight:bold;
8447: font-style:normal;
1.613 albertel 8448: }
1.795 www 8449:
1.779 bisitz 8450: .LC_edit_problem_header,
1.614 albertel 8451: div.LC_edit_problem_footer {
1.705 tempelho 8452: font-weight: normal;
8453: font-size: medium;
1.602 albertel 8454: margin: 2px;
1.1060 bisitz 8455: background-color: $sidebg;
1.600 albertel 8456: }
1.795 www 8457:
1.600 albertel 8458: div.LC_edit_problem_header,
1.602 albertel 8459: div.LC_edit_problem_header div,
1.614 albertel 8460: div.LC_edit_problem_footer,
8461: div.LC_edit_problem_footer div,
1.602 albertel 8462: div.LC_edit_problem_editxml_header,
8463: div.LC_edit_problem_editxml_header div {
1.1205 golterma 8464: z-index: 100;
1.600 albertel 8465: }
1.795 www 8466:
1.600 albertel 8467: div.LC_edit_problem_header_title {
1.705 tempelho 8468: font-weight: bold;
8469: font-size: larger;
1.602 albertel 8470: background: $tabbg;
8471: padding: 3px;
1.1060 bisitz 8472: margin: 0 0 5px 0;
1.602 albertel 8473: }
1.795 www 8474:
1.602 albertel 8475: table.LC_edit_problem_header_title {
8476: width: 100%;
1.600 albertel 8477: background: $tabbg;
1.602 albertel 8478: }
8479:
1.1205 golterma 8480: div.LC_edit_actionbar {
8481: background-color: $sidebg;
1.1218 droeschl 8482: margin: 0;
8483: padding: 0;
8484: line-height: 200%;
1.602 albertel 8485: }
1.795 www 8486:
1.1218 droeschl 8487: div.LC_edit_actionbar div{
8488: padding: 0;
8489: margin: 0;
8490: display: inline-block;
1.600 albertel 8491: }
1.795 www 8492:
1.1124 bisitz 8493: .LC_edit_opt {
8494: padding-left: 1em;
8495: white-space: nowrap;
8496: }
8497:
1.1152 golterma 8498: .LC_edit_problem_latexhelper{
8499: text-align: right;
8500: }
8501:
8502: #LC_edit_problem_colorful div{
8503: margin-left: 40px;
8504: }
8505:
1.1205 golterma 8506: #LC_edit_problem_codemirror div{
8507: margin-left: 0px;
8508: }
8509:
1.911 bisitz 8510: img.stift {
1.803 bisitz 8511: border-width: 0;
8512: vertical-align: middle;
1.677 riegler 8513: }
1.680 riegler 8514:
1.923 bisitz 8515: table td.LC_mainmenu_col_fieldset {
1.680 riegler 8516: vertical-align: top;
1.777 tempelho 8517: }
1.795 www 8518:
1.716 raeburn 8519: div.LC_createcourse {
1.911 bisitz 8520: margin: 10px 10px 10px 10px;
1.716 raeburn 8521: }
8522:
1.917 raeburn 8523: .LC_dccid {
1.1130 raeburn 8524: float: right;
1.917 raeburn 8525: margin: 0.2em 0 0 0;
8526: padding: 0;
8527: font-size: 90%;
8528: display:none;
8529: }
8530:
1.897 wenzelju 8531: ol.LC_primary_menu a:hover,
1.721 harmsja 8532: ol#LC_MenuBreadcrumbs a:hover,
8533: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 8534: ul#LC_secondary_menu a:hover,
1.721 harmsja 8535: .LC_FormSectionClearButton input:hover
1.795 www 8536: ul.LC_TabContent li:hover a {
1.952 onken 8537: color:$button_hover;
1.911 bisitz 8538: text-decoration:none;
1.693 droeschl 8539: }
8540:
1.779 bisitz 8541: h1 {
1.911 bisitz 8542: padding: 0;
8543: line-height:130%;
1.693 droeschl 8544: }
1.698 harmsja 8545:
1.911 bisitz 8546: h2,
8547: h3,
8548: h4,
8549: h5,
8550: h6 {
8551: margin: 5px 0 5px 0;
8552: padding: 0;
8553: line-height:130%;
1.693 droeschl 8554: }
1.795 www 8555:
8556: .LC_hcell {
1.911 bisitz 8557: padding:3px 15px 3px 15px;
8558: margin: 0;
8559: background-color:$tabbg;
8560: color:$fontmenu;
8561: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 8562: }
1.795 www 8563:
1.840 bisitz 8564: .LC_Box > .LC_hcell {
1.911 bisitz 8565: margin: 0 -10px 10px -10px;
1.835 bisitz 8566: }
8567:
1.721 harmsja 8568: .LC_noBorder {
1.911 bisitz 8569: border: 0;
1.698 harmsja 8570: }
1.693 droeschl 8571:
1.721 harmsja 8572: .LC_FormSectionClearButton input {
1.911 bisitz 8573: background-color:transparent;
8574: border: none;
8575: cursor:pointer;
8576: text-decoration:underline;
1.693 droeschl 8577: }
1.763 bisitz 8578:
8579: .LC_help_open_topic {
1.911 bisitz 8580: color: #FFFFFF;
8581: background-color: #EEEEFF;
8582: margin: 1px;
8583: padding: 4px;
8584: border: 1px solid #000033;
8585: white-space: nowrap;
8586: /* vertical-align: middle; */
1.759 neumanie 8587: }
1.693 droeschl 8588:
1.911 bisitz 8589: dl,
8590: ul,
8591: div,
8592: fieldset {
8593: margin: 10px 10px 10px 0;
8594: /* overflow: hidden; */
1.693 droeschl 8595: }
1.795 www 8596:
1.1404 raeburn 8597: fieldset#LC_selectuser {
8598: margin: 0;
8599: padding: 0;
8600: }
8601:
1.1211 raeburn 8602: article.geogebraweb div {
8603: margin: 0;
8604: }
8605:
1.838 bisitz 8606: fieldset > legend {
1.911 bisitz 8607: font-weight: bold;
8608: padding: 0 5px 0 5px;
1.838 bisitz 8609: }
8610:
1.813 bisitz 8611: #LC_nav_bar {
1.911 bisitz 8612: float: left;
1.995 raeburn 8613: background-color: $pgbg_or_bgcolor;
1.966 bisitz 8614: margin: 0 0 2px 0;
1.807 droeschl 8615: }
8616:
1.916 droeschl 8617: #LC_realm {
8618: margin: 0.2em 0 0 0;
8619: padding: 0;
8620: font-weight: bold;
8621: text-align: center;
1.995 raeburn 8622: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8623: }
8624:
1.911 bisitz 8625: #LC_nav_bar em {
8626: font-weight: bold;
8627: font-style: normal;
1.807 droeschl 8628: }
8629:
1.897 wenzelju 8630: ol.LC_primary_menu {
1.934 droeschl 8631: margin: 0;
1.1076 raeburn 8632: padding: 0;
1.807 droeschl 8633: }
8634:
1.852 droeschl 8635: ol#LC_PathBreadcrumbs {
1.911 bisitz 8636: margin: 0;
1.693 droeschl 8637: }
8638:
1.897 wenzelju 8639: ol.LC_primary_menu li {
1.1076 raeburn 8640: color: RGB(80, 80, 80);
8641: vertical-align: middle;
8642: text-align: left;
8643: list-style: none;
1.1205 golterma 8644: position: relative;
1.1076 raeburn 8645: float: left;
1.1205 golterma 8646: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8647: line-height: 1.5em;
1.1076 raeburn 8648: }
8649:
1.1205 golterma 8650: ol.LC_primary_menu li a,
8651: ol.LC_primary_menu li p {
1.1076 raeburn 8652: display: block;
8653: margin: 0;
8654: padding: 0 5px 0 10px;
8655: text-decoration: none;
8656: }
8657:
1.1205 golterma 8658: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8659: display: inline-block;
8660: width: 95%;
8661: text-align: left;
8662: }
8663:
8664: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8665: display: inline-block;
8666: width: 5%;
8667: float: right;
8668: text-align: right;
8669: font-size: 70%;
8670: }
8671:
8672: ol.LC_primary_menu ul {
1.1076 raeburn 8673: display: none;
1.1205 golterma 8674: width: 15em;
1.1076 raeburn 8675: background-color: $data_table_light;
1.1205 golterma 8676: position: absolute;
8677: top: 100%;
1.1076 raeburn 8678: }
8679:
1.1205 golterma 8680: ol.LC_primary_menu ul ul {
8681: left: 100%;
8682: top: 0;
8683: }
8684:
8685: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8686: display: block;
8687: position: absolute;
8688: margin: 0;
8689: padding: 0;
1.1078 raeburn 8690: z-index: 2;
1.1076 raeburn 8691: }
8692:
8693: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8694: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8695: font-size: 90%;
1.911 bisitz 8696: vertical-align: top;
1.1076 raeburn 8697: float: none;
1.1079 raeburn 8698: border-left: 1px solid black;
8699: border-right: 1px solid black;
1.1205 golterma 8700: /* A dark bottom border to visualize different menu options;
8701: overwritten in the create_submenu routine for the last border-bottom of the menu */
8702: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8703: }
8704:
1.1205 golterma 8705: ol.LC_primary_menu li li p:hover {
8706: color:$button_hover;
8707: text-decoration:none;
8708: background-color:$data_table_dark;
1.1076 raeburn 8709: }
8710:
8711: ol.LC_primary_menu li li a:hover {
8712: color:$button_hover;
8713: background-color:$data_table_dark;
1.693 droeschl 8714: }
8715:
1.1205 golterma 8716: /* Font-size equal to the size of the predecessors*/
8717: ol.LC_primary_menu li:hover li li {
8718: font-size: 100%;
8719: }
8720:
1.897 wenzelju 8721: ol.LC_primary_menu li img {
1.911 bisitz 8722: vertical-align: bottom;
1.934 droeschl 8723: height: 1.1em;
1.1077 raeburn 8724: margin: 0.2em 0 0 0;
1.693 droeschl 8725: }
8726:
1.897 wenzelju 8727: ol.LC_primary_menu a {
1.911 bisitz 8728: color: RGB(80, 80, 80);
8729: text-decoration: none;
1.693 droeschl 8730: }
1.795 www 8731:
1.949 droeschl 8732: ol.LC_primary_menu a.LC_new_message {
8733: font-weight:bold;
8734: color: darkred;
8735: }
8736:
1.975 raeburn 8737: ol.LC_docs_parameters {
8738: margin-left: 0;
8739: padding: 0;
8740: list-style: none;
8741: }
8742:
8743: ol.LC_docs_parameters li {
8744: margin: 0;
8745: padding-right: 20px;
8746: display: inline;
8747: }
8748:
1.976 raeburn 8749: ol.LC_docs_parameters li:before {
8750: content: "\\002022 \\0020";
8751: }
8752:
8753: li.LC_docs_parameters_title {
8754: font-weight: bold;
8755: }
8756:
8757: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8758: content: "";
8759: }
8760:
1.897 wenzelju 8761: ul#LC_secondary_menu {
1.1107 raeburn 8762: clear: right;
1.911 bisitz 8763: color: $fontmenu;
8764: background: $tabbg;
8765: list-style: none;
8766: padding: 0;
8767: margin: 0;
8768: width: 100%;
1.995 raeburn 8769: text-align: left;
1.1107 raeburn 8770: float: left;
1.808 droeschl 8771: }
8772:
1.897 wenzelju 8773: ul#LC_secondary_menu li {
1.911 bisitz 8774: font-weight: bold;
8775: line-height: 1.8em;
1.1107 raeburn 8776: border-right: 1px solid black;
8777: float: left;
8778: }
8779:
8780: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8781: background-color: $data_table_light;
8782: }
8783:
8784: ul#LC_secondary_menu li a {
1.911 bisitz 8785: padding: 0 0.8em;
1.1107 raeburn 8786: }
8787:
8788: ul#LC_secondary_menu li ul {
8789: display: none;
8790: }
8791:
8792: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8793: display: block;
8794: position: absolute;
8795: margin: 0;
8796: padding: 0;
8797: list-style:none;
8798: float: none;
8799: background-color: $data_table_light;
8800: z-index: 2;
8801: margin-left: -1px;
8802: }
8803:
8804: ul#LC_secondary_menu li ul li {
8805: font-size: 90%;
8806: vertical-align: top;
8807: border-left: 1px solid black;
1.911 bisitz 8808: border-right: 1px solid black;
1.1119 raeburn 8809: background-color: $data_table_light;
1.1107 raeburn 8810: list-style:none;
8811: float: none;
8812: }
8813:
8814: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8815: background-color: $data_table_dark;
1.807 droeschl 8816: }
8817:
1.847 tempelho 8818: ul.LC_TabContent {
1.911 bisitz 8819: display:block;
8820: background: $sidebg;
8821: border-bottom: solid 1px $lg_border_color;
8822: list-style:none;
1.1020 raeburn 8823: margin: -1px -10px 0 -10px;
1.911 bisitz 8824: padding: 0;
1.693 droeschl 8825: }
8826:
1.795 www 8827: ul.LC_TabContent li,
8828: ul.LC_TabContentBigger li {
1.911 bisitz 8829: float:left;
1.741 harmsja 8830: }
1.795 www 8831:
1.897 wenzelju 8832: ul#LC_secondary_menu li a {
1.911 bisitz 8833: color: $fontmenu;
8834: text-decoration: none;
1.693 droeschl 8835: }
1.795 www 8836:
1.721 harmsja 8837: ul.LC_TabContent {
1.952 onken 8838: min-height:20px;
1.721 harmsja 8839: }
1.795 www 8840:
8841: ul.LC_TabContent li {
1.911 bisitz 8842: vertical-align:middle;
1.959 onken 8843: padding: 0 16px 0 10px;
1.911 bisitz 8844: background-color:$tabbg;
8845: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8846: border-left: solid 1px $font;
1.721 harmsja 8847: }
1.795 www 8848:
1.847 tempelho 8849: ul.LC_TabContent .right {
1.911 bisitz 8850: float:right;
1.847 tempelho 8851: }
8852:
1.911 bisitz 8853: ul.LC_TabContent li a,
8854: ul.LC_TabContent li {
8855: color:rgb(47,47,47);
8856: text-decoration:none;
8857: font-size:95%;
8858: font-weight:bold;
1.952 onken 8859: min-height:20px;
8860: }
8861:
1.959 onken 8862: ul.LC_TabContent li a:hover,
8863: ul.LC_TabContent li a:focus {
1.952 onken 8864: color: $button_hover;
1.959 onken 8865: background:none;
8866: outline:none;
1.952 onken 8867: }
8868:
8869: ul.LC_TabContent li:hover {
8870: color: $button_hover;
8871: cursor:pointer;
1.721 harmsja 8872: }
1.795 www 8873:
1.911 bisitz 8874: ul.LC_TabContent li.active {
1.952 onken 8875: color: $font;
1.911 bisitz 8876: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8877: border-bottom:solid 1px #FFFFFF;
8878: cursor: default;
1.744 ehlerst 8879: }
1.795 www 8880:
1.959 onken 8881: ul.LC_TabContent li.active a {
8882: color:$font;
8883: background:#FFFFFF;
8884: outline: none;
8885: }
1.1047 raeburn 8886:
8887: ul.LC_TabContent li.goback {
8888: float: left;
8889: border-left: none;
8890: }
8891:
1.870 tempelho 8892: #maincoursedoc {
1.911 bisitz 8893: clear:both;
1.870 tempelho 8894: }
8895:
8896: ul.LC_TabContentBigger {
1.911 bisitz 8897: display:block;
8898: list-style:none;
8899: padding: 0;
1.870 tempelho 8900: }
8901:
1.795 www 8902: ul.LC_TabContentBigger li {
1.911 bisitz 8903: vertical-align:bottom;
8904: height: 30px;
8905: font-size:110%;
8906: font-weight:bold;
8907: color: #737373;
1.841 tempelho 8908: }
8909:
1.957 onken 8910: ul.LC_TabContentBigger li.active {
8911: position: relative;
8912: top: 1px;
8913: }
8914:
1.870 tempelho 8915: ul.LC_TabContentBigger li a {
1.911 bisitz 8916: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8917: height: 30px;
8918: line-height: 30px;
8919: text-align: center;
8920: display: block;
8921: text-decoration: none;
1.958 onken 8922: outline: none;
1.741 harmsja 8923: }
1.795 www 8924:
1.870 tempelho 8925: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8926: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8927: color:$font;
1.744 ehlerst 8928: }
1.795 www 8929:
1.870 tempelho 8930: ul.LC_TabContentBigger li b {
1.911 bisitz 8931: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8932: display: block;
8933: float: left;
8934: padding: 0 30px;
1.957 onken 8935: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8936: }
8937:
1.956 onken 8938: ul.LC_TabContentBigger li:hover b {
8939: color:$button_hover;
8940: }
8941:
1.870 tempelho 8942: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8943: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8944: color:$font;
1.957 onken 8945: border: 0;
1.741 harmsja 8946: }
1.693 droeschl 8947:
1.870 tempelho 8948:
1.862 bisitz 8949: ul.LC_CourseBreadcrumbs {
8950: background: $sidebg;
1.1020 raeburn 8951: height: 2em;
1.862 bisitz 8952: padding-left: 10px;
1.1020 raeburn 8953: margin: 0;
1.862 bisitz 8954: list-style-position: inside;
8955: }
8956:
1.911 bisitz 8957: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8958: ol#LC_PathBreadcrumbs {
1.911 bisitz 8959: padding-left: 10px;
8960: margin: 0;
1.933 droeschl 8961: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8962: }
8963:
1.911 bisitz 8964: ol#LC_MenuBreadcrumbs li,
8965: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8966: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8967: display: inline;
1.933 droeschl 8968: white-space: normal;
1.693 droeschl 8969: }
8970:
1.823 bisitz 8971: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8972: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8973: text-decoration: none;
8974: font-size:90%;
1.693 droeschl 8975: }
1.795 www 8976:
1.969 droeschl 8977: ol#LC_MenuBreadcrumbs h1 {
8978: display: inline;
8979: font-size: 90%;
8980: line-height: 2.5em;
8981: margin: 0;
8982: padding: 0;
8983: }
8984:
1.795 www 8985: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8986: text-decoration:none;
8987: font-size:100%;
8988: font-weight:bold;
1.693 droeschl 8989: }
1.795 www 8990:
1.840 bisitz 8991: .LC_Box {
1.911 bisitz 8992: border: solid 1px $lg_border_color;
8993: padding: 0 10px 10px 10px;
1.746 neumanie 8994: }
1.795 www 8995:
1.1020 raeburn 8996: .LC_DocsBox {
8997: border: solid 1px $lg_border_color;
8998: padding: 0 0 10px 10px;
8999: }
9000:
1.795 www 9001: .LC_AboutMe_Image {
1.911 bisitz 9002: float:left;
9003: margin-right:10px;
1.747 neumanie 9004: }
1.795 www 9005:
9006: .LC_Clear_AboutMe_Image {
1.911 bisitz 9007: clear:left;
1.747 neumanie 9008: }
1.795 www 9009:
1.721 harmsja 9010: dl.LC_ListStyleClean dt {
1.911 bisitz 9011: padding-right: 5px;
9012: display: table-header-group;
1.693 droeschl 9013: }
9014:
1.721 harmsja 9015: dl.LC_ListStyleClean dd {
1.911 bisitz 9016: display: table-row;
1.693 droeschl 9017: }
9018:
1.721 harmsja 9019: .LC_ListStyleClean,
9020: .LC_ListStyleSimple,
9021: .LC_ListStyleNormal,
1.795 www 9022: .LC_ListStyleSpecial {
1.911 bisitz 9023: /* display:block; */
9024: list-style-position: inside;
9025: list-style-type: none;
9026: overflow: hidden;
9027: padding: 0;
1.693 droeschl 9028: }
9029:
1.721 harmsja 9030: .LC_ListStyleSimple li,
9031: .LC_ListStyleSimple dd,
9032: .LC_ListStyleNormal li,
9033: .LC_ListStyleNormal dd,
9034: .LC_ListStyleSpecial li,
1.795 www 9035: .LC_ListStyleSpecial dd {
1.911 bisitz 9036: margin: 0;
9037: padding: 5px 5px 5px 10px;
9038: clear: both;
1.693 droeschl 9039: }
9040:
1.721 harmsja 9041: .LC_ListStyleClean li,
9042: .LC_ListStyleClean dd {
1.911 bisitz 9043: padding-top: 0;
9044: padding-bottom: 0;
1.693 droeschl 9045: }
9046:
1.721 harmsja 9047: .LC_ListStyleSimple dd,
1.795 www 9048: .LC_ListStyleSimple li {
1.911 bisitz 9049: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 9050: }
9051:
1.721 harmsja 9052: .LC_ListStyleSpecial li,
9053: .LC_ListStyleSpecial dd {
1.911 bisitz 9054: list-style-type: none;
9055: background-color: RGB(220, 220, 220);
9056: margin-bottom: 4px;
1.693 droeschl 9057: }
9058:
1.721 harmsja 9059: table.LC_SimpleTable {
1.911 bisitz 9060: margin:5px;
9061: border:solid 1px $lg_border_color;
1.795 www 9062: }
1.693 droeschl 9063:
1.721 harmsja 9064: table.LC_SimpleTable tr {
1.911 bisitz 9065: padding: 0;
9066: border:solid 1px $lg_border_color;
1.693 droeschl 9067: }
1.795 www 9068:
9069: table.LC_SimpleTable thead {
1.911 bisitz 9070: background:rgb(220,220,220);
1.693 droeschl 9071: }
9072:
1.721 harmsja 9073: div.LC_columnSection {
1.911 bisitz 9074: display: block;
9075: clear: both;
9076: overflow: hidden;
9077: margin: 0;
1.693 droeschl 9078: }
9079:
1.721 harmsja 9080: div.LC_columnSection>* {
1.911 bisitz 9081: float: left;
9082: margin: 10px 20px 10px 0;
9083: overflow:hidden;
1.693 droeschl 9084: }
1.721 harmsja 9085:
1.795 www 9086: table em {
1.911 bisitz 9087: font-weight: bold;
9088: font-style: normal;
1.748 schulted 9089: }
1.795 www 9090:
1.779 bisitz 9091: table.LC_tableBrowseRes,
1.795 www 9092: table.LC_tableOfContent {
1.911 bisitz 9093: border:none;
9094: border-spacing: 1px;
9095: padding: 3px;
9096: background-color: #FFFFFF;
9097: font-size: 90%;
1.753 droeschl 9098: }
1.789 droeschl 9099:
1.911 bisitz 9100: table.LC_tableOfContent {
9101: border-collapse: collapse;
1.789 droeschl 9102: }
9103:
1.771 droeschl 9104: table.LC_tableBrowseRes a,
1.768 schulted 9105: table.LC_tableOfContent a {
1.911 bisitz 9106: background-color: transparent;
9107: text-decoration: none;
1.753 droeschl 9108: }
9109:
1.795 www 9110: table.LC_tableOfContent img {
1.911 bisitz 9111: border: none;
9112: height: 1.3em;
9113: vertical-align: text-bottom;
9114: margin-right: 0.3em;
1.753 droeschl 9115: }
1.757 schulted 9116:
1.795 www 9117: a#LC_content_toolbar_firsthomework {
1.911 bisitz 9118: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 9119: }
9120:
1.795 www 9121: a#LC_content_toolbar_everything {
1.911 bisitz 9122: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 9123: }
9124:
1.795 www 9125: a#LC_content_toolbar_uncompleted {
1.911 bisitz 9126: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 9127: }
9128:
1.795 www 9129: #LC_content_toolbar_clearbubbles {
1.911 bisitz 9130: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 9131: }
9132:
1.795 www 9133: a#LC_content_toolbar_changefolder {
1.911 bisitz 9134: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 9135: }
9136:
1.795 www 9137: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 9138: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 9139: }
9140:
1.1043 raeburn 9141: a#LC_content_toolbar_edittoplevel {
9142: background-image:url(/res/adm/pages/edittoplevel.gif);
9143: }
9144:
1.1384 raeburn 9145: a#LC_content_toolbar_printout {
9146: background-image:url(/res/adm/pages/printout.gif);
9147: }
9148:
1.795 www 9149: ul#LC_toolbar li a:hover {
1.911 bisitz 9150: background-position: bottom center;
1.757 schulted 9151: }
9152:
1.795 www 9153: ul#LC_toolbar {
1.911 bisitz 9154: padding: 0;
9155: margin: 2px;
9156: list-style:none;
1.1449 raeburn 9157: display:inline;
1.911 bisitz 9158: background-color:white;
1.1082 raeburn 9159: overflow: auto;
1.757 schulted 9160: }
9161:
1.795 www 9162: ul#LC_toolbar li {
1.911 bisitz 9163: border:1px solid white;
9164: padding: 0;
9165: margin: 0;
9166: float: left;
9167: display:inline;
9168: vertical-align:middle;
1.1082 raeburn 9169: white-space: nowrap;
1.911 bisitz 9170: }
1.757 schulted 9171:
1.783 amueller 9172:
1.795 www 9173: a.LC_toolbarItem {
1.911 bisitz 9174: display:block;
9175: padding: 0;
9176: margin: 0;
9177: height: 32px;
9178: width: 32px;
9179: color:white;
9180: border: none;
9181: background-repeat:no-repeat;
9182: background-color:transparent;
1.757 schulted 9183: }
9184:
1.1449 raeburn 9185: .LC_navtools {
9186: display: inline-block;
9187: padding: 0;
9188: margin: 2px;
9189: vertical-align: middle;
9190: }
9191:
1.915 droeschl 9192: ul.LC_funclist {
9193: margin: 0;
9194: padding: 0.5em 1em 0.5em 0;
9195: }
9196:
1.933 droeschl 9197: ul.LC_funclist > li:first-child {
9198: font-weight:bold;
9199: margin-left:0.8em;
9200: }
9201:
1.915 droeschl 9202: ul.LC_funclist + ul.LC_funclist {
9203: /*
9204: left border as a seperator if we have more than
9205: one list
9206: */
9207: border-left: 1px solid $sidebg;
9208: /*
9209: this hides the left border behind the border of the
9210: outer box if element is wrapped to the next 'line'
9211: */
9212: margin-left: -1px;
9213: }
9214:
1.843 bisitz 9215: ul.LC_funclist li {
1.915 droeschl 9216: display: inline;
1.782 bisitz 9217: white-space: nowrap;
1.915 droeschl 9218: margin: 0 0 0 25px;
9219: line-height: 150%;
1.782 bisitz 9220: }
9221:
1.974 wenzelju 9222: .LC_hidden {
9223: display: none;
9224: }
9225:
1.1030 www 9226: .LCmodal-overlay {
9227: position:fixed;
9228: top:0;
9229: right:0;
9230: bottom:0;
9231: left:0;
9232: height:100%;
9233: width:100%;
9234: margin:0;
9235: padding:0;
9236: background:#999;
9237: opacity:.75;
9238: filter: alpha(opacity=75);
9239: -moz-opacity: 0.75;
9240: z-index:101;
9241: }
9242:
9243: * html .LCmodal-overlay {
9244: position: absolute;
9245: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
9246: }
9247:
9248: .LCmodal-window {
9249: position:fixed;
9250: top:50%;
9251: left:50%;
9252: margin:0;
9253: padding:0;
9254: z-index:102;
9255: }
9256:
9257: * html .LCmodal-window {
9258: position:absolute;
9259: }
9260:
9261: .LCclose-window {
9262: position:absolute;
9263: width:32px;
9264: height:32px;
9265: right:8px;
9266: top:8px;
9267: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
9268: text-indent:-99999px;
9269: overflow:hidden;
9270: cursor:pointer;
9271: }
9272:
1.1369 raeburn 9273: .LCisDisabled {
9274: cursor: not-allowed;
9275: opacity: 0.5;
9276: }
9277:
9278: a[aria-disabled="true"] {
9279: color: currentColor;
9280: display: inline-block; /* For IE11/ MS Edge bug */
9281: pointer-events: none;
9282: text-decoration: none;
9283: }
9284:
1.1335 raeburn 9285: pre.LC_wordwrap {
9286: white-space: pre-wrap;
9287: white-space: -moz-pre-wrap;
9288: white-space: -pre-wrap;
9289: white-space: -o-pre-wrap;
9290: word-wrap: break-word;
9291: }
9292:
1.1100 raeburn 9293: /*
1.1231 damieng 9294: styles used for response display
9295: */
9296: div.LC_radiofoil, div.LC_rankfoil {
9297: margin: .5em 0em .5em 0em;
9298: }
9299: table.LC_itemgroup {
9300: margin-top: 1em;
9301: }
9302:
9303: /*
1.1100 raeburn 9304: styles used by TTH when "Default set of options to pass to tth/m
9305: when converting TeX" in course settings has been set
9306:
9307: option passed: -t
9308:
9309: */
9310:
9311: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
9312: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
9313: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
9314: td div.norm {line-height:normal;}
9315:
9316: /*
9317: option passed -y3
9318: */
9319:
9320: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
9321: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
9322: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
9323:
1.1230 damieng 9324: /*
9325: sections with roles, for content only
9326: */
9327: section[class^="role-"] {
9328: padding-left: 10px;
9329: padding-right: 5px;
9330: margin-top: 8px;
9331: margin-bottom: 8px;
9332: border: 1px solid #2A4;
9333: border-radius: 5px;
9334: box-shadow: 0px 1px 1px #BBB;
9335: }
9336: section[class^="role-"]>h1 {
9337: position: relative;
9338: margin: 0px;
9339: padding-top: 10px;
9340: padding-left: 40px;
9341: }
9342: section[class^="role-"]>h1:before {
9343: position: absolute;
9344: left: -5px;
9345: top: 5px;
9346: }
9347: section.role-activity>h1:before {
9348: content:url('/adm/daxe/images/section_icons/activity.png');
9349: }
9350: section.role-advice>h1:before {
9351: content:url('/adm/daxe/images/section_icons/advice.png');
9352: }
9353: section.role-bibliography>h1:before {
9354: content:url('/adm/daxe/images/section_icons/bibliography.png');
9355: }
9356: section.role-citation>h1:before {
9357: content:url('/adm/daxe/images/section_icons/citation.png');
9358: }
9359: section.role-conclusion>h1:before {
9360: content:url('/adm/daxe/images/section_icons/conclusion.png');
9361: }
9362: section.role-definition>h1:before {
9363: content:url('/adm/daxe/images/section_icons/definition.png');
9364: }
9365: section.role-demonstration>h1:before {
9366: content:url('/adm/daxe/images/section_icons/demonstration.png');
9367: }
9368: section.role-example>h1:before {
9369: content:url('/adm/daxe/images/section_icons/example.png');
9370: }
9371: section.role-explanation>h1:before {
9372: content:url('/adm/daxe/images/section_icons/explanation.png');
9373: }
9374: section.role-introduction>h1:before {
9375: content:url('/adm/daxe/images/section_icons/introduction.png');
9376: }
9377: section.role-method>h1:before {
9378: content:url('/adm/daxe/images/section_icons/method.png');
9379: }
9380: section.role-more_information>h1:before {
9381: content:url('/adm/daxe/images/section_icons/more_information.png');
9382: }
9383: section.role-objectives>h1:before {
9384: content:url('/adm/daxe/images/section_icons/objectives.png');
9385: }
9386: section.role-prerequisites>h1:before {
9387: content:url('/adm/daxe/images/section_icons/prerequisites.png');
9388: }
9389: section.role-remark>h1:before {
9390: content:url('/adm/daxe/images/section_icons/remark.png');
9391: }
9392: section.role-reminder>h1:before {
9393: content:url('/adm/daxe/images/section_icons/reminder.png');
9394: }
9395: section.role-summary>h1:before {
9396: content:url('/adm/daxe/images/section_icons/summary.png');
9397: }
9398: section.role-syntax>h1:before {
9399: content:url('/adm/daxe/images/section_icons/syntax.png');
9400: }
9401: section.role-warning>h1:before {
9402: content:url('/adm/daxe/images/section_icons/warning.png');
9403: }
9404:
1.1269 raeburn 9405: #LC_minitab_header {
9406: float:left;
9407: width:100%;
9408: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
9409: font-size:93%;
9410: line-height:normal;
9411: margin: 0.5em 0 0.5em 0;
9412: }
9413: #LC_minitab_header ul {
9414: margin:0;
9415: padding:10px 10px 0;
9416: list-style:none;
9417: }
9418: #LC_minitab_header li {
9419: float:left;
9420: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
9421: margin:0;
9422: padding:0 0 0 9px;
9423: }
9424: #LC_minitab_header a {
9425: display:block;
9426: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
9427: padding:5px 15px 4px 6px;
9428: }
9429: #LC_minitab_header #LC_current_minitab {
9430: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
9431: }
9432: #LC_minitab_header #LC_current_minitab a {
9433: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
9434: padding-bottom:5px;
9435: }
9436:
9437:
1.343 albertel 9438: END
9439: }
9440:
1.306 albertel 9441: =pod
9442:
9443: =item * &headtag()
9444:
9445: Returns a uniform footer for LON-CAPA web pages.
9446:
1.307 albertel 9447: Inputs: $title - optional title for the head
9448: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 9449: $args - optional arguments
1.319 albertel 9450: force_register - if is true call registerurl so the remote is
9451: informed
1.415 albertel 9452: redirect -> array ref of
9453: 1- seconds before redirect occurs
9454: 2- url to redirect to
9455: 3- whether the side effect should occur
1.315 albertel 9456: (side effect of setting
9457: $env{'internal.head.redirect'} to the url
1.1386 raeburn 9458: redirected to)
9459: 4- whether the redirect target should be
9460: the opener of the current (pop-up)
9461: window (side effect of setting
9462: $env{'internal.head.to_opener'} to
9463: 1, if true.
1.1388 raeburn 9464: 5- whether encrypt check should be skipped
1.352 albertel 9465: domain -> force to color decorate a page for a specific
9466: domain
9467: function -> force usage of a specific rolish color scheme
9468: bgcolor -> override the default page bgcolor
1.460 albertel 9469: no_auto_mt_title
9470: -> prevent &mt()ing the title arg
1.464 albertel 9471:
1.306 albertel 9472: =cut
9473:
9474: sub headtag {
1.313 albertel 9475: my ($title,$head_extra,$args) = @_;
1.306 albertel 9476:
1.363 albertel 9477: my $function = $args->{'function'} || &get_users_function();
9478: my $domain = $args->{'domain'} || &determinedomain();
9479: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 9480: my $httphost = $args->{'use_absolute'};
1.418 albertel 9481: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 9482: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 9483: #time(),
1.418 albertel 9484: $env{'environment.color.timestamp'},
1.363 albertel 9485: $function,$domain,$bgcolor);
9486:
1.369 www 9487: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 9488:
1.308 albertel 9489: my $result =
9490: '<head>'.
1.1160 raeburn 9491: &font_settings($args);
1.319 albertel 9492:
1.1188 raeburn 9493: my $inhibitprint;
9494: if ($args->{'print_suppress'}) {
9495: $inhibitprint = &print_suppression();
9496: }
1.1064 raeburn 9497:
1.1439 raeburn 9498: if (!$args->{'frameset'} && !$args->{'switchserver'}) {
1.461 albertel 9499: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
9500: }
1.962 droeschl 9501: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
9502: $result .= Apache::lonxml::display_title();
1.319 albertel 9503: }
1.436 albertel 9504: if (!$args->{'no_nav_bar'}
9505: && !$args->{'only_body'}
1.1438 raeburn 9506: && !$args->{'frameset'}
9507: && !$args->{'switchserver'}) {
1.1154 raeburn 9508: $result .= &help_menu_js($httphost);
1.1032 www 9509: $result.=&modal_window();
1.1038 www 9510: $result.=&togglebox_script();
1.1034 www 9511: $result.=&wishlist_window();
1.1041 www 9512: $result.=&LCprogressbarUpdate_script();
1.1034 www 9513: } else {
9514: if ($args->{'add_modal'}) {
9515: $result.=&modal_window();
9516: }
9517: if ($args->{'add_wishlist'}) {
9518: $result.=&wishlist_window();
9519: }
1.1038 www 9520: if ($args->{'add_togglebox'}) {
9521: $result.=&togglebox_script();
9522: }
1.1041 www 9523: if ($args->{'add_progressbar'}) {
9524: $result.=&LCprogressbarUpdate_script();
9525: }
1.436 albertel 9526: }
1.314 albertel 9527: if (ref($args->{'redirect'})) {
1.1388 raeburn 9528: my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
9529: if (!$skip_enc_check) {
9530: $url = &Apache::lonenc::check_encrypt($url);
9531: }
1.414 albertel 9532: if (!$inhibit_continue) {
9533: $env{'internal.head.redirect'} = $url;
9534: }
1.1386 raeburn 9535: $result.=<<"ADDMETA";
1.313 albertel 9536: <meta http-equiv="pragma" content="no-cache" />
1.1386 raeburn 9537: ADDMETA
9538: if ($to_opener) {
9539: $env{'internal.head.to_opener'} = 1;
9540: my $dest = &js_escape($url);
9541: my $timeout = int($time * 1000);
9542: $result .=<<"ENDJS";
9543: <script type="text/javascript">
9544: // <![CDATA[
9545: function LC_To_Opener() {
9546: var dest = '$dest';
9547: if (dest != '') {
9548: if (window.opener != null && !window.opener.closed) {
9549: window.opener.location.href=dest;
9550: window.close();
9551: } else {
9552: window.location.href=dest;
9553: }
9554: }
9555: }
9556: \$(document).ready(function () {
9557: setTimeout('LC_To_Opener()',$timeout);
9558: });
9559: // ]]>
9560: </script>
9561: ENDJS
9562: } else {
9563: $result.=<<"ADDMETA";
1.344 albertel 9564: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 9565: ADDMETA
1.1386 raeburn 9566: }
1.1210 raeburn 9567: } else {
9568: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
9569: my $requrl = $env{'request.uri'};
9570: if ($requrl eq '') {
9571: $requrl = $ENV{'REQUEST_URI'};
9572: $requrl =~ s/\?.+$//;
9573: }
9574: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
9575: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
9576: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
9577: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
9578: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
9579: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 9580: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 9581: my ($offload,$offloadoth);
1.1210 raeburn 9582: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
9583: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 9584: $offload = 1;
1.1353 raeburn 9585: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9586: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9587: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9588: $offloadoth = 1;
9589: $dom_in_use = $env{'user.domain'};
9590: }
9591: }
1.1340 raeburn 9592: }
9593: }
9594: unless ($offload) {
9595: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
9596: if ($domdefs{'offloadoth'}{$lonhost}) {
9597: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9598: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9599: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9600: $offload = 1;
1.1352 raeburn 9601: $offloadoth = 1;
1.1340 raeburn 9602: $dom_in_use = $env{'user.domain'};
9603: }
1.1210 raeburn 9604: }
1.1340 raeburn 9605: }
9606: }
9607: }
9608: if ($offload) {
1.1358 raeburn 9609: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 9610: if (($newserver eq '') && ($offloadoth)) {
9611: my @domains = &Apache::lonnet::current_machine_domains();
9612: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
9613: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
9614: }
9615: }
1.1340 raeburn 9616: if (($newserver) && ($newserver ne $lonhost)) {
9617: my $numsec = 5;
9618: my $timeout = $numsec * 1000;
9619: my ($newurl,$locknum,%locks,$msg);
9620: if ($env{'request.role.adv'}) {
9621: ($locknum,%locks) = &Apache::lonnet::get_locks();
9622: }
9623: my $disable_submit = 0;
9624: if ($requrl =~ /$LONCAPA::assess_re/) {
9625: $disable_submit = 1;
9626: }
9627: if ($locknum) {
9628: my @lockinfo = sort(values(%locks));
1.1354 raeburn 9629: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 9630: join(", ",sort(values(%locks)))."\n";
9631: if (&show_course()) {
9632: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
9633: } else {
9634: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 9635: }
1.1340 raeburn 9636: } else {
9637: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
9638: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
9639: }
9640: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
9641: $newurl = '/adm/switchserver?otherserver='.$newserver;
9642: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
9643: $newurl .= '&role='.$env{'request.role'};
9644: }
9645: if ($env{'request.symb'}) {
9646: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
9647: if ($shownsymb =~ m{^/enc/}) {
9648: my $reqdmajor = 2;
9649: my $reqdminor = 11;
9650: my $reqdsubminor = 3;
9651: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
9652: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
9653: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
9654: if (($major eq '' && $minor eq '') ||
9655: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
9656: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
9657: ($reqdsubminor > $subminor))))) {
9658: undef($shownsymb);
9659: }
1.1210 raeburn 9660: }
1.1340 raeburn 9661: if ($shownsymb) {
9662: &js_escape(\$shownsymb);
9663: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 9664: }
1.1340 raeburn 9665: } else {
9666: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
9667: &js_escape(\$shownurl);
9668: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 9669: }
1.1340 raeburn 9670: }
9671: &js_escape(\$msg);
9672: $result.=<<OFFLOAD
1.1210 raeburn 9673: <meta http-equiv="pragma" content="no-cache" />
9674: <script type="text/javascript">
1.1215 raeburn 9675: // <![CDATA[
1.1210 raeburn 9676: function LC_Offload_Now() {
9677: var dest = "$newurl";
9678: if (dest != '') {
9679: window.location.href="$newurl";
9680: }
9681: }
1.1214 raeburn 9682: \$(document).ready(function () {
9683: window.alert('$msg');
9684: if ($disable_submit) {
1.1210 raeburn 9685: \$(".LC_hwk_submit").prop("disabled", true);
9686: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9687: }
9688: setTimeout('LC_Offload_Now()', $timeout);
9689: });
1.1215 raeburn 9690: // ]]>
1.1210 raeburn 9691: </script>
9692: OFFLOAD
9693: }
9694: }
9695: }
9696: }
9697: }
1.313 albertel 9698: }
1.306 albertel 9699: if (!defined($title)) {
9700: $title = 'The LearningOnline Network with CAPA';
9701: }
1.460 albertel 9702: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1432 raeburn 9703: if ($title =~ /^LON-CAPA\s+/) {
9704: $result .= '<title> '.$title.'</title>';
9705: } else {
9706: $result .= '<title> LON-CAPA '.$title.'</title>';
9707: }
9708: $result .= "\n".'<link rel="stylesheet" type="text/css" href="'.$url.'"';
1.1168 raeburn 9709: if (!$args->{'frameset'}) {
9710: $result .= ' /';
9711: }
9712: $result .= '>'
1.1064 raeburn 9713: .$inhibitprint
1.414 albertel 9714: .$head_extra;
1.1242 raeburn 9715: my $clientmobile;
9716: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9717: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9718: } else {
9719: $clientmobile = $env{'browser.mobile'};
9720: }
9721: if ($clientmobile) {
1.1137 raeburn 9722: $result .= '
1.1435 raeburn 9723: <meta name="viewport" content="width=device-width, initial-scale=1.0">
1.1137 raeburn 9724: <meta name="apple-mobile-web-app-capable" content="yes" />';
9725: }
1.1278 raeburn 9726: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9727: return $result.'</head>';
1.306 albertel 9728: }
9729:
9730: =pod
9731:
1.340 albertel 9732: =item * &font_settings()
9733:
9734: Returns neccessary <meta> to set the proper encoding
9735:
1.1160 raeburn 9736: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9737:
9738: =cut
9739:
9740: sub font_settings {
1.1160 raeburn 9741: my ($args) = @_;
1.340 albertel 9742: my $headerstring='';
1.1160 raeburn 9743: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9744: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9745: $headerstring.=
9746: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9747: if (!$args->{'frameset'}) {
9748: $headerstring.= ' /';
9749: }
9750: $headerstring .= '>'."\n";
1.340 albertel 9751: }
9752: return $headerstring;
9753: }
9754:
1.341 albertel 9755: =pod
9756:
1.1064 raeburn 9757: =item * &print_suppression()
9758:
9759: In course context returns css which causes the body to be blank when media="print",
9760: if printout generation is unavailable for the current resource.
9761:
9762: This could be because:
9763:
9764: (a) printstartdate is in the future
9765:
9766: (b) printenddate is in the past
9767:
9768: (c) there is an active exam block with "printout"
9769: functionality blocked
9770:
9771: Users with pav, pfo or evb privileges are exempt.
9772:
9773: Inputs: none
9774:
9775: =cut
9776:
9777:
9778: sub print_suppression {
9779: my $noprint;
9780: if ($env{'request.course.id'}) {
9781: my $scope = $env{'request.course.id'};
9782: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9783: (&Apache::lonnet::allowed('pfo',$scope))) {
9784: return;
9785: }
9786: if ($env{'request.course.sec'} ne '') {
9787: $scope .= "/$env{'request.course.sec'}";
9788: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9789: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9790: return;
1.1064 raeburn 9791: }
9792: }
9793: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9794: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9795: my $clientip = &Apache::lonnet::get_requestor_ip();
9796: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9797: if ($blocked) {
9798: my $checkrole = "cm./$cdom/$cnum";
9799: if ($env{'request.course.sec'} ne '') {
9800: $checkrole .= "/$env{'request.course.sec'}";
9801: }
9802: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9803: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9804: $noprint = 1;
9805: }
9806: }
9807: unless ($noprint) {
9808: my $symb = &Apache::lonnet::symbread();
9809: if ($symb ne '') {
9810: my $navmap = Apache::lonnavmaps::navmap->new();
9811: if (ref($navmap)) {
9812: my $res = $navmap->getBySymb($symb);
9813: if (ref($res)) {
9814: if (!$res->resprintable()) {
9815: $noprint = 1;
9816: }
9817: }
9818: }
9819: }
9820: }
9821: if ($noprint) {
9822: return <<"ENDSTYLE";
9823: <style type="text/css" media="print">
9824: body { display:none }
9825: </style>
9826: ENDSTYLE
9827: }
9828: }
9829: return;
9830: }
9831:
9832: =pod
9833:
1.341 albertel 9834: =item * &xml_begin()
9835:
9836: Returns the needed doctype and <html>
9837:
9838: Inputs: none
9839:
9840: =cut
9841:
9842: sub xml_begin {
1.1168 raeburn 9843: my ($is_frameset) = @_;
1.341 albertel 9844: my $output='';
9845:
9846: if ($env{'browser.mathml'}) {
9847: $output='<?xml version="1.0"?>'
9848: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9849: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9850:
9851: # .'<!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">] >'
9852: .'<!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">'
9853: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9854: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9855: } elsif ($is_frameset) {
9856: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9857: '<html>'."\n";
1.341 albertel 9858: } else {
1.1168 raeburn 9859: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9860: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9861: }
9862: return $output;
9863: }
1.340 albertel 9864:
9865: =pod
9866:
1.306 albertel 9867: =item * &start_page()
9868:
9869: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9870:
1.648 raeburn 9871: Inputs:
9872:
9873: =over 4
9874:
9875: $title - optional title for the page
9876:
9877: $head_extra - optional extra HTML to incude inside the <head>
9878:
9879: $args - additional optional args supported are:
9880:
9881: =over 8
9882:
9883: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9884: arg on
1.814 bisitz 9885: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9886: add_entries -> additional attributes to add to the <body>
9887: domain -> force to color decorate a page for a
1.317 albertel 9888: specific domain
1.648 raeburn 9889: function -> force usage of a specific rolish color
1.317 albertel 9890: scheme
1.648 raeburn 9891: redirect -> see &headtag()
9892: bgcolor -> override the default page bg color
9893: js_ready -> return a string ready for being used in
1.317 albertel 9894: a javascript writeln
1.648 raeburn 9895: html_encode -> return a string ready for being used in
1.320 albertel 9896: a html attribute
1.648 raeburn 9897: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9898: $forcereg arg
1.648 raeburn 9899: frameset -> if true will start with a <frameset>
1.330 albertel 9900: rather than <body>
1.648 raeburn 9901: skip_phases -> hash ref of
1.338 albertel 9902: head -> skip the <html><head> generation
9903: body -> skip all <body> generation
1.648 raeburn 9904: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9905: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9906: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1437 raeburn 9907: bread_crumbs_style -> breadcrumbs are contained within <div id="LC_breadcrumbs">,
9908: and &standard_css() contains CSS for #LC_breadcrumbs, if you want
9909: to override those values, or add to them, specify the value to
9910: include in the style attribute to include in the div tag by using
9911: bread_crumbs_style (e.g., overflow: visible)
1.1272 raeburn 9912: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9913: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9914: group -> includes the current group, if page is for a
1.1274 raeburn 9915: specific group
9916: use_absolute -> for request for external resource or syllabus, this
9917: will contain https://<hostname> if server uses
9918: https (as per hosts.tab), but request is for http
9919: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9920: links_disabled -> Links in primary and secondary menus are disabled
9921: (Can enable them once page has loaded - see lonroles.pm
9922: for an example).
1.1380 raeburn 9923: links_target -> Target for links, e.g., _parent (optional).
1.361 albertel 9924:
1.648 raeburn 9925: =back
1.460 albertel 9926:
1.648 raeburn 9927: =back
1.562 albertel 9928:
1.306 albertel 9929: =cut
9930:
9931: sub start_page {
1.309 albertel 9932: my ($title,$head_extra,$args) = @_;
1.318 albertel 9933: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9934:
1.315 albertel 9935: $env{'internal.start_page'}++;
1.1359 raeburn 9936: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9937:
1.338 albertel 9938: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9939: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9940: }
1.1316 raeburn 9941:
9942: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9943: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9944: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9945: $args->{'no_primary_menu'} = 1;
9946: }
9947: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9948: $args->{'no_inline_menu'} = 1;
9949: }
9950: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9951: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9952: }
9953: } else {
9954: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9955: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9956: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9957: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9958: $args->{'no_primary_menu'} = 1;
9959: }
9960: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9961: $args->{'no_inline_menu'} = 1;
9962: }
9963: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9964: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9965: }
9966: }
9967: }
1.1316 raeburn 9968: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9969: $env{'course.'.$env{'request.course.id'}.'.domain'},
9970: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9971: } elsif ($env{'request.course.id'}) {
9972: my $expiretime=600;
9973: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9974: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9975: }
9976: my ($deeplinkmenu,$menuref);
9977: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9978: if ($menucoll) {
9979: if (ref($menuref) eq 'HASH') {
9980: %menu = %{$menuref};
9981: }
9982: if ($menu{'top'} eq 'n') {
9983: $args->{'no_primary_menu'} = 1;
9984: }
9985: if ($menu{'inline'} eq 'n') {
9986: unless (&Apache::lonnet::allowed('opa')) {
9987: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9988: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9989: my $crstype = &course_type();
9990: my $now = time;
9991: my $ccrole;
9992: if ($crstype eq 'Community') {
9993: $ccrole = 'co';
9994: } else {
9995: $ccrole = 'cc';
9996: }
9997: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9998: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9999: if ((($start) && ($start<0)) ||
10000: (($end) && ($end<$now)) ||
10001: (($start) && ($now<$start))) {
10002: $args->{'no_inline_menu'} = 1;
10003: }
10004: } else {
10005: $args->{'no_inline_menu'} = 1;
10006: }
10007: }
10008: }
10009: }
1.1316 raeburn 10010: }
1.1359 raeburn 10011:
1.1385 raeburn 10012: my $showncrumbs;
1.338 albertel 10013: if (! exists($args->{'skip_phases'}{'body'}) ) {
10014: if ($args->{'frameset'}) {
10015: my $attr_string = &make_attr_string($args->{'force_register'},
10016: $args->{'add_entries'});
10017: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 10018: } else {
10019: $result .=
10020: &bodytag($title,
10021: $args->{'function'}, $args->{'add_entries'},
10022: $args->{'only_body'}, $args->{'domain'},
10023: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 10024: $args->{'bgcolor'}, $args,
1.1385 raeburn 10025: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
10026: \%menu,\$showncrumbs);
1.831 bisitz 10027: }
1.330 albertel 10028: }
1.338 albertel 10029:
1.315 albertel 10030: if ($args->{'js_ready'}) {
1.713 kaisler 10031: $result = &js_ready($result);
1.315 albertel 10032: }
1.320 albertel 10033: if ($args->{'html_encode'}) {
1.713 kaisler 10034: $result = &html_encode($result);
10035: }
10036:
1.813 bisitz 10037: # Preparation for new and consistent functionlist at top of screen
10038: # if ($args->{'functionlist'}) {
10039: # $result .= &build_functionlist();
10040: #}
10041:
1.964 droeschl 10042: # Don't add anything more if only_body wanted or in const space
10043: return $result if $args->{'only_body'}
10044: || $env{'request.state'} eq 'construct';
1.813 bisitz 10045:
10046: #Breadcrumbs
1.758 kaisler 10047: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385 raeburn 10048: unless ($showncrumbs) {
1.758 kaisler 10049: &Apache::lonhtmlcommon::clear_breadcrumbs();
10050: #if any br links exists, add them to the breadcrumbs
10051: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
10052: foreach my $crumb (@{$args->{'bread_crumbs'}}){
10053: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
10054: }
10055: }
1.1096 raeburn 10056: # if @advtools array contains items add then to the breadcrumbs
10057: if (@advtools > 0) {
10058: &Apache::lonmenu::advtools_crumbs(@advtools);
10059: }
1.1272 raeburn 10060: my $menulink;
10061: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
10062: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 10063: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 10064: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
10065: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
10066: (!$env{'request.role.adv'}))) {
10067: $menulink = 0;
10068: } else {
10069: undef($menulink);
10070: }
1.1385 raeburn 10071: my $linkprotout;
10072: if ($env{'request.deeplink.login'}) {
10073: my $linkprotout = &Apache::lonmenu::linkprot_exit();
10074: if ($linkprotout) {
10075: &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
10076: }
10077: }
1.758 kaisler 10078: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
10079: if(exists($args->{'bread_crumbs_component'})){
1.1437 raeburn 10080: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},
10081: '',$menulink,'',
10082: $args->{'bread_crumbs_style'});
1.1237 raeburn 10083: } else {
1.1437 raeburn 10084: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink,'',
10085: $args->{'bread_crumbs_style'});
1.758 kaisler 10086: }
1.1385 raeburn 10087: }
1.320 albertel 10088: }
1.315 albertel 10089: return $result;
1.306 albertel 10090: }
10091:
10092: sub end_page {
1.315 albertel 10093: my ($args) = @_;
10094: $env{'internal.end_page'}++;
1.330 albertel 10095: my $result;
1.335 albertel 10096: if ($args->{'discussion'}) {
10097: my ($target,$parser);
10098: if (ref($args->{'discussion'})) {
10099: ($target,$parser) =($args->{'discussion'}{'target'},
10100: $args->{'discussion'}{'parser'});
10101: }
10102: $result .= &Apache::lonxml::xmlend($target,$parser);
10103: }
1.330 albertel 10104: if ($args->{'frameset'}) {
10105: $result .= '</frameset>';
10106: } else {
1.635 raeburn 10107: $result .= &endbodytag($args);
1.330 albertel 10108: }
1.1080 raeburn 10109: unless ($args->{'notbody'}) {
10110: $result .= "\n</html>";
10111: }
1.330 albertel 10112:
1.315 albertel 10113: if ($args->{'js_ready'}) {
1.317 albertel 10114: $result = &js_ready($result);
1.315 albertel 10115: }
1.335 albertel 10116:
1.320 albertel 10117: if ($args->{'html_encode'}) {
10118: $result = &html_encode($result);
10119: }
1.335 albertel 10120:
1.315 albertel 10121: return $result;
10122: }
10123:
1.1359 raeburn 10124: sub menucoll_in_effect {
10125: my ($menucoll,$deeplinkmenu,%menu);
10126: if ($env{'request.course.id'}) {
10127: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 10128: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 10129: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 10130: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
10131: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10132: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
10133: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
10134: my $navmap = Apache::lonnavmaps::navmap->new();
10135: if (ref($navmap)) {
10136: $deeplink = $navmap->get_mapparam(undef,
10137: &Apache::lonnet::declutter($env{'request.noversionuri'}),
10138: '0.deeplink');
1.1370 raeburn 10139: } else {
10140: $check_login_symb = 1;
1.1362 raeburn 10141: }
10142: } else {
1.1370 raeburn 10143: my $symb = &Apache::lonnet::symbread();
10144: if ($symb) {
10145: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
10146: } else {
10147: $check_login_symb = 1;
10148: }
1.1362 raeburn 10149: }
10150: } else {
1.1370 raeburn 10151: $check_login_symb = 1;
10152: }
10153: if ($check_login_symb) {
1.1362 raeburn 10154: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
10155: if ($deeplink_symb =~ /\.(page|sequence)$/) {
10156: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
10157: my $navmap = Apache::lonnavmaps::navmap->new();
10158: if (ref($navmap)) {
10159: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
10160: }
10161: } else {
10162: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
10163: }
10164: }
1.1359 raeburn 10165: if ($deeplink ne '') {
1.1378 raeburn 10166: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 10167: if ($display =~ /^\d+$/) {
10168: $deeplinkmenu = 1;
10169: $menucoll = $display;
10170: }
10171: }
10172: }
10173: if ($menucoll) {
10174: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
10175: }
10176: }
10177: return ($menucoll,$deeplinkmenu,\%menu);
10178: }
10179:
1.1362 raeburn 10180: sub deeplink_login_symb {
10181: my ($cnum,$cdom) = @_;
10182: my $login_symb;
10183: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 10184: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
10185: }
10186: return $login_symb;
10187: }
10188:
10189: sub symb_from_tinyurl {
10190: my ($url,$cnum,$cdom) = @_;
10191: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
10192: my $key = $1;
10193: my ($tinyurl,$login);
10194: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
10195: if (defined($cached)) {
10196: $tinyurl = $result;
10197: } else {
10198: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
10199: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
10200: if ($currtiny{$key} ne '') {
10201: $tinyurl = $currtiny{$key};
10202: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 10203: }
1.1364 raeburn 10204: }
10205: if ($tinyurl ne '') {
10206: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
10207: if (wantarray) {
10208: return ($cnumreq,$symb);
10209: } elsif ($cnumreq eq $cnum) {
10210: return $symb;
1.1362 raeburn 10211: }
10212: }
10213: }
1.1364 raeburn 10214: if (wantarray) {
10215: return ();
10216: } else {
10217: return;
10218: }
1.1362 raeburn 10219: }
10220:
1.1405 raeburn 10221: sub usable_exttools {
10222: my %tooltypes;
10223: if ($env{'request.course.id'}) {
10224: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
10225: if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
10226: %tooltypes = (
10227: crs => 1,
10228: dom => 1,
10229: );
10230: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
10231: $tooltypes{'crs'} = 1;
10232: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
10233: $tooltypes{'dom'} = 1;
10234: }
10235: } else {
10236: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10237: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
10238: my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
10239: if ($crstype eq '') {
10240: $crstype = 'course';
10241: }
10242: if ($crstype eq 'course') {
10243: if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
10244: $crstype = 'official';
10245: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
10246: $crstype = 'textbook';
10247: } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
10248: $crstype = 'lti';
10249: } else {
10250: $crstype = 'unofficial';
10251: }
10252: }
10253: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
10254: if ($domdefaults{$crstype.'domexttool'}) {
10255: $tooltypes{'dom'} = 1;
10256: }
10257: if ($domdefaults{$crstype.'exttool'}) {
10258: $tooltypes{'crs'} = 1;
10259: }
10260: }
10261: }
10262: return %tooltypes;
10263: }
10264:
1.1034 www 10265: sub wishlist_window {
10266: return(<<'ENDWISHLIST');
1.1046 raeburn 10267: <script type="text/javascript">
1.1034 www 10268: // <![CDATA[
10269: // <!-- BEGIN LON-CAPA Internal
10270: function set_wishlistlink(title, path) {
10271: if (!title) {
10272: title = document.title;
10273: title = title.replace(/^LON-CAPA /,'');
10274: }
1.1175 raeburn 10275: title = encodeURIComponent(title);
1.1203 raeburn 10276: title = title.replace("'","\\\'");
1.1034 www 10277: if (!path) {
10278: path = location.pathname;
10279: }
1.1175 raeburn 10280: path = encodeURIComponent(path);
1.1203 raeburn 10281: path = path.replace("'","\\\'");
1.1034 www 10282: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
10283: 'wishlistNewLink','width=560,height=350,scrollbars=0');
10284: }
10285: // END LON-CAPA Internal -->
10286: // ]]>
10287: </script>
10288: ENDWISHLIST
10289: }
10290:
1.1030 www 10291: sub modal_window {
10292: return(<<'ENDMODAL');
1.1046 raeburn 10293: <script type="text/javascript">
1.1030 www 10294: // <![CDATA[
10295: // <!-- BEGIN LON-CAPA Internal
10296: var modalWindow = {
10297: parent:"body",
10298: windowId:null,
10299: content:null,
10300: width:null,
10301: height:null,
10302: close:function()
10303: {
10304: $(".LCmodal-window").remove();
10305: $(".LCmodal-overlay").remove();
10306: },
10307: open:function()
10308: {
10309: var modal = "";
10310: modal += "<div class=\"LCmodal-overlay\"></div>";
10311: 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;\">";
10312: modal += this.content;
10313: modal += "</div>";
10314:
10315: $(this.parent).append(modal);
10316:
10317: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
10318: $(".LCclose-window").click(function(){modalWindow.close();});
10319: $(".LCmodal-overlay").click(function(){modalWindow.close();});
10320: }
10321: };
1.1140 raeburn 10322: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 10323: {
1.1266 raeburn 10324: source = source.replace(/'/g,"'");
1.1030 www 10325: modalWindow.windowId = "myModal";
10326: modalWindow.width = width;
10327: modalWindow.height = height;
1.1196 raeburn 10328: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 10329: modalWindow.open();
1.1208 raeburn 10330: };
1.1030 www 10331: // END LON-CAPA Internal -->
10332: // ]]>
10333: </script>
10334: ENDMODAL
10335: }
10336:
10337: sub modal_link {
1.1140 raeburn 10338: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 10339: unless ($width) { $width=480; }
10340: unless ($height) { $height=400; }
1.1031 www 10341: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 10342: unless ($transparency) { $transparency='true'; }
10343:
1.1074 raeburn 10344: my $target_attr;
10345: if (defined($target)) {
10346: $target_attr = 'target="'.$target.'"';
10347: }
10348: return <<"ENDLINK";
1.1336 raeburn 10349: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 10350: ENDLINK
1.1030 www 10351: }
10352:
1.1032 www 10353: sub modal_adhoc_script {
1.1365 raeburn 10354: my ($funcname,$width,$height,$content,$possmathjax)=@_;
10355: my $mathjax;
10356: if ($possmathjax) {
10357: $mathjax = <<'ENDJAX';
10358: if (typeof MathJax == 'object') {
10359: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
10360: }
10361: ENDJAX
10362: }
1.1032 www 10363: return (<<ENDADHOC);
1.1046 raeburn 10364: <script type="text/javascript">
1.1032 www 10365: // <![CDATA[
10366: var $funcname = function()
10367: {
10368: modalWindow.windowId = "myModal";
10369: modalWindow.width = $width;
10370: modalWindow.height = $height;
10371: modalWindow.content = '$content';
10372: modalWindow.open();
1.1365 raeburn 10373: $mathjax
1.1032 www 10374: };
10375: // ]]>
10376: </script>
10377: ENDADHOC
10378: }
10379:
1.1041 www 10380: sub modal_adhoc_inner {
1.1365 raeburn 10381: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 10382: my $innerwidth=$width-20;
10383: $content=&js_ready(
1.1140 raeburn 10384: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
10385: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
10386: $content.
1.1041 www 10387: &end_scrollbox().
1.1140 raeburn 10388: &end_page()
1.1041 www 10389: );
1.1365 raeburn 10390: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 10391: }
10392:
10393: sub modal_adhoc_window {
1.1365 raeburn 10394: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
10395: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 10396: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
10397: }
10398:
10399: sub modal_adhoc_launch {
10400: my ($funcname,$width,$height,$content)=@_;
10401: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
10402: <script type="text/javascript">
10403: // <![CDATA[
10404: $funcname();
10405: // ]]>
10406: </script>
10407: ENDLAUNCH
10408: }
10409:
10410: sub modal_adhoc_close {
10411: return (<<ENDCLOSE);
10412: <script type="text/javascript">
10413: // <![CDATA[
10414: modalWindow.close();
10415: // ]]>
10416: </script>
10417: ENDCLOSE
10418: }
10419:
1.1038 www 10420: sub togglebox_script {
10421: return(<<ENDTOGGLE);
10422: <script type="text/javascript">
10423: // <![CDATA[
10424: function LCtoggleDisplay(id,hidetext,showtext) {
10425: link = document.getElementById(id + "link").childNodes[0];
10426: with (document.getElementById(id).style) {
10427: if (display == "none" ) {
10428: display = "inline";
10429: link.nodeValue = hidetext;
10430: } else {
10431: display = "none";
10432: link.nodeValue = showtext;
10433: }
10434: }
10435: }
10436: // ]]>
10437: </script>
10438: ENDTOGGLE
10439: }
10440:
1.1039 www 10441: sub start_togglebox {
10442: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
10443: unless ($heading) { $heading=''; } else { $heading.=' '; }
10444: unless ($showtext) { $showtext=&mt('show'); }
10445: unless ($hidetext) { $hidetext=&mt('hide'); }
10446: unless ($headerbg) { $headerbg='#FFFFFF'; }
10447: return &start_data_table().
10448: &start_data_table_header_row().
10449: '<td bgcolor="'.$headerbg.'">'.$heading.
10450: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
10451: $showtext.'\')">'.$showtext.'</a>]</td>'.
10452: &end_data_table_header_row().
10453: '<tr id="'.$id.'" style="display:none""><td>';
10454: }
10455:
10456: sub end_togglebox {
10457: return '</td></tr>'.&end_data_table();
10458: }
10459:
1.1041 www 10460: sub LCprogressbar_script {
1.1302 raeburn 10461: my ($id,$number_to_do)=@_;
10462: if ($number_to_do) {
10463: return(<<ENDPROGRESS);
1.1041 www 10464: <script type="text/javascript">
10465: // <![CDATA[
1.1045 www 10466: \$('#progressbar$id').progressbar({
1.1041 www 10467: value: 0,
10468: change: function(event, ui) {
10469: var newVal = \$(this).progressbar('option', 'value');
10470: \$('.pblabel', this).text(LCprogressTxt);
10471: }
10472: });
10473: // ]]>
10474: </script>
10475: ENDPROGRESS
1.1302 raeburn 10476: } else {
10477: return(<<ENDPROGRESS);
10478: <script type="text/javascript">
10479: // <![CDATA[
10480: \$('#progressbar$id').progressbar({
10481: value: false,
10482: create: function(event, ui) {
10483: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
10484: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
10485: }
10486: });
10487: // ]]>
10488: </script>
10489: ENDPROGRESS
10490: }
1.1041 www 10491: }
10492:
10493: sub LCprogressbarUpdate_script {
10494: return(<<ENDPROGRESSUPDATE);
10495: <style type="text/css">
10496: .ui-progressbar { position:relative; }
1.1302 raeburn 10497: .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 10498: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
10499: </style>
10500: <script type="text/javascript">
10501: // <![CDATA[
1.1045 www 10502: var LCprogressTxt='---';
10503:
1.1302 raeburn 10504: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 10505: LCprogressTxt=progresstext;
1.1302 raeburn 10506: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
10507: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
10508: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 10509: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
10510: } else {
10511: \$('#progressbar'+id).progressbar('value',percent);
10512: }
1.1041 www 10513: }
10514: // ]]>
10515: </script>
10516: ENDPROGRESSUPDATE
10517: }
10518:
1.1042 www 10519: my $LClastpercent;
1.1045 www 10520: my $LCidcnt;
10521: my $LCcurrentid;
1.1042 www 10522:
1.1041 www 10523: sub LCprogressbar {
1.1302 raeburn 10524: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 10525: $LClastpercent=0;
1.1045 www 10526: $LCidcnt++;
10527: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 10528: my ($starting,$content);
10529: if ($number_to_do) {
10530: $starting=&mt('Starting');
10531: $content=(<<ENDPROGBAR);
10532: $preamble
1.1045 www 10533: <div id="progressbar$LCcurrentid">
1.1041 www 10534: <span class="pblabel">$starting</span>
10535: </div>
10536: ENDPROGBAR
1.1302 raeburn 10537: } else {
10538: $starting=&mt('Loading...');
10539: $LClastpercent='false';
10540: $content=(<<ENDPROGBAR);
10541: $preamble
10542: <div id="progressbar$LCcurrentid">
10543: <div class="progress-label">$starting</div>
10544: </div>
10545: ENDPROGBAR
10546: }
10547: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 10548: }
10549:
10550: sub LCprogressbarUpdate {
1.1302 raeburn 10551: my ($r,$val,$text,$number_to_do)=@_;
10552: if ($number_to_do) {
10553: unless ($val) {
10554: if ($LClastpercent) {
10555: $val=$LClastpercent;
10556: } else {
10557: $val=0;
10558: }
10559: }
10560: if ($val<0) { $val=0; }
10561: if ($val>100) { $val=0; }
10562: $LClastpercent=$val;
10563: unless ($text) { $text=$val.'%'; }
10564: } else {
10565: $val = 'false';
1.1042 www 10566: }
1.1041 www 10567: $text=&js_ready($text);
1.1044 www 10568: &r_print($r,<<ENDUPDATE);
1.1041 www 10569: <script type="text/javascript">
10570: // <![CDATA[
1.1302 raeburn 10571: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 10572: // ]]>
10573: </script>
10574: ENDUPDATE
1.1035 www 10575: }
10576:
1.1042 www 10577: sub LCprogressbarClose {
10578: my ($r)=@_;
10579: $LClastpercent=0;
1.1044 www 10580: &r_print($r,<<ENDCLOSE);
1.1042 www 10581: <script type="text/javascript">
10582: // <![CDATA[
1.1045 www 10583: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 10584: // ]]>
10585: </script>
10586: ENDCLOSE
1.1044 www 10587: }
10588:
10589: sub r_print {
10590: my ($r,$to_print)=@_;
10591: if ($r) {
10592: $r->print($to_print);
10593: $r->rflush();
10594: } else {
10595: print($to_print);
10596: }
1.1042 www 10597: }
10598:
1.320 albertel 10599: sub html_encode {
10600: my ($result) = @_;
10601:
1.322 albertel 10602: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 10603:
10604: return $result;
10605: }
1.1044 www 10606:
1.317 albertel 10607: sub js_ready {
10608: my ($result) = @_;
10609:
1.323 albertel 10610: $result =~ s/[\n\r]/ /xmsg;
10611: $result =~ s/\\/\\\\/xmsg;
10612: $result =~ s/'/\\'/xmsg;
1.372 albertel 10613: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 10614:
10615: return $result;
10616: }
10617:
1.315 albertel 10618: sub validate_page {
10619: if ( exists($env{'internal.start_page'})
1.316 albertel 10620: && $env{'internal.start_page'} > 1) {
10621: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 10622: $env{'internal.start_page'}.' '.
1.316 albertel 10623: $ENV{'request.filename'});
1.315 albertel 10624: }
10625: if ( exists($env{'internal.end_page'})
1.316 albertel 10626: && $env{'internal.end_page'} > 1) {
10627: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 10628: $env{'internal.end_page'}.' '.
1.316 albertel 10629: $env{'request.filename'});
1.315 albertel 10630: }
10631: if ( exists($env{'internal.start_page'})
10632: && ! exists($env{'internal.end_page'})) {
1.316 albertel 10633: &Apache::lonnet::logthis('start_page called without end_page '.
10634: $env{'request.filename'});
1.315 albertel 10635: }
10636: if ( ! exists($env{'internal.start_page'})
10637: && exists($env{'internal.end_page'})) {
1.316 albertel 10638: &Apache::lonnet::logthis('end_page called without start_page'.
10639: $env{'request.filename'});
1.315 albertel 10640: }
1.306 albertel 10641: }
1.315 albertel 10642:
1.996 www 10643:
10644: sub start_scrollbox {
1.1140 raeburn 10645: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 10646: unless ($outerwidth) { $outerwidth='520px'; }
10647: unless ($width) { $width='500px'; }
10648: unless ($height) { $height='200px'; }
1.1075 raeburn 10649: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 10650: if ($id ne '') {
1.1140 raeburn 10651: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 10652: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 10653: }
1.1075 raeburn 10654: if ($bgcolor ne '') {
10655: $tdcol = "background-color: $bgcolor;";
10656: }
1.1137 raeburn 10657: my $nicescroll_js;
10658: if ($env{'browser.mobile'}) {
1.1140 raeburn 10659: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
10660: }
10661: return <<"END";
10662: $nicescroll_js
10663:
10664: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
10665: <div style="overflow:auto; width:$width; height:$height;"$div_id>
10666: END
10667: }
10668:
10669: sub end_scrollbox {
10670: return '</div></td></tr></table>';
10671: }
10672:
10673: sub nicescroll_javascript {
10674: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
10675: my %options;
10676: if (ref($cursor) eq 'HASH') {
10677: %options = %{$cursor};
10678: }
10679: unless ($options{'railalign'} =~ /^left|right$/) {
10680: $options{'railalign'} = 'left';
10681: }
10682: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10683: my $function = &get_users_function();
10684: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 10685: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 10686: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 10687: }
1.1140 raeburn 10688: }
10689: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
10690: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 10691: $options{'cursoropacity'}='1.0';
10692: }
1.1140 raeburn 10693: } else {
10694: $options{'cursoropacity'}='1.0';
10695: }
10696: if ($options{'cursorfixedheight'} eq 'none') {
10697: delete($options{'cursorfixedheight'});
10698: } else {
10699: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
10700: }
10701: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
10702: delete($options{'railoffset'});
10703: }
10704: my @niceoptions;
10705: while (my($key,$value) = each(%options)) {
10706: if ($value =~ /^\{.+\}$/) {
10707: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 10708: } else {
1.1140 raeburn 10709: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 10710: }
1.1140 raeburn 10711: }
10712: my $nicescroll_js = '
1.1137 raeburn 10713: $(document).ready(
1.1140 raeburn 10714: function() {
10715: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
10716: }
1.1137 raeburn 10717: );
10718: ';
1.1140 raeburn 10719: if ($framecheck) {
10720: $nicescroll_js .= '
10721: function expand_div(caller) {
10722: if (top === self) {
10723: document.getElementById("'.$id.'").style.width = "auto";
10724: document.getElementById("'.$id.'").style.height = "auto";
10725: } else {
10726: try {
10727: if (parent.frames) {
10728: if (parent.frames.length > 1) {
10729: var framesrc = parent.frames[1].location.href;
10730: var currsrc = framesrc.replace(/\#.*$/,"");
10731: if ((caller == "search") || (currsrc == "'.$location.'")) {
10732: document.getElementById("'.$id.'").style.width = "auto";
10733: document.getElementById("'.$id.'").style.height = "auto";
10734: }
10735: }
10736: }
10737: } catch (e) {
10738: return;
10739: }
1.1137 raeburn 10740: }
1.1140 raeburn 10741: return;
1.996 www 10742: }
1.1140 raeburn 10743: ';
10744: }
10745: if ($needjsready) {
10746: $nicescroll_js = '
10747: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10748: } else {
10749: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10750: }
10751: return $nicescroll_js;
1.996 www 10752: }
10753:
1.318 albertel 10754: sub simple_error_page {
1.1150 bisitz 10755: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10756: my %displayargs;
1.1151 raeburn 10757: if (ref($args) eq 'HASH') {
10758: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10759: if ($args->{'only_body'}) {
10760: $displayargs{'only_body'} = 1;
10761: }
10762: if ($args->{'no_nav_bar'}) {
10763: $displayargs{'no_nav_bar'} = 1;
10764: }
1.1151 raeburn 10765: } else {
10766: $msg = &mt($msg);
10767: }
1.1150 bisitz 10768:
1.318 albertel 10769: my $page =
1.1304 raeburn 10770: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10771: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10772: &Apache::loncommon::end_page();
10773: if (ref($r)) {
10774: $r->print($page);
1.327 albertel 10775: return;
1.318 albertel 10776: }
10777: return $page;
10778: }
1.347 albertel 10779:
10780: {
1.610 albertel 10781: my @row_count;
1.961 onken 10782:
10783: sub start_data_table_count {
10784: unshift(@row_count, 0);
10785: return;
10786: }
10787:
10788: sub end_data_table_count {
10789: shift(@row_count);
10790: return;
10791: }
10792:
1.347 albertel 10793: sub start_data_table {
1.1018 raeburn 10794: my ($add_class,$id) = @_;
1.422 albertel 10795: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10796: my $table_id;
10797: if (defined($id)) {
10798: $table_id = ' id="'.$id.'"';
10799: }
1.961 onken 10800: &start_data_table_count();
1.1018 raeburn 10801: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10802: }
10803:
10804: sub end_data_table {
1.961 onken 10805: &end_data_table_count();
1.389 albertel 10806: return '</table>'."\n";;
1.347 albertel 10807: }
10808:
10809: sub start_data_table_row {
1.974 wenzelju 10810: my ($add_class, $id) = @_;
1.610 albertel 10811: $row_count[0]++;
10812: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10813: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10814: $id = (' id="'.$id.'"') unless ($id eq '');
10815: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10816: }
1.471 banghart 10817:
10818: sub continue_data_table_row {
1.974 wenzelju 10819: my ($add_class, $id) = @_;
1.610 albertel 10820: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10821: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10822: $id = (' id="'.$id.'"') unless ($id eq '');
10823: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10824: }
1.347 albertel 10825:
10826: sub end_data_table_row {
1.389 albertel 10827: return '</tr>'."\n";;
1.347 albertel 10828: }
1.367 www 10829:
1.421 albertel 10830: sub start_data_table_empty_row {
1.707 bisitz 10831: # $row_count[0]++;
1.421 albertel 10832: return '<tr class="LC_empty_row" >'."\n";;
10833: }
10834:
10835: sub end_data_table_empty_row {
10836: return '</tr>'."\n";;
10837: }
10838:
1.367 www 10839: sub start_data_table_header_row {
1.389 albertel 10840: return '<tr class="LC_header_row">'."\n";;
1.367 www 10841: }
10842:
10843: sub end_data_table_header_row {
1.389 albertel 10844: return '</tr>'."\n";;
1.367 www 10845: }
1.890 droeschl 10846:
10847: sub data_table_caption {
10848: my $caption = shift;
10849: return "<caption class=\"LC_caption\">$caption</caption>";
10850: }
1.347 albertel 10851: }
10852:
1.548 albertel 10853: =pod
10854:
10855: =item * &inhibit_menu_check($arg)
10856:
10857: Checks for a inhibitmenu state and generates output to preserve it
10858:
10859: Inputs: $arg - can be any of
10860: - undef - in which case the return value is a string
10861: to add into arguments list of a uri
10862: - 'input' - in which case the return value is a HTML
10863: <form> <input> field of type hidden to
10864: preserve the value
10865: - a url - in which case the return value is the url with
10866: the neccesary cgi args added to preserve the
10867: inhibitmenu state
10868: - a ref to a url - no return value, but the string is
10869: updated to include the neccessary cgi
10870: args to preserve the inhibitmenu state
10871:
10872: =cut
10873:
10874: sub inhibit_menu_check {
10875: my ($arg) = @_;
10876: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10877: if ($arg eq 'input') {
10878: if ($env{'form.inhibitmenu'}) {
10879: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10880: } else {
10881: return
10882: }
10883: }
10884: if ($env{'form.inhibitmenu'}) {
10885: if (ref($arg)) {
10886: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10887: } elsif ($arg eq '') {
10888: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10889: } else {
10890: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10891: }
10892: }
10893: if (!ref($arg)) {
10894: return $arg;
10895: }
10896: }
10897:
1.251 albertel 10898: ###############################################
1.182 matthew 10899:
10900: =pod
10901:
1.549 albertel 10902: =back
10903:
10904: =head1 User Information Routines
10905:
10906: =over 4
10907:
1.405 albertel 10908: =item * &get_users_function()
1.182 matthew 10909:
10910: Used by &bodytag to determine the current users primary role.
10911: Returns either 'student','coordinator','admin', or 'author'.
10912:
10913: =cut
10914:
10915: ###############################################
10916: sub get_users_function {
1.815 tempelho 10917: my $function = 'norole';
1.818 tempelho 10918: if ($env{'request.role'}=~/^(st)/) {
10919: $function='student';
10920: }
1.907 raeburn 10921: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10922: $function='coordinator';
10923: }
1.258 albertel 10924: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10925: $function='admin';
10926: }
1.826 bisitz 10927: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10928: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10929: $function='author';
10930: }
10931: return $function;
1.54 www 10932: }
1.99 www 10933:
10934: ###############################################
10935:
1.233 raeburn 10936: =pod
10937:
1.821 raeburn 10938: =item * &show_course()
10939:
10940: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10941: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10942:
10943: Inputs:
10944: None
10945:
10946: Outputs:
10947: Scalar: 1 if 'Course' to be used, 0 otherwise.
10948:
10949: =cut
10950:
10951: ###############################################
10952: sub show_course {
1.1408 raeburn 10953: my ($udom,$uname) = @_;
10954: if (($udom ne '') && ($uname ne '')) {
10955: if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
1.1410 raeburn 10956: if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
1.1408 raeburn 10957: return 0;
10958: } else {
10959: return 1;
10960: }
10961: }
10962: }
1.821 raeburn 10963: my $course = !$env{'user.adv'};
10964: if (!$env{'user.adv'}) {
10965: foreach my $env (keys(%env)) {
10966: next if ($env !~ m/^user\.priv\./);
10967: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10968: $course = 0;
10969: last;
10970: }
10971: }
10972: }
10973: return $course;
10974: }
10975:
10976: ###############################################
10977:
10978: =pod
10979:
1.542 raeburn 10980: =item * &check_user_status()
1.274 raeburn 10981:
10982: Determines current status of supplied role for a
10983: specific user. Roles can be active, previous or future.
10984:
10985: Inputs:
10986: user's domain, user's username, course's domain,
1.375 raeburn 10987: course's number, optional section ID.
1.274 raeburn 10988:
10989: Outputs:
10990: role status: active, previous or future.
10991:
10992: =cut
10993:
10994: sub check_user_status {
1.412 raeburn 10995: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10996: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10997: my @uroles = keys(%userinfo);
1.274 raeburn 10998: my $srchstr;
10999: my $active_chk = 'none';
1.412 raeburn 11000: my $now = time;
1.274 raeburn 11001: if (@uroles > 0) {
1.908 raeburn 11002: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 11003: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
11004: } else {
1.412 raeburn 11005: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
11006: }
11007: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 11008: my $role_end = 0;
11009: my $role_start = 0;
11010: $active_chk = 'active';
1.412 raeburn 11011: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
11012: $role_end = $1;
11013: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
11014: $role_start = $1;
1.274 raeburn 11015: }
11016: }
11017: if ($role_start > 0) {
1.412 raeburn 11018: if ($now < $role_start) {
1.274 raeburn 11019: $active_chk = 'future';
11020: }
11021: }
11022: if ($role_end > 0) {
1.412 raeburn 11023: if ($now > $role_end) {
1.274 raeburn 11024: $active_chk = 'previous';
11025: }
11026: }
11027: }
11028: }
11029: return $active_chk;
11030: }
11031:
11032: ###############################################
11033:
11034: =pod
11035:
1.405 albertel 11036: =item * &get_sections()
1.233 raeburn 11037:
11038: Determines all the sections for a course including
11039: sections with students and sections containing other roles.
1.419 raeburn 11040: Incoming parameters:
11041:
11042: 1. domain
11043: 2. course number
11044: 3. reference to array containing roles for which sections should
11045: be gathered (optional).
11046: 4. reference to array containing status types for which sections
11047: should be gathered (optional).
11048:
11049: If the third argument is undefined, sections are gathered for any role.
11050: If the fourth argument is undefined, sections are gathered for any status.
11051: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 11052:
1.374 raeburn 11053: Returns section hash (keys are section IDs, values are
11054: number of users in each section), subject to the
1.419 raeburn 11055: optional roles filter, optional status filter
1.233 raeburn 11056:
11057: =cut
11058:
11059: ###############################################
11060: sub get_sections {
1.419 raeburn 11061: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 11062: if (!defined($cdom) || !defined($cnum)) {
11063: my $cid = $env{'request.course.id'};
11064:
11065: return if (!defined($cid));
11066:
11067: $cdom = $env{'course.'.$cid.'.domain'};
11068: $cnum = $env{'course.'.$cid.'.num'};
11069: }
11070:
11071: my %sectioncount;
1.419 raeburn 11072: my $now = time;
1.240 albertel 11073:
1.1118 raeburn 11074: my $check_students = 1;
11075: my $only_students = 0;
11076: if (ref($possible_roles) eq 'ARRAY') {
11077: if (grep(/^st$/,@{$possible_roles})) {
11078: if (@{$possible_roles} == 1) {
11079: $only_students = 1;
11080: }
11081: } else {
11082: $check_students = 0;
11083: }
11084: }
11085:
11086: if ($check_students) {
1.276 albertel 11087: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 11088: my $sec_index = &Apache::loncoursedata::CL_SECTION();
11089: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 11090: my $start_index = &Apache::loncoursedata::CL_START();
11091: my $end_index = &Apache::loncoursedata::CL_END();
11092: my $status;
1.366 albertel 11093: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 11094: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
11095: $data->[$status_index],
11096: $data->[$start_index],
11097: $data->[$end_index]);
11098: if ($stu_status eq 'Active') {
11099: $status = 'active';
11100: } elsif ($end < $now) {
11101: $status = 'previous';
11102: } elsif ($start > $now) {
11103: $status = 'future';
11104: }
11105: if ($section ne '-1' && $section !~ /^\s*$/) {
11106: if ((!defined($possible_status)) || (($status ne '') &&
11107: (grep/^\Q$status\E$/,@{$possible_status}))) {
11108: $sectioncount{$section}++;
11109: }
1.240 albertel 11110: }
11111: }
11112: }
1.1118 raeburn 11113: if ($only_students) {
11114: return %sectioncount;
11115: }
1.240 albertel 11116: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11117: foreach my $user (sort(keys(%courseroles))) {
11118: if ($user !~ /^(\w{2})/) { next; }
11119: my ($role) = ($user =~ /^(\w{2})/);
11120: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 11121: my ($section,$status);
1.240 albertel 11122: if ($role eq 'cr' &&
11123: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
11124: $section=$1;
11125: }
11126: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
11127: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 11128: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
11129: if ($end == -1 && $start == -1) {
11130: next; #deleted role
11131: }
11132: if (!defined($possible_status)) {
11133: $sectioncount{$section}++;
11134: } else {
11135: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
11136: $status = 'active';
11137: } elsif ($end < $now) {
11138: $status = 'future';
11139: } elsif ($start > $now) {
11140: $status = 'previous';
11141: }
11142: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
11143: $sectioncount{$section}++;
11144: }
11145: }
1.233 raeburn 11146: }
1.366 albertel 11147: return %sectioncount;
1.233 raeburn 11148: }
11149:
1.274 raeburn 11150: ###############################################
1.294 raeburn 11151:
11152: =pod
1.405 albertel 11153:
11154: =item * &get_course_users()
11155:
1.275 raeburn 11156: Retrieves usernames:domains for users in the specified course
11157: with specific role(s), and access status.
11158:
11159: Incoming parameters:
1.277 albertel 11160: 1. course domain
11161: 2. course number
11162: 3. access status: users must have - either active,
1.275 raeburn 11163: previous, future, or all.
1.277 albertel 11164: 4. reference to array of permissible roles
1.288 raeburn 11165: 5. reference to array of section restrictions (optional)
11166: 6. reference to results object (hash of hashes).
11167: 7. reference to optional userdata hash
1.609 raeburn 11168: 8. reference to optional statushash
1.630 raeburn 11169: 9. flag if privileged users (except those set to unhide in
11170: course settings) should be excluded
1.609 raeburn 11171: Keys of top level results hash are roles.
1.275 raeburn 11172: Keys of inner hashes are username:domain, with
11173: values set to access type.
1.288 raeburn 11174: Optional userdata hash returns an array with arguments in the
11175: same order as loncoursedata::get_classlist() for student data.
11176:
1.609 raeburn 11177: Optional statushash returns
11178:
1.288 raeburn 11179: Entries for end, start, section and status are blank because
11180: of the possibility of multiple values for non-student roles.
11181:
1.275 raeburn 11182: =cut
1.405 albertel 11183:
1.275 raeburn 11184: ###############################################
1.405 albertel 11185:
1.275 raeburn 11186: sub get_course_users {
1.630 raeburn 11187: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 11188: my %idx = ();
1.419 raeburn 11189: my %seclists;
1.288 raeburn 11190:
11191: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
11192: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
11193: $idx{end} = &Apache::loncoursedata::CL_END();
11194: $idx{start} = &Apache::loncoursedata::CL_START();
11195: $idx{id} = &Apache::loncoursedata::CL_ID();
11196: $idx{section} = &Apache::loncoursedata::CL_SECTION();
11197: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
11198: $idx{status} = &Apache::loncoursedata::CL_STATUS();
11199:
1.290 albertel 11200: if (grep(/^st$/,@{$roles})) {
1.276 albertel 11201: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 11202: my $now = time;
1.277 albertel 11203: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 11204: my $match = 0;
1.412 raeburn 11205: my $secmatch = 0;
1.419 raeburn 11206: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 11207: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 11208: if ($section eq '') {
11209: $section = 'none';
11210: }
1.291 albertel 11211: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 11212: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 11213: $secmatch = 1;
11214: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 11215: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 11216: $secmatch = 1;
11217: }
11218: } else {
1.419 raeburn 11219: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 11220: $secmatch = 1;
11221: }
1.290 albertel 11222: }
1.412 raeburn 11223: if (!$secmatch) {
11224: next;
11225: }
1.419 raeburn 11226: }
1.275 raeburn 11227: if (defined($$types{'active'})) {
1.288 raeburn 11228: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 11229: push(@{$$users{st}{$student}},'active');
1.288 raeburn 11230: $match = 1;
1.275 raeburn 11231: }
11232: }
11233: if (defined($$types{'previous'})) {
1.609 raeburn 11234: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 11235: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 11236: $match = 1;
1.275 raeburn 11237: }
11238: }
11239: if (defined($$types{'future'})) {
1.609 raeburn 11240: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 11241: push(@{$$users{st}{$student}},'future');
1.288 raeburn 11242: $match = 1;
1.275 raeburn 11243: }
11244: }
1.609 raeburn 11245: if ($match) {
11246: push(@{$seclists{$student}},$section);
11247: if (ref($userdata) eq 'HASH') {
11248: $$userdata{$student} = $$classlist{$student};
11249: }
11250: if (ref($statushash) eq 'HASH') {
11251: $statushash->{$student}{'st'}{$section} = $status;
11252: }
1.288 raeburn 11253: }
1.275 raeburn 11254: }
11255: }
1.412 raeburn 11256: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 11257: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11258: my $now = time;
1.609 raeburn 11259: my %displaystatus = ( previous => 'Expired',
11260: active => 'Active',
11261: future => 'Future',
11262: );
1.1121 raeburn 11263: my (%nothide,@possdoms);
1.630 raeburn 11264: if ($hidepriv) {
11265: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
11266: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
11267: if ($user !~ /:/) {
11268: $nothide{join(':',split(/[\@]/,$user))}=1;
11269: } else {
11270: $nothide{$user} = 1;
11271: }
11272: }
1.1121 raeburn 11273: my @possdoms = ($cdom);
11274: if ($coursehash{'checkforpriv'}) {
11275: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
11276: }
1.630 raeburn 11277: }
1.439 raeburn 11278: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 11279: my $match = 0;
1.412 raeburn 11280: my $secmatch = 0;
1.439 raeburn 11281: my $status;
1.412 raeburn 11282: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 11283: $user =~ s/:$//;
1.439 raeburn 11284: my ($end,$start) = split(/:/,$coursepersonnel{$person});
11285: if ($end == -1 || $start == -1) {
11286: next;
11287: }
11288: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
11289: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 11290: my ($uname,$udom) = split(/:/,$user);
11291: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 11292: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 11293: $secmatch = 1;
11294: } elsif ($usec eq '') {
1.420 albertel 11295: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 11296: $secmatch = 1;
11297: }
11298: } else {
11299: if (grep(/^\Q$usec\E$/,@{$sections})) {
11300: $secmatch = 1;
11301: }
11302: }
11303: if (!$secmatch) {
11304: next;
11305: }
1.288 raeburn 11306: }
1.419 raeburn 11307: if ($usec eq '') {
11308: $usec = 'none';
11309: }
1.275 raeburn 11310: if ($uname ne '' && $udom ne '') {
1.630 raeburn 11311: if ($hidepriv) {
1.1121 raeburn 11312: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 11313: (!$nothide{$uname.':'.$udom})) {
11314: next;
11315: }
11316: }
1.503 raeburn 11317: if ($end > 0 && $end < $now) {
1.439 raeburn 11318: $status = 'previous';
11319: } elsif ($start > $now) {
11320: $status = 'future';
11321: } else {
11322: $status = 'active';
11323: }
1.277 albertel 11324: foreach my $type (keys(%{$types})) {
1.275 raeburn 11325: if ($status eq $type) {
1.420 albertel 11326: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 11327: push(@{$$users{$role}{$user}},$type);
11328: }
1.288 raeburn 11329: $match = 1;
11330: }
11331: }
1.419 raeburn 11332: if (($match) && (ref($userdata) eq 'HASH')) {
11333: if (!exists($$userdata{$uname.':'.$udom})) {
11334: &get_user_info($udom,$uname,\%idx,$userdata);
11335: }
1.420 albertel 11336: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 11337: push(@{$seclists{$uname.':'.$udom}},$usec);
11338: }
1.609 raeburn 11339: if (ref($statushash) eq 'HASH') {
11340: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
11341: }
1.275 raeburn 11342: }
11343: }
11344: }
11345: }
1.290 albertel 11346: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 11347: if ((defined($cdom)) && (defined($cnum))) {
11348: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
11349: if ( defined($csettings{'internal.courseowner'}) ) {
11350: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 11351: next if ($owner eq '');
11352: my ($ownername,$ownerdom);
11353: if ($owner =~ /^([^:]+):([^:]+)$/) {
11354: $ownername = $1;
11355: $ownerdom = $2;
11356: } else {
11357: $ownername = $owner;
11358: $ownerdom = $cdom;
11359: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 11360: }
11361: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 11362: if (defined($userdata) &&
1.609 raeburn 11363: !exists($$userdata{$owner})) {
11364: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
11365: if (!grep(/^none$/,@{$seclists{$owner}})) {
11366: push(@{$seclists{$owner}},'none');
11367: }
11368: if (ref($statushash) eq 'HASH') {
11369: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 11370: }
1.290 albertel 11371: }
1.279 raeburn 11372: }
11373: }
11374: }
1.419 raeburn 11375: foreach my $user (keys(%seclists)) {
11376: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
11377: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
11378: }
1.275 raeburn 11379: }
11380: return;
11381: }
11382:
1.288 raeburn 11383: sub get_user_info {
11384: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 11385: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
11386: &plainname($uname,$udom,'lastname');
1.291 albertel 11387: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 11388: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 11389: my %idhash = &Apache::lonnet::idrget($udom,($uname));
11390: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 11391: return;
11392: }
1.275 raeburn 11393:
1.472 raeburn 11394: ###############################################
11395:
11396: =pod
11397:
11398: =item * &get_user_quota()
11399:
1.1134 raeburn 11400: Retrieves quota assigned for storage of user files.
11401: Default is to report quota for portfolio files.
1.472 raeburn 11402:
11403: Incoming parameters:
11404: 1. user's username
11405: 2. user's domain
1.1134 raeburn 11406: 3. quota name - portfolio, author, or course
1.1136 raeburn 11407: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 11408: 4. crstype - official, unofficial, textbook, placement or community,
11409: if quota name is course
1.472 raeburn 11410:
11411: Returns:
1.1163 raeburn 11412: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 11413: 2. (Optional) Type of setting: custom or default
11414: (individually assigned or default for user's
11415: institutional status).
11416: 3. (Optional) - User's institutional status (e.g., faculty, staff
11417: or student - types as defined in localenroll::inst_usertypes
11418: for user's domain, which determines default quota for user.
11419: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 11420:
11421: If a value has been stored in the user's environment,
1.536 raeburn 11422: it will return that, otherwise it returns the maximal default
1.1134 raeburn 11423: defined for the user's institutional status(es) in the domain.
1.472 raeburn 11424:
11425: =cut
11426:
11427: ###############################################
11428:
11429:
11430: sub get_user_quota {
1.1136 raeburn 11431: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 11432: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 11433: if (!defined($udom)) {
11434: $udom = $env{'user.domain'};
11435: }
11436: if (!defined($uname)) {
11437: $uname = $env{'user.name'};
11438: }
11439: if (($udom eq '' || $uname eq '') ||
11440: ($udom eq 'public') && ($uname eq 'public')) {
11441: $quota = 0;
1.536 raeburn 11442: $quotatype = 'default';
11443: $defquota = 0;
1.472 raeburn 11444: } else {
1.536 raeburn 11445: my $inststatus;
1.1134 raeburn 11446: if ($quotaname eq 'course') {
11447: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
11448: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
11449: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
11450: } else {
11451: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
11452: $quota = $cenv{'internal.uploadquota'};
11453: }
1.536 raeburn 11454: } else {
1.1134 raeburn 11455: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
11456: if ($quotaname eq 'author') {
11457: $quota = $env{'environment.authorquota'};
11458: } else {
11459: $quota = $env{'environment.portfolioquota'};
11460: }
11461: $inststatus = $env{'environment.inststatus'};
11462: } else {
11463: my %userenv =
11464: &Apache::lonnet::get('environment',['portfolioquota',
11465: 'authorquota','inststatus'],$udom,$uname);
11466: my ($tmp) = keys(%userenv);
11467: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
11468: if ($quotaname eq 'author') {
11469: $quota = $userenv{'authorquota'};
11470: } else {
11471: $quota = $userenv{'portfolioquota'};
11472: }
11473: $inststatus = $userenv{'inststatus'};
11474: } else {
11475: undef(%userenv);
11476: }
11477: }
11478: }
11479: if ($quota eq '' || wantarray) {
11480: if ($quotaname eq 'course') {
11481: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 11482: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 11483: ($crstype eq 'community') || ($crstype eq 'textbook') ||
11484: ($crstype eq 'placement')) {
1.1136 raeburn 11485: $defquota = $domdefs{$crstype.'quota'};
11486: }
11487: if ($defquota eq '') {
11488: $defquota = 500;
11489: }
1.1134 raeburn 11490: } else {
11491: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
11492: }
11493: if ($quota eq '') {
11494: $quota = $defquota;
11495: $quotatype = 'default';
11496: } else {
11497: $quotatype = 'custom';
11498: }
1.472 raeburn 11499: }
11500: }
1.536 raeburn 11501: if (wantarray) {
11502: return ($quota,$quotatype,$settingstatus,$defquota);
11503: } else {
11504: return $quota;
11505: }
1.472 raeburn 11506: }
11507:
11508: ###############################################
11509:
11510: =pod
11511:
11512: =item * &default_quota()
11513:
1.536 raeburn 11514: Retrieves default quota assigned for storage of user portfolio files,
11515: given an (optional) user's institutional status.
1.472 raeburn 11516:
11517: Incoming parameters:
1.1142 raeburn 11518:
1.472 raeburn 11519: 1. domain
1.536 raeburn 11520: 2. (Optional) institutional status(es). This is a : separated list of
11521: status types (e.g., faculty, staff, student etc.)
11522: which apply to the user for whom the default is being retrieved.
11523: If the institutional status string in undefined, the domain
1.1134 raeburn 11524: default quota will be returned.
11525: 3. quota name - portfolio, author, or course
11526: (if no quota name provided, defaults to portfolio).
1.472 raeburn 11527:
11528: Returns:
1.1142 raeburn 11529:
1.1163 raeburn 11530: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 11531: 2. (Optional) institutional type which determined the value of the
11532: default quota.
1.472 raeburn 11533:
11534: If a value has been stored in the domain's configuration db,
11535: it will return that, otherwise it returns 20 (for backwards
11536: compatibility with domains which have not set up a configuration
1.1163 raeburn 11537: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 11538:
1.536 raeburn 11539: If the user's status includes multiple types (e.g., staff and student),
11540: the largest default quota which applies to the user determines the
11541: default quota returned.
11542:
1.472 raeburn 11543: =cut
11544:
11545: ###############################################
11546:
11547:
11548: sub default_quota {
1.1134 raeburn 11549: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 11550: my ($defquota,$settingstatus);
11551: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 11552: ['quotas'],$udom);
1.1134 raeburn 11553: my $key = 'defaultquota';
11554: if ($quotaname eq 'author') {
11555: $key = 'authorquota';
11556: }
1.622 raeburn 11557: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 11558: if ($inststatus ne '') {
1.765 raeburn 11559: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 11560: foreach my $item (@statuses) {
1.1134 raeburn 11561: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11562: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 11563: if ($defquota eq '') {
1.1134 raeburn 11564: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11565: $settingstatus = $item;
1.1134 raeburn 11566: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
11567: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11568: $settingstatus = $item;
11569: }
11570: }
1.1134 raeburn 11571: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11572: if ($quotahash{'quotas'}{$item} ne '') {
11573: if ($defquota eq '') {
11574: $defquota = $quotahash{'quotas'}{$item};
11575: $settingstatus = $item;
11576: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
11577: $defquota = $quotahash{'quotas'}{$item};
11578: $settingstatus = $item;
11579: }
1.536 raeburn 11580: }
11581: }
11582: }
11583: }
11584: if ($defquota eq '') {
1.1134 raeburn 11585: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11586: $defquota = $quotahash{'quotas'}{$key}{'default'};
11587: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11588: $defquota = $quotahash{'quotas'}{'default'};
11589: }
1.536 raeburn 11590: $settingstatus = 'default';
1.1139 raeburn 11591: if ($defquota eq '') {
11592: if ($quotaname eq 'author') {
11593: $defquota = 500;
11594: }
11595: }
1.536 raeburn 11596: }
11597: } else {
11598: $settingstatus = 'default';
1.1134 raeburn 11599: if ($quotaname eq 'author') {
11600: $defquota = 500;
11601: } else {
11602: $defquota = 20;
11603: }
1.536 raeburn 11604: }
11605: if (wantarray) {
11606: return ($defquota,$settingstatus);
1.472 raeburn 11607: } else {
1.536 raeburn 11608: return $defquota;
1.472 raeburn 11609: }
11610: }
11611:
1.1135 raeburn 11612: ###############################################
11613:
11614: =pod
11615:
1.1136 raeburn 11616: =item * &excess_filesize_warning()
1.1135 raeburn 11617:
11618: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 11619: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 11620: space to be exceeded.
1.1136 raeburn 11621:
11622: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 11623: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 11624:
1.1165 raeburn 11625: Inputs: 7
1.1136 raeburn 11626: 1. username or coursenum
1.1135 raeburn 11627: 2. domain
1.1136 raeburn 11628: 3. context ('author' or 'course')
1.1135 raeburn 11629: 4. filename of file for which action is being requested
11630: 5. filesize (kB) of file
11631: 6. action being taken: copy or upload.
1.1237 raeburn 11632: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 11633:
11634: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 11635: otherwise return null.
11636:
11637: =back
1.1135 raeburn 11638:
11639: =cut
11640:
1.1136 raeburn 11641: sub excess_filesize_warning {
1.1165 raeburn 11642: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 11643: my $current_disk_usage = 0;
1.1165 raeburn 11644: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 11645: if ($context eq 'author') {
11646: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
11647: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
11648: } else {
11649: foreach my $subdir ('docs','supplemental') {
11650: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
11651: }
11652: }
1.1135 raeburn 11653: $disk_quota = int($disk_quota * 1000);
11654: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 11655: return '<p class="LC_warning">'.
1.1135 raeburn 11656: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 11657: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
11658: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 11659: $disk_quota,$current_disk_usage).
11660: '</p>';
11661: }
11662: return;
11663: }
11664:
11665: ###############################################
11666:
11667:
1.1136 raeburn 11668:
11669:
1.384 raeburn 11670: sub get_secgrprole_info {
11671: my ($cdom,$cnum,$needroles,$type) = @_;
11672: my %sections_count = &get_sections($cdom,$cnum);
11673: my @sections = (sort {$a <=> $b} keys(%sections_count));
11674: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
11675: my @groups = sort(keys(%curr_groups));
11676: my $allroles = [];
11677: my $rolehash;
11678: my $accesshash = {
11679: active => 'Currently has access',
11680: future => 'Will have future access',
11681: previous => 'Previously had access',
11682: };
11683: if ($needroles) {
11684: $rolehash = {'all' => 'all'};
1.385 albertel 11685: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11686: if (&Apache::lonnet::error(%user_roles)) {
11687: undef(%user_roles);
11688: }
11689: foreach my $item (keys(%user_roles)) {
1.384 raeburn 11690: my ($role)=split(/\:/,$item,2);
11691: if ($role eq 'cr') { next; }
11692: if ($role =~ /^cr/) {
11693: $$rolehash{$role} = (split('/',$role))[3];
11694: } else {
11695: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
11696: }
11697: }
11698: foreach my $key (sort(keys(%{$rolehash}))) {
11699: push(@{$allroles},$key);
11700: }
11701: push (@{$allroles},'st');
11702: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
11703: }
11704: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
11705: }
11706:
1.555 raeburn 11707: sub user_picker {
1.1279 raeburn 11708: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 11709: my $currdom = $dom;
1.1253 raeburn 11710: my @alldoms = &Apache::lonnet::all_domains();
11711: if (@alldoms == 1) {
11712: my %domsrch = &Apache::lonnet::get_dom('configuration',
11713: ['directorysrch'],$alldoms[0]);
11714: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
11715: my $showdom = $domdesc;
11716: if ($showdom eq '') {
11717: $showdom = $dom;
11718: }
11719: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
11720: if ((!$domsrch{'directorysrch'}{'available'}) &&
11721: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
11722: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
11723: }
11724: }
11725: }
1.555 raeburn 11726: my %curr_selected = (
11727: srchin => 'dom',
1.580 raeburn 11728: srchby => 'lastname',
1.555 raeburn 11729: );
11730: my $srchterm;
1.625 raeburn 11731: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 11732: if ($srch->{'srchby'} ne '') {
11733: $curr_selected{'srchby'} = $srch->{'srchby'};
11734: }
11735: if ($srch->{'srchin'} ne '') {
11736: $curr_selected{'srchin'} = $srch->{'srchin'};
11737: }
11738: if ($srch->{'srchtype'} ne '') {
11739: $curr_selected{'srchtype'} = $srch->{'srchtype'};
11740: }
11741: if ($srch->{'srchdomain'} ne '') {
11742: $currdom = $srch->{'srchdomain'};
11743: }
11744: $srchterm = $srch->{'srchterm'};
11745: }
1.1222 damieng 11746: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11747: 'usr' => 'Search criteria',
1.563 raeburn 11748: 'doma' => 'Domain/institution to search',
1.558 albertel 11749: 'uname' => 'username',
11750: 'lastname' => 'last name',
1.555 raeburn 11751: 'lastfirst' => 'last name, first name',
1.558 albertel 11752: 'crs' => 'in this course',
1.576 raeburn 11753: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11754: 'alc' => 'all LON-CAPA',
1.573 raeburn 11755: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11756: 'exact' => 'is',
11757: 'contains' => 'contains',
1.569 raeburn 11758: 'begins' => 'begins with',
1.1222 damieng 11759: );
11760: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11761: 'youm' => "You must include some text to search for.",
11762: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11763: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11764: 'yomc' => "You must choose a domain when using an institutional directory search.",
11765: 'ymcd' => "You must choose a domain when using a domain search.",
11766: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11767: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11768: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11769: );
1.1222 damieng 11770: &html_escape(\%html_lt);
11771: &js_escape(\%js_lt);
1.1255 raeburn 11772: my $domform;
1.1277 raeburn 11773: my $allow_blank = 1;
1.1255 raeburn 11774: if ($fixeddom) {
1.1277 raeburn 11775: $allow_blank = 0;
11776: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11777: } else {
1.1287 raeburn 11778: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11779: my ($trusted,$untrusted);
1.1287 raeburn 11780: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11781: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11782: } elsif ($context eq 'author') {
1.1288 raeburn 11783: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11784: } elsif ($context eq 'domain') {
1.1288 raeburn 11785: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11786: }
1.1288 raeburn 11787: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11788: }
1.563 raeburn 11789: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11790:
11791: my @srchins = ('crs','dom','alc','instd');
11792:
11793: foreach my $option (@srchins) {
11794: # FIXME 'alc' option unavailable until
11795: # loncreateuser::print_user_query_page()
11796: # has been completed.
11797: next if ($option eq 'alc');
1.880 raeburn 11798: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11799: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11800: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11801: if ($curr_selected{'srchin'} eq $option) {
11802: $srchinsel .= '
1.1222 damieng 11803: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11804: } else {
11805: $srchinsel .= '
1.1222 damieng 11806: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11807: }
1.555 raeburn 11808: }
1.563 raeburn 11809: $srchinsel .= "\n </select>\n";
1.555 raeburn 11810:
11811: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11812: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11813: if ($curr_selected{'srchby'} eq $option) {
11814: $srchbysel .= '
1.1222 damieng 11815: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11816: } else {
11817: $srchbysel .= '
1.1222 damieng 11818: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11819: }
11820: }
11821: $srchbysel .= "\n </select>\n";
11822:
11823: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11824: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11825: if ($curr_selected{'srchtype'} eq $option) {
11826: $srchtypesel .= '
1.1222 damieng 11827: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11828: } else {
11829: $srchtypesel .= '
1.1222 damieng 11830: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11831: }
11832: }
11833: $srchtypesel .= "\n </select>\n";
11834:
1.558 albertel 11835: my ($newuserscript,$new_user_create);
1.994 raeburn 11836: my $context_dom = $env{'request.role.domain'};
11837: if ($context eq 'requestcrs') {
11838: if ($env{'form.coursedom'} ne '') {
11839: $context_dom = $env{'form.coursedom'};
11840: }
11841: }
1.556 raeburn 11842: if ($forcenewuser) {
1.576 raeburn 11843: if (ref($srch) eq 'HASH') {
1.994 raeburn 11844: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11845: if ($cancreate) {
11846: $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>';
11847: } else {
1.799 bisitz 11848: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11849: my %usertypetext = (
11850: official => 'institutional',
11851: unofficial => 'non-institutional',
11852: );
1.799 bisitz 11853: $new_user_create = '<p class="LC_warning">'
11854: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11855: .' '
11856: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11857: ,'<a href="'.$helplink.'">','</a>')
11858: .'</p><br />';
1.627 raeburn 11859: }
1.576 raeburn 11860: }
11861: }
11862:
1.556 raeburn 11863: $newuserscript = <<"ENDSCRIPT";
11864:
1.570 raeburn 11865: function setSearch(createnew,callingForm) {
1.556 raeburn 11866: if (createnew == 1) {
1.570 raeburn 11867: for (var i=0; i<callingForm.srchby.length; i++) {
11868: if (callingForm.srchby.options[i].value == 'uname') {
11869: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11870: }
11871: }
1.570 raeburn 11872: for (var i=0; i<callingForm.srchin.length; i++) {
11873: if ( callingForm.srchin.options[i].value == 'dom') {
11874: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11875: }
11876: }
1.570 raeburn 11877: for (var i=0; i<callingForm.srchtype.length; i++) {
11878: if (callingForm.srchtype.options[i].value == 'exact') {
11879: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11880: }
11881: }
1.570 raeburn 11882: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11883: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11884: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11885: }
11886: }
11887: }
11888: }
11889: ENDSCRIPT
1.558 albertel 11890:
1.556 raeburn 11891: }
11892:
1.555 raeburn 11893: my $output = <<"END_BLOCK";
1.556 raeburn 11894: <script type="text/javascript">
1.824 bisitz 11895: // <![CDATA[
1.570 raeburn 11896: function validateEntry(callingForm) {
1.558 albertel 11897:
1.556 raeburn 11898: var checkok = 1;
1.558 albertel 11899: var srchin;
1.570 raeburn 11900: for (var i=0; i<callingForm.srchin.length; i++) {
11901: if ( callingForm.srchin[i].checked ) {
11902: srchin = callingForm.srchin[i].value;
1.558 albertel 11903: }
11904: }
11905:
1.570 raeburn 11906: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11907: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11908: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11909: var srchterm = callingForm.srchterm.value;
11910: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11911: var msg = "";
11912:
11913: if (srchterm == "") {
11914: checkok = 0;
1.1222 damieng 11915: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11916: }
11917:
1.569 raeburn 11918: if (srchtype== 'begins') {
11919: if (srchterm.length < 2) {
11920: checkok = 0;
1.1222 damieng 11921: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11922: }
11923: }
11924:
1.556 raeburn 11925: if (srchtype== 'contains') {
11926: if (srchterm.length < 3) {
11927: checkok = 0;
1.1222 damieng 11928: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11929: }
11930: }
11931: if (srchin == 'instd') {
11932: if (srchdomain == '') {
11933: checkok = 0;
1.1222 damieng 11934: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11935: }
11936: }
11937: if (srchin == 'dom') {
11938: if (srchdomain == '') {
11939: checkok = 0;
1.1222 damieng 11940: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11941: }
11942: }
11943: if (srchby == 'lastfirst') {
11944: if (srchterm.indexOf(",") == -1) {
11945: checkok = 0;
1.1222 damieng 11946: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11947: }
11948: if (srchterm.indexOf(",") == srchterm.length -1) {
11949: checkok = 0;
1.1222 damieng 11950: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11951: }
11952: }
11953: if (checkok == 0) {
1.1222 damieng 11954: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11955: return;
11956: }
11957: if (checkok == 1) {
1.570 raeburn 11958: callingForm.submit();
1.556 raeburn 11959: }
11960: }
11961:
11962: $newuserscript
11963:
1.824 bisitz 11964: // ]]>
1.556 raeburn 11965: </script>
1.558 albertel 11966:
11967: $new_user_create
11968:
1.555 raeburn 11969: END_BLOCK
1.558 albertel 11970:
1.876 raeburn 11971: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11972: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11973: $domform.
11974: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11975: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11976: $srchbysel.
11977: $srchtypesel.
11978: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11979: $srchinsel.
11980: &Apache::lonhtmlcommon::row_closure(1).
11981: &Apache::lonhtmlcommon::end_pick_box().
11982: '<br />';
1.1253 raeburn 11983: return ($output,1);
1.555 raeburn 11984: }
11985:
1.612 raeburn 11986: sub user_rule_check {
1.615 raeburn 11987: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11988: my ($response,%inst_response);
1.612 raeburn 11989: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11990: if (keys(%{$usershash}) > 1) {
11991: my (%by_username,%by_id,%userdoms);
11992: my $checkid;
11993: if (ref($checks) eq 'HASH') {
11994: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11995: $checkid = 1;
11996: }
11997: }
11998: foreach my $user (keys(%{$usershash})) {
11999: my ($uname,$udom) = split(/:/,$user);
12000: if ($checkid) {
12001: if (ref($usershash->{$user}) eq 'HASH') {
12002: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 12003: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 12004: $userdoms{$udom} = 1;
1.1227 raeburn 12005: if (ref($inst_results) eq 'HASH') {
12006: $inst_results->{$uname.':'.$udom} = {};
12007: }
1.1226 raeburn 12008: }
12009: }
12010: } else {
12011: $by_username{$udom}{$uname} = 1;
12012: $userdoms{$udom} = 1;
1.1227 raeburn 12013: if (ref($inst_results) eq 'HASH') {
12014: $inst_results->{$uname.':'.$udom} = {};
12015: }
1.1226 raeburn 12016: }
12017: }
12018: foreach my $udom (keys(%userdoms)) {
12019: if (!$got_rules->{$udom}) {
12020: my %domconfig = &Apache::lonnet::get_dom('configuration',
12021: ['usercreation'],$udom);
12022: if (ref($domconfig{'usercreation'}) eq 'HASH') {
12023: foreach my $item ('username','id') {
12024: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 12025: $$curr_rules{$udom}{$item} =
12026: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 12027: }
12028: }
12029: }
12030: $got_rules->{$udom} = 1;
12031: }
1.612 raeburn 12032: }
1.1226 raeburn 12033: if ($checkid) {
12034: foreach my $udom (keys(%by_id)) {
12035: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
12036: if ($outcome eq 'ok') {
1.1227 raeburn 12037: foreach my $id (keys(%{$by_id{$udom}})) {
12038: my $uname = $by_id{$udom}{$id};
12039: $inst_response{$uname.':'.$udom} = $outcome;
12040: }
1.1226 raeburn 12041: if (ref($results) eq 'HASH') {
12042: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 12043: if (exists($inst_response{$uname.':'.$udom})) {
12044: $inst_response{$uname.':'.$udom} = $outcome;
12045: $inst_results->{$uname.':'.$udom} = $results->{$uname};
12046: }
1.1226 raeburn 12047: }
12048: }
12049: }
1.612 raeburn 12050: }
1.615 raeburn 12051: } else {
1.1226 raeburn 12052: foreach my $udom (keys(%by_username)) {
12053: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
12054: if ($outcome eq 'ok') {
1.1227 raeburn 12055: foreach my $uname (keys(%{$by_username{$udom}})) {
12056: $inst_response{$uname.':'.$udom} = $outcome;
12057: }
1.1226 raeburn 12058: if (ref($results) eq 'HASH') {
12059: foreach my $uname (keys(%{$results})) {
12060: $inst_results->{$uname.':'.$udom} = $results->{$uname};
12061: }
12062: }
12063: }
12064: }
1.612 raeburn 12065: }
1.1226 raeburn 12066: } elsif (keys(%{$usershash}) == 1) {
12067: my $user = (keys(%{$usershash}))[0];
12068: my ($uname,$udom) = split(/:/,$user);
12069: if (($udom ne '') && ($uname ne '')) {
12070: if (ref($usershash->{$user}) eq 'HASH') {
12071: if (ref($checks) eq 'HASH') {
12072: if (defined($checks->{'username'})) {
12073: ($inst_response{$user},%{$inst_results->{$user}}) =
12074: &Apache::lonnet::get_instuser($udom,$uname);
12075: } elsif (defined($checks->{'id'})) {
12076: if ($usershash->{$user}->{'id'} ne '') {
12077: ($inst_response{$user},%{$inst_results->{$user}}) =
12078: &Apache::lonnet::get_instuser($udom,undef,
12079: $usershash->{$user}->{'id'});
12080: } else {
12081: ($inst_response{$user},%{$inst_results->{$user}}) =
12082: &Apache::lonnet::get_instuser($udom,$uname);
12083: }
1.585 raeburn 12084: }
1.1226 raeburn 12085: } else {
12086: ($inst_response{$user},%{$inst_results->{$user}}) =
12087: &Apache::lonnet::get_instuser($udom,$uname);
12088: return;
12089: }
12090: if (!$got_rules->{$udom}) {
12091: my %domconfig = &Apache::lonnet::get_dom('configuration',
12092: ['usercreation'],$udom);
12093: if (ref($domconfig{'usercreation'}) eq 'HASH') {
12094: foreach my $item ('username','id') {
12095: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
12096: $$curr_rules{$udom}{$item} =
12097: $domconfig{'usercreation'}{$item.'_rule'};
12098: }
12099: }
12100: }
12101: $got_rules->{$udom} = 1;
1.585 raeburn 12102: }
12103: }
1.1226 raeburn 12104: } else {
12105: return;
12106: }
12107: } else {
12108: return;
12109: }
12110: foreach my $user (keys(%{$usershash})) {
12111: my ($uname,$udom) = split(/:/,$user);
12112: next if (($udom eq '') || ($uname eq ''));
12113: my $id;
1.1227 raeburn 12114: if (ref($inst_results) eq 'HASH') {
12115: if (ref($inst_results->{$user}) eq 'HASH') {
12116: $id = $inst_results->{$user}->{'id'};
12117: }
12118: }
12119: if ($id eq '') {
12120: if (ref($usershash->{$user})) {
12121: $id = $usershash->{$user}->{'id'};
12122: }
1.585 raeburn 12123: }
1.612 raeburn 12124: foreach my $item (keys(%{$checks})) {
12125: if (ref($$curr_rules{$udom}) eq 'HASH') {
12126: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
12127: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 12128: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
12129: $$curr_rules{$udom}{$item});
1.612 raeburn 12130: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
12131: if ($rule_check{$rule}) {
12132: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 12133: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 12134: if (ref($inst_results) eq 'HASH') {
12135: if (ref($inst_results->{$user}) eq 'HASH') {
12136: if (keys(%{$inst_results->{$user}}) == 0) {
12137: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 12138: } elsif ($item eq 'id') {
12139: if ($inst_results->{$user}->{'id'} eq '') {
12140: $$alerts{$item}{$udom}{$uname} = 1;
12141: }
1.615 raeburn 12142: }
1.612 raeburn 12143: }
12144: }
1.615 raeburn 12145: }
12146: last;
1.585 raeburn 12147: }
12148: }
12149: }
12150: }
12151: }
12152: }
12153: }
12154: }
1.612 raeburn 12155: return;
12156: }
12157:
12158: sub user_rule_formats {
12159: my ($domain,$domdesc,$curr_rules,$check) = @_;
12160: my %text = (
12161: 'username' => 'Usernames',
12162: 'id' => 'IDs',
12163: );
12164: my $output;
12165: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
12166: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
12167: if (@{$ruleorder} > 0) {
1.1102 raeburn 12168: $output = '<br />'.
12169: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
12170: '<span class="LC_cusr_emph">','</span>',$domdesc).
12171: ' <ul>';
1.612 raeburn 12172: foreach my $rule (@{$ruleorder}) {
12173: if (ref($curr_rules) eq 'ARRAY') {
12174: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
12175: if (ref($rules->{$rule}) eq 'HASH') {
12176: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
12177: $rules->{$rule}{'desc'}.'</li>';
12178: }
12179: }
12180: }
12181: }
12182: $output .= '</ul>';
12183: }
12184: }
12185: return $output;
12186: }
12187:
12188: sub instrule_disallow_msg {
1.615 raeburn 12189: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 12190: my $response;
12191: my %text = (
12192: item => 'username',
12193: items => 'usernames',
12194: match => 'matches',
12195: do => 'does',
12196: action => 'a username',
12197: one => 'one',
12198: );
12199: if ($count > 1) {
12200: $text{'item'} = 'usernames';
12201: $text{'match'} ='match';
12202: $text{'do'} = 'do';
12203: $text{'action'} = 'usernames',
12204: $text{'one'} = 'ones';
12205: }
12206: if ($checkitem eq 'id') {
12207: $text{'items'} = 'IDs';
12208: $text{'item'} = 'ID';
12209: $text{'action'} = 'an ID';
1.615 raeburn 12210: if ($count > 1) {
12211: $text{'item'} = 'IDs';
12212: $text{'action'} = 'IDs';
12213: }
1.612 raeburn 12214: }
1.674 bisitz 12215: $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 12216: if ($mode eq 'upload') {
12217: if ($checkitem eq 'username') {
12218: $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'}.");
12219: } elsif ($checkitem eq 'id') {
1.674 bisitz 12220: $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 12221: }
1.669 raeburn 12222: } elsif ($mode eq 'selfcreate') {
12223: if ($checkitem eq 'id') {
12224: $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.");
12225: }
1.615 raeburn 12226: } else {
12227: if ($checkitem eq 'username') {
12228: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
12229: } elsif ($checkitem eq 'id') {
12230: $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.");
12231: }
1.612 raeburn 12232: }
12233: return $response;
1.585 raeburn 12234: }
12235:
1.624 raeburn 12236: sub personal_data_fieldtitles {
12237: my %fieldtitles = &Apache::lonlocal::texthash (
12238: id => 'Student/Employee ID',
12239: permanentemail => 'E-mail address',
12240: lastname => 'Last Name',
12241: firstname => 'First Name',
12242: middlename => 'Middle Name',
12243: generation => 'Generation',
12244: gen => 'Generation',
1.765 raeburn 12245: inststatus => 'Affiliation',
1.624 raeburn 12246: );
12247: return %fieldtitles;
12248: }
12249:
1.642 raeburn 12250: sub sorted_inst_types {
12251: my ($dom) = @_;
1.1185 raeburn 12252: my ($usertypes,$order);
12253: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
12254: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
12255: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
12256: $order = $domdefaults{'inststatus'}{'inststatusorder'};
12257: } else {
12258: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
12259: }
1.642 raeburn 12260: my $othertitle = &mt('All users');
12261: if ($env{'request.course.id'}) {
1.668 raeburn 12262: $othertitle = &mt('Any users');
1.642 raeburn 12263: }
12264: my @types;
12265: if (ref($order) eq 'ARRAY') {
12266: @types = @{$order};
12267: }
12268: if (@types == 0) {
12269: if (ref($usertypes) eq 'HASH') {
12270: @types = sort(keys(%{$usertypes}));
12271: }
12272: }
12273: if (keys(%{$usertypes}) > 0) {
12274: $othertitle = &mt('Other users');
12275: }
12276: return ($othertitle,$usertypes,\@types);
12277: }
12278:
1.645 raeburn 12279: sub get_institutional_codes {
1.1361 raeburn 12280: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 12281: # Get complete list of course sections to update
12282: my @currsections = ();
12283: my @currxlists = ();
1.1361 raeburn 12284: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 12285: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 12286: my $crskey = $crs.':'.$coursecode;
12287: @{$unclutteredsec{$crskey}} = ();
12288: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 12289:
12290: if ($$settings{'internal.sectionnums'} ne '') {
12291: @currsections = split(/,/,$$settings{'internal.sectionnums'});
12292: }
12293:
12294: if ($$settings{'internal.crosslistings'} ne '') {
12295: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
12296: }
12297:
12298: if (@currxlists > 0) {
1.1361 raeburn 12299: foreach my $xl (@currxlists) {
12300: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 12301: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 12302: push(@{$allcourses},$1);
1.645 raeburn 12303: $$LC_code{$1} = $2;
12304: }
12305: }
12306: }
12307: }
1.1361 raeburn 12308:
1.645 raeburn 12309: if (@currsections > 0) {
1.1361 raeburn 12310: foreach my $sec (@currsections) {
12311: if ($sec =~ m/^(\w+):(\w*)$/ ) {
12312: my $instsec = $1;
1.645 raeburn 12313: my $lc_sec = $2;
1.1361 raeburn 12314: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
12315: push(@{$unclutteredsec{$crskey}},$instsec);
12316: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
12317: }
12318: }
12319: }
12320: }
12321:
12322: if (@{$unclutteredsec{$crskey}} > 0) {
12323: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
12324: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
12325: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
12326: my $sec = $coursecode.$formattedsec{$crskey}[$i];
12327: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 12328: push(@{$allcourses},$sec);
1.1361 raeburn 12329: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 12330: }
12331: }
12332: }
12333: }
12334: return;
12335: }
12336:
1.971 raeburn 12337: sub get_standard_codeitems {
12338: return ('Year','Semester','Department','Number','Section');
12339: }
12340:
1.112 bowersj2 12341: =pod
12342:
1.780 raeburn 12343: =head1 Slot Helpers
12344:
12345: =over 4
12346:
12347: =item * sorted_slots()
12348:
1.1040 raeburn 12349: Sorts an array of slot names in order of an optional sort key,
12350: default sort is by slot start time (earliest first).
1.780 raeburn 12351:
12352: Inputs:
12353:
12354: =over 4
12355:
12356: slotsarr - Reference to array of unsorted slot names.
12357:
12358: slots - Reference to hash of hash, where outer hash keys are slot names.
12359:
1.1040 raeburn 12360: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
12361:
1.549 albertel 12362: =back
12363:
1.780 raeburn 12364: Returns:
12365:
12366: =over 4
12367:
1.1040 raeburn 12368: sorted - An array of slot names sorted by a specified sort key
12369: (default sort key is start time of the slot).
1.780 raeburn 12370:
12371: =back
12372:
12373: =cut
12374:
12375:
12376: sub sorted_slots {
1.1040 raeburn 12377: my ($slotsarr,$slots,$sortkey) = @_;
12378: if ($sortkey eq '') {
12379: $sortkey = 'starttime';
12380: }
1.780 raeburn 12381: my @sorted;
12382: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
12383: @sorted =
12384: sort {
12385: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 12386: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 12387: }
12388: if (ref($slots->{$a})) { return -1;}
12389: if (ref($slots->{$b})) { return 1;}
12390: return 0;
12391: } @{$slotsarr};
12392: }
12393: return @sorted;
12394: }
12395:
1.1040 raeburn 12396: =pod
12397:
12398: =item * get_future_slots()
12399:
12400: Inputs:
12401:
12402: =over 4
12403:
12404: cnum - course number
12405:
12406: cdom - course domain
12407:
12408: now - current UNIX time
12409:
12410: symb - optional symb
12411:
12412: =back
12413:
12414: Returns:
12415:
12416: =over 4
12417:
12418: sorted_reservable - ref to array of student_schedulable slots currently
12419: reservable, ordered by end date of reservation period.
12420:
12421: reservable_now - ref to hash of student_schedulable slots currently
12422: reservable.
12423:
12424: Keys in inner hash are:
12425: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12426: (b) endreserve: end date of reservation period.
12427: (c) uniqueperiod: start,end dates when slot is to be uniquely
12428: selected.
1.1040 raeburn 12429:
12430: sorted_future - ref to array of student_schedulable slots reservable in
12431: the future, ordered by start date of reservation period.
12432:
12433: future_reservable - ref to hash of student_schedulable slots reservable
12434: in the future.
12435:
12436: Keys in inner hash are:
12437: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 12438: (b) startreserve: start date of reservation period.
12439: (c) uniqueperiod: start,end dates when slot is to be uniquely
12440: selected.
1.1040 raeburn 12441:
12442: =back
12443:
12444: =cut
12445:
12446: sub get_future_slots {
12447: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 12448: my $map;
12449: if ($symb) {
12450: ($map) = &Apache::lonnet::decode_symb($symb);
12451: }
1.1040 raeburn 12452: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
12453: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
12454: foreach my $slot (keys(%slots)) {
12455: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
12456: if ($symb) {
1.1229 raeburn 12457: if ($slots{$slot}->{'symb'} ne '') {
12458: my $canuse;
12459: my %oksymbs;
12460: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
12461: map { $oksymbs{$_} = 1; } @slotsymbs;
12462: if ($oksymbs{$symb}) {
12463: $canuse = 1;
12464: } else {
12465: foreach my $item (@slotsymbs) {
12466: if ($item =~ /\.(page|sequence)$/) {
12467: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
12468: if (($map ne '') && ($map eq $sloturl)) {
12469: $canuse = 1;
12470: last;
12471: }
12472: }
12473: }
12474: }
12475: next unless ($canuse);
12476: }
1.1040 raeburn 12477: }
12478: if (($slots{$slot}->{'starttime'} > $now) &&
12479: ($slots{$slot}->{'endtime'} > $now)) {
12480: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
12481: my $userallowed = 0;
12482: if ($slots{$slot}->{'allowedsections'}) {
12483: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
12484: if (!defined($env{'request.role.sec'})
12485: && grep(/^No section assigned$/,@allowed_sec)) {
12486: $userallowed=1;
12487: } else {
12488: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
12489: $userallowed=1;
12490: }
12491: }
12492: unless ($userallowed) {
12493: if (defined($env{'request.course.groups'})) {
12494: my @groups = split(/:/,$env{'request.course.groups'});
12495: foreach my $group (@groups) {
12496: if (grep(/^\Q$group\E$/,@allowed_sec)) {
12497: $userallowed=1;
12498: last;
12499: }
12500: }
12501: }
12502: }
12503: }
12504: if ($slots{$slot}->{'allowedusers'}) {
12505: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
12506: my $user = $env{'user.name'}.':'.$env{'user.domain'};
12507: if (grep(/^\Q$user\E$/,@allowed_users)) {
12508: $userallowed = 1;
12509: }
12510: }
12511: next unless($userallowed);
12512: }
12513: my $startreserve = $slots{$slot}->{'startreserve'};
12514: my $endreserve = $slots{$slot}->{'endreserve'};
12515: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 12516: my $uniqueperiod;
12517: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
12518: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
12519: }
1.1040 raeburn 12520: if (($startreserve < $now) &&
12521: (!$endreserve || $endreserve > $now)) {
12522: my $lastres = $endreserve;
12523: if (!$lastres) {
12524: $lastres = $slots{$slot}->{'starttime'};
12525: }
12526: $reservable_now{$slot} = {
12527: symb => $symb,
1.1250 raeburn 12528: endreserve => $lastres,
12529: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12530: };
12531: } elsif (($startreserve > $now) &&
12532: (!$endreserve || $endreserve > $startreserve)) {
12533: $future_reservable{$slot} = {
12534: symb => $symb,
1.1250 raeburn 12535: startreserve => $startreserve,
12536: uniqueperiod => $uniqueperiod,
1.1040 raeburn 12537: };
12538: }
12539: }
12540: }
12541: my @unsorted_reservable = keys(%reservable_now);
12542: if (@unsorted_reservable > 0) {
12543: @sorted_reservable =
12544: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
12545: }
12546: my @unsorted_future = keys(%future_reservable);
12547: if (@unsorted_future > 0) {
12548: @sorted_future =
12549: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
12550: }
12551: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
12552: }
1.780 raeburn 12553:
12554: =pod
12555:
1.1057 foxr 12556: =back
12557:
1.549 albertel 12558: =head1 HTTP Helpers
12559:
12560: =over 4
12561:
1.648 raeburn 12562: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 12563:
1.258 albertel 12564: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 12565: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 12566: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 12567:
12568: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
12569: $possible_names is an ref to an array of form element names. As an example:
12570: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 12571: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 12572:
12573: =cut
1.1 albertel 12574:
1.6 albertel 12575: sub get_unprocessed_cgi {
1.25 albertel 12576: my ($query,$possible_names)= @_;
1.26 matthew 12577: # $Apache::lonxml::debug=1;
1.356 albertel 12578: foreach my $pair (split(/&/,$query)) {
12579: my ($name, $value) = split(/=/,$pair);
1.369 www 12580: $name = &unescape($name);
1.25 albertel 12581: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
12582: $value =~ tr/+/ /;
12583: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 12584: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 12585: }
1.16 harris41 12586: }
1.6 albertel 12587: }
12588:
1.112 bowersj2 12589: =pod
12590:
1.648 raeburn 12591: =item * &cacheheader()
1.112 bowersj2 12592:
12593: returns cache-controlling header code
12594:
12595: =cut
12596:
1.7 albertel 12597: sub cacheheader {
1.258 albertel 12598: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 12599: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
12600: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 12601: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
12602: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 12603: return $output;
1.7 albertel 12604: }
12605:
1.112 bowersj2 12606: =pod
12607:
1.648 raeburn 12608: =item * &no_cache($r)
1.112 bowersj2 12609:
12610: specifies header code to not have cache
12611:
12612: =cut
12613:
1.9 albertel 12614: sub no_cache {
1.216 albertel 12615: my ($r) = @_;
12616: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 12617: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 12618: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
12619: $r->no_cache(1);
12620: $r->header_out("Expires" => $date);
12621: $r->header_out("Pragma" => "no-cache");
1.123 www 12622: }
12623:
12624: sub content_type {
1.181 albertel 12625: my ($r,$type,$charset) = @_;
1.299 foxr 12626: if ($r) {
12627: # Note that printout.pl calls this with undef for $r.
12628: &no_cache($r);
12629: }
1.258 albertel 12630: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 12631: unless ($charset) {
12632: $charset=&Apache::lonlocal::current_encoding;
12633: }
12634: if ($charset) { $type.='; charset='.$charset; }
12635: if ($r) {
12636: $r->content_type($type);
12637: } else {
12638: print("Content-type: $type\n\n");
12639: }
1.9 albertel 12640: }
1.25 albertel 12641:
1.112 bowersj2 12642: =pod
12643:
1.648 raeburn 12644: =item * &add_to_env($name,$value)
1.112 bowersj2 12645:
1.258 albertel 12646: adds $name to the %env hash with value
1.112 bowersj2 12647: $value, if $name already exists, the entry is converted to an array
12648: reference and $value is added to the array.
12649:
12650: =cut
12651:
1.25 albertel 12652: sub add_to_env {
12653: my ($name,$value)=@_;
1.258 albertel 12654: if (defined($env{$name})) {
12655: if (ref($env{$name})) {
1.25 albertel 12656: #already have multiple values
1.258 albertel 12657: push(@{ $env{$name} },$value);
1.25 albertel 12658: } else {
12659: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 12660: my $first=$env{$name};
12661: undef($env{$name});
12662: push(@{ $env{$name} },$first,$value);
1.25 albertel 12663: }
12664: } else {
1.258 albertel 12665: $env{$name}=$value;
1.25 albertel 12666: }
1.31 albertel 12667: }
1.149 albertel 12668:
12669: =pod
12670:
1.648 raeburn 12671: =item * &get_env_multiple($name)
1.149 albertel 12672:
1.258 albertel 12673: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 12674: values may be defined and end up as an array ref.
12675:
12676: returns an array of values
12677:
12678: =cut
12679:
12680: sub get_env_multiple {
12681: my ($name) = @_;
12682: my @values;
1.258 albertel 12683: if (defined($env{$name})) {
1.149 albertel 12684: # exists is it an array
1.258 albertel 12685: if (ref($env{$name})) {
12686: @values=@{ $env{$name} };
1.149 albertel 12687: } else {
1.258 albertel 12688: $values[0]=$env{$name};
1.149 albertel 12689: }
12690: }
12691: return(@values);
12692: }
12693:
1.1249 damieng 12694: # Looks at given dependencies, and returns something depending on the context.
12695: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
12696: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
12697: # For all other contexts, returns ($output, $counter, $numpathchg).
12698: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
12699: # $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.
12700: # $numpathchg: integer with the number of cleaned up dependency paths.
12701: # \%existing: hash reference clean path -> 1 only for existing dependencies.
12702: # \%mapping: hash reference clean path -> original path for all dependencies.
12703: # @param {string} actionurl - The path to the handler, indicative of the context.
12704: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
12705: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
12706: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
12707: # @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)
12708: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 12709: sub ask_for_embedded_content {
1.1249 damieng 12710: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 12711: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 12712: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 12713: %currsubfile,%unused,$rem);
1.1071 raeburn 12714: my $counter = 0;
12715: my $numnew = 0;
1.987 raeburn 12716: my $numremref = 0;
12717: my $numinvalid = 0;
12718: my $numpathchg = 0;
12719: my $numexisting = 0;
1.1071 raeburn 12720: my $numunused = 0;
12721: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 12722: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 12723: my $heading = &mt('Upload embedded files');
12724: my $buttontext = &mt('Upload');
12725:
1.1249 damieng 12726: # fills these variables based on the context:
12727: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
12728: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 12729: if ($env{'request.course.id'}) {
1.1123 raeburn 12730: if ($actionurl eq '/adm/dependencies') {
12731: $navmap = Apache::lonnavmaps::navmap->new();
12732: }
12733: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
12734: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 12735: }
1.1123 raeburn 12736: if (($actionurl eq '/adm/portfolio') ||
12737: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 12738: my $current_path='/';
12739: if ($env{'form.currentpath'}) {
12740: $current_path = $env{'form.currentpath'};
12741: }
12742: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 12743: $udom = $cdom;
12744: $uname = $cnum;
1.984 raeburn 12745: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
12746: } else {
12747: $udom = $env{'user.domain'};
12748: $uname = $env{'user.name'};
12749: $url = '/userfiles/portfolio';
12750: }
1.987 raeburn 12751: $toplevel = $url.'/';
1.984 raeburn 12752: $url .= $current_path;
12753: $getpropath = 1;
1.987 raeburn 12754: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12755: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12756: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12757: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12758: $toplevel = $url;
1.984 raeburn 12759: if ($rest ne '') {
1.987 raeburn 12760: $url .= $rest;
12761: }
12762: } elsif ($actionurl eq '/adm/coursedocs') {
12763: if (ref($args) eq 'HASH') {
1.1071 raeburn 12764: $url = $args->{'docs_url'};
12765: $toplevel = $url;
1.1084 raeburn 12766: if ($args->{'context'} eq 'paste') {
12767: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12768: ($path) =
12769: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12770: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12771: $fileloc =~ s{^/}{};
12772: }
1.1071 raeburn 12773: }
1.1084 raeburn 12774: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12775: if ($env{'request.course.id'} ne '') {
12776: if (ref($args) eq 'HASH') {
12777: $url = $args->{'docs_url'};
12778: $title = $args->{'docs_title'};
1.1126 raeburn 12779: $toplevel = $url;
12780: unless ($toplevel =~ m{^/}) {
12781: $toplevel = "/$url";
12782: }
1.1085 raeburn 12783: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12784: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12785: $path = $1;
12786: } else {
12787: ($path) =
12788: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12789: }
1.1195 raeburn 12790: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12791: $fileloc = $toplevel;
12792: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12793: my ($udom,$uname,$fname) =
12794: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12795: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12796: } else {
12797: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12798: }
1.1071 raeburn 12799: $fileloc =~ s{^/}{};
12800: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12801: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12802: }
1.987 raeburn 12803: }
1.1123 raeburn 12804: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12805: $udom = $cdom;
12806: $uname = $cnum;
12807: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12808: $toplevel = $url;
12809: $path = $url;
12810: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12811: $fileloc =~ s{^/}{};
1.987 raeburn 12812: }
1.1249 damieng 12813:
12814: # parses the dependency paths to get some info
12815: # fills $newfiles, $mapping, $subdependencies, $dependencies
12816: # $newfiles: hash URL -> 1 for new files or external URLs
12817: # (will be completed later)
12818: # $mapping:
12819: # for external URLs: external URL -> external URL
12820: # for relative paths: clean path -> original path
12821: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12822: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12823: foreach my $file (keys(%{$allfiles})) {
12824: my $embed_file;
12825: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12826: $embed_file = $1;
12827: } else {
12828: $embed_file = $file;
12829: }
1.1158 raeburn 12830: my ($absolutepath,$cleaned_file);
12831: if ($embed_file =~ m{^\w+://}) {
12832: $cleaned_file = $embed_file;
1.1147 raeburn 12833: $newfiles{$cleaned_file} = 1;
12834: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12835: } else {
1.1158 raeburn 12836: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12837: if ($embed_file =~ m{^/}) {
12838: $absolutepath = $embed_file;
12839: }
1.1147 raeburn 12840: if ($cleaned_file =~ m{/}) {
12841: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12842: $path = &check_for_traversal($path,$url,$toplevel);
12843: my $item = $fname;
12844: if ($path ne '') {
12845: $item = $path.'/'.$fname;
12846: $subdependencies{$path}{$fname} = 1;
12847: } else {
12848: $dependencies{$item} = 1;
12849: }
12850: if ($absolutepath) {
12851: $mapping{$item} = $absolutepath;
12852: } else {
12853: $mapping{$item} = $embed_file;
12854: }
12855: } else {
12856: $dependencies{$embed_file} = 1;
12857: if ($absolutepath) {
1.1147 raeburn 12858: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12859: } else {
1.1147 raeburn 12860: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12861: }
12862: }
1.984 raeburn 12863: }
12864: }
1.1249 damieng 12865:
12866: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12867: # and lists
12868: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12869: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12870: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12871: # the path had to be cleaned up
12872: # $existing: hash clean path -> 1 if the file exists
12873: # $numexisting: number of keys in $existing
12874: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12875: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12876: # dependency subdirectories that are
12877: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12878: my $dirptr = 16384;
1.984 raeburn 12879: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12880: $currsubfile{$path} = {};
1.1123 raeburn 12881: if (($actionurl eq '/adm/portfolio') ||
12882: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12883: my ($sublistref,$listerror) =
12884: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12885: if (ref($sublistref) eq 'ARRAY') {
12886: foreach my $line (@{$sublistref}) {
12887: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12888: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12889: }
1.984 raeburn 12890: }
1.987 raeburn 12891: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12892: if (opendir(my $dir,$url.'/'.$path)) {
12893: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12894: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12895: }
1.1084 raeburn 12896: } elsif (($actionurl eq '/adm/dependencies') ||
12897: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12898: ($args->{'context'} eq 'paste')) ||
12899: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12900: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12901: my $dir;
12902: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12903: $dir = $fileloc;
12904: } else {
12905: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12906: }
1.1071 raeburn 12907: if ($dir ne '') {
12908: my ($sublistref,$listerror) =
12909: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12910: if (ref($sublistref) eq 'ARRAY') {
12911: foreach my $line (@{$sublistref}) {
12912: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12913: undef,$mtime)=split(/\&/,$line,12);
12914: unless (($testdir&$dirptr) ||
12915: ($file_name =~ /^\.\.?$/)) {
12916: $currsubfile{$path}{$file_name} = [$size,$mtime];
12917: }
12918: }
12919: }
12920: }
1.984 raeburn 12921: }
12922: }
12923: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12924: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12925: my $item = $path.'/'.$file;
12926: unless ($mapping{$item} eq $item) {
12927: $pathchanges{$item} = 1;
12928: }
12929: $existing{$item} = 1;
12930: $numexisting ++;
12931: } else {
12932: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12933: }
12934: }
1.1071 raeburn 12935: if ($actionurl eq '/adm/dependencies') {
12936: foreach my $path (keys(%currsubfile)) {
12937: if (ref($currsubfile{$path}) eq 'HASH') {
12938: foreach my $file (keys(%{$currsubfile{$path}})) {
12939: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12940: next if (($rem ne '') &&
12941: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12942: (ref($navmap) &&
12943: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12944: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12945: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12946: $unused{$path.'/'.$file} = 1;
12947: }
12948: }
12949: }
12950: }
12951: }
1.984 raeburn 12952: }
1.1249 damieng 12953:
12954: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12955: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12956: my %currfile;
1.1123 raeburn 12957: if (($actionurl eq '/adm/portfolio') ||
12958: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12959: my ($dirlistref,$listerror) =
12960: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12961: if (ref($dirlistref) eq 'ARRAY') {
12962: foreach my $line (@{$dirlistref}) {
12963: my ($file_name,$rest) = split(/\&/,$line,2);
12964: $currfile{$file_name} = 1;
12965: }
1.984 raeburn 12966: }
1.987 raeburn 12967: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12968: if (opendir(my $dir,$url)) {
1.987 raeburn 12969: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12970: map {$currfile{$_} = 1;} @dir_list;
12971: }
1.1084 raeburn 12972: } elsif (($actionurl eq '/adm/dependencies') ||
12973: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12974: ($args->{'context'} eq 'paste')) ||
12975: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12976: if ($env{'request.course.id'} ne '') {
12977: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12978: if ($dir ne '') {
12979: my ($dirlistref,$listerror) =
12980: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12981: if (ref($dirlistref) eq 'ARRAY') {
12982: foreach my $line (@{$dirlistref}) {
12983: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12984: $size,undef,$mtime)=split(/\&/,$line,12);
12985: unless (($testdir&$dirptr) ||
12986: ($file_name =~ /^\.\.?$/)) {
12987: $currfile{$file_name} = [$size,$mtime];
12988: }
12989: }
12990: }
12991: }
12992: }
1.984 raeburn 12993: }
1.1249 damieng 12994: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12995: # are not in subdirectories, using $currfile
1.984 raeburn 12996: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12997: if (exists($currfile{$file})) {
1.987 raeburn 12998: unless ($mapping{$file} eq $file) {
12999: $pathchanges{$file} = 1;
13000: }
13001: $existing{$file} = 1;
13002: $numexisting ++;
13003: } else {
1.984 raeburn 13004: $newfiles{$file} = 1;
13005: }
13006: }
1.1071 raeburn 13007: foreach my $file (keys(%currfile)) {
13008: unless (($file eq $filename) ||
13009: ($file eq $filename.'.bak') ||
13010: ($dependencies{$file})) {
1.1085 raeburn 13011: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 13012: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
13013: next if (($rem ne '') &&
13014: (($env{"httpref.$rem".$file} ne '') ||
13015: (ref($navmap) &&
13016: (($navmap->getResourceByUrl($rem.$file) ne '') ||
13017: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
13018: ($navmap->getResourceByUrl($rem.$1)))))));
13019: }
1.1085 raeburn 13020: }
1.1071 raeburn 13021: $unused{$file} = 1;
13022: }
13023: }
1.1249 damieng 13024:
13025: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 13026: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
13027: ($args->{'context'} eq 'paste')) {
13028: $counter = scalar(keys(%existing));
13029: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 13030: return ($output,$counter,$numpathchg,\%existing);
13031: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
13032: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
13033: $counter = scalar(keys(%existing));
13034: $numpathchg = scalar(keys(%pathchanges));
13035: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 13036: }
1.1249 damieng 13037:
13038: # returns HTML otherwise, with dependency results and to ask for more uploads
13039:
13040: # $upload_output: missing dependencies (with upload form)
13041: # $modify_output: uploaded dependencies (in use)
13042: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 13043: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 13044: if ($actionurl eq '/adm/dependencies') {
13045: next if ($embed_file =~ m{^\w+://});
13046: }
1.660 raeburn 13047: $upload_output .= &start_data_table_row().
1.1123 raeburn 13048: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 13049: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 13050: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 13051: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
13052: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 13053: }
1.1123 raeburn 13054: $upload_output .= '</td>';
1.1071 raeburn 13055: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 13056: $upload_output.='<td align="right">'.
13057: '<span class="LC_info LC_fontsize_medium">'.
13058: &mt("URL points to web address").'</span>';
1.987 raeburn 13059: $numremref++;
1.660 raeburn 13060: } elsif ($args->{'error_on_invalid_names'}
13061: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 13062: $upload_output.='<td align="right"><span class="LC_warning">'.
13063: &mt('Invalid characters').'</span>';
1.987 raeburn 13064: $numinvalid++;
1.660 raeburn 13065: } else {
1.1123 raeburn 13066: $upload_output .= '<td>'.
13067: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 13068: $embed_file,\%mapping,
1.1071 raeburn 13069: $allfiles,$codebase,'upload');
13070: $counter ++;
13071: $numnew ++;
1.987 raeburn 13072: }
13073: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
13074: }
13075: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 13076: if ($actionurl eq '/adm/dependencies') {
13077: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
13078: $modify_output .= &start_data_table_row().
13079: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
13080: '<img src="'.&icon($embed_file).'" border="0" />'.
13081: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
13082: '<td>'.$size.'</td>'.
13083: '<td>'.$mtime.'</td>'.
13084: '<td><label><input type="checkbox" name="mod_upload_dep" '.
13085: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
13086: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
13087: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
13088: &embedded_file_element('upload_embedded',$counter,
13089: $embed_file,\%mapping,
13090: $allfiles,$codebase,'modify').
13091: '</div></td>'.
13092: &end_data_table_row()."\n";
13093: $counter ++;
13094: } else {
13095: $upload_output .= &start_data_table_row().
1.1123 raeburn 13096: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
13097: '<span class="LC_filename">'.$embed_file.'</span></td>'.
13098: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 13099: &Apache::loncommon::end_data_table_row()."\n";
13100: }
13101: }
13102: my $delidx = $counter;
13103: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
13104: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
13105: $delete_output .= &start_data_table_row().
13106: '<td><img src="'.&icon($oldfile).'" />'.
13107: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
13108: '<td>'.$size.'</td>'.
13109: '<td>'.$mtime.'</td>'.
13110: '<td><label><input type="checkbox" name="del_upload_dep" '.
13111: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
13112: &embedded_file_element('upload_embedded',$delidx,
13113: $oldfile,\%mapping,$allfiles,
13114: $codebase,'delete').'</td>'.
13115: &end_data_table_row()."\n";
13116: $numunused ++;
13117: $delidx ++;
1.987 raeburn 13118: }
13119: if ($upload_output) {
13120: $upload_output = &start_data_table().
13121: $upload_output.
13122: &end_data_table()."\n";
13123: }
1.1071 raeburn 13124: if ($modify_output) {
13125: $modify_output = &start_data_table().
13126: &start_data_table_header_row().
13127: '<th>'.&mt('File').'</th>'.
13128: '<th>'.&mt('Size (KB)').'</th>'.
13129: '<th>'.&mt('Modified').'</th>'.
13130: '<th>'.&mt('Upload replacement?').'</th>'.
13131: &end_data_table_header_row().
13132: $modify_output.
13133: &end_data_table()."\n";
13134: }
13135: if ($delete_output) {
13136: $delete_output = &start_data_table().
13137: &start_data_table_header_row().
13138: '<th>'.&mt('File').'</th>'.
13139: '<th>'.&mt('Size (KB)').'</th>'.
13140: '<th>'.&mt('Modified').'</th>'.
13141: '<th>'.&mt('Delete?').'</th>'.
13142: &end_data_table_header_row().
13143: $delete_output.
13144: &end_data_table()."\n";
13145: }
1.987 raeburn 13146: my $applies = 0;
13147: if ($numremref) {
13148: $applies ++;
13149: }
13150: if ($numinvalid) {
13151: $applies ++;
13152: }
13153: if ($numexisting) {
13154: $applies ++;
13155: }
1.1071 raeburn 13156: if ($counter || $numunused) {
1.987 raeburn 13157: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
13158: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 13159: $state.'<h3>'.$heading.'</h3>';
13160: if ($actionurl eq '/adm/dependencies') {
13161: if ($numnew) {
13162: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
13163: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
13164: $upload_output.'<br />'."\n";
13165: }
13166: if ($numexisting) {
13167: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
13168: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
13169: $modify_output.'<br />'."\n";
13170: $buttontext = &mt('Save changes');
13171: }
13172: if ($numunused) {
13173: $output .= '<h4>'.&mt('Unused files').'</h4>'.
13174: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
13175: $delete_output.'<br />'."\n";
13176: $buttontext = &mt('Save changes');
13177: }
13178: } else {
13179: $output .= $upload_output.'<br />'."\n";
13180: }
13181: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
13182: $counter.'" />'."\n";
13183: if ($actionurl eq '/adm/dependencies') {
13184: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
13185: $numnew.'" />'."\n";
13186: } elsif ($actionurl eq '') {
1.987 raeburn 13187: $output .= '<input type="hidden" name="phase" value="three" />';
13188: }
13189: } elsif ($applies) {
13190: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
13191: if ($applies > 1) {
13192: $output .=
1.1123 raeburn 13193: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 13194: if ($numremref) {
13195: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
13196: }
13197: if ($numinvalid) {
13198: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
13199: }
13200: if ($numexisting) {
13201: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
13202: }
13203: $output .= '</ul><br />';
13204: } elsif ($numremref) {
13205: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
13206: } elsif ($numinvalid) {
13207: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
13208: } elsif ($numexisting) {
13209: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
13210: }
13211: $output .= $upload_output.'<br />';
13212: }
13213: my ($pathchange_output,$chgcount);
1.1071 raeburn 13214: $chgcount = $counter;
1.987 raeburn 13215: if (keys(%pathchanges) > 0) {
13216: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 13217: if ($counter) {
1.987 raeburn 13218: $output .= &embedded_file_element('pathchange',$chgcount,
13219: $embed_file,\%mapping,
1.1071 raeburn 13220: $allfiles,$codebase,'change');
1.987 raeburn 13221: } else {
13222: $pathchange_output .=
13223: &start_data_table_row().
13224: '<td><input type ="checkbox" name="namechange" value="'.
13225: $chgcount.'" checked="checked" /></td>'.
13226: '<td>'.$mapping{$embed_file}.'</td>'.
13227: '<td>'.$embed_file.
13228: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 13229: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 13230: '</td>'.&end_data_table_row();
1.660 raeburn 13231: }
1.987 raeburn 13232: $numpathchg ++;
13233: $chgcount ++;
1.660 raeburn 13234: }
13235: }
1.1127 raeburn 13236: if (($counter) || ($numunused)) {
1.987 raeburn 13237: if ($numpathchg) {
13238: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
13239: $numpathchg.'" />'."\n";
13240: }
13241: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
13242: ($actionurl eq '/adm/imsimport')) {
13243: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
13244: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
13245: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 13246: } elsif ($actionurl eq '/adm/dependencies') {
13247: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 13248: }
1.1123 raeburn 13249: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 13250: } elsif ($numpathchg) {
13251: my %pathchange = ();
13252: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
13253: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
13254: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 13255: }
1.987 raeburn 13256: }
1.1071 raeburn 13257: return ($output,$counter,$numpathchg);
1.987 raeburn 13258: }
13259:
1.1147 raeburn 13260: =pod
13261:
13262: =item * clean_path($name)
13263:
13264: Performs clean-up of directories, subdirectories and filename in an
13265: embedded object, referenced in an HTML file which is being uploaded
13266: to a course or portfolio, where
13267: "Upload embedded images/multimedia files if HTML file" checkbox was
13268: checked.
13269:
13270: Clean-up is similar to replacements in lonnet::clean_filename()
13271: except each / between sub-directory and next level is preserved.
13272:
13273: =cut
13274:
13275: sub clean_path {
13276: my ($embed_file) = @_;
13277: $embed_file =~s{^/+}{};
13278: my @contents;
13279: if ($embed_file =~ m{/}) {
13280: @contents = split(/\//,$embed_file);
13281: } else {
13282: @contents = ($embed_file);
13283: }
13284: my $lastidx = scalar(@contents)-1;
13285: for (my $i=0; $i<=$lastidx; $i++) {
13286: $contents[$i]=~s{\\}{/}g;
13287: $contents[$i]=~s/\s+/\_/g;
13288: $contents[$i]=~s{[^/\w\.\-]}{}g;
13289: if ($i == $lastidx) {
13290: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
13291: }
13292: }
13293: if ($lastidx > 0) {
13294: return join('/',@contents);
13295: } else {
13296: return $contents[0];
13297: }
13298: }
13299:
1.987 raeburn 13300: sub embedded_file_element {
1.1071 raeburn 13301: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 13302: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
13303: (ref($codebase) eq 'HASH'));
13304: my $output;
1.1071 raeburn 13305: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 13306: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
13307: }
13308: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
13309: &escape($embed_file).'" />';
13310: unless (($context eq 'upload_embedded') &&
13311: ($mapping->{$embed_file} eq $embed_file)) {
13312: $output .='
13313: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
13314: }
13315: my $attrib;
13316: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
13317: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
13318: }
13319: $output .=
13320: "\n\t\t".
13321: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
13322: $attrib.'" />';
13323: if (exists($codebase->{$mapping->{$embed_file}})) {
13324: $output .=
13325: "\n\t\t".
13326: '<input name="codebase_'.$num.'" type="hidden" value="'.
13327: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 13328: }
1.987 raeburn 13329: return $output;
1.660 raeburn 13330: }
13331:
1.1071 raeburn 13332: sub get_dependency_details {
13333: my ($currfile,$currsubfile,$embed_file) = @_;
13334: my ($size,$mtime,$showsize,$showmtime);
13335: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
13336: if ($embed_file =~ m{/}) {
13337: my ($path,$fname) = split(/\//,$embed_file);
13338: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
13339: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
13340: }
13341: } else {
13342: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
13343: ($size,$mtime) = @{$currfile->{$embed_file}};
13344: }
13345: }
13346: $showsize = $size/1024.0;
13347: $showsize = sprintf("%.1f",$showsize);
13348: if ($mtime > 0) {
13349: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
13350: }
13351: }
13352: return ($showsize,$showmtime);
13353: }
13354:
13355: sub ask_embedded_js {
13356: return <<"END";
13357: <script type="text/javascript"">
13358: // <![CDATA[
13359: function toggleBrowse(counter) {
13360: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
13361: var fileid = document.getElementById('embedded_item_'+counter);
13362: var uploaddivid = document.getElementById('moduploaddep_'+counter);
13363: if (chkboxid.checked == true) {
13364: uploaddivid.style.display='block';
13365: } else {
13366: uploaddivid.style.display='none';
13367: fileid.value = '';
13368: }
13369: }
13370: // ]]>
13371: </script>
13372:
13373: END
13374: }
13375:
1.661 raeburn 13376: sub upload_embedded {
13377: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 13378: $current_disk_usage,$hiddenstate,$actionurl) = @_;
13379: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 13380: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
13381: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
13382: my $orig_uploaded_filename =
13383: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 13384: foreach my $type ('orig','ref','attrib','codebase') {
13385: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
13386: $env{'form.embedded_'.$type.'_'.$i} =
13387: &unescape($env{'form.embedded_'.$type.'_'.$i});
13388: }
13389: }
1.661 raeburn 13390: my ($path,$fname) =
13391: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
13392: # no path, whole string is fname
13393: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
13394: $fname = &Apache::lonnet::clean_filename($fname);
13395: # See if there is anything left
13396: next if ($fname eq '');
13397:
13398: # Check if file already exists as a file or directory.
13399: my ($state,$msg);
13400: if ($context eq 'portfolio') {
13401: my $port_path = $dirpath;
13402: if ($group ne '') {
13403: $port_path = "groups/$group/$port_path";
13404: }
1.987 raeburn 13405: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
13406: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 13407: $dir_root,$port_path,$disk_quota,
13408: $current_disk_usage,$uname,$udom);
13409: if ($state eq 'will_exceed_quota'
1.984 raeburn 13410: || $state eq 'file_locked') {
1.661 raeburn 13411: $output .= $msg;
13412: next;
13413: }
13414: } elsif (($context eq 'author') || ($context eq 'testbank')) {
13415: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
13416: if ($state eq 'exists') {
13417: $output .= $msg;
13418: next;
13419: }
13420: }
13421: # Check if extension is valid
13422: if (($fname =~ /\.(\w+)$/) &&
13423: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 13424: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
13425: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 13426: next;
13427: } elsif (($fname =~ /\.(\w+)$/) &&
13428: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 13429: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 13430: next;
13431: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 13432: $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 13433: next;
13434: }
13435: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 13436: my $subdir = $path;
13437: $subdir =~ s{/+$}{};
1.661 raeburn 13438: if ($context eq 'portfolio') {
1.984 raeburn 13439: my $result;
13440: if ($state eq 'existingfile') {
13441: $result=
13442: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 13443: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 13444: } else {
1.984 raeburn 13445: $result=
13446: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 13447: $dirpath.
1.1123 raeburn 13448: $env{'form.currentpath'}.$subdir);
1.984 raeburn 13449: if ($result !~ m|^/uploaded/|) {
13450: $output .= '<span class="LC_error">'
13451: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13452: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13453: .'</span><br />';
13454: next;
13455: } else {
1.987 raeburn 13456: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13457: $path.$fname.'</span>').'<br />';
1.984 raeburn 13458: }
1.661 raeburn 13459: }
1.1123 raeburn 13460: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 13461: my $extendedsubdir = $dirpath.'/'.$subdir;
13462: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 13463: my $result =
1.1126 raeburn 13464: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 13465: if ($result !~ m|^/uploaded/|) {
13466: $output .= '<span class="LC_error">'
13467: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
13468: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
13469: .'</span><br />';
13470: next;
13471: } else {
13472: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13473: $path.$fname.'</span>').'<br />';
1.1125 raeburn 13474: if ($context eq 'syllabus') {
13475: &Apache::lonnet::make_public_indefinitely($result);
13476: }
1.987 raeburn 13477: }
1.661 raeburn 13478: } else {
13479: # Save the file
13480: my $target = $env{'form.embedded_item_'.$i};
13481: my $fullpath = $dir_root.$dirpath.'/'.$path;
13482: my $dest = $fullpath.$fname;
13483: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 13484: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 13485: my $count;
13486: my $filepath = $dir_root;
1.1027 raeburn 13487: foreach my $subdir (@parts) {
13488: $filepath .= "/$subdir";
13489: if (!-e $filepath) {
1.661 raeburn 13490: mkdir($filepath,0770);
13491: }
13492: }
13493: my $fh;
13494: if (!open($fh,'>'.$dest)) {
13495: &Apache::lonnet::logthis('Failed to create '.$dest);
13496: $output .= '<span class="LC_error">'.
1.1071 raeburn 13497: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
13498: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13499: '</span><br />';
13500: } else {
13501: if (!print $fh $env{'form.embedded_item_'.$i}) {
13502: &Apache::lonnet::logthis('Failed to write to '.$dest);
13503: $output .= '<span class="LC_error">'.
1.1071 raeburn 13504: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
13505: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 13506: '</span><br />';
13507: } else {
1.987 raeburn 13508: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
13509: $url.'</span>').'<br />';
13510: unless ($context eq 'testbank') {
13511: $footer .= &mt('View embedded file: [_1]',
13512: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
13513: }
13514: }
13515: close($fh);
13516: }
13517: }
13518: if ($env{'form.embedded_ref_'.$i}) {
13519: $pathchange{$i} = 1;
13520: }
13521: }
13522: if ($output) {
13523: $output = '<p>'.$output.'</p>';
13524: }
13525: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
13526: $returnflag = 'ok';
1.1071 raeburn 13527: my $numpathchgs = scalar(keys(%pathchange));
13528: if ($numpathchgs > 0) {
1.987 raeburn 13529: if ($context eq 'portfolio') {
13530: $output .= '<p>'.&mt('or').'</p>';
13531: } elsif ($context eq 'testbank') {
1.1071 raeburn 13532: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
13533: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 13534: $returnflag = 'modify_orightml';
13535: }
13536: }
1.1071 raeburn 13537: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 13538: }
13539:
13540: sub modify_html_form {
13541: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
13542: my $end = 0;
13543: my $modifyform;
13544: if ($context eq 'upload_embedded') {
13545: return unless (ref($pathchange) eq 'HASH');
13546: if ($env{'form.number_embedded_items'}) {
13547: $end += $env{'form.number_embedded_items'};
13548: }
13549: if ($env{'form.number_pathchange_items'}) {
13550: $end += $env{'form.number_pathchange_items'};
13551: }
13552: if ($end) {
13553: for (my $i=0; $i<$end; $i++) {
13554: if ($i < $env{'form.number_embedded_items'}) {
13555: next unless($pathchange->{$i});
13556: }
13557: $modifyform .=
13558: &start_data_table_row().
13559: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
13560: 'checked="checked" /></td>'.
13561: '<td>'.$env{'form.embedded_ref_'.$i}.
13562: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
13563: &escape($env{'form.embedded_ref_'.$i}).'" />'.
13564: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
13565: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
13566: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
13567: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
13568: '<td>'.$env{'form.embedded_orig_'.$i}.
13569: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
13570: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
13571: &end_data_table_row();
1.1071 raeburn 13572: }
1.987 raeburn 13573: }
13574: } else {
13575: $modifyform = $pathchgtable;
13576: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
13577: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
13578: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
13579: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
13580: }
13581: }
13582: if ($modifyform) {
1.1071 raeburn 13583: if ($actionurl eq '/adm/dependencies') {
13584: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
13585: }
1.987 raeburn 13586: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
13587: '<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".
13588: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
13589: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
13590: '</ol></p>'."\n".'<p>'.
13591: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
13592: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
13593: &start_data_table()."\n".
13594: &start_data_table_header_row().
13595: '<th>'.&mt('Change?').'</th>'.
13596: '<th>'.&mt('Current reference').'</th>'.
13597: '<th>'.&mt('Required reference').'</th>'.
13598: &end_data_table_header_row()."\n".
13599: $modifyform.
13600: &end_data_table().'<br />'."\n".$hiddenstate.
13601: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
13602: '</form>'."\n";
13603: }
13604: return;
13605: }
13606:
13607: sub modify_html_refs {
1.1123 raeburn 13608: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 13609: my $container;
13610: if ($context eq 'portfolio') {
13611: $container = $env{'form.container'};
13612: } elsif ($context eq 'coursedoc') {
13613: $container = $env{'form.primaryurl'};
1.1071 raeburn 13614: } elsif ($context eq 'manage_dependencies') {
13615: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
13616: $container = "/$container";
1.1123 raeburn 13617: } elsif ($context eq 'syllabus') {
13618: $container = $url;
1.987 raeburn 13619: } else {
1.1027 raeburn 13620: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 13621: }
13622: my (%allfiles,%codebase,$output,$content);
13623: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 13624: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 13625: if (wantarray) {
13626: return ('',0,0);
13627: } else {
13628: return;
13629: }
13630: }
13631: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13632: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 13633: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
13634: if (wantarray) {
13635: return ('',0,0);
13636: } else {
13637: return;
13638: }
13639: }
1.987 raeburn 13640: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 13641: if ($content eq '-1') {
13642: if (wantarray) {
13643: return ('',0,0);
13644: } else {
13645: return;
13646: }
13647: }
1.987 raeburn 13648: } else {
1.1071 raeburn 13649: unless ($container =~ /^\Q$dir_root\E/) {
13650: if (wantarray) {
13651: return ('',0,0);
13652: } else {
13653: return;
13654: }
13655: }
1.1317 raeburn 13656: if (open(my $fh,'<',$container)) {
1.987 raeburn 13657: $content = join('', <$fh>);
13658: close($fh);
13659: } else {
1.1071 raeburn 13660: if (wantarray) {
13661: return ('',0,0);
13662: } else {
13663: return;
13664: }
1.987 raeburn 13665: }
13666: }
13667: my ($count,$codebasecount) = (0,0);
13668: my $mm = new File::MMagic;
13669: my $mime_type = $mm->checktype_contents($content);
13670: if ($mime_type eq 'text/html') {
13671: my $parse_result =
13672: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
13673: \%codebase,\$content);
13674: if ($parse_result eq 'ok') {
13675: foreach my $i (@changes) {
13676: my $orig = &unescape($env{'form.embedded_orig_'.$i});
13677: my $ref = &unescape($env{'form.embedded_ref_'.$i});
13678: if ($allfiles{$ref}) {
13679: my $newname = $orig;
13680: my ($attrib_regexp,$codebase);
1.1006 raeburn 13681: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 13682: if ($attrib_regexp =~ /:/) {
13683: $attrib_regexp =~ s/\:/|/g;
13684: }
13685: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13686: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13687: $count += $numchg;
1.1123 raeburn 13688: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 13689: delete($allfiles{$ref});
1.987 raeburn 13690: }
13691: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 13692: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 13693: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
13694: $codebasecount ++;
13695: }
13696: }
13697: }
1.1123 raeburn 13698: my $skiprewrites;
1.987 raeburn 13699: if ($count || $codebasecount) {
13700: my $saveresult;
1.1071 raeburn 13701: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13702: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 13703: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13704: if ($url eq $container) {
13705: my ($fname) = ($container =~ m{/([^/]+)$});
13706: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13707: $count,'<span class="LC_filename">'.
1.1071 raeburn 13708: $fname.'</span>').'</p>';
1.987 raeburn 13709: } else {
13710: $output = '<p class="LC_error">'.
13711: &mt('Error: update failed for: [_1].',
13712: '<span class="LC_filename">'.
13713: $container.'</span>').'</p>';
13714: }
1.1123 raeburn 13715: if ($context eq 'syllabus') {
13716: unless ($saveresult eq 'ok') {
13717: $skiprewrites = 1;
13718: }
13719: }
1.987 raeburn 13720: } else {
1.1317 raeburn 13721: if (open(my $fh,'>',$container)) {
1.987 raeburn 13722: print $fh $content;
13723: close($fh);
13724: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13725: $count,'<span class="LC_filename">'.
13726: $container.'</span>').'</p>';
1.661 raeburn 13727: } else {
1.987 raeburn 13728: $output = '<p class="LC_error">'.
13729: &mt('Error: could not update [_1].',
13730: '<span class="LC_filename">'.
13731: $container.'</span>').'</p>';
1.661 raeburn 13732: }
13733: }
13734: }
1.1123 raeburn 13735: if (($context eq 'syllabus') && (!$skiprewrites)) {
13736: my ($actionurl,$state);
13737: $actionurl = "/public/$udom/$uname/syllabus";
13738: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
13739: &ask_for_embedded_content($actionurl,$state,\%allfiles,
13740: \%codebase,
13741: {'context' => 'rewrites',
13742: 'ignore_remote_references' => 1,});
13743: if (ref($mapping) eq 'HASH') {
13744: my $rewrites = 0;
13745: foreach my $key (keys(%{$mapping})) {
13746: next if ($key =~ m{^https?://});
13747: my $ref = $mapping->{$key};
13748: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13749: my $attrib;
13750: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13751: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13752: }
13753: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13754: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13755: $rewrites += $numchg;
13756: }
13757: }
13758: if ($rewrites) {
13759: my $saveresult;
13760: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13761: if ($url eq $container) {
13762: my ($fname) = ($container =~ m{/([^/]+)$});
13763: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13764: $count,'<span class="LC_filename">'.
13765: $fname.'</span>').'</p>';
13766: } else {
13767: $output .= '<p class="LC_error">'.
13768: &mt('Error: could not update links in [_1].',
13769: '<span class="LC_filename">'.
13770: $container.'</span>').'</p>';
13771:
13772: }
13773: }
13774: }
13775: }
1.987 raeburn 13776: } else {
13777: &logthis('Failed to parse '.$container.
13778: ' to modify references: '.$parse_result);
1.661 raeburn 13779: }
13780: }
1.1071 raeburn 13781: if (wantarray) {
13782: return ($output,$count,$codebasecount);
13783: } else {
13784: return $output;
13785: }
1.661 raeburn 13786: }
13787:
13788: sub check_for_existing {
13789: my ($path,$fname,$element) = @_;
13790: my ($state,$msg);
13791: if (-d $path.'/'.$fname) {
13792: $state = 'exists';
13793: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13794: } elsif (-e $path.'/'.$fname) {
13795: $state = 'exists';
13796: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13797: }
13798: if ($state eq 'exists') {
13799: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13800: }
13801: return ($state,$msg);
13802: }
13803:
13804: sub check_for_upload {
13805: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13806: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13807: my $filesize = length($env{'form.'.$element});
13808: if (!$filesize) {
13809: my $msg = '<span class="LC_error">'.
13810: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13811: '<span class="LC_filename">'.$fname.'</span>',
13812: $filesize).'<br />'.
1.1007 raeburn 13813: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13814: '</span>';
13815: return ('zero_bytes',$msg);
13816: }
13817: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13818: my $getpropath = 1;
1.1021 raeburn 13819: my ($dirlistref,$listerror) =
13820: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13821: my $found_file = 0;
13822: my $locked_file = 0;
1.991 raeburn 13823: my @lockers;
13824: my $navmap;
13825: if ($env{'request.course.id'}) {
13826: $navmap = Apache::lonnavmaps::navmap->new();
13827: }
1.1021 raeburn 13828: if (ref($dirlistref) eq 'ARRAY') {
13829: foreach my $line (@{$dirlistref}) {
13830: my ($file_name,$rest)=split(/\&/,$line,2);
13831: if ($file_name eq $fname){
13832: $file_name = $path.$file_name;
13833: if ($group ne '') {
13834: $file_name = $group.$file_name;
13835: }
13836: $found_file = 1;
13837: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13838: foreach my $lock (@lockers) {
13839: if (ref($lock) eq 'ARRAY') {
13840: my ($symb,$crsid) = @{$lock};
13841: if ($crsid eq $env{'request.course.id'}) {
13842: if (ref($navmap)) {
13843: my $res = $navmap->getBySymb($symb);
13844: foreach my $part (@{$res->parts()}) {
13845: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13846: unless (($slot_status == $res->RESERVED) ||
13847: ($slot_status == $res->RESERVED_LOCATION)) {
13848: $locked_file = 1;
13849: }
1.991 raeburn 13850: }
1.1021 raeburn 13851: } else {
13852: $locked_file = 1;
1.991 raeburn 13853: }
13854: } else {
13855: $locked_file = 1;
13856: }
13857: }
1.1021 raeburn 13858: }
13859: } else {
13860: my @info = split(/\&/,$rest);
13861: my $currsize = $info[6]/1000;
13862: if ($currsize < $filesize) {
13863: my $extra = $filesize - $currsize;
13864: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13865: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13866: &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 13867: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13868: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13869: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13870: return ('will_exceed_quota',$msg);
13871: }
1.984 raeburn 13872: }
13873: }
1.661 raeburn 13874: }
13875: }
13876: }
13877: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13878: my $msg = '<p class="LC_warning">'.
13879: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13880: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13881: return ('will_exceed_quota',$msg);
13882: } elsif ($found_file) {
13883: if ($locked_file) {
1.1179 bisitz 13884: my $msg = '<p class="LC_warning">';
1.661 raeburn 13885: $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 13886: $msg .= '</p>';
1.661 raeburn 13887: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13888: return ('file_locked',$msg);
13889: } else {
1.1179 bisitz 13890: my $msg = '<p class="LC_error">';
1.984 raeburn 13891: $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 13892: $msg .= '</p>';
1.984 raeburn 13893: return ('existingfile',$msg);
1.661 raeburn 13894: }
13895: }
13896: }
13897:
1.987 raeburn 13898: sub check_for_traversal {
13899: my ($path,$url,$toplevel) = @_;
13900: my @parts=split(/\//,$path);
13901: my $cleanpath;
13902: my $fullpath = $url;
13903: for (my $i=0;$i<@parts;$i++) {
13904: next if ($parts[$i] eq '.');
13905: if ($parts[$i] eq '..') {
13906: $fullpath =~ s{([^/]+/)$}{};
13907: } else {
13908: $fullpath .= $parts[$i].'/';
13909: }
13910: }
13911: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13912: $cleanpath = $1;
13913: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13914: my $curr_toprel = $1;
13915: my @parts = split(/\//,$curr_toprel);
13916: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13917: my @urlparts = split(/\//,$url_toprel);
13918: my $doubledots;
13919: my $startdiff = -1;
13920: for (my $i=0; $i<@urlparts; $i++) {
13921: if ($startdiff == -1) {
13922: unless ($urlparts[$i] eq $parts[$i]) {
13923: $startdiff = $i;
13924: $doubledots .= '../';
13925: }
13926: } else {
13927: $doubledots .= '../';
13928: }
13929: }
13930: if ($startdiff > -1) {
13931: $cleanpath = $doubledots;
13932: for (my $i=$startdiff; $i<@parts; $i++) {
13933: $cleanpath .= $parts[$i].'/';
13934: }
13935: }
13936: }
13937: $cleanpath =~ s{(/)$}{};
13938: return $cleanpath;
13939: }
1.31 albertel 13940:
1.1053 raeburn 13941: sub is_archive_file {
13942: my ($mimetype) = @_;
13943: if (($mimetype eq 'application/octet-stream') ||
13944: ($mimetype eq 'application/x-stuffit') ||
13945: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13946: return 1;
13947: }
13948: return;
13949: }
13950:
13951: sub decompress_form {
1.1065 raeburn 13952: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13953: my %lt = &Apache::lonlocal::texthash (
13954: this => 'This file is an archive file.',
1.1067 raeburn 13955: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13956: itsc => 'Its contents are as follows:',
1.1053 raeburn 13957: youm => 'You may wish to extract its contents.',
13958: extr => 'Extract contents',
1.1067 raeburn 13959: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13960: proa => 'Process automatically?',
1.1053 raeburn 13961: yes => 'Yes',
13962: no => 'No',
1.1067 raeburn 13963: fold => 'Title for folder containing movie',
13964: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13965: );
1.1065 raeburn 13966: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13967: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13968: my $info = &list_archive_contents($fileloc,\@paths);
13969: if (@paths) {
13970: foreach my $path (@paths) {
13971: $path =~ s{^/}{};
1.1067 raeburn 13972: if ($path =~ m{^([^/]+)/$}) {
13973: $topdir = $1;
13974: }
1.1065 raeburn 13975: if ($path =~ m{^([^/]+)/}) {
13976: $toplevel{$1} = $path;
13977: } else {
13978: $toplevel{$path} = $path;
13979: }
13980: }
13981: }
1.1067 raeburn 13982: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13983: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13984: "$topdir/media/",
13985: "$topdir/media/$topdir.mp4",
13986: "$topdir/media/FirstFrame.png",
13987: "$topdir/media/player.swf",
13988: "$topdir/media/swfobject.js",
13989: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13990: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13991: "$topdir/$topdir.mp4",
13992: "$topdir/$topdir\_config.xml",
13993: "$topdir/$topdir\_controller.swf",
13994: "$topdir/$topdir\_embed.css",
13995: "$topdir/$topdir\_First_Frame.png",
13996: "$topdir/$topdir\_player.html",
13997: "$topdir/$topdir\_Thumbnails.png",
13998: "$topdir/playerProductInstall.swf",
13999: "$topdir/scripts/",
14000: "$topdir/scripts/config_xml.js",
14001: "$topdir/scripts/handlebars.js",
14002: "$topdir/scripts/jquery-1.7.1.min.js",
14003: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
14004: "$topdir/scripts/modernizr.js",
14005: "$topdir/scripts/player-min.js",
14006: "$topdir/scripts/swfobject.js",
14007: "$topdir/skins/",
14008: "$topdir/skins/configuration_express.xml",
14009: "$topdir/skins/express_show/",
14010: "$topdir/skins/express_show/player-min.css",
14011: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 14012: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
14013: "$topdir/$topdir.mp4",
14014: "$topdir/$topdir\_config.xml",
14015: "$topdir/$topdir\_controller.swf",
14016: "$topdir/$topdir\_embed.css",
14017: "$topdir/$topdir\_First_Frame.png",
14018: "$topdir/$topdir\_player.html",
14019: "$topdir/$topdir\_Thumbnails.png",
14020: "$topdir/playerProductInstall.swf",
14021: "$topdir/scripts/",
14022: "$topdir/scripts/config_xml.js",
14023: "$topdir/scripts/techsmith-smart-player.min.js",
14024: "$topdir/skins/",
14025: "$topdir/skins/configuration_express.xml",
14026: "$topdir/skins/express_show/",
14027: "$topdir/skins/express_show/spritesheet.min.css",
14028: "$topdir/skins/express_show/spritesheet.png",
14029: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 14030: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 14031: if (@diffs == 0) {
1.1164 raeburn 14032: $is_camtasia = 6;
14033: } else {
1.1197 raeburn 14034: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 14035: if (@diffs == 0) {
14036: $is_camtasia = 8;
1.1197 raeburn 14037: } else {
14038: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
14039: if (@diffs == 0) {
14040: $is_camtasia = 8;
14041: }
1.1164 raeburn 14042: }
1.1067 raeburn 14043: }
14044: }
14045: my $output;
14046: if ($is_camtasia) {
14047: $output = <<"ENDCAM";
14048: <script type="text/javascript" language="Javascript">
14049: // <![CDATA[
14050:
14051: function camtasiaToggle() {
14052: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
14053: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 14054: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 14055: document.getElementById('camtasia_titles').style.display='block';
14056: } else {
14057: document.getElementById('camtasia_titles').style.display='none';
14058: }
14059: }
14060: }
14061: return;
14062: }
14063:
14064: // ]]>
14065: </script>
14066: <p>$lt{'camt'}</p>
14067: ENDCAM
1.1065 raeburn 14068: } else {
1.1067 raeburn 14069: $output = '<p>'.$lt{'this'};
14070: if ($info eq '') {
14071: $output .= ' '.$lt{'youm'}.'</p>'."\n";
14072: } else {
14073: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
14074: '<div><pre>'.$info.'</pre></div>';
14075: }
1.1065 raeburn 14076: }
1.1067 raeburn 14077: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 14078: my $duplicates;
14079: my $num = 0;
14080: if (ref($dirlist) eq 'ARRAY') {
14081: foreach my $item (@{$dirlist}) {
14082: if (ref($item) eq 'ARRAY') {
14083: if (exists($toplevel{$item->[0]})) {
14084: $duplicates .=
14085: &start_data_table_row().
14086: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
14087: 'value="0" checked="checked" />'.&mt('No').'</label>'.
14088: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
14089: 'value="1" />'.&mt('Yes').'</label>'.
14090: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
14091: '<td>'.$item->[0].'</td>';
14092: if ($item->[2]) {
14093: $duplicates .= '<td>'.&mt('Directory').'</td>';
14094: } else {
14095: $duplicates .= '<td>'.&mt('File').'</td>';
14096: }
14097: $duplicates .= '<td>'.$item->[3].'</td>'.
14098: '<td>'.
14099: &Apache::lonlocal::locallocaltime($item->[4]).
14100: '</td>'.
14101: &end_data_table_row();
14102: $num ++;
14103: }
14104: }
14105: }
14106: }
14107: my $itemcount;
14108: if (@paths > 0) {
14109: $itemcount = scalar(@paths);
14110: } else {
14111: $itemcount = 1;
14112: }
1.1067 raeburn 14113: if ($is_camtasia) {
14114: $output .= $lt{'auto'}.'<br />'.
14115: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 14116: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 14117: $lt{'yes'}.'</label> <label>'.
14118: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
14119: $lt{'no'}.'</label></span><br />'.
14120: '<div id="camtasia_titles" style="display:block">'.
14121: &Apache::lonhtmlcommon::start_pick_box().
14122: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
14123: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
14124: &Apache::lonhtmlcommon::row_closure().
14125: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
14126: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
14127: &Apache::lonhtmlcommon::row_closure(1).
14128: &Apache::lonhtmlcommon::end_pick_box().
14129: '</div>';
14130: }
1.1065 raeburn 14131: $output .=
14132: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 14133: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
14134: "\n";
1.1065 raeburn 14135: if ($duplicates ne '') {
14136: $output .= '<p><span class="LC_warning">'.
14137: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
14138: &start_data_table().
14139: &start_data_table_header_row().
14140: '<th>'.&mt('Overwrite?').'</th>'.
14141: '<th>'.&mt('Name').'</th>'.
14142: '<th>'.&mt('Type').'</th>'.
14143: '<th>'.&mt('Size').'</th>'.
14144: '<th>'.&mt('Last modified').'</th>'.
14145: &end_data_table_header_row().
14146: $duplicates.
14147: &end_data_table().
14148: '</p>';
14149: }
1.1067 raeburn 14150: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 14151: if (ref($hiddenelements) eq 'HASH') {
14152: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
14153: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
14154: }
14155: }
14156: $output .= <<"END";
1.1067 raeburn 14157: <br />
1.1053 raeburn 14158: <input type="submit" name="decompress" value="$lt{'extr'}" />
14159: </form>
14160: $noextract
14161: END
14162: return $output;
14163: }
14164:
1.1065 raeburn 14165: sub decompression_utility {
14166: my ($program) = @_;
14167: my @utilities = ('tar','gunzip','bunzip2','unzip');
14168: my $location;
14169: if (grep(/^\Q$program\E$/,@utilities)) {
14170: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
14171: '/usr/sbin/') {
14172: if (-x $dir.$program) {
14173: $location = $dir.$program;
14174: last;
14175: }
14176: }
14177: }
14178: return $location;
14179: }
14180:
14181: sub list_archive_contents {
14182: my ($file,$pathsref) = @_;
14183: my (@cmd,$output);
14184: my $needsregexp;
14185: if ($file =~ /\.zip$/) {
14186: @cmd = (&decompression_utility('unzip'),"-l");
14187: $needsregexp = 1;
14188: } elsif (($file =~ m/\.tar\.gz$/) ||
14189: ($file =~ /\.tgz$/)) {
14190: @cmd = (&decompression_utility('tar'),"-ztf");
14191: } elsif ($file =~ /\.tar\.bz2$/) {
14192: @cmd = (&decompression_utility('tar'),"-jtf");
14193: } elsif ($file =~ m|\.tar$|) {
14194: @cmd = (&decompression_utility('tar'),"-tf");
14195: }
14196: if (@cmd) {
14197: undef($!);
14198: undef($@);
14199: if (open(my $fh,"-|", @cmd, $file)) {
14200: while (my $line = <$fh>) {
14201: $output .= $line;
14202: chomp($line);
14203: my $item;
14204: if ($needsregexp) {
14205: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
14206: } else {
14207: $item = $line;
14208: }
14209: if ($item ne '') {
14210: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
14211: push(@{$pathsref},$item);
14212: }
14213: }
14214: }
14215: close($fh);
14216: }
14217: }
14218: return $output;
14219: }
14220:
1.1053 raeburn 14221: sub decompress_uploaded_file {
14222: my ($file,$dir) = @_;
14223: &Apache::lonnet::appenv({'cgi.file' => $file});
14224: &Apache::lonnet::appenv({'cgi.dir' => $dir});
14225: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
14226: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
14227: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
14228: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
14229: my $decompressed = $env{'cgi.decompressed'};
14230: &Apache::lonnet::delenv('cgi.file');
14231: &Apache::lonnet::delenv('cgi.dir');
14232: &Apache::lonnet::delenv('cgi.decompressed');
14233: return ($decompressed,$result);
14234: }
14235:
1.1055 raeburn 14236: sub process_decompression {
14237: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 14238: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
14239: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14240: &mt('Unexpected file path.').'</p>'."\n";
14241: }
14242: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
14243: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14244: &mt('Unexpected course context.').'</p>'."\n";
14245: }
1.1293 raeburn 14246: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 14247: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14248: &mt('Filename contained unexpected characters.').'</p>'."\n";
14249: }
1.1055 raeburn 14250: my ($dir,$error,$warning,$output);
1.1180 raeburn 14251: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 14252: $error = &mt('Filename not a supported archive file type.').
14253: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 14254: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
14255: } else {
14256: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14257: if ($docuhome eq 'no_host') {
14258: $error = &mt('Could not determine home server for course.');
14259: } else {
14260: my @ids=&Apache::lonnet::current_machine_ids();
14261: my $currdir = "$dir_root/$destination";
14262: if (grep(/^\Q$docuhome\E$/,@ids)) {
14263: $dir = &LONCAPA::propath($docudom,$docuname).
14264: "$dir_root/$destination";
14265: } else {
14266: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
14267: "$dir_root/$docudom/$docuname/$destination";
14268: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
14269: $error = &mt('Archive file not found.');
14270: }
14271: }
1.1065 raeburn 14272: my (@to_overwrite,@to_skip);
14273: if ($env{'form.archive_overwrite_total'} > 0) {
14274: my $total = $env{'form.archive_overwrite_total'};
14275: for (my $i=0; $i<$total; $i++) {
14276: if ($env{'form.archive_overwrite_'.$i} == 1) {
14277: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
14278: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
14279: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
14280: }
14281: }
14282: }
14283: my $numskip = scalar(@to_skip);
1.1292 raeburn 14284: my $numoverwrite = scalar(@to_overwrite);
14285: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 14286: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
14287: } elsif ($dir eq '') {
1.1055 raeburn 14288: $error = &mt('Directory containing archive file unavailable.');
14289: } elsif (!$error) {
1.1065 raeburn 14290: my ($decompressed,$display);
1.1292 raeburn 14291: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 14292: my $tempdir = time.'_'.$$.int(rand(10000));
14293: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 14294: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
14295: ($decompressed,$display) =
14296: &decompress_uploaded_file($file,"$dir/$tempdir");
14297: foreach my $item (@to_skip) {
14298: if (($item ne '') && ($item !~ /\.\./)) {
14299: if (-f "$dir/$tempdir/$item") {
14300: unlink("$dir/$tempdir/$item");
14301: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 14302: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 14303: }
14304: }
14305: }
14306: foreach my $item (@to_overwrite) {
14307: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
14308: if (($item ne '') && ($item !~ /\.\./)) {
14309: if (-f "$dir/$item") {
14310: unlink("$dir/$item");
14311: } elsif (-d "$dir/$item") {
1.1300 raeburn 14312: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 14313: }
14314: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
14315: }
1.1065 raeburn 14316: }
14317: }
1.1292 raeburn 14318: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 14319: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 14320: }
1.1065 raeburn 14321: }
14322: } else {
14323: ($decompressed,$display) =
14324: &decompress_uploaded_file($file,$dir);
14325: }
1.1055 raeburn 14326: if ($decompressed eq 'ok') {
1.1065 raeburn 14327: $output = '<p class="LC_info">'.
14328: &mt('Files extracted successfully from archive.').
14329: '</p>'."\n";
1.1055 raeburn 14330: my ($warning,$result,@contents);
14331: my ($newdirlistref,$newlisterror) =
14332: &Apache::lonnet::dirlist($currdir,$docudom,
14333: $docuname,1);
14334: my (%is_dir,%changes,@newitems);
14335: my $dirptr = 16384;
1.1065 raeburn 14336: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 14337: foreach my $dir_line (@{$newdirlistref}) {
14338: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 14339: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 14340: push(@newitems,$item);
14341: if ($dirptr&$testdir) {
14342: $is_dir{$item} = 1;
14343: }
14344: $changes{$item} = 1;
14345: }
14346: }
14347: }
14348: if (keys(%changes) > 0) {
14349: foreach my $item (sort(@newitems)) {
14350: if ($changes{$item}) {
14351: push(@contents,$item);
14352: }
14353: }
14354: }
14355: if (@contents > 0) {
1.1067 raeburn 14356: my $wantform;
14357: unless ($env{'form.autoextract_camtasia'}) {
14358: $wantform = 1;
14359: }
1.1056 raeburn 14360: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 14361: my ($count,$datatable) = &get_extracted($docudom,$docuname,
14362: $currdir,\%is_dir,
14363: \%children,\%parent,
1.1056 raeburn 14364: \@contents,\%dirorder,
14365: \%titles,$wantform);
1.1055 raeburn 14366: if ($datatable ne '') {
14367: $output .= &archive_options_form('decompressed',$datatable,
14368: $count,$hiddenelem);
1.1065 raeburn 14369: my $startcount = 6;
1.1055 raeburn 14370: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 14371: \%titles,\%children);
1.1055 raeburn 14372: }
1.1067 raeburn 14373: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 14374: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 14375: my %displayed;
14376: my $total = 1;
14377: $env{'form.archive_directory'} = [];
14378: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
14379: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
14380: $path =~ s{/$}{};
14381: my $item;
14382: if ($path ne '') {
14383: $item = "$path/$titles{$i}";
14384: } else {
14385: $item = $titles{$i};
14386: }
14387: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
14388: if ($item eq $contents[0]) {
14389: push(@{$env{'form.archive_directory'}},$i);
14390: $env{'form.archive_'.$i} = 'display';
14391: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
14392: $displayed{'folder'} = $i;
1.1164 raeburn 14393: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
14394: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 14395: $env{'form.archive_'.$i} = 'display';
14396: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
14397: $displayed{'web'} = $i;
14398: } else {
1.1164 raeburn 14399: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
14400: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
14401: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 14402: push(@{$env{'form.archive_directory'}},$i);
14403: }
14404: $env{'form.archive_'.$i} = 'dependency';
14405: }
14406: $total ++;
14407: }
14408: for (my $i=1; $i<$total; $i++) {
14409: next if ($i == $displayed{'web'});
14410: next if ($i == $displayed{'folder'});
14411: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
14412: }
14413: $env{'form.phase'} = 'decompress_cleanup';
14414: $env{'form.archivedelete'} = 1;
14415: $env{'form.archive_count'} = $total-1;
14416: $output .=
14417: &process_extracted_files('coursedocs',$docudom,
14418: $docuname,$destination,
14419: $dir_root,$hiddenelem);
14420: }
1.1055 raeburn 14421: } else {
14422: $warning = &mt('No new items extracted from archive file.');
14423: }
14424: } else {
14425: $output = $display;
14426: $error = &mt('An error occurred during extraction from the archive file.');
14427: }
14428: }
14429: }
14430: }
14431: if ($error) {
14432: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14433: $error.'</p>'."\n";
14434: }
14435: if ($warning) {
14436: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14437: }
14438: return $output;
14439: }
14440:
14441: sub get_extracted {
1.1056 raeburn 14442: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
14443: $titles,$wantform) = @_;
1.1055 raeburn 14444: my $count = 0;
14445: my $depth = 0;
14446: my $datatable;
1.1056 raeburn 14447: my @hierarchy;
1.1055 raeburn 14448: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 14449: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
14450: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 14451: foreach my $item (@{$contents}) {
14452: $count ++;
1.1056 raeburn 14453: @{$dirorder->{$count}} = @hierarchy;
14454: $titles->{$count} = $item;
1.1055 raeburn 14455: &archive_hierarchy($depth,$count,$parent,$children);
14456: if ($wantform) {
14457: $datatable .= &archive_row($is_dir->{$item},$item,
14458: $currdir,$depth,$count);
14459: }
14460: if ($is_dir->{$item}) {
14461: $depth ++;
1.1056 raeburn 14462: push(@hierarchy,$count);
14463: $parent->{$depth} = $count;
1.1055 raeburn 14464: $datatable .=
14465: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 14466: \$depth,\$count,\@hierarchy,$dirorder,
14467: $children,$parent,$titles,$wantform);
1.1055 raeburn 14468: $depth --;
1.1056 raeburn 14469: pop(@hierarchy);
1.1055 raeburn 14470: }
14471: }
14472: return ($count,$datatable);
14473: }
14474:
14475: sub recurse_extracted_archive {
1.1056 raeburn 14476: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
14477: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 14478: my $result='';
1.1056 raeburn 14479: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
14480: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
14481: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 14482: return $result;
14483: }
14484: my $dirptr = 16384;
14485: my ($newdirlistref,$newlisterror) =
14486: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
14487: if (ref($newdirlistref) eq 'ARRAY') {
14488: foreach my $dir_line (@{$newdirlistref}) {
14489: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
14490: unless ($item =~ /^\.+$/) {
14491: $$count ++;
1.1056 raeburn 14492: @{$dirorder->{$$count}} = @{$hierarchy};
14493: $titles->{$$count} = $item;
1.1055 raeburn 14494: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 14495:
1.1055 raeburn 14496: my $is_dir;
14497: if ($dirptr&$testdir) {
14498: $is_dir = 1;
14499: }
14500: if ($wantform) {
14501: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
14502: }
14503: if ($is_dir) {
14504: $$depth ++;
1.1056 raeburn 14505: push(@{$hierarchy},$$count);
14506: $parent->{$$depth} = $$count;
1.1055 raeburn 14507: $result .=
14508: &recurse_extracted_archive("$currdir/$item",$docudom,
14509: $docuname,$depth,$count,
1.1056 raeburn 14510: $hierarchy,$dirorder,$children,
14511: $parent,$titles,$wantform);
1.1055 raeburn 14512: $$depth --;
1.1056 raeburn 14513: pop(@{$hierarchy});
1.1055 raeburn 14514: }
14515: }
14516: }
14517: }
14518: return $result;
14519: }
14520:
14521: sub archive_hierarchy {
14522: my ($depth,$count,$parent,$children) =@_;
14523: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
14524: if (exists($parent->{$depth})) {
14525: $children->{$parent->{$depth}} .= $count.':';
14526: }
14527: }
14528: return;
14529: }
14530:
14531: sub archive_row {
14532: my ($is_dir,$item,$currdir,$depth,$count) = @_;
14533: my ($name) = ($item =~ m{([^/]+)$});
14534: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 14535: 'display' => 'Add as file',
1.1055 raeburn 14536: 'dependency' => 'Include as dependency',
14537: 'discard' => 'Discard',
14538: );
14539: if ($is_dir) {
1.1059 raeburn 14540: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 14541: }
1.1056 raeburn 14542: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
14543: my $offset = 0;
1.1055 raeburn 14544: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 14545: $offset ++;
1.1065 raeburn 14546: if ($action ne 'display') {
14547: $offset ++;
14548: }
1.1055 raeburn 14549: $output .= '<td><span class="LC_nobreak">'.
14550: '<label><input type="radio" name="archive_'.$count.
14551: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
14552: my $text = $choices{$action};
14553: if ($is_dir) {
14554: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
14555: if ($action eq 'display') {
1.1059 raeburn 14556: $text = &mt('Add as folder');
1.1055 raeburn 14557: }
1.1056 raeburn 14558: } else {
14559: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
14560:
14561: }
14562: $output .= ' /> '.$choices{$action}.'</label></span>';
14563: if ($action eq 'dependency') {
14564: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
14565: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
14566: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
14567: '<option value=""></option>'."\n".
14568: '</select>'."\n".
14569: '</div>';
1.1059 raeburn 14570: } elsif ($action eq 'display') {
14571: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
14572: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
14573: '</div>';
1.1055 raeburn 14574: }
1.1056 raeburn 14575: $output .= '</td>';
1.1055 raeburn 14576: }
14577: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
14578: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
14579: for (my $i=0; $i<$depth; $i++) {
14580: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
14581: }
14582: if ($is_dir) {
14583: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
14584: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
14585: } else {
14586: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
14587: }
14588: $output .= ' '.$name.'</td>'."\n".
14589: &end_data_table_row();
14590: return $output;
14591: }
14592:
14593: sub archive_options_form {
1.1065 raeburn 14594: my ($form,$display,$count,$hiddenelem) = @_;
14595: my %lt = &Apache::lonlocal::texthash(
14596: perm => 'Permanently remove archive file?',
14597: hows => 'How should each extracted item be incorporated in the course?',
14598: cont => 'Content actions for all',
14599: addf => 'Add as folder/file',
14600: incd => 'Include as dependency for a displayed file',
14601: disc => 'Discard',
14602: no => 'No',
14603: yes => 'Yes',
14604: save => 'Save',
14605: );
14606: my $output = <<"END";
14607: <form name="$form" method="post" action="">
14608: <p><span class="LC_nobreak">$lt{'perm'}
14609: <label>
14610: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
14611: </label>
14612:
14613: <label>
14614: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
14615: </span>
14616: </p>
14617: <input type="hidden" name="phase" value="decompress_cleanup" />
14618: <br />$lt{'hows'}
14619: <div class="LC_columnSection">
14620: <fieldset>
14621: <legend>$lt{'cont'}</legend>
14622: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
14623: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
14624: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
14625: </fieldset>
14626: </div>
14627: END
14628: return $output.
1.1055 raeburn 14629: &start_data_table()."\n".
1.1065 raeburn 14630: $display."\n".
1.1055 raeburn 14631: &end_data_table()."\n".
14632: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
14633: $hiddenelem.
1.1065 raeburn 14634: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 14635: '</form>';
14636: }
14637:
14638: sub archive_javascript {
1.1056 raeburn 14639: my ($startcount,$numitems,$titles,$children) = @_;
14640: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 14641: my $maintitle = $env{'form.comment'};
1.1055 raeburn 14642: my $scripttag = <<START;
14643: <script type="text/javascript">
14644: // <![CDATA[
14645:
14646: function checkAll(form,prefix) {
14647: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
14648: for (var i=0; i < form.elements.length; i++) {
14649: var id = form.elements[i].id;
14650: if ((id != '') && (id != undefined)) {
14651: if (idstr.test(id)) {
14652: if (form.elements[i].type == 'radio') {
14653: form.elements[i].checked = true;
1.1056 raeburn 14654: var nostart = i-$startcount;
1.1059 raeburn 14655: var offset = nostart%7;
14656: var count = (nostart-offset)/7;
1.1056 raeburn 14657: dependencyCheck(form,count,offset);
1.1055 raeburn 14658: }
14659: }
14660: }
14661: }
14662: }
14663:
14664: function propagateCheck(form,count) {
14665: if (count > 0) {
1.1059 raeburn 14666: var startelement = $startcount + ((count-1) * 7);
14667: for (var j=1; j<6; j++) {
14668: if ((j != 2) && (j != 4)) {
1.1056 raeburn 14669: var item = startelement + j;
14670: if (form.elements[item].type == 'radio') {
14671: if (form.elements[item].checked) {
14672: containerCheck(form,count,j);
14673: break;
14674: }
1.1055 raeburn 14675: }
14676: }
14677: }
14678: }
14679: }
14680:
14681: numitems = $numitems
1.1056 raeburn 14682: var titles = new Array(numitems);
14683: var parents = new Array(numitems);
1.1055 raeburn 14684: for (var i=0; i<numitems; i++) {
1.1056 raeburn 14685: parents[i] = new Array;
1.1055 raeburn 14686: }
1.1059 raeburn 14687: var maintitle = '$maintitle';
1.1055 raeburn 14688:
14689: START
14690:
1.1056 raeburn 14691: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
14692: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 14693: for (my $i=0; $i<@contents; $i ++) {
14694: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
14695: }
14696: }
14697:
1.1056 raeburn 14698: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
14699: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
14700: }
14701:
1.1055 raeburn 14702: $scripttag .= <<END;
14703:
14704: function containerCheck(form,count,offset) {
14705: if (count > 0) {
1.1056 raeburn 14706: dependencyCheck(form,count,offset);
1.1059 raeburn 14707: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 14708: form.elements[item].checked = true;
14709: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
14710: if (parents[count].length > 0) {
14711: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 14712: containerCheck(form,parents[count][j],offset);
14713: }
14714: }
14715: }
14716: }
14717: }
14718:
14719: function dependencyCheck(form,count,offset) {
14720: if (count > 0) {
1.1059 raeburn 14721: var chosen = (offset+$startcount)+7*(count-1);
14722: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 14723: var currtype = form.elements[depitem].type;
14724: if (form.elements[chosen].value == 'dependency') {
14725: document.getElementById('arc_depon_'+count).style.display='block';
14726: form.elements[depitem].options.length = 0;
14727: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 14728: for (var i=1; i<=numitems; i++) {
14729: if (i == count) {
14730: continue;
14731: }
1.1059 raeburn 14732: var startelement = $startcount + (i-1) * 7;
14733: for (var j=1; j<6; j++) {
14734: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 14735: var item = startelement + j;
14736: if (form.elements[item].type == 'radio') {
14737: if (form.elements[item].checked) {
14738: if (form.elements[item].value == 'display') {
14739: var n = form.elements[depitem].options.length;
14740: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
14741: }
14742: }
14743: }
14744: }
14745: }
14746: }
14747: } else {
14748: document.getElementById('arc_depon_'+count).style.display='none';
14749: form.elements[depitem].options.length = 0;
14750: form.elements[depitem].options[0] = new Option('Select','',true,true);
14751: }
1.1059 raeburn 14752: titleCheck(form,count,offset);
1.1056 raeburn 14753: }
14754: }
14755:
14756: function propagateSelect(form,count,offset) {
14757: if (count > 0) {
1.1065 raeburn 14758: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14759: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14760: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14761: if (parents[count].length > 0) {
14762: for (var j=0; j<parents[count].length; j++) {
14763: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14764: }
14765: }
14766: }
14767: }
14768: }
1.1056 raeburn 14769:
14770: function containerSelect(form,count,offset,picked) {
14771: if (count > 0) {
1.1065 raeburn 14772: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14773: if (form.elements[item].type == 'radio') {
14774: if (form.elements[item].value == 'dependency') {
14775: if (form.elements[item+1].type == 'select-one') {
14776: for (var i=0; i<form.elements[item+1].options.length; i++) {
14777: if (form.elements[item+1].options[i].value == picked) {
14778: form.elements[item+1].selectedIndex = i;
14779: break;
14780: }
14781: }
14782: }
14783: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14784: if (parents[count].length > 0) {
14785: for (var j=0; j<parents[count].length; j++) {
14786: containerSelect(form,parents[count][j],offset,picked);
14787: }
14788: }
14789: }
14790: }
14791: }
14792: }
14793: }
14794:
1.1059 raeburn 14795: function titleCheck(form,count,offset) {
14796: if (count > 0) {
14797: var chosen = (offset+$startcount)+7*(count-1);
14798: var depitem = $startcount + ((count-1) * 7) + 2;
14799: var currtype = form.elements[depitem].type;
14800: if (form.elements[chosen].value == 'display') {
14801: document.getElementById('arc_title_'+count).style.display='block';
14802: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14803: document.getElementById('archive_title_'+count).value=maintitle;
14804: }
14805: } else {
14806: document.getElementById('arc_title_'+count).style.display='none';
14807: if (currtype == 'text') {
14808: document.getElementById('archive_title_'+count).value='';
14809: }
14810: }
14811: }
14812: return;
14813: }
14814:
1.1055 raeburn 14815: // ]]>
14816: </script>
14817: END
14818: return $scripttag;
14819: }
14820:
14821: sub process_extracted_files {
1.1067 raeburn 14822: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14823: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14824: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14825: my @ids=&Apache::lonnet::current_machine_ids();
14826: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14827: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14828: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14829: if (grep(/^\Q$docuhome\E$/,@ids)) {
14830: $prefix = &LONCAPA::propath($docudom,$docuname);
14831: $pathtocheck = "$dir_root/$destination";
14832: $dir = $dir_root;
14833: $ishome = 1;
14834: } else {
14835: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14836: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14837: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14838: }
14839: my $currdir = "$dir_root/$destination";
14840: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14841: if ($env{'form.folderpath'}) {
14842: my @items = split('&',$env{'form.folderpath'});
14843: $folders{'0'} = $items[-2];
1.1099 raeburn 14844: if ($env{'form.folderpath'} =~ /\:1$/) {
14845: $containers{'0'}='page';
14846: } else {
14847: $containers{'0'}='sequence';
14848: }
1.1055 raeburn 14849: }
14850: my @archdirs = &get_env_multiple('form.archive_directory');
14851: if ($numitems) {
14852: for (my $i=1; $i<=$numitems; $i++) {
14853: my $path = $env{'form.archive_content_'.$i};
14854: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14855: my $item = $1;
14856: $toplevelitems{$item} = $i;
14857: if (grep(/^\Q$i\E$/,@archdirs)) {
14858: $is_dir{$item} = 1;
14859: }
14860: }
14861: }
14862: }
1.1067 raeburn 14863: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14864: if (keys(%toplevelitems) > 0) {
14865: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14866: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14867: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14868: }
1.1066 raeburn 14869: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14870: if ($numitems) {
14871: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14872: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14873: my $path = $env{'form.archive_content_'.$i};
14874: if ($path =~ /^\Q$pathtocheck\E/) {
14875: if ($env{'form.archive_'.$i} eq 'discard') {
14876: if ($prefix ne '' && $path ne '') {
14877: if (-e $prefix.$path) {
1.1066 raeburn 14878: if ((@archdirs > 0) &&
14879: (grep(/^\Q$i\E$/,@archdirs))) {
14880: $todeletedir{$prefix.$path} = 1;
14881: } else {
14882: $todelete{$prefix.$path} = 1;
14883: }
1.1055 raeburn 14884: }
14885: }
14886: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14887: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14888: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14889: $docstitle = $env{'form.archive_title_'.$i};
14890: if ($docstitle eq '') {
14891: $docstitle = $title;
14892: }
1.1055 raeburn 14893: $outer = 0;
1.1056 raeburn 14894: if (ref($dirorder{$i}) eq 'ARRAY') {
14895: if (@{$dirorder{$i}} > 0) {
14896: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14897: if ($env{'form.archive_'.$item} eq 'display') {
14898: $outer = $item;
14899: last;
14900: }
14901: }
14902: }
14903: }
14904: my ($errtext,$fatal) =
14905: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14906: '/'.$folders{$outer}.'.'.
14907: $containers{$outer});
14908: next if ($fatal);
14909: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14910: if ($context eq 'coursedocs') {
1.1056 raeburn 14911: $mapinner{$i} = time;
1.1055 raeburn 14912: $folders{$i} = 'default_'.$mapinner{$i};
14913: $containers{$i} = 'sequence';
14914: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14915: $folders{$i}.'.'.$containers{$i};
14916: my $newidx = &LONCAPA::map::getresidx();
14917: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14918: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14919: push(@LONCAPA::map::order,$newidx);
14920: my ($outtext,$errtext) =
14921: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14922: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14923: '.'.$containers{$outer},1,1);
1.1056 raeburn 14924: $newseqid{$i} = $newidx;
1.1067 raeburn 14925: unless ($errtext) {
1.1294 raeburn 14926: $result .= '<li>'.&mt('Folder: [_1] added to course',
14927: &HTML::Entities::encode($docstitle,'<>&"')).
14928: '</li>'."\n";
1.1067 raeburn 14929: }
1.1055 raeburn 14930: }
14931: } else {
14932: if ($context eq 'coursedocs') {
14933: my $newidx=&LONCAPA::map::getresidx();
14934: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14935: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14936: $title;
1.1392 raeburn 14937: if (($outer !~ /\D/) &&
14938: (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
14939: ($newidx !~ /\D/)) {
1.1294 raeburn 14940: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14941: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14942: }
14943: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14944: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14945: }
14946: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14947: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14948: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14949: unless ($ishome) {
14950: my $fetch = "$newdest{$i}/$title";
14951: $fetch =~ s/^\Q$prefix$dir\E//;
14952: $prompttofetch{$fetch} = 1;
14953: }
1.1292 raeburn 14954: }
1.1067 raeburn 14955: }
1.1294 raeburn 14956: $LONCAPA::map::resources[$newidx]=
14957: $docstitle.':'.$url.':false:normal:res';
14958: push(@LONCAPA::map::order, $newidx);
14959: my ($outtext,$errtext)=
14960: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14961: $docuname.'/'.$folders{$outer}.
14962: '.'.$containers{$outer},1,1);
14963: unless ($errtext) {
14964: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14965: $result .= '<li>'.&mt('File: [_1] added to course',
14966: &HTML::Entities::encode($docstitle,'<>&"')).
14967: '</li>'."\n";
14968: }
1.1067 raeburn 14969: }
1.1294 raeburn 14970: } else {
14971: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14972: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14973: }
1.1055 raeburn 14974: }
14975: }
1.1086 raeburn 14976: }
14977: } else {
1.1294 raeburn 14978: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14979: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14980: }
14981: }
14982: for (my $i=1; $i<=$numitems; $i++) {
14983: next unless ($env{'form.archive_'.$i} eq 'dependency');
14984: my $path = $env{'form.archive_content_'.$i};
14985: if ($path =~ /^\Q$pathtocheck\E/) {
14986: my ($title) = ($path =~ m{/([^/]+)$});
14987: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14988: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14989: if (ref($dirorder{$i}) eq 'ARRAY') {
14990: my ($itemidx,$fullpath,$relpath);
14991: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14992: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14993: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14994: if ($dirorder{$i}->[$j] eq $container) {
14995: $itemidx = $j;
1.1056 raeburn 14996: }
14997: }
1.1086 raeburn 14998: }
14999: if ($itemidx eq '') {
15000: $itemidx = 0;
15001: }
15002: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
15003: if ($mapinner{$referrer{$i}}) {
15004: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
15005: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
15006: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
15007: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
15008: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
15009: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
15010: if (!-e $fullpath) {
15011: mkdir($fullpath,0755);
1.1056 raeburn 15012: }
15013: }
1.1086 raeburn 15014: } else {
15015: last;
1.1056 raeburn 15016: }
1.1086 raeburn 15017: }
15018: }
15019: } elsif ($newdest{$referrer{$i}}) {
15020: $fullpath = $newdest{$referrer{$i}};
15021: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
15022: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
15023: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
15024: last;
15025: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
15026: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
15027: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
15028: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
15029: if (!-e $fullpath) {
15030: mkdir($fullpath,0755);
1.1056 raeburn 15031: }
15032: }
1.1086 raeburn 15033: } else {
15034: last;
1.1056 raeburn 15035: }
1.1055 raeburn 15036: }
15037: }
1.1086 raeburn 15038: if ($fullpath ne '') {
15039: if (-e "$prefix$path") {
1.1292 raeburn 15040: unless (rename("$prefix$path","$fullpath/$title")) {
15041: $warning .= &mt('Failed to rename dependency').'<br />';
15042: }
1.1086 raeburn 15043: }
15044: if (-e "$fullpath/$title") {
15045: my $showpath;
15046: if ($relpath ne '') {
15047: $showpath = "$relpath/$title";
15048: } else {
15049: $showpath = "/$title";
15050: }
1.1294 raeburn 15051: $result .= '<li>'.&mt('[_1] included as a dependency',
15052: &HTML::Entities::encode($showpath,'<>&"')).
15053: '</li>'."\n";
1.1292 raeburn 15054: unless ($ishome) {
15055: my $fetch = "$fullpath/$title";
15056: $fetch =~ s/^\Q$prefix$dir\E//;
15057: $prompttofetch{$fetch} = 1;
15058: }
1.1086 raeburn 15059: }
15060: }
1.1055 raeburn 15061: }
1.1086 raeburn 15062: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
15063: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 15064: &HTML::Entities::encode($path,'<>&"'),
15065: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
15066: '<br />';
1.1055 raeburn 15067: }
15068: } else {
1.1294 raeburn 15069: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 15070: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 15071: }
15072: }
15073: if (keys(%todelete)) {
15074: foreach my $key (keys(%todelete)) {
15075: unlink($key);
1.1066 raeburn 15076: }
15077: }
15078: if (keys(%todeletedir)) {
15079: foreach my $key (keys(%todeletedir)) {
15080: rmdir($key);
15081: }
15082: }
15083: foreach my $dir (sort(keys(%is_dir))) {
15084: if (($pathtocheck ne '') && ($dir ne '')) {
15085: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 15086: }
15087: }
1.1067 raeburn 15088: if ($result ne '') {
15089: $output .= '<ul>'."\n".
15090: $result."\n".
15091: '</ul>';
15092: }
15093: unless ($ishome) {
15094: my $replicationfail;
15095: foreach my $item (keys(%prompttofetch)) {
15096: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
15097: unless ($fetchresult eq 'ok') {
15098: $replicationfail .= '<li>'.$item.'</li>'."\n";
15099: }
15100: }
15101: if ($replicationfail) {
15102: $output .= '<p class="LC_error">'.
15103: &mt('Course home server failed to retrieve:').'<ul>'.
15104: $replicationfail.
15105: '</ul></p>';
15106: }
15107: }
1.1055 raeburn 15108: } else {
15109: $warning = &mt('No items found in archive.');
15110: }
15111: if ($error) {
15112: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
15113: $error.'</p>'."\n";
15114: }
15115: if ($warning) {
15116: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
15117: }
15118: return $output;
15119: }
15120:
1.1066 raeburn 15121: sub cleanup_empty_dirs {
15122: my ($path) = @_;
15123: if (($path ne '') && (-d $path)) {
15124: if (opendir(my $dirh,$path)) {
15125: my @dircontents = grep(!/^\./,readdir($dirh));
15126: my $numitems = 0;
15127: foreach my $item (@dircontents) {
15128: if (-d "$path/$item") {
1.1111 raeburn 15129: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 15130: if (-e "$path/$item") {
15131: $numitems ++;
15132: }
15133: } else {
15134: $numitems ++;
15135: }
15136: }
15137: if ($numitems == 0) {
15138: rmdir($path);
15139: }
15140: closedir($dirh);
15141: }
15142: }
15143: return;
15144: }
15145:
1.41 ng 15146: =pod
1.45 matthew 15147:
1.1162 raeburn 15148: =item * &get_folder_hierarchy()
1.1068 raeburn 15149:
15150: Provides hierarchy of names of folders/sub-folders containing the current
15151: item,
15152:
15153: Inputs: 3
15154: - $navmap - navmaps object
15155:
15156: - $map - url for map (either the trigger itself, or map containing
15157: the resource, which is the trigger).
15158:
15159: - $showitem - 1 => show title for map itself; 0 => do not show.
15160:
15161: Outputs: 1 @pathitems - array of folder/subfolder names.
15162:
15163: =cut
15164:
15165: sub get_folder_hierarchy {
15166: my ($navmap,$map,$showitem) = @_;
15167: my @pathitems;
15168: if (ref($navmap)) {
15169: my $mapres = $navmap->getResourceByUrl($map);
15170: if (ref($mapres)) {
15171: my $pcslist = $mapres->map_hierarchy();
15172: if ($pcslist ne '') {
15173: my @pcs = split(/,/,$pcslist);
15174: foreach my $pc (@pcs) {
15175: if ($pc == 1) {
1.1129 raeburn 15176: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 15177: } else {
15178: my $res = $navmap->getByMapPc($pc);
15179: if (ref($res)) {
15180: my $title = $res->compTitle();
15181: $title =~ s/\W+/_/g;
15182: if ($title ne '') {
15183: push(@pathitems,$title);
15184: }
15185: }
15186: }
15187: }
15188: }
1.1071 raeburn 15189: if ($showitem) {
15190: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 15191: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 15192: } else {
15193: my $maptitle = $mapres->compTitle();
15194: $maptitle =~ s/\W+/_/g;
15195: if ($maptitle ne '') {
15196: push(@pathitems,$maptitle);
15197: }
1.1068 raeburn 15198: }
15199: }
15200: }
15201: }
15202: return @pathitems;
15203: }
15204:
15205: =pod
15206:
1.1015 raeburn 15207: =item * &get_turnedin_filepath()
15208:
15209: Determines path in a user's portfolio file for storage of files uploaded
15210: to a specific essayresponse or dropbox item.
15211:
15212: Inputs: 3 required + 1 optional.
15213: $symb is symb for resource, $uname and $udom are for current user (required).
15214: $caller is optional (can be "submission", if routine is called when storing
15215: an upoaded file when "Submit Answer" button was pressed).
15216:
15217: Returns array containing $path and $multiresp.
15218: $path is path in portfolio. $multiresp is 1 if this resource contains more
15219: than one file upload item. Callers of routine should append partid as a
15220: subdirectory to $path in cases where $multiresp is 1.
15221:
15222: Called by: homework/essayresponse.pm and homework/structuretags.pm
15223:
15224: =cut
15225:
15226: sub get_turnedin_filepath {
15227: my ($symb,$uname,$udom,$caller) = @_;
15228: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
15229: my $turnindir;
15230: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
15231: $turnindir = $userhash{'turnindir'};
15232: my ($path,$multiresp);
15233: if ($turnindir eq '') {
15234: if ($caller eq 'submission') {
15235: $turnindir = &mt('turned in');
15236: $turnindir =~ s/\W+/_/g;
15237: my %newhash = (
15238: 'turnindir' => $turnindir,
15239: );
15240: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
15241: }
15242: }
15243: if ($turnindir ne '') {
15244: $path = '/'.$turnindir.'/';
15245: my ($multipart,$turnin,@pathitems);
15246: my $navmap = Apache::lonnavmaps::navmap->new();
15247: if (defined($navmap)) {
15248: my $mapres = $navmap->getResourceByUrl($map);
15249: if (ref($mapres)) {
15250: my $pcslist = $mapres->map_hierarchy();
15251: if ($pcslist ne '') {
15252: foreach my $pc (split(/,/,$pcslist)) {
15253: my $res = $navmap->getByMapPc($pc);
15254: if (ref($res)) {
15255: my $title = $res->compTitle();
15256: $title =~ s/\W+/_/g;
15257: if ($title ne '') {
1.1149 raeburn 15258: if (($pc > 1) && (length($title) > 12)) {
15259: $title = substr($title,0,12);
15260: }
1.1015 raeburn 15261: push(@pathitems,$title);
15262: }
15263: }
15264: }
15265: }
15266: my $maptitle = $mapres->compTitle();
15267: $maptitle =~ s/\W+/_/g;
15268: if ($maptitle ne '') {
1.1149 raeburn 15269: if (length($maptitle) > 12) {
15270: $maptitle = substr($maptitle,0,12);
15271: }
1.1015 raeburn 15272: push(@pathitems,$maptitle);
15273: }
15274: unless ($env{'request.state'} eq 'construct') {
15275: my $res = $navmap->getBySymb($symb);
15276: if (ref($res)) {
15277: my $partlist = $res->parts();
15278: my $totaluploads = 0;
15279: if (ref($partlist) eq 'ARRAY') {
15280: foreach my $part (@{$partlist}) {
15281: my @types = $res->responseType($part);
15282: my @ids = $res->responseIds($part);
15283: for (my $i=0; $i < scalar(@ids); $i++) {
15284: if ($types[$i] eq 'essay') {
15285: my $partid = $part.'_'.$ids[$i];
15286: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
15287: $totaluploads ++;
15288: }
15289: }
15290: }
15291: }
15292: if ($totaluploads > 1) {
15293: $multiresp = 1;
15294: }
15295: }
15296: }
15297: }
15298: } else {
15299: return;
15300: }
15301: } else {
15302: return;
15303: }
15304: my $restitle=&Apache::lonnet::gettitle($symb);
15305: $restitle =~ s/\W+/_/g;
15306: if ($restitle eq '') {
15307: $restitle = ($resurl =~ m{/[^/]+$});
15308: if ($restitle eq '') {
15309: $restitle = time;
15310: }
15311: }
1.1149 raeburn 15312: if (length($restitle) > 12) {
15313: $restitle = substr($restitle,0,12);
15314: }
1.1015 raeburn 15315: push(@pathitems,$restitle);
15316: $path .= join('/',@pathitems);
15317: }
15318: return ($path,$multiresp);
15319: }
15320:
15321: =pod
15322:
1.464 albertel 15323: =back
1.41 ng 15324:
1.112 bowersj2 15325: =head1 CSV Upload/Handling functions
1.38 albertel 15326:
1.41 ng 15327: =over 4
15328:
1.648 raeburn 15329: =item * &upfile_store($r)
1.41 ng 15330:
15331: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 15332: needs $env{'form.upfile'}
1.41 ng 15333: returns $datatoken to be put into hidden field
15334:
15335: =cut
1.31 albertel 15336:
15337: sub upfile_store {
15338: my $r=shift;
1.258 albertel 15339: $env{'form.upfile'}=~s/\r/\n/gs;
15340: $env{'form.upfile'}=~s/\f/\n/gs;
15341: $env{'form.upfile'}=~s/\n+/\n/gs;
15342: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 15343:
1.1299 raeburn 15344: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
15345: '_enroll_'.$env{'request.course.id'}.'_'.
15346: time.'_'.$$);
15347: return if ($datatoken eq '');
15348:
1.31 albertel 15349: {
1.158 raeburn 15350: my $datafile = $r->dir_config('lonDaemons').
15351: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15352: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 15353: print $fh $env{'form.upfile'};
1.158 raeburn 15354: close($fh);
15355: }
1.31 albertel 15356: }
15357: return $datatoken;
15358: }
15359:
1.56 matthew 15360: =pod
15361:
1.1290 raeburn 15362: =item * &load_tmp_file($r,$datatoken)
1.41 ng 15363:
15364: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 15365: $datatoken is the name to assign to the temporary file.
1.258 albertel 15366: sets $env{'form.upfile'} to the contents of the file
1.41 ng 15367:
15368: =cut
1.31 albertel 15369:
15370: sub load_tmp_file {
1.1290 raeburn 15371: my ($r,$datatoken) = @_;
15372: return if ($datatoken eq '');
1.31 albertel 15373: my @studentdata=();
15374: {
1.158 raeburn 15375: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 15376: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 15377: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 15378: @studentdata=<$fh>;
15379: close($fh);
15380: }
1.31 albertel 15381: }
1.258 albertel 15382: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 15383: }
15384:
1.1290 raeburn 15385: sub valid_datatoken {
15386: my ($datatoken) = @_;
1.1325 raeburn 15387: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 15388: return $datatoken;
15389: }
15390: return;
15391: }
15392:
1.56 matthew 15393: =pod
15394:
1.648 raeburn 15395: =item * &upfile_record_sep()
1.41 ng 15396:
15397: Separate uploaded file into records
15398: returns array of records,
1.258 albertel 15399: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 15400:
15401: =cut
1.31 albertel 15402:
15403: sub upfile_record_sep {
1.258 albertel 15404: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 15405: } else {
1.248 albertel 15406: my @records;
1.258 albertel 15407: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 15408: if ($line=~/^\s*$/) { next; }
15409: push(@records,$line);
15410: }
15411: return @records;
1.31 albertel 15412: }
15413: }
15414:
1.56 matthew 15415: =pod
15416:
1.648 raeburn 15417: =item * &record_sep($record)
1.41 ng 15418:
1.258 albertel 15419: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 15420:
15421: =cut
15422:
1.263 www 15423: sub takeleft {
15424: my $index=shift;
15425: return substr('0000'.$index,-4,4);
15426: }
15427:
1.31 albertel 15428: sub record_sep {
15429: my $record=shift;
15430: my %components=();
1.258 albertel 15431: if ($env{'form.upfiletype'} eq 'xml') {
15432: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 15433: my $i=0;
1.356 albertel 15434: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 15435: $field=~s/^(\"|\')//;
15436: $field=~s/(\"|\')$//;
1.263 www 15437: $components{&takeleft($i)}=$field;
1.31 albertel 15438: $i++;
15439: }
1.258 albertel 15440: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 15441: my $i=0;
1.356 albertel 15442: foreach my $field (split(/\t/,$record)) {
1.31 albertel 15443: $field=~s/^(\"|\')//;
15444: $field=~s/(\"|\')$//;
1.263 www 15445: $components{&takeleft($i)}=$field;
1.31 albertel 15446: $i++;
15447: }
15448: } else {
1.561 www 15449: my $separator=',';
1.480 banghart 15450: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 15451: $separator=';';
1.480 banghart 15452: }
1.31 albertel 15453: my $i=0;
1.561 www 15454: # the character we are looking for to indicate the end of a quote or a record
15455: my $looking_for=$separator;
15456: # do not add the characters to the fields
15457: my $ignore=0;
15458: # we just encountered a separator (or the beginning of the record)
15459: my $just_found_separator=1;
15460: # store the field we are working on here
15461: my $field='';
15462: # work our way through all characters in record
15463: foreach my $character ($record=~/(.)/g) {
15464: if ($character eq $looking_for) {
15465: if ($character ne $separator) {
15466: # Found the end of a quote, again looking for separator
15467: $looking_for=$separator;
15468: $ignore=1;
15469: } else {
15470: # Found a separator, store away what we got
15471: $components{&takeleft($i)}=$field;
15472: $i++;
15473: $just_found_separator=1;
15474: $ignore=0;
15475: $field='';
15476: }
15477: next;
15478: }
15479: # single or double quotation marks after a separator indicate beginning of a quote
15480: # we are now looking for the end of the quote and need to ignore separators
15481: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
15482: $looking_for=$character;
15483: next;
15484: }
15485: # ignore would be true after we reached the end of a quote
15486: if ($ignore) { next; }
15487: if (($just_found_separator) && ($character=~/\s/)) { next; }
15488: $field.=$character;
15489: $just_found_separator=0;
1.31 albertel 15490: }
1.561 www 15491: # catch the very last entry, since we never encountered the separator
15492: $components{&takeleft($i)}=$field;
1.31 albertel 15493: }
15494: return %components;
15495: }
15496:
1.144 matthew 15497: ######################################################
15498: ######################################################
15499:
1.56 matthew 15500: =pod
15501:
1.648 raeburn 15502: =item * &upfile_select_html()
1.41 ng 15503:
1.144 matthew 15504: Return HTML code to select a file from the users machine and specify
15505: the file type.
1.41 ng 15506:
15507: =cut
15508:
1.144 matthew 15509: ######################################################
15510: ######################################################
1.31 albertel 15511: sub upfile_select_html {
1.144 matthew 15512: my %Types = (
15513: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 15514: semisv => &mt('Semicolon separated values'),
1.144 matthew 15515: space => &mt('Space separated'),
15516: tab => &mt('Tabulator separated'),
15517: # xml => &mt('HTML/XML'),
15518: );
15519: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 15520: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 15521: foreach my $type (sort(keys(%Types))) {
15522: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
15523: }
15524: $Str .= "</select>\n";
15525: return $Str;
1.31 albertel 15526: }
15527:
1.301 albertel 15528: sub get_samples {
15529: my ($records,$toget) = @_;
15530: my @samples=({});
15531: my $got=0;
15532: foreach my $rec (@$records) {
15533: my %temp = &record_sep($rec);
15534: if (! grep(/\S/, values(%temp))) { next; }
15535: if (%temp) {
15536: $samples[$got]=\%temp;
15537: $got++;
15538: if ($got == $toget) { last; }
15539: }
15540: }
15541: return \@samples;
15542: }
15543:
1.144 matthew 15544: ######################################################
15545: ######################################################
15546:
1.56 matthew 15547: =pod
15548:
1.648 raeburn 15549: =item * &csv_print_samples($r,$records)
1.41 ng 15550:
15551: Prints a table of sample values from each column uploaded $r is an
15552: Apache Request ref, $records is an arrayref from
15553: &Apache::loncommon::upfile_record_sep
15554:
15555: =cut
15556:
1.144 matthew 15557: ######################################################
15558: ######################################################
1.31 albertel 15559: sub csv_print_samples {
15560: my ($r,$records) = @_;
1.662 bisitz 15561: my $samples = &get_samples($records,5);
1.301 albertel 15562:
1.594 raeburn 15563: $r->print(&mt('Samples').'<br />'.&start_data_table().
15564: &start_data_table_header_row());
1.356 albertel 15565: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 15566: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 15567: $r->print(&end_data_table_header_row());
1.301 albertel 15568: foreach my $hash (@$samples) {
1.594 raeburn 15569: $r->print(&start_data_table_row());
1.356 albertel 15570: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 15571: $r->print('<td>');
1.356 albertel 15572: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 15573: $r->print('</td>');
15574: }
1.594 raeburn 15575: $r->print(&end_data_table_row());
1.31 albertel 15576: }
1.594 raeburn 15577: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 15578: }
15579:
1.144 matthew 15580: ######################################################
15581: ######################################################
15582:
1.56 matthew 15583: =pod
15584:
1.648 raeburn 15585: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 15586:
15587: Prints a table to create associations between values and table columns.
1.144 matthew 15588:
1.41 ng 15589: $r is an Apache Request ref,
15590: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 15591: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 15592:
15593: =cut
15594:
1.144 matthew 15595: ######################################################
15596: ######################################################
1.31 albertel 15597: sub csv_print_select_table {
15598: my ($r,$records,$d) = @_;
1.301 albertel 15599: my $i=0;
15600: my $samples = &get_samples($records,1);
1.144 matthew 15601: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 15602: &start_data_table().&start_data_table_header_row().
1.144 matthew 15603: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 15604: '<th>'.&mt('Column').'</th>'.
15605: &end_data_table_header_row()."\n");
1.356 albertel 15606: foreach my $array_ref (@$d) {
15607: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 15608: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 15609:
1.875 bisitz 15610: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 15611: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 15612: $r->print('<option value="none"></option>');
1.356 albertel 15613: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
15614: $r->print('<option value="'.$sample.'"'.
15615: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 15616: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 15617: }
1.594 raeburn 15618: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 15619: $i++;
15620: }
1.594 raeburn 15621: $r->print(&end_data_table());
1.31 albertel 15622: $i--;
15623: return $i;
15624: }
1.56 matthew 15625:
1.144 matthew 15626: ######################################################
15627: ######################################################
15628:
1.56 matthew 15629: =pod
1.31 albertel 15630:
1.648 raeburn 15631: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 15632:
15633: Prints a table of sample values from the upload and can make associate samples to internal names.
15634:
15635: $r is an Apache Request ref,
15636: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
15637: $d is an array of 2 element arrays (internal name, displayed name)
15638:
15639: =cut
15640:
1.144 matthew 15641: ######################################################
15642: ######################################################
1.31 albertel 15643: sub csv_samples_select_table {
15644: my ($r,$records,$d) = @_;
15645: my $i=0;
1.144 matthew 15646: #
1.662 bisitz 15647: my $max_samples = 5;
15648: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 15649: $r->print(&start_data_table().
15650: &start_data_table_header_row().'<th>'.
15651: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
15652: &end_data_table_header_row());
1.301 albertel 15653:
15654: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 15655: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 15656: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 15657: foreach my $option (@$d) {
15658: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 15659: $r->print('<option value="'.$value.'"'.
1.253 albertel 15660: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 15661: $display.'</option>');
1.31 albertel 15662: }
15663: $r->print('</select></td><td>');
1.662 bisitz 15664: foreach my $line (0..($max_samples-1)) {
1.301 albertel 15665: if (defined($samples->[$line]{$key})) {
15666: $r->print($samples->[$line]{$key}."<br />\n");
15667: }
15668: }
1.594 raeburn 15669: $r->print('</td>'.&end_data_table_row());
1.31 albertel 15670: $i++;
15671: }
1.594 raeburn 15672: $r->print(&end_data_table());
1.31 albertel 15673: $i--;
15674: return($i);
1.115 matthew 15675: }
15676:
1.144 matthew 15677: ######################################################
15678: ######################################################
15679:
1.115 matthew 15680: =pod
15681:
1.648 raeburn 15682: =item * &clean_excel_name($name)
1.115 matthew 15683:
15684: Returns a replacement for $name which does not contain any illegal characters.
15685:
15686: =cut
15687:
1.144 matthew 15688: ######################################################
15689: ######################################################
1.115 matthew 15690: sub clean_excel_name {
15691: my ($name) = @_;
15692: $name =~ s/[:\*\?\/\\]//g;
15693: if (length($name) > 31) {
15694: $name = substr($name,0,31);
15695: }
15696: return $name;
1.25 albertel 15697: }
1.84 albertel 15698:
1.85 albertel 15699: =pod
15700:
1.648 raeburn 15701: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 15702:
15703: Returns either 1 or undef
15704:
15705: 1 if the part is to be hidden, undef if it is to be shown
15706:
15707: Arguments are:
15708:
15709: $id the id of the part to be checked
15710: $symb, optional the symb of the resource to check
15711: $udom, optional the domain of the user to check for
15712: $uname, optional the username of the user to check for
15713:
15714: =cut
1.84 albertel 15715:
15716: sub check_if_partid_hidden {
15717: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 15718: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 15719: $symb,$udom,$uname);
1.141 albertel 15720: my $truth=1;
15721: #if the string starts with !, then the list is the list to show not hide
15722: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 15723: my @hiddenlist=split(/,/,$hiddenparts);
15724: foreach my $checkid (@hiddenlist) {
1.141 albertel 15725: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 15726: }
1.141 albertel 15727: return !$truth;
1.84 albertel 15728: }
1.127 matthew 15729:
1.138 matthew 15730:
15731: ############################################################
15732: ############################################################
15733:
15734: =pod
15735:
1.157 matthew 15736: =back
15737:
1.138 matthew 15738: =head1 cgi-bin script and graphing routines
15739:
1.157 matthew 15740: =over 4
15741:
1.648 raeburn 15742: =item * &get_cgi_id()
1.138 matthew 15743:
15744: Inputs: none
15745:
15746: Returns an id which can be used to pass environment variables
15747: to various cgi-bin scripts. These environment variables will
15748: be removed from the users environment after a given time by
15749: the routine &Apache::lonnet::transfer_profile_to_env.
15750:
15751: =cut
15752:
15753: ############################################################
15754: ############################################################
1.152 albertel 15755: my $uniq=0;
1.136 matthew 15756: sub get_cgi_id {
1.154 albertel 15757: $uniq=($uniq+1)%100000;
1.280 albertel 15758: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15759: }
15760:
1.127 matthew 15761: ############################################################
15762: ############################################################
15763:
15764: =pod
15765:
1.648 raeburn 15766: =item * &DrawBarGraph()
1.127 matthew 15767:
1.138 matthew 15768: Facilitates the plotting of data in a (stacked) bar graph.
15769: Puts plot definition data into the users environment in order for
15770: graph.png to plot it. Returns an <img> tag for the plot.
15771: The bars on the plot are labeled '1','2',...,'n'.
15772:
15773: Inputs:
15774:
15775: =over 4
15776:
15777: =item $Title: string, the title of the plot
15778:
15779: =item $xlabel: string, text describing the X-axis of the plot
15780:
15781: =item $ylabel: string, text describing the Y-axis of the plot
15782:
15783: =item $Max: scalar, the maximum Y value to use in the plot
15784: If $Max is < any data point, the graph will not be rendered.
15785:
1.140 matthew 15786: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15787: they are plotted. If undefined, default values will be used.
15788:
1.178 matthew 15789: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15790:
1.138 matthew 15791: =item @Values: An array of array references. Each array reference holds data
15792: to be plotted in a stacked bar chart.
15793:
1.239 matthew 15794: =item If the final element of @Values is a hash reference the key/value
15795: pairs will be added to the graph definition.
15796:
1.138 matthew 15797: =back
15798:
15799: Returns:
15800:
15801: An <img> tag which references graph.png and the appropriate identifying
15802: information for the plot.
15803:
1.127 matthew 15804: =cut
15805:
15806: ############################################################
15807: ############################################################
1.134 matthew 15808: sub DrawBarGraph {
1.178 matthew 15809: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15810: #
15811: if (! defined($colors)) {
15812: $colors = ['#33ff00',
15813: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15814: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15815: ];
15816: }
1.228 matthew 15817: my $extra_settings = {};
15818: if (ref($Values[-1]) eq 'HASH') {
15819: $extra_settings = pop(@Values);
15820: }
1.127 matthew 15821: #
1.136 matthew 15822: my $identifier = &get_cgi_id();
15823: my $id = 'cgi.'.$identifier;
1.129 matthew 15824: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15825: return '';
15826: }
1.225 matthew 15827: #
15828: my @Labels;
15829: if (defined($labels)) {
15830: @Labels = @$labels;
15831: } else {
15832: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15833: push(@Labels,$i+1);
1.225 matthew 15834: }
15835: }
15836: #
1.129 matthew 15837: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15838: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15839: my %ValuesHash;
15840: my $NumSets=1;
15841: foreach my $array (@Values) {
15842: next if (! ref($array));
1.136 matthew 15843: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15844: join(',',@$array);
1.129 matthew 15845: }
1.127 matthew 15846: #
1.136 matthew 15847: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15848: if ($NumBars < 3) {
15849: $width = 120+$NumBars*32;
1.220 matthew 15850: $xskip = 1;
1.225 matthew 15851: $bar_width = 30;
15852: } elsif ($NumBars < 5) {
15853: $width = 120+$NumBars*20;
15854: $xskip = 1;
15855: $bar_width = 20;
1.220 matthew 15856: } elsif ($NumBars < 10) {
1.136 matthew 15857: $width = 120+$NumBars*15;
15858: $xskip = 1;
15859: $bar_width = 15;
15860: } elsif ($NumBars <= 25) {
15861: $width = 120+$NumBars*11;
15862: $xskip = 5;
15863: $bar_width = 8;
15864: } elsif ($NumBars <= 50) {
15865: $width = 120+$NumBars*8;
15866: $xskip = 5;
15867: $bar_width = 4;
15868: } else {
15869: $width = 120+$NumBars*8;
15870: $xskip = 5;
15871: $bar_width = 4;
15872: }
15873: #
1.137 matthew 15874: $Max = 1 if ($Max < 1);
15875: if ( int($Max) < $Max ) {
15876: $Max++;
15877: $Max = int($Max);
15878: }
1.127 matthew 15879: $Title = '' if (! defined($Title));
15880: $xlabel = '' if (! defined($xlabel));
15881: $ylabel = '' if (! defined($ylabel));
1.369 www 15882: $ValuesHash{$id.'.title'} = &escape($Title);
15883: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15884: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15885: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15886: $ValuesHash{$id.'.NumBars'} = $NumBars;
15887: $ValuesHash{$id.'.NumSets'} = $NumSets;
15888: $ValuesHash{$id.'.PlotType'} = 'bar';
15889: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15890: $ValuesHash{$id.'.height'} = $height;
15891: $ValuesHash{$id.'.width'} = $width;
15892: $ValuesHash{$id.'.xskip'} = $xskip;
15893: $ValuesHash{$id.'.bar_width'} = $bar_width;
15894: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15895: #
1.228 matthew 15896: # Deal with other parameters
15897: while (my ($key,$value) = each(%$extra_settings)) {
15898: $ValuesHash{$id.'.'.$key} = $value;
15899: }
15900: #
1.646 raeburn 15901: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15902: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15903: }
15904:
15905: ############################################################
15906: ############################################################
15907:
15908: =pod
15909:
1.648 raeburn 15910: =item * &DrawXYGraph()
1.137 matthew 15911:
1.138 matthew 15912: Facilitates the plotting of data in an XY graph.
15913: Puts plot definition data into the users environment in order for
15914: graph.png to plot it. Returns an <img> tag for the plot.
15915:
15916: Inputs:
15917:
15918: =over 4
15919:
15920: =item $Title: string, the title of the plot
15921:
15922: =item $xlabel: string, text describing the X-axis of the plot
15923:
15924: =item $ylabel: string, text describing the Y-axis of the plot
15925:
15926: =item $Max: scalar, the maximum Y value to use in the plot
15927: If $Max is < any data point, the graph will not be rendered.
15928:
15929: =item $colors: Array ref containing the hex color codes for the data to be
15930: plotted in. If undefined, default values will be used.
15931:
15932: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15933:
15934: =item $Ydata: Array ref containing Array refs.
1.185 www 15935: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15936:
15937: =item %Values: hash indicating or overriding any default values which are
15938: passed to graph.png.
15939: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15940:
15941: =back
15942:
15943: Returns:
15944:
15945: An <img> tag which references graph.png and the appropriate identifying
15946: information for the plot.
15947:
1.137 matthew 15948: =cut
15949:
15950: ############################################################
15951: ############################################################
15952: sub DrawXYGraph {
15953: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15954: #
15955: # Create the identifier for the graph
15956: my $identifier = &get_cgi_id();
15957: my $id = 'cgi.'.$identifier;
15958: #
15959: $Title = '' if (! defined($Title));
15960: $xlabel = '' if (! defined($xlabel));
15961: $ylabel = '' if (! defined($ylabel));
15962: my %ValuesHash =
15963: (
1.369 www 15964: $id.'.title' => &escape($Title),
15965: $id.'.xlabel' => &escape($xlabel),
15966: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15967: $id.'.y_max_value'=> $Max,
15968: $id.'.labels' => join(',',@$Xlabels),
15969: $id.'.PlotType' => 'XY',
15970: );
15971: #
15972: if (defined($colors) && ref($colors) eq 'ARRAY') {
15973: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15974: }
15975: #
15976: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15977: return '';
15978: }
15979: my $NumSets=1;
1.138 matthew 15980: foreach my $array (@{$Ydata}){
1.137 matthew 15981: next if (! ref($array));
15982: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15983: }
1.138 matthew 15984: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15985: #
15986: # Deal with other parameters
15987: while (my ($key,$value) = each(%Values)) {
15988: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15989: }
15990: #
1.646 raeburn 15991: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15992: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15993: }
15994:
15995: ############################################################
15996: ############################################################
15997:
15998: =pod
15999:
1.648 raeburn 16000: =item * &DrawXYYGraph()
1.138 matthew 16001:
16002: Facilitates the plotting of data in an XY graph with two Y axes.
16003: Puts plot definition data into the users environment in order for
16004: graph.png to plot it. Returns an <img> tag for the plot.
16005:
16006: Inputs:
16007:
16008: =over 4
16009:
16010: =item $Title: string, the title of the plot
16011:
16012: =item $xlabel: string, text describing the X-axis of the plot
16013:
16014: =item $ylabel: string, text describing the Y-axis of the plot
16015:
16016: =item $colors: Array ref containing the hex color codes for the data to be
16017: plotted in. If undefined, default values will be used.
16018:
16019: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
16020:
16021: =item $Ydata1: The first data set
16022:
16023: =item $Min1: The minimum value of the left Y-axis
16024:
16025: =item $Max1: The maximum value of the left Y-axis
16026:
16027: =item $Ydata2: The second data set
16028:
16029: =item $Min2: The minimum value of the right Y-axis
16030:
16031: =item $Max2: The maximum value of the left Y-axis
16032:
16033: =item %Values: hash indicating or overriding any default values which are
16034: passed to graph.png.
16035: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
16036:
16037: =back
16038:
16039: Returns:
16040:
16041: An <img> tag which references graph.png and the appropriate identifying
16042: information for the plot.
1.136 matthew 16043:
16044: =cut
16045:
16046: ############################################################
16047: ############################################################
1.137 matthew 16048: sub DrawXYYGraph {
16049: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
16050: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 16051: #
16052: # Create the identifier for the graph
16053: my $identifier = &get_cgi_id();
16054: my $id = 'cgi.'.$identifier;
16055: #
16056: $Title = '' if (! defined($Title));
16057: $xlabel = '' if (! defined($xlabel));
16058: $ylabel = '' if (! defined($ylabel));
16059: my %ValuesHash =
16060: (
1.369 www 16061: $id.'.title' => &escape($Title),
16062: $id.'.xlabel' => &escape($xlabel),
16063: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 16064: $id.'.labels' => join(',',@$Xlabels),
16065: $id.'.PlotType' => 'XY',
16066: $id.'.NumSets' => 2,
1.137 matthew 16067: $id.'.two_axes' => 1,
16068: $id.'.y1_max_value' => $Max1,
16069: $id.'.y1_min_value' => $Min1,
16070: $id.'.y2_max_value' => $Max2,
16071: $id.'.y2_min_value' => $Min2,
1.136 matthew 16072: );
16073: #
1.137 matthew 16074: if (defined($colors) && ref($colors) eq 'ARRAY') {
16075: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
16076: }
16077: #
16078: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
16079: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 16080: return '';
16081: }
16082: my $NumSets=1;
1.137 matthew 16083: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 16084: next if (! ref($array));
16085: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 16086: }
16087: #
16088: # Deal with other parameters
16089: while (my ($key,$value) = each(%Values)) {
16090: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 16091: }
16092: #
1.646 raeburn 16093: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 16094: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 16095: }
16096:
16097: ############################################################
16098: ############################################################
16099:
16100: =pod
16101:
1.157 matthew 16102: =back
16103:
1.139 matthew 16104: =head1 Statistics helper routines?
16105:
16106: Bad place for them but what the hell.
16107:
1.157 matthew 16108: =over 4
16109:
1.648 raeburn 16110: =item * &chartlink()
1.139 matthew 16111:
16112: Returns a link to the chart for a specific student.
16113:
16114: Inputs:
16115:
16116: =over 4
16117:
16118: =item $linktext: The text of the link
16119:
16120: =item $sname: The students username
16121:
16122: =item $sdomain: The students domain
16123:
16124: =back
16125:
1.157 matthew 16126: =back
16127:
1.139 matthew 16128: =cut
16129:
16130: ############################################################
16131: ############################################################
16132: sub chartlink {
16133: my ($linktext, $sname, $sdomain) = @_;
16134: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 16135: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 16136: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 16137: '">'.$linktext.'</a>';
1.153 matthew 16138: }
16139:
16140: #######################################################
16141: #######################################################
16142:
16143: =pod
16144:
16145: =head1 Course Environment Routines
1.157 matthew 16146:
16147: =over 4
1.153 matthew 16148:
1.648 raeburn 16149: =item * &restore_course_settings()
1.153 matthew 16150:
1.648 raeburn 16151: =item * &store_course_settings()
1.153 matthew 16152:
16153: Restores/Store indicated form parameters from the course environment.
16154: Will not overwrite existing values of the form parameters.
16155:
16156: Inputs:
16157: a scalar describing the data (e.g. 'chart', 'problem_analysis')
16158:
16159: a hash ref describing the data to be stored. For example:
16160:
16161: %Save_Parameters = ('Status' => 'scalar',
16162: 'chartoutputmode' => 'scalar',
16163: 'chartoutputdata' => 'scalar',
16164: 'Section' => 'array',
1.373 raeburn 16165: 'Group' => 'array',
1.153 matthew 16166: 'StudentData' => 'array',
16167: 'Maps' => 'array');
16168:
16169: Returns: both routines return nothing
16170:
1.631 raeburn 16171: =back
16172:
1.153 matthew 16173: =cut
16174:
16175: #######################################################
16176: #######################################################
16177: sub store_course_settings {
1.496 albertel 16178: return &store_settings($env{'request.course.id'},@_);
16179: }
16180:
16181: sub store_settings {
1.153 matthew 16182: # save to the environment
16183: # appenv the same items, just to be safe
1.300 albertel 16184: my $udom = $env{'user.domain'};
16185: my $uname = $env{'user.name'};
1.496 albertel 16186: my ($context,$prefix,$Settings) = @_;
1.153 matthew 16187: my %SaveHash;
16188: my %AppHash;
16189: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 16190: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 16191: my $envname = 'environment.'.$basename;
1.258 albertel 16192: if (exists($env{'form.'.$setting})) {
1.153 matthew 16193: # Save this value away
16194: if ($type eq 'scalar' &&
1.258 albertel 16195: (! exists($env{$envname}) ||
16196: $env{$envname} ne $env{'form.'.$setting})) {
16197: $SaveHash{$basename} = $env{'form.'.$setting};
16198: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 16199: } elsif ($type eq 'array') {
16200: my $stored_form;
1.258 albertel 16201: if (ref($env{'form.'.$setting})) {
1.153 matthew 16202: $stored_form = join(',',
16203: map {
1.369 www 16204: &escape($_);
1.258 albertel 16205: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 16206: } else {
16207: $stored_form =
1.369 www 16208: &escape($env{'form.'.$setting});
1.153 matthew 16209: }
16210: # Determine if the array contents are the same.
1.258 albertel 16211: if ($stored_form ne $env{$envname}) {
1.153 matthew 16212: $SaveHash{$basename} = $stored_form;
16213: $AppHash{$envname} = $stored_form;
16214: }
16215: }
16216: }
16217: }
16218: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 16219: $udom,$uname);
1.153 matthew 16220: if ($put_result !~ /^(ok|delayed)/) {
16221: &Apache::lonnet::logthis('unable to save form parameters, '.
16222: 'got error:'.$put_result);
16223: }
16224: # Make sure these settings stick around in this session, too
1.646 raeburn 16225: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 16226: return;
16227: }
16228:
16229: sub restore_course_settings {
1.499 albertel 16230: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 16231: }
16232:
16233: sub restore_settings {
16234: my ($context,$prefix,$Settings) = @_;
1.153 matthew 16235: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 16236: next if (exists($env{'form.'.$setting}));
1.496 albertel 16237: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 16238: '.'.$setting;
1.258 albertel 16239: if (exists($env{$envname})) {
1.153 matthew 16240: if ($type eq 'scalar') {
1.258 albertel 16241: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 16242: } elsif ($type eq 'array') {
1.258 albertel 16243: $env{'form.'.$setting} = [
1.153 matthew 16244: map {
1.369 www 16245: &unescape($_);
1.258 albertel 16246: } split(',',$env{$envname})
1.153 matthew 16247: ];
16248: }
16249: }
16250: }
1.127 matthew 16251: }
16252:
1.618 raeburn 16253: #######################################################
16254: #######################################################
16255:
16256: =pod
16257:
16258: =head1 Domain E-mail Routines
16259:
16260: =over 4
16261:
1.648 raeburn 16262: =item * &build_recipient_list()
1.618 raeburn 16263:
1.1144 raeburn 16264: Build recipient lists for following types of e-mail:
1.766 raeburn 16265: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 16266: (d) Help requests, (e) Course requests needing approval, (f) loncapa
16267: module change checking, student/employee ID conflict checks, as
16268: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
16269: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 16270:
16271: Inputs:
1.619 raeburn 16272: defmail (scalar - email address of default recipient),
1.1144 raeburn 16273: mailing type (scalar: errormail, packagesmail, helpdeskmail,
16274: requestsmail, updatesmail, or idconflictsmail).
16275:
1.619 raeburn 16276: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 16277:
1.619 raeburn 16278: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 16279: i.e., predates configuration by DC via domainprefs.pm
16280:
16281: $requname username of requester (if mailing type is helpdeskmail)
16282:
16283: $requdom domain of requester (if mailing type is helpdeskmail)
16284:
16285: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
16286:
1.618 raeburn 16287:
1.655 raeburn 16288: Returns: comma separated list of addresses to which to send e-mail.
16289:
16290: =back
1.618 raeburn 16291:
16292: =cut
16293:
16294: ############################################################
16295: ############################################################
16296: sub build_recipient_list {
1.1297 raeburn 16297: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 16298: my @recipients;
1.1270 raeburn 16299: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 16300: my %domconfig =
1.1270 raeburn 16301: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 16302: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 16303: if (exists($domconfig{'contacts'}{$mailing})) {
16304: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
16305: my @contacts = ('adminemail','supportemail');
16306: foreach my $item (@contacts) {
16307: if ($domconfig{'contacts'}{$mailing}{$item}) {
16308: my $addr = $domconfig{'contacts'}{$item};
16309: if (!grep(/^\Q$addr\E$/,@recipients)) {
16310: push(@recipients,$addr);
16311: }
1.619 raeburn 16312: }
1.1270 raeburn 16313: }
16314: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
16315: if ($mailing eq 'helpdeskmail') {
16316: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
16317: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
16318: my @ok_bccs;
16319: foreach my $bcc (@bccs) {
16320: $bcc =~ s/^\s+//g;
16321: $bcc =~ s/\s+$//g;
16322: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16323: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16324: push(@ok_bccs,$bcc);
16325: }
16326: }
16327: }
16328: if (@ok_bccs > 0) {
16329: $allbcc = join(', ',@ok_bccs);
16330: }
16331: }
16332: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 16333: }
16334: }
1.766 raeburn 16335: } elsif ($origmail ne '') {
1.1270 raeburn 16336: $lastresort = $origmail;
1.618 raeburn 16337: }
1.1297 raeburn 16338: if ($mailing eq 'helpdeskmail') {
16339: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
16340: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
16341: my ($inststatus,$inststatus_checked);
16342: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
16343: ($env{'user.domain'} ne 'public')) {
16344: $inststatus_checked = 1;
16345: $inststatus = $env{'environment.inststatus'};
16346: }
16347: unless ($inststatus_checked) {
16348: if (($requname ne '') && ($requdom ne '')) {
16349: if (($requname =~ /^$match_username$/) &&
16350: ($requdom =~ /^$match_domain$/) &&
16351: (&Apache::lonnet::domain($requdom))) {
16352: my $requhome = &Apache::lonnet::homeserver($requname,
16353: $requdom);
16354: unless ($requhome eq 'no_host') {
16355: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
16356: $inststatus = $userenv{'inststatus'};
16357: $inststatus_checked = 1;
16358: }
16359: }
16360: }
16361: }
16362: unless ($inststatus_checked) {
16363: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
16364: my %srch = (srchby => 'email',
16365: srchdomain => $defdom,
16366: srchterm => $reqemail,
16367: srchtype => 'exact');
16368: my %srch_results = &Apache::lonnet::usersearch(\%srch);
16369: foreach my $uname (keys(%srch_results)) {
16370: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16371: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16372: $inststatus_checked = 1;
16373: last;
16374: }
16375: }
16376: unless ($inststatus_checked) {
16377: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
16378: if ($dirsrchres eq 'ok') {
16379: foreach my $uname (keys(%srch_results)) {
16380: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
16381: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
16382: $inststatus_checked = 1;
16383: last;
16384: }
16385: }
16386: }
16387: }
16388: }
16389: }
16390: if ($inststatus ne '') {
16391: foreach my $status (split(/\:/,$inststatus)) {
16392: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
16393: my @contacts = ('adminemail','supportemail');
16394: foreach my $item (@contacts) {
16395: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
16396: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
16397: if (!grep(/^\Q$addr\E$/,@recipients)) {
16398: push(@recipients,$addr);
16399: }
16400: }
16401: }
16402: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
16403: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
16404: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
16405: my @ok_bccs;
16406: foreach my $bcc (@bccs) {
16407: $bcc =~ s/^\s+//g;
16408: $bcc =~ s/\s+$//g;
16409: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16410: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16411: push(@ok_bccs,$bcc);
16412: }
16413: }
16414: }
16415: if (@ok_bccs > 0) {
16416: $allbcc = join(', ',@ok_bccs);
16417: }
16418: }
16419: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
16420: last;
16421: }
16422: }
16423: }
16424: }
16425: }
1.619 raeburn 16426: } elsif ($origmail ne '') {
1.1270 raeburn 16427: $lastresort = $origmail;
16428: }
1.1297 raeburn 16429: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 16430: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
16431: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
16432: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
16433: my %what = (
16434: perlvar => 1,
16435: );
16436: my $primary = &Apache::lonnet::domain($defdom,'primary');
16437: if ($primary) {
16438: my $gotaddr;
16439: my ($result,$returnhash) =
16440: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
16441: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
16442: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
16443: $lastresort = $returnhash->{'lonSupportEMail'};
16444: $gotaddr = 1;
16445: }
16446: }
16447: unless ($gotaddr) {
16448: my $uintdom = &Apache::lonnet::internet_dom($primary);
16449: my $intdom = &Apache::lonnet::internet_dom($lonhost);
16450: unless ($uintdom eq $intdom) {
16451: my %domconfig =
16452: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
16453: if (ref($domconfig{'contacts'}) eq 'HASH') {
16454: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
16455: my @contacts = ('adminemail','supportemail');
16456: foreach my $item (@contacts) {
16457: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
16458: my $addr = $domconfig{'contacts'}{$item};
16459: if (!grep(/^\Q$addr\E$/,@recipients)) {
16460: push(@recipients,$addr);
16461: }
16462: }
16463: }
16464: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
16465: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
16466: }
16467: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
16468: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
16469: my @ok_bccs;
16470: foreach my $bcc (@bccs) {
16471: $bcc =~ s/^\s+//g;
16472: $bcc =~ s/\s+$//g;
16473: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
16474: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
16475: push(@ok_bccs,$bcc);
16476: }
16477: }
16478: }
16479: if (@ok_bccs > 0) {
16480: $allbcc = join(', ',@ok_bccs);
16481: }
16482: }
16483: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
16484: }
16485: }
16486: }
16487: }
16488: }
16489: }
1.618 raeburn 16490: }
1.688 raeburn 16491: if (defined($defmail)) {
16492: if ($defmail ne '') {
16493: push(@recipients,$defmail);
16494: }
1.618 raeburn 16495: }
16496: if ($otheremails) {
1.619 raeburn 16497: my @others;
16498: if ($otheremails =~ /,/) {
16499: @others = split(/,/,$otheremails);
1.618 raeburn 16500: } else {
1.619 raeburn 16501: push(@others,$otheremails);
16502: }
16503: foreach my $addr (@others) {
16504: if (!grep(/^\Q$addr\E$/,@recipients)) {
16505: push(@recipients,$addr);
16506: }
1.618 raeburn 16507: }
16508: }
1.1298 raeburn 16509: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 16510: if ((!@recipients) && ($lastresort ne '')) {
16511: push(@recipients,$lastresort);
16512: }
16513: } elsif ($lastresort ne '') {
16514: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
16515: push(@recipients,$lastresort);
16516: }
16517: }
1.1271 raeburn 16518: my $recipientlist = join(',',@recipients);
1.1270 raeburn 16519: if (wantarray) {
16520: return ($recipientlist,$allbcc,$addtext);
16521: } else {
16522: return $recipientlist;
16523: }
1.618 raeburn 16524: }
16525:
1.127 matthew 16526: ############################################################
16527: ############################################################
1.154 albertel 16528:
1.655 raeburn 16529: =pod
16530:
1.1224 musolffc 16531: =over 4
16532:
1.1223 musolffc 16533: =item * &mime_email()
16534:
16535: Sends an email with a possible attachment
16536:
16537: Inputs:
16538:
16539: =over 4
16540:
16541: from - Sender's email address
16542:
1.1343 raeburn 16543: replyto - Reply-To email address
16544:
1.1223 musolffc 16545: to - Email address of recipient
16546:
16547: subject - Subject of email
16548:
16549: body - Body of email
16550:
16551: cc_string - Carbon copy email address
16552:
16553: bcc - Blind carbon copy email address
16554:
16555: attachment_path - Path of file to be attached
16556:
16557: file_name - Name of file to be attached
16558:
16559: attachment_text - The body of an attachment of type "TEXT"
16560:
16561: =back
16562:
16563: =back
16564:
16565: =cut
16566:
16567: ############################################################
16568: ############################################################
16569:
16570: sub mime_email {
1.1343 raeburn 16571: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
16572: $file_name,$attachment_text) = @_;
16573:
1.1223 musolffc 16574: my $msg = MIME::Lite->new(
16575: From => $from,
16576: To => $to,
16577: Subject => $subject,
16578: Type =>'TEXT',
16579: Data => $body,
16580: );
1.1343 raeburn 16581: if ($replyto ne '') {
16582: $msg->add("Reply-To" => $replyto);
16583: }
1.1223 musolffc 16584: if ($cc_string ne '') {
16585: $msg->add("Cc" => $cc_string);
16586: }
16587: if ($bcc ne '') {
16588: $msg->add("Bcc" => $bcc);
16589: }
16590: $msg->attr("content-type" => "text/plain");
16591: $msg->attr("content-type.charset" => "UTF-8");
16592: # Attach file if given
16593: if ($attachment_path) {
16594: unless ($file_name) {
16595: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
16596: }
16597: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
16598: $msg->attach(Type => $type,
16599: Path => $attachment_path,
16600: Filename => $file_name
16601: );
16602: # Otherwise attach text if given
16603: } elsif ($attachment_text) {
16604: $msg->attach(Type => 'TEXT',
16605: Data => $attachment_text);
16606: }
16607: # Send it
16608: $msg->send('sendmail');
16609: }
16610:
16611: ############################################################
16612: ############################################################
16613:
16614: =pod
16615:
1.655 raeburn 16616: =head1 Course Catalog Routines
16617:
16618: =over 4
16619:
16620: =item * &gather_categories()
16621:
16622: Converts category definitions - keys of categories hash stored in
16623: coursecategories in configuration.db on the primary library server in a
16624: domain - to an array. Also generates javascript and idx hash used to
16625: generate Domain Coordinator interface for editing Course Categories.
16626:
16627: Inputs:
1.663 raeburn 16628:
1.655 raeburn 16629: categories (reference to hash of category definitions).
1.663 raeburn 16630:
1.655 raeburn 16631: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16632: categories and subcategories).
1.663 raeburn 16633:
1.655 raeburn 16634: idx (reference to hash of counters used in Domain Coordinator interface for
16635: editing Course Categories).
1.663 raeburn 16636:
1.655 raeburn 16637: jsarray (reference to array of categories used to create Javascript arrays for
16638: Domain Coordinator interface for editing Course Categories).
16639:
16640: Returns: nothing
16641:
16642: Side effects: populates cats, idx and jsarray.
16643:
16644: =cut
16645:
16646: sub gather_categories {
16647: my ($categories,$cats,$idx,$jsarray) = @_;
16648: my %counters;
16649: my $num = 0;
16650: foreach my $item (keys(%{$categories})) {
16651: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
16652: if ($container eq '' && $depth == 0) {
16653: $cats->[$depth][$categories->{$item}] = $cat;
16654: } else {
16655: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
16656: }
16657: my ($escitem,$tail) = split(/:/,$item,2);
16658: if ($counters{$tail} eq '') {
16659: $counters{$tail} = $num;
16660: $num ++;
16661: }
16662: if (ref($idx) eq 'HASH') {
16663: $idx->{$item} = $counters{$tail};
16664: }
16665: if (ref($jsarray) eq 'ARRAY') {
16666: push(@{$jsarray->[$counters{$tail}]},$item);
16667: }
16668: }
16669: return;
16670: }
16671:
16672: =pod
16673:
16674: =item * &extract_categories()
16675:
16676: Used to generate breadcrumb trails for course categories.
16677:
16678: Inputs:
1.663 raeburn 16679:
1.655 raeburn 16680: categories (reference to hash of category definitions).
1.663 raeburn 16681:
1.655 raeburn 16682: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16683: categories and subcategories).
1.663 raeburn 16684:
1.655 raeburn 16685: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 16686:
1.655 raeburn 16687: allitems (reference to hash - key is category key
16688: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16689:
1.655 raeburn 16690: idx (reference to hash of counters used in Domain Coordinator interface for
16691: editing Course Categories).
1.663 raeburn 16692:
1.655 raeburn 16693: jsarray (reference to array of categories used to create Javascript arrays for
16694: Domain Coordinator interface for editing Course Categories).
16695:
1.665 raeburn 16696: subcats (reference to hash of arrays containing all subcategories within each
16697: category, -recursive)
16698:
1.1321 raeburn 16699: maxd (reference to hash used to hold max depth for all top-level categories).
16700:
1.655 raeburn 16701: Returns: nothing
16702:
16703: Side effects: populates trails and allitems hash references.
16704:
16705: =cut
16706:
16707: sub extract_categories {
1.1321 raeburn 16708: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 16709: if (ref($categories) eq 'HASH') {
16710: &gather_categories($categories,$cats,$idx,$jsarray);
16711: if (ref($cats->[0]) eq 'ARRAY') {
16712: for (my $i=0; $i<@{$cats->[0]}; $i++) {
16713: my $name = $cats->[0][$i];
16714: my $item = &escape($name).'::0';
16715: my $trailstr;
16716: if ($name eq 'instcode') {
16717: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 16718: } elsif ($name eq 'communities') {
16719: $trailstr = &mt('Communities');
1.1239 raeburn 16720: } elsif ($name eq 'placement') {
16721: $trailstr = &mt('Placement Tests');
1.655 raeburn 16722: } else {
16723: $trailstr = $name;
16724: }
16725: if ($allitems->{$item} eq '') {
16726: push(@{$trails},$trailstr);
16727: $allitems->{$item} = scalar(@{$trails})-1;
16728: }
16729: my @parents = ($name);
16730: if (ref($cats->[1]{$name}) eq 'ARRAY') {
16731: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
16732: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 16733: if (ref($subcats) eq 'HASH') {
16734: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
16735: }
1.1321 raeburn 16736: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 16737: }
16738: } else {
16739: if (ref($subcats) eq 'HASH') {
16740: $subcats->{$item} = [];
1.655 raeburn 16741: }
1.1321 raeburn 16742: if (ref($maxd) eq 'HASH') {
16743: $maxd->{$name} = 1;
16744: }
1.655 raeburn 16745: }
16746: }
16747: }
16748: }
16749: return;
16750: }
16751:
16752: =pod
16753:
1.1162 raeburn 16754: =item * &recurse_categories()
1.655 raeburn 16755:
16756: Recursively used to generate breadcrumb trails for course categories.
16757:
16758: Inputs:
1.663 raeburn 16759:
1.655 raeburn 16760: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16761: categories and subcategories).
1.663 raeburn 16762:
1.655 raeburn 16763: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16764:
16765: category (current course category, for which breadcrumb trail is being generated).
16766:
16767: trails (reference to array of breadcrumb trails for each category).
16768:
1.655 raeburn 16769: allitems (reference to hash - key is category key
16770: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16771:
1.655 raeburn 16772: parents (array containing containers directories for current category,
16773: back to top level).
16774:
16775: Returns: nothing
16776:
16777: Side effects: populates trails and allitems hash references
16778:
16779: =cut
16780:
16781: sub recurse_categories {
1.1321 raeburn 16782: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16783: my $shallower = $depth - 1;
16784: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16785: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16786: my $name = $cats->[$depth]{$category}[$k];
16787: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16788: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16789: if ($allitems->{$item} eq '') {
16790: push(@{$trails},$trailstr);
16791: $allitems->{$item} = scalar(@{$trails})-1;
16792: }
16793: my $deeper = $depth+1;
16794: push(@{$parents},$category);
1.665 raeburn 16795: if (ref($subcats) eq 'HASH') {
16796: my $subcat = &escape($name).':'.$category.':'.$depth;
16797: for (my $j=@{$parents}; $j>=0; $j--) {
16798: my $higher;
16799: if ($j > 0) {
16800: $higher = &escape($parents->[$j]).':'.
16801: &escape($parents->[$j-1]).':'.$j;
16802: } else {
16803: $higher = &escape($parents->[$j]).'::'.$j;
16804: }
16805: push(@{$subcats->{$higher}},$subcat);
16806: }
16807: }
16808: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16809: $subcats,$maxd);
1.655 raeburn 16810: pop(@{$parents});
16811: }
16812: } else {
16813: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16814: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16815: if ($allitems->{$item} eq '') {
16816: push(@{$trails},$trailstr);
16817: $allitems->{$item} = scalar(@{$trails})-1;
16818: }
1.1321 raeburn 16819: if (ref($maxd) eq 'HASH') {
16820: if ($depth > $maxd->{$parents->[0]}) {
16821: $maxd->{$parents->[0]} = $depth;
16822: }
16823: }
1.655 raeburn 16824: }
16825: return;
16826: }
16827:
1.663 raeburn 16828: =pod
16829:
1.1162 raeburn 16830: =item * &assign_categories_table()
1.663 raeburn 16831:
16832: Create a datatable for display of hierarchical categories in a domain,
16833: with checkboxes to allow a course to be categorized.
16834:
16835: Inputs:
16836:
16837: cathash - reference to hash of categories defined for the domain (from
16838: configuration.db)
16839:
16840: currcat - scalar with an & separated list of categories assigned to a course.
16841:
1.919 raeburn 16842: type - scalar contains course type (Course or Community).
16843:
1.1260 raeburn 16844: disabled - scalar (optional) contains disabled="disabled" if input elements are
16845: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16846:
1.663 raeburn 16847: Returns: $output (markup to be displayed)
16848:
16849: =cut
16850:
16851: sub assign_categories_table {
1.1259 raeburn 16852: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16853: my $output;
16854: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16855: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16856: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16857: $maxdepth = scalar(@cats);
16858: if (@cats > 0) {
16859: my $itemcount = 0;
16860: if (ref($cats[0]) eq 'ARRAY') {
16861: my @currcategories;
16862: if ($currcat ne '') {
16863: @currcategories = split('&',$currcat);
16864: }
1.919 raeburn 16865: my $table;
1.663 raeburn 16866: for (my $i=0; $i<@{$cats[0]}; $i++) {
16867: my $parent = $cats[0][$i];
1.919 raeburn 16868: next if ($parent eq 'instcode');
16869: if ($type eq 'Community') {
16870: next unless ($parent eq 'communities');
1.1239 raeburn 16871: } elsif ($type eq 'Placement') {
16872: next unless ($parent eq 'placement');
1.919 raeburn 16873: } else {
1.1239 raeburn 16874: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16875: }
1.663 raeburn 16876: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16877: my $item = &escape($parent).'::0';
16878: my $checked = '';
16879: if (@currcategories > 0) {
16880: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16881: $checked = ' checked="checked"';
1.663 raeburn 16882: }
16883: }
1.919 raeburn 16884: my $parent_title = $parent;
16885: if ($parent eq 'communities') {
16886: $parent_title = &mt('Communities');
1.1239 raeburn 16887: } elsif ($parent eq 'placement') {
16888: $parent_title = &mt('Placement Tests');
1.919 raeburn 16889: }
16890: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16891: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16892: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16893: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16894: my $depth = 1;
16895: push(@path,$parent);
1.1259 raeburn 16896: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16897: pop(@path);
1.919 raeburn 16898: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16899: $itemcount ++;
16900: }
1.919 raeburn 16901: if ($itemcount) {
16902: $output = &Apache::loncommon::start_data_table().
16903: $table.
16904: &Apache::loncommon::end_data_table();
16905: }
1.663 raeburn 16906: }
16907: }
16908: }
16909: return $output;
16910: }
16911:
16912: =pod
16913:
1.1162 raeburn 16914: =item * &assign_category_rows()
1.663 raeburn 16915:
16916: Create a datatable row for display of nested categories in a domain,
16917: with checkboxes to allow a course to be categorized,called recursively.
16918:
16919: Inputs:
16920:
16921: itemcount - track row number for alternating colors
16922:
16923: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16924: categories and subcategories.
16925:
16926: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16927:
16928: parent - parent of current category item
16929:
16930: path - Array containing all categories back up through the hierarchy from the
16931: current category to the top level.
16932:
16933: currcategories - reference to array of current categories assigned to the course
16934:
1.1260 raeburn 16935: disabled - scalar (optional) contains disabled="disabled" if input elements are
16936: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16937:
1.663 raeburn 16938: Returns: $output (markup to be displayed).
16939:
16940: =cut
16941:
16942: sub assign_category_rows {
1.1259 raeburn 16943: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16944: my ($text,$name,$item,$chgstr);
16945: if (ref($cats) eq 'ARRAY') {
16946: my $maxdepth = scalar(@{$cats});
16947: if (ref($cats->[$depth]) eq 'HASH') {
16948: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16949: my $numchildren = @{$cats->[$depth]{$parent}};
16950: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16951: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16952: for (my $j=0; $j<$numchildren; $j++) {
16953: $name = $cats->[$depth]{$parent}[$j];
16954: $item = &escape($name).':'.&escape($parent).':'.$depth;
16955: my $deeper = $depth+1;
16956: my $checked = '';
16957: if (ref($currcategories) eq 'ARRAY') {
16958: if (@{$currcategories} > 0) {
16959: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16960: $checked = ' checked="checked"';
1.663 raeburn 16961: }
16962: }
16963: }
1.664 raeburn 16964: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16965: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16966: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16967: '<input type="hidden" name="catname" value="'.$name.'" />'.
16968: '</td><td>';
1.663 raeburn 16969: if (ref($path) eq 'ARRAY') {
16970: push(@{$path},$name);
1.1259 raeburn 16971: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16972: pop(@{$path});
16973: }
16974: $text .= '</td></tr>';
16975: }
16976: $text .= '</table></td>';
16977: }
16978: }
16979: }
16980: return $text;
16981: }
16982:
1.1181 raeburn 16983: =pod
16984:
16985: =back
16986:
16987: =cut
16988:
1.655 raeburn 16989: ############################################################
16990: ############################################################
16991:
16992:
1.443 albertel 16993: sub commit_customrole {
1.1408 raeburn 16994: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
1.1399 raeburn 16995: my $result = &Apache::lonnet::assigncustomrole(
1.1408 raeburn 16996: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
16997: $context,$othdomby,$requester);
1.630 raeburn 16998: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16999: ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399 raeburn 17000: ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
17001: if (wantarray) {
17002: return ($output,$result);
17003: } else {
17004: return $output;
17005: }
1.443 albertel 17006: }
17007:
17008: sub commit_standardrole {
1.1408 raeburn 17009: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits,
17010: $othdomby,$requester) = @_;
1.1399 raeburn 17011: my ($output,$logmsg,$linefeed,$result);
1.541 raeburn 17012: if ($context eq 'auto') {
17013: $linefeed = "\n";
17014: } else {
17015: $linefeed = "<br />\n";
17016: }
1.443 albertel 17017: if ($three eq 'st') {
1.1399 raeburn 17018: $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1408 raeburn 17019: $one,$two,$sec,$context,$credits,$othdomby,
17020: $requester);
1.541 raeburn 17021: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 17022: ($result eq 'unknown_course') || ($result eq 'refused')) {
17023: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 17024: } else {
1.541 raeburn 17025: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 17026: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 17027: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
17028: if ($context eq 'auto') {
17029: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
17030: } else {
17031: $output .= '<b>'.$result.'</b>'.$linefeed.
17032: &mt('Add to classlist').': <b>ok</b>';
17033: }
17034: $output .= $linefeed;
1.443 albertel 17035: }
17036: } else {
17037: $output = &mt('Assigning').' '.$three.' in '.$url.
17038: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 17039: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1408 raeburn 17040: $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,
17041: '','',$context,$othdomby,$requester);
1.541 raeburn 17042: if ($context eq 'auto') {
17043: $output .= $result.$linefeed;
17044: } else {
17045: $output .= '<b>'.$result.'</b>'.$linefeed;
17046: }
1.443 albertel 17047: }
1.1399 raeburn 17048: if (wantarray) {
17049: return ($output,$result);
17050: } else {
17051: return $output;
17052: }
1.443 albertel 17053: }
17054:
17055: sub commit_studentrole {
1.1116 raeburn 17056: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
1.1408 raeburn 17057: $credits,$othdomby,$requester) = @_;
1.626 raeburn 17058: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 17059: if ($context eq 'auto') {
17060: $linefeed = "\n";
17061: } else {
17062: $linefeed = '<br />'."\n";
17063: }
1.443 albertel 17064: if (defined($one) && defined($two)) {
17065: my $cid=$one.'_'.$two;
17066: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
17067: my $secchange = 0;
17068: my $expire_role_result;
17069: my $modify_section_result;
1.628 raeburn 17070: if ($oldsec ne '-1') {
17071: if ($oldsec ne $sec) {
1.443 albertel 17072: $secchange = 1;
1.628 raeburn 17073: my $now = time;
1.443 albertel 17074: my $uurl='/'.$cid;
17075: $uurl=~s/\_/\//g;
17076: if ($oldsec) {
17077: $uurl.='/'.$oldsec;
17078: }
1.626 raeburn 17079: $oldsecurl = $uurl;
1.628 raeburn 17080: $expire_role_result =
1.1408 raeburn 17081: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
17082: '','','',$context,$othdomby,$requester);
17083: if ($env{'request.course.sec'} ne '') {
1.628 raeburn 17084: if ($expire_role_result eq 'refused') {
17085: my @roles = ('st');
17086: my @statuses = ('previous');
17087: my @roledoms = ($one);
17088: my $withsec = 1;
17089: my %roleshash =
17090: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
17091: \@statuses,\@roles,\@roledoms,$withsec);
17092: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
17093: my ($oldstart,$oldend) =
17094: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
17095: if ($oldend > 0 && $oldend <= $now) {
17096: $expire_role_result = 'ok';
17097: }
17098: }
17099: }
17100: }
1.443 albertel 17101: $result = $expire_role_result;
17102: }
17103: }
17104: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 17105: $modify_section_result =
17106: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
17107: undef,undef,undef,$sec,
17108: $end,$start,'','',$cid,
1.1408 raeburn 17109: '',$context,$credits,'',
17110: $othdomby,$requester);
1.443 albertel 17111: if ($modify_section_result =~ /^ok/) {
17112: if ($secchange == 1) {
1.628 raeburn 17113: if ($sec eq '') {
17114: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
17115: } else {
17116: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
17117: }
1.443 albertel 17118: } elsif ($oldsec eq '-1') {
1.628 raeburn 17119: if ($sec eq '') {
17120: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
17121: } else {
17122: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
17123: }
1.443 albertel 17124: } else {
1.628 raeburn 17125: if ($sec eq '') {
17126: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
17127: } else {
17128: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
17129: }
1.443 albertel 17130: }
17131: } else {
1.1115 raeburn 17132: if ($secchange) {
1.628 raeburn 17133: $$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;
17134: } else {
17135: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
17136: }
1.443 albertel 17137: }
17138: $result = $modify_section_result;
17139: } elsif ($secchange == 1) {
1.628 raeburn 17140: if ($oldsec eq '') {
1.1103 raeburn 17141: $$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 17142: } else {
17143: $$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;
17144: }
1.626 raeburn 17145: if ($expire_role_result eq 'refused') {
17146: my $newsecurl = '/'.$cid;
17147: $newsecurl =~ s/\_/\//g;
17148: if ($sec ne '') {
17149: $newsecurl.='/'.$sec;
17150: }
17151: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
17152: if ($sec eq '') {
17153: $$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;
17154: } else {
17155: $$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;
17156: }
17157: }
17158: }
1.443 albertel 17159: }
17160: } else {
1.626 raeburn 17161: $$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 17162: $result = "error: incomplete course id\n";
17163: }
17164: return $result;
17165: }
17166:
1.1108 raeburn 17167: sub show_role_extent {
17168: my ($scope,$context,$role) = @_;
17169: $scope =~ s{^/}{};
17170: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
17171: push(@courseroles,'co');
17172: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
17173: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
17174: $scope =~ s{/}{_};
17175: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
17176: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
17177: my ($audom,$auname) = split(/\//,$scope);
17178: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
17179: &Apache::loncommon::plainname($auname,$audom).'</span>');
17180: } else {
17181: $scope =~ s{/$}{};
17182: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
17183: &Apache::lonnet::domain($scope,'description').'</span>');
17184: }
17185: }
17186:
1.443 albertel 17187: ############################################################
17188: ############################################################
17189:
1.566 albertel 17190: sub check_clone {
1.578 raeburn 17191: my ($args,$linefeed) = @_;
1.566 albertel 17192: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
17193: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
17194: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 17195: my $clonetitle;
17196: my @clonemsg;
1.566 albertel 17197: my $can_clone = 0;
1.944 raeburn 17198: my $lctype = lc($args->{'crstype'});
1.908 raeburn 17199: if ($lctype ne 'community') {
17200: $lctype = 'course';
17201: }
1.566 albertel 17202: if ($clonehome eq 'no_host') {
1.944 raeburn 17203: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 17204: push(@clonemsg,({
17205: mt => 'No new community created.',
17206: args => [],
17207: },
17208: {
17209: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
17210: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
17211: }));
1.908 raeburn 17212: } else {
1.1344 raeburn 17213: push(@clonemsg,({
17214: mt => 'No new course created.',
17215: args => [],
17216: },
17217: {
17218: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
17219: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
17220: }));
17221: }
1.566 albertel 17222: } else {
17223: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 17224: $clonetitle = $clonedesc{'description'};
1.944 raeburn 17225: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 17226: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 17227: push(@clonemsg,({
17228: mt => 'No new community created.',
17229: args => [],
17230: },
17231: {
17232: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
17233: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
17234: }));
17235: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 17236: }
17237: }
1.1262 raeburn 17238: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 17239: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 17240: $can_clone = 1;
17241: } else {
1.1221 raeburn 17242: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 17243: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 17244: if ($clonehash{'cloners'} eq '') {
17245: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
17246: if ($domdefs{'canclone'}) {
17247: unless ($domdefs{'canclone'} eq 'none') {
17248: if ($domdefs{'canclone'} eq 'domain') {
17249: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
17250: $can_clone = 1;
17251: }
17252: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
17253: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
17254: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
17255: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
17256: $can_clone = 1;
17257: }
17258: }
17259: }
17260: }
1.578 raeburn 17261: } else {
1.1221 raeburn 17262: my @cloners = split(/,/,$clonehash{'cloners'});
17263: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 17264: $can_clone = 1;
1.1221 raeburn 17265: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 17266: $can_clone = 1;
1.1225 raeburn 17267: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
17268: $can_clone = 1;
1.1221 raeburn 17269: }
17270: unless ($can_clone) {
1.1225 raeburn 17271: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
17272: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 17273: my (%gotdomdefaults,%gotcodedefaults);
17274: foreach my $cloner (@cloners) {
17275: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
17276: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
17277: my (%codedefaults,@code_order);
17278: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
17279: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
17280: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
17281: }
17282: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
17283: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
17284: }
17285: } else {
17286: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
17287: \%codedefaults,
17288: \@code_order);
17289: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
17290: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
17291: }
17292: if (@code_order > 0) {
17293: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
17294: $cloner,$clonehash{'internal.coursecode'},
17295: $args->{'crscode'})) {
17296: $can_clone = 1;
17297: last;
17298: }
17299: }
17300: }
17301: }
17302: }
1.1225 raeburn 17303: }
17304: }
17305: unless ($can_clone) {
17306: my $ccrole = 'cc';
17307: if ($args->{'crstype'} eq 'Community') {
17308: $ccrole = 'co';
17309: }
17310: my %roleshash =
17311: &Apache::lonnet::get_my_roles($args->{'ccuname'},
17312: $args->{'ccdomain'},
17313: 'userroles',['active'],[$ccrole],
17314: [$args->{'clonedomain'}]);
17315: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
17316: $can_clone = 1;
17317: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
17318: $args->{'ccuname'},$args->{'ccdomain'})) {
17319: $can_clone = 1;
1.1221 raeburn 17320: }
17321: }
17322: unless ($can_clone) {
17323: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 17324: push(@clonemsg,({
17325: mt => 'No new community created.',
17326: args => [],
17327: },
17328: {
17329: 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]).',
17330: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
17331: }));
1.942 raeburn 17332: } else {
1.1344 raeburn 17333: push(@clonemsg,({
17334: mt => 'No new course created.',
17335: args => [],
17336: },
17337: {
17338: 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]).',
17339: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
17340: }));
1.1221 raeburn 17341: }
1.566 albertel 17342: }
1.578 raeburn 17343: }
1.566 albertel 17344: }
1.1344 raeburn 17345: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17346: }
17347:
1.444 albertel 17348: sub construct_course {
1.1262 raeburn 17349: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 17350: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
17351: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 17352: my $linefeed = '<br />'."\n";
17353: if ($context eq 'auto') {
17354: $linefeed = "\n";
17355: }
1.566 albertel 17356:
17357: #
17358: # Are we cloning?
17359: #
1.1344 raeburn 17360: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 17361: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 17362: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 17363: if (!$can_clone) {
1.1344 raeburn 17364: return (0,$outcome,$clonemsgref);
1.566 albertel 17365: }
17366: }
17367:
1.444 albertel 17368: #
17369: # Open course
17370: #
1.1239 raeburn 17371: my $showncrstype;
17372: if ($args->{'crstype'} eq 'Placement') {
17373: $showncrstype = 'placement test';
17374: } else {
17375: $showncrstype = lc($args->{'crstype'});
17376: }
1.444 albertel 17377: my %cenv=();
17378: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
17379: $args->{'cdescr'},
17380: $args->{'curl'},
17381: $args->{'course_home'},
17382: $args->{'nonstandard'},
17383: $args->{'crscode'},
17384: $args->{'ccuname'}.':'.
17385: $args->{'ccdomain'},
1.882 raeburn 17386: $args->{'crstype'},
1.1344 raeburn 17387: $cnum,$context,$category,
17388: $callercontext);
1.444 albertel 17389:
17390: # Note: The testing routines depend on this being output; see
17391: # Utils::Course. This needs to at least be output as a comment
17392: # if anyone ever decides to not show this, and Utils::Course::new
17393: # will need to be suitably modified.
1.1344 raeburn 17394: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17395: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17396: } else {
17397: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
17398: }
1.943 raeburn 17399: if ($$courseid =~ /^error:/) {
1.1344 raeburn 17400: return (0,$outcome,$clonemsgref);
1.943 raeburn 17401: }
17402:
1.444 albertel 17403: #
17404: # Check if created correctly
17405: #
1.479 albertel 17406: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 17407: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 17408: if ($crsuhome eq 'no_host') {
1.1344 raeburn 17409: if (($callercontext eq 'auto') && ($user_lh ne '')) {
17410: $outcome .= &mt_user($user_lh,
17411: 'Course creation failed, unrecognized course home server.');
17412: } else {
17413: $outcome .= &mt('Course creation failed, unrecognized course home server.');
17414: }
17415: $outcome .= $linefeed;
17416: return (0,$outcome,$clonemsgref);
1.943 raeburn 17417: }
1.541 raeburn 17418: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 17419:
1.444 albertel 17420: #
1.566 albertel 17421: # Do the cloning
17422: #
1.1344 raeburn 17423: my @clonemsg;
1.566 albertel 17424: if ($can_clone && $cloneid) {
1.1344 raeburn 17425: push(@clonemsg,
17426: {
17427: mt => 'Created [_1] by cloning from [_2]',
17428: args => [$showncrstype,$clonetitle],
17429: });
1.566 albertel 17430: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 17431: # Copy all files
1.1344 raeburn 17432: my @info =
17433: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
17434: $args->{'dateshift'},$args->{'crscode'},
17435: $args->{'ccuname'}.':'.$args->{'ccdomain'},
17436: $args->{'tinyurls'});
17437: if (@info) {
17438: push(@clonemsg,@info);
17439: }
1.444 albertel 17440: # Restore URL
1.566 albertel 17441: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 17442: # Restore title
1.566 albertel 17443: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 17444: # Restore creation date, creator and creation context.
17445: $cenv{'internal.created'}=$oldcenv{'internal.created'};
17446: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
17447: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 17448: # Mark as cloned
1.566 albertel 17449: $cenv{'clonedfrom'}=$cloneid;
1.638 www 17450: # Need to clone grading mode
17451: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
17452: $cenv{'grading'}=$newenv{'grading'};
17453: # Do not clone these environment entries
17454: &Apache::lonnet::del('environment',
17455: ['default_enrollment_start_date',
17456: 'default_enrollment_end_date',
17457: 'question.email',
17458: 'policy.email',
17459: 'comment.email',
17460: 'pch.users.denied',
1.725 raeburn 17461: 'plc.users.denied',
17462: 'hidefromcat',
1.1121 raeburn 17463: 'checkforpriv',
1.1355 raeburn 17464: 'categories'],
1.638 www 17465: $$crsudom,$$crsunum);
1.1170 raeburn 17466: if ($args->{'textbook'}) {
17467: $cenv{'internal.textbook'} = $args->{'textbook'};
17468: }
1.444 albertel 17469: }
1.566 albertel 17470:
1.444 albertel 17471: #
17472: # Set environment (will override cloned, if existing)
17473: #
17474: my @sections = ();
17475: my @xlists = ();
17476: if ($args->{'crstype'}) {
17477: $cenv{'type'}=$args->{'crstype'};
17478: }
1.1371 raeburn 17479: if ($args->{'lti'}) {
17480: $cenv{'internal.lti'}=$args->{'lti'};
17481: }
1.444 albertel 17482: if ($args->{'crsid'}) {
17483: $cenv{'courseid'}=$args->{'crsid'};
17484: }
17485: if ($args->{'crscode'}) {
17486: $cenv{'internal.coursecode'}=$args->{'crscode'};
17487: }
17488: if ($args->{'crsquota'} ne '') {
17489: $cenv{'internal.coursequota'}=$args->{'crsquota'};
17490: } else {
17491: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
17492: }
17493: if ($args->{'ccuname'}) {
17494: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
17495: ':'.$args->{'ccdomain'};
17496: } else {
17497: $cenv{'internal.courseowner'} = $args->{'curruser'};
17498: }
1.1116 raeburn 17499: if ($args->{'defaultcredits'}) {
17500: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
17501: }
1.444 albertel 17502: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1412 raeburn 17503: my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444 albertel 17504: if ($args->{'crssections'}) {
17505: $cenv{'internal.sectionnums'} = '';
17506: if ($args->{'crssections'} =~ m/,/) {
17507: @sections = split/,/,$args->{'crssections'};
17508: } else {
17509: $sections[0] = $args->{'crssections'};
17510: }
17511: if (@sections > 0) {
17512: foreach my $item (@sections) {
17513: my ($sec,$gp) = split/:/,$item;
17514: my $class = $args->{'crscode'}.$sec;
17515: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
17516: $cenv{'internal.sectionnums'} .= $item.',';
1.1412 raeburn 17517: if ($addcheck eq 'ok') {
17518: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17519: push(@oklcsecs,$gp);
17520: }
17521: } else {
1.1263 raeburn 17522: push(@badclasses,$class);
1.444 albertel 17523: }
17524: }
17525: $cenv{'internal.sectionnums'} =~ s/,$//;
17526: }
17527: }
17528: # do not hide course coordinator from staff listing,
17529: # even if privileged
17530: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 17531: # add course coordinator's domain to domains to check for privileged users
17532: # if different to course domain
17533: if ($$crsudom ne $args->{'ccdomain'}) {
17534: $cenv{'checkforpriv'} = $args->{'ccdomain'};
17535: }
1.444 albertel 17536: # add crosslistings
17537: if ($args->{'crsxlist'}) {
17538: $cenv{'internal.crosslistings'}='';
17539: if ($args->{'crsxlist'} =~ m/,/) {
17540: @xlists = split/,/,$args->{'crsxlist'};
17541: } else {
17542: $xlists[0] = $args->{'crsxlist'};
17543: }
17544: if (@xlists > 0) {
17545: foreach my $item (@xlists) {
17546: my ($xl,$gp) = split/:/,$item;
17547: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
17548: $cenv{'internal.crosslistings'} .= $item.',';
1.1412 raeburn 17549: if ($addcheck eq 'ok') {
17550: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
17551: push(@oklcsecs,$gp);
17552: }
17553: } else {
1.1263 raeburn 17554: push(@badclasses,$xl);
1.444 albertel 17555: }
17556: }
17557: $cenv{'internal.crosslistings'} =~ s/,$//;
17558: }
17559: }
17560: if ($args->{'autoadds'}) {
17561: $cenv{'internal.autoadds'}=$args->{'autoadds'};
17562: }
17563: if ($args->{'autodrops'}) {
17564: $cenv{'internal.autodrops'}=$args->{'autodrops'};
17565: }
17566: # check for notification of enrollment changes
17567: my @notified = ();
17568: if ($args->{'notify_owner'}) {
17569: if ($args->{'ccuname'} ne '') {
17570: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
17571: }
17572: }
17573: if ($args->{'notify_dc'}) {
17574: if ($uname ne '') {
1.630 raeburn 17575: push(@notified,$uname.':'.$udom);
1.444 albertel 17576: }
17577: }
17578: if (@notified > 0) {
17579: my $notifylist;
17580: if (@notified > 1) {
17581: $notifylist = join(',',@notified);
17582: } else {
17583: $notifylist = $notified[0];
17584: }
17585: $cenv{'internal.notifylist'} = $notifylist;
17586: }
17587: if (@badclasses > 0) {
17588: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 17589: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
17590: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
17591: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 17592: );
1.1264 raeburn 17593: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
17594: &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 17595: if ($context eq 'auto') {
17596: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 17597: } else {
1.566 albertel 17598: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 17599: }
17600: foreach my $item (@badclasses) {
1.541 raeburn 17601: if ($context eq 'auto') {
1.1261 raeburn 17602: $outcome .= " - $item\n";
1.541 raeburn 17603: } else {
1.1261 raeburn 17604: $outcome .= "<li>$item</li>\n";
1.541 raeburn 17605: }
1.1261 raeburn 17606: }
17607: if ($context eq 'auto') {
17608: $outcome .= $linefeed;
17609: } else {
17610: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 17611: }
1.444 albertel 17612: }
17613: if ($args->{'no_end_date'}) {
17614: $args->{'endaccess'} = 0;
17615: }
1.1412 raeburn 17616: # If an official course with institutional sections is created by cloning
17617: # an existing course, section-specific hiding of course totals in student's
17618: # view of grades as copied from cloned course, will be checked for valid
17619: # sections.
17620: if (($can_clone && $cloneid) &&
17621: ($cenv{'internal.coursecode'} ne '') &&
17622: ($cenv{'grading'} eq 'standard') &&
17623: ($cenv{'hidetotals'} ne '') &&
17624: ($cenv{'hidetotals'} ne 'all')) {
17625: my @hidesecs;
17626: my $deletehidetotals;
17627: if (@oklcsecs) {
17628: foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
17629: if (grep(/^\Q$sec$/,@oklcsecs)) {
17630: push(@hidesecs,$sec);
17631: }
17632: }
17633: if (@hidesecs) {
17634: $cenv{'hidetotals'} = join(',',@hidesecs);
17635: } else {
17636: $deletehidetotals = 1;
17637: }
17638: } else {
17639: $deletehidetotals = 1;
17640: }
17641: if ($deletehidetotals) {
17642: delete($cenv{'hidetotals'});
17643: &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
17644: }
17645: }
1.444 albertel 17646: $cenv{'internal.autostart'}=$args->{'enrollstart'};
17647: $cenv{'internal.autoend'}=$args->{'enrollend'};
17648: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
17649: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
17650: if ($args->{'showphotos'}) {
17651: $cenv{'internal.showphotos'}=$args->{'showphotos'};
17652: }
17653: $cenv{'internal.authtype'} = $args->{'authtype'};
17654: $cenv{'internal.autharg'} = $args->{'autharg'};
17655: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
17656: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 17657: 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');
17658: if ($context eq 'auto') {
17659: $outcome .= $krb_msg;
17660: } else {
1.566 albertel 17661: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 17662: }
17663: $outcome .= $linefeed;
1.444 albertel 17664: }
17665: }
17666: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
17667: if ($args->{'setpolicy'}) {
17668: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17669: }
17670: if ($args->{'setcontent'}) {
17671: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17672: }
1.1251 raeburn 17673: if ($args->{'setcomment'}) {
17674: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17675: }
1.444 albertel 17676: }
17677: if ($args->{'reshome'}) {
17678: $cenv{'reshome'}=$args->{'reshome'}.'/';
17679: $cenv{'reshome'}=~s/\/+$/\//;
17680: }
17681: #
17682: # course has keyed access
17683: #
17684: if ($args->{'setkeys'}) {
17685: $cenv{'keyaccess'}='yes';
17686: }
17687: # if specified, key authority is not course, but user
17688: # only active if keyaccess is yes
17689: if ($args->{'keyauth'}) {
1.487 albertel 17690: my ($user,$domain) = split(':',$args->{'keyauth'});
17691: $user = &LONCAPA::clean_username($user);
17692: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 17693: if ($user ne '' && $domain ne '') {
1.487 albertel 17694: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 17695: }
17696: }
17697:
1.1166 raeburn 17698: #
1.1167 raeburn 17699: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 17700: #
17701: if ($args->{'uniquecode'}) {
17702: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
17703: if ($code) {
17704: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 17705: my %crsinfo =
17706: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
17707: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
17708: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
17709: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
17710: }
1.1166 raeburn 17711: if (ref($coderef)) {
17712: $$coderef = $code;
17713: }
17714: }
17715: }
17716:
1.444 albertel 17717: if ($args->{'disresdis'}) {
17718: $cenv{'pch.roles.denied'}='st';
17719: }
17720: if ($args->{'disablechat'}) {
17721: $cenv{'plc.roles.denied'}='st';
17722: }
17723:
17724: # Record we've not yet viewed the Course Initialization Helper for this
17725: # course
17726: $cenv{'course.helper.not.run'} = 1;
17727: #
17728: # Use new Randomseed
17729: #
17730: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
17731: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
17732: #
17733: # The encryption code and receipt prefix for this course
17734: #
17735: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
17736: $cenv{'internal.encpref'}=100+int(9*rand(99));
17737: #
17738: # By default, use standard grading
17739: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
17740:
1.541 raeburn 17741: $outcome .= $linefeed.&mt('Setting environment').': '.
17742: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17743: #
17744: # Open all assignments
17745: #
17746: if ($args->{'openall'}) {
1.1341 raeburn 17747: my $opendate = time;
17748: if ($args->{'openallfrom'} =~ /^\d+$/) {
17749: $opendate = $args->{'openallfrom'};
17750: }
1.444 albertel 17751: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 17752: my %storecontent = ($storeunder => $opendate,
1.444 albertel 17753: $storeunder.'.type' => 'date_start');
1.1341 raeburn 17754: $outcome .= &mt('All assignments open starting [_1]',
17755: &Apache::lonlocal::locallocaltime($opendate)).': '.
17756: &Apache::lonnet::cput
17757: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17758: }
17759: #
17760: # Set first page
17761: #
17762: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
17763: || ($cloneid)) {
17764: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 17765:
17766: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
17767: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
17768:
1.444 albertel 17769: $outcome .= ($fatal?$errtext:'read ok').' - ';
17770: my $title; my $url;
17771: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 17772: $title=&mt('Syllabus');
1.444 albertel 17773: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
17774: } else {
1.963 raeburn 17775: $title=&mt('Table of Contents');
1.444 albertel 17776: $url='/adm/navmaps';
17777: }
1.445 albertel 17778:
17779: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
17780: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
17781:
17782: if ($errtext) { $fatal=2; }
1.541 raeburn 17783: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 17784: }
1.566 albertel 17785:
1.1237 raeburn 17786: #
17787: # Set params for Placement Tests
17788: #
1.1239 raeburn 17789: if ($args->{'crstype'} eq 'Placement') {
17790: my %storecontent;
17791: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
17792: my %defaults = (
17793: buttonshide => { value => 'yes',
17794: type => 'string_yesno',},
17795: type => { value => 'randomizetry',
17796: type => 'string_questiontype',},
17797: maxtries => { value => 1,
17798: type => 'int_pos',},
17799: problemstatus => { value => 'no',
17800: type => 'string_problemstatus',},
17801: );
17802: foreach my $key (keys(%defaults)) {
17803: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
17804: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
17805: }
1.1237 raeburn 17806: &Apache::lonnet::cput
17807: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17808: }
17809:
1.1344 raeburn 17810: return (1,$outcome,\@clonemsg);
1.444 albertel 17811: }
17812:
1.1166 raeburn 17813: sub make_unique_code {
17814: my ($cdom,$cnum) = @_;
17815: # get lock on uniquecodes db
17816: my $lockhash = {
17817: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17818: ':'.$env{'user.domain'},
17819: };
17820: my $tries = 0;
17821: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17822: my ($code,$error);
17823:
17824: while (($gotlock ne 'ok') && ($tries<3)) {
17825: $tries ++;
17826: sleep 1;
17827: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17828: }
17829: if ($gotlock eq 'ok') {
17830: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17831: my $gotcode;
17832: my $attempts = 0;
17833: while ((!$gotcode) && ($attempts < 100)) {
17834: $code = &generate_code();
17835: if (!exists($currcodes{$code})) {
17836: $gotcode = 1;
17837: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17838: $error = 'nostore';
17839: }
17840: }
17841: $attempts ++;
17842: }
17843: my @del_lock = ($cnum."\0".'uniquecodes');
17844: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17845: } else {
17846: $error = 'nolock';
17847: }
17848: return ($code,$error);
17849: }
17850:
17851: sub generate_code {
17852: my $code;
17853: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17854: for (my $i=0; $i<6; $i++) {
17855: my $lettnum = int (rand 2);
17856: my $item = '';
17857: if ($lettnum) {
17858: $item = $letts[int( rand(18) )];
17859: } else {
17860: $item = 1+int( rand(8) );
17861: }
17862: $code .= $item;
17863: }
17864: return $code;
17865: }
17866:
1.444 albertel 17867: ############################################################
17868: ############################################################
17869:
1.1237 raeburn 17870: # Community, Course and Placement Test
1.378 raeburn 17871: sub course_type {
17872: my ($cid) = @_;
17873: if (!defined($cid)) {
17874: $cid = $env{'request.course.id'};
17875: }
1.404 albertel 17876: if (defined($env{'course.'.$cid.'.type'})) {
17877: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17878: } else {
17879: return 'Course';
1.377 raeburn 17880: }
17881: }
1.156 albertel 17882:
1.406 raeburn 17883: sub group_term {
17884: my $crstype = &course_type();
17885: my %names = (
17886: 'Course' => 'group',
1.865 raeburn 17887: 'Community' => 'group',
1.1237 raeburn 17888: 'Placement' => 'group',
1.406 raeburn 17889: );
17890: return $names{$crstype};
17891: }
17892:
1.902 raeburn 17893: sub course_types {
1.1310 raeburn 17894: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17895: my %typename = (
17896: official => 'Official course',
17897: unofficial => 'Unofficial course',
17898: community => 'Community',
1.1165 raeburn 17899: textbook => 'Textbook course',
1.1237 raeburn 17900: placement => 'Placement test',
1.1310 raeburn 17901: lti => 'LTI provider',
1.902 raeburn 17902: );
17903: return (\@types,\%typename);
17904: }
17905:
1.156 albertel 17906: sub icon {
17907: my ($file)=@_;
1.505 albertel 17908: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17909: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17910: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17911: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17912: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17913: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17914: $curfext.".gif") {
17915: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17916: $curfext.".gif";
17917: }
17918: }
1.249 albertel 17919: return &lonhttpdurl($iconname);
1.154 albertel 17920: }
1.84 albertel 17921:
1.575 albertel 17922: sub lonhttpdurl {
1.692 www 17923: #
17924: # Had been used for "small fry" static images on separate port 8080.
17925: # Modify here if lightweight http functionality desired again.
17926: # Currently eliminated due to increasing firewall issues.
17927: #
1.575 albertel 17928: my ($url)=@_;
1.692 www 17929: return $url;
1.215 albertel 17930: }
17931:
1.213 albertel 17932: sub connection_aborted {
17933: my ($r)=@_;
17934: $r->print(" ");$r->rflush();
17935: my $c = $r->connection;
17936: return $c->aborted();
17937: }
17938:
1.221 foxr 17939: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17940: # strings as 'strings'.
17941: sub escape_single {
1.221 foxr 17942: my ($input) = @_;
1.223 albertel 17943: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17944: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17945: return $input;
17946: }
1.223 albertel 17947:
1.222 foxr 17948: # Same as escape_single, but escape's "'s This
17949: # can be used for "strings"
17950: sub escape_double {
17951: my ($input) = @_;
17952: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17953: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17954: return $input;
17955: }
1.223 albertel 17956:
1.222 foxr 17957: # Escapes the last element of a full URL.
17958: sub escape_url {
17959: my ($url) = @_;
1.238 raeburn 17960: my @urlslices = split(/\//, $url,-1);
1.369 www 17961: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17962: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17963: }
1.462 albertel 17964:
1.820 raeburn 17965: sub compare_arrays {
17966: my ($arrayref1,$arrayref2) = @_;
17967: my (@difference,%count);
17968: @difference = ();
17969: %count = ();
17970: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17971: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17972: foreach my $element (keys(%count)) {
17973: if ($count{$element} == 1) {
17974: push(@difference,$element);
17975: }
17976: }
17977: }
17978: return @difference;
17979: }
17980:
1.1322 raeburn 17981: sub lon_status_items {
17982: my %defaults = (
17983: E => 100,
17984: W => 4,
17985: N => 1,
1.1324 raeburn 17986: U => 5,
1.1322 raeburn 17987: threshold => 200,
17988: sysmail => 2500,
17989: );
17990: my %names = (
17991: E => 'Errors',
17992: W => 'Warnings',
17993: N => 'Notices',
1.1324 raeburn 17994: U => 'Unsent',
1.1322 raeburn 17995: );
17996: return (\%defaults,\%names);
17997: }
17998:
1.817 bisitz 17999: # -------------------------------------------------------- Initialize user login
1.462 albertel 18000: sub init_user_environment {
1.463 albertel 18001: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 18002: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
18003:
18004: my $public=($username eq 'public' && $domain eq 'public');
18005:
1.1415 raeburn 18006: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
18007: $coauthorenv);
1.462 albertel 18008: my $now=time;
18009:
18010: if ($public) {
18011: my $max_public=100;
18012: my $oldest;
18013: my $oldest_time=0;
18014: for(my $next=1;$next<=$max_public;$next++) {
18015: if (-e $lonids."/publicuser_$next.id") {
18016: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
18017: if ($mtime<$oldest_time || !$oldest_time) {
18018: $oldest_time=$mtime;
18019: $oldest=$next;
18020: }
18021: } else {
18022: $cookie="publicuser_$next";
18023: last;
18024: }
18025: }
18026: if (!$cookie) { $cookie="publicuser_$oldest"; }
18027: } else {
1.1275 raeburn 18028: # See if old ID present, if so, remove if this isn't a robot,
18029: # killing any existing non-robot sessions
1.463 albertel 18030: if (!$args->{'robot'}) {
18031: opendir(DIR,$lonids);
18032: while ($filename=readdir(DIR)) {
18033: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 18034: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
18035: &GDBM_READER(),0640)) {
1.1295 raeburn 18036: my $linkedfile;
1.1320 raeburn 18037: if (exists($oldenv{'user.linkedenv'})) {
18038: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 18039: }
1.1320 raeburn 18040: untie(%oldenv);
18041: if (unlink("$lonids/$filename")) {
18042: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
18043: if (-l "$lonids/$linkedfile.id") {
18044: unlink("$lonids/$linkedfile.id");
18045: }
1.1295 raeburn 18046: }
18047: }
18048: } else {
18049: unlink($lonids.'/'.$filename);
18050: }
1.463 albertel 18051: }
1.462 albertel 18052: }
1.463 albertel 18053: closedir(DIR);
1.1204 raeburn 18054: # If there is a undeleted lockfile for the user's paste buffer remove it.
18055: my $namespace = 'nohist_courseeditor';
18056: my $lockingkey = 'paste'."\0".'locked_num';
18057: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
18058: $domain,$username);
18059: if (exists($lockhash{$lockingkey})) {
18060: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
18061: unless ($delresult eq 'ok') {
18062: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
18063: }
18064: }
1.462 albertel 18065: }
18066: # Give them a new cookie
1.463 albertel 18067: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 18068: : $now.$$.int(rand(10000)));
1.463 albertel 18069: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 18070:
18071: # Initialize roles
18072:
1.1414 raeburn 18073: ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
1.1062 raeburn 18074: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 18075: }
18076: # ------------------------------------ Check browser type and MathML capability
18077:
1.1194 raeburn 18078: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
18079: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 18080:
18081: # ------------------------------------------------------------- Get environment
18082:
18083: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
18084: my ($tmp) = keys(%userenv);
1.1275 raeburn 18085: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 18086: undef(%userenv);
18087: }
18088: if (($userenv{'interface'}) && (!$form->{'interface'})) {
18089: $form->{'interface'}=$userenv{'interface'};
18090: }
18091: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
18092:
18093: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 18094: foreach my $option ('interface','localpath','localres') {
18095: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 18096: }
18097: # --------------------------------------------------------- Write first profile
18098:
18099: {
1.1350 raeburn 18100: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 18101: my %initial_env =
18102: ("user.name" => $username,
18103: "user.domain" => $domain,
18104: "user.home" => $authhost,
18105: "browser.type" => $clientbrowser,
18106: "browser.version" => $clientversion,
18107: "browser.mathml" => $clientmathml,
18108: "browser.unicode" => $clientunicode,
18109: "browser.os" => $clientos,
1.1137 raeburn 18110: "browser.mobile" => $clientmobile,
1.1141 raeburn 18111: "browser.info" => $clientinfo,
1.1194 raeburn 18112: "browser.osversion" => $clientosversion,
1.462 albertel 18113: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
18114: "request.course.fn" => '',
18115: "request.course.uri" => '',
18116: "request.course.sec" => '',
18117: "request.role" => 'cm',
18118: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 18119: "request.host" => $ip,);
1.462 albertel 18120:
18121: if ($form->{'localpath'}) {
18122: $initial_env{"browser.localpath"} = $form->{'localpath'};
18123: $initial_env{"browser.localres"} = $form->{'localres'};
18124: }
18125:
18126: if ($form->{'interface'}) {
18127: $form->{'interface'}=~s/\W//gs;
18128: $initial_env{"browser.interface"} = $form->{'interface'};
18129: $env{'browser.interface'}=$form->{'interface'};
18130: }
18131:
1.1157 raeburn 18132: if ($form->{'iptoken'}) {
18133: my $lonhost = $r->dir_config('lonHostID');
18134: $initial_env{"user.noloadbalance"} = $lonhost;
18135: $env{'user.noloadbalance'} = $lonhost;
18136: }
18137:
1.1268 raeburn 18138: if ($form->{'noloadbalance'}) {
18139: my @hosts = &Apache::lonnet::current_machine_ids();
18140: my $hosthere = $form->{'noloadbalance'};
18141: if (grep(/^\Q$hosthere\E$/,@hosts)) {
18142: $initial_env{"user.noloadbalance"} = $hosthere;
18143: $env{'user.noloadbalance'} = $hosthere;
18144: }
18145: }
18146:
1.1016 raeburn 18147: unless ($domain eq 'public') {
1.1273 raeburn 18148: my %is_adv = ( is_adv => $env{'user.adv'} );
18149: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
18150:
1.1414 raeburn 18151: foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
18152: $userenv{'availabletools.'.$tool} =
1.1273 raeburn 18153: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
18154: undef,\%userenv,\%domdef,\%is_adv);
18155: }
1.980 raeburn 18156:
1.1311 raeburn 18157: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 18158: $userenv{'canrequest.'.$crstype} =
18159: &Apache::lonnet::usertools_access($username,$domain,$crstype,
18160: 'reload','requestcourses',
18161: \%userenv,\%domdef,\%is_adv);
18162: }
1.724 raeburn 18163:
1.1418 raeburn 18164: if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
18165: (exists($userroles->{"user.role.au./$domain/"}))) {
18166: if ($userenv{'authoreditors'}) {
18167: $userenv{'editors'} = $userenv{'authoreditors'};
18168: } elsif ($domdef{'editors'} ne '') {
18169: $userenv{'editors'} = $domdef{'editors'};
18170: } else {
18171: $userenv{'editors'} = 'edit,xml';
18172: }
1.1431 raeburn 18173: if ($userenv{'authorarchive'}) {
18174: $userenv{'canarchive'} = 1;
18175: } elsif (($userenv{'authorarchive'} eq '') &&
18176: ($domdef{'archive'})) {
18177: $userenv{'canarchive'} = 1;
18178: }
1.1418 raeburn 18179: }
18180:
1.1273 raeburn 18181: $userenv{'canrequest.author'} =
18182: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
18183: 'reload','requestauthor',
1.980 raeburn 18184: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 18185: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
18186: $domain,$username);
18187: my $reqstatus = $reqauthor{'author_status'};
18188: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
18189: if (ref($reqauthor{'author'}) eq 'HASH') {
18190: $userenv{'requestauthorqueued'} = $reqstatus.':'.
18191: $reqauthor{'author'}{'timestamp'};
18192: }
1.1092 raeburn 18193: }
1.1287 raeburn 18194: my ($types,$typename) = &course_types();
18195: if (ref($types) eq 'ARRAY') {
18196: my @options = ('approval','validate','autolimit');
18197: my $optregex = join('|',@options);
18198: my (%willtrust,%trustchecked);
18199: foreach my $type (@{$types}) {
18200: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
18201: if ($dom_str ne '') {
18202: my $updatedstr = '';
18203: my @possdomains = split(',',$dom_str);
18204: foreach my $entry (@possdomains) {
18205: my ($extdom,$extopt) = split(':',$entry);
18206: unless ($trustchecked{$extdom}) {
18207: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
18208: $trustchecked{$extdom} = 1;
18209: }
18210: if ($willtrust{$extdom}) {
18211: $updatedstr .= $entry.',';
18212: }
18213: }
18214: $updatedstr =~ s/,$//;
18215: if ($updatedstr) {
18216: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
18217: } else {
18218: delete($userenv{'reqcrsotherdom.'.$type});
18219: }
18220: }
18221: }
18222: }
1.1092 raeburn 18223: }
1.462 albertel 18224: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 18225:
1.462 albertel 18226: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
18227: &GDBM_WRCREAT(),0640)) {
18228: &_add_to_env(\%disk_env,\%initial_env);
18229: &_add_to_env(\%disk_env,\%userenv,'environment.');
18230: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 18231: if (ref($firstaccenv) eq 'HASH') {
18232: &_add_to_env(\%disk_env,$firstaccenv);
18233: }
18234: if (ref($timerintenv) eq 'HASH') {
18235: &_add_to_env(\%disk_env,$timerintenv);
18236: }
1.1414 raeburn 18237: if (ref($coauthorenv) eq 'HASH') {
18238: if (keys(%{$coauthorenv})) {
18239: &_add_to_env(\%disk_env,$coauthorenv);
18240: }
18241: }
1.463 albertel 18242: if (ref($args->{'extra_env'})) {
18243: &_add_to_env(\%disk_env,$args->{'extra_env'});
18244: }
1.462 albertel 18245: untie(%disk_env);
18246: } else {
1.705 tempelho 18247: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
18248: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 18249: return 'error: '.$!;
18250: }
18251: }
18252: $env{'request.role'}='cm';
18253: $env{'request.role.adv'}=$env{'user.adv'};
18254: $env{'browser.type'}=$clientbrowser;
18255:
18256: return $cookie;
18257:
18258: }
18259:
18260: sub _add_to_env {
18261: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 18262: if (ref($env_data) eq 'HASH') {
18263: while (my ($key,$value) = each(%$env_data)) {
18264: $idf->{$prefix.$key} = $value;
18265: $env{$prefix.$key} = $value;
18266: }
1.462 albertel 18267: }
18268: }
18269:
1.685 tempelho 18270: # --- Get the symbolic name of a problem and the url
18271: sub get_symb {
18272: my ($request,$silent) = @_;
1.726 raeburn 18273: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 18274: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
18275: if ($symb eq '') {
18276: if (!$silent) {
1.1071 raeburn 18277: if (ref($request)) {
18278: $request->print("Unable to handle ambiguous references:$url:.");
18279: }
1.685 tempelho 18280: return ();
18281: }
18282: }
18283: &Apache::lonenc::check_decrypt(\$symb);
18284: return ($symb);
18285: }
18286:
18287: # --------------------------------------------------------------Get annotation
18288:
18289: sub get_annotation {
18290: my ($symb,$enc) = @_;
18291:
18292: my $key = $symb;
18293: if (!$enc) {
18294: $key =
18295: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
18296: }
18297: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
18298: return $annotation{$key};
18299: }
18300:
18301: sub clean_symb {
1.731 raeburn 18302: my ($symb,$delete_enc) = @_;
1.685 tempelho 18303:
18304: &Apache::lonenc::check_decrypt(\$symb);
18305: my $enc = $env{'request.enc'};
1.731 raeburn 18306: if ($delete_enc) {
1.730 raeburn 18307: delete($env{'request.enc'});
18308: }
1.685 tempelho 18309:
18310: return ($symb,$enc);
18311: }
1.462 albertel 18312:
1.1181 raeburn 18313: ############################################################
18314: ############################################################
18315:
18316: =pod
18317:
18318: =head1 Routines for building display used to search for courses
18319:
18320:
18321: =over 4
18322:
18323: =item * &build_filters()
18324:
18325: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 18326: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
18327: and quotacheck.pl
18328:
1.1181 raeburn 18329:
18330: Inputs:
18331:
18332: filterlist - anonymous array of fields to include as potential filters
18333:
18334: crstype - course type
18335:
18336: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
18337: to pop-open a course selector (will contain "extra element").
18338:
18339: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
18340:
18341: filter - anonymous hash of criteria and their values
18342:
18343: action - form action
18344:
18345: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
18346:
1.1182 raeburn 18347: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 18348:
18349: cloneruname - username of owner of new course who wants to clone
18350:
18351: clonerudom - domain of owner of new course who wants to clone
18352:
18353: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
18354:
18355: codetitlesref - reference to array of titles of components in institutional codes (official courses)
18356:
18357: codedom - domain
18358:
18359: formname - value of form element named "form".
18360:
18361: fixeddom - domain, if fixed.
18362:
18363: prevphase - value to assign to form element named "phase" when going back to the previous screen
18364:
18365: cnameelement - name of form element in form on opener page which will receive title of selected course
18366:
18367: cnumelement - name of form element in form on opener page which will receive courseID of selected course
18368:
18369: cdomelement - name of form element in form on opener page which will receive domain of selected course
18370:
18371: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
18372:
18373: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
18374:
18375: clonewarning - warning message about missing information for intended course owner when DC creates a course
18376:
1.1182 raeburn 18377:
1.1181 raeburn 18378: Returns: $output - HTML for display of search criteria, and hidden form elements.
18379:
1.1182 raeburn 18380:
1.1181 raeburn 18381: Side Effects: None
18382:
18383: =cut
18384:
18385: # ---------------------------------------------- search for courses based on last activity etc.
18386:
18387: sub build_filters {
18388: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
18389: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
18390: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
18391: $cnameelement,$cnumelement,$cdomelement,$setroles,
18392: $clonetext,$clonewarning) = @_;
1.1182 raeburn 18393: my ($list,$jscript);
1.1181 raeburn 18394: my $onchange = 'javascript:updateFilters(this)';
18395: my ($domainselectform,$sincefilterform,$createdfilterform,
18396: $ownerdomselectform,$persondomselectform,$instcodeform,
18397: $typeselectform,$instcodetitle);
18398: if ($formname eq '') {
18399: $formname = $caller;
18400: }
18401: foreach my $item (@{$filterlist}) {
18402: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
18403: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
18404: if ($item eq 'domainfilter') {
18405: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
18406: } elsif ($item eq 'coursefilter') {
18407: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
18408: } elsif ($item eq 'ownerfilter') {
18409: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18410: } elsif ($item eq 'ownerdomfilter') {
18411: $filter->{'ownerdomfilter'} =
18412: &LONCAPA::clean_domain($filter->{$item});
18413: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
18414: 'ownerdomfilter',1);
18415: } elsif ($item eq 'personfilter') {
18416: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
18417: } elsif ($item eq 'persondomfilter') {
18418: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
18419: 'persondomfilter',1);
18420: } else {
18421: $filter->{$item} =~ s/\W//g;
18422: }
18423: if (!$filter->{$item}) {
18424: $filter->{$item} = '';
18425: }
18426: }
18427: if ($item eq 'domainfilter') {
18428: my $allow_blank = 1;
18429: if ($formname eq 'portform') {
18430: $allow_blank=0;
18431: } elsif ($formname eq 'studentform') {
18432: $allow_blank=0;
18433: }
18434: if ($fixeddom) {
18435: $domainselectform = '<input type="hidden" name="domainfilter"'.
18436: ' value="'.$codedom.'" />'.
18437: &Apache::lonnet::domain($codedom,'description');
18438: } else {
18439: $domainselectform = &select_dom_form($filter->{$item},
18440: 'domainfilter',
18441: $allow_blank,'',$onchange);
18442: }
18443: } else {
18444: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
18445: }
18446: }
18447:
18448: # last course activity filter and selection
18449: $sincefilterform = &timebased_select_form('sincefilter',$filter);
18450:
18451: # course created filter and selection
18452: if (exists($filter->{'createdfilter'})) {
18453: $createdfilterform = &timebased_select_form('createdfilter',$filter);
18454: }
18455:
1.1239 raeburn 18456: my $prefix = $crstype;
18457: if ($crstype eq 'Placement') {
18458: $prefix = 'Placement Test'
18459: }
1.1181 raeburn 18460: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 18461: 'cac' => "$prefix Activity",
18462: 'ccr' => "$prefix Created",
18463: 'cde' => "$prefix Title",
18464: 'cdo' => "$prefix Domain",
1.1181 raeburn 18465: 'ins' => 'Institutional Code',
18466: 'inc' => 'Institutional Categorization',
1.1239 raeburn 18467: 'cow' => "$prefix Owner/Co-owner",
18468: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 18469: 'cog' => 'Type',
18470: );
18471:
18472: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18473: my $typeval = 'Course';
18474: if ($crstype eq 'Community') {
18475: $typeval = 'Community';
1.1239 raeburn 18476: } elsif ($crstype eq 'Placement') {
18477: $typeval = 'Placement';
1.1181 raeburn 18478: }
18479: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
18480: } else {
18481: $typeselectform = '<select name="type" size="1"';
18482: if ($onchange) {
18483: $typeselectform .= ' onchange="'.$onchange.'"';
18484: }
18485: $typeselectform .= '>'."\n";
1.1237 raeburn 18486: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 18487: my $shown;
18488: if ($posstype eq 'Placement') {
18489: $shown = &mt('Placement Test');
18490: } else {
18491: $shown = &mt($posstype);
18492: }
1.1181 raeburn 18493: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 18494: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 18495: }
18496: $typeselectform.="</select>";
18497: }
18498:
18499: my ($cloneableonlyform,$cloneabletitle);
18500: if (exists($filter->{'cloneableonly'})) {
18501: my $cloneableon = '';
18502: my $cloneableoff = ' checked="checked"';
18503: if ($filter->{'cloneableonly'}) {
18504: $cloneableon = $cloneableoff;
18505: $cloneableoff = '';
18506: }
18507: $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>';
18508: if ($formname eq 'ccrs') {
1.1187 bisitz 18509: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 18510: } else {
18511: $cloneabletitle = &mt('Cloneable by you');
18512: }
18513: }
18514: my $officialjs;
18515: if ($crstype eq 'Course') {
18516: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 18517: # if (($fixeddom) || ($formname eq 'requestcrs') ||
18518: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
18519: if ($codedom) {
1.1181 raeburn 18520: $officialjs = 1;
18521: ($instcodeform,$jscript,$$numtitlesref) =
18522: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
18523: $officialjs,$codetitlesref);
18524: if ($jscript) {
1.1182 raeburn 18525: $jscript = '<script type="text/javascript">'."\n".
18526: '// <![CDATA['."\n".
18527: $jscript."\n".
18528: '// ]]>'."\n".
18529: '</script>'."\n";
1.1181 raeburn 18530: }
18531: }
18532: if ($instcodeform eq '') {
18533: $instcodeform =
18534: '<input type="text" name="instcodefilter" size="10" value="'.
18535: $list->{'instcodefilter'}.'" />';
18536: $instcodetitle = $lt{'ins'};
18537: } else {
18538: $instcodetitle = $lt{'inc'};
18539: }
18540: if ($fixeddom) {
18541: $instcodetitle .= '<br />('.$codedom.')';
18542: }
18543: }
18544: }
18545: my $output = qq|
18546: <form method="post" name="filterpicker" action="$action">
18547: <input type="hidden" name="form" value="$formname" />
18548: |;
18549: if ($formname eq 'modifycourse') {
18550: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
18551: '<input type="hidden" name="prevphase" value="'.
18552: $prevphase.'" />'."\n";
1.1198 musolffc 18553: } elsif ($formname eq 'quotacheck') {
18554: $output .= qq|
18555: <input type="hidden" name="sortby" value="" />
18556: <input type="hidden" name="sortorder" value="" />
18557: |;
18558: } else {
1.1181 raeburn 18559: my $name_input;
18560: if ($cnameelement ne '') {
18561: $name_input = '<input type="hidden" name="cnameelement" value="'.
18562: $cnameelement.'" />';
18563: }
18564: $output .= qq|
1.1182 raeburn 18565: <input type="hidden" name="cnumelement" value="$cnumelement" />
18566: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 18567: $name_input
18568: $roleelement
18569: $multelement
18570: $typeelement
18571: |;
18572: if ($formname eq 'portform') {
18573: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
18574: }
18575: }
18576: if ($fixeddom) {
18577: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
18578: }
18579: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
18580: if ($sincefilterform) {
18581: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
18582: .$sincefilterform
18583: .&Apache::lonhtmlcommon::row_closure();
18584: }
18585: if ($createdfilterform) {
18586: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
18587: .$createdfilterform
18588: .&Apache::lonhtmlcommon::row_closure();
18589: }
18590: if ($domainselectform) {
18591: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
18592: .$domainselectform
18593: .&Apache::lonhtmlcommon::row_closure();
18594: }
18595: if ($typeselectform) {
18596: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
18597: $output .= $typeselectform;
18598: } else {
18599: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
18600: .$typeselectform
18601: .&Apache::lonhtmlcommon::row_closure();
18602: }
18603: }
18604: if ($instcodeform) {
18605: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
18606: .$instcodeform
18607: .&Apache::lonhtmlcommon::row_closure();
18608: }
18609: if (exists($filter->{'ownerfilter'})) {
18610: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
18611: '<table><tr><td>'.&mt('Username').'<br />'.
18612: '<input type="text" name="ownerfilter" size="20" value="'.
18613: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18614: $ownerdomselectform.'</td></tr></table>'.
18615: &Apache::lonhtmlcommon::row_closure();
18616: }
18617: if (exists($filter->{'personfilter'})) {
18618: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
18619: '<table><tr><td>'.&mt('Username').'<br />'.
18620: '<input type="text" name="personfilter" size="20" value="'.
18621: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
18622: $persondomselectform.'</td></tr></table>'.
18623: &Apache::lonhtmlcommon::row_closure();
18624: }
18625: if (exists($filter->{'coursefilter'})) {
18626: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
18627: .'<input type="text" name="coursefilter" size="25" value="'
18628: .$list->{'coursefilter'}.'" />'
18629: .&Apache::lonhtmlcommon::row_closure();
18630: }
18631: if ($cloneableonlyform) {
18632: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
18633: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
18634: }
18635: if (exists($filter->{'descriptfilter'})) {
18636: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
18637: .'<input type="text" name="descriptfilter" size="40" value="'
18638: .$list->{'descriptfilter'}.'" />'
18639: .&Apache::lonhtmlcommon::row_closure(1);
18640: }
18641: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
18642: '<input type="hidden" name="updater" value="" />'."\n".
18643: '<input type="submit" name="gosearch" value="'.
18644: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
18645: return $jscript.$clonewarning.$output;
18646: }
18647:
18648: =pod
18649:
18650: =item * &timebased_select_form()
18651:
1.1182 raeburn 18652: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 18653: filter e.g., Course Activity, Course Created, when searching for courses
18654: or communities
18655:
18656: Inputs:
18657:
18658: item - name of form element (sincefilter or createdfilter)
18659:
18660: filter - anonymous hash of criteria and their values
18661:
18662: Returns: HTML for a select box contained a blank, then six time selections,
18663: with value set in incoming form variables currently selected.
18664:
18665: Side Effects: None
18666:
18667: =cut
18668:
18669: sub timebased_select_form {
18670: my ($item,$filter) = @_;
18671: if (ref($filter) eq 'HASH') {
18672: $filter->{$item} =~ s/[^\d-]//g;
18673: if (!$filter->{$item}) { $filter->{$item}=-1; }
18674: return &select_form(
18675: $filter->{$item},
18676: $item,
18677: { '-1' => '',
18678: '86400' => &mt('today'),
18679: '604800' => &mt('last week'),
18680: '2592000' => &mt('last month'),
18681: '7776000' => &mt('last three months'),
18682: '15552000' => &mt('last six months'),
18683: '31104000' => &mt('last year'),
18684: 'select_form_order' =>
18685: ['-1','86400','604800','2592000','7776000',
18686: '15552000','31104000']});
18687: }
18688: }
18689:
18690: =pod
18691:
18692: =item * &js_changer()
18693:
18694: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 18695: when course type or domain is changed, and also to hide 'Searching ...' on
18696: page load completion for page showing search result.
1.1181 raeburn 18697:
18698: Inputs: None
18699:
1.1183 raeburn 18700: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 18701:
18702: Side Effects: None
18703:
18704: =cut
18705:
18706: sub js_changer {
18707: return <<ENDJS;
18708: <script type="text/javascript">
18709: // <![CDATA[
18710: function updateFilters(caller) {
18711: if (typeof(caller) != "undefined") {
18712: document.filterpicker.updater.value = caller.name;
18713: }
18714: document.filterpicker.submit();
18715: }
1.1183 raeburn 18716:
18717: function hideSearching() {
18718: if (document.getElementById('searching')) {
18719: document.getElementById('searching').style.display = 'none';
18720: }
18721: return;
18722: }
18723:
1.1181 raeburn 18724: // ]]>
18725: </script>
18726:
18727: ENDJS
18728: }
18729:
18730: =pod
18731:
1.1182 raeburn 18732: =item * &search_courses()
18733:
18734: Process selected filters form course search form and pass to lonnet::courseiddump
18735: to retrieve a hash for which keys are courseIDs which match the selected filters.
18736:
18737: Inputs:
18738:
18739: dom - domain being searched
18740:
18741: type - course type ('Course' or 'Community' or '.' if any).
18742:
18743: filter - anonymous hash of criteria and their values
18744:
18745: numtitles - for institutional codes - number of categories
18746:
18747: cloneruname - optional username of new course owner
18748:
18749: clonerudom - optional domain of new course owner
18750:
1.1221 raeburn 18751: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 18752: (used when DC is using course creation form)
18753:
18754: codetitles - reference to array of titles of components in institutional codes (official courses).
18755:
1.1221 raeburn 18756: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
18757: (and so can clone automatically)
18758:
18759: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
18760:
18761: reqinstcode - institutional code of new course, where search_courses is used to identify potential
18762: courses to clone
1.1182 raeburn 18763:
18764: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
18765:
18766:
18767: Side Effects: None
18768:
18769: =cut
18770:
18771:
18772: sub search_courses {
1.1221 raeburn 18773: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
18774: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 18775: my (%courses,%showcourses,$cloner);
18776: if (($filter->{'ownerfilter'} ne '') ||
18777: ($filter->{'ownerdomfilter'} ne '')) {
18778: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
18779: $filter->{'ownerdomfilter'};
18780: }
18781: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
18782: if (!$filter->{$item}) {
18783: $filter->{$item}='.';
18784: }
18785: }
18786: my $now = time;
18787: my $timefilter =
18788: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
18789: my ($createdbefore,$createdafter);
18790: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
18791: $createdbefore = $now;
18792: $createdafter = $now-$filter->{'createdfilter'};
18793: }
18794: my ($instcodefilter,$regexpok);
18795: if ($numtitles) {
18796: if ($env{'form.official'} eq 'on') {
18797: $instcodefilter =
18798: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18799: $regexpok = 1;
18800: } elsif ($env{'form.official'} eq 'off') {
18801: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18802: unless ($instcodefilter eq '') {
18803: $regexpok = -1;
18804: }
18805: }
18806: } else {
18807: $instcodefilter = $filter->{'instcodefilter'};
18808: }
18809: if ($instcodefilter eq '') { $instcodefilter = '.'; }
18810: if ($type eq '') { $type = '.'; }
18811:
18812: if (($clonerudom ne '') && ($cloneruname ne '')) {
18813: $cloner = $cloneruname.':'.$clonerudom;
18814: }
18815: %courses = &Apache::lonnet::courseiddump($dom,
18816: $filter->{'descriptfilter'},
18817: $timefilter,
18818: $instcodefilter,
18819: $filter->{'combownerfilter'},
18820: $filter->{'coursefilter'},
18821: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 18822: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 18823: $filter->{'cloneableonly'},
18824: $createdbefore,$createdafter,undef,
1.1221 raeburn 18825: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 18826: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18827: my $ccrole;
18828: if ($type eq 'Community') {
18829: $ccrole = 'co';
18830: } else {
18831: $ccrole = 'cc';
18832: }
18833: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18834: $filter->{'persondomfilter'},
18835: 'userroles',undef,
18836: [$ccrole,'in','ad','ep','ta','cr'],
18837: $dom);
18838: foreach my $role (keys(%rolehash)) {
18839: my ($cnum,$cdom,$courserole) = split(':',$role);
18840: my $cid = $cdom.'_'.$cnum;
18841: if (exists($courses{$cid})) {
18842: if (ref($courses{$cid}) eq 'HASH') {
18843: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18844: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18845: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18846: }
18847: } else {
18848: $courses{$cid}{roles} = [$courserole];
18849: }
18850: $showcourses{$cid} = $courses{$cid};
18851: }
18852: }
18853: }
18854: %courses = %showcourses;
18855: }
18856: return %courses;
18857: }
18858:
18859: =pod
18860:
1.1181 raeburn 18861: =back
18862:
1.1207 raeburn 18863: =head1 Routines for version requirements for current course.
18864:
18865: =over 4
18866:
18867: =item * &check_release_required()
18868:
18869: Compares required LON-CAPA version with version on server, and
18870: if required version is newer looks for a server with the required version.
18871:
18872: Looks first at servers in user's owen domain; if none suitable, looks at
18873: servers in course's domain are permitted to host sessions for user's domain.
18874:
18875: Inputs:
18876:
18877: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18878:
18879: $courseid - Course ID of current course
18880:
18881: $rolecode - User's current role in course (for switchserver query string).
18882:
18883: $required - LON-CAPA version needed by course (format: Major.Minor).
18884:
18885:
18886: Returns:
18887:
18888: $switchserver - query string tp append to /adm/switchserver call (if
18889: current server's LON-CAPA version is too old.
18890:
18891: $warning - Message is displayed if no suitable server could be found.
18892:
18893: =cut
18894:
18895: sub check_release_required {
18896: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18897: my ($switchserver,$warning);
18898: if ($required ne '') {
18899: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18900: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18901: if ($reqdmajor ne '' && $reqdminor ne '') {
18902: my $otherserver;
18903: if (($major eq '' && $minor eq '') ||
18904: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18905: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18906: my $switchlcrev =
18907: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18908: $userdomserver);
18909: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18910: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18911: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18912: my $cdom = $env{'course.'.$courseid.'.domain'};
18913: if ($cdom ne $env{'user.domain'}) {
18914: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18915: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18916: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18917: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18918: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18919: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18920: my $canhost =
18921: &Apache::lonnet::can_host_session($env{'user.domain'},
18922: $coursedomserver,
18923: $remoterev,
18924: $udomdefaults{'remotesessions'},
18925: $defdomdefaults{'hostedsessions'});
18926:
18927: if ($canhost) {
18928: $otherserver = $coursedomserver;
18929: } else {
18930: $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.");
18931: }
18932: } else {
18933: $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).");
18934: }
18935: } else {
18936: $otherserver = $userdomserver;
18937: }
18938: }
18939: if ($otherserver ne '') {
18940: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18941: }
18942: }
18943: }
18944: return ($switchserver,$warning);
18945: }
18946:
18947: =pod
18948:
18949: =item * &check_release_result()
18950:
18951: Inputs:
18952:
18953: $switchwarning - Warning message if no suitable server found to host session.
18954:
18955: $switchserver - query string to append to /adm/switchserver containing lonHostID
18956: and current role.
18957:
18958: Returns: HTML to display with information about requirement to switch server.
18959: Either displaying warning with link to Roles/Courses screen or
18960: display link to switchserver.
18961:
1.1181 raeburn 18962: =cut
18963:
1.1207 raeburn 18964: sub check_release_result {
18965: my ($switchwarning,$switchserver) = @_;
18966: my $output = &start_page('Selected course unavailable on this server').
18967: '<p class="LC_warning">';
18968: if ($switchwarning) {
18969: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18970: if (&show_course()) {
18971: $output .= &mt('Display courses');
18972: } else {
18973: $output .= &mt('Display roles');
18974: }
18975: $output .= '</a>';
18976: } elsif ($switchserver) {
18977: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18978: '<br />'.
18979: '<a href="/adm/switchserver?'.$switchserver.'">'.
18980: &mt('Switch Server').
18981: '</a>';
18982: }
18983: $output .= '</p>'.&end_page();
18984: return $output;
18985: }
18986:
18987: =pod
18988:
18989: =item * &needs_coursereinit()
18990:
18991: Determine if course contents stored for user's session needs to be
18992: refreshed, because content has changed since "Big Hash" last tied.
18993:
18994: Check for change is made if time last checked is more than 10 minutes ago
18995: (by default).
18996:
18997: Inputs:
18998:
18999: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
19000:
19001: $interval (optional) - Time which may elapse (in s) between last check for content
19002: change in current course. (default: 600 s).
19003:
19004: Returns: an array; first element is:
19005:
19006: =over 4
19007:
19008: 'switch' - if content updates mean user's session
19009: needs to be switched to a server running a newer LON-CAPA version
19010:
19011: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
19012: on current server hosting user's session
19013:
19014: '' - if no action required.
19015:
19016: =back
19017:
19018: If first item element is 'switch':
19019:
19020: second item is $switchwarning - Warning message if no suitable server found to host session.
19021:
19022: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
19023: and current role.
19024:
19025: otherwise: no other elements returned.
19026:
19027: =back
19028:
19029: =cut
19030:
19031: sub needs_coursereinit {
19032: my ($loncaparev,$interval) = @_;
19033: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
19034: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
19035: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
19036: my $now = time;
19037: if ($interval eq '') {
19038: $interval = 600;
19039: }
19040: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 19041: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 19042: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 19043: if ($blocked) {
19044: return ();
19045: }
1.1391 raeburn 19046: my $update;
19047: my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
19048: my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
19049: if ($lastmainchange > $env{'request.course.tied'}) {
19050: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
19051: if ($needswitch) {
19052: return ('switch',$switchwarning,$switchserver);
19053: }
19054: $update = 'main';
19055: }
19056: if ($lastsuppchange > $env{'request.course.suppupdated'}) {
19057: if ($update) {
19058: $update = 'both';
19059: } else {
19060: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
19061: if ($needswitch) {
19062: return ('switch',$switchwarning,$switchserver);
19063: } else {
19064: $update = 'supp';
1.1207 raeburn 19065: }
19066: }
1.1391 raeburn 19067: return ($update);
19068: }
19069: }
19070: return ();
19071: }
19072:
19073: sub switch_for_update {
19074: my ($loncaparev,$cdom,$cnum) = @_;
19075: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
19076: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
19077: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
19078: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
19079: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
19080: $curr_reqd_hash{'internal.releaserequired'}});
19081: my ($switchserver,$switchwarning) =
19082: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
19083: $curr_reqd_hash{'internal.releaserequired'});
19084: if ($switchwarning ne '' || $switchserver ne '') {
19085: return ('switch',$switchwarning,$switchserver);
19086: }
1.1207 raeburn 19087: }
19088: }
19089: return ();
19090: }
1.1181 raeburn 19091:
1.1083 raeburn 19092: sub update_content_constraints {
1.1395 raeburn 19093: my ($cdom,$cnum,$chome,$cid) = @_;
1.1083 raeburn 19094: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
19095: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 19096: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 19097: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 19098: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 19099: if ($item eq 'resourcetag') {
19100: if ($name eq 'responsetype') {
19101: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
19102: }
1.1307 raeburn 19103: } elsif ($item eq 'course') {
19104: if ($name eq 'courserestype') {
19105: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
19106: }
1.1083 raeburn 19107: }
19108: }
19109: my $navmap = Apache::lonnavmaps::navmap->new();
19110: if (defined($navmap)) {
1.1307 raeburn 19111: my (%allresponses,%allcrsrestypes);
19112: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
19113: if ($res->is_tool()) {
19114: if ($allcrsrestypes{'exttool'}) {
19115: $allcrsrestypes{'exttool'} ++;
19116: } else {
19117: $allcrsrestypes{'exttool'} = 1;
19118: }
19119: next;
19120: }
1.1083 raeburn 19121: my %responses = $res->responseTypes();
19122: foreach my $key (keys(%responses)) {
19123: next unless(exists($checkresponsetypes{$key}));
19124: $allresponses{$key} += $responses{$key};
19125: }
19126: }
19127: foreach my $key (keys(%allresponses)) {
19128: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
19129: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
19130: ($reqdmajor,$reqdminor) = ($major,$minor);
19131: }
19132: }
1.1307 raeburn 19133: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 19134: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 19135: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
19136: ($reqdmajor,$reqdminor) = ($major,$minor);
19137: }
19138: }
1.1083 raeburn 19139: undef($navmap);
19140: }
1.1391 raeburn 19141: if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308 raeburn 19142: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
19143: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
19144: ($reqdmajor,$reqdminor) = ($major,$minor);
19145: }
19146: }
1.1083 raeburn 19147: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
19148: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
19149: }
19150: return;
19151: }
19152:
1.1110 raeburn 19153: sub allmaps_incourse {
19154: my ($cdom,$cnum,$chome,$cid) = @_;
19155: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
19156: $cid = $env{'request.course.id'};
19157: $cdom = $env{'course.'.$cid.'.domain'};
19158: $cnum = $env{'course.'.$cid.'.num'};
19159: $chome = $env{'course.'.$cid.'.home'};
19160: }
19161: my %allmaps = ();
19162: my $lastchange =
19163: &Apache::lonnet::get_coursechange($cdom,$cnum);
19164: if ($lastchange > $env{'request.course.tied'}) {
19165: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
19166: unless ($ferr) {
1.1395 raeburn 19167: &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110 raeburn 19168: }
19169: }
19170: my $navmap = Apache::lonnavmaps::navmap->new();
19171: if (defined($navmap)) {
19172: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
19173: $allmaps{$res->src()} = 1;
19174: }
19175: }
19176: return \%allmaps;
19177: }
19178:
1.1083 raeburn 19179: sub parse_supplemental_title {
19180: my ($title) = @_;
19181:
19182: my ($foldertitle,$renametitle);
19183: if ($title =~ /&&&/) {
19184: $title = &HTML::Entites::decode($title);
19185: }
19186: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
19187: $renametitle=$4;
19188: my ($time,$uname,$udom) = ($1,$2,$3);
19189: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
19190: my $name = &plainname($uname,$udom);
19191: $name = &HTML::Entities::encode($name,'"<>&\'');
19192: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1401 raeburn 19193: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
1.1402 raeburn 19194: if ($foldertitle ne '') {
1.1401 raeburn 19195: $title .= ': <br />'.$foldertitle;
19196: }
1.1083 raeburn 19197: }
19198: if (wantarray) {
19199: return ($title,$foldertitle,$renametitle);
19200: }
19201: return $title;
19202: }
19203:
1.1395 raeburn 19204: sub get_supplemental {
19205: my ($cnum,$cdom,$ignorecache,$possdel)=@_;
19206: my $hashid=$cnum.':'.$cdom;
19207: my ($supplemental,$cached,$set_httprefs);
19208: unless ($ignorecache) {
19209: ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
19210: }
19211: unless (defined($cached)) {
19212: my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
19213: unless ($chome eq 'no_host') {
19214: my @order = @LONCAPA::map::order;
19215: my @resources = @LONCAPA::map::resources;
19216: my @resparms = @LONCAPA::map::resparms;
19217: my @zombies = @LONCAPA::map::zombies;
19218: my ($errors,%ids,%hidden);
19219: $errors =
19220: &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
19221: $errors,$possdel,\%ids,\%hidden);
19222: @LONCAPA::map::order = @order;
19223: @LONCAPA::map::resources = @resources;
19224: @LONCAPA::map::resparms = @resparms;
19225: @LONCAPA::map::zombies = @zombies;
19226: $set_httprefs = 1;
19227: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
19228: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
19229: }
19230: $supplemental = {
19231: ids => \%ids,
19232: hidden => \%hidden,
19233: };
19234: &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
19235: }
19236: }
19237: return ($supplemental,$set_httprefs);
19238: }
19239:
1.1143 raeburn 19240: sub recurse_supplemental {
1.1391 raeburn 19241: my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
19242: if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
19243: my $mapnum;
19244: if ($suppmap eq 'supplemental.sequence') {
19245: $mapnum = 0;
19246: } else {
19247: ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
19248: }
1.1143 raeburn 19249: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
19250: if ($fatal) {
19251: $errors ++;
19252: } else {
1.1389 raeburn 19253: my @order = @LONCAPA::map::order;
19254: if (@order > 0) {
19255: my @resources = @LONCAPA::map::resources;
1.1391 raeburn 19256: my @resparms = @LONCAPA::map::resparms;
1.1389 raeburn 19257: foreach my $idx (@order) {
19258: my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143 raeburn 19259: if (($src ne '') && ($status eq 'res')) {
1.1391 raeburn 19260: my $id = $mapnum.':'.$idx;
19261: push(@{$suppids->{$src}},$id);
19262: if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
19263: $hiddensupp->{$id} = 1;
19264: }
1.1146 raeburn 19265: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391 raeburn 19266: $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
19267: $hiddensupp,$hiddensupp->{$id});
1.1143 raeburn 19268: } else {
1.1391 raeburn 19269: my $allowed;
19270: if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
19271: $allowed = 1;
19272: } elsif ($possdel) {
19273: foreach my $item (@{$suppids->{$src}}) {
19274: next if ($item eq $id);
19275: unless ($hiddensupp->{$item}) {
19276: $allowed = 1;
19277: last;
19278: }
19279: }
19280: if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
19281: &Apache::lonnet::delenv('httpref.'.$src);
19282: }
19283: }
19284: if ($allowed && (!exists($env{'httpref.'.$src}))) {
19285: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308 raeburn 19286: }
1.1143 raeburn 19287: }
19288: }
19289: }
19290: }
19291: }
19292: }
1.1391 raeburn 19293: return $errors;
19294: }
19295:
19296: sub set_supp_httprefs {
19297: my ($cnum,$cdom,$supplemental,$possdel) = @_;
19298: if (ref($supplemental) eq 'HASH') {
19299: if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
19300: foreach my $src (keys(%{$supplemental->{'ids'}})) {
19301: next if ($src =~ /\.sequence$/);
19302: if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
19303: my $allowed;
19304: if ($env{'request.role.adv'}) {
19305: $allowed = 1;
19306: } else {
19307: foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
19308: unless ($supplemental->{'hidden'}->{$id}) {
19309: $allowed = 1;
19310: last;
19311: }
19312: }
19313: }
19314: if (exists($env{'httpref.'.$src})) {
19315: if ($possdel) {
19316: unless ($allowed) {
19317: &Apache::lonnet::delenv('httpref.'.$src);
19318: }
19319: }
19320: } elsif ($allowed) {
19321: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
19322: }
19323: }
19324: }
19325: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
19326: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
19327: }
19328: }
19329: }
19330: }
19331:
19332: sub get_supp_parameter {
19333: my ($resparm,$name)=@_;
19334: return if ($resparm eq '');
19335: my $value=undef;
19336: my $ptype=undef;
19337: foreach (split('&&&',$resparm)) {
19338: my ($thistype,$thisname,$thisvalue)=split('___',$_);
19339: if ($thisname eq $name) {
19340: $value=$thisvalue;
19341: $ptype=$thistype;
19342: }
19343: }
19344: return $value;
1.1143 raeburn 19345: }
19346:
1.1101 raeburn 19347: sub symb_to_docspath {
1.1267 raeburn 19348: my ($symb,$navmapref) = @_;
19349: return unless ($symb && ref($navmapref));
1.1101 raeburn 19350: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
19351: if ($resurl=~/\.(sequence|page)$/) {
19352: $mapurl=$resurl;
19353: } elsif ($resurl eq 'adm/navmaps') {
19354: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
19355: }
19356: my $mapresobj;
1.1267 raeburn 19357: unless (ref($$navmapref)) {
19358: $$navmapref = Apache::lonnavmaps::navmap->new();
19359: }
19360: if (ref($$navmapref)) {
19361: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 19362: }
19363: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
19364: my $type=$2;
19365: my $path;
19366: if (ref($mapresobj)) {
19367: my $pcslist = $mapresobj->map_hierarchy();
19368: if ($pcslist ne '') {
19369: foreach my $pc (split(/,/,$pcslist)) {
19370: next if ($pc <= 1);
1.1267 raeburn 19371: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 19372: if (ref($res)) {
19373: my $thisurl = $res->src();
19374: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
19375: my $thistitle = $res->title();
19376: $path .= '&'.
19377: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 19378: &escape($thistitle).
1.1101 raeburn 19379: ':'.$res->randompick().
19380: ':'.$res->randomout().
19381: ':'.$res->encrypted().
19382: ':'.$res->randomorder().
19383: ':'.$res->is_page();
19384: }
19385: }
19386: }
19387: $path =~ s/^\&//;
19388: my $maptitle = $mapresobj->title();
19389: if ($mapurl eq 'default') {
1.1129 raeburn 19390: $maptitle = 'Main Content';
1.1101 raeburn 19391: }
19392: $path .= (($path ne '')? '&' : '').
19393: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19394: &escape($maptitle).
1.1101 raeburn 19395: ':'.$mapresobj->randompick().
19396: ':'.$mapresobj->randomout().
19397: ':'.$mapresobj->encrypted().
19398: ':'.$mapresobj->randomorder().
19399: ':'.$mapresobj->is_page();
19400: } else {
19401: my $maptitle = &Apache::lonnet::gettitle($mapurl);
19402: my $ispage = (($type eq 'page')? 1 : '');
19403: if ($mapurl eq 'default') {
1.1129 raeburn 19404: $maptitle = 'Main Content';
1.1101 raeburn 19405: }
19406: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 19407: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 19408: }
19409: unless ($mapurl eq 'default') {
19410: $path = 'default&'.
1.1146 raeburn 19411: &escape('Main Content').
1.1101 raeburn 19412: ':::::&'.$path;
19413: }
19414: return $path;
19415: }
19416:
1.1393 raeburn 19417: sub validate_folderpath {
19418: my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
19419: if ($env{'form.folderpath'} ne '') {
19420: my @items = split(/\&/,$env{'form.folderpath'});
1.1394 raeburn 19421: my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393 raeburn 19422: for (my $i=0; $i<@items; $i++) {
19423: my $odd = $i%2;
19424: if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
19425: $badpath = 1;
1.1394 raeburn 19426: } elsif ($odd && $supplementalflag) {
1.1393 raeburn 19427: my $idx = $i-1;
1.1394 raeburn 19428: if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
19429: my $esc_name = $1;
19430: if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
19431: $supppath .= '&'.$esc_name;
19432: $changed = 1;
19433: } else {
19434: $supppath .= '&'.$items[$i];
19435: }
19436: } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
19437: $changed = 1;
1.1393 raeburn 19438: my $is_hidden;
19439: unless ($got_supp) {
1.1395 raeburn 19440: my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393 raeburn 19441: if (ref($supplemental) eq 'HASH') {
19442: if (ref($supplemental->{'hidden'}) eq 'HASH') {
19443: %supphidden = %{$supplemental->{'hidden'}};
19444: }
19445: if (ref($supplemental->{'ids'}) eq 'HASH') {
19446: %suppids = %{$supplemental->{'ids'}};
19447: }
19448: }
19449: $got_supp = 1;
19450: }
19451: if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
19452: my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
19453: if ($supphidden{$mapid}) {
19454: $is_hidden = 1;
19455: }
19456: }
1.1394 raeburn 19457: $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
19458: } else {
19459: $supppath .= '&'.$items[$i];
1.1393 raeburn 19460: }
19461: } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
19462: $badpath = 1;
1.1394 raeburn 19463: } elsif ($supplementalflag) {
1.1393 raeburn 19464: $supppath .= '&'.$items[$i];
19465: }
19466: last if ($badpath);
19467: }
19468: if ($badpath) {
19469: delete($env{'form.folderpath'});
1.1394 raeburn 19470: } elsif ($changed && $supplementalflag) {
1.1393 raeburn 19471: $supppath =~ s/^\&//;
19472: $env{'form.folderpath'} = $supppath;
19473: }
19474: }
19475: return;
19476: }
19477:
1.1094 raeburn 19478: sub captcha_display {
1.1327 raeburn 19479: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19480: my ($output,$error);
1.1234 raeburn 19481: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 19482: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19483: if ($captcha eq 'original') {
1.1094 raeburn 19484: $output = &create_captcha();
19485: unless ($output) {
1.1172 raeburn 19486: $error = 'captcha';
1.1094 raeburn 19487: }
19488: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19489: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 19490: unless ($output) {
1.1172 raeburn 19491: $error = 'recaptcha';
1.1094 raeburn 19492: }
19493: }
1.1234 raeburn 19494: return ($output,$error,$captcha,$version);
1.1094 raeburn 19495: }
19496:
19497: sub captcha_response {
1.1327 raeburn 19498: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 19499: my ($captcha_chk,$captcha_error);
1.1327 raeburn 19500: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 19501: if ($captcha eq 'original') {
1.1094 raeburn 19502: ($captcha_chk,$captcha_error) = &check_captcha();
19503: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 19504: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 19505: } else {
19506: $captcha_chk = 1;
19507: }
19508: return ($captcha_chk,$captcha_error);
19509: }
19510:
19511: sub get_captcha_config {
1.1327 raeburn 19512: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 19513: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 19514: my $hostname = &Apache::lonnet::hostname($lonhost);
19515: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
19516: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 19517: if ($context eq 'usercreation') {
19518: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
19519: if (ref($domconfig{$context}) eq 'HASH') {
19520: $hashtocheck = $domconfig{$context}{'cancreate'};
19521: if (ref($hashtocheck) eq 'HASH') {
19522: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
19523: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
19524: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
19525: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
19526: }
19527: if ($privkey && $pubkey) {
19528: $captcha = 'recaptcha';
1.1234 raeburn 19529: $version = $hashtocheck->{'recaptchaversion'};
19530: if ($version ne '2') {
19531: $version = 1;
19532: }
1.1095 raeburn 19533: } else {
19534: $captcha = 'original';
19535: }
19536: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
19537: $captcha = 'original';
19538: }
1.1094 raeburn 19539: }
1.1095 raeburn 19540: } else {
19541: $captcha = 'captcha';
19542: }
19543: } elsif ($context eq 'login') {
19544: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
19545: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
19546: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
19547: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 19548: if ($privkey && $pubkey) {
19549: $captcha = 'recaptcha';
1.1234 raeburn 19550: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
19551: if ($version ne '2') {
19552: $version = 1;
19553: }
1.1095 raeburn 19554: } else {
19555: $captcha = 'original';
1.1094 raeburn 19556: }
1.1095 raeburn 19557: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
19558: $captcha = 'original';
1.1094 raeburn 19559: }
1.1327 raeburn 19560: } elsif ($context eq 'passwords') {
19561: if ($dom_in_effect) {
19562: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
19563: if ($passwdconf{'captcha'} eq 'recaptcha') {
19564: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
19565: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
19566: $privkey = $passwdconf{'recaptchakeys'}{'private'};
19567: }
19568: if ($privkey && $pubkey) {
19569: $captcha = 'recaptcha';
19570: $version = $passwdconf{'recaptchaversion'};
19571: if ($version ne '2') {
19572: $version = 1;
19573: }
19574: } else {
19575: $captcha = 'original';
19576: }
19577: } elsif ($passwdconf{'captcha'} ne 'notused') {
19578: $captcha = 'original';
19579: }
19580: }
19581: }
1.1234 raeburn 19582: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 19583: }
19584:
19585: sub create_captcha {
19586: my %captcha_params = &captcha_settings();
19587: my ($output,$maxtries,$tries) = ('',10,0);
19588: while ($tries < $maxtries) {
19589: $tries ++;
19590: my $captcha = Authen::Captcha->new (
19591: output_folder => $captcha_params{'output_dir'},
19592: data_folder => $captcha_params{'db_dir'},
19593: );
19594: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
19595:
19596: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
19597: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 19598: '<span class="LC_nobreak">'.
1.1094 raeburn 19599: &mt('Type in the letters/numbers shown below').' '.
1.1390 raeburn 19600: '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367 raeburn 19601: '</span><br />'.
1.1176 raeburn 19602: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 19603: last;
19604: }
19605: }
1.1323 raeburn 19606: if ($output eq '') {
19607: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
19608: }
1.1094 raeburn 19609: return $output;
19610: }
19611:
19612: sub captcha_settings {
19613: my %captcha_params = (
19614: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
19615: www_output_dir => "/captchaspool",
19616: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
19617: numchars => '5',
19618: );
19619: return %captcha_params;
19620: }
19621:
19622: sub check_captcha {
19623: my ($captcha_chk,$captcha_error);
19624: my $code = $env{'form.code'};
19625: my $md5sum = $env{'form.crypt'};
19626: my %captcha_params = &captcha_settings();
19627: my $captcha = Authen::Captcha->new(
19628: output_folder => $captcha_params{'output_dir'},
19629: data_folder => $captcha_params{'db_dir'},
19630: );
1.1109 raeburn 19631: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 19632: my %captcha_hash = (
19633: 0 => 'Code not checked (file error)',
19634: -1 => 'Failed: code expired',
19635: -2 => 'Failed: invalid code (not in database)',
19636: -3 => 'Failed: invalid code (code does not match crypt)',
19637: );
19638: if ($captcha_chk != 1) {
19639: $captcha_error = $captcha_hash{$captcha_chk}
19640: }
19641: return ($captcha_chk,$captcha_error);
19642: }
19643:
19644: sub create_recaptcha {
1.1234 raeburn 19645: my ($pubkey,$version) = @_;
19646: if ($version >= 2) {
1.1367 raeburn 19647: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
19648: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 19649: } else {
19650: my $use_ssl;
19651: if ($ENV{'SERVER_PORT'} == 443) {
19652: $use_ssl = 1;
19653: }
19654: my $captcha = Captcha::reCAPTCHA->new;
19655: return $captcha->get_options_setter({theme => 'white'})."\n".
19656: $captcha->get_html($pubkey,undef,$use_ssl).
19657: &mt('If the text is hard to read, [_1] will replace them.',
19658: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
19659: '<br /><br />';
19660: }
1.1094 raeburn 19661: }
19662:
19663: sub check_recaptcha {
1.1234 raeburn 19664: my ($privkey,$version) = @_;
1.1094 raeburn 19665: my $captcha_chk;
1.1350 raeburn 19666: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 19667: if ($version >= 2) {
19668: my %info = (
19669: secret => $privkey,
19670: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 19671: remoteip => $ip,
1.1234 raeburn 19672: );
1.1280 raeburn 19673: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
19674: $request->content(join('&',map {
19675: my $name = escape($_);
19676: "$name=" . ( ref($info{$_}) eq 'ARRAY'
19677: ? join("&$name=", map {escape($_) } @{$info{$_}})
19678: : &escape($info{$_}) );
19679: } keys(%info)));
19680: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 19681: if ($response->is_success) {
19682: my $data = JSON::DWIW->from_json($response->decoded_content);
19683: if (ref($data) eq 'HASH') {
19684: if ($data->{'success'}) {
19685: $captcha_chk = 1;
19686: }
19687: }
19688: }
19689: } else {
19690: my $captcha = Captcha::reCAPTCHA->new;
19691: my $captcha_result =
19692: $captcha->check_answer(
19693: $privkey,
1.1350 raeburn 19694: $ip,
1.1234 raeburn 19695: $env{'form.recaptcha_challenge_field'},
19696: $env{'form.recaptcha_response_field'},
19697: );
19698: if ($captcha_result->{is_valid}) {
19699: $captcha_chk = 1;
19700: }
1.1094 raeburn 19701: }
19702: return $captcha_chk;
19703: }
19704:
1.1174 raeburn 19705: sub emailusername_info {
1.1244 raeburn 19706: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 19707: my %titles = &Apache::lonlocal::texthash (
19708: lastname => 'Last Name',
19709: firstname => 'First Name',
19710: institution => 'School/college/university',
19711: location => "School's city, state/province, country",
19712: web => "School's web address",
19713: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 19714: id => 'Student/Employee ID',
1.1174 raeburn 19715: );
19716: return (\@fields,\%titles);
19717: }
19718:
1.1161 raeburn 19719: sub cleanup_html {
19720: my ($incoming) = @_;
19721: my $outgoing;
19722: if ($incoming ne '') {
19723: $outgoing = $incoming;
19724: $outgoing =~ s/;/;/g;
19725: $outgoing =~ s/\#/#/g;
19726: $outgoing =~ s/\&/&/g;
19727: $outgoing =~ s/</</g;
19728: $outgoing =~ s/>/>/g;
19729: $outgoing =~ s/\(/(/g;
19730: $outgoing =~ s/\)/)/g;
19731: $outgoing =~ s/"/"/g;
19732: $outgoing =~ s/'/'/g;
19733: $outgoing =~ s/\$/$/g;
19734: $outgoing =~ s{/}{/}g;
19735: $outgoing =~ s/=/=/g;
19736: $outgoing =~ s/\\/\/g
19737: }
19738: return $outgoing;
19739: }
19740:
1.1190 musolffc 19741: # Checks for critical messages and returns a redirect url if one exists.
19742: # $interval indicates how often to check for messages.
1.1282 raeburn 19743: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 19744: sub critical_redirect {
1.1282 raeburn 19745: my ($interval,$context) = @_;
1.1356 raeburn 19746: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
19747: return ();
19748: }
1.1190 musolffc 19749: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 19750: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
19751: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
19752: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 19753: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 19754: if ($blocked) {
19755: my $checkrole = "cm./$cdom/$cnum";
19756: if ($env{'request.course.sec'} ne '') {
19757: $checkrole .= "/$env{'request.course.sec'}";
19758: }
19759: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
19760: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
19761: return;
19762: }
19763: }
19764: }
1.1190 musolffc 19765: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
19766: $env{'user.name'});
19767: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 19768: my $redirecturl;
1.1190 musolffc 19769: if ($what[0]) {
1.1356 raeburn 19770: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 19771: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 19772: my $url=&Apache::lonnet::absolute_url().$redirecturl;
19773: return (1, $url);
1.1190 musolffc 19774: }
1.1191 raeburn 19775: }
19776: }
19777: return ();
1.1190 musolffc 19778: }
19779:
1.1174 raeburn 19780: # Use:
19781: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
19782: #
19783: ##################################################
19784: # password associated functions #
19785: ##################################################
19786: sub des_keys {
19787: # Make a new key for DES encryption.
19788: # Each key has two parts which are returned separately.
19789: # Please note: Each key must be passed through the &hex function
19790: # before it is output to the web browser. The hex versions cannot
19791: # be used to decrypt.
19792: my @hexstr=('0','1','2','3','4','5','6','7',
19793: '8','9','a','b','c','d','e','f');
19794: my $lkey='';
19795: for (0..7) {
19796: $lkey.=$hexstr[rand(15)];
19797: }
19798: my $ukey='';
19799: for (0..7) {
19800: $ukey.=$hexstr[rand(15)];
19801: }
19802: return ($lkey,$ukey);
19803: }
19804:
19805: sub des_decrypt {
19806: my ($key,$cyphertext) = @_;
19807: my $keybin=pack("H16",$key);
19808: my $cypher;
19809: if ($Crypt::DES::VERSION>=2.03) {
19810: $cypher=new Crypt::DES $keybin;
19811: } else {
19812: $cypher=new DES $keybin;
19813: }
1.1233 raeburn 19814: my $plaintext='';
19815: my $cypherlength = length($cyphertext);
19816: my $numchunks = int($cypherlength/32);
19817: for (my $j=0; $j<$numchunks; $j++) {
19818: my $start = $j*32;
19819: my $cypherblock = substr($cyphertext,$start,32);
19820: my $chunk =
19821: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
19822: $chunk .=
19823: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
19824: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
19825: $plaintext .= $chunk;
19826: }
1.1174 raeburn 19827: return $plaintext;
19828: }
19829:
1.1344 raeburn 19830: sub get_requested_shorturls {
1.1309 raeburn 19831: my ($cdom,$cnum,$navmap) = @_;
19832: return unless (ref($navmap));
1.1344 raeburn 19833: my ($numnew,$errors);
1.1309 raeburn 19834: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
19835: if (@toshorten) {
19836: my (%maps,%resources,%titles);
19837: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
19838: 'shorturls',$cdom,$cnum);
19839: if (keys(%resources)) {
1.1344 raeburn 19840: my %tocreate;
1.1309 raeburn 19841: foreach my $item (sort {$a <=> $b} (@toshorten)) {
19842: my $symb = $resources{$item};
19843: if ($symb) {
19844: $tocreate{$cnum.'&'.$symb} = 1;
19845: }
19846: }
1.1344 raeburn 19847: if (keys(%tocreate)) {
19848: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
19849: \%tocreate);
19850: }
1.1309 raeburn 19851: }
1.1344 raeburn 19852: }
19853: return ($numnew,$errors);
19854: }
19855:
19856: sub make_short_symbs {
19857: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
19858: my ($numnew,@errors);
19859: if (ref($tocreateref) eq 'HASH') {
19860: my %tocreate = %{$tocreateref};
1.1309 raeburn 19861: if (keys(%tocreate)) {
19862: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
19863: my $su = Short::URL->new(no_vowels => 1);
19864: my $init = '';
19865: my (%newunique,%addcourse,%courseonly,%failed);
19866: # get lock on tiny db
19867: my $now = time;
1.1344 raeburn 19868: if ($lockuser eq '') {
19869: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
19870: }
1.1309 raeburn 19871: my $lockhash = {
1.1344 raeburn 19872: "lock\0$now" => $lockuser,
1.1309 raeburn 19873: };
19874: my $tries = 0;
19875: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19876: my ($code,$error);
19877: while (($gotlock ne 'ok') && ($tries<3)) {
19878: $tries ++;
19879: sleep 1;
1.1319 raeburn 19880: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 19881: }
19882: if ($gotlock eq 'ok') {
19883: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
19884: \%addcourse,\%courseonly,\%failed);
19885: if (keys(%failed)) {
19886: my $numfailed = scalar(keys(%failed));
19887: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
19888: }
19889: if (keys(%newunique)) {
19890: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
19891: if ($putres eq 'ok') {
19892: $numnew = scalar(keys(%newunique));
19893: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
19894: unless ($newputres eq 'ok') {
19895: push(@errors,&mt('error: could not store course look-up of short URLs'));
19896: }
19897: } else {
19898: push(@errors,&mt('error: could not store unique six character URLs'));
19899: }
19900: }
19901: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
19902: unless ($dellockres eq 'ok') {
19903: push(@errors,&mt('error: could not release lockfile'));
19904: }
19905: } else {
19906: push(@errors,&mt('error: could not obtain lockfile'));
19907: }
19908: if (keys(%courseonly)) {
19909: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
19910: if ($result ne 'ok') {
19911: push(@errors,&mt('error: could not update course look-up of short URLs'));
19912: }
19913: }
19914: }
19915: }
19916: return ($numnew,\@errors);
19917: }
19918:
19919: sub shorten_symbs {
19920: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
19921: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
19922: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
19923: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
19924: my (%possibles,%collisions);
19925: foreach my $key (keys(%{$tocreate})) {
19926: my $num = String::CRC32::crc32($key);
19927: my $tiny = $su->encode($num,$init);
19928: if ($tiny) {
19929: $possibles{$tiny} = $key;
19930: }
19931: }
19932: if (!$init) {
19933: $init = 1;
19934: } else {
19935: $init ++;
19936: }
19937: if (keys(%possibles)) {
19938: my @posstiny = keys(%possibles);
19939: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
19940: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
19941: if (keys(%currtiny)) {
19942: foreach my $key (keys(%currtiny)) {
19943: next if ($currtiny{$key} eq '');
19944: if ($currtiny{$key} eq $possibles{$key}) {
19945: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
19946: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19947: $courseonly->{$tsymb} = $key;
19948: }
19949: } else {
19950: $collisions{$possibles{$key}} = 1;
19951: }
19952: delete($possibles{$key});
19953: }
19954: }
19955: foreach my $key (keys(%possibles)) {
19956: $newunique->{$key} = $possibles{$key};
19957: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
19958: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19959: $addcourse->{$tsymb} = $key;
19960: }
19961: }
19962: }
19963: if (keys(%collisions)) {
19964: if ($init <5) {
19965: if (!$init) {
19966: $init = 1;
19967: } else {
19968: $init ++;
19969: }
19970: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
19971: $newunique,$addcourse,$courseonly,$failed);
19972: } else {
19973: foreach my $key (keys(%collisions)) {
19974: $failed->{$key} = 1;
19975: }
19976: }
19977: }
19978: return $init;
19979: }
19980:
1.1328 raeburn 19981: sub is_nonframeable {
1.1329 raeburn 19982: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
19983: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 19984: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 19985:
19986: $remprotocol = lc($remprotocol);
19987: $remhost = lc($remhost);
19988: my $remport = 80;
19989: if ($remprotocol eq 'https') {
19990: $remport = 443;
19991: }
1.1330 raeburn 19992: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 19993: if ($cached) {
19994: unless ($nocache) {
19995: if ($result) {
19996: return 1;
19997: } else {
19998: return 0;
19999: }
20000: }
20001: }
1.1328 raeburn 20002: my $uselink;
20003: my $request = new HTTP::Request('HEAD',$url);
20004: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
20005: if ($response->is_success()) {
20006: my $secpolicy = lc($response->header('content-security-policy'));
20007: my $xframeop = lc($response->header('x-frame-options'));
20008: $secpolicy =~ s/^\s+|\s+$//g;
20009: $xframeop =~ s/^\s+|\s+$//g;
20010: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 20011: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 20012: my ($origin,$protocol,$port);
20013: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
20014: $port = $ENV{'SERVER_PORT'};
20015: } else {
20016: $port = 80;
20017: }
20018: if ($absolute eq '') {
20019: $protocol = 'http:';
20020: if ($port == 443) {
20021: $protocol = 'https:';
20022: }
20023: $origin = $protocol.'//'.lc($hostname);
20024: } else {
20025: $origin = lc($absolute);
20026: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
20027: }
20028: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
20029: my $framepolicy = $1;
20030: $framepolicy =~ s/^\s+|\s+$//g;
20031: my @policies = split(/\s+/,$framepolicy);
20032: if (@policies) {
20033: if (grep(/^\Q'none'\E$/,@policies)) {
20034: $uselink = 1;
20035: } else {
20036: $uselink = 1;
20037: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
20038: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
20039: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
20040: undef($uselink);
20041: }
20042: if ($uselink) {
20043: if (grep(/^\Q'self'\E$/,@policies)) {
20044: if (($origin ne '') && ($remotehost eq $origin)) {
20045: undef($uselink);
20046: }
20047: }
20048: }
20049: if ($uselink) {
20050: my @possok;
20051: if ($ip ne '') {
20052: push(@possok,$ip);
20053: }
20054: my $hoststr = '';
20055: foreach my $part (reverse(split(/\./,$hostname))) {
20056: if ($hoststr eq '') {
20057: $hoststr = $part;
20058: } else {
20059: $hoststr = "$part.$hoststr";
20060: }
20061: if ($hoststr eq $hostname) {
20062: push(@possok,$hostname);
20063: } else {
20064: push(@possok,"*.$hoststr");
20065: }
20066: }
20067: if (@possok) {
20068: foreach my $poss (@possok) {
20069: last if (!$uselink);
20070: foreach my $policy (@policies) {
20071: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
20072: undef($uselink);
20073: last;
20074: }
20075: }
20076: }
20077: }
20078: }
20079: }
20080: }
20081: } elsif ($xframeop ne '') {
20082: $uselink = 1;
20083: my @policies = split(/\s*,\s*/,$xframeop);
20084: if (@policies) {
20085: unless (grep(/^deny$/,@policies)) {
20086: if ($origin ne '') {
20087: if (grep(/^sameorigin$/,@policies)) {
20088: if ($remotehost eq $origin) {
20089: undef($uselink);
20090: }
20091: }
20092: if ($uselink) {
20093: foreach my $policy (@policies) {
20094: if ($policy =~ /^allow-from\s*(.+)$/) {
20095: my $allowfrom = $1;
20096: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
20097: undef($uselink);
20098: last;
20099: }
20100: }
20101: }
20102: }
20103: }
20104: }
20105: }
20106: }
20107: }
20108: }
1.1329 raeburn 20109: if ($nocache) {
20110: if ($cached) {
20111: my $devalidate;
20112: if ($uselink && !$result) {
20113: $devalidate = 1;
20114: } elsif (!$uselink && $result) {
20115: $devalidate = 1;
20116: }
20117: if ($devalidate) {
20118: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
20119: }
20120: }
20121: } else {
20122: if ($uselink) {
20123: $result = 1;
20124: } else {
20125: $result = 0;
20126: }
20127: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
20128: }
1.1328 raeburn 20129: return $uselink;
20130: }
20131:
1.1359 raeburn 20132: sub page_menu {
20133: my ($menucolls,$menunum) = @_;
20134: my %menu;
20135: foreach my $item (split(/;/,$menucolls)) {
20136: my ($num,$value) = split(/\%/,$item);
20137: if ($num eq $menunum) {
20138: my @entries = split(/\&/,$value);
20139: foreach my $entry (@entries) {
20140: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 20141: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 20142: $menu{$name} = $fields;
20143: } else {
20144: my @shown;
20145: if ($fields =~ /,/) {
20146: @shown = split(/,/,$fields);
20147: } else {
20148: @shown = ($fields);
20149: }
20150: if (@shown) {
20151: foreach my $field (@shown) {
20152: next if ($field eq '');
20153: $menu{$field} = 1;
20154: }
20155: }
20156: }
20157: }
20158: }
20159: }
20160: return %menu;
20161: }
20162:
1.112 bowersj2 20163: 1;
20164: __END__;
1.41 ng 20165:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface