Annotation of loncom/interface/loncommon.pm, revision 1.1345
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1345 ! raeburn 4: # $Id: loncommon.pm,v 1.1344 2020/07/01 20:08: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.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.1280 raeburn 74: use LONCAPA::LWPReq;
1.1328 raeburn 75: use HTTP::Request;
1.657 raeburn 76: use DateTime::TimeZone;
1.1241 raeburn 77: use DateTime::Locale;
1.1220 raeburn 78: use Encode();
1.1091 foxr 79: use Text::Aspell;
1.1094 raeburn 80: use Authen::Captcha;
81: use Captcha::reCAPTCHA;
1.1234 raeburn 82: use JSON::DWIW;
1.1174 raeburn 83: use Crypt::DES;
84: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 85: use MIME::Lite;
86: use MIME::Types;
1.1292 raeburn 87: use File::Copy();
1.1300 raeburn 88: use File::Path();
1.1309 raeburn 89: use String::CRC32();
90: use Short::URL();
1.117 www 91:
1.517 raeburn 92: # ---------------------------------------------- Designs
93: use vars qw(%defaultdesign);
94:
1.22 www 95: my $readit;
96:
1.517 raeburn 97:
1.157 matthew 98: ##
99: ## Global Variables
100: ##
1.46 matthew 101:
1.643 foxr 102:
103: # ----------------------------------------------- SSI with retries:
104: #
105:
106: =pod
107:
1.648 raeburn 108: =head1 Server Side include with retries:
1.643 foxr 109:
110: =over 4
111:
1.648 raeburn 112: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 113:
114: Performs an ssi with some number of retries. Retries continue either
115: until the result is ok or until the retry count supplied by the
116: caller is exhausted.
117:
118: Inputs:
1.648 raeburn 119:
120: =over 4
121:
1.643 foxr 122: resource - Identifies the resource to insert.
1.648 raeburn 123:
1.643 foxr 124: retries - Count of the number of retries allowed.
1.648 raeburn 125:
1.643 foxr 126: form - Hash that identifies the rendering options.
127:
1.648 raeburn 128: =back
129:
130: Returns:
131:
132: =over 4
133:
1.643 foxr 134: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 135:
1.643 foxr 136: response - The response from the last attempt (which may or may not have been successful.
137:
1.648 raeburn 138: =back
139:
140: =back
141:
1.643 foxr 142: =cut
143:
144: sub ssi_with_retries {
145: my ($resource, $retries, %form) = @_;
146:
147:
148: my $ok = 0; # True if we got a good response.
149: my $content;
150: my $response;
151:
152: # Try to get the ssi done. within the retries count:
153:
154: do {
155: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
156: $ok = $response->is_success;
1.650 www 157: if (!$ok) {
158: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
159: }
1.643 foxr 160: $retries--;
161: } while (!$ok && ($retries > 0));
162:
163: if (!$ok) {
164: $content = ''; # On error return an empty content.
165: }
166: return ($content, $response);
167:
168: }
169:
170:
171:
1.20 www 172: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 173: my %language;
1.124 www 174: my %supported_language;
1.1088 foxr 175: my %supported_codes;
1.1048 foxr 176: my %latex_language; # For choosing hyphenation in <transl..>
177: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 178: my %cprtag;
1.192 taceyjo1 179: my %scprtag;
1.351 www 180: my %fe; my %fd; my %fm;
1.41 ng 181: my %category_extensions;
1.12 harris41 182:
1.46 matthew 183: # ---------------------------------------------- Thesaurus variables
1.144 matthew 184: #
185: # %Keywords:
186: # A hash used by &keyword to determine if a word is considered a keyword.
187: # $thesaurus_db_file
188: # Scalar containing the full path to the thesaurus database.
1.46 matthew 189:
190: my %Keywords;
191: my $thesaurus_db_file;
192:
1.144 matthew 193: #
194: # Initialize values from language.tab, copyright.tab, filetypes.tab,
195: # thesaurus.tab, and filecategories.tab.
196: #
1.18 www 197: BEGIN {
1.46 matthew 198: # Variable initialization
199: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
200: #
1.22 www 201: unless ($readit) {
1.12 harris41 202: # ------------------------------------------------------------------- languages
203: {
1.158 raeburn 204: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
205: '/language.tab';
1.1317 raeburn 206: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 207: while (my $line = <$fh>) {
208: next if ($line=~/^\#/);
209: chomp($line);
1.1088 foxr 210: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 211: $language{$key}=$val.' - '.$enc;
212: if ($sup) {
213: $supported_language{$key}=$sup;
1.1088 foxr 214: $supported_codes{$key} = $code;
1.158 raeburn 215: }
1.1048 foxr 216: if ($latex) {
217: $latex_language_bykey{$key} = $latex;
1.1088 foxr 218: $latex_language{$code} = $latex;
1.1048 foxr 219: }
1.158 raeburn 220: }
221: close($fh);
222: }
1.12 harris41 223: }
224: # ------------------------------------------------------------------ copyrights
225: {
1.158 raeburn 226: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
227: '/copyright.tab';
1.1317 raeburn 228: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 229: while (my $line = <$fh>) {
230: next if ($line=~/^\#/);
231: chomp($line);
232: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 233: $cprtag{$key}=$val;
234: }
235: close($fh);
236: }
1.12 harris41 237: }
1.351 www 238: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 239: {
240: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
241: '/source_copyright.tab';
1.1317 raeburn 242: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 243: while (my $line = <$fh>) {
244: next if ($line =~ /^\#/);
245: chomp($line);
246: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 247: $scprtag{$key}=$val;
248: }
249: close($fh);
250: }
251: }
1.63 www 252:
1.517 raeburn 253: # -------------------------------------------------------------- default domain designs
1.63 www 254: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 255: my $designfile = $designdir.'/default.tab';
1.1317 raeburn 256: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 257: while (my $line = <$fh>) {
258: next if ($line =~ /^\#/);
259: chomp($line);
260: my ($key,$val)=(split(/\=/,$line));
261: if ($val) { $defaultdesign{$key}=$val; }
262: }
263: close($fh);
1.63 www 264: }
265:
1.15 harris41 266: # ------------------------------------------------------------- file categories
267: {
1.158 raeburn 268: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
269: '/filecategories.tab';
1.1317 raeburn 270: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 271: while (my $line = <$fh>) {
272: next if ($line =~ /^\#/);
273: chomp($line);
274: my ($extension,$category)=(split(/\s+/,$line,2));
1.1263 raeburn 275: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 276: }
277: close($fh);
278: }
279:
1.15 harris41 280: }
1.12 harris41 281: # ------------------------------------------------------------------ file types
282: {
1.158 raeburn 283: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
284: '/filetypes.tab';
1.1317 raeburn 285: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 286: while (my $line = <$fh>) {
287: next if ($line =~ /^\#/);
288: chomp($line);
289: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 290: if ($descr ne '') {
291: $fe{$ending}=lc($emb);
292: $fd{$ending}=$descr;
1.351 www 293: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 294: }
295: }
296: close($fh);
297: }
1.12 harris41 298: }
1.22 www 299: &Apache::lonnet::logthis(
1.705 tempelho 300: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 301: $readit=1;
1.46 matthew 302: } # end of unless($readit)
1.32 matthew 303:
304: }
1.112 bowersj2 305:
1.42 matthew 306: ###############################################################
307: ## HTML and Javascript Helper Functions ##
308: ###############################################################
309:
310: =pod
311:
1.112 bowersj2 312: =head1 HTML and Javascript Functions
1.42 matthew 313:
1.112 bowersj2 314: =over 4
315:
1.648 raeburn 316: =item * &browser_and_searcher_javascript()
1.112 bowersj2 317:
318: X<browsing, javascript>X<searching, javascript>Returns a string
319: containing javascript with two functions, C<openbrowser> and
320: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
321: tags.
1.42 matthew 322:
1.648 raeburn 323: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 324:
325: inputs: formname, elementname, only, omit
326:
327: formname and elementname indicate the name of the html form and name of
328: the element that the results of the browsing selection are to be placed in.
329:
330: Specifying 'only' will restrict the browser to displaying only files
1.185 www 331: with the given extension. Can be a comma separated list.
1.42 matthew 332:
333: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 334: with the given extension. Can be a comma separated list.
1.42 matthew 335:
1.648 raeburn 336: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 337:
338: Inputs: formname, elementname
339:
340: formname and elementname specify the name of the html form and the name
341: of the element the selection from the search results will be placed in.
1.542 raeburn 342:
1.42 matthew 343: =cut
344:
345: sub browser_and_searcher_javascript {
1.199 albertel 346: my ($mode)=@_;
347: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 348: my $resurl=&escape_single(&lastresurl());
1.42 matthew 349: return <<END;
1.219 albertel 350: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 351: var editbrowser = null;
1.135 albertel 352: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 353: var url = '$resurl/?';
1.42 matthew 354: if (editbrowser == null) {
355: url += 'launch=1&';
356: }
357: url += 'catalogmode=interactive&';
1.199 albertel 358: url += 'mode=$mode&';
1.611 albertel 359: url += 'inhibitmenu=yes&';
1.42 matthew 360: url += 'form=' + formname + '&';
361: if (only != null) {
362: url += 'only=' + only + '&';
1.217 albertel 363: } else {
364: url += 'only=&';
365: }
1.42 matthew 366: if (omit != null) {
367: url += 'omit=' + omit + '&';
1.217 albertel 368: } else {
369: url += 'omit=&';
370: }
1.135 albertel 371: if (titleelement != null) {
372: url += 'titleelement=' + titleelement + '&';
1.217 albertel 373: } else {
374: url += 'titleelement=&';
375: }
1.42 matthew 376: url += 'element=' + elementname + '';
377: var title = 'Browser';
1.435 albertel 378: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 379: options += ',width=700,height=600';
380: editbrowser = open(url,title,options,'1');
381: editbrowser.focus();
382: }
383: var editsearcher;
1.135 albertel 384: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 385: var url = '/adm/searchcat?';
386: if (editsearcher == null) {
387: url += 'launch=1&';
388: }
389: url += 'catalogmode=interactive&';
1.199 albertel 390: url += 'mode=$mode&';
1.42 matthew 391: url += 'form=' + formname + '&';
1.135 albertel 392: if (titleelement != null) {
393: url += 'titleelement=' + titleelement + '&';
1.217 albertel 394: } else {
395: url += 'titleelement=&';
396: }
1.42 matthew 397: url += 'element=' + elementname + '';
398: var title = 'Search';
1.435 albertel 399: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 400: options += ',width=700,height=600';
401: editsearcher = open(url,title,options,'1');
402: editsearcher.focus();
403: }
1.219 albertel 404: // END LON-CAPA Internal -->
1.42 matthew 405: END
1.170 www 406: }
407:
408: sub lastresurl {
1.258 albertel 409: if ($env{'environment.lastresurl'}) {
410: return $env{'environment.lastresurl'}
1.170 www 411: } else {
412: return '/res';
413: }
414: }
415:
416: sub storeresurl {
417: my $resurl=&Apache::lonnet::clutter(shift);
418: unless ($resurl=~/^\/res/) { return 0; }
419: $resurl=~s/\/$//;
420: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 421: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 422: return 1;
1.42 matthew 423: }
424:
1.74 www 425: sub studentbrowser_javascript {
1.111 www 426: unless (
1.258 albertel 427: (($env{'request.course.id'}) &&
1.302 albertel 428: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
429: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
430: '/'.$env{'request.course.sec'})
431: ))
1.258 albertel 432: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 433: ) { return ''; }
1.74 www 434: return (<<'ENDSTDBRW');
1.776 bisitz 435: <script type="text/javascript" language="Javascript">
1.824 bisitz 436: // <![CDATA[
1.74 www 437: var stdeditbrowser;
1.1337 raeburn 438: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74 www 439: var url = '/adm/pickstudent?';
440: var filter;
1.558 albertel 441: if (!ignorefilter) {
442: eval('filter=document.'+formname+'.'+uname+'.value;');
443: }
1.74 www 444: if (filter != null) {
445: if (filter != '') {
446: url += 'filter='+filter+'&';
447: }
448: }
449: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 450: '&udomelement='+udom+
451: '&clicker='+clicker;
1.111 www 452: if (roleflag) { url+="&roles=1"; }
1.1337 raeburn 453: if (courseadv == 'condition') {
454: if (document.getElementById('courseadv')) {
455: courseadv = document.getElementById('courseadv').value;
456: }
457: }
458: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102 www 459: var title = 'Student_Browser';
1.74 www 460: var options = 'scrollbars=1,resizable=1,menubar=0';
461: options += ',width=700,height=600';
462: stdeditbrowser = open(url,title,options,'1');
463: stdeditbrowser.focus();
464: }
1.824 bisitz 465: // ]]>
1.74 www 466: </script>
467: ENDSTDBRW
468: }
1.42 matthew 469:
1.1003 www 470: sub resourcebrowser_javascript {
471: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 472: return (<<'ENDRESBRW');
1.1003 www 473: <script type="text/javascript" language="Javascript">
474: // <![CDATA[
475: var reseditbrowser;
1.1004 www 476: function openresbrowser(formname,reslink) {
1.1005 www 477: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 478: var title = 'Resource_Browser';
479: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 480: options += ',width=700,height=500';
1.1004 www 481: reseditbrowser = open(url,title,options,'1');
482: reseditbrowser.focus();
1.1003 www 483: }
484: // ]]>
485: </script>
1.1004 www 486: ENDRESBRW
1.1003 www 487: }
488:
1.74 www 489: sub selectstudent_link {
1.1337 raeburn 490: my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999 www 491: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
492: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
493: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 494: if ($env{'request.course.id'}) {
1.302 albertel 495: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
496: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
497: '/'.$env{'request.course.sec'})) {
1.111 www 498: return '';
499: }
1.999 www 500: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1337 raeburn 501: if ($courseadv eq 'only') {
502: $callargs .= ",'',1,'$courseadv'";
503: } elsif ($courseadv eq 'none') {
504: $callargs .= ",'','','$courseadv'";
505: } elsif ($courseadv eq 'condition') {
506: $callargs .= ",'','','$courseadv'";
1.793 raeburn 507: }
508: return '<span class="LC_nobreak">'.
509: '<a href="javascript:openstdbrowser('.$callargs.');">'.
510: &mt('Select User').'</a></span>';
1.74 www 511: }
1.258 albertel 512: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 513: $callargs .= ",'',1";
1.793 raeburn 514: return '<span class="LC_nobreak">'.
515: '<a href="javascript:openstdbrowser('.$callargs.');">'.
516: &mt('Select User').'</a></span>';
1.111 www 517: }
518: return '';
1.91 www 519: }
520:
1.1004 www 521: sub selectresource_link {
522: my ($form,$reslink,$arg)=@_;
523:
524: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
525: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
526: unless ($env{'request.course.id'}) { return $arg; }
527: return '<span class="LC_nobreak">'.
528: '<a href="javascript:openresbrowser('.$callargs.');">'.
529: $arg.'</a></span>';
530: }
531:
532:
533:
1.653 raeburn 534: sub authorbrowser_javascript {
535: return <<"ENDAUTHORBRW";
1.776 bisitz 536: <script type="text/javascript" language="JavaScript">
1.824 bisitz 537: // <![CDATA[
1.653 raeburn 538: var stdeditbrowser;
539:
540: function openauthorbrowser(formname,udom) {
541: var url = '/adm/pickauthor?';
542: url += 'form='+formname+'&roledom='+udom;
543: var title = 'Author_Browser';
544: var options = 'scrollbars=1,resizable=1,menubar=0';
545: options += ',width=700,height=600';
546: stdeditbrowser = open(url,title,options,'1');
547: stdeditbrowser.focus();
548: }
549:
1.824 bisitz 550: // ]]>
1.653 raeburn 551: </script>
552: ENDAUTHORBRW
553: }
554:
1.91 www 555: sub coursebrowser_javascript {
1.1116 raeburn 556: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 557: $credits_element,$instcode) = @_;
1.932 raeburn 558: my $wintitle = 'Course_Browser';
1.931 raeburn 559: if ($crstype eq 'Community') {
1.932 raeburn 560: $wintitle = 'Community_Browser';
1.909 raeburn 561: }
1.876 raeburn 562: my $id_functions = &javascript_index_functions();
563: my $output = '
1.776 bisitz 564: <script type="text/javascript" language="JavaScript">
1.824 bisitz 565: // <![CDATA[
1.468 raeburn 566: var stdeditbrowser;'."\n";
1.876 raeburn 567:
568: $output .= <<"ENDSTDBRW";
1.909 raeburn 569: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 570: var url = '/adm/pickcourse?';
1.895 raeburn 571: var formid = getFormIdByName(formname);
1.876 raeburn 572: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 573: if (domainfilter != null) {
574: if (domainfilter != '') {
575: url += 'domainfilter='+domainfilter+'&';
576: }
577: }
1.91 www 578: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 579: '&cdomelement='+udom+
580: '&cnameelement='+desc;
1.468 raeburn 581: if (extra_element !=null && extra_element != '') {
1.594 raeburn 582: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 583: url += '&roleelement='+extra_element;
584: if (domainfilter == null || domainfilter == '') {
585: url += '&domainfilter='+extra_element;
586: }
1.234 raeburn 587: }
1.468 raeburn 588: else {
589: if (formname == 'portform') {
590: url += '&setroles='+extra_element;
1.800 raeburn 591: } else {
592: if (formname == 'rules') {
593: url += '&fixeddom='+extra_element;
594: }
1.468 raeburn 595: }
596: }
1.230 raeburn 597: }
1.909 raeburn 598: if (type != null && type != '') {
599: url += '&type='+type;
600: }
601: if (type_elem != null && type_elem != '') {
602: url += '&typeelement='+type_elem;
603: }
1.872 raeburn 604: if (formname == 'ccrs') {
605: var ownername = document.forms[formid].ccuname.value;
606: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 607: url += '&cloner='+ownername+':'+ownerdom;
608: if (type == 'Course') {
609: url += '&crscode='+document.forms[formid].crscode.value;
610: }
1.1221 raeburn 611: }
612: if (formname == 'requestcrs') {
613: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 614: }
1.293 raeburn 615: if (multflag !=null && multflag != '') {
616: url += '&multiple='+multflag;
617: }
1.909 raeburn 618: var title = '$wintitle';
1.91 www 619: var options = 'scrollbars=1,resizable=1,menubar=0';
620: options += ',width=700,height=600';
621: stdeditbrowser = open(url,title,options,'1');
622: stdeditbrowser.focus();
623: }
1.876 raeburn 624: $id_functions
625: ENDSTDBRW
1.1116 raeburn 626: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
627: $output .= &setsec_javascript($sec_element,$formname,$role_element,
628: $credits_element);
1.876 raeburn 629: }
630: $output .= '
631: // ]]>
632: </script>';
633: return $output;
634: }
635:
636: sub javascript_index_functions {
637: return <<"ENDJS";
638:
639: function getFormIdByName(formname) {
640: for (var i=0;i<document.forms.length;i++) {
641: if (document.forms[i].name == formname) {
642: return i;
643: }
644: }
645: return -1;
646: }
647:
648: function getIndexByName(formid,item) {
649: for (var i=0;i<document.forms[formid].elements.length;i++) {
650: if (document.forms[formid].elements[i].name == item) {
651: return i;
652: }
653: }
654: return -1;
655: }
1.468 raeburn 656:
1.876 raeburn 657: function getDomainFromSelectbox(formname,udom) {
658: var userdom;
659: var formid = getFormIdByName(formname);
660: if (formid > -1) {
661: var domid = getIndexByName(formid,udom);
662: if (domid > -1) {
663: if (document.forms[formid].elements[domid].type == 'select-one') {
664: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
665: }
666: if (document.forms[formid].elements[domid].type == 'hidden') {
667: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 668: }
669: }
670: }
1.876 raeburn 671: return userdom;
672: }
673:
674: ENDJS
1.468 raeburn 675:
1.876 raeburn 676: }
677:
1.1017 raeburn 678: sub javascript_array_indexof {
1.1018 raeburn 679: return <<ENDJS;
1.1017 raeburn 680: <script type="text/javascript" language="JavaScript">
681: // <![CDATA[
682:
683: if (!Array.prototype.indexOf) {
684: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
685: "use strict";
686: if (this === void 0 || this === null) {
687: throw new TypeError();
688: }
689: var t = Object(this);
690: var len = t.length >>> 0;
691: if (len === 0) {
692: return -1;
693: }
694: var n = 0;
695: if (arguments.length > 0) {
696: n = Number(arguments[1]);
1.1088 foxr 697: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 698: n = 0;
699: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
700: n = (n > 0 || -1) * Math.floor(Math.abs(n));
701: }
702: }
703: if (n >= len) {
704: return -1;
705: }
706: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
707: for (; k < len; k++) {
708: if (k in t && t[k] === searchElement) {
709: return k;
710: }
711: }
712: return -1;
713: }
714: }
715:
716: // ]]>
717: </script>
718:
719: ENDJS
720:
721: }
722:
1.876 raeburn 723: sub userbrowser_javascript {
724: my $id_functions = &javascript_index_functions();
725: return <<"ENDUSERBRW";
726:
1.888 raeburn 727: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 728: var url = '/adm/pickuser?';
729: var userdom = getDomainFromSelectbox(formname,udom);
730: if (userdom != null) {
731: if (userdom != '') {
732: url += 'srchdom='+userdom+'&';
733: }
734: }
735: url += 'form=' + formname + '&unameelement='+uname+
736: '&udomelement='+udom+
737: '&ulastelement='+ulast+
738: '&ufirstelement='+ufirst+
739: '&uemailelement='+uemail+
1.881 raeburn 740: '&hideudomelement='+hideudom+
741: '&coursedom='+crsdom;
1.888 raeburn 742: if ((caller != null) && (caller != undefined)) {
743: url += '&caller='+caller;
744: }
1.876 raeburn 745: var title = 'User_Browser';
746: var options = 'scrollbars=1,resizable=1,menubar=0';
747: options += ',width=700,height=600';
748: var stdeditbrowser = open(url,title,options,'1');
749: stdeditbrowser.focus();
750: }
751:
1.888 raeburn 752: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 753: var formid = getFormIdByName(formname);
754: if (formid > -1) {
1.888 raeburn 755: var unameid = getIndexByName(formid,uname);
1.876 raeburn 756: var domid = getIndexByName(formid,udom);
757: var hidedomid = getIndexByName(formid,origdom);
758: if (hidedomid > -1) {
759: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 760: var unameval = document.forms[formid].elements[unameid].value;
761: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
762: if (domid > -1) {
763: var slct = document.forms[formid].elements[domid];
764: if (slct.type == 'select-one') {
765: var i;
766: for (i=0;i<slct.length;i++) {
767: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
768: }
769: }
770: if (slct.type == 'hidden') {
771: slct.value = fixeddom;
1.876 raeburn 772: }
773: }
1.468 raeburn 774: }
775: }
776: }
1.876 raeburn 777: return;
778: }
779:
780: $id_functions
781: ENDUSERBRW
1.468 raeburn 782: }
783:
784: sub setsec_javascript {
1.1116 raeburn 785: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 786: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
787: $communityrolestr);
788: if ($role_element ne '') {
789: my @allroles = ('st','ta','ep','in','ad');
790: foreach my $crstype ('Course','Community') {
791: if ($crstype eq 'Community') {
792: foreach my $role (@allroles) {
793: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
794: }
795: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
796: } else {
797: foreach my $role (@allroles) {
798: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
799: }
800: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
801: }
802: }
803: $rolestr = '"'.join('","',@allroles).'"';
804: $courserolestr = '"'.join('","',@courserolenames).'"';
805: $communityrolestr = '"'.join('","',@communityrolenames).'"';
806: }
1.468 raeburn 807: my $setsections = qq|
808: function setSect(sectionlist) {
1.629 raeburn 809: var sectionsArray = new Array();
810: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
811: sectionsArray = sectionlist.split(",");
812: }
1.468 raeburn 813: var numSections = sectionsArray.length;
814: document.$formname.$sec_element.length = 0;
815: if (numSections == 0) {
816: document.$formname.$sec_element.multiple=false;
817: document.$formname.$sec_element.size=1;
818: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
819: } else {
820: if (numSections == 1) {
821: document.$formname.$sec_element.multiple=false;
822: document.$formname.$sec_element.size=1;
823: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
824: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
825: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
826: } else {
827: for (var i=0; i<numSections; i++) {
828: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
829: }
830: document.$formname.$sec_element.multiple=true
831: if (numSections < 3) {
832: document.$formname.$sec_element.size=numSections;
833: } else {
834: document.$formname.$sec_element.size=3;
835: }
836: document.$formname.$sec_element.options[0].selected = false
837: }
838: }
1.91 www 839: }
1.905 raeburn 840:
841: function setRole(crstype) {
1.468 raeburn 842: |;
1.905 raeburn 843: if ($role_element eq '') {
844: $setsections .= ' return;
845: }
846: ';
847: } else {
848: $setsections .= qq|
849: var elementLength = document.$formname.$role_element.length;
850: var allroles = Array($rolestr);
851: var courserolenames = Array($courserolestr);
852: var communityrolenames = Array($communityrolestr);
853: if (elementLength != undefined) {
854: if (document.$formname.$role_element.options[5].value == 'cc') {
855: if (crstype == 'Course') {
856: return;
857: } else {
858: allroles[5] = 'co';
859: for (var i=0; i<6; i++) {
860: document.$formname.$role_element.options[i].value = allroles[i];
861: document.$formname.$role_element.options[i].text = communityrolenames[i];
862: }
863: }
864: } else {
865: if (crstype == 'Community') {
866: return;
867: } else {
868: allroles[5] = 'cc';
869: for (var i=0; i<6; i++) {
870: document.$formname.$role_element.options[i].value = allroles[i];
871: document.$formname.$role_element.options[i].text = courserolenames[i];
872: }
873: }
874: }
875: }
876: return;
877: }
878: |;
879: }
1.1116 raeburn 880: if ($credits_element) {
881: $setsections .= qq|
882: function setCredits(defaultcredits) {
883: document.$formname.$credits_element.value = defaultcredits;
884: return;
885: }
886: |;
887: }
1.468 raeburn 888: return $setsections;
889: }
890:
1.91 www 891: sub selectcourse_link {
1.909 raeburn 892: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
893: $typeelement) = @_;
894: my $type = $selecttype;
1.871 raeburn 895: my $linktext = &mt('Select Course');
896: if ($selecttype eq 'Community') {
1.909 raeburn 897: $linktext = &mt('Select Community');
1.1239 raeburn 898: } elsif ($selecttype eq 'Placement') {
899: $linktext = &mt('Select Placement Test');
1.906 raeburn 900: } elsif ($selecttype eq 'Course/Community') {
901: $linktext = &mt('Select Course/Community');
1.909 raeburn 902: $type = '';
1.1019 raeburn 903: } elsif ($selecttype eq 'Select') {
904: $linktext = &mt('Select');
905: $type = '';
1.871 raeburn 906: }
1.787 bisitz 907: return '<span class="LC_nobreak">'
908: ."<a href='"
909: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
910: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 911: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 912: ."'>".$linktext.'</a>'
1.787 bisitz 913: .'</span>';
1.74 www 914: }
1.42 matthew 915:
1.653 raeburn 916: sub selectauthor_link {
917: my ($form,$udom)=@_;
918: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
919: &mt('Select Author').'</a>';
920: }
921:
1.876 raeburn 922: sub selectuser_link {
1.881 raeburn 923: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 924: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 925: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 926: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 927: ');">'.$linktext.'</a>';
1.876 raeburn 928: }
929:
1.273 raeburn 930: sub check_uncheck_jscript {
931: my $jscript = <<"ENDSCRT";
932: function checkAll(field) {
933: if (field.length > 0) {
934: for (i = 0; i < field.length; i++) {
1.1093 raeburn 935: if (!field[i].disabled) {
936: field[i].checked = true;
937: }
1.273 raeburn 938: }
939: } else {
1.1093 raeburn 940: if (!field.disabled) {
941: field.checked = true;
942: }
1.273 raeburn 943: }
944: }
945:
946: function uncheckAll(field) {
947: if (field.length > 0) {
948: for (i = 0; i < field.length; i++) {
949: field[i].checked = false ;
1.543 albertel 950: }
951: } else {
1.273 raeburn 952: field.checked = false ;
953: }
954: }
955: ENDSCRT
956: return $jscript;
957: }
958:
1.656 www 959: sub select_timezone {
1.1256 raeburn 960: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
961: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 962: if ($includeempty) {
963: $output .= '<option value=""';
964: if (($selected eq '') || ($selected eq 'local')) {
965: $output .= ' selected="selected" ';
966: }
967: $output .= '> </option>';
968: }
1.657 raeburn 969: my @timezones = DateTime::TimeZone->all_names;
970: foreach my $tzone (@timezones) {
971: $output.= '<option value="'.$tzone.'"';
972: if ($tzone eq $selected) {
973: $output.=' selected="selected"';
974: }
975: $output.=">$tzone</option>\n";
1.656 www 976: }
977: $output.="</select>";
978: return $output;
979: }
1.273 raeburn 980:
1.687 raeburn 981: sub select_datelocale {
1.1256 raeburn 982: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
983: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 984: if ($includeempty) {
985: $output .= '<option value=""';
986: if ($selected eq '') {
987: $output .= ' selected="selected" ';
988: }
989: $output .= '> </option>';
990: }
1.1241 raeburn 991: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 992: my (@possibles,%locale_names);
1.1241 raeburn 993: my @locales = DateTime::Locale->ids();
994: foreach my $id (@locales) {
995: if ($id ne '') {
996: my ($en_terr,$native_terr);
997: my $loc = DateTime::Locale->load($id);
998: if (ref($loc)) {
999: $en_terr = $loc->name();
1000: $native_terr = $loc->native_name();
1.687 raeburn 1001: if (grep(/^en$/,@languages) || !@languages) {
1002: if ($en_terr ne '') {
1003: $locale_names{$id} = '('.$en_terr.')';
1004: } elsif ($native_terr ne '') {
1005: $locale_names{$id} = $native_terr;
1006: }
1007: } else {
1008: if ($native_terr ne '') {
1009: $locale_names{$id} = $native_terr.' ';
1010: } elsif ($en_terr ne '') {
1011: $locale_names{$id} = '('.$en_terr.')';
1012: }
1013: }
1.1220 raeburn 1014: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1015: push(@possibles,$id);
1016: }
1.687 raeburn 1017: }
1018: }
1019: foreach my $item (sort(@possibles)) {
1020: $output.= '<option value="'.$item.'"';
1021: if ($item eq $selected) {
1022: $output.=' selected="selected"';
1023: }
1024: $output.=">$item";
1025: if ($locale_names{$item} ne '') {
1.1220 raeburn 1026: $output.=' '.$locale_names{$item};
1.687 raeburn 1027: }
1028: $output.="</option>\n";
1029: }
1030: $output.="</select>";
1031: return $output;
1032: }
1033:
1.792 raeburn 1034: sub select_language {
1.1256 raeburn 1035: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1036: my %langchoices;
1037: if ($includeempty) {
1.1117 raeburn 1038: %langchoices = ('' => 'No language preference');
1.792 raeburn 1039: }
1040: foreach my $id (&languageids()) {
1041: my $code = &supportedlanguagecode($id);
1042: if ($code) {
1043: $langchoices{$code} = &plainlanguagedescription($id);
1044: }
1045: }
1.1117 raeburn 1046: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256 raeburn 1047: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1048: }
1049:
1.42 matthew 1050: =pod
1.36 matthew 1051:
1.1088 foxr 1052:
1053: =item * &list_languages()
1054:
1055: Returns an array reference that is suitable for use in language prompters.
1056: Each array element is itself a two element array. The first element
1057: is the language code. The second element a descsriptiuon of the
1058: language itself. This is suitable for use in e.g.
1059: &Apache::edit::select_arg (once dereferenced that is).
1060:
1061: =cut
1062:
1063: sub list_languages {
1064: my @lang_choices;
1065:
1066: foreach my $id (&languageids()) {
1067: my $code = &supportedlanguagecode($id);
1068: if ($code) {
1069: my $selector = $supported_codes{$id};
1070: my $description = &plainlanguagedescription($id);
1.1263 raeburn 1071: push(@lang_choices, [$selector, $description]);
1.1088 foxr 1072: }
1073: }
1074: return \@lang_choices;
1075: }
1076:
1077: =pod
1078:
1.648 raeburn 1079: =item * &linked_select_forms(...)
1.36 matthew 1080:
1081: linked_select_forms returns a string containing a <script></script> block
1082: and html for two <select> menus. The select menus will be linked in that
1083: changing the value of the first menu will result in new values being placed
1084: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1085: order unless a defined order is provided.
1.36 matthew 1086:
1087: linked_select_forms takes the following ordered inputs:
1088:
1089: =over 4
1090:
1.112 bowersj2 1091: =item * $formname, the name of the <form> tag
1.36 matthew 1092:
1.112 bowersj2 1093: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1094:
1.112 bowersj2 1095: =item * $firstdefault, the default value for the first menu
1.36 matthew 1096:
1.112 bowersj2 1097: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1098:
1.112 bowersj2 1099: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1100:
1.112 bowersj2 1101: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1102:
1.609 raeburn 1103: =item * $menuorder, the order of values in the first menu
1104:
1.1115 raeburn 1105: =item * $onchangefirst, additional javascript call to execute for an onchange
1106: event for the first <select> tag
1107:
1108: =item * $onchangesecond, additional javascript call to execute for an onchange
1109: event for the second <select> tag
1110:
1.1245 raeburn 1111: =item * $suffix, to differentiate separate uses of select2data javascript
1112: objects in a page.
1113:
1.41 ng 1114: =back
1115:
1.36 matthew 1116: Below is an example of such a hash. Only the 'text', 'default', and
1117: 'select2' keys must appear as stated. keys(%menu) are the possible
1118: values for the first select menu. The text that coincides with the
1.41 ng 1119: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1120: and text for the second menu are given in the hash pointed to by
1121: $menu{$choice1}->{'select2'}.
1122:
1.112 bowersj2 1123: my %menu = ( A1 => { text =>"Choice A1" ,
1124: default => "B3",
1125: select2 => {
1126: B1 => "Choice B1",
1127: B2 => "Choice B2",
1128: B3 => "Choice B3",
1129: B4 => "Choice B4"
1.609 raeburn 1130: },
1131: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1132: },
1133: A2 => { text =>"Choice A2" ,
1134: default => "C2",
1135: select2 => {
1136: C1 => "Choice C1",
1137: C2 => "Choice C2",
1138: C3 => "Choice C3"
1.609 raeburn 1139: },
1140: order => ['C2','C1','C3'],
1.112 bowersj2 1141: },
1142: A3 => { text =>"Choice A3" ,
1143: default => "D6",
1144: select2 => {
1145: D1 => "Choice D1",
1146: D2 => "Choice D2",
1147: D3 => "Choice D3",
1148: D4 => "Choice D4",
1149: D5 => "Choice D5",
1150: D6 => "Choice D6",
1151: D7 => "Choice D7"
1.609 raeburn 1152: },
1153: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1154: }
1155: );
1.36 matthew 1156:
1157: =cut
1158:
1159: sub linked_select_forms {
1160: my ($formname,
1161: $middletext,
1162: $firstdefault,
1163: $firstselectname,
1164: $secondselectname,
1.609 raeburn 1165: $hashref,
1166: $menuorder,
1.1115 raeburn 1167: $onchangefirst,
1.1245 raeburn 1168: $onchangesecond,
1169: $suffix
1.36 matthew 1170: ) = @_;
1171: my $second = "document.$formname.$secondselectname";
1172: my $first = "document.$formname.$firstselectname";
1173: # output the javascript to do the changing
1174: my $result = '';
1.776 bisitz 1175: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1176: $result.="// <![CDATA[\n";
1.1245 raeburn 1177: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1178: $" = '","';
1179: my $debug = '';
1180: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1181: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1182: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1183: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1184: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1185: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1186: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1187: @s2values = @{$hashref->{$s1}->{'order'}};
1188: }
1.36 matthew 1189: $result.="\"@s2values\");\n";
1.1245 raeburn 1190: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1191: my @s2texts;
1192: foreach my $value (@s2values) {
1.1263 raeburn 1193: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1194: }
1195: $result.="\"@s2texts\");\n";
1196: }
1197: $"=' ';
1198: $result.= <<"END";
1199:
1.1245 raeburn 1200: function select1${suffix}_changed() {
1.36 matthew 1201: // Determine new choice
1.1245 raeburn 1202: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1203: // update select2
1.1245 raeburn 1204: var values = select2data${suffix}[newvalue].values;
1205: var texts = select2data${suffix}[newvalue].texts;
1206: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1207: var i;
1208: // out with the old
1.1245 raeburn 1209: $second.options.length = 0;
1210: // in with the new
1.36 matthew 1211: for (i=0;i<values.length; i++) {
1212: $second.options[i] = new Option(values[i]);
1.143 matthew 1213: $second.options[i].value = values[i];
1.36 matthew 1214: $second.options[i].text = texts[i];
1215: if (values[i] == select2def) {
1216: $second.options[i].selected = true;
1217: }
1218: }
1219: }
1.824 bisitz 1220: // ]]>
1.36 matthew 1221: </script>
1222: END
1223: # output the initial values for the selection lists
1.1245 raeburn 1224: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1225: my @order = sort(keys(%{$hashref}));
1226: if (ref($menuorder) eq 'ARRAY') {
1227: @order = @{$menuorder};
1228: }
1229: foreach my $value (@order) {
1.36 matthew 1230: $result.=" <option value=\"$value\" ";
1.253 albertel 1231: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1232: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1233: }
1234: $result .= "</select>\n";
1235: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1236: $result .= $middletext;
1.1115 raeburn 1237: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1238: if ($onchangesecond) {
1239: $result .= ' onchange="'.$onchangesecond.'"';
1240: }
1241: $result .= ">\n";
1.36 matthew 1242: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1243:
1244: my @secondorder = sort(keys(%select2));
1245: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1246: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1247: }
1248: foreach my $value (@secondorder) {
1.36 matthew 1249: $result.=" <option value=\"$value\" ";
1.253 albertel 1250: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1251: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1252: }
1253: $result .= "</select>\n";
1254: # return $debug;
1255: return $result;
1256: } # end of sub linked_select_forms {
1257:
1.45 matthew 1258: =pod
1.44 bowersj2 1259:
1.973 raeburn 1260: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1261:
1.112 bowersj2 1262: Returns a string corresponding to an HTML link to the given help
1263: $topic, where $topic corresponds to the name of a .tex file in
1264: /home/httpd/html/adm/help/tex, with underscores replaced by
1265: spaces.
1266:
1267: $text will optionally be linked to the same topic, allowing you to
1268: link text in addition to the graphic. If you do not want to link
1269: text, but wish to specify one of the later parameters, pass an
1270: empty string.
1271:
1272: $stayOnPage is a value that will be interpreted as a boolean. If true,
1273: the link will not open a new window. If false, the link will open
1274: a new window using Javascript. (Default is false.)
1275:
1276: $width and $height are optional numerical parameters that will
1277: override the width and height of the popped up window, which may
1.973 raeburn 1278: be useful for certain help topics with big pictures included.
1279:
1280: $imgid is the id of the img tag used for the help icon. This may be
1281: used in a javascript call to switch the image src. See
1282: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1283:
1284: =cut
1285:
1286: sub help_open_topic {
1.973 raeburn 1287: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1288: $text = "" if (not defined $text);
1.44 bowersj2 1289: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1290: $width = 500 if (not defined $width);
1.44 bowersj2 1291: $height = 400 if (not defined $height);
1292: my $filename = $topic;
1293: $filename =~ s/ /_/g;
1294:
1.48 bowersj2 1295: my $template = "";
1296: my $link;
1.572 banghart 1297:
1.159 www 1298: $topic=~s/\W/\_/g;
1.44 bowersj2 1299:
1.572 banghart 1300: if (!$stayOnPage) {
1.1033 www 1301: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1302: } elsif ($stayOnPage eq 'popup') {
1303: $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 1304: } else {
1.48 bowersj2 1305: $link = "/adm/help/${filename}.hlp";
1306: }
1307:
1308: # Add the text
1.1314 raeburn 1309: my $target = ' target="_top"';
1310: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1311: $target = '';
1312: }
1.755 neumanie 1313: if ($text ne "") {
1.763 bisitz 1314: $template.='<span class="LC_help_open_topic">'
1.1314 raeburn 1315: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1316: .$text.'</a>';
1.48 bowersj2 1317: }
1318:
1.763 bisitz 1319: # (Always) Add the graphic
1.179 matthew 1320: my $title = &mt('Online Help');
1.667 raeburn 1321: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1322: if ($imgid ne '') {
1323: $imgid = ' id="'.$imgid.'"';
1324: }
1.1314 raeburn 1325: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1326: .'<img src="'.$helpicon.'" border="0"'
1327: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1328: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1329: .' /></a>';
1330: if ($text ne "") {
1331: $template.='</span>';
1332: }
1.44 bowersj2 1333: return $template;
1334:
1.106 bowersj2 1335: }
1336:
1337: # This is a quicky function for Latex cheatsheet editing, since it
1338: # appears in at least four places
1339: sub helpLatexCheatsheet {
1.1037 www 1340: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1341: my $out;
1.106 bowersj2 1342: my $addOther = '';
1.732 raeburn 1343: if ($topic) {
1.1037 www 1344: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1345: }
1346: $out = '<span>' # Start cheatsheet
1347: .$addOther
1348: .'<span>'
1.1037 www 1349: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1350: .'</span> <span>'
1.1037 www 1351: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1352: .'</span>';
1.732 raeburn 1353: unless ($not_author) {
1.1186 kruse 1354: $out .= '<span>'
1355: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1356: .'</span> <span>'
1357: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1358: .'</span>';
1.732 raeburn 1359: }
1.763 bisitz 1360: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1361: return $out;
1.172 www 1362: }
1363:
1.430 albertel 1364: sub general_help {
1365: my $helptopic='Student_Intro';
1366: if ($env{'request.role'}=~/^(ca|au)/) {
1367: $helptopic='Authoring_Intro';
1.907 raeburn 1368: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1369: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1370: } elsif ($env{'request.role'}=~/^dc/) {
1371: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1372: }
1373: return $helptopic;
1374: }
1375:
1376: sub update_help_link {
1377: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1378: my $origurl = $ENV{'REQUEST_URI'};
1379: $origurl=~s|^/~|/priv/|;
1380: my $timestamp = time;
1381: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1382: $$datum = &escape($$datum);
1383: }
1384:
1385: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1386: my $output .= <<"ENDOUTPUT";
1387: <script type="text/javascript">
1.824 bisitz 1388: // <![CDATA[
1.430 albertel 1389: banner_link = '$banner_link';
1.824 bisitz 1390: // ]]>
1.430 albertel 1391: </script>
1392: ENDOUTPUT
1393: return $output;
1394: }
1395:
1396: # now just updates the help link and generates a blue icon
1.193 raeburn 1397: sub help_open_menu {
1.430 albertel 1398: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1399: = @_;
1.949 droeschl 1400: $stayOnPage = 1;
1.430 albertel 1401: my $output;
1402: if ($component_help) {
1403: if (!$text) {
1404: $output=&help_open_topic($component_help,undef,$stayOnPage,
1405: $width,$height);
1406: } else {
1407: my $help_text;
1408: $help_text=&unescape($topic);
1409: $output='<table><tr><td>'.
1410: &help_open_topic($component_help,$help_text,$stayOnPage,
1411: $width,$height).'</td></tr></table>';
1412: }
1413: }
1414: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1415: return $output.$banner_link;
1416: }
1417:
1418: sub top_nav_help {
1419: my ($text) = @_;
1.436 albertel 1420: $text = &mt($text);
1.949 droeschl 1421: my $stay_on_page = 1;
1422:
1.1168 raeburn 1423: my ($link,$banner_link);
1424: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1425: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1426: : "javascript:helpMenu('open')";
1427: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1428: }
1.201 raeburn 1429: my $title = &mt('Get help');
1.1168 raeburn 1430: if ($link) {
1431: return <<"END";
1.436 albertel 1432: $banner_link
1.1159 raeburn 1433: <a href="$link" title="$title">$text</a>
1.436 albertel 1434: END
1.1168 raeburn 1435: } else {
1436: return ' '.$text.' ';
1437: }
1.436 albertel 1438: }
1439:
1440: sub help_menu_js {
1.1154 raeburn 1441: my ($httphost) = @_;
1.949 droeschl 1442: my $stayOnPage = 1;
1.436 albertel 1443: my $width = 620;
1444: my $height = 600;
1.430 albertel 1445: my $helptopic=&general_help();
1.1154 raeburn 1446: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1447: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1448: my $start_page =
1449: &Apache::loncommon::start_page('Help Menu', undef,
1450: {'frameset' => 1,
1451: 'js_ready' => 1,
1.1154 raeburn 1452: 'use_absolute' => $httphost,
1.331 albertel 1453: 'add_entries' => {
1.1168 raeburn 1454: 'border' => '0',
1.579 raeburn 1455: 'rows' => "110,*",},});
1.331 albertel 1456: my $end_page =
1457: &Apache::loncommon::end_page({'frameset' => 1,
1458: 'js_ready' => 1,});
1459:
1.436 albertel 1460: my $template .= <<"ENDTEMPLATE";
1461: <script type="text/javascript">
1.877 bisitz 1462: // <![CDATA[
1.253 albertel 1463: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1464: var banner_link = '';
1.243 raeburn 1465: function helpMenu(target) {
1466: var caller = this;
1467: if (target == 'open') {
1468: var newWindow = null;
1469: try {
1.262 albertel 1470: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1471: }
1472: catch(error) {
1473: writeHelp(caller);
1474: return;
1475: }
1476: if (newWindow) {
1477: caller = newWindow;
1478: }
1.193 raeburn 1479: }
1.243 raeburn 1480: writeHelp(caller);
1481: return;
1482: }
1483: function writeHelp(caller) {
1.1168 raeburn 1484: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1485: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1486: caller.document.close();
1487: caller.focus();
1.193 raeburn 1488: }
1.877 bisitz 1489: // END LON-CAPA Internal -->
1.253 albertel 1490: // ]]>
1.436 albertel 1491: </script>
1.193 raeburn 1492: ENDTEMPLATE
1493: return $template;
1494: }
1495:
1.172 www 1496: sub help_open_bug {
1497: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1498: unless ($env{'user.adv'}) { return ''; }
1.172 www 1499: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1500: $text = "" if (not defined $text);
1501: $stayOnPage=1;
1.184 albertel 1502: $width = 600 if (not defined $width);
1503: $height = 600 if (not defined $height);
1.172 www 1504:
1505: $topic=~s/\W+/\+/g;
1506: my $link='';
1507: my $template='';
1.379 albertel 1508: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1509: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1510: if (!$stayOnPage)
1511: {
1512: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1513: }
1514: else
1515: {
1516: $link = $url;
1517: }
1.1314 raeburn 1518:
1519: my $target = ' target="_top"';
1520: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1521: $target = '';
1522: }
1.172 www 1523: # Add the text
1524: if ($text ne "")
1525: {
1526: $template .=
1527: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1314 raeburn 1528: "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1529: }
1530:
1531: # Add the graphic
1.179 matthew 1532: my $title = &mt('Report a Bug');
1.215 albertel 1533: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1534: $template .= <<"ENDTEMPLATE";
1.1314 raeburn 1535: <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1536: ENDTEMPLATE
1537: if ($text ne '') { $template.='</td></tr></table>' };
1538: return $template;
1539:
1540: }
1541:
1542: sub help_open_faq {
1543: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1544: unless ($env{'user.adv'}) { return ''; }
1.172 www 1545: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1546: $text = "" if (not defined $text);
1547: $stayOnPage=1;
1548: $width = 350 if (not defined $width);
1549: $height = 400 if (not defined $height);
1550:
1551: $topic=~s/\W+/\+/g;
1552: my $link='';
1553: my $template='';
1554: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1555: if (!$stayOnPage)
1556: {
1557: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1558: }
1559: else
1560: {
1561: $link = $url;
1562: }
1563:
1564: # Add the text
1565: if ($text ne "")
1566: {
1567: $template .=
1.173 www 1568: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1569: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1570: }
1571:
1572: # Add the graphic
1.179 matthew 1573: my $title = &mt('View the FAQ');
1.215 albertel 1574: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1575: $template .= <<"ENDTEMPLATE";
1.436 albertel 1576: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1577: ENDTEMPLATE
1578: if ($text ne '') { $template.='</td></tr></table>' };
1579: return $template;
1580:
1.44 bowersj2 1581: }
1.37 matthew 1582:
1.180 matthew 1583: ###############################################################
1584: ###############################################################
1585:
1.45 matthew 1586: =pod
1587:
1.648 raeburn 1588: =item * &change_content_javascript():
1.256 matthew 1589:
1590: This and the next function allow you to create small sections of an
1591: otherwise static HTML page that you can update on the fly with
1592: Javascript, even in Netscape 4.
1593:
1594: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1595: must be written to the HTML page once. It will prove the Javascript
1596: function "change(name, content)". Calling the change function with the
1597: name of the section
1598: you want to update, matching the name passed to C<changable_area>, and
1599: the new content you want to put in there, will put the content into
1600: that area.
1601:
1602: B<Note>: Netscape 4 only reserves enough space for the changable area
1603: to contain room for the original contents. You need to "make space"
1604: for whatever changes you wish to make, and be B<sure> to check your
1605: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1606: it's adequate for updating a one-line status display, but little more.
1607: This script will set the space to 100% width, so you only need to
1608: worry about height in Netscape 4.
1609:
1610: Modern browsers are much less limiting, and if you can commit to the
1611: user not using Netscape 4, this feature may be used freely with
1612: pretty much any HTML.
1613:
1614: =cut
1615:
1616: sub change_content_javascript {
1617: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1618: if ($env{'browser.type'} eq 'netscape' &&
1619: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1620: return (<<NETSCAPE4);
1621: function change(name, content) {
1622: doc = document.layers[name+"___escape"].layers[0].document;
1623: doc.open();
1624: doc.write(content);
1625: doc.close();
1626: }
1627: NETSCAPE4
1628: } else {
1629: # Otherwise, we need to use semi-standards-compliant code
1630: # (technically, "innerHTML" isn't standard but the equivalent
1631: # is really scary, and every useful browser supports it
1632: return (<<DOMBASED);
1633: function change(name, content) {
1634: element = document.getElementById(name);
1635: element.innerHTML = content;
1636: }
1637: DOMBASED
1638: }
1639: }
1640:
1641: =pod
1642:
1.648 raeburn 1643: =item * &changable_area($name,$origContent):
1.256 matthew 1644:
1645: This provides a "changable area" that can be modified on the fly via
1646: the Javascript code provided in C<change_content_javascript>. $name is
1647: the name you will use to reference the area later; do not repeat the
1648: same name on a given HTML page more then once. $origContent is what
1649: the area will originally contain, which can be left blank.
1650:
1651: =cut
1652:
1653: sub changable_area {
1654: my ($name, $origContent) = @_;
1655:
1.258 albertel 1656: if ($env{'browser.type'} eq 'netscape' &&
1657: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1658: # If this is netscape 4, we need to use the Layer tag
1659: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1660: } else {
1661: return "<span id='$name'>$origContent</span>";
1662: }
1663: }
1664:
1665: =pod
1666:
1.648 raeburn 1667: =item * &viewport_geometry_js
1.590 raeburn 1668:
1669: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1670:
1671: =cut
1672:
1673:
1674: sub viewport_geometry_js {
1675: return <<"GEOMETRY";
1676: var Geometry = {};
1677: function init_geometry() {
1678: if (Geometry.init) { return };
1679: Geometry.init=1;
1680: if (window.innerHeight) {
1681: Geometry.getViewportHeight = function() { return window.innerHeight; };
1682: Geometry.getViewportWidth = function() { return window.innerWidth; };
1683: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1684: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1685: }
1686: else if (document.documentElement && document.documentElement.clientHeight) {
1687: Geometry.getViewportHeight =
1688: function() { return document.documentElement.clientHeight; };
1689: Geometry.getViewportWidth =
1690: function() { return document.documentElement.clientWidth; };
1691:
1692: Geometry.getHorizontalScroll =
1693: function() { return document.documentElement.scrollLeft; };
1694: Geometry.getVerticalScroll =
1695: function() { return document.documentElement.scrollTop; };
1696: }
1697: else if (document.body.clientHeight) {
1698: Geometry.getViewportHeight =
1699: function() { return document.body.clientHeight; };
1700: Geometry.getViewportWidth =
1701: function() { return document.body.clientWidth; };
1702: Geometry.getHorizontalScroll =
1703: function() { return document.body.scrollLeft; };
1704: Geometry.getVerticalScroll =
1705: function() { return document.body.scrollTop; };
1706: }
1707: }
1708:
1709: GEOMETRY
1710: }
1711:
1712: =pod
1713:
1.648 raeburn 1714: =item * &viewport_size_js()
1.590 raeburn 1715:
1716: 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.
1717:
1718: =cut
1719:
1720: sub viewport_size_js {
1721: my $geometry = &viewport_geometry_js();
1722: return <<"DIMS";
1723:
1724: $geometry
1725:
1726: function getViewportDims(width,height) {
1727: init_geometry();
1728: width.value = Geometry.getViewportWidth();
1729: height.value = Geometry.getViewportHeight();
1730: return;
1731: }
1732:
1733: DIMS
1734: }
1735:
1736: =pod
1737:
1.648 raeburn 1738: =item * &resize_textarea_js()
1.565 albertel 1739:
1740: emits the needed javascript to resize a textarea to be as big as possible
1741:
1742: creates a function resize_textrea that takes two IDs first should be
1743: the id of the element to resize, second should be the id of a div that
1744: surrounds everything that comes after the textarea, this routine needs
1745: to be attached to the <body> for the onload and onresize events.
1746:
1.648 raeburn 1747: =back
1.565 albertel 1748:
1749: =cut
1750:
1751: sub resize_textarea_js {
1.590 raeburn 1752: my $geometry = &viewport_geometry_js();
1.565 albertel 1753: return <<"RESIZE";
1754: <script type="text/javascript">
1.824 bisitz 1755: // <![CDATA[
1.590 raeburn 1756: $geometry
1.565 albertel 1757:
1.588 albertel 1758: function getX(element) {
1759: var x = 0;
1760: while (element) {
1761: x += element.offsetLeft;
1762: element = element.offsetParent;
1763: }
1764: return x;
1765: }
1766: function getY(element) {
1767: var y = 0;
1768: while (element) {
1769: y += element.offsetTop;
1770: element = element.offsetParent;
1771: }
1772: return y;
1773: }
1774:
1775:
1.565 albertel 1776: function resize_textarea(textarea_id,bottom_id) {
1777: init_geometry();
1778: var textarea = document.getElementById(textarea_id);
1779: //alert(textarea);
1780:
1.588 albertel 1781: var textarea_top = getY(textarea);
1.565 albertel 1782: var textarea_height = textarea.offsetHeight;
1783: var bottom = document.getElementById(bottom_id);
1.588 albertel 1784: var bottom_top = getY(bottom);
1.565 albertel 1785: var bottom_height = bottom.offsetHeight;
1786: var window_height = Geometry.getViewportHeight();
1.588 albertel 1787: var fudge = 23;
1.565 albertel 1788: var new_height = window_height-fudge-textarea_top-bottom_height;
1789: if (new_height < 300) {
1790: new_height = 300;
1791: }
1792: textarea.style.height=new_height+'px';
1793: }
1.824 bisitz 1794: // ]]>
1.565 albertel 1795: </script>
1796: RESIZE
1797:
1798: }
1799:
1.1205 golterma 1800: sub colorfuleditor_js {
1.1248 raeburn 1801: my $browse_or_search;
1802: my $respath;
1803: my ($cnum,$cdom) = &crsauthor_url();
1804: if ($cnum) {
1805: $respath = "/res/$cdom/$cnum/";
1806: my %js_lt = &Apache::lonlocal::texthash(
1807: sunm => 'Sub-directory name',
1808: save => 'Save page to make this permanent',
1809: );
1810: &js_escape(\%js_lt);
1811: $browse_or_search = <<"END";
1812:
1813: function toggleChooser(form,element,titleid,only,search) {
1814: var disp = 'none';
1815: if (document.getElementById('chooser_'+element)) {
1816: var curr = document.getElementById('chooser_'+element).style.display;
1817: if (curr == 'none') {
1818: disp='inline';
1819: if (form.elements['chooser_'+element].length) {
1820: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1821: form.elements['chooser_'+element][i].checked = false;
1822: }
1823: }
1824: toggleResImport(form,element);
1825: }
1826: document.getElementById('chooser_'+element).style.display = disp;
1827: }
1828: }
1829:
1830: function toggleCrsFile(form,element,numdirs) {
1831: if (document.getElementById('chooser_'+element+'_crsres')) {
1832: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1833: if (curr == 'none') {
1834: if (numdirs) {
1835: form.elements['coursepath_'+element].selectedIndex = 0;
1836: if (numdirs > 1) {
1837: window['select1'+element+'_changed']();
1838: }
1839: }
1840: }
1841: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1842:
1843: }
1844: if (document.getElementById('chooser_'+element+'_upload')) {
1845: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1846: if (document.getElementById('uploadcrsres_'+element)) {
1847: document.getElementById('uploadcrsres_'+element).value = '';
1848: }
1849: }
1850: return;
1851: }
1852:
1853: function toggleCrsUpload(form,element,numcrsdirs) {
1854: if (document.getElementById('chooser_'+element+'_crsres')) {
1855: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1856: }
1857: if (document.getElementById('chooser_'+element+'_upload')) {
1858: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1859: if (curr == 'none') {
1860: if (numcrsdirs) {
1861: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1862: form.elements['newsubdir_'+element][0].checked = true;
1863: toggleNewsubdir(form,element);
1864: }
1865: }
1866: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1867: }
1868: return;
1869: }
1870:
1871: function toggleResImport(form,element) {
1872: var choices = new Array('crsres','upload');
1873: for (var i=0; i<choices.length; i++) {
1874: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1875: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1876: }
1877: }
1878: }
1879:
1880: function toggleNewsubdir(form,element) {
1881: var newsub = form.elements['newsubdir_'+element];
1882: if (newsub) {
1883: if (newsub.length) {
1884: for (var j=0; j<newsub.length; j++) {
1885: if (newsub[j].checked) {
1886: if (document.getElementById('newsubdirname_'+element)) {
1887: if (newsub[j].value == '1') {
1888: document.getElementById('newsubdirname_'+element).type = "text";
1889: if (document.getElementById('newsubdir_'+element)) {
1890: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1891: }
1892: } else {
1893: document.getElementById('newsubdirname_'+element).type = "hidden";
1894: document.getElementById('newsubdirname_'+element).value = "";
1895: document.getElementById('newsubdir_'+element).innerHTML = "";
1896: }
1897: }
1898: break;
1899: }
1900: }
1901: }
1902: }
1903: }
1904:
1905: function updateCrsFile(form,element) {
1906: var directory = form.elements['coursepath_'+element];
1907: var filename = form.elements['coursefile_'+element];
1908: var path = directory.options[directory.selectedIndex].value;
1909: var file = filename.options[filename.selectedIndex].value;
1910: form.elements[element].value = '$respath';
1911: if (path == '/') {
1912: form.elements[element].value += file;
1913: } else {
1914: form.elements[element].value += path+'/'+file;
1915: }
1916: unClean();
1917: if (document.getElementById('previewimg_'+element)) {
1918: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1919: var newsrc = document.getElementById('previewimg_'+element).src;
1920: }
1921: if (document.getElementById('showimg_'+element)) {
1922: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1923: }
1924: toggleChooser(form,element);
1925: return;
1926: }
1927:
1928: function uploadDone(suffix,name) {
1929: if (name) {
1930: document.forms["lonhomework"].elements[suffix].value = name;
1931: unClean();
1932: toggleChooser(document.forms["lonhomework"],suffix);
1933: }
1934: }
1935:
1936: \$(document).ready(function(){
1937:
1938: \$(document).delegate('form :submit', 'click', function( event ) {
1939: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1940: var buttonId = this.id;
1941: var suffix = buttonId.toString();
1942: suffix = suffix.replace(/^crsupload_/,'');
1943: event.preventDefault();
1944: document.lonhomework.target = 'crsupload_target_'+suffix;
1945: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1946: \$(this.form).submit();
1947: document.lonhomework.target = '';
1948: if (document.getElementById('crsuploadto_'+suffix)) {
1949: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1950: }
1951: return false;
1952: }
1953: });
1954: });
1955: END
1956: }
1.1205 golterma 1957: return <<"COLORFULEDIT"
1958: <script type="text/javascript">
1959: // <![CDATA[>
1960: function fold_box(curDepth, lastresource){
1961:
1962: // we need a list because there can be several blocks you need to fold in one tag
1963: var block = document.getElementsByName('foldblock_'+curDepth);
1964: // but there is only one folding button per tag
1965: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1966:
1967: if(block.item(0).style.display == 'none'){
1968:
1969: foldbutton.value = '@{[&mt("Hide")]}';
1970: for (i = 0; i < block.length; i++){
1971: block.item(i).style.display = '';
1972: }
1973: }else{
1974:
1975: foldbutton.value = '@{[&mt("Show")]}';
1976: for (i = 0; i < block.length; i++){
1977: // block.item(i).style.visibility = 'collapse';
1978: block.item(i).style.display = 'none';
1979: }
1980: };
1981: saveState(lastresource);
1982: }
1983:
1984: function saveState (lastresource) {
1985:
1986: var tag_list = getTagList();
1987: if(tag_list != null){
1988: var timestamp = new Date().getTime();
1989: var key = lastresource;
1990:
1991: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1992: // starting with timestamp
1993: var value = timestamp+';';
1994:
1995: // building the list of key-value pairs
1996: for(var i = 0; i < tag_list.length; i++){
1997: value += tag_list[i]+',';
1998: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1999: }
2000:
2001: // only iterate whole storage if nothing to override
2002: if(localStorage.getItem(key) == null){
2003:
2004: // prevent storage from growing large
2005: if(localStorage.length > 50){
2006: var regex_getTimestamp = /^(?:\d)+;/;
2007: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
2008: var oldest_key;
2009:
2010: for(var i = 1; i < localStorage.length; i++){
2011: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2012: oldest_key = localStorage.key(i);
2013: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2014: }
2015: }
2016: localStorage.removeItem(oldest_key);
2017: }
2018: }
2019: localStorage.setItem(key,value);
2020: }
2021: }
2022:
2023: // restore folding status of blocks (on page load)
2024: function restoreState (lastresource) {
2025: if(localStorage.getItem(lastresource) != null){
2026: var key = lastresource;
2027: var value = localStorage.getItem(key);
2028: var regex_delTimestamp = /^\d+;/;
2029:
2030: value.replace(regex_delTimestamp, '');
2031:
2032: var valueArr = value.split(';');
2033: var pairs;
2034: var elements;
2035: for (var i = 0; i < valueArr.length; i++){
2036: pairs = valueArr[i].split(',');
2037: elements = document.getElementsByName(pairs[0]);
2038:
2039: for (var j = 0; j < elements.length; j++){
2040: elements[j].style.display = pairs[1];
2041: if (pairs[1] == "none"){
2042: var regex_id = /([_\\d]+)\$/;
2043: regex_id.exec(pairs[0]);
2044: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2045: }
2046: }
2047: }
2048: }
2049: }
2050:
2051: function getTagList () {
2052:
2053: var stringToSearch = document.lonhomework.innerHTML;
2054:
2055: var ret = new Array();
2056: var regex_findBlock = /(foldblock_.*?)"/g;
2057: var tag_list = stringToSearch.match(regex_findBlock);
2058:
2059: if(tag_list != null){
2060: for(var i = 0; i < tag_list.length; i++){
2061: ret.push(tag_list[i].replace(/"/, ''));
2062: }
2063: }
2064: return ret;
2065: }
2066:
2067: function saveScrollPosition (resource) {
2068: var tag_list = getTagList();
2069:
2070: // we dont always want to jump to the first block
2071: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2072: if(\$(window).scrollTop() > 170){
2073: if(tag_list != null){
2074: var result;
2075: for(var i = 0; i < tag_list.length; i++){
2076: if(isElementInViewport(tag_list[i])){
2077: result += tag_list[i]+';';
2078: }
2079: }
2080: sessionStorage.setItem('anchor_'+resource, result);
2081: }
2082: } else {
2083: // we dont need to save zero, just delete the item to leave everything tidy
2084: sessionStorage.removeItem('anchor_'+resource);
2085: }
2086: }
2087:
2088: function restoreScrollPosition(resource){
2089:
2090: var elem = sessionStorage.getItem('anchor_'+resource);
2091: if(elem != null){
2092: var tag_list = elem.split(';');
2093: var elem_list;
2094:
2095: for(var i = 0; i < tag_list.length; i++){
2096: elem_list = document.getElementsByName(tag_list[i]);
2097:
2098: if(elem_list.length > 0){
2099: elem = elem_list[0];
2100: break;
2101: }
2102: }
2103: elem.scrollIntoView();
2104: }
2105: }
2106:
2107: function isElementInViewport(el) {
2108:
2109: // change to last element instead of first
2110: var elem = document.getElementsByName(el);
2111: var rect = elem[0].getBoundingClientRect();
2112:
2113: return (
2114: rect.top >= 0 &&
2115: rect.left >= 0 &&
2116: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2117: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2118: );
2119: }
2120:
2121: function autosize(depth){
2122: var cmInst = window['cm'+depth];
2123: var fitsizeButton = document.getElementById('fitsize'+depth);
2124:
2125: // is fixed size, switching to dynamic
2126: if (sessionStorage.getItem("autosized_"+depth) == null) {
2127: cmInst.setSize("","auto");
2128: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2129: sessionStorage.setItem("autosized_"+depth, "yes");
2130:
2131: // is dynamic size, switching to fixed
2132: } else {
2133: cmInst.setSize("","300px");
2134: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2135: sessionStorage.removeItem("autosized_"+depth);
2136: }
2137: }
2138:
1.1248 raeburn 2139: $browse_or_search
1.1205 golterma 2140:
2141: // ]]>
2142: </script>
2143: COLORFULEDIT
2144: }
2145:
2146: sub xmleditor_js {
2147: return <<XMLEDIT
2148: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2149: <script type="text/javascript">
2150: // <![CDATA[>
2151:
2152: function saveScrollPosition (resource) {
2153:
2154: var scrollPos = \$(window).scrollTop();
2155: sessionStorage.setItem(resource,scrollPos);
2156: }
2157:
2158: function restoreScrollPosition(resource){
2159:
2160: var scrollPos = sessionStorage.getItem(resource);
2161: \$(window).scrollTop(scrollPos);
2162: }
2163:
2164: // unless internet explorer
2165: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2166:
2167: \$(document).ready(function() {
2168: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2169: });
2170: }
2171:
2172: // inserts text at cursor position into codemirror (xml editor only)
2173: function insertText(text){
2174: cm.focus();
2175: var curPos = cm.getCursor();
2176: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2177: }
2178: // ]]>
2179: </script>
2180: XMLEDIT
2181: }
2182:
2183: sub insert_folding_button {
2184: my $curDepth = $Apache::lonxml::curdepth;
2185: my $lastresource = $env{'request.ambiguous'};
2186:
2187: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2188: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2189: }
2190:
1.1248 raeburn 2191: sub crsauthor_url {
2192: my ($url) = @_;
2193: if ($url eq '') {
2194: $url = $ENV{'REQUEST_URI'};
2195: }
2196: my ($cnum,$cdom);
2197: if ($env{'request.course.id'}) {
2198: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2199: if ($audom ne '' && $auname ne '') {
2200: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2201: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2202: $cnum = $auname;
2203: $cdom = $audom;
2204: }
2205: }
2206: }
2207: return ($cnum,$cdom);
2208: }
2209:
2210: sub import_crsauthor_form {
1.1265 raeburn 2211: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2212: return (0) unless ($env{'request.course.id'});
2213: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2214: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2215: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2216: return (0) unless (($cnum ne '') && ($cdom ne ''));
2217: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2218: my @ids=&Apache::lonnet::current_machine_ids();
2219: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2220:
2221: if (grep(/^\Q$crshome\E$/,@ids)) {
2222: $is_home = 1;
2223: }
2224: $relpath = "/priv/$cdom/$cnum";
2225: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2226: my %lt = &Apache::lonlocal::texthash (
2227: fnam => 'Filename',
2228: dire => 'Directory',
2229: );
2230: my $numdirs = scalar(keys(%files));
2231: my (%possexts,$singledir,@singledirfiles);
2232: if ($only) {
2233: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2234: }
2235: my (%nonemptydirs,$possdirs);
2236: if ($numdirs > 1) {
2237: my @order;
2238: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2239: if (ref($files{$key}) eq 'HASH') {
2240: my $shown = $key;
2241: if ($key eq '') {
2242: $shown = '/';
2243: }
2244: my @ordered = ();
2245: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
1.1315 raeburn 2246: next if ($file =~ /\.rights$/);
1.1248 raeburn 2247: if ($only) {
2248: my ($ext) = ($file =~ /\.([^.]+)$/);
2249: unless ($possexts{lc($ext)}) {
2250: next;
2251: }
2252: }
2253: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2254: push(@ordered,$file);
2255: }
2256: if (@ordered) {
2257: push(@order,$key);
2258: $nonemptydirs{$key} = 1;
2259: $selimport_menus{$key}->{'text'} = $shown;
2260: $selimport_menus{$key}->{'default'} = '';
2261: $selimport_menus{$key}->{'select2'}->{''} = '';
2262: $selimport_menus{$key}->{'order'} = \@ordered;
2263: }
2264: }
2265: }
2266: $possdirs = scalar(keys(%nonemptydirs));
2267: if ($possdirs > 1) {
2268: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2269: $output = $lt{'dire'}.
2270: &linked_select_forms($form,'<br />'.
2271: $lt{'fnam'},'',
2272: $firstselectname,$secondselectname,
2273: \%selimport_menus,\@order,
2274: $onchangefirst,'',$suffix).'<br />';
2275: } elsif ($possdirs == 1) {
2276: $singledir = (keys(%nonemptydirs))[0];
2277: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2278: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2279: }
2280: delete($selimport_menus{$singledir});
2281: }
2282: } elsif ($numdirs == 1) {
2283: $singledir = (keys(%files))[0];
2284: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2285: if ($only) {
2286: my ($ext) = ($file =~ /\.([^.]+)$/);
2287: unless ($possexts{lc($ext)}) {
2288: next;
2289: }
1.1315 raeburn 2290: } else {
2291: next if ($file =~ /\.rights$/);
1.1248 raeburn 2292: }
2293: push(@singledirfiles,$file);
2294: }
2295: if (@singledirfiles) {
1.1315 raeburn 2296: $possdirs = 1;
1.1248 raeburn 2297: }
2298: }
2299: if (($possdirs == 1) && (@singledirfiles)) {
2300: my $showdir = $singledir;
2301: if ($singledir eq '') {
2302: $showdir = '/';
2303: }
2304: $output = $lt{'dire'}.
2305: '<select name="'.$firstselectname.'">'.
2306: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2307: '</select><br />'.
2308: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2309: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2310: foreach my $file (@singledirfiles) {
2311: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2312: }
2313: $output .= '</select><br />'."\n";
2314: }
2315: return ($possdirs,$output);
2316: }
2317:
1.565 albertel 2318: =pod
2319:
1.256 matthew 2320: =head1 Excel and CSV file utility routines
2321:
2322: =cut
2323:
2324: ###############################################################
2325: ###############################################################
2326:
2327: =pod
2328:
1.1162 raeburn 2329: =over 4
2330:
1.648 raeburn 2331: =item * &csv_translate($text)
1.37 matthew 2332:
1.185 www 2333: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2334: format.
2335:
2336: =cut
2337:
1.180 matthew 2338: ###############################################################
2339: ###############################################################
1.37 matthew 2340: sub csv_translate {
2341: my $text = shift;
2342: $text =~ s/\"/\"\"/g;
1.209 albertel 2343: $text =~ s/\n/ /g;
1.37 matthew 2344: return $text;
2345: }
1.180 matthew 2346:
2347: ###############################################################
2348: ###############################################################
2349:
2350: =pod
2351:
1.648 raeburn 2352: =item * &define_excel_formats()
1.180 matthew 2353:
2354: Define some commonly used Excel cell formats.
2355:
2356: Currently supported formats:
2357:
2358: =over 4
2359:
2360: =item header
2361:
2362: =item bold
2363:
2364: =item h1
2365:
2366: =item h2
2367:
2368: =item h3
2369:
1.256 matthew 2370: =item h4
2371:
2372: =item i
2373:
1.180 matthew 2374: =item date
2375:
2376: =back
2377:
2378: Inputs: $workbook
2379:
2380: Returns: $format, a hash reference.
2381:
1.1057 foxr 2382:
1.180 matthew 2383: =cut
2384:
2385: ###############################################################
2386: ###############################################################
2387: sub define_excel_formats {
2388: my ($workbook) = @_;
2389: my $format;
2390: $format->{'header'} = $workbook->add_format(bold => 1,
2391: bottom => 1,
2392: align => 'center');
2393: $format->{'bold'} = $workbook->add_format(bold=>1);
2394: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2395: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2396: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2397: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2398: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2399: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2400: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2401: return $format;
2402: }
2403:
2404: ###############################################################
2405: ###############################################################
1.113 bowersj2 2406:
2407: =pod
2408:
1.648 raeburn 2409: =item * &create_workbook()
1.255 matthew 2410:
2411: Create an Excel worksheet. If it fails, output message on the
2412: request object and return undefs.
2413:
2414: Inputs: Apache request object
2415:
2416: Returns (undef) on failure,
2417: Excel worksheet object, scalar with filename, and formats
2418: from &Apache::loncommon::define_excel_formats on success
2419:
2420: =cut
2421:
2422: ###############################################################
2423: ###############################################################
2424: sub create_workbook {
2425: my ($r) = @_;
2426: #
2427: # Create the excel spreadsheet
2428: my $filename = '/prtspool/'.
1.258 albertel 2429: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2430: time.'_'.rand(1000000000).'.xls';
2431: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2432: if (! defined($workbook)) {
2433: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2434: $r->print(
2435: '<p class="LC_error">'
2436: .&mt('Problems occurred in creating the new Excel file.')
2437: .' '.&mt('This error has been logged.')
2438: .' '.&mt('Please alert your LON-CAPA administrator.')
2439: .'</p>'
2440: );
1.255 matthew 2441: return (undef);
2442: }
2443: #
1.1014 foxr 2444: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2445: #
2446: my $format = &Apache::loncommon::define_excel_formats($workbook);
2447: return ($workbook,$filename,$format);
2448: }
2449:
2450: ###############################################################
2451: ###############################################################
2452:
2453: =pod
2454:
1.648 raeburn 2455: =item * &create_text_file()
1.113 bowersj2 2456:
1.542 raeburn 2457: Create a file to write to and eventually make available to the user.
1.256 matthew 2458: If file creation fails, outputs an error message on the request object and
2459: return undefs.
1.113 bowersj2 2460:
1.256 matthew 2461: Inputs: Apache request object, and file suffix
1.113 bowersj2 2462:
1.256 matthew 2463: Returns (undef) on failure,
2464: Filehandle and filename on success.
1.113 bowersj2 2465:
2466: =cut
2467:
1.256 matthew 2468: ###############################################################
2469: ###############################################################
2470: sub create_text_file {
2471: my ($r,$suffix) = @_;
2472: if (! defined($suffix)) { $suffix = 'txt'; };
2473: my $fh;
2474: my $filename = '/prtspool/'.
1.258 albertel 2475: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2476: time.'_'.rand(1000000000).'.'.$suffix;
2477: $fh = Apache::File->new('>/home/httpd'.$filename);
2478: if (! defined($fh)) {
2479: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2480: $r->print(
2481: '<p class="LC_error">'
2482: .&mt('Problems occurred in creating the output file.')
2483: .' '.&mt('This error has been logged.')
2484: .' '.&mt('Please alert your LON-CAPA administrator.')
2485: .'</p>'
2486: );
1.113 bowersj2 2487: }
1.256 matthew 2488: return ($fh,$filename)
1.113 bowersj2 2489: }
2490:
2491:
1.256 matthew 2492: =pod
1.113 bowersj2 2493:
2494: =back
2495:
2496: =cut
1.37 matthew 2497:
2498: ###############################################################
1.33 matthew 2499: ## Home server <option> list generating code ##
2500: ###############################################################
1.35 matthew 2501:
1.169 www 2502: # ------------------------------------------
2503:
2504: sub domain_select {
1.1289 raeburn 2505: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2506: my @possdoms;
2507: if (ref($incdoms) eq 'ARRAY') {
2508: @possdoms = @{$incdoms};
2509: } else {
2510: @possdoms = &Apache::lonnet::all_domains();
2511: }
2512:
1.169 www 2513: my %domains=map {
1.514 albertel 2514: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2515: } @possdoms;
2516:
2517: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2518: foreach my $dom (@{$excdoms}) {
2519: delete($domains{$dom});
2520: }
2521: }
2522:
1.169 www 2523: if ($multiple) {
2524: $domains{''}=&mt('Any domain');
1.550 albertel 2525: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2526: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2527: } else {
1.550 albertel 2528: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2529: return &select_form($name,$value,\%domains);
1.169 www 2530: }
2531: }
2532:
1.282 albertel 2533: #-------------------------------------------
2534:
2535: =pod
2536:
1.519 raeburn 2537: =head1 Routines for form select boxes
2538:
2539: =over 4
2540:
1.648 raeburn 2541: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2542:
2543: Returns a string containing a <select> element int multiple mode
2544:
2545:
2546: Args:
2547: $name - name of the <select> element
1.506 raeburn 2548: $value - scalar or array ref of values that should already be selected
1.282 albertel 2549: $size - number of rows long the select element is
1.283 albertel 2550: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2551: (shown text should already have been &mt())
1.506 raeburn 2552: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2553:
1.282 albertel 2554: =cut
2555:
2556: #-------------------------------------------
1.169 www 2557: sub multiple_select_form {
1.284 albertel 2558: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2559: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2560: my $output='';
1.191 matthew 2561: if (! defined($size)) {
2562: $size = 4;
1.283 albertel 2563: if (scalar(keys(%$hash))<4) {
2564: $size = scalar(keys(%$hash));
1.191 matthew 2565: }
2566: }
1.734 bisitz 2567: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2568: my @order;
1.506 raeburn 2569: if (ref($order) eq 'ARRAY') {
2570: @order = @{$order};
2571: } else {
2572: @order = sort(keys(%$hash));
1.501 banghart 2573: }
2574: if (exists($$hash{'select_form_order'})) {
2575: @order = @{$$hash{'select_form_order'}};
2576: }
2577:
1.284 albertel 2578: foreach my $key (@order) {
1.356 albertel 2579: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2580: $output.='selected="selected" ' if ($selected{$key});
2581: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2582: }
2583: $output.="</select>\n";
2584: return $output;
2585: }
2586:
1.88 www 2587: #-------------------------------------------
2588:
2589: =pod
2590:
1.1254 raeburn 2591: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2592:
2593: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2594: allow a user to select options from a ref to a hash containing:
2595: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2596: a javascript onchange item, e.g., onchange="this.form.submit();".
2597: An optional arg -- $readonly -- if true will cause the select form
2598: to be disabled, e.g., for the case where an instructor has a section-
2599: specific role, and is viewing/modifying parameters.
1.970 raeburn 2600:
1.88 www 2601: See lonrights.pm for an example invocation and use.
2602:
2603: =cut
2604:
2605: #-------------------------------------------
2606: sub select_form {
1.1228 raeburn 2607: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2608: return unless (ref($hashref) eq 'HASH');
2609: if ($onchange) {
2610: $onchange = ' onchange="'.$onchange.'"';
2611: }
1.1228 raeburn 2612: my $disabled;
2613: if ($readonly) {
2614: $disabled = ' disabled="disabled"';
2615: }
2616: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2617: my @keys;
1.970 raeburn 2618: if (exists($hashref->{'select_form_order'})) {
2619: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2620: } else {
1.970 raeburn 2621: @keys=sort(keys(%{$hashref}));
1.128 albertel 2622: }
1.356 albertel 2623: foreach my $key (@keys) {
2624: $selectform.=
2625: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2626: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2627: ">".$hashref->{$key}."</option>\n";
1.88 www 2628: }
2629: $selectform.="</select>";
2630: return $selectform;
2631: }
2632:
1.475 www 2633: # For display filters
2634:
2635: sub display_filter {
1.1074 raeburn 2636: my ($context) = @_;
1.475 www 2637: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2638: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2639: my $phraseinput = 'hidden';
2640: my $includeinput = 'hidden';
2641: my ($checked,$includetypestext);
2642: if ($env{'form.displayfilter'} eq 'containing') {
2643: $phraseinput = 'text';
2644: if ($context eq 'parmslog') {
2645: $includeinput = 'checkbox';
2646: if ($env{'form.includetypes'}) {
2647: $checked = ' checked="checked"';
2648: }
2649: $includetypestext = &mt('Include parameter types');
2650: }
2651: } else {
2652: $includetypestext = ' ';
2653: }
2654: my ($additional,$secondid,$thirdid);
2655: if ($context eq 'parmslog') {
2656: $additional =
2657: '<label><input type="'.$includeinput.'" name="includetypes"'.
2658: $checked.' name="includetypes" value="1" id="includetypes" />'.
2659: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2660: '</label>';
2661: $secondid = 'includetypes';
2662: $thirdid = 'includetypestext';
2663: }
2664: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2665: '$secondid','$thirdid')";
2666: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2667: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2668: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2669: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2670: &mt('Filter: [_1]',
1.477 www 2671: &select_form($env{'form.displayfilter'},
2672: 'displayfilter',
1.970 raeburn 2673: {'currentfolder' => 'Current folder/page',
1.477 www 2674: 'containing' => 'Containing phrase',
1.1074 raeburn 2675: 'none' => 'None'},$onchange)).' '.
2676: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2677: &HTML::Entities::encode($env{'form.containingphrase'}).
2678: '" />'.$additional;
2679: }
2680:
2681: sub display_filter_js {
2682: my $includetext = &mt('Include parameter types');
2683: return <<"ENDJS";
2684:
2685: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2686: var firstType = 'hidden';
2687: if (setter.options[setter.selectedIndex].value == 'containing') {
2688: firstType = 'text';
2689: }
2690: firstObject = document.getElementById(firstid);
2691: if (typeof(firstObject) == 'object') {
2692: if (firstObject.type != firstType) {
2693: changeInputType(firstObject,firstType);
2694: }
2695: }
2696: if (context == 'parmslog') {
2697: var secondType = 'hidden';
2698: if (firstType == 'text') {
2699: secondType = 'checkbox';
2700: }
2701: secondObject = document.getElementById(secondid);
2702: if (typeof(secondObject) == 'object') {
2703: if (secondObject.type != secondType) {
2704: changeInputType(secondObject,secondType);
2705: }
2706: }
2707: var textItem = document.getElementById(thirdid);
2708: var currtext = textItem.innerHTML;
2709: var newtext;
2710: if (firstType == 'text') {
2711: newtext = '$includetext';
2712: } else {
2713: newtext = ' ';
2714: }
2715: if (currtext != newtext) {
2716: textItem.innerHTML = newtext;
2717: }
2718: }
2719: return;
2720: }
2721:
2722: function changeInputType(oldObject,newType) {
2723: var newObject = document.createElement('input');
2724: newObject.type = newType;
2725: if (oldObject.size) {
2726: newObject.size = oldObject.size;
2727: }
2728: if (oldObject.value) {
2729: newObject.value = oldObject.value;
2730: }
2731: if (oldObject.name) {
2732: newObject.name = oldObject.name;
2733: }
2734: if (oldObject.id) {
2735: newObject.id = oldObject.id;
2736: }
2737: oldObject.parentNode.replaceChild(newObject,oldObject);
2738: return;
2739: }
2740:
2741: ENDJS
1.475 www 2742: }
2743:
1.167 www 2744: sub gradeleveldescription {
2745: my $gradelevel=shift;
2746: my %gradelevels=(0 => 'Not specified',
2747: 1 => 'Grade 1',
2748: 2 => 'Grade 2',
2749: 3 => 'Grade 3',
2750: 4 => 'Grade 4',
2751: 5 => 'Grade 5',
2752: 6 => 'Grade 6',
2753: 7 => 'Grade 7',
2754: 8 => 'Grade 8',
2755: 9 => 'Grade 9',
2756: 10 => 'Grade 10',
2757: 11 => 'Grade 11',
2758: 12 => 'Grade 12',
2759: 13 => 'Grade 13',
2760: 14 => '100 Level',
2761: 15 => '200 Level',
2762: 16 => '300 Level',
2763: 17 => '400 Level',
2764: 18 => 'Graduate Level');
2765: return &mt($gradelevels{$gradelevel});
2766: }
2767:
1.163 www 2768: sub select_level_form {
2769: my ($deflevel,$name)=@_;
2770: unless ($deflevel) { $deflevel=0; }
1.167 www 2771: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2772: for (my $i=0; $i<=18; $i++) {
2773: $selectform.="<option value=\"$i\" ".
1.253 albertel 2774: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2775: ">".&gradeleveldescription($i)."</option>\n";
2776: }
2777: $selectform.="</select>";
2778: return $selectform;
1.163 www 2779: }
1.167 www 2780:
1.35 matthew 2781: #-------------------------------------------
2782:
1.45 matthew 2783: =pod
2784:
1.1256 raeburn 2785: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2786:
2787: Returns a string containing a <select name='$name' size='1'> form to
2788: allow a user to select the domain to preform an operation in.
2789: See loncreateuser.pm for an example invocation and use.
2790:
1.90 www 2791: If the $includeempty flag is set, it also includes an empty choice ("no domain
2792: selected");
2793:
1.743 raeburn 2794: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2795:
1.910 raeburn 2796: 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.
2797:
1.1121 raeburn 2798: The optional $incdoms is a reference to an array of domains which will be the only available options.
2799:
2800: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2801:
1.1256 raeburn 2802: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2803:
1.35 matthew 2804: =cut
2805:
2806: #-------------------------------------------
1.34 matthew 2807: sub select_dom_form {
1.1256 raeburn 2808: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2809: if ($onchange) {
1.874 raeburn 2810: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2811: }
1.1256 raeburn 2812: if ($disabled) {
2813: $disabled = ' disabled="disabled"';
2814: }
1.1121 raeburn 2815: my (@domains,%exclude);
1.910 raeburn 2816: if (ref($incdoms) eq 'ARRAY') {
2817: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2818: } else {
2819: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2820: }
1.90 www 2821: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2822: if (ref($excdoms) eq 'ARRAY') {
2823: map { $exclude{$_} = 1; } @{$excdoms};
2824: }
1.1256 raeburn 2825: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2826: foreach my $dom (@domains) {
1.1121 raeburn 2827: next if ($exclude{$dom});
1.356 albertel 2828: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2829: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2830: if ($showdomdesc) {
2831: if ($dom ne '') {
2832: my $domdesc = &Apache::lonnet::domain($dom,'description');
2833: if ($domdesc ne '') {
2834: $selectdomain .= ' ('.$domdesc.')';
2835: }
2836: }
2837: }
2838: $selectdomain .= "</option>\n";
1.34 matthew 2839: }
2840: $selectdomain.="</select>";
2841: return $selectdomain;
2842: }
2843:
1.35 matthew 2844: #-------------------------------------------
2845:
1.45 matthew 2846: =pod
2847:
1.648 raeburn 2848: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2849:
1.586 raeburn 2850: input: 4 arguments (two required, two optional) -
2851: $domain - domain of new user
2852: $name - name of form element
2853: $default - Value of 'default' causes a default item to be first
2854: option, and selected by default.
2855: $hide - Value of 'hide' causes hiding of the name of the server,
2856: if 1 server found, or default, if 0 found.
1.594 raeburn 2857: output: returns 2 items:
1.586 raeburn 2858: (a) form element which contains either:
2859: (i) <select name="$name">
2860: <option value="$hostid1">$hostid $servers{$hostid}</option>
2861: <option value="$hostid2">$hostid $servers{$hostid}</option>
2862: </select>
2863: form item if there are multiple library servers in $domain, or
2864: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2865: if there is only one library server in $domain.
2866:
2867: (b) number of library servers found.
2868:
2869: See loncreateuser.pm for example of use.
1.35 matthew 2870:
2871: =cut
2872:
2873: #-------------------------------------------
1.586 raeburn 2874: sub home_server_form_item {
2875: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2876: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2877: my $result;
2878: my $numlib = keys(%servers);
2879: if ($numlib > 1) {
2880: $result .= '<select name="'.$name.'" />'."\n";
2881: if ($default) {
1.804 bisitz 2882: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2883: '</option>'."\n";
2884: }
2885: foreach my $hostid (sort(keys(%servers))) {
2886: $result.= '<option value="'.$hostid.'">'.
2887: $hostid.' '.$servers{$hostid}."</option>\n";
2888: }
2889: $result .= '</select>'."\n";
2890: } elsif ($numlib == 1) {
2891: my $hostid;
2892: foreach my $item (keys(%servers)) {
2893: $hostid = $item;
2894: }
2895: $result .= '<input type="hidden" name="'.$name.'" value="'.
2896: $hostid.'" />';
2897: if (!$hide) {
2898: $result .= $hostid.' '.$servers{$hostid};
2899: }
2900: $result .= "\n";
2901: } elsif ($default) {
2902: $result .= '<input type="hidden" name="'.$name.
2903: '" value="default" />';
2904: if (!$hide) {
2905: $result .= &mt('default');
2906: }
2907: $result .= "\n";
1.33 matthew 2908: }
1.586 raeburn 2909: return ($result,$numlib);
1.33 matthew 2910: }
1.112 bowersj2 2911:
2912: =pod
2913:
1.534 albertel 2914: =back
2915:
1.112 bowersj2 2916: =cut
1.87 matthew 2917:
2918: ###############################################################
1.112 bowersj2 2919: ## Decoding User Agent ##
1.87 matthew 2920: ###############################################################
2921:
2922: =pod
2923:
1.112 bowersj2 2924: =head1 Decoding the User Agent
2925:
2926: =over 4
2927:
2928: =item * &decode_user_agent()
1.87 matthew 2929:
2930: Inputs: $r
2931:
2932: Outputs:
2933:
2934: =over 4
2935:
1.112 bowersj2 2936: =item * $httpbrowser
1.87 matthew 2937:
1.112 bowersj2 2938: =item * $clientbrowser
1.87 matthew 2939:
1.112 bowersj2 2940: =item * $clientversion
1.87 matthew 2941:
1.112 bowersj2 2942: =item * $clientmathml
1.87 matthew 2943:
1.112 bowersj2 2944: =item * $clientunicode
1.87 matthew 2945:
1.112 bowersj2 2946: =item * $clientos
1.87 matthew 2947:
1.1137 raeburn 2948: =item * $clientmobile
2949:
1.1141 raeburn 2950: =item * $clientinfo
2951:
1.1194 raeburn 2952: =item * $clientosversion
2953:
1.87 matthew 2954: =back
2955:
1.157 matthew 2956: =back
2957:
1.87 matthew 2958: =cut
2959:
2960: ###############################################################
2961: ###############################################################
2962: sub decode_user_agent {
1.247 albertel 2963: my ($r)=@_;
1.87 matthew 2964: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2965: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2966: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2967: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2968: my $clientbrowser='unknown';
2969: my $clientversion='0';
2970: my $clientmathml='';
2971: my $clientunicode='0';
1.1137 raeburn 2972: my $clientmobile=0;
1.1194 raeburn 2973: my $clientosversion='';
1.87 matthew 2974: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2975: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2976: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2977: $clientbrowser=$bname;
2978: $httpbrowser=~/$vreg/i;
2979: $clientversion=$1;
2980: $clientmathml=($clientversion>=$minv);
2981: $clientunicode=($clientversion>=$univ);
2982: }
2983: }
2984: my $clientos='unknown';
1.1141 raeburn 2985: my $clientinfo;
1.87 matthew 2986: if (($httpbrowser=~/linux/i) ||
2987: ($httpbrowser=~/unix/i) ||
2988: ($httpbrowser=~/ux/i) ||
2989: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2990: if (($httpbrowser=~/vax/i) ||
2991: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2992: if ($httpbrowser=~/next/i) { $clientos='next'; }
2993: if (($httpbrowser=~/mac/i) ||
2994: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2995: if ($httpbrowser=~/win/i) {
2996: $clientos='win';
2997: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2998: $clientosversion = $1;
2999: }
3000: }
1.87 matthew 3001: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3002: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3003: $clientmobile=lc($1);
3004: }
1.1141 raeburn 3005: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3006: $clientinfo = 'firefox-'.$1;
3007: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3008: $clientinfo = 'chromeframe-'.$1;
3009: }
1.87 matthew 3010: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3011: $clientunicode,$clientos,$clientmobile,$clientinfo,
3012: $clientosversion);
1.87 matthew 3013: }
3014:
1.32 matthew 3015: ###############################################################
3016: ## Authentication changing form generation subroutines ##
3017: ###############################################################
3018: ##
3019: ## All of the authform_xxxxxxx subroutines take their inputs in a
3020: ## hash, and have reasonable default values.
3021: ##
3022: ## formname = the name given in the <form> tag.
1.35 matthew 3023: #-------------------------------------------
3024:
1.45 matthew 3025: =pod
3026:
1.112 bowersj2 3027: =head1 Authentication Routines
3028:
3029: =over 4
3030:
1.648 raeburn 3031: =item * &authform_xxxxxx()
1.35 matthew 3032:
3033: The authform_xxxxxx subroutines provide javascript and html forms which
3034: handle some of the conveniences required for authentication forms.
3035: This is not an optimal method, but it works.
3036:
3037: =over 4
3038:
1.112 bowersj2 3039: =item * authform_header
1.35 matthew 3040:
1.112 bowersj2 3041: =item * authform_authorwarning
1.35 matthew 3042:
1.112 bowersj2 3043: =item * authform_nochange
1.35 matthew 3044:
1.112 bowersj2 3045: =item * authform_kerberos
1.35 matthew 3046:
1.112 bowersj2 3047: =item * authform_internal
1.35 matthew 3048:
1.112 bowersj2 3049: =item * authform_filesystem
1.35 matthew 3050:
1.1310 raeburn 3051: =item * authform_lti
3052:
1.35 matthew 3053: =back
3054:
1.648 raeburn 3055: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3056:
1.35 matthew 3057: =cut
3058:
3059: #-------------------------------------------
1.32 matthew 3060: sub authform_header{
3061: my %in = (
3062: formname => 'cu',
1.80 albertel 3063: kerb_def_dom => '',
1.32 matthew 3064: @_,
3065: );
3066: $in{'formname'} = 'document.' . $in{'formname'};
3067: my $result='';
1.80 albertel 3068:
3069: #---------------------------------------------- Code for upper case translation
3070: my $Javascript_toUpperCase;
3071: unless ($in{kerb_def_dom}) {
3072: $Javascript_toUpperCase =<<"END";
3073: switch (choice) {
3074: case 'krb': currentform.elements[choicearg].value =
3075: currentform.elements[choicearg].value.toUpperCase();
3076: break;
3077: default:
3078: }
3079: END
3080: } else {
3081: $Javascript_toUpperCase = "";
3082: }
3083:
1.165 raeburn 3084: my $radioval = "'nochange'";
1.591 raeburn 3085: if (defined($in{'curr_authtype'})) {
3086: if ($in{'curr_authtype'} ne '') {
3087: $radioval = "'".$in{'curr_authtype'}."arg'";
3088: }
1.174 matthew 3089: }
1.165 raeburn 3090: my $argfield = 'null';
1.591 raeburn 3091: if (defined($in{'mode'})) {
1.165 raeburn 3092: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3093: if (defined($in{'curr_autharg'})) {
3094: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3095: $argfield = "'$in{'curr_autharg'}'";
3096: }
3097: }
3098: }
3099: }
3100:
1.32 matthew 3101: $result.=<<"END";
3102: var current = new Object();
1.165 raeburn 3103: current.radiovalue = $radioval;
3104: current.argfield = $argfield;
1.32 matthew 3105:
3106: function changed_radio(choice,currentform) {
3107: var choicearg = choice + 'arg';
3108: // If a radio button in changed, we need to change the argfield
3109: if (current.radiovalue != choice) {
3110: current.radiovalue = choice;
3111: if (current.argfield != null) {
3112: currentform.elements[current.argfield].value = '';
3113: }
3114: if (choice == 'nochange') {
3115: current.argfield = null;
3116: } else {
3117: current.argfield = choicearg;
3118: switch(choice) {
3119: case 'krb':
3120: currentform.elements[current.argfield].value =
3121: "$in{'kerb_def_dom'}";
3122: break;
3123: default:
3124: break;
3125: }
3126: }
3127: }
3128: return;
3129: }
1.22 www 3130:
1.32 matthew 3131: function changed_text(choice,currentform) {
3132: var choicearg = choice + 'arg';
3133: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3134: $Javascript_toUpperCase
1.32 matthew 3135: // clear old field
3136: if ((current.argfield != choicearg) && (current.argfield != null)) {
3137: currentform.elements[current.argfield].value = '';
3138: }
3139: current.argfield = choicearg;
3140: }
3141: set_auth_radio_buttons(choice,currentform);
3142: return;
1.20 www 3143: }
1.32 matthew 3144:
3145: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3146: var numauthchoices = currentform.login.length;
3147: if (typeof numauthchoices == "undefined") {
3148: return;
3149: }
1.32 matthew 3150: var i=0;
1.986 raeburn 3151: while (i < numauthchoices) {
1.32 matthew 3152: if (currentform.login[i].value == newvalue) { break; }
3153: i++;
3154: }
1.986 raeburn 3155: if (i == numauthchoices) {
1.32 matthew 3156: return;
3157: }
3158: current.radiovalue = newvalue;
3159: currentform.login[i].checked = true;
3160: return;
3161: }
3162: END
3163: return $result;
3164: }
3165:
1.1106 raeburn 3166: sub authform_authorwarning {
1.32 matthew 3167: my $result='';
1.144 matthew 3168: $result='<i>'.
3169: &mt('As a general rule, only authors or co-authors should be '.
3170: 'filesystem authenticated '.
3171: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3172: return $result;
3173: }
3174:
1.1106 raeburn 3175: sub authform_nochange {
1.32 matthew 3176: my %in = (
3177: formname => 'document.cu',
3178: kerb_def_dom => 'MSU.EDU',
3179: @_,
3180: );
1.1106 raeburn 3181: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3182: my $result;
1.1104 raeburn 3183: if (!$authnum) {
1.1105 raeburn 3184: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3185: } else {
3186: $result = '<label>'.&mt('[_1] Do not change login data',
3187: '<input type="radio" name="login" value="nochange" '.
3188: 'checked="checked" onclick="'.
1.281 albertel 3189: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3190: '</label>';
1.586 raeburn 3191: }
1.32 matthew 3192: return $result;
3193: }
3194:
1.591 raeburn 3195: sub authform_kerberos {
1.32 matthew 3196: my %in = (
3197: formname => 'document.cu',
3198: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3199: kerb_def_auth => 'krb4',
1.32 matthew 3200: @_,
3201: );
1.586 raeburn 3202: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3203: $autharg,$jscall,$disabled);
1.1106 raeburn 3204: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3205: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3206: $check5 = ' checked="checked"';
1.80 albertel 3207: } else {
1.772 bisitz 3208: $check4 = ' checked="checked"';
1.80 albertel 3209: }
1.1259 raeburn 3210: if ($in{'readonly'}) {
3211: $disabled = ' disabled="disabled"';
3212: }
1.165 raeburn 3213: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3214: if (defined($in{'curr_authtype'})) {
3215: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3216: $krbcheck = ' checked="checked"';
1.623 raeburn 3217: if (defined($in{'mode'})) {
3218: if ($in{'mode'} eq 'modifyuser') {
3219: $krbcheck = '';
3220: }
3221: }
1.591 raeburn 3222: if (defined($in{'curr_kerb_ver'})) {
3223: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3224: $check5 = ' checked="checked"';
1.591 raeburn 3225: $check4 = '';
3226: } else {
1.772 bisitz 3227: $check4 = ' checked="checked"';
1.591 raeburn 3228: $check5 = '';
3229: }
1.586 raeburn 3230: }
1.591 raeburn 3231: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3232: $krbarg = $in{'curr_autharg'};
3233: }
1.586 raeburn 3234: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3235: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3236: $result =
3237: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3238: $in{'curr_autharg'},$krbver);
3239: } else {
3240: $result =
3241: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3242: }
3243: return $result;
3244: }
3245: }
3246: } else {
3247: if ($authnum == 1) {
1.784 bisitz 3248: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3249: }
3250: }
1.586 raeburn 3251: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3252: return;
1.587 raeburn 3253: } elsif ($authtype eq '') {
1.591 raeburn 3254: if (defined($in{'mode'})) {
1.587 raeburn 3255: if ($in{'mode'} eq 'modifycourse') {
3256: if ($authnum == 1) {
1.1259 raeburn 3257: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3258: }
3259: }
3260: }
1.586 raeburn 3261: }
3262: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3263: if ($authtype eq '') {
3264: $authtype = '<input type="radio" name="login" value="krb" '.
3265: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3266: $krbcheck.$disabled.' />';
1.586 raeburn 3267: }
3268: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3269: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3270: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3271: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3272: $in{'curr_authtype'} eq 'krb4')) {
3273: $result .= &mt
1.144 matthew 3274: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3275: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3276: '<label>'.$authtype,
1.281 albertel 3277: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3278: 'value="'.$krbarg.'" '.
1.1259 raeburn 3279: 'onchange="'.$jscall.'"'.$disabled.' />',
3280: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3281: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3282: '</label>');
1.586 raeburn 3283: } elsif ($can_assign{'krb4'}) {
3284: $result .= &mt
3285: ('[_1] Kerberos authenticated with domain [_2] '.
3286: '[_3] Version 4 [_4]',
3287: '<label>'.$authtype,
3288: '</label><input type="text" size="10" name="krbarg" '.
3289: 'value="'.$krbarg.'" '.
1.1259 raeburn 3290: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3291: '<label><input type="hidden" name="krbver" value="4" />',
3292: '</label>');
3293: } elsif ($can_assign{'krb5'}) {
3294: $result .= &mt
3295: ('[_1] Kerberos authenticated with domain [_2] '.
3296: '[_3] Version 5 [_4]',
3297: '<label>'.$authtype,
3298: '</label><input type="text" size="10" name="krbarg" '.
3299: 'value="'.$krbarg.'" '.
1.1259 raeburn 3300: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3301: '<label><input type="hidden" name="krbver" value="5" />',
3302: '</label>');
3303: }
1.32 matthew 3304: return $result;
3305: }
3306:
1.1106 raeburn 3307: sub authform_internal {
1.586 raeburn 3308: my %in = (
1.32 matthew 3309: formname => 'document.cu',
3310: kerb_def_dom => 'MSU.EDU',
3311: @_,
3312: );
1.1259 raeburn 3313: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3314: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3315: if ($in{'readonly'}) {
3316: $disabled = ' disabled="disabled"';
3317: }
1.591 raeburn 3318: if (defined($in{'curr_authtype'})) {
3319: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3320: if ($can_assign{'int'}) {
1.772 bisitz 3321: $intcheck = 'checked="checked" ';
1.623 raeburn 3322: if (defined($in{'mode'})) {
3323: if ($in{'mode'} eq 'modifyuser') {
3324: $intcheck = '';
3325: }
3326: }
1.591 raeburn 3327: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3328: $intarg = $in{'curr_autharg'};
3329: }
3330: } else {
3331: $result = &mt('Currently internally authenticated.');
3332: return $result;
1.165 raeburn 3333: }
3334: }
1.586 raeburn 3335: } else {
3336: if ($authnum == 1) {
1.784 bisitz 3337: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3338: }
3339: }
3340: if (!$can_assign{'int'}) {
3341: return;
1.587 raeburn 3342: } elsif ($authtype eq '') {
1.591 raeburn 3343: if (defined($in{'mode'})) {
1.587 raeburn 3344: if ($in{'mode'} eq 'modifycourse') {
3345: if ($authnum == 1) {
1.1259 raeburn 3346: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3347: }
3348: }
3349: }
1.165 raeburn 3350: }
1.586 raeburn 3351: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3352: if ($authtype eq '') {
3353: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3354: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3355: }
1.605 bisitz 3356: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3357: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3358: $result = &mt
1.144 matthew 3359: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3360: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3361: $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 3362: return $result;
3363: }
3364:
1.1104 raeburn 3365: sub authform_local {
1.32 matthew 3366: my %in = (
3367: formname => 'document.cu',
3368: kerb_def_dom => 'MSU.EDU',
3369: @_,
3370: );
1.1259 raeburn 3371: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3372: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3373: if ($in{'readonly'}) {
3374: $disabled = ' disabled="disabled"';
3375: }
1.591 raeburn 3376: if (defined($in{'curr_authtype'})) {
3377: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3378: if ($can_assign{'loc'}) {
1.772 bisitz 3379: $loccheck = 'checked="checked" ';
1.623 raeburn 3380: if (defined($in{'mode'})) {
3381: if ($in{'mode'} eq 'modifyuser') {
3382: $loccheck = '';
3383: }
3384: }
1.591 raeburn 3385: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3386: $locarg = $in{'curr_autharg'};
3387: }
3388: } else {
3389: $result = &mt('Currently using local (institutional) authentication.');
3390: return $result;
1.165 raeburn 3391: }
3392: }
1.586 raeburn 3393: } else {
3394: if ($authnum == 1) {
1.784 bisitz 3395: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3396: }
3397: }
3398: if (!$can_assign{'loc'}) {
3399: return;
1.587 raeburn 3400: } elsif ($authtype eq '') {
1.591 raeburn 3401: if (defined($in{'mode'})) {
1.587 raeburn 3402: if ($in{'mode'} eq 'modifycourse') {
3403: if ($authnum == 1) {
1.1259 raeburn 3404: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3405: }
3406: }
3407: }
1.165 raeburn 3408: }
1.586 raeburn 3409: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3410: if ($authtype eq '') {
3411: $authtype = '<input type="radio" name="login" value="loc" '.
3412: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3413: $jscall.'"'.$disabled.' />';
1.586 raeburn 3414: }
3415: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3416: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3417: $result = &mt('[_1] Local Authentication with argument [_2]',
3418: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3419: return $result;
3420: }
3421:
1.1106 raeburn 3422: sub authform_filesystem {
1.32 matthew 3423: my %in = (
3424: formname => 'document.cu',
3425: kerb_def_dom => 'MSU.EDU',
3426: @_,
3427: );
1.1259 raeburn 3428: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3429: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3430: if ($in{'readonly'}) {
3431: $disabled = ' disabled="disabled"';
3432: }
1.591 raeburn 3433: if (defined($in{'curr_authtype'})) {
3434: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3435: if ($can_assign{'fsys'}) {
1.772 bisitz 3436: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3437: if (defined($in{'mode'})) {
3438: if ($in{'mode'} eq 'modifyuser') {
3439: $fsyscheck = '';
3440: }
3441: }
1.586 raeburn 3442: } else {
3443: $result = &mt('Currently Filesystem Authenticated.');
3444: return $result;
1.1259 raeburn 3445: }
1.586 raeburn 3446: }
3447: } else {
3448: if ($authnum == 1) {
1.784 bisitz 3449: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3450: }
3451: }
3452: if (!$can_assign{'fsys'}) {
3453: return;
1.587 raeburn 3454: } elsif ($authtype eq '') {
1.591 raeburn 3455: if (defined($in{'mode'})) {
1.587 raeburn 3456: if ($in{'mode'} eq 'modifycourse') {
3457: if ($authnum == 1) {
1.1259 raeburn 3458: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3459: }
3460: }
3461: }
1.586 raeburn 3462: }
3463: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3464: if ($authtype eq '') {
3465: $authtype = '<input type="radio" name="login" value="fsys" '.
3466: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3467: $jscall.'"'.$disabled.' />';
1.586 raeburn 3468: }
1.1310 raeburn 3469: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3470: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3471: $result = &mt
1.144 matthew 3472: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3473: '<label>'.$authtype,'</label>'.$autharg);
3474: return $result;
3475: }
3476:
3477: sub authform_lti {
3478: my %in = (
3479: formname => 'document.cu',
3480: kerb_def_dom => 'MSU.EDU',
3481: @_,
3482: );
3483: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3484: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3485: if ($in{'readonly'}) {
3486: $disabled = ' disabled="disabled"';
3487: }
3488: if (defined($in{'curr_authtype'})) {
3489: if ($in{'curr_authtype'} eq 'lti') {
3490: if ($can_assign{'lti'}) {
3491: $lticheck = 'checked="checked" ';
3492: if (defined($in{'mode'})) {
3493: if ($in{'mode'} eq 'modifyuser') {
3494: $lticheck = '';
3495: }
3496: }
3497: } else {
3498: $result = &mt('Currently LTI Authenticated.');
3499: return $result;
3500: }
3501: }
3502: } else {
3503: if ($authnum == 1) {
3504: $authtype = '<input type="hidden" name="login" value="lti" />';
3505: }
3506: }
3507: if (!$can_assign{'lti'}) {
3508: return;
3509: } elsif ($authtype eq '') {
3510: if (defined($in{'mode'})) {
3511: if ($in{'mode'} eq 'modifycourse') {
3512: if ($authnum == 1) {
3513: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3514: }
3515: }
3516: }
3517: }
3518: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3519: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3520: $authtype = '<input type="radio" name="login" value="lti" '.
3521: $lticheck.' onchange="'.$jscall.'" onclick="'.
3522: $jscall.'"'.$disabled.' />';
3523: }
3524: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3525: if ($authtype) {
3526: $result = &mt('[_1] LTI Authenticated',
3527: '<label>'.$authtype.'</label>'.$autharg);
3528: } else {
3529: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3530: $autharg;
3531: }
1.32 matthew 3532: return $result;
3533: }
3534:
1.586 raeburn 3535: sub get_assignable_auth {
3536: my ($dom) = @_;
3537: if ($dom eq '') {
3538: $dom = $env{'request.role.domain'};
3539: }
3540: my %can_assign = (
3541: krb4 => 1,
3542: krb5 => 1,
3543: int => 1,
3544: loc => 1,
1.1310 raeburn 3545: lti => 1,
1.586 raeburn 3546: );
3547: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3548: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3549: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3550: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3551: my $context;
3552: if ($env{'request.role'} =~ /^au/) {
3553: $context = 'author';
1.1259 raeburn 3554: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3555: $context = 'domain';
3556: } elsif ($env{'request.course.id'}) {
3557: $context = 'course';
3558: }
3559: if ($context) {
3560: if (ref($authhash->{$context}) eq 'HASH') {
3561: %can_assign = %{$authhash->{$context}};
3562: }
3563: }
3564: }
3565: }
3566: my $authnum = 0;
3567: foreach my $key (keys(%can_assign)) {
3568: if ($can_assign{$key}) {
3569: $authnum ++;
3570: }
3571: }
3572: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3573: $authnum --;
3574: }
3575: return ($authnum,%can_assign);
3576: }
3577:
1.1331 raeburn 3578: sub check_passwd_rules {
3579: my ($domain,$plainpass) = @_;
3580: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3581: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3582: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3583: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3584: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3585: if ($passwdconf{'min'} > $min) {
3586: $min = $passwdconf{'min'};
3587: }
1.1331 raeburn 3588: }
3589: if ($passwdconf{'max'} =~ /^\d+$/) {
3590: $max = $passwdconf{'max'};
3591: }
3592: @chars = @{$passwdconf{'chars'}};
3593: }
3594: if (($min) && (length($plainpass) < $min)) {
3595: push(@brokerule,'min');
3596: }
3597: if (($max) && (length($plainpass) > $max)) {
3598: push(@brokerule,'max');
3599: }
3600: if (@chars) {
3601: my %rules;
3602: map { $rules{$_} = 1; } @chars;
3603: if ($rules{'uc'}) {
3604: unless ($plainpass =~ /[A-Z]/) {
3605: push(@brokerule,'uc');
3606: }
3607: }
3608: if ($rules{'lc'}) {
1.1332 raeburn 3609: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3610: push(@brokerule,'lc');
3611: }
3612: }
3613: if ($rules{'num'}) {
3614: unless ($plainpass =~ /\d/) {
3615: push(@brokerule,'num');
3616: }
3617: }
3618: if ($rules{'spec'}) {
3619: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3620: push(@brokerule,'spec');
3621: }
3622: }
3623: }
3624: if (@brokerule) {
3625: my %rulenames = &Apache::lonlocal::texthash(
3626: uc => 'At least one upper case letter',
3627: lc => 'At least one lower case letter',
3628: num => 'At least one number',
3629: spec => 'At least one non-alphanumeric',
3630: );
3631: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3632: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3633: $rulenames{'num'} .= ': 0123456789';
3634: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3635: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3636: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3637: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3638: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3639: if (grep(/^$rule$/,@brokerule)) {
3640: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3641: }
3642: }
3643: $warning .= '</ul>';
3644: }
1.1332 raeburn 3645: if (wantarray) {
3646: return @brokerule;
3647: }
1.1331 raeburn 3648: return $warning;
3649: }
3650:
1.80 albertel 3651: ###############################################################
3652: ## Get Kerberos Defaults for Domain ##
3653: ###############################################################
3654: ##
3655: ## Returns default kerberos version and an associated argument
3656: ## as listed in file domain.tab. If not listed, provides
3657: ## appropriate default domain and kerberos version.
3658: ##
3659: #-------------------------------------------
3660:
3661: =pod
3662:
1.648 raeburn 3663: =item * &get_kerberos_defaults()
1.80 albertel 3664:
3665: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3666: version and domain. If not found, it defaults to version 4 and the
3667: domain of the server.
1.80 albertel 3668:
1.648 raeburn 3669: =over 4
3670:
1.80 albertel 3671: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3672:
1.648 raeburn 3673: =back
3674:
3675: =back
3676:
1.80 albertel 3677: =cut
3678:
3679: #-------------------------------------------
3680: sub get_kerberos_defaults {
3681: my $domain=shift;
1.641 raeburn 3682: my ($krbdef,$krbdefdom);
3683: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3684: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3685: $krbdef = $domdefaults{'auth_def'};
3686: $krbdefdom = $domdefaults{'auth_arg_def'};
3687: } else {
1.80 albertel 3688: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3689: my $krbdefdom=$1;
3690: $krbdefdom=~tr/a-z/A-Z/;
3691: $krbdef = "krb4";
3692: }
3693: return ($krbdef,$krbdefdom);
3694: }
1.112 bowersj2 3695:
1.32 matthew 3696:
1.46 matthew 3697: ###############################################################
3698: ## Thesaurus Functions ##
3699: ###############################################################
1.20 www 3700:
1.46 matthew 3701: =pod
1.20 www 3702:
1.112 bowersj2 3703: =head1 Thesaurus Functions
3704:
3705: =over 4
3706:
1.648 raeburn 3707: =item * &initialize_keywords()
1.46 matthew 3708:
3709: Initializes the package variable %Keywords if it is empty. Uses the
3710: package variable $thesaurus_db_file.
3711:
3712: =cut
3713:
3714: ###################################################
3715:
3716: sub initialize_keywords {
3717: return 1 if (scalar keys(%Keywords));
3718: # If we are here, %Keywords is empty, so fill it up
3719: # Make sure the file we need exists...
3720: if (! -e $thesaurus_db_file) {
3721: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3722: " failed because it does not exist");
3723: return 0;
3724: }
3725: # Set up the hash as a database
3726: my %thesaurus_db;
3727: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3728: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3729: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3730: $thesaurus_db_file);
3731: return 0;
3732: }
3733: # Get the average number of appearances of a word.
3734: my $avecount = $thesaurus_db{'average.count'};
3735: # Put keywords (those that appear > average) into %Keywords
3736: while (my ($word,$data)=each (%thesaurus_db)) {
3737: my ($count,undef) = split /:/,$data;
3738: $Keywords{$word}++ if ($count > $avecount);
3739: }
3740: untie %thesaurus_db;
3741: # Remove special values from %Keywords.
1.356 albertel 3742: foreach my $value ('total.count','average.count') {
3743: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3744: }
1.46 matthew 3745: return 1;
3746: }
3747:
3748: ###################################################
3749:
3750: =pod
3751:
1.648 raeburn 3752: =item * &keyword($word)
1.46 matthew 3753:
3754: Returns true if $word is a keyword. A keyword is a word that appears more
3755: than the average number of times in the thesaurus database. Calls
3756: &initialize_keywords
3757:
3758: =cut
3759:
3760: ###################################################
1.20 www 3761:
3762: sub keyword {
1.46 matthew 3763: return if (!&initialize_keywords());
3764: my $word=lc(shift());
3765: $word=~s/\W//g;
3766: return exists($Keywords{$word});
1.20 www 3767: }
1.46 matthew 3768:
3769: ###############################################################
3770:
3771: =pod
1.20 www 3772:
1.648 raeburn 3773: =item * &get_related_words()
1.46 matthew 3774:
1.160 matthew 3775: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3776: an array of words. If the keyword is not in the thesaurus, an empty array
3777: will be returned. The order of the words returned is determined by the
3778: database which holds them.
3779:
3780: Uses global $thesaurus_db_file.
3781:
1.1057 foxr 3782:
1.46 matthew 3783: =cut
3784:
3785: ###############################################################
3786: sub get_related_words {
3787: my $keyword = shift;
3788: my %thesaurus_db;
3789: if (! -e $thesaurus_db_file) {
3790: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3791: "failed because the file does not exist");
3792: return ();
3793: }
3794: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3795: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3796: return ();
3797: }
3798: my @Words=();
1.429 www 3799: my $count=0;
1.46 matthew 3800: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3801: # The first element is the number of times
3802: # the word appears. We do not need it now.
1.429 www 3803: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3804: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3805: my $threshold=$mostfrequentcount/10;
3806: foreach my $possibleword (@RelatedWords) {
3807: my ($word,$wordcount)=split(/\,/,$possibleword);
3808: if ($wordcount>$threshold) {
3809: push(@Words,$word);
3810: $count++;
3811: if ($count>10) { last; }
3812: }
1.20 www 3813: }
3814: }
1.46 matthew 3815: untie %thesaurus_db;
3816: return @Words;
1.14 harris41 3817: }
1.1090 foxr 3818: ###############################################################
3819: #
3820: # Spell checking
3821: #
3822:
3823: =pod
3824:
1.1142 raeburn 3825: =back
3826:
1.1090 foxr 3827: =head1 Spell checking
3828:
3829: =over 4
3830:
3831: =item * &check_spelling($wordlist $language)
3832:
3833: Takes a string containing words and feeds it to an external
3834: spellcheck program via a pipeline. Returns a string containing
3835: them mis-spelled words.
3836:
3837: Parameters:
3838:
3839: =over 4
3840:
3841: =item - $wordlist
3842:
3843: String that will be fed into the spellcheck program.
3844:
3845: =item - $language
3846:
3847: Language string that specifies the language for which the spell
3848: check will be performed.
3849:
3850: =back
3851:
3852: =back
3853:
3854: Note: This sub assumes that aspell is installed.
3855:
3856:
3857: =cut
3858:
1.46 matthew 3859:
1.1090 foxr 3860: sub check_spelling {
3861: my ($wordlist, $language) = @_;
1.1091 foxr 3862: my @misspellings;
3863:
3864: # Generate the speller and set the langauge.
3865: # if explicitly selected:
1.1090 foxr 3866:
1.1091 foxr 3867: my $speller = Text::Aspell->new;
1.1090 foxr 3868: if ($language) {
1.1091 foxr 3869: $speller->set_option('lang', $language);
1.1090 foxr 3870: }
3871:
1.1091 foxr 3872: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3873:
1.1091 foxr 3874: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3875:
1.1091 foxr 3876: foreach my $word (@words) {
3877: if(! $speller->check($word)) {
3878: push(@misspellings, $word);
1.1090 foxr 3879: }
3880: }
1.1091 foxr 3881: return join(' ', @misspellings);
3882:
1.1090 foxr 3883: }
3884:
1.61 www 3885: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3886: =pod
3887:
1.112 bowersj2 3888: =head1 User Name Functions
3889:
3890: =over 4
3891:
1.648 raeburn 3892: =item * &plainname($uname,$udom,$first)
1.81 albertel 3893:
1.112 bowersj2 3894: Takes a users logon name and returns it as a string in
1.226 albertel 3895: "first middle last generation" form
3896: if $first is set to 'lastname' then it returns it as
3897: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3898:
3899: =cut
1.61 www 3900:
1.295 www 3901:
1.81 albertel 3902: ###############################################################
1.61 www 3903: sub plainname {
1.226 albertel 3904: my ($uname,$udom,$first)=@_;
1.537 albertel 3905: return if (!defined($uname) || !defined($udom));
1.295 www 3906: my %names=&getnames($uname,$udom);
1.226 albertel 3907: my $name=&Apache::lonnet::format_name($names{'firstname'},
3908: $names{'middlename'},
3909: $names{'lastname'},
3910: $names{'generation'},$first);
3911: $name=~s/^\s+//;
1.62 www 3912: $name=~s/\s+$//;
3913: $name=~s/\s+/ /g;
1.353 albertel 3914: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3915: return $name;
1.61 www 3916: }
1.66 www 3917:
3918: # -------------------------------------------------------------------- Nickname
1.81 albertel 3919: =pod
3920:
1.648 raeburn 3921: =item * &nickname($uname,$udom)
1.81 albertel 3922:
3923: Gets a users name and returns it as a string as
3924:
3925: ""nickname""
1.66 www 3926:
1.81 albertel 3927: if the user has a nickname or
3928:
3929: "first middle last generation"
3930:
3931: if the user does not
3932:
3933: =cut
1.66 www 3934:
3935: sub nickname {
3936: my ($uname,$udom)=@_;
1.537 albertel 3937: return if (!defined($uname) || !defined($udom));
1.295 www 3938: my %names=&getnames($uname,$udom);
1.68 albertel 3939: my $name=$names{'nickname'};
1.66 www 3940: if ($name) {
3941: $name='"'.$name.'"';
3942: } else {
3943: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3944: $names{'lastname'}.' '.$names{'generation'};
3945: $name=~s/\s+$//;
3946: $name=~s/\s+/ /g;
3947: }
3948: return $name;
3949: }
3950:
1.295 www 3951: sub getnames {
3952: my ($uname,$udom)=@_;
1.537 albertel 3953: return if (!defined($uname) || !defined($udom));
1.433 albertel 3954: if ($udom eq 'public' && $uname eq 'public') {
3955: return ('lastname' => &mt('Public'));
3956: }
1.295 www 3957: my $id=$uname.':'.$udom;
3958: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3959: if ($cached) {
3960: return %{$names};
3961: } else {
3962: my %loadnames=&Apache::lonnet::get('environment',
3963: ['firstname','middlename','lastname','generation','nickname'],
3964: $udom,$uname);
3965: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3966: return %loadnames;
3967: }
3968: }
1.61 www 3969:
1.542 raeburn 3970: # -------------------------------------------------------------------- getemails
1.648 raeburn 3971:
1.542 raeburn 3972: =pod
3973:
1.648 raeburn 3974: =item * &getemails($uname,$udom)
1.542 raeburn 3975:
3976: Gets a user's email information and returns it as a hash with keys:
3977: notification, critnotification, permanentemail
3978:
3979: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3980: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3981:
1.648 raeburn 3982:
1.542 raeburn 3983: =cut
3984:
1.648 raeburn 3985:
1.466 albertel 3986: sub getemails {
3987: my ($uname,$udom)=@_;
3988: if ($udom eq 'public' && $uname eq 'public') {
3989: return;
3990: }
1.467 www 3991: if (!$udom) { $udom=$env{'user.domain'}; }
3992: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3993: my $id=$uname.':'.$udom;
3994: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3995: if ($cached) {
3996: return %{$names};
3997: } else {
3998: my %loadnames=&Apache::lonnet::get('environment',
3999: ['notification','critnotification',
4000: 'permanentemail'],
4001: $udom,$uname);
4002: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4003: return %loadnames;
4004: }
4005: }
4006:
1.551 albertel 4007: sub flush_email_cache {
4008: my ($uname,$udom)=@_;
4009: if (!$udom) { $udom =$env{'user.domain'}; }
4010: if (!$uname) { $uname=$env{'user.name'}; }
4011: return if ($udom eq 'public' && $uname eq 'public');
4012: my $id=$uname.':'.$udom;
4013: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4014: }
4015:
1.728 raeburn 4016: # -------------------------------------------------------------------- getlangs
4017:
4018: =pod
4019:
4020: =item * &getlangs($uname,$udom)
4021:
4022: Gets a user's language preference and returns it as a hash with key:
4023: language.
4024:
4025: =cut
4026:
4027:
4028: sub getlangs {
4029: my ($uname,$udom) = @_;
4030: if (!$udom) { $udom =$env{'user.domain'}; }
4031: if (!$uname) { $uname=$env{'user.name'}; }
4032: my $id=$uname.':'.$udom;
4033: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4034: if ($cached) {
4035: return %{$langs};
4036: } else {
4037: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4038: $udom,$uname);
4039: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4040: return %loadlangs;
4041: }
4042: }
4043:
4044: sub flush_langs_cache {
4045: my ($uname,$udom)=@_;
4046: if (!$udom) { $udom =$env{'user.domain'}; }
4047: if (!$uname) { $uname=$env{'user.name'}; }
4048: return if ($udom eq 'public' && $uname eq 'public');
4049: my $id=$uname.':'.$udom;
4050: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4051: }
4052:
1.61 www 4053: # ------------------------------------------------------------------ Screenname
1.81 albertel 4054:
4055: =pod
4056:
1.648 raeburn 4057: =item * &screenname($uname,$udom)
1.81 albertel 4058:
4059: Gets a users screenname and returns it as a string
4060:
4061: =cut
1.61 www 4062:
4063: sub screenname {
4064: my ($uname,$udom)=@_;
1.258 albertel 4065: if ($uname eq $env{'user.name'} &&
4066: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4067: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4068: return $names{'screenname'};
1.62 www 4069: }
4070:
1.212 albertel 4071:
1.802 bisitz 4072: # ------------------------------------------------------------- Confirm Wrapper
4073: =pod
4074:
1.1142 raeburn 4075: =item * &confirmwrapper($message)
1.802 bisitz 4076:
4077: Wrap messages about completion of operation in box
4078:
4079: =cut
4080:
4081: sub confirmwrapper {
4082: my ($message)=@_;
4083: if ($message) {
4084: return "\n".'<div class="LC_confirm_box">'."\n"
4085: .$message."\n"
4086: .'</div>'."\n";
4087: } else {
4088: return $message;
4089: }
4090: }
4091:
1.62 www 4092: # ------------------------------------------------------------- Message Wrapper
4093:
4094: sub messagewrapper {
1.369 www 4095: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4096: return
1.441 albertel 4097: '<a href="/adm/email?compose=individual&'.
4098: 'recname='.$username.'&recdom='.$domain.
4099: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4100: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4101: }
1.802 bisitz 4102:
1.74 www 4103: # --------------------------------------------------------------- Notes Wrapper
4104:
4105: sub noteswrapper {
4106: my ($link,$un,$do)=@_;
4107: return
1.896 amueller 4108: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4109: }
1.802 bisitz 4110:
1.62 www 4111: # ------------------------------------------------------------- Aboutme Wrapper
4112:
4113: sub aboutmewrapper {
1.1070 raeburn 4114: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4115: if (!defined($username) && !defined($domain)) {
4116: return;
4117: }
1.1096 raeburn 4118: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4119: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4120: }
4121:
4122: # ------------------------------------------------------------ Syllabus Wrapper
4123:
4124: sub syllabuswrapper {
1.707 bisitz 4125: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4126: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4127: }
1.14 harris41 4128:
1.802 bisitz 4129: # -----------------------------------------------------------------------------
4130:
1.208 matthew 4131: sub track_student_link {
1.887 raeburn 4132: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4133: my $link ="/adm/trackstudent?";
1.208 matthew 4134: my $title = 'View recent activity';
4135: if (defined($sname) && $sname !~ /^\s*$/ &&
4136: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4137: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4138: $title .= ' of this student';
1.268 albertel 4139: }
1.208 matthew 4140: if (defined($target) && $target !~ /^\s*$/) {
4141: $target = qq{target="$target"};
4142: } else {
4143: $target = '';
4144: }
1.268 albertel 4145: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4146: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4147: $title = &mt($title);
4148: $linktext = &mt($linktext);
1.448 albertel 4149: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4150: &help_open_topic('View_recent_activity');
1.208 matthew 4151: }
4152:
1.781 raeburn 4153: sub slot_reservations_link {
4154: my ($linktext,$sname,$sdom,$target) = @_;
4155: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4156: my $title = 'View slot reservation history';
4157: if (defined($sname) && $sname !~ /^\s*$/ &&
4158: defined($sdom) && $sdom !~ /^\s*$/) {
4159: $link .= "&uname=$sname&udom=$sdom";
4160: $title .= ' of this student';
4161: }
4162: if (defined($target) && $target !~ /^\s*$/) {
4163: $target = qq{target="$target"};
4164: } else {
4165: $target = '';
4166: }
4167: $title = &mt($title);
4168: $linktext = &mt($linktext);
4169: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4170: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4171:
4172: }
4173:
1.508 www 4174: # ===================================================== Display a student photo
4175:
4176:
1.509 albertel 4177: sub student_image_tag {
1.508 www 4178: my ($domain,$user)=@_;
4179: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4180: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4181: return '<img src="'.$imgsrc.'" align="right" />';
4182: } else {
4183: return '';
4184: }
4185: }
4186:
1.112 bowersj2 4187: =pod
4188:
4189: =back
4190:
4191: =head1 Access .tab File Data
4192:
4193: =over 4
4194:
1.648 raeburn 4195: =item * &languageids()
1.112 bowersj2 4196:
4197: returns list of all language ids
4198:
4199: =cut
4200:
1.14 harris41 4201: sub languageids {
1.16 harris41 4202: return sort(keys(%language));
1.14 harris41 4203: }
4204:
1.112 bowersj2 4205: =pod
4206:
1.648 raeburn 4207: =item * &languagedescription()
1.112 bowersj2 4208:
4209: returns description of a specified language id
4210:
4211: =cut
4212:
1.14 harris41 4213: sub languagedescription {
1.125 www 4214: my $code=shift;
4215: return ($supported_language{$code}?'* ':'').
4216: $language{$code}.
1.126 www 4217: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4218: }
4219:
1.1048 foxr 4220: =pod
4221:
4222: =item * &plainlanguagedescription
4223:
4224: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4225: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4226:
4227: =cut
4228:
1.145 www 4229: sub plainlanguagedescription {
4230: my $code=shift;
4231: return $language{$code};
4232: }
4233:
1.1048 foxr 4234: =pod
4235:
4236: =item * &supportedlanguagecode
4237:
4238: Returns the supported language code (e.g. sptutf maps to pt) given a language
4239: code.
4240:
4241: =cut
4242:
1.145 www 4243: sub supportedlanguagecode {
4244: my $code=shift;
4245: return $supported_language{$code};
1.97 www 4246: }
4247:
1.112 bowersj2 4248: =pod
4249:
1.1048 foxr 4250: =item * &latexlanguage()
4251:
4252: Given a language key code returns the correspondnig language to use
4253: to select the correct hyphenation on LaTeX printouts. This is undef if there
4254: is no supported hyphenation for the language code.
4255:
4256: =cut
4257:
4258: sub latexlanguage {
4259: my $code = shift;
4260: return $latex_language{$code};
4261: }
4262:
4263: =pod
4264:
4265: =item * &latexhyphenation()
4266:
4267: Same as above but what's supplied is the language as it might be stored
4268: in the metadata.
4269:
4270: =cut
4271:
4272: sub latexhyphenation {
4273: my $key = shift;
4274: return $latex_language_bykey{$key};
4275: }
4276:
4277: =pod
4278:
1.648 raeburn 4279: =item * ©rightids()
1.112 bowersj2 4280:
4281: returns list of all copyrights
4282:
4283: =cut
4284:
4285: sub copyrightids {
4286: return sort(keys(%cprtag));
4287: }
4288:
4289: =pod
4290:
1.648 raeburn 4291: =item * ©rightdescription()
1.112 bowersj2 4292:
4293: returns description of a specified copyright id
4294:
4295: =cut
4296:
4297: sub copyrightdescription {
1.166 www 4298: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4299: }
1.197 matthew 4300:
4301: =pod
4302:
1.648 raeburn 4303: =item * &source_copyrightids()
1.192 taceyjo1 4304:
4305: returns list of all source copyrights
4306:
4307: =cut
4308:
4309: sub source_copyrightids {
4310: return sort(keys(%scprtag));
4311: }
4312:
4313: =pod
4314:
1.648 raeburn 4315: =item * &source_copyrightdescription()
1.192 taceyjo1 4316:
4317: returns description of a specified source copyright id
4318:
4319: =cut
4320:
4321: sub source_copyrightdescription {
4322: return &mt($scprtag{shift(@_)});
4323: }
1.112 bowersj2 4324:
4325: =pod
4326:
1.648 raeburn 4327: =item * &filecategories()
1.112 bowersj2 4328:
4329: returns list of all file categories
4330:
4331: =cut
4332:
4333: sub filecategories {
4334: return sort(keys(%category_extensions));
4335: }
4336:
4337: =pod
4338:
1.648 raeburn 4339: =item * &filecategorytypes()
1.112 bowersj2 4340:
4341: returns list of file types belonging to a given file
4342: category
4343:
4344: =cut
4345:
4346: sub filecategorytypes {
1.356 albertel 4347: my ($cat) = @_;
1.1248 raeburn 4348: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4349: return @{$category_extensions{lc($cat)}};
4350: } else {
4351: return ();
4352: }
1.112 bowersj2 4353: }
4354:
4355: =pod
4356:
1.648 raeburn 4357: =item * &fileembstyle()
1.112 bowersj2 4358:
4359: returns embedding style for a specified file type
4360:
4361: =cut
4362:
4363: sub fileembstyle {
4364: return $fe{lc(shift(@_))};
1.169 www 4365: }
4366:
1.351 www 4367: sub filemimetype {
4368: return $fm{lc(shift(@_))};
4369: }
4370:
1.169 www 4371:
4372: sub filecategoryselect {
4373: my ($name,$value)=@_;
1.189 matthew 4374: return &select_form($value,$name,
1.970 raeburn 4375: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4376: }
4377:
4378: =pod
4379:
1.648 raeburn 4380: =item * &filedescription()
1.112 bowersj2 4381:
4382: returns description for a specified file type
4383:
4384: =cut
4385:
4386: sub filedescription {
1.188 matthew 4387: my $file_description = $fd{lc(shift())};
4388: $file_description =~ s:([\[\]]):~$1:g;
4389: return &mt($file_description);
1.112 bowersj2 4390: }
4391:
4392: =pod
4393:
1.648 raeburn 4394: =item * &filedescriptionex()
1.112 bowersj2 4395:
4396: returns description for a specified file type with
4397: extra formatting
4398:
4399: =cut
4400:
4401: sub filedescriptionex {
4402: my $ex=shift;
1.188 matthew 4403: my $file_description = $fd{lc($ex)};
4404: $file_description =~ s:([\[\]]):~$1:g;
4405: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4406: }
4407:
4408: # End of .tab access
4409: =pod
4410:
4411: =back
4412:
4413: =cut
4414:
4415: # ------------------------------------------------------------------ File Types
4416: sub fileextensions {
4417: return sort(keys(%fe));
4418: }
4419:
1.97 www 4420: # ----------------------------------------------------------- Display Languages
4421: # returns a hash with all desired display languages
4422: #
4423:
4424: sub display_languages {
4425: my %languages=();
1.695 raeburn 4426: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4427: $languages{$lang}=1;
1.97 www 4428: }
4429: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4430: if ($env{'form.displaylanguage'}) {
1.356 albertel 4431: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4432: $languages{$lang}=1;
1.97 www 4433: }
4434: }
4435: return %languages;
1.14 harris41 4436: }
4437:
1.582 albertel 4438: sub languages {
4439: my ($possible_langs) = @_;
1.695 raeburn 4440: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4441: if (!ref($possible_langs)) {
4442: if( wantarray ) {
4443: return @preferred_langs;
4444: } else {
4445: return $preferred_langs[0];
4446: }
4447: }
4448: my %possibilities = map { $_ => 1 } (@$possible_langs);
4449: my @preferred_possibilities;
4450: foreach my $preferred_lang (@preferred_langs) {
4451: if (exists($possibilities{$preferred_lang})) {
4452: push(@preferred_possibilities, $preferred_lang);
4453: }
4454: }
4455: if( wantarray ) {
4456: return @preferred_possibilities;
4457: }
4458: return $preferred_possibilities[0];
4459: }
4460:
1.742 raeburn 4461: sub user_lang {
4462: my ($touname,$toudom,$fromcid) = @_;
4463: my @userlangs;
4464: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4465: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4466: $env{'course.'.$fromcid.'.languages'}));
4467: } else {
4468: my %langhash = &getlangs($touname,$toudom);
4469: if ($langhash{'languages'} ne '') {
4470: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4471: } else {
4472: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4473: if ($domdefs{'lang_def'} ne '') {
4474: @userlangs = ($domdefs{'lang_def'});
4475: }
4476: }
4477: }
4478: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4479: my $user_lh = Apache::localize->get_handle(@languages);
4480: return $user_lh;
4481: }
4482:
4483:
1.112 bowersj2 4484: ###############################################################
4485: ## Student Answer Attempts ##
4486: ###############################################################
4487:
4488: =pod
4489:
4490: =head1 Alternate Problem Views
4491:
4492: =over 4
4493:
1.648 raeburn 4494: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4495: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4496:
4497: Return string with previous attempt on problem. Arguments:
4498:
4499: =over 4
4500:
4501: =item * $symb: Problem, including path
4502:
4503: =item * $username: username of the desired student
4504:
4505: =item * $domain: domain of the desired student
1.14 harris41 4506:
1.112 bowersj2 4507: =item * $course: Course ID
1.14 harris41 4508:
1.112 bowersj2 4509: =item * $getattempt: Leave blank for all attempts, otherwise put
4510: something
1.14 harris41 4511:
1.112 bowersj2 4512: =item * $regexp: if string matches this regexp, the string will be
4513: sent to $gradesub
1.14 harris41 4514:
1.112 bowersj2 4515: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4516:
1.1199 raeburn 4517: =item * $usec: section of the desired student
4518:
4519: =item * $identifier: counter for student (multiple students one problem) or
4520: problem (one student; whole sequence).
4521:
1.112 bowersj2 4522: =back
1.14 harris41 4523:
1.112 bowersj2 4524: The output string is a table containing all desired attempts, if any.
1.16 harris41 4525:
1.112 bowersj2 4526: =cut
1.1 albertel 4527:
4528: sub get_previous_attempt {
1.1199 raeburn 4529: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4530: my $prevattempts='';
1.43 ng 4531: no strict 'refs';
1.1 albertel 4532: if ($symb) {
1.3 albertel 4533: my (%returnhash)=
4534: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4535: if ($returnhash{'version'}) {
4536: my %lasthash=();
4537: my $version;
4538: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4539: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4540: if ($key =~ /\.rawrndseed$/) {
4541: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4542: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4543: } else {
4544: $lasthash{$key}=$returnhash{$version.':'.$key};
4545: }
1.19 harris41 4546: }
1.1 albertel 4547: }
1.596 albertel 4548: $prevattempts=&start_data_table().&start_data_table_header_row();
4549: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4550: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4551: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4552: foreach my $key (sort(keys(%lasthash))) {
4553: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4554: if ($#parts > 0) {
1.31 albertel 4555: my $data=$parts[-1];
1.989 raeburn 4556: next if ($data eq 'foilorder');
1.31 albertel 4557: pop(@parts);
1.1010 www 4558: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4559: if ($data eq 'type') {
4560: unless ($showsurv) {
4561: my $id = join(',',@parts);
4562: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4563: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4564: $lasthidden{$ign.'.'.$id} = 1;
4565: }
1.945 raeburn 4566: }
1.1199 raeburn 4567: if ($identifier ne '') {
4568: my $id = join(',',@parts);
4569: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4570: $domain,$username,$usec,undef,$course) =~ /^no/) {
4571: $hidestatus{$ign.'.'.$id} = 1;
4572: }
4573: }
4574: } elsif ($data eq 'regrader') {
4575: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4576: my $id = join(',',@parts);
4577: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4578: }
1.1010 www 4579: }
1.31 albertel 4580: } else {
1.41 ng 4581: if ($#parts == 0) {
4582: $prevattempts.='<th>'.$parts[0].'</th>';
4583: } else {
4584: $prevattempts.='<th>'.$ign.'</th>';
4585: }
1.31 albertel 4586: }
1.16 harris41 4587: }
1.596 albertel 4588: $prevattempts.=&end_data_table_header_row();
1.40 ng 4589: if ($getattempt eq '') {
1.1199 raeburn 4590: my (%solved,%resets,%probstatus);
1.1200 raeburn 4591: if (($identifier ne '') && (keys(%regraded) > 0)) {
4592: for ($version=1;$version<=$returnhash{'version'};$version++) {
4593: foreach my $id (keys(%regraded)) {
4594: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4595: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4596: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4597: push(@{$resets{$id}},$version);
1.1199 raeburn 4598: }
4599: }
4600: }
1.1200 raeburn 4601: }
4602: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4603: my (@hidden,@unsolved);
1.945 raeburn 4604: if (%typeparts) {
4605: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4606: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4607: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4608: push(@hidden,$id);
1.1199 raeburn 4609: } elsif ($identifier ne '') {
4610: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4611: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4612: ($hidestatus{$id})) {
1.1200 raeburn 4613: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4614: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4615: push(@{$solved{$id}},$version);
4616: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4617: (ref($solved{$id}) eq 'ARRAY')) {
4618: my $skip;
4619: if (ref($resets{$id}) eq 'ARRAY') {
4620: foreach my $reset (@{$resets{$id}}) {
4621: if ($reset > $solved{$id}[-1]) {
4622: $skip=1;
4623: last;
4624: }
4625: }
4626: }
4627: unless ($skip) {
4628: my ($ign,$partslist) = split(/\./,$id,2);
4629: push(@unsolved,$partslist);
4630: }
4631: }
4632: }
1.945 raeburn 4633: }
4634: }
4635: }
4636: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4637: '<td>'.&mt('Transaction [_1]',$version);
4638: if (@unsolved) {
4639: $prevattempts .= '<span class="LC_nobreak"><label>'.
4640: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4641: &mt('Hide').'</label></span>';
4642: }
4643: $prevattempts .= '</td>';
1.945 raeburn 4644: if (@hidden) {
4645: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4646: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4647: my $hide;
4648: foreach my $id (@hidden) {
4649: if ($key =~ /^\Q$id\E/) {
4650: $hide = 1;
4651: last;
4652: }
4653: }
4654: if ($hide) {
4655: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4656: if (($data eq 'award') || ($data eq 'awarddetail')) {
4657: my $value = &format_previous_attempt_value($key,
4658: $returnhash{$version.':'.$key});
1.1173 kruse 4659: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4660: } else {
4661: $prevattempts.='<td> </td>';
4662: }
4663: } else {
4664: if ($key =~ /\./) {
1.1212 raeburn 4665: my $value = $returnhash{$version.':'.$key};
4666: if ($key =~ /\.rndseed$/) {
4667: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4668: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4669: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4670: }
4671: }
4672: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4673: ' </td>';
1.945 raeburn 4674: } else {
4675: $prevattempts.='<td> </td>';
4676: }
4677: }
4678: }
4679: } else {
4680: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4681: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4682: my $value = $returnhash{$version.':'.$key};
4683: if ($key =~ /\.rndseed$/) {
4684: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4685: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4686: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4687: }
4688: }
4689: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4690: ' </td>';
1.945 raeburn 4691: }
4692: }
4693: $prevattempts.=&end_data_table_row();
1.40 ng 4694: }
1.1 albertel 4695: }
1.945 raeburn 4696: my @currhidden = keys(%lasthidden);
1.596 albertel 4697: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4698: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4699: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4700: if (%typeparts) {
4701: my $hidden;
4702: foreach my $id (@currhidden) {
4703: if ($key =~ /^\Q$id\E/) {
4704: $hidden = 1;
4705: last;
4706: }
4707: }
4708: if ($hidden) {
4709: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4710: if (($data eq 'award') || ($data eq 'awarddetail')) {
4711: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4712: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4713: $value = &$gradesub($value);
4714: }
1.1173 kruse 4715: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4716: } else {
4717: $prevattempts.='<td> </td>';
4718: }
4719: } else {
4720: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4721: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4722: $value = &$gradesub($value);
4723: }
1.1173 kruse 4724: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4725: }
4726: } else {
4727: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4728: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4729: $value = &$gradesub($value);
4730: }
1.1173 kruse 4731: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4732: }
1.16 harris41 4733: }
1.596 albertel 4734: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4735: } else {
1.1305 raeburn 4736: my $msg;
4737: if ($symb =~ /ext\.tool$/) {
4738: $msg = &mt('No grade passed back.');
4739: } else {
4740: $msg = &mt('Nothing submitted - no attempts.');
4741: }
1.596 albertel 4742: $prevattempts=
4743: &start_data_table().&start_data_table_row().
1.1305 raeburn 4744: '<td>'.$msg.'</td>'.
1.596 albertel 4745: &end_data_table_row().&end_data_table();
1.1 albertel 4746: }
4747: } else {
1.596 albertel 4748: $prevattempts=
4749: &start_data_table().&start_data_table_row().
4750: '<td>'.&mt('No data.').'</td>'.
4751: &end_data_table_row().&end_data_table();
1.1 albertel 4752: }
1.10 albertel 4753: }
4754:
1.581 albertel 4755: sub format_previous_attempt_value {
4756: my ($key,$value) = @_;
1.1011 www 4757: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4758: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4759: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4760: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4761: } elsif ($key =~ /answerstring$/) {
4762: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4763: my @answer = %answers;
4764: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4765: my @anskeys = sort(keys(%answers));
4766: if (@anskeys == 1) {
4767: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4768: if ($answer =~ m{\0}) {
4769: $answer =~ s{\0}{,}g;
1.988 raeburn 4770: }
4771: my $tag_internal_answer_name = 'INTERNAL';
4772: if ($anskeys[0] eq $tag_internal_answer_name) {
4773: $value = $answer;
4774: } else {
4775: $value = $anskeys[0].'='.$answer;
4776: }
4777: } else {
4778: foreach my $ans (@anskeys) {
4779: my $answer = $answers{$ans};
1.1001 raeburn 4780: if ($answer =~ m{\0}) {
4781: $answer =~ s{\0}{,}g;
1.988 raeburn 4782: }
4783: $value .= $ans.'='.$answer.'<br />';;
4784: }
4785: }
1.581 albertel 4786: } else {
1.1173 kruse 4787: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4788: }
4789: return $value;
4790: }
4791:
4792:
1.107 albertel 4793: sub relative_to_absolute {
4794: my ($url,$output)=@_;
4795: my $parser=HTML::TokeParser->new(\$output);
4796: my $token;
4797: my $thisdir=$url;
4798: my @rlinks=();
4799: while ($token=$parser->get_token) {
4800: if ($token->[0] eq 'S') {
4801: if ($token->[1] eq 'a') {
4802: if ($token->[2]->{'href'}) {
4803: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4804: }
4805: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4806: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4807: } elsif ($token->[1] eq 'base') {
4808: $thisdir=$token->[2]->{'href'};
4809: }
4810: }
4811: }
4812: $thisdir=~s-/[^/]*$--;
1.356 albertel 4813: foreach my $link (@rlinks) {
1.726 raeburn 4814: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4815: ($link=~/^\//) ||
4816: ($link=~/^javascript:/i) ||
4817: ($link=~/^mailto:/i) ||
4818: ($link=~/^\#/)) {
4819: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4820: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4821: }
4822: }
4823: # -------------------------------------------------- Deal with Applet codebases
4824: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4825: return $output;
4826: }
4827:
1.112 bowersj2 4828: =pod
4829:
1.648 raeburn 4830: =item * &get_student_view()
1.112 bowersj2 4831:
4832: show a snapshot of what student was looking at
4833:
4834: =cut
4835:
1.10 albertel 4836: sub get_student_view {
1.186 albertel 4837: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4838: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4839: my (%form);
1.10 albertel 4840: my @elements=('symb','courseid','domain','username');
4841: foreach my $element (@elements) {
1.186 albertel 4842: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4843: }
1.186 albertel 4844: if (defined($moreenv)) {
4845: %form=(%form,%{$moreenv});
4846: }
1.236 albertel 4847: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4848: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 4849: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
4850: $feedurl =~ s{^/adm/wrapper}{};
4851: }
1.650 www 4852: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4853: $userview=~s/\<body[^\>]*\>//gi;
4854: $userview=~s/\<\/body\>//gi;
4855: $userview=~s/\<html\>//gi;
4856: $userview=~s/\<\/html\>//gi;
4857: $userview=~s/\<head\>//gi;
4858: $userview=~s/\<\/head\>//gi;
4859: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4860: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4861: if (wantarray) {
4862: return ($userview,$response);
4863: } else {
4864: return $userview;
4865: }
4866: }
4867:
4868: sub get_student_view_with_retries {
4869: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4870:
4871: my $ok = 0; # True if we got a good response.
4872: my $content;
4873: my $response;
4874:
4875: # Try to get the student_view done. within the retries count:
4876:
4877: do {
4878: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4879: $ok = $response->is_success;
4880: if (!$ok) {
4881: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4882: }
4883: $retries--;
4884: } while (!$ok && ($retries > 0));
4885:
4886: if (!$ok) {
4887: $content = ''; # On error return an empty content.
4888: }
1.651 www 4889: if (wantarray) {
4890: return ($content, $response);
4891: } else {
4892: return $content;
4893: }
1.11 albertel 4894: }
4895:
1.112 bowersj2 4896: =pod
4897:
1.648 raeburn 4898: =item * &get_student_answers()
1.112 bowersj2 4899:
4900: show a snapshot of how student was answering problem
4901:
4902: =cut
4903:
1.11 albertel 4904: sub get_student_answers {
1.100 sakharuk 4905: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4906: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4907: my (%moreenv);
1.11 albertel 4908: my @elements=('symb','courseid','domain','username');
4909: foreach my $element (@elements) {
1.186 albertel 4910: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4911: }
1.186 albertel 4912: $moreenv{'grade_target'}='answer';
4913: %moreenv=(%form,%moreenv);
1.497 raeburn 4914: $feedurl = &Apache::lonnet::clutter($feedurl);
4915: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4916: return $userview;
1.1 albertel 4917: }
1.116 albertel 4918:
4919: =pod
4920:
4921: =item * &submlink()
4922:
1.242 albertel 4923: Inputs: $text $uname $udom $symb $target
1.116 albertel 4924:
4925: Returns: A link to grades.pm such as to see the SUBM view of a student
4926:
4927: =cut
4928:
4929: ###############################################
4930: sub submlink {
1.242 albertel 4931: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4932: if (!($uname && $udom)) {
4933: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4934: &Apache::lonnet::whichuser($symb);
1.116 albertel 4935: if (!$symb) { $symb=$cursymb; }
4936: }
1.254 matthew 4937: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4938: $symb=&escape($symb);
1.960 bisitz 4939: if ($target) { $target=" target=\"$target\""; }
4940: return
4941: '<a href="/adm/grades?command=submission'.
4942: '&symb='.$symb.
4943: '&student='.$uname.
4944: '&userdom='.$udom.'"'.
4945: $target.'>'.$text.'</a>';
1.242 albertel 4946: }
4947: ##############################################
4948:
4949: =pod
4950:
4951: =item * &pgrdlink()
4952:
4953: Inputs: $text $uname $udom $symb $target
4954:
4955: Returns: A link to grades.pm such as to see the PGRD view of a student
4956:
4957: =cut
4958:
4959: ###############################################
4960: sub pgrdlink {
4961: my $link=&submlink(@_);
4962: $link=~s/(&command=submission)/$1&showgrading=yes/;
4963: return $link;
4964: }
4965: ##############################################
4966:
4967: =pod
4968:
4969: =item * &pprmlink()
4970:
4971: Inputs: $text $uname $udom $symb $target
4972:
4973: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4974: student and a specific resource
1.242 albertel 4975:
4976: =cut
4977:
4978: ###############################################
4979: sub pprmlink {
4980: my ($text,$uname,$udom,$symb,$target)=@_;
4981: if (!($uname && $udom)) {
4982: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4983: &Apache::lonnet::whichuser($symb);
1.242 albertel 4984: if (!$symb) { $symb=$cursymb; }
4985: }
1.254 matthew 4986: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4987: $symb=&escape($symb);
1.242 albertel 4988: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4989: return '<a href="/adm/parmset?command=set&'.
4990: 'symb='.$symb.'&uname='.$uname.
4991: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4992: }
4993: ##############################################
1.37 matthew 4994:
1.112 bowersj2 4995: =pod
4996:
4997: =back
4998:
4999: =cut
5000:
1.37 matthew 5001: ###############################################
1.51 www 5002:
5003:
5004: sub timehash {
1.687 raeburn 5005: my ($thistime) = @_;
5006: my $timezone = &Apache::lonlocal::gettimezone();
5007: my $dt = DateTime->from_epoch(epoch => $thistime)
5008: ->set_time_zone($timezone);
5009: my $wday = $dt->day_of_week();
5010: if ($wday == 7) { $wday = 0; }
5011: return ( 'second' => $dt->second(),
5012: 'minute' => $dt->minute(),
5013: 'hour' => $dt->hour(),
5014: 'day' => $dt->day_of_month(),
5015: 'month' => $dt->month(),
5016: 'year' => $dt->year(),
5017: 'weekday' => $wday,
5018: 'dayyear' => $dt->day_of_year(),
5019: 'dlsav' => $dt->is_dst() );
1.51 www 5020: }
5021:
1.370 www 5022: sub utc_string {
5023: my ($date)=@_;
1.371 www 5024: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5025: }
5026:
1.51 www 5027: sub maketime {
5028: my %th=@_;
1.687 raeburn 5029: my ($epoch_time,$timezone,$dt);
5030: $timezone = &Apache::lonlocal::gettimezone();
5031: eval {
5032: $dt = DateTime->new( year => $th{'year'},
5033: month => $th{'month'},
5034: day => $th{'day'},
5035: hour => $th{'hour'},
5036: minute => $th{'minute'},
5037: second => $th{'second'},
5038: time_zone => $timezone,
5039: );
5040: };
5041: if (!$@) {
5042: $epoch_time = $dt->epoch;
5043: if ($epoch_time) {
5044: return $epoch_time;
5045: }
5046: }
1.51 www 5047: return POSIX::mktime(
5048: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5049: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5050: }
5051:
5052: #########################################
1.51 www 5053:
5054: sub findallcourses {
1.482 raeburn 5055: my ($roles,$uname,$udom) = @_;
1.355 albertel 5056: my %roles;
5057: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5058: my %courses;
1.51 www 5059: my $now=time;
1.482 raeburn 5060: if (!defined($uname)) {
5061: $uname = $env{'user.name'};
5062: }
5063: if (!defined($udom)) {
5064: $udom = $env{'user.domain'};
5065: }
5066: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5067: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5068: if (!%roles) {
5069: %roles = (
5070: cc => 1,
1.907 raeburn 5071: co => 1,
1.482 raeburn 5072: in => 1,
5073: ep => 1,
5074: ta => 1,
5075: cr => 1,
5076: st => 1,
5077: );
5078: }
5079: foreach my $entry (keys(%roleshash)) {
5080: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5081: if ($trole =~ /^cr/) {
5082: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5083: } else {
5084: next if (!exists($roles{$trole}));
5085: }
5086: if ($tend) {
5087: next if ($tend < $now);
5088: }
5089: if ($tstart) {
5090: next if ($tstart > $now);
5091: }
1.1058 raeburn 5092: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5093: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5094: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5095: if ($secpart eq '') {
5096: ($cnum,$role) = split(/_/,$cnumpart);
5097: $sec = 'none';
1.1058 raeburn 5098: $value .= $cnum.'/';
1.482 raeburn 5099: } else {
5100: $cnum = $cnumpart;
5101: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5102: $value .= $cnum.'/'.$sec;
5103: }
5104: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5105: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5106: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5107: }
5108: } else {
5109: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5110: }
1.482 raeburn 5111: }
5112: } else {
5113: foreach my $key (keys(%env)) {
1.483 albertel 5114: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5115: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5116: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5117: next if ($role eq 'ca' || $role eq 'aa');
5118: next if (%roles && !exists($roles{$role}));
5119: my ($starttime,$endtime)=split(/\./,$env{$key});
5120: my $active=1;
5121: if ($starttime) {
5122: if ($now<$starttime) { $active=0; }
5123: }
5124: if ($endtime) {
5125: if ($now>$endtime) { $active=0; }
5126: }
5127: if ($active) {
1.1058 raeburn 5128: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5129: if ($sec eq '') {
5130: $sec = 'none';
1.1058 raeburn 5131: } else {
5132: $value .= $sec;
5133: }
5134: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5135: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5136: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5137: }
5138: } else {
5139: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5140: }
1.474 raeburn 5141: }
5142: }
1.51 www 5143: }
5144: }
1.474 raeburn 5145: return %courses;
1.51 www 5146: }
1.37 matthew 5147:
1.54 www 5148: ###############################################
1.474 raeburn 5149:
5150: sub blockcheck {
1.1189 raeburn 5151: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 5152:
1.1189 raeburn 5153: if (defined($udom) && defined($uname)) {
5154: # If uname and udom are for a course, check for blocks in the course.
5155: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5156: my ($startblock,$endblock,$triggerblock) =
5157: &get_blocks($setters,$activity,$udom,$uname,$url);
5158: return ($startblock,$endblock,$triggerblock);
5159: }
5160: } else {
1.490 raeburn 5161: $udom = $env{'user.domain'};
5162: $uname = $env{'user.name'};
5163: }
5164:
1.502 raeburn 5165: my $startblock = 0;
5166: my $endblock = 0;
1.1062 raeburn 5167: my $triggerblock = '';
1.482 raeburn 5168: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 5169:
1.490 raeburn 5170: # If uname is for a user, and activity is course-specific, i.e.,
5171: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5172:
1.490 raeburn 5173: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5174: $activity eq 'groups' || $activity eq 'printout' ||
5175: $activity eq 'reinit' || $activity eq 'alert') &&
1.1189 raeburn 5176: ($env{'request.course.id'})) {
1.490 raeburn 5177: foreach my $key (keys(%live_courses)) {
5178: if ($key ne $env{'request.course.id'}) {
5179: delete($live_courses{$key});
5180: }
5181: }
5182: }
5183:
5184: my $otheruser = 0;
5185: my %own_courses;
5186: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5187: # Resource belongs to user other than current user.
5188: $otheruser = 1;
5189: # Gather courses for current user
5190: %own_courses =
5191: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5192: }
5193:
5194: # Gather active course roles - course coordinator, instructor,
5195: # exam proctor, ta, student, or custom role.
1.474 raeburn 5196:
5197: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5198: my ($cdom,$cnum);
5199: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5200: $cdom = $env{'course.'.$course.'.domain'};
5201: $cnum = $env{'course.'.$course.'.num'};
5202: } else {
1.490 raeburn 5203: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5204: }
5205: my $no_ownblock = 0;
5206: my $no_userblock = 0;
1.533 raeburn 5207: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5208: # Check if current user has 'evb' priv for this
5209: if (defined($own_courses{$course})) {
5210: foreach my $sec (keys(%{$own_courses{$course}})) {
5211: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5212: if ($sec ne 'none') {
5213: $checkrole .= '/'.$sec;
5214: }
5215: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5216: $no_ownblock = 1;
5217: last;
5218: }
5219: }
5220: }
5221: # if they have 'evb' priv and are currently not playing student
5222: next if (($no_ownblock) &&
5223: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5224: }
1.474 raeburn 5225: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5226: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5227: if ($sec ne 'none') {
1.482 raeburn 5228: $checkrole .= '/'.$sec;
1.474 raeburn 5229: }
1.490 raeburn 5230: if ($otheruser) {
5231: # Resource belongs to user other than current user.
5232: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5233: my (%allroles,%userroles);
5234: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5235: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5236: my ($trole,$tdom,$tnum,$tsec);
5237: if ($entry =~ /^cr/) {
5238: ($trole,$tdom,$tnum,$tsec) =
5239: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5240: } else {
5241: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5242: }
5243: my ($spec,$area,$trest);
5244: $area = '/'.$tdom.'/'.$tnum;
5245: $trest = $tnum;
5246: if ($tsec ne '') {
5247: $area .= '/'.$tsec;
5248: $trest .= '/'.$tsec;
5249: }
5250: $spec = $trole.'.'.$area;
5251: if ($trole =~ /^cr/) {
5252: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5253: $tdom,$spec,$trest,$area);
5254: } else {
5255: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5256: $tdom,$spec,$trest,$area);
5257: }
5258: }
1.1276 raeburn 5259: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5260: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5261: if ($1) {
5262: $no_userblock = 1;
5263: last;
5264: }
1.486 raeburn 5265: }
5266: }
1.490 raeburn 5267: } else {
5268: # Resource belongs to current user
5269: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5270: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5271: $no_ownblock = 1;
5272: last;
5273: }
1.474 raeburn 5274: }
5275: }
5276: # if they have the evb priv and are currently not playing student
1.482 raeburn 5277: next if (($no_ownblock) &&
1.491 albertel 5278: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5279: next if ($no_userblock);
1.474 raeburn 5280:
1.1303 raeburn 5281: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5282: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5283:
1.1062 raeburn 5284: my ($start,$end,$trigger) =
5285: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 5286: if (($start != 0) &&
5287: (($startblock == 0) || ($startblock > $start))) {
5288: $startblock = $start;
1.1062 raeburn 5289: if ($trigger ne '') {
5290: $triggerblock = $trigger;
5291: }
1.502 raeburn 5292: }
5293: if (($end != 0) &&
5294: (($endblock == 0) || ($endblock < $end))) {
5295: $endblock = $end;
1.1062 raeburn 5296: if ($trigger ne '') {
5297: $triggerblock = $trigger;
5298: }
1.502 raeburn 5299: }
1.490 raeburn 5300: }
1.1062 raeburn 5301: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5302: }
5303:
5304: sub get_blocks {
1.1062 raeburn 5305: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 5306: my $startblock = 0;
5307: my $endblock = 0;
1.1062 raeburn 5308: my $triggerblock = '';
1.490 raeburn 5309: my $course = $cdom.'_'.$cnum;
5310: $setters->{$course} = {};
5311: $setters->{$course}{'staff'} = [];
5312: $setters->{$course}{'times'} = [];
1.1062 raeburn 5313: $setters->{$course}{'triggers'} = [];
5314: my (@blockers,%triggered);
5315: my $now = time;
5316: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5317: if ($activity eq 'docs') {
5318: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
5319: foreach my $block (@blockers) {
5320: if ($block =~ /^firstaccess____(.+)$/) {
5321: my $item = $1;
5322: my $type = 'map';
5323: my $timersymb = $item;
5324: if ($item eq 'course') {
5325: $type = 'course';
5326: } elsif ($item =~ /___\d+___/) {
5327: $type = 'resource';
5328: } else {
5329: $timersymb = &Apache::lonnet::symbread($item);
5330: }
5331: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5332: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5333: $triggered{$block} = {
5334: start => $start,
5335: end => $end,
5336: type => $type,
5337: };
5338: }
5339: }
5340: } else {
5341: foreach my $block (keys(%commblocks)) {
5342: if ($block =~ m/^(\d+)____(\d+)$/) {
5343: my ($start,$end) = ($1,$2);
5344: if ($start <= time && $end >= time) {
5345: if (ref($commblocks{$block}) eq 'HASH') {
5346: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5347: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5348: unless(grep(/^\Q$block\E$/,@blockers)) {
5349: push(@blockers,$block);
5350: }
5351: }
5352: }
5353: }
5354: }
5355: } elsif ($block =~ /^firstaccess____(.+)$/) {
5356: my $item = $1;
5357: my $timersymb = $item;
5358: my $type = 'map';
5359: if ($item eq 'course') {
5360: $type = 'course';
5361: } elsif ($item =~ /___\d+___/) {
5362: $type = 'resource';
5363: } else {
5364: $timersymb = &Apache::lonnet::symbread($item);
5365: }
5366: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5367: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5368: if ($start && $end) {
5369: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5370: if (ref($commblocks{$block}) eq 'HASH') {
5371: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5372: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5373: unless(grep(/^\Q$block\E$/,@blockers)) {
5374: push(@blockers,$block);
5375: $triggered{$block} = {
5376: start => $start,
5377: end => $end,
5378: type => $type,
5379: };
5380: }
5381: }
5382: }
1.1062 raeburn 5383: }
5384: }
1.490 raeburn 5385: }
1.1062 raeburn 5386: }
5387: }
5388: }
5389: foreach my $blocker (@blockers) {
5390: my ($staff_name,$staff_dom,$title,$blocks) =
5391: &parse_block_record($commblocks{$blocker});
5392: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5393: my ($start,$end,$triggertype);
5394: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5395: ($start,$end) = ($1,$2);
5396: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5397: $start = $triggered{$blocker}{'start'};
5398: $end = $triggered{$blocker}{'end'};
5399: $triggertype = $triggered{$blocker}{'type'};
5400: }
5401: if ($start) {
5402: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5403: if ($triggertype) {
5404: push(@{$$setters{$course}{'triggers'}},$triggertype);
5405: } else {
5406: push(@{$$setters{$course}{'triggers'}},0);
5407: }
5408: if ( ($startblock == 0) || ($startblock > $start) ) {
5409: $startblock = $start;
5410: if ($triggertype) {
5411: $triggerblock = $blocker;
1.474 raeburn 5412: }
5413: }
1.1062 raeburn 5414: if ( ($endblock == 0) || ($endblock < $end) ) {
5415: $endblock = $end;
5416: if ($triggertype) {
5417: $triggerblock = $blocker;
5418: }
5419: }
1.474 raeburn 5420: }
5421: }
1.1062 raeburn 5422: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5423: }
5424:
5425: sub parse_block_record {
5426: my ($record) = @_;
5427: my ($setuname,$setudom,$title,$blocks);
5428: if (ref($record) eq 'HASH') {
5429: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5430: $title = &unescape($record->{'event'});
5431: $blocks = $record->{'blocks'};
5432: } else {
5433: my @data = split(/:/,$record,3);
5434: if (scalar(@data) eq 2) {
5435: $title = $data[1];
5436: ($setuname,$setudom) = split(/@/,$data[0]);
5437: } else {
5438: ($setuname,$setudom,$title) = @data;
5439: }
5440: $blocks = { 'com' => 'on' };
5441: }
5442: return ($setuname,$setudom,$title,$blocks);
5443: }
5444:
1.854 kalberla 5445: sub blocking_status {
1.1189 raeburn 5446: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 5447: my %setters;
1.890 droeschl 5448:
1.1061 raeburn 5449: # check for active blocking
1.1062 raeburn 5450: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 5451: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 5452: my $blocked = 0;
5453: if ($startblock && $endblock) {
5454: $blocked = 1;
5455: }
1.890 droeschl 5456:
1.1061 raeburn 5457: # caller just wants to know whether a block is active
5458: if (!wantarray) { return $blocked; }
5459:
5460: # build a link to a popup window containing the details
5461: my $querystring = "?activity=$activity";
5462: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232 raeburn 5463: if (($activity eq 'port') || ($activity eq 'passwd')) {
5464: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5465: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5466: } elsif ($activity eq 'docs') {
5467: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
5468: }
1.1061 raeburn 5469:
5470: my $output .= <<'END_MYBLOCK';
5471: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5472: var options = "width=" + w + ",height=" + h + ",";
5473: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5474: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5475: var newWin = window.open(url, wdwName, options);
5476: newWin.focus();
5477: }
1.890 droeschl 5478: END_MYBLOCK
1.854 kalberla 5479:
1.1061 raeburn 5480: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5481:
1.1061 raeburn 5482: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5483: my $text = &mt('Communication Blocked');
1.1217 raeburn 5484: my $class = 'LC_comblock';
1.1062 raeburn 5485: if ($activity eq 'docs') {
5486: $text = &mt('Content Access Blocked');
1.1217 raeburn 5487: $class = '';
1.1063 raeburn 5488: } elsif ($activity eq 'printout') {
5489: $text = &mt('Printing Blocked');
1.1232 raeburn 5490: } elsif ($activity eq 'passwd') {
5491: $text = &mt('Password Changing Blocked');
1.1345 ! raeburn 5492: } elsif ($activity eq 'grades') {
! 5493: $text = &mt('Gradebook Blocked');
1.1282 raeburn 5494: } elsif ($activity eq 'alert') {
5495: $text = &mt('Checking Critical Messages Blocked');
5496: } elsif ($activity eq 'reinit') {
5497: $text = &mt('Checking Course Update Blocked');
1.1062 raeburn 5498: }
1.1061 raeburn 5499: $output .= <<"END_BLOCK";
1.1217 raeburn 5500: <div class='$class'>
1.869 kalberla 5501: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5502: title='$text'>
5503: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5504: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5505: title='$text'>$text</a>
1.867 kalberla 5506: </div>
5507:
5508: END_BLOCK
1.474 raeburn 5509:
1.1061 raeburn 5510: return ($blocked, $output);
1.854 kalberla 5511: }
1.490 raeburn 5512:
1.60 matthew 5513: ###############################################
5514:
1.682 raeburn 5515: sub check_ip_acc {
1.1201 raeburn 5516: my ($acc,$clientip)=@_;
1.682 raeburn 5517: &Apache::lonxml::debug("acc is $acc");
5518: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5519: return 1;
5520: }
1.1339 raeburn 5521: my ($ip,$allowed);
5522: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5523: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5524: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5525: } else {
5526: $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
5527: }
1.682 raeburn 5528:
5529: my $name;
1.1219 raeburn 5530: my %access = (
5531: allowfrom => 1,
5532: denyfrom => 0,
5533: );
5534: my @allows;
5535: my @denies;
5536: foreach my $item (split(',',$acc)) {
5537: $item =~ s/^\s*//;
5538: $item =~ s/\s*$//;
5539: my $pattern;
5540: if ($item =~ /^\!(.+)$/) {
5541: push(@denies,$1);
5542: } else {
5543: push(@allows,$item);
5544: }
5545: }
5546: my $numdenies = scalar(@denies);
5547: my $numallows = scalar(@allows);
5548: my $count = 0;
5549: foreach my $pattern (@denies,@allows) {
5550: $count ++;
5551: my $acctype = 'allowfrom';
5552: if ($count <= $numdenies) {
5553: $acctype = 'denyfrom';
5554: }
1.682 raeburn 5555: if ($pattern =~ /\*$/) {
5556: #35.8.*
5557: $pattern=~s/\*//;
1.1219 raeburn 5558: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5559: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5560: #35.8.3.[34-56]
5561: my $low=$2;
5562: my $high=$3;
5563: $pattern=$1;
5564: if ($ip =~ /^\Q$pattern\E/) {
5565: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5566: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5567: }
5568: } elsif ($pattern =~ /^\*/) {
5569: #*.msu.edu
5570: $pattern=~s/\*//;
5571: if (!defined($name)) {
5572: use Socket;
5573: my $netaddr=inet_aton($ip);
5574: ($name)=gethostbyaddr($netaddr,AF_INET);
5575: }
1.1219 raeburn 5576: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5577: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5578: #127.0.0.1
1.1219 raeburn 5579: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5580: } else {
5581: #some.name.com
5582: if (!defined($name)) {
5583: use Socket;
5584: my $netaddr=inet_aton($ip);
5585: ($name)=gethostbyaddr($netaddr,AF_INET);
5586: }
1.1219 raeburn 5587: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5588: }
5589: if ($allowed =~ /^(0|1)$/) { last; }
5590: }
5591: if ($allowed eq '') {
5592: if ($numdenies && !$numallows) {
5593: $allowed = 1;
5594: } else {
5595: $allowed = 0;
1.682 raeburn 5596: }
5597: }
5598: return $allowed;
5599: }
5600:
5601: ###############################################
5602:
1.60 matthew 5603: =pod
5604:
1.112 bowersj2 5605: =head1 Domain Template Functions
5606:
5607: =over 4
5608:
5609: =item * &determinedomain()
1.60 matthew 5610:
5611: Inputs: $domain (usually will be undef)
5612:
1.63 www 5613: Returns: Determines which domain should be used for designs
1.60 matthew 5614:
5615: =cut
1.54 www 5616:
1.60 matthew 5617: ###############################################
1.63 www 5618: sub determinedomain {
5619: my $domain=shift;
1.531 albertel 5620: if (! $domain) {
1.60 matthew 5621: # Determine domain if we have not been given one
1.893 raeburn 5622: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5623: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5624: if ($env{'request.role.domain'}) {
5625: $domain=$env{'request.role.domain'};
1.60 matthew 5626: }
5627: }
1.63 www 5628: return $domain;
5629: }
5630: ###############################################
1.517 raeburn 5631:
1.518 albertel 5632: sub devalidate_domconfig_cache {
5633: my ($udom)=@_;
5634: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5635: }
5636:
5637: # ---------------------- Get domain configuration for a domain
5638: sub get_domainconf {
5639: my ($udom) = @_;
5640: my $cachetime=1800;
5641: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5642: if (defined($cached)) { return %{$result}; }
5643:
5644: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5645: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5646: my (%designhash,%legacy);
1.518 albertel 5647: if (keys(%domconfig) > 0) {
5648: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5649: if (keys(%{$domconfig{'login'}})) {
5650: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5651: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5652: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5653: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5654: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5655: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5656: if ($key eq 'loginvia') {
5657: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5658: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5659: $designhash{$udom.'.login.loginvia'} = $server;
5660: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5661:
5662: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5663: } else {
5664: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5665: }
1.948 raeburn 5666: }
1.1208 raeburn 5667: } elsif ($key eq 'headtag') {
5668: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5669: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5670: }
1.946 raeburn 5671: }
1.1208 raeburn 5672: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5673: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5674: }
1.946 raeburn 5675: }
5676: }
5677: }
5678: } else {
5679: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5680: $designhash{$udom.'.login.'.$key.'_'.$img} =
5681: $domconfig{'login'}{$key}{$img};
5682: }
1.699 raeburn 5683: }
5684: } else {
5685: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5686: }
1.632 raeburn 5687: }
5688: } else {
5689: $legacy{'login'} = 1;
1.518 albertel 5690: }
1.632 raeburn 5691: } else {
5692: $legacy{'login'} = 1;
1.518 albertel 5693: }
5694: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5695: if (keys(%{$domconfig{'rolecolors'}})) {
5696: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5697: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5698: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5699: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5700: }
1.518 albertel 5701: }
5702: }
1.632 raeburn 5703: } else {
5704: $legacy{'rolecolors'} = 1;
1.518 albertel 5705: }
1.632 raeburn 5706: } else {
5707: $legacy{'rolecolors'} = 1;
1.518 albertel 5708: }
1.948 raeburn 5709: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5710: if ($domconfig{'autoenroll'}{'co-owners'}) {
5711: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5712: }
5713: }
1.632 raeburn 5714: if (keys(%legacy) > 0) {
5715: my %legacyhash = &get_legacy_domconf($udom);
5716: foreach my $item (keys(%legacyhash)) {
5717: if ($item =~ /^\Q$udom\E\.login/) {
5718: if ($legacy{'login'}) {
5719: $designhash{$item} = $legacyhash{$item};
5720: }
5721: } else {
5722: if ($legacy{'rolecolors'}) {
5723: $designhash{$item} = $legacyhash{$item};
5724: }
1.518 albertel 5725: }
5726: }
5727: }
1.632 raeburn 5728: } else {
5729: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5730: }
5731: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5732: $cachetime);
5733: return %designhash;
5734: }
5735:
1.632 raeburn 5736: sub get_legacy_domconf {
5737: my ($udom) = @_;
5738: my %legacyhash;
5739: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5740: my $designfile = $designdir.'/'.$udom.'.tab';
5741: if (-e $designfile) {
1.1317 raeburn 5742: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 5743: while (my $line = <$fh>) {
5744: next if ($line =~ /^\#/);
5745: chomp($line);
5746: my ($key,$val)=(split(/\=/,$line));
5747: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5748: }
5749: close($fh);
5750: }
5751: }
1.1026 raeburn 5752: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5753: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5754: }
5755: return %legacyhash;
5756: }
5757:
1.63 www 5758: =pod
5759:
1.112 bowersj2 5760: =item * &domainlogo()
1.63 www 5761:
5762: Inputs: $domain (usually will be undef)
5763:
5764: Returns: A link to a domain logo, if the domain logo exists.
5765: If the domain logo does not exist, a description of the domain.
5766:
5767: =cut
1.112 bowersj2 5768:
1.63 www 5769: ###############################################
5770: sub domainlogo {
1.517 raeburn 5771: my $domain = &determinedomain(shift);
1.518 albertel 5772: my %designhash = &get_domainconf($domain);
1.517 raeburn 5773: # See if there is a logo
5774: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5775: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5776: if ($imgsrc =~ m{^/(adm|res)/}) {
5777: if ($imgsrc =~ m{^/res/}) {
5778: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5779: &Apache::lonnet::repcopy($local_name);
5780: }
5781: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 5782: }
5783: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 5784: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5785: return &Apache::lonnet::domain($domain,'description');
1.59 www 5786: } else {
1.60 matthew 5787: return '';
1.59 www 5788: }
5789: }
1.63 www 5790: ##############################################
5791:
5792: =pod
5793:
1.112 bowersj2 5794: =item * &designparm()
1.63 www 5795:
5796: Inputs: $which parameter; $domain (usually will be undef)
5797:
5798: Returns: value of designparamter $which
5799:
5800: =cut
1.112 bowersj2 5801:
1.397 albertel 5802:
1.400 albertel 5803: ##############################################
1.397 albertel 5804: sub designparm {
5805: my ($which,$domain)=@_;
5806: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5807: return $env{'environment.color.'.$which};
1.96 www 5808: }
1.63 www 5809: $domain=&determinedomain($domain);
1.1016 raeburn 5810: my %domdesign;
5811: unless ($domain eq 'public') {
5812: %domdesign = &get_domainconf($domain);
5813: }
1.520 raeburn 5814: my $output;
1.517 raeburn 5815: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5816: $output = $domdesign{$domain.'.'.$which};
1.63 www 5817: } else {
1.520 raeburn 5818: $output = $defaultdesign{$which};
5819: }
5820: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5821: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5822: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5823: if ($output =~ m{^/res/}) {
5824: my $local_name = &Apache::lonnet::filelocation('',$output);
5825: &Apache::lonnet::repcopy($local_name);
5826: }
1.520 raeburn 5827: $output = &lonhttpdurl($output);
5828: }
1.63 www 5829: }
1.520 raeburn 5830: return $output;
1.63 www 5831: }
1.59 www 5832:
1.822 bisitz 5833: ##############################################
5834: =pod
5835:
1.832 bisitz 5836: =item * &authorspace()
5837:
1.1028 raeburn 5838: Inputs: $url (usually will be undef).
1.832 bisitz 5839:
1.1132 raeburn 5840: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5841: directory being viewed (or for which action is being taken).
5842: If $url is provided, and begins /priv/<domain>/<uname>
5843: the path will be that portion of the $context argument.
5844: Otherwise the path will be for the author space of the current
5845: user when the current role is author, or for that of the
5846: co-author/assistant co-author space when the current role
5847: is co-author or assistant co-author.
1.832 bisitz 5848:
5849: =cut
5850:
5851: sub authorspace {
1.1028 raeburn 5852: my ($url) = @_;
5853: if ($url ne '') {
5854: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5855: return $1;
5856: }
5857: }
1.832 bisitz 5858: my $caname = '';
1.1024 www 5859: my $cadom = '';
1.1028 raeburn 5860: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5861: ($cadom,$caname) =
1.832 bisitz 5862: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5863: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5864: $caname = $env{'user.name'};
1.1024 www 5865: $cadom = $env{'user.domain'};
1.832 bisitz 5866: }
1.1028 raeburn 5867: if (($caname ne '') && ($cadom ne '')) {
5868: return "/priv/$cadom/$caname/";
5869: }
5870: return;
1.832 bisitz 5871: }
5872:
5873: ##############################################
5874: =pod
5875:
1.822 bisitz 5876: =item * &head_subbox()
5877:
5878: Inputs: $content (contains HTML code with page functions, etc.)
5879:
5880: Returns: HTML div with $content
5881: To be included in page header
5882:
5883: =cut
5884:
5885: sub head_subbox {
5886: my ($content)=@_;
5887: my $output =
1.993 raeburn 5888: '<div class="LC_head_subbox">'
1.822 bisitz 5889: .$content
5890: .'</div>'
5891: }
5892:
5893: ##############################################
5894: =pod
5895:
5896: =item * &CSTR_pageheader()
5897:
1.1026 raeburn 5898: Input: (optional) filename from which breadcrumb trail is built.
5899: In most cases no input as needed, as $env{'request.filename'}
5900: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5901:
5902: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5903: To be included on Authoring Space pages
1.822 bisitz 5904:
5905: =cut
5906:
5907: sub CSTR_pageheader {
1.1026 raeburn 5908: my ($trailfile) = @_;
5909: if ($trailfile eq '') {
5910: $trailfile = $env{'request.filename'};
5911: }
5912:
5913: # this is for resources; directories have customtitle, and crumbs
5914: # and select recent are created in lonpubdir.pm
5915:
5916: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5917: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5918: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5919: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5920: $formaction =~ s{/+}{/}g;
1.822 bisitz 5921:
5922: my $parentpath = '';
5923: my $lastitem = '';
5924: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5925: $parentpath = $1;
5926: $lastitem = $2;
5927: } else {
5928: $lastitem = $thisdisfn;
5929: }
1.921 bisitz 5930:
1.1246 raeburn 5931: my ($crsauthor,$title);
5932: if (($env{'request.course.id'}) &&
5933: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 5934: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 5935: $crsauthor = 1;
5936: $title = &mt('Course Authoring Space');
5937: } else {
5938: $title = &mt('Authoring Space');
5939: }
5940:
1.1314 raeburn 5941: my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
1.1313 raeburn 5942: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 5943: $target = '';
5944: $crumbtarget = '';
1.1313 raeburn 5945: }
5946:
1.921 bisitz 5947: my $output =
1.822 bisitz 5948: '<div>'
5949: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 5950: .'<b>'.$title.'</b> '
1.1314 raeburn 5951: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
5952: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 5953:
5954: if ($lastitem) {
5955: $output .=
5956: '<span class="LC_filename">'
5957: .$lastitem
5958: .'</span>';
5959: }
1.1245 raeburn 5960:
1.1246 raeburn 5961: if ($crsauthor) {
5962: $output .= '</form>'.&Apache::lonmenu::constspaceform();
5963: } else {
5964: $output .=
5965: '<br />'
1.1314 raeburn 5966: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 5967: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5968: .'</form>'
5969: .&Apache::lonmenu::constspaceform();
5970: }
5971: $output .= '</div>';
1.921 bisitz 5972:
5973: return $output;
1.822 bisitz 5974: }
5975:
1.60 matthew 5976: ###############################################
5977: ###############################################
5978:
5979: =pod
5980:
1.112 bowersj2 5981: =back
5982:
1.549 albertel 5983: =head1 HTML Helpers
1.112 bowersj2 5984:
5985: =over 4
5986:
5987: =item * &bodytag()
1.60 matthew 5988:
5989: Returns a uniform header for LON-CAPA web pages.
5990:
5991: Inputs:
5992:
1.112 bowersj2 5993: =over 4
5994:
5995: =item * $title, A title to be displayed on the page.
5996:
5997: =item * $function, the current role (can be undef).
5998:
5999: =item * $addentries, extra parameters for the <body> tag.
6000:
6001: =item * $bodyonly, if defined, only return the <body> tag.
6002:
6003: =item * $domain, if defined, force a given domain.
6004:
6005: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6006: text interface only)
1.60 matthew 6007:
1.814 bisitz 6008: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6009: navigational links
1.317 albertel 6010:
1.338 albertel 6011: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6012:
1.460 albertel 6013: =item * $args, optional argument valid values are
6014: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6015: use_absolute -> for external resource or syllabus, this will
6016: contain https://<hostname> if server uses
6017: https (as per hosts.tab), but request is for http
6018: hostname -> hostname, from $r->hostname().
1.460 albertel 6019:
1.1096 raeburn 6020: =item * $advtoolsref, optional argument, ref to an array containing
6021: inlineremote items to be added in "Functions" menu below
6022: breadcrumbs.
6023:
1.1316 raeburn 6024: =item * $ltiscope, optional argument, will be one of: resource, map or
6025: course, if LON-CAPA is in LTI Provider context. Value is
6026: the scope of use, i.e., launch was for access to a single, a map
6027: or the entire course.
6028:
6029: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6030: context, this will contain the URL for the landing item in
6031: the course, after launch from an LTI Consumer
6032:
1.1318 raeburn 6033: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6034: context, this will contain a reference to hash of items
6035: to be included in the page header and/or inline menu.
6036:
1.112 bowersj2 6037: =back
6038:
1.60 matthew 6039: Returns: A uniform header for LON-CAPA web pages.
6040: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6041: If $bodyonly is undef or zero, an html string containing a <body> tag and
6042: other decorations will be returned.
6043:
6044: =cut
6045:
1.54 www 6046: sub bodytag {
1.831 bisitz 6047: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1318 raeburn 6048: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
1.339 albertel 6049:
1.954 raeburn 6050: my $public;
6051: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6052: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6053: $public = 1;
6054: }
1.460 albertel 6055: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6056: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6057: my $hostname = $args->{'hostname'};
1.339 albertel 6058:
1.183 matthew 6059: $function = &get_users_function() if (!$function);
1.339 albertel 6060: my $img = &designparm($function.'.img',$domain);
6061: my $font = &designparm($function.'.font',$domain);
6062: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6063:
1.803 bisitz 6064: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6065: 'bgcolor' => $pgbg,
1.339 albertel 6066: 'text' => $font,
6067: 'alink' => &designparm($function.'.alink',$domain),
6068: 'vlink' => &designparm($function.'.vlink',$domain),
6069: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6070: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6071:
1.63 www 6072: # role and realm
1.1178 raeburn 6073: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6074: if ($realm) {
6075: $realm = '/'.$realm;
6076: }
1.378 raeburn 6077: if ($role eq 'ca') {
1.479 albertel 6078: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6079: $realm = &plainname($rname,$rdom);
1.378 raeburn 6080: }
1.55 www 6081: # realm
1.258 albertel 6082: if ($env{'request.course.id'}) {
1.378 raeburn 6083: if ($env{'request.role'} !~ /^cr/) {
6084: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6085: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6086: if ($env{'request.role.desc'}) {
6087: $role = $env{'request.role.desc'};
6088: } else {
6089: $role = &mt('Helpdesk[_1]',' '.$2);
6090: }
1.1257 raeburn 6091: } else {
6092: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6093: }
1.898 raeburn 6094: if ($env{'request.course.sec'}) {
6095: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
6096: }
1.359 albertel 6097: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 6098: } else {
6099: $role = &Apache::lonnet::plaintext($role);
1.54 www 6100: }
1.433 albertel 6101:
1.359 albertel 6102: if (!$realm) { $realm=' '; }
1.330 albertel 6103:
1.438 albertel 6104: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6105:
1.101 www 6106: # construct main body tag
1.359 albertel 6107: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6108: &Apache::lontexconvert::init_math_support();
1.252 albertel 6109:
1.1131 raeburn 6110: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6111:
1.1130 raeburn 6112: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6113: return $bodytag;
1.1130 raeburn 6114: }
1.359 albertel 6115:
1.954 raeburn 6116: if ($public) {
1.433 albertel 6117: undef($role);
6118: }
1.1318 raeburn 6119:
6120: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
6121: if (ref($ltimenu) eq 'HASH') {
6122: unless ($ltimenu->{'role'}) {
6123: undef($role);
6124: }
6125: unless ($ltimenu->{'coursetitle'}) {
6126: $realm=' ';
6127: }
6128: }
6129: }
6130:
1.762 bisitz 6131: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6132: #
6133: # Extra info if you are the DC
6134: my $dc_info = '';
6135: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
6136: $env{'course.'.$env{'request.course.id'}.
6137: '.domain'}.'/'})) {
6138: my $cid = $env{'request.course.id'};
1.917 raeburn 6139: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6140: $dc_info =~ s/\s+$//;
1.359 albertel 6141: }
6142:
1.1237 raeburn 6143: my $crstype;
6144: if ($env{'request.course.id'}) {
6145: $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
6146: } elsif ($args->{'crstype'}) {
6147: $crstype = $args->{'crstype'};
6148: }
6149: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6150: undef($role);
6151: } else {
1.1242 raeburn 6152: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6153: }
1.853 droeschl 6154:
1.903 droeschl 6155: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6156:
6157: # if ($env{'request.state'} eq 'construct') {
6158: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6159: # }
6160:
1.1130 raeburn 6161: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6162: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6163:
1.1318 raeburn 6164: unless ($args->{'no_primary_menu'}) {
6165: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);
1.359 albertel 6166:
1.1318 raeburn 6167: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6168: if ($dc_info) {
6169: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6170: }
6171: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6172: <em>$realm</em> $dc_info</div>|;
6173: return $bodytag;
6174: }
1.894 droeschl 6175:
1.1318 raeburn 6176: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6177: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6178: }
1.916 droeschl 6179:
1.1318 raeburn 6180: $bodytag .= $right;
1.852 droeschl 6181:
1.1318 raeburn 6182: if ($dc_info) {
6183: $dc_info = &dc_courseid_toggle($dc_info);
6184: }
6185: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6186: }
1.916 droeschl 6187:
1.1169 raeburn 6188: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6189: if ($args->{'no_secondary_menu'}) {
6190: return $bodytag;
6191: }
1.1169 raeburn 6192: #don't show menus for public users
1.954 raeburn 6193: if (!$public){
1.1318 raeburn 6194: unless ($args->{'no_inline_menu'}) {
6195: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
6196: $args->{'no_primary_menu'});
6197: }
1.903 droeschl 6198: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6199: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6200: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6201: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1316 raeburn 6202: $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6203: } elsif ($forcereg) {
6204: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 6205: $args->{'group'},
1.1274 raeburn 6206: $args->{'hide_buttons'},
1.1316 raeburn 6207: $hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6208: } else {
6209: $bodytag .=
6210: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6211: $forcereg,$args->{'group'},
6212: $args->{'bread_crumbs'},
1.1274 raeburn 6213: $advtoolsref,'',$hostname);
1.920 raeburn 6214: }
1.903 droeschl 6215: }else{
6216: # this is to seperate menu from content when there's no secondary
6217: # menu. Especially needed for public accessible ressources.
6218: $bodytag .= '<hr style="clear:both" />';
6219: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6220: }
1.903 droeschl 6221:
1.235 raeburn 6222: return $bodytag;
1.182 matthew 6223: }
6224:
1.917 raeburn 6225: sub dc_courseid_toggle {
6226: my ($dc_info) = @_;
1.980 raeburn 6227: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6228: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6229: &mt('(More ...)').'</a></span>'.
6230: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6231: }
6232:
1.330 albertel 6233: sub make_attr_string {
6234: my ($register,$attr_ref) = @_;
6235:
6236: if ($attr_ref && !ref($attr_ref)) {
6237: die("addentries Must be a hash ref ".
6238: join(':',caller(1))." ".
6239: join(':',caller(0))." ");
6240: }
6241:
6242: if ($register) {
1.339 albertel 6243: my ($on_load,$on_unload);
6244: foreach my $key (keys(%{$attr_ref})) {
6245: if (lc($key) eq 'onload') {
6246: $on_load.=$attr_ref->{$key}.';';
6247: delete($attr_ref->{$key});
6248:
6249: } elsif (lc($key) eq 'onunload') {
6250: $on_unload.=$attr_ref->{$key}.';';
6251: delete($attr_ref->{$key});
6252: }
6253: }
1.953 droeschl 6254: $attr_ref->{'onload'} = $on_load;
6255: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6256: }
1.339 albertel 6257:
1.330 albertel 6258: my $attr_string;
1.1159 raeburn 6259: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6260: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6261: }
6262: return $attr_string;
6263: }
6264:
6265:
1.182 matthew 6266: ###############################################
1.251 albertel 6267: ###############################################
6268:
6269: =pod
6270:
6271: =item * &endbodytag()
6272:
6273: Returns a uniform footer for LON-CAPA web pages.
6274:
1.635 raeburn 6275: Inputs: 1 - optional reference to an args hash
6276: If in the hash, key for noredirectlink has a value which evaluates to true,
6277: a 'Continue' link is not displayed if the page contains an
6278: internal redirect in the <head></head> section,
6279: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6280:
6281: =cut
6282:
6283: sub endbodytag {
1.635 raeburn 6284: my ($args) = @_;
1.1080 raeburn 6285: my $endbodytag;
6286: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6287: $endbodytag='</body>';
6288: }
1.315 albertel 6289: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6290: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6291: $endbodytag=
6292: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6293: &mt('Continue').'</a>'.
6294: $endbodytag;
6295: }
1.315 albertel 6296: }
1.251 albertel 6297: return $endbodytag;
6298: }
6299:
1.352 albertel 6300: =pod
6301:
6302: =item * &standard_css()
6303:
6304: Returns a style sheet
6305:
6306: Inputs: (all optional)
6307: domain -> force to color decorate a page for a specific
6308: domain
6309: function -> force usage of a specific rolish color scheme
6310: bgcolor -> override the default page bgcolor
6311:
6312: =cut
6313:
1.343 albertel 6314: sub standard_css {
1.345 albertel 6315: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6316: $function = &get_users_function() if (!$function);
6317: my $img = &designparm($function.'.img', $domain);
6318: my $tabbg = &designparm($function.'.tabbg', $domain);
6319: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6320: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6321: #second colour for later usage
1.345 albertel 6322: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6323: my $pgbg_or_bgcolor =
6324: $bgcolor ||
1.352 albertel 6325: &designparm($function.'.pgbg', $domain);
1.382 albertel 6326: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6327: my $alink = &designparm($function.'.alink', $domain);
6328: my $vlink = &designparm($function.'.vlink', $domain);
6329: my $link = &designparm($function.'.link', $domain);
6330:
1.602 albertel 6331: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6332: my $mono = 'monospace';
1.850 bisitz 6333: my $data_table_head = $sidebg;
6334: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6335: my $data_table_dark = '#E0E0E0';
1.470 banghart 6336: my $data_table_darker = '#CCCCCC';
1.349 albertel 6337: my $data_table_highlight = '#FFFF00';
1.352 albertel 6338: my $mail_new = '#FFBB77';
6339: my $mail_new_hover = '#DD9955';
6340: my $mail_read = '#BBBB77';
6341: my $mail_read_hover = '#999944';
6342: my $mail_replied = '#AAAA88';
6343: my $mail_replied_hover = '#888855';
6344: my $mail_other = '#99BBBB';
6345: my $mail_other_hover = '#669999';
1.391 albertel 6346: my $table_header = '#DDDDDD';
1.489 raeburn 6347: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6348: my $lg_border_color = '#C8C8C8';
1.952 onken 6349: my $button_hover = '#BF2317';
1.392 albertel 6350:
1.608 albertel 6351: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6352: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6353: : '0 3px 0 4px';
1.448 albertel 6354:
1.523 albertel 6355:
1.343 albertel 6356: return <<END;
1.947 droeschl 6357:
6358: /* needed for iframe to allow 100% height in FF */
6359: body, html {
6360: margin: 0;
6361: padding: 0 0.5%;
6362: height: 99%; /* to avoid scrollbars */
6363: }
6364:
1.795 www 6365: body {
1.911 bisitz 6366: font-family: $sans;
6367: line-height:130%;
6368: font-size:0.83em;
6369: color:$font;
1.795 www 6370: }
6371:
1.959 onken 6372: a:focus,
6373: a:focus img {
1.795 www 6374: color: red;
6375: }
1.698 harmsja 6376:
1.911 bisitz 6377: form, .inline {
6378: display: inline;
1.795 www 6379: }
1.721 harmsja 6380:
1.795 www 6381: .LC_right {
1.911 bisitz 6382: text-align:right;
1.795 www 6383: }
6384:
6385: .LC_middle {
1.911 bisitz 6386: vertical-align:middle;
1.795 www 6387: }
1.721 harmsja 6388:
1.1130 raeburn 6389: .LC_floatleft {
6390: float: left;
6391: }
6392:
6393: .LC_floatright {
6394: float: right;
6395: }
6396:
1.911 bisitz 6397: .LC_400Box {
6398: width:400px;
6399: }
1.721 harmsja 6400:
1.947 droeschl 6401: .LC_iframecontainer {
6402: width: 98%;
6403: margin: 0;
6404: position: fixed;
6405: top: 8.5em;
6406: bottom: 0;
6407: }
6408:
6409: .LC_iframecontainer iframe{
6410: border: none;
6411: width: 100%;
6412: height: 100%;
6413: }
6414:
1.778 bisitz 6415: .LC_filename {
6416: font-family: $mono;
6417: white-space:pre;
1.921 bisitz 6418: font-size: 120%;
1.778 bisitz 6419: }
6420:
6421: .LC_fileicon {
6422: border: none;
6423: height: 1.3em;
6424: vertical-align: text-bottom;
6425: margin-right: 0.3em;
6426: text-decoration:none;
6427: }
6428:
1.1008 www 6429: .LC_setting {
6430: text-decoration:underline;
6431: }
6432:
1.350 albertel 6433: .LC_error {
6434: color: red;
6435: }
1.795 www 6436:
1.1097 bisitz 6437: .LC_warning {
6438: color: darkorange;
6439: }
6440:
1.457 albertel 6441: .LC_diff_removed {
1.733 bisitz 6442: color: red;
1.394 albertel 6443: }
1.532 albertel 6444:
6445: .LC_info,
1.457 albertel 6446: .LC_success,
6447: .LC_diff_added {
1.350 albertel 6448: color: green;
6449: }
1.795 www 6450:
1.802 bisitz 6451: div.LC_confirm_box {
6452: background-color: #FAFAFA;
6453: border: 1px solid $lg_border_color;
6454: margin-right: 0;
6455: padding: 5px;
6456: }
6457:
6458: div.LC_confirm_box .LC_error img,
6459: div.LC_confirm_box .LC_success img {
6460: vertical-align: middle;
6461: }
6462:
1.1242 raeburn 6463: .LC_maxwidth {
6464: max-width: 100%;
6465: height: auto;
6466: }
6467:
1.1243 raeburn 6468: .LC_textsize_mobile {
6469: \@media only screen and (max-device-width: 480px) {
6470: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6471: }
6472: }
6473:
1.440 albertel 6474: .LC_icon {
1.771 droeschl 6475: border: none;
1.790 droeschl 6476: vertical-align: middle;
1.771 droeschl 6477: }
6478:
1.543 albertel 6479: .LC_docs_spacer {
6480: width: 25px;
6481: height: 1px;
1.771 droeschl 6482: border: none;
1.543 albertel 6483: }
1.346 albertel 6484:
1.532 albertel 6485: .LC_internal_info {
1.735 bisitz 6486: color: #999999;
1.532 albertel 6487: }
6488:
1.794 www 6489: .LC_discussion {
1.1050 www 6490: background: $data_table_dark;
1.911 bisitz 6491: border: 1px solid black;
6492: margin: 2px;
1.794 www 6493: }
6494:
6495: .LC_disc_action_left {
1.1050 www 6496: background: $sidebg;
1.911 bisitz 6497: text-align: left;
1.1050 www 6498: padding: 4px;
6499: margin: 2px;
1.794 www 6500: }
6501:
6502: .LC_disc_action_right {
1.1050 www 6503: background: $sidebg;
1.911 bisitz 6504: text-align: right;
1.1050 www 6505: padding: 4px;
6506: margin: 2px;
1.794 www 6507: }
6508:
6509: .LC_disc_new_item {
1.911 bisitz 6510: background: white;
6511: border: 2px solid red;
1.1050 www 6512: margin: 4px;
6513: padding: 4px;
1.794 www 6514: }
6515:
6516: .LC_disc_old_item {
1.911 bisitz 6517: background: white;
1.1050 www 6518: margin: 4px;
6519: padding: 4px;
1.794 www 6520: }
6521:
1.458 albertel 6522: table.LC_pastsubmission {
6523: border: 1px solid black;
6524: margin: 2px;
6525: }
6526:
1.924 bisitz 6527: table#LC_menubuttons {
1.345 albertel 6528: width: 100%;
6529: background: $pgbg;
1.392 albertel 6530: border: 2px;
1.402 albertel 6531: border-collapse: separate;
1.803 bisitz 6532: padding: 0;
1.345 albertel 6533: }
1.392 albertel 6534:
1.801 tempelho 6535: table#LC_title_bar a {
6536: color: $fontmenu;
6537: }
1.836 bisitz 6538:
1.807 droeschl 6539: table#LC_title_bar {
1.819 tempelho 6540: clear: both;
1.836 bisitz 6541: display: none;
1.807 droeschl 6542: }
6543:
1.795 www 6544: table#LC_title_bar,
1.933 droeschl 6545: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6546: table#LC_title_bar.LC_with_remote {
1.359 albertel 6547: width: 100%;
1.392 albertel 6548: border-color: $pgbg;
6549: border-style: solid;
6550: border-width: $border;
1.379 albertel 6551: background: $pgbg;
1.801 tempelho 6552: color: $fontmenu;
1.392 albertel 6553: border-collapse: collapse;
1.803 bisitz 6554: padding: 0;
1.819 tempelho 6555: margin: 0;
1.359 albertel 6556: }
1.795 www 6557:
1.933 droeschl 6558: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6559: margin: 0;
6560: padding: 0;
1.933 droeschl 6561: position: relative;
6562: list-style: none;
1.913 droeschl 6563: }
1.933 droeschl 6564: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6565: display: inline;
6566: }
1.933 droeschl 6567:
6568: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6569: padding: 0;
1.933 droeschl 6570: margin: 0;
6571: float: left;
1.913 droeschl 6572: }
1.933 droeschl 6573: .LC_breadcrumb_tools_tools {
6574: padding: 0;
6575: margin: 0;
1.913 droeschl 6576: float: right;
6577: }
6578:
1.1240 raeburn 6579: .LC_placement_prog {
6580: padding-right: 20px;
6581: font-weight: bold;
6582: font-size: 90%;
6583: }
6584:
1.359 albertel 6585: table#LC_title_bar td {
6586: background: $tabbg;
6587: }
1.795 www 6588:
1.911 bisitz 6589: table#LC_menubuttons img {
1.803 bisitz 6590: border: none;
1.346 albertel 6591: }
1.795 www 6592:
1.842 droeschl 6593: .LC_breadcrumbs_component {
1.911 bisitz 6594: float: right;
6595: margin: 0 1em;
1.357 albertel 6596: }
1.842 droeschl 6597: .LC_breadcrumbs_component img {
1.911 bisitz 6598: vertical-align: middle;
1.777 tempelho 6599: }
1.795 www 6600:
1.1243 raeburn 6601: .LC_breadcrumbs_hoverable {
6602: background: $sidebg;
6603: }
6604:
1.383 albertel 6605: td.LC_table_cell_checkbox {
6606: text-align: center;
6607: }
1.795 www 6608:
6609: .LC_fontsize_small {
1.911 bisitz 6610: font-size: 70%;
1.705 tempelho 6611: }
6612:
1.844 bisitz 6613: #LC_breadcrumbs {
1.911 bisitz 6614: clear:both;
6615: background: $sidebg;
6616: border-bottom: 1px solid $lg_border_color;
6617: line-height: 2.5em;
1.933 droeschl 6618: overflow: hidden;
1.911 bisitz 6619: margin: 0;
6620: padding: 0;
1.995 raeburn 6621: text-align: left;
1.819 tempelho 6622: }
1.862 bisitz 6623:
1.1098 bisitz 6624: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6625: clear:both;
6626: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6627: border: 1px solid $sidebg;
1.1098 bisitz 6628: margin: 0 0 10px 0;
1.966 bisitz 6629: padding: 3px;
1.995 raeburn 6630: text-align: left;
1.822 bisitz 6631: }
6632:
1.795 www 6633: .LC_fontsize_medium {
1.911 bisitz 6634: font-size: 85%;
1.705 tempelho 6635: }
6636:
1.795 www 6637: .LC_fontsize_large {
1.911 bisitz 6638: font-size: 120%;
1.705 tempelho 6639: }
6640:
1.346 albertel 6641: .LC_menubuttons_inline_text {
6642: color: $font;
1.698 harmsja 6643: font-size: 90%;
1.701 harmsja 6644: padding-left:3px;
1.346 albertel 6645: }
6646:
1.934 droeschl 6647: .LC_menubuttons_inline_text img{
6648: vertical-align: middle;
6649: }
6650:
1.1051 www 6651: li.LC_menubuttons_inline_text img {
1.951 onken 6652: cursor:pointer;
1.1002 droeschl 6653: text-decoration: none;
1.951 onken 6654: }
6655:
1.526 www 6656: .LC_menubuttons_link {
6657: text-decoration: none;
6658: }
1.795 www 6659:
1.522 albertel 6660: .LC_menubuttons_category {
1.521 www 6661: color: $font;
1.526 www 6662: background: $pgbg;
1.521 www 6663: font-size: larger;
6664: font-weight: bold;
6665: }
6666:
1.346 albertel 6667: td.LC_menubuttons_text {
1.911 bisitz 6668: color: $font;
1.346 albertel 6669: }
1.706 harmsja 6670:
1.346 albertel 6671: .LC_current_location {
6672: background: $tabbg;
6673: }
1.795 www 6674:
1.1286 raeburn 6675: td.LC_zero_height {
6676: line-height: 0;
6677: cellpadding: 0;
6678: }
6679:
1.938 bisitz 6680: table.LC_data_table {
1.347 albertel 6681: border: 1px solid #000000;
1.402 albertel 6682: border-collapse: separate;
1.426 albertel 6683: border-spacing: 1px;
1.610 albertel 6684: background: $pgbg;
1.347 albertel 6685: }
1.795 www 6686:
1.422 albertel 6687: .LC_data_table_dense {
6688: font-size: small;
6689: }
1.795 www 6690:
1.507 raeburn 6691: table.LC_nested_outer {
6692: border: 1px solid #000000;
1.589 raeburn 6693: border-collapse: collapse;
1.803 bisitz 6694: border-spacing: 0;
1.507 raeburn 6695: width: 100%;
6696: }
1.795 www 6697:
1.879 raeburn 6698: table.LC_innerpickbox,
1.507 raeburn 6699: table.LC_nested {
1.803 bisitz 6700: border: none;
1.589 raeburn 6701: border-collapse: collapse;
1.803 bisitz 6702: border-spacing: 0;
1.507 raeburn 6703: width: 100%;
6704: }
1.795 www 6705:
1.911 bisitz 6706: table.LC_data_table tr th,
6707: table.LC_calendar tr th,
1.879 raeburn 6708: table.LC_prior_tries tr th,
6709: table.LC_innerpickbox tr th {
1.349 albertel 6710: font-weight: bold;
6711: background-color: $data_table_head;
1.801 tempelho 6712: color:$fontmenu;
1.701 harmsja 6713: font-size:90%;
1.347 albertel 6714: }
1.795 www 6715:
1.879 raeburn 6716: table.LC_innerpickbox tr th,
6717: table.LC_innerpickbox tr td {
6718: vertical-align: top;
6719: }
6720:
1.711 raeburn 6721: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6722: background-color: #CCCCCC;
1.711 raeburn 6723: font-weight: bold;
6724: text-align: left;
6725: }
1.795 www 6726:
1.912 bisitz 6727: table.LC_data_table tr.LC_odd_row > td {
6728: background-color: $data_table_light;
6729: padding: 2px;
6730: vertical-align: top;
6731: }
6732:
1.809 bisitz 6733: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6734: background-color: $data_table_light;
1.912 bisitz 6735: vertical-align: top;
6736: }
6737:
6738: table.LC_data_table tr.LC_even_row > td {
6739: background-color: $data_table_dark;
1.425 albertel 6740: padding: 2px;
1.900 bisitz 6741: vertical-align: top;
1.347 albertel 6742: }
1.795 www 6743:
1.809 bisitz 6744: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6745: background-color: $data_table_dark;
1.900 bisitz 6746: vertical-align: top;
1.347 albertel 6747: }
1.795 www 6748:
1.425 albertel 6749: table.LC_data_table tr.LC_data_table_highlight td {
6750: background-color: $data_table_darker;
6751: }
1.795 www 6752:
1.639 raeburn 6753: table.LC_data_table tr td.LC_leftcol_header {
6754: background-color: $data_table_head;
6755: font-weight: bold;
6756: }
1.795 www 6757:
1.451 albertel 6758: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6759: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6760: font-weight: bold;
6761: font-style: italic;
6762: text-align: center;
6763: padding: 8px;
1.347 albertel 6764: }
1.795 www 6765:
1.1114 raeburn 6766: table.LC_data_table tr.LC_empty_row td,
6767: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6768: background-color: $sidebg;
6769: }
6770:
6771: table.LC_nested tr.LC_empty_row td {
6772: background-color: #FFFFFF;
6773: }
6774:
1.890 droeschl 6775: table.LC_caption {
6776: }
6777:
1.507 raeburn 6778: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6779: padding: 4ex
6780: }
1.795 www 6781:
1.507 raeburn 6782: table.LC_nested_outer tr th {
6783: font-weight: bold;
1.801 tempelho 6784: color:$fontmenu;
1.507 raeburn 6785: background-color: $data_table_head;
1.701 harmsja 6786: font-size: small;
1.507 raeburn 6787: border-bottom: 1px solid #000000;
6788: }
1.795 www 6789:
1.507 raeburn 6790: table.LC_nested_outer tr td.LC_subheader {
6791: background-color: $data_table_head;
6792: font-weight: bold;
6793: font-size: small;
6794: border-bottom: 1px solid #000000;
6795: text-align: right;
1.451 albertel 6796: }
1.795 www 6797:
1.507 raeburn 6798: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6799: background-color: #CCCCCC;
1.451 albertel 6800: font-weight: bold;
6801: font-size: small;
1.507 raeburn 6802: text-align: center;
6803: }
1.795 www 6804:
1.589 raeburn 6805: table.LC_nested tr.LC_info_row td.LC_left_item,
6806: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6807: text-align: left;
1.451 albertel 6808: }
1.795 www 6809:
1.507 raeburn 6810: table.LC_nested td {
1.735 bisitz 6811: background-color: #FFFFFF;
1.451 albertel 6812: font-size: small;
1.507 raeburn 6813: }
1.795 www 6814:
1.507 raeburn 6815: table.LC_nested_outer tr th.LC_right_item,
6816: table.LC_nested tr.LC_info_row td.LC_right_item,
6817: table.LC_nested tr.LC_odd_row td.LC_right_item,
6818: table.LC_nested tr td.LC_right_item {
1.451 albertel 6819: text-align: right;
6820: }
6821:
1.507 raeburn 6822: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6823: background-color: #EEEEEE;
1.451 albertel 6824: }
6825:
1.473 raeburn 6826: table.LC_createuser {
6827: }
6828:
6829: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6830: font-size: small;
1.473 raeburn 6831: }
6832:
6833: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6834: background-color: #CCCCCC;
1.473 raeburn 6835: font-weight: bold;
6836: text-align: center;
6837: }
6838:
1.349 albertel 6839: table.LC_calendar {
6840: border: 1px solid #000000;
6841: border-collapse: collapse;
1.917 raeburn 6842: width: 98%;
1.349 albertel 6843: }
1.795 www 6844:
1.349 albertel 6845: table.LC_calendar_pickdate {
6846: font-size: xx-small;
6847: }
1.795 www 6848:
1.349 albertel 6849: table.LC_calendar tr td {
6850: border: 1px solid #000000;
6851: vertical-align: top;
1.917 raeburn 6852: width: 14%;
1.349 albertel 6853: }
1.795 www 6854:
1.349 albertel 6855: table.LC_calendar tr td.LC_calendar_day_empty {
6856: background-color: $data_table_dark;
6857: }
1.795 www 6858:
1.779 bisitz 6859: table.LC_calendar tr td.LC_calendar_day_current {
6860: background-color: $data_table_highlight;
1.777 tempelho 6861: }
1.795 www 6862:
1.938 bisitz 6863: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6864: background-color: $mail_new;
6865: }
1.795 www 6866:
1.938 bisitz 6867: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6868: background-color: $mail_new_hover;
6869: }
1.795 www 6870:
1.938 bisitz 6871: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6872: background-color: $mail_read;
6873: }
1.795 www 6874:
1.938 bisitz 6875: /*
6876: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6877: background-color: $mail_read_hover;
6878: }
1.938 bisitz 6879: */
1.795 www 6880:
1.938 bisitz 6881: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6882: background-color: $mail_replied;
6883: }
1.795 www 6884:
1.938 bisitz 6885: /*
6886: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6887: background-color: $mail_replied_hover;
6888: }
1.938 bisitz 6889: */
1.795 www 6890:
1.938 bisitz 6891: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6892: background-color: $mail_other;
6893: }
1.795 www 6894:
1.938 bisitz 6895: /*
6896: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6897: background-color: $mail_other_hover;
6898: }
1.938 bisitz 6899: */
1.494 raeburn 6900:
1.777 tempelho 6901: table.LC_data_table tr > td.LC_browser_file,
6902: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6903: background: #AAEE77;
1.389 albertel 6904: }
1.795 www 6905:
1.777 tempelho 6906: table.LC_data_table tr > td.LC_browser_file_locked,
6907: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6908: background: #FFAA99;
1.387 albertel 6909: }
1.795 www 6910:
1.777 tempelho 6911: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6912: background: #888888;
1.779 bisitz 6913: }
1.795 www 6914:
1.777 tempelho 6915: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6916: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6917: background: #F8F866;
1.777 tempelho 6918: }
1.795 www 6919:
1.696 bisitz 6920: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6921: background: #E0E8FF;
1.387 albertel 6922: }
1.696 bisitz 6923:
1.707 bisitz 6924: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6925: /* background: #77FF77; */
1.707 bisitz 6926: }
1.795 www 6927:
1.707 bisitz 6928: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6929: border-right: 8px solid #FFFF77;
1.707 bisitz 6930: }
1.795 www 6931:
1.707 bisitz 6932: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6933: border-right: 8px solid #FFAA77;
1.707 bisitz 6934: }
1.795 www 6935:
1.707 bisitz 6936: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6937: border-right: 8px solid #FF7777;
1.707 bisitz 6938: }
1.795 www 6939:
1.707 bisitz 6940: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6941: border-right: 8px solid #AAFF77;
1.707 bisitz 6942: }
1.795 www 6943:
1.707 bisitz 6944: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6945: border-right: 8px solid #11CC55;
1.707 bisitz 6946: }
6947:
1.388 albertel 6948: span.LC_current_location {
1.701 harmsja 6949: font-size:larger;
1.388 albertel 6950: background: $pgbg;
6951: }
1.387 albertel 6952:
1.1029 www 6953: span.LC_current_nav_location {
6954: font-weight:bold;
6955: background: $sidebg;
6956: }
6957:
1.395 albertel 6958: span.LC_parm_menu_item {
6959: font-size: larger;
6960: }
1.795 www 6961:
1.395 albertel 6962: span.LC_parm_scope_all {
6963: color: red;
6964: }
1.795 www 6965:
1.395 albertel 6966: span.LC_parm_scope_folder {
6967: color: green;
6968: }
1.795 www 6969:
1.395 albertel 6970: span.LC_parm_scope_resource {
6971: color: orange;
6972: }
1.795 www 6973:
1.395 albertel 6974: span.LC_parm_part {
6975: color: blue;
6976: }
1.795 www 6977:
1.911 bisitz 6978: span.LC_parm_folder,
6979: span.LC_parm_symb {
1.395 albertel 6980: font-size: x-small;
6981: font-family: $mono;
6982: color: #AAAAAA;
6983: }
6984:
1.977 bisitz 6985: ul.LC_parm_parmlist li {
6986: display: inline-block;
6987: padding: 0.3em 0.8em;
6988: vertical-align: top;
6989: width: 150px;
6990: border-top:1px solid $lg_border_color;
6991: }
6992:
1.795 www 6993: td.LC_parm_overview_level_menu,
6994: td.LC_parm_overview_map_menu,
6995: td.LC_parm_overview_parm_selectors,
6996: td.LC_parm_overview_restrictions {
1.396 albertel 6997: border: 1px solid black;
6998: border-collapse: collapse;
6999: }
1.795 www 7000:
1.1285 raeburn 7001: span.LC_parm_recursive,
7002: td.LC_parm_recursive {
7003: font-weight: bold;
7004: font-size: smaller;
7005: }
7006:
1.396 albertel 7007: table.LC_parm_overview_restrictions td {
7008: border-width: 1px 4px 1px 4px;
7009: border-style: solid;
7010: border-color: $pgbg;
7011: text-align: center;
7012: }
1.795 www 7013:
1.396 albertel 7014: table.LC_parm_overview_restrictions th {
7015: background: $tabbg;
7016: border-width: 1px 4px 1px 4px;
7017: border-style: solid;
7018: border-color: $pgbg;
7019: }
1.795 www 7020:
1.398 albertel 7021: table#LC_helpmenu {
1.803 bisitz 7022: border: none;
1.398 albertel 7023: height: 55px;
1.803 bisitz 7024: border-spacing: 0;
1.398 albertel 7025: }
7026:
7027: table#LC_helpmenu fieldset legend {
7028: font-size: larger;
7029: }
1.795 www 7030:
1.397 albertel 7031: table#LC_helpmenu_links {
7032: width: 100%;
7033: border: 1px solid black;
7034: background: $pgbg;
1.803 bisitz 7035: padding: 0;
1.397 albertel 7036: border-spacing: 1px;
7037: }
1.795 www 7038:
1.397 albertel 7039: table#LC_helpmenu_links tr td {
7040: padding: 1px;
7041: background: $tabbg;
1.399 albertel 7042: text-align: center;
7043: font-weight: bold;
1.397 albertel 7044: }
1.396 albertel 7045:
1.795 www 7046: table#LC_helpmenu_links a:link,
7047: table#LC_helpmenu_links a:visited,
1.397 albertel 7048: table#LC_helpmenu_links a:active {
7049: text-decoration: none;
7050: color: $font;
7051: }
1.795 www 7052:
1.397 albertel 7053: table#LC_helpmenu_links a:hover {
7054: text-decoration: underline;
7055: color: $vlink;
7056: }
1.396 albertel 7057:
1.417 albertel 7058: .LC_chrt_popup_exists {
7059: border: 1px solid #339933;
7060: margin: -1px;
7061: }
1.795 www 7062:
1.417 albertel 7063: .LC_chrt_popup_up {
7064: border: 1px solid yellow;
7065: margin: -1px;
7066: }
1.795 www 7067:
1.417 albertel 7068: .LC_chrt_popup {
7069: border: 1px solid #8888FF;
7070: background: #CCCCFF;
7071: }
1.795 www 7072:
1.421 albertel 7073: table.LC_pick_box {
7074: border-collapse: separate;
7075: background: white;
7076: border: 1px solid black;
7077: border-spacing: 1px;
7078: }
1.795 www 7079:
1.421 albertel 7080: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7081: background: $sidebg;
1.421 albertel 7082: font-weight: bold;
1.900 bisitz 7083: text-align: left;
1.740 bisitz 7084: vertical-align: top;
1.421 albertel 7085: width: 184px;
7086: padding: 8px;
7087: }
1.795 www 7088:
1.579 raeburn 7089: table.LC_pick_box td.LC_pick_box_value {
7090: text-align: left;
7091: padding: 8px;
7092: }
1.795 www 7093:
1.579 raeburn 7094: table.LC_pick_box td.LC_pick_box_select {
7095: text-align: left;
7096: padding: 8px;
7097: }
1.795 www 7098:
1.424 albertel 7099: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7100: padding: 0;
1.421 albertel 7101: height: 1px;
7102: background: black;
7103: }
1.795 www 7104:
1.421 albertel 7105: table.LC_pick_box td.LC_pick_box_submit {
7106: text-align: right;
7107: }
1.795 www 7108:
1.579 raeburn 7109: table.LC_pick_box td.LC_evenrow_value {
7110: text-align: left;
7111: padding: 8px;
7112: background-color: $data_table_light;
7113: }
1.795 www 7114:
1.579 raeburn 7115: table.LC_pick_box td.LC_oddrow_value {
7116: text-align: left;
7117: padding: 8px;
7118: background-color: $data_table_light;
7119: }
1.795 www 7120:
1.579 raeburn 7121: span.LC_helpform_receipt_cat {
7122: font-weight: bold;
7123: }
1.795 www 7124:
1.424 albertel 7125: table.LC_group_priv_box {
7126: background: white;
7127: border: 1px solid black;
7128: border-spacing: 1px;
7129: }
1.795 www 7130:
1.424 albertel 7131: table.LC_group_priv_box td.LC_pick_box_title {
7132: background: $tabbg;
7133: font-weight: bold;
7134: text-align: right;
7135: width: 184px;
7136: }
1.795 www 7137:
1.424 albertel 7138: table.LC_group_priv_box td.LC_groups_fixed {
7139: background: $data_table_light;
7140: text-align: center;
7141: }
1.795 www 7142:
1.424 albertel 7143: table.LC_group_priv_box td.LC_groups_optional {
7144: background: $data_table_dark;
7145: text-align: center;
7146: }
1.795 www 7147:
1.424 albertel 7148: table.LC_group_priv_box td.LC_groups_functionality {
7149: background: $data_table_darker;
7150: text-align: center;
7151: font-weight: bold;
7152: }
1.795 www 7153:
1.424 albertel 7154: table.LC_group_priv td {
7155: text-align: left;
1.803 bisitz 7156: padding: 0;
1.424 albertel 7157: }
7158:
7159: .LC_navbuttons {
7160: margin: 2ex 0ex 2ex 0ex;
7161: }
1.795 www 7162:
1.423 albertel 7163: .LC_topic_bar {
7164: font-weight: bold;
7165: background: $tabbg;
1.918 wenzelju 7166: margin: 1em 0em 1em 2em;
1.805 bisitz 7167: padding: 3px;
1.918 wenzelju 7168: font-size: 1.2em;
1.423 albertel 7169: }
1.795 www 7170:
1.423 albertel 7171: .LC_topic_bar span {
1.918 wenzelju 7172: left: 0.5em;
7173: position: absolute;
1.423 albertel 7174: vertical-align: middle;
1.918 wenzelju 7175: font-size: 1.2em;
1.423 albertel 7176: }
1.795 www 7177:
1.423 albertel 7178: table.LC_course_group_status {
7179: margin: 20px;
7180: }
1.795 www 7181:
1.423 albertel 7182: table.LC_status_selector td {
7183: vertical-align: top;
7184: text-align: center;
1.424 albertel 7185: padding: 4px;
7186: }
1.795 www 7187:
1.599 albertel 7188: div.LC_feedback_link {
1.616 albertel 7189: clear: both;
1.829 kalberla 7190: background: $sidebg;
1.779 bisitz 7191: width: 100%;
1.829 kalberla 7192: padding-bottom: 10px;
7193: border: 1px $tabbg solid;
1.833 kalberla 7194: height: 22px;
7195: line-height: 22px;
7196: padding-top: 5px;
7197: }
7198:
7199: div.LC_feedback_link img {
7200: height: 22px;
1.867 kalberla 7201: vertical-align:middle;
1.829 kalberla 7202: }
7203:
1.911 bisitz 7204: div.LC_feedback_link a {
1.829 kalberla 7205: text-decoration: none;
1.489 raeburn 7206: }
1.795 www 7207:
1.867 kalberla 7208: div.LC_comblock {
1.911 bisitz 7209: display:inline;
1.867 kalberla 7210: color:$font;
7211: font-size:90%;
7212: }
7213:
7214: div.LC_feedback_link div.LC_comblock {
7215: padding-left:5px;
7216: }
7217:
7218: div.LC_feedback_link div.LC_comblock a {
7219: color:$font;
7220: }
7221:
1.489 raeburn 7222: span.LC_feedback_link {
1.858 bisitz 7223: /* background: $feedback_link_bg; */
1.599 albertel 7224: font-size: larger;
7225: }
1.795 www 7226:
1.599 albertel 7227: span.LC_message_link {
1.858 bisitz 7228: /* background: $feedback_link_bg; */
1.599 albertel 7229: font-size: larger;
7230: position: absolute;
7231: right: 1em;
1.489 raeburn 7232: }
1.421 albertel 7233:
1.515 albertel 7234: table.LC_prior_tries {
1.524 albertel 7235: border: 1px solid #000000;
7236: border-collapse: separate;
7237: border-spacing: 1px;
1.515 albertel 7238: }
1.523 albertel 7239:
1.515 albertel 7240: table.LC_prior_tries td {
1.524 albertel 7241: padding: 2px;
1.515 albertel 7242: }
1.523 albertel 7243:
7244: .LC_answer_correct {
1.795 www 7245: background: lightgreen;
7246: color: darkgreen;
7247: padding: 6px;
1.523 albertel 7248: }
1.795 www 7249:
1.523 albertel 7250: .LC_answer_charged_try {
1.797 www 7251: background: #FFAAAA;
1.795 www 7252: color: darkred;
7253: padding: 6px;
1.523 albertel 7254: }
1.795 www 7255:
1.779 bisitz 7256: .LC_answer_not_charged_try,
1.523 albertel 7257: .LC_answer_no_grade,
7258: .LC_answer_late {
1.795 www 7259: background: lightyellow;
1.523 albertel 7260: color: black;
1.795 www 7261: padding: 6px;
1.523 albertel 7262: }
1.795 www 7263:
1.523 albertel 7264: .LC_answer_previous {
1.795 www 7265: background: lightblue;
7266: color: darkblue;
7267: padding: 6px;
1.523 albertel 7268: }
1.795 www 7269:
1.779 bisitz 7270: .LC_answer_no_message {
1.777 tempelho 7271: background: #FFFFFF;
7272: color: black;
1.795 www 7273: padding: 6px;
1.779 bisitz 7274: }
1.795 www 7275:
1.1334 raeburn 7276: .LC_answer_unknown,
7277: .LC_answer_warning {
1.779 bisitz 7278: background: orange;
7279: color: black;
1.795 www 7280: padding: 6px;
1.777 tempelho 7281: }
1.795 www 7282:
1.529 albertel 7283: span.LC_prior_numerical,
7284: span.LC_prior_string,
7285: span.LC_prior_custom,
7286: span.LC_prior_reaction,
7287: span.LC_prior_math {
1.925 bisitz 7288: font-family: $mono;
1.523 albertel 7289: white-space: pre;
7290: }
7291:
1.525 albertel 7292: span.LC_prior_string {
1.925 bisitz 7293: font-family: $mono;
1.525 albertel 7294: white-space: pre;
7295: }
7296:
1.523 albertel 7297: table.LC_prior_option {
7298: width: 100%;
7299: border-collapse: collapse;
7300: }
1.795 www 7301:
1.911 bisitz 7302: table.LC_prior_rank,
1.795 www 7303: table.LC_prior_match {
1.528 albertel 7304: border-collapse: collapse;
7305: }
1.795 www 7306:
1.528 albertel 7307: table.LC_prior_option tr td,
7308: table.LC_prior_rank tr td,
7309: table.LC_prior_match tr td {
1.524 albertel 7310: border: 1px solid #000000;
1.515 albertel 7311: }
7312:
1.855 bisitz 7313: .LC_nobreak {
1.544 albertel 7314: white-space: nowrap;
1.519 raeburn 7315: }
7316:
1.576 raeburn 7317: span.LC_cusr_emph {
7318: font-style: italic;
7319: }
7320:
1.633 raeburn 7321: span.LC_cusr_subheading {
7322: font-weight: normal;
7323: font-size: 85%;
7324: }
7325:
1.861 bisitz 7326: div.LC_docs_entry_move {
1.859 bisitz 7327: border: 1px solid #BBBBBB;
1.545 albertel 7328: background: #DDDDDD;
1.861 bisitz 7329: width: 22px;
1.859 bisitz 7330: padding: 1px;
7331: margin: 0;
1.545 albertel 7332: }
7333:
1.861 bisitz 7334: table.LC_data_table tr > td.LC_docs_entry_commands,
7335: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7336: font-size: x-small;
7337: }
1.795 www 7338:
1.861 bisitz 7339: .LC_docs_entry_parameter {
7340: white-space: nowrap;
7341: }
7342:
1.544 albertel 7343: .LC_docs_copy {
1.545 albertel 7344: color: #000099;
1.544 albertel 7345: }
1.795 www 7346:
1.544 albertel 7347: .LC_docs_cut {
1.545 albertel 7348: color: #550044;
1.544 albertel 7349: }
1.795 www 7350:
1.544 albertel 7351: .LC_docs_rename {
1.545 albertel 7352: color: #009900;
1.544 albertel 7353: }
1.795 www 7354:
1.544 albertel 7355: .LC_docs_remove {
1.545 albertel 7356: color: #990000;
7357: }
7358:
1.1284 raeburn 7359: .LC_docs_alias {
7360: color: #440055;
7361: }
7362:
1.1286 raeburn 7363: .LC_domprefs_email,
1.1284 raeburn 7364: .LC_docs_alias_name,
1.547 albertel 7365: .LC_docs_reinit_warn,
7366: .LC_docs_ext_edit {
7367: font-size: x-small;
7368: }
7369:
1.545 albertel 7370: table.LC_docs_adddocs td,
7371: table.LC_docs_adddocs th {
7372: border: 1px solid #BBBBBB;
7373: padding: 4px;
7374: background: #DDDDDD;
1.543 albertel 7375: }
7376:
1.584 albertel 7377: table.LC_sty_begin {
7378: background: #BBFFBB;
7379: }
1.795 www 7380:
1.584 albertel 7381: table.LC_sty_end {
7382: background: #FFBBBB;
7383: }
7384:
1.589 raeburn 7385: table.LC_double_column {
1.803 bisitz 7386: border-width: 0;
1.589 raeburn 7387: border-collapse: collapse;
7388: width: 100%;
7389: padding: 2px;
7390: }
7391:
7392: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7393: top: 2px;
1.589 raeburn 7394: left: 2px;
7395: width: 47%;
7396: vertical-align: top;
7397: }
7398:
7399: table.LC_double_column tr td.LC_right_col {
7400: top: 2px;
1.779 bisitz 7401: right: 2px;
1.589 raeburn 7402: width: 47%;
7403: vertical-align: top;
7404: }
7405:
1.591 raeburn 7406: div.LC_left_float {
7407: float: left;
7408: padding-right: 5%;
1.597 albertel 7409: padding-bottom: 4px;
1.591 raeburn 7410: }
7411:
7412: div.LC_clear_float_header {
1.597 albertel 7413: padding-bottom: 2px;
1.591 raeburn 7414: }
7415:
7416: div.LC_clear_float_footer {
1.597 albertel 7417: padding-top: 10px;
1.591 raeburn 7418: clear: both;
7419: }
7420:
1.597 albertel 7421: div.LC_grade_show_user {
1.941 bisitz 7422: /* border-left: 5px solid $sidebg; */
7423: border-top: 5px solid #000000;
7424: margin: 50px 0 0 0;
1.936 bisitz 7425: padding: 15px 0 5px 10px;
1.597 albertel 7426: }
1.795 www 7427:
1.936 bisitz 7428: div.LC_grade_show_user_odd_row {
1.941 bisitz 7429: /* border-left: 5px solid #000000; */
7430: }
7431:
7432: div.LC_grade_show_user div.LC_Box {
7433: margin-right: 50px;
1.597 albertel 7434: }
7435:
7436: div.LC_grade_submissions,
7437: div.LC_grade_message_center,
1.936 bisitz 7438: div.LC_grade_info_links {
1.597 albertel 7439: margin: 5px;
7440: width: 99%;
7441: background: #FFFFFF;
7442: }
1.795 www 7443:
1.597 albertel 7444: div.LC_grade_submissions_header,
1.936 bisitz 7445: div.LC_grade_message_center_header {
1.705 tempelho 7446: font-weight: bold;
7447: font-size: large;
1.597 albertel 7448: }
1.795 www 7449:
1.597 albertel 7450: div.LC_grade_submissions_body,
1.936 bisitz 7451: div.LC_grade_message_center_body {
1.597 albertel 7452: border: 1px solid black;
7453: width: 99%;
7454: background: #FFFFFF;
7455: }
1.795 www 7456:
1.613 albertel 7457: table.LC_scantron_action {
7458: width: 100%;
7459: }
1.795 www 7460:
1.613 albertel 7461: table.LC_scantron_action tr th {
1.698 harmsja 7462: font-weight:bold;
7463: font-style:normal;
1.613 albertel 7464: }
1.795 www 7465:
1.779 bisitz 7466: .LC_edit_problem_header,
1.614 albertel 7467: div.LC_edit_problem_footer {
1.705 tempelho 7468: font-weight: normal;
7469: font-size: medium;
1.602 albertel 7470: margin: 2px;
1.1060 bisitz 7471: background-color: $sidebg;
1.600 albertel 7472: }
1.795 www 7473:
1.600 albertel 7474: div.LC_edit_problem_header,
1.602 albertel 7475: div.LC_edit_problem_header div,
1.614 albertel 7476: div.LC_edit_problem_footer,
7477: div.LC_edit_problem_footer div,
1.602 albertel 7478: div.LC_edit_problem_editxml_header,
7479: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7480: z-index: 100;
1.600 albertel 7481: }
1.795 www 7482:
1.600 albertel 7483: div.LC_edit_problem_header_title {
1.705 tempelho 7484: font-weight: bold;
7485: font-size: larger;
1.602 albertel 7486: background: $tabbg;
7487: padding: 3px;
1.1060 bisitz 7488: margin: 0 0 5px 0;
1.602 albertel 7489: }
1.795 www 7490:
1.602 albertel 7491: table.LC_edit_problem_header_title {
7492: width: 100%;
1.600 albertel 7493: background: $tabbg;
1.602 albertel 7494: }
7495:
1.1205 golterma 7496: div.LC_edit_actionbar {
7497: background-color: $sidebg;
1.1218 droeschl 7498: margin: 0;
7499: padding: 0;
7500: line-height: 200%;
1.602 albertel 7501: }
1.795 www 7502:
1.1218 droeschl 7503: div.LC_edit_actionbar div{
7504: padding: 0;
7505: margin: 0;
7506: display: inline-block;
1.600 albertel 7507: }
1.795 www 7508:
1.1124 bisitz 7509: .LC_edit_opt {
7510: padding-left: 1em;
7511: white-space: nowrap;
7512: }
7513:
1.1152 golterma 7514: .LC_edit_problem_latexhelper{
7515: text-align: right;
7516: }
7517:
7518: #LC_edit_problem_colorful div{
7519: margin-left: 40px;
7520: }
7521:
1.1205 golterma 7522: #LC_edit_problem_codemirror div{
7523: margin-left: 0px;
7524: }
7525:
1.911 bisitz 7526: img.stift {
1.803 bisitz 7527: border-width: 0;
7528: vertical-align: middle;
1.677 riegler 7529: }
1.680 riegler 7530:
1.923 bisitz 7531: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7532: vertical-align: top;
1.777 tempelho 7533: }
1.795 www 7534:
1.716 raeburn 7535: div.LC_createcourse {
1.911 bisitz 7536: margin: 10px 10px 10px 10px;
1.716 raeburn 7537: }
7538:
1.917 raeburn 7539: .LC_dccid {
1.1130 raeburn 7540: float: right;
1.917 raeburn 7541: margin: 0.2em 0 0 0;
7542: padding: 0;
7543: font-size: 90%;
7544: display:none;
7545: }
7546:
1.897 wenzelju 7547: ol.LC_primary_menu a:hover,
1.721 harmsja 7548: ol#LC_MenuBreadcrumbs a:hover,
7549: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7550: ul#LC_secondary_menu a:hover,
1.721 harmsja 7551: .LC_FormSectionClearButton input:hover
1.795 www 7552: ul.LC_TabContent li:hover a {
1.952 onken 7553: color:$button_hover;
1.911 bisitz 7554: text-decoration:none;
1.693 droeschl 7555: }
7556:
1.779 bisitz 7557: h1 {
1.911 bisitz 7558: padding: 0;
7559: line-height:130%;
1.693 droeschl 7560: }
1.698 harmsja 7561:
1.911 bisitz 7562: h2,
7563: h3,
7564: h4,
7565: h5,
7566: h6 {
7567: margin: 5px 0 5px 0;
7568: padding: 0;
7569: line-height:130%;
1.693 droeschl 7570: }
1.795 www 7571:
7572: .LC_hcell {
1.911 bisitz 7573: padding:3px 15px 3px 15px;
7574: margin: 0;
7575: background-color:$tabbg;
7576: color:$fontmenu;
7577: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7578: }
1.795 www 7579:
1.840 bisitz 7580: .LC_Box > .LC_hcell {
1.911 bisitz 7581: margin: 0 -10px 10px -10px;
1.835 bisitz 7582: }
7583:
1.721 harmsja 7584: .LC_noBorder {
1.911 bisitz 7585: border: 0;
1.698 harmsja 7586: }
1.693 droeschl 7587:
1.721 harmsja 7588: .LC_FormSectionClearButton input {
1.911 bisitz 7589: background-color:transparent;
7590: border: none;
7591: cursor:pointer;
7592: text-decoration:underline;
1.693 droeschl 7593: }
1.763 bisitz 7594:
7595: .LC_help_open_topic {
1.911 bisitz 7596: color: #FFFFFF;
7597: background-color: #EEEEFF;
7598: margin: 1px;
7599: padding: 4px;
7600: border: 1px solid #000033;
7601: white-space: nowrap;
7602: /* vertical-align: middle; */
1.759 neumanie 7603: }
1.693 droeschl 7604:
1.911 bisitz 7605: dl,
7606: ul,
7607: div,
7608: fieldset {
7609: margin: 10px 10px 10px 0;
7610: /* overflow: hidden; */
1.693 droeschl 7611: }
1.795 www 7612:
1.1211 raeburn 7613: article.geogebraweb div {
7614: margin: 0;
7615: }
7616:
1.838 bisitz 7617: fieldset > legend {
1.911 bisitz 7618: font-weight: bold;
7619: padding: 0 5px 0 5px;
1.838 bisitz 7620: }
7621:
1.813 bisitz 7622: #LC_nav_bar {
1.911 bisitz 7623: float: left;
1.995 raeburn 7624: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7625: margin: 0 0 2px 0;
1.807 droeschl 7626: }
7627:
1.916 droeschl 7628: #LC_realm {
7629: margin: 0.2em 0 0 0;
7630: padding: 0;
7631: font-weight: bold;
7632: text-align: center;
1.995 raeburn 7633: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7634: }
7635:
1.911 bisitz 7636: #LC_nav_bar em {
7637: font-weight: bold;
7638: font-style: normal;
1.807 droeschl 7639: }
7640:
1.897 wenzelju 7641: ol.LC_primary_menu {
1.934 droeschl 7642: margin: 0;
1.1076 raeburn 7643: padding: 0;
1.807 droeschl 7644: }
7645:
1.852 droeschl 7646: ol#LC_PathBreadcrumbs {
1.911 bisitz 7647: margin: 0;
1.693 droeschl 7648: }
7649:
1.897 wenzelju 7650: ol.LC_primary_menu li {
1.1076 raeburn 7651: color: RGB(80, 80, 80);
7652: vertical-align: middle;
7653: text-align: left;
7654: list-style: none;
1.1205 golterma 7655: position: relative;
1.1076 raeburn 7656: float: left;
1.1205 golterma 7657: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7658: line-height: 1.5em;
1.1076 raeburn 7659: }
7660:
1.1205 golterma 7661: ol.LC_primary_menu li a,
7662: ol.LC_primary_menu li p {
1.1076 raeburn 7663: display: block;
7664: margin: 0;
7665: padding: 0 5px 0 10px;
7666: text-decoration: none;
7667: }
7668:
1.1205 golterma 7669: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7670: display: inline-block;
7671: width: 95%;
7672: text-align: left;
7673: }
7674:
7675: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7676: display: inline-block;
7677: width: 5%;
7678: float: right;
7679: text-align: right;
7680: font-size: 70%;
7681: }
7682:
7683: ol.LC_primary_menu ul {
1.1076 raeburn 7684: display: none;
1.1205 golterma 7685: width: 15em;
1.1076 raeburn 7686: background-color: $data_table_light;
1.1205 golterma 7687: position: absolute;
7688: top: 100%;
1.1076 raeburn 7689: }
7690:
1.1205 golterma 7691: ol.LC_primary_menu ul ul {
7692: left: 100%;
7693: top: 0;
7694: }
7695:
7696: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 7697: display: block;
7698: position: absolute;
7699: margin: 0;
7700: padding: 0;
1.1078 raeburn 7701: z-index: 2;
1.1076 raeburn 7702: }
7703:
7704: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 7705: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 7706: font-size: 90%;
1.911 bisitz 7707: vertical-align: top;
1.1076 raeburn 7708: float: none;
1.1079 raeburn 7709: border-left: 1px solid black;
7710: border-right: 1px solid black;
1.1205 golterma 7711: /* A dark bottom border to visualize different menu options;
7712: overwritten in the create_submenu routine for the last border-bottom of the menu */
7713: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 7714: }
7715:
1.1205 golterma 7716: ol.LC_primary_menu li li p:hover {
7717: color:$button_hover;
7718: text-decoration:none;
7719: background-color:$data_table_dark;
1.1076 raeburn 7720: }
7721:
7722: ol.LC_primary_menu li li a:hover {
7723: color:$button_hover;
7724: background-color:$data_table_dark;
1.693 droeschl 7725: }
7726:
1.1205 golterma 7727: /* Font-size equal to the size of the predecessors*/
7728: ol.LC_primary_menu li:hover li li {
7729: font-size: 100%;
7730: }
7731:
1.897 wenzelju 7732: ol.LC_primary_menu li img {
1.911 bisitz 7733: vertical-align: bottom;
1.934 droeschl 7734: height: 1.1em;
1.1077 raeburn 7735: margin: 0.2em 0 0 0;
1.693 droeschl 7736: }
7737:
1.897 wenzelju 7738: ol.LC_primary_menu a {
1.911 bisitz 7739: color: RGB(80, 80, 80);
7740: text-decoration: none;
1.693 droeschl 7741: }
1.795 www 7742:
1.949 droeschl 7743: ol.LC_primary_menu a.LC_new_message {
7744: font-weight:bold;
7745: color: darkred;
7746: }
7747:
1.975 raeburn 7748: ol.LC_docs_parameters {
7749: margin-left: 0;
7750: padding: 0;
7751: list-style: none;
7752: }
7753:
7754: ol.LC_docs_parameters li {
7755: margin: 0;
7756: padding-right: 20px;
7757: display: inline;
7758: }
7759:
1.976 raeburn 7760: ol.LC_docs_parameters li:before {
7761: content: "\\002022 \\0020";
7762: }
7763:
7764: li.LC_docs_parameters_title {
7765: font-weight: bold;
7766: }
7767:
7768: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7769: content: "";
7770: }
7771:
1.897 wenzelju 7772: ul#LC_secondary_menu {
1.1107 raeburn 7773: clear: right;
1.911 bisitz 7774: color: $fontmenu;
7775: background: $tabbg;
7776: list-style: none;
7777: padding: 0;
7778: margin: 0;
7779: width: 100%;
1.995 raeburn 7780: text-align: left;
1.1107 raeburn 7781: float: left;
1.808 droeschl 7782: }
7783:
1.897 wenzelju 7784: ul#LC_secondary_menu li {
1.911 bisitz 7785: font-weight: bold;
7786: line-height: 1.8em;
1.1107 raeburn 7787: border-right: 1px solid black;
7788: float: left;
7789: }
7790:
7791: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7792: background-color: $data_table_light;
7793: }
7794:
7795: ul#LC_secondary_menu li a {
1.911 bisitz 7796: padding: 0 0.8em;
1.1107 raeburn 7797: }
7798:
7799: ul#LC_secondary_menu li ul {
7800: display: none;
7801: }
7802:
7803: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7804: display: block;
7805: position: absolute;
7806: margin: 0;
7807: padding: 0;
7808: list-style:none;
7809: float: none;
7810: background-color: $data_table_light;
7811: z-index: 2;
7812: margin-left: -1px;
7813: }
7814:
7815: ul#LC_secondary_menu li ul li {
7816: font-size: 90%;
7817: vertical-align: top;
7818: border-left: 1px solid black;
1.911 bisitz 7819: border-right: 1px solid black;
1.1119 raeburn 7820: background-color: $data_table_light;
1.1107 raeburn 7821: list-style:none;
7822: float: none;
7823: }
7824:
7825: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7826: background-color: $data_table_dark;
1.807 droeschl 7827: }
7828:
1.847 tempelho 7829: ul.LC_TabContent {
1.911 bisitz 7830: display:block;
7831: background: $sidebg;
7832: border-bottom: solid 1px $lg_border_color;
7833: list-style:none;
1.1020 raeburn 7834: margin: -1px -10px 0 -10px;
1.911 bisitz 7835: padding: 0;
1.693 droeschl 7836: }
7837:
1.795 www 7838: ul.LC_TabContent li,
7839: ul.LC_TabContentBigger li {
1.911 bisitz 7840: float:left;
1.741 harmsja 7841: }
1.795 www 7842:
1.897 wenzelju 7843: ul#LC_secondary_menu li a {
1.911 bisitz 7844: color: $fontmenu;
7845: text-decoration: none;
1.693 droeschl 7846: }
1.795 www 7847:
1.721 harmsja 7848: ul.LC_TabContent {
1.952 onken 7849: min-height:20px;
1.721 harmsja 7850: }
1.795 www 7851:
7852: ul.LC_TabContent li {
1.911 bisitz 7853: vertical-align:middle;
1.959 onken 7854: padding: 0 16px 0 10px;
1.911 bisitz 7855: background-color:$tabbg;
7856: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7857: border-left: solid 1px $font;
1.721 harmsja 7858: }
1.795 www 7859:
1.847 tempelho 7860: ul.LC_TabContent .right {
1.911 bisitz 7861: float:right;
1.847 tempelho 7862: }
7863:
1.911 bisitz 7864: ul.LC_TabContent li a,
7865: ul.LC_TabContent li {
7866: color:rgb(47,47,47);
7867: text-decoration:none;
7868: font-size:95%;
7869: font-weight:bold;
1.952 onken 7870: min-height:20px;
7871: }
7872:
1.959 onken 7873: ul.LC_TabContent li a:hover,
7874: ul.LC_TabContent li a:focus {
1.952 onken 7875: color: $button_hover;
1.959 onken 7876: background:none;
7877: outline:none;
1.952 onken 7878: }
7879:
7880: ul.LC_TabContent li:hover {
7881: color: $button_hover;
7882: cursor:pointer;
1.721 harmsja 7883: }
1.795 www 7884:
1.911 bisitz 7885: ul.LC_TabContent li.active {
1.952 onken 7886: color: $font;
1.911 bisitz 7887: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7888: border-bottom:solid 1px #FFFFFF;
7889: cursor: default;
1.744 ehlerst 7890: }
1.795 www 7891:
1.959 onken 7892: ul.LC_TabContent li.active a {
7893: color:$font;
7894: background:#FFFFFF;
7895: outline: none;
7896: }
1.1047 raeburn 7897:
7898: ul.LC_TabContent li.goback {
7899: float: left;
7900: border-left: none;
7901: }
7902:
1.870 tempelho 7903: #maincoursedoc {
1.911 bisitz 7904: clear:both;
1.870 tempelho 7905: }
7906:
7907: ul.LC_TabContentBigger {
1.911 bisitz 7908: display:block;
7909: list-style:none;
7910: padding: 0;
1.870 tempelho 7911: }
7912:
1.795 www 7913: ul.LC_TabContentBigger li {
1.911 bisitz 7914: vertical-align:bottom;
7915: height: 30px;
7916: font-size:110%;
7917: font-weight:bold;
7918: color: #737373;
1.841 tempelho 7919: }
7920:
1.957 onken 7921: ul.LC_TabContentBigger li.active {
7922: position: relative;
7923: top: 1px;
7924: }
7925:
1.870 tempelho 7926: ul.LC_TabContentBigger li a {
1.911 bisitz 7927: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7928: height: 30px;
7929: line-height: 30px;
7930: text-align: center;
7931: display: block;
7932: text-decoration: none;
1.958 onken 7933: outline: none;
1.741 harmsja 7934: }
1.795 www 7935:
1.870 tempelho 7936: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7937: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7938: color:$font;
1.744 ehlerst 7939: }
1.795 www 7940:
1.870 tempelho 7941: ul.LC_TabContentBigger li b {
1.911 bisitz 7942: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7943: display: block;
7944: float: left;
7945: padding: 0 30px;
1.957 onken 7946: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7947: }
7948:
1.956 onken 7949: ul.LC_TabContentBigger li:hover b {
7950: color:$button_hover;
7951: }
7952:
1.870 tempelho 7953: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7954: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7955: color:$font;
1.957 onken 7956: border: 0;
1.741 harmsja 7957: }
1.693 droeschl 7958:
1.870 tempelho 7959:
1.862 bisitz 7960: ul.LC_CourseBreadcrumbs {
7961: background: $sidebg;
1.1020 raeburn 7962: height: 2em;
1.862 bisitz 7963: padding-left: 10px;
1.1020 raeburn 7964: margin: 0;
1.862 bisitz 7965: list-style-position: inside;
7966: }
7967:
1.911 bisitz 7968: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7969: ol#LC_PathBreadcrumbs {
1.911 bisitz 7970: padding-left: 10px;
7971: margin: 0;
1.933 droeschl 7972: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7973: }
7974:
1.911 bisitz 7975: ol#LC_MenuBreadcrumbs li,
7976: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7977: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7978: display: inline;
1.933 droeschl 7979: white-space: normal;
1.693 droeschl 7980: }
7981:
1.823 bisitz 7982: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7983: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7984: text-decoration: none;
7985: font-size:90%;
1.693 droeschl 7986: }
1.795 www 7987:
1.969 droeschl 7988: ol#LC_MenuBreadcrumbs h1 {
7989: display: inline;
7990: font-size: 90%;
7991: line-height: 2.5em;
7992: margin: 0;
7993: padding: 0;
7994: }
7995:
1.795 www 7996: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7997: text-decoration:none;
7998: font-size:100%;
7999: font-weight:bold;
1.693 droeschl 8000: }
1.795 www 8001:
1.840 bisitz 8002: .LC_Box {
1.911 bisitz 8003: border: solid 1px $lg_border_color;
8004: padding: 0 10px 10px 10px;
1.746 neumanie 8005: }
1.795 www 8006:
1.1020 raeburn 8007: .LC_DocsBox {
8008: border: solid 1px $lg_border_color;
8009: padding: 0 0 10px 10px;
8010: }
8011:
1.795 www 8012: .LC_AboutMe_Image {
1.911 bisitz 8013: float:left;
8014: margin-right:10px;
1.747 neumanie 8015: }
1.795 www 8016:
8017: .LC_Clear_AboutMe_Image {
1.911 bisitz 8018: clear:left;
1.747 neumanie 8019: }
1.795 www 8020:
1.721 harmsja 8021: dl.LC_ListStyleClean dt {
1.911 bisitz 8022: padding-right: 5px;
8023: display: table-header-group;
1.693 droeschl 8024: }
8025:
1.721 harmsja 8026: dl.LC_ListStyleClean dd {
1.911 bisitz 8027: display: table-row;
1.693 droeschl 8028: }
8029:
1.721 harmsja 8030: .LC_ListStyleClean,
8031: .LC_ListStyleSimple,
8032: .LC_ListStyleNormal,
1.795 www 8033: .LC_ListStyleSpecial {
1.911 bisitz 8034: /* display:block; */
8035: list-style-position: inside;
8036: list-style-type: none;
8037: overflow: hidden;
8038: padding: 0;
1.693 droeschl 8039: }
8040:
1.721 harmsja 8041: .LC_ListStyleSimple li,
8042: .LC_ListStyleSimple dd,
8043: .LC_ListStyleNormal li,
8044: .LC_ListStyleNormal dd,
8045: .LC_ListStyleSpecial li,
1.795 www 8046: .LC_ListStyleSpecial dd {
1.911 bisitz 8047: margin: 0;
8048: padding: 5px 5px 5px 10px;
8049: clear: both;
1.693 droeschl 8050: }
8051:
1.721 harmsja 8052: .LC_ListStyleClean li,
8053: .LC_ListStyleClean dd {
1.911 bisitz 8054: padding-top: 0;
8055: padding-bottom: 0;
1.693 droeschl 8056: }
8057:
1.721 harmsja 8058: .LC_ListStyleSimple dd,
1.795 www 8059: .LC_ListStyleSimple li {
1.911 bisitz 8060: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8061: }
8062:
1.721 harmsja 8063: .LC_ListStyleSpecial li,
8064: .LC_ListStyleSpecial dd {
1.911 bisitz 8065: list-style-type: none;
8066: background-color: RGB(220, 220, 220);
8067: margin-bottom: 4px;
1.693 droeschl 8068: }
8069:
1.721 harmsja 8070: table.LC_SimpleTable {
1.911 bisitz 8071: margin:5px;
8072: border:solid 1px $lg_border_color;
1.795 www 8073: }
1.693 droeschl 8074:
1.721 harmsja 8075: table.LC_SimpleTable tr {
1.911 bisitz 8076: padding: 0;
8077: border:solid 1px $lg_border_color;
1.693 droeschl 8078: }
1.795 www 8079:
8080: table.LC_SimpleTable thead {
1.911 bisitz 8081: background:rgb(220,220,220);
1.693 droeschl 8082: }
8083:
1.721 harmsja 8084: div.LC_columnSection {
1.911 bisitz 8085: display: block;
8086: clear: both;
8087: overflow: hidden;
8088: margin: 0;
1.693 droeschl 8089: }
8090:
1.721 harmsja 8091: div.LC_columnSection>* {
1.911 bisitz 8092: float: left;
8093: margin: 10px 20px 10px 0;
8094: overflow:hidden;
1.693 droeschl 8095: }
1.721 harmsja 8096:
1.795 www 8097: table em {
1.911 bisitz 8098: font-weight: bold;
8099: font-style: normal;
1.748 schulted 8100: }
1.795 www 8101:
1.779 bisitz 8102: table.LC_tableBrowseRes,
1.795 www 8103: table.LC_tableOfContent {
1.911 bisitz 8104: border:none;
8105: border-spacing: 1px;
8106: padding: 3px;
8107: background-color: #FFFFFF;
8108: font-size: 90%;
1.753 droeschl 8109: }
1.789 droeschl 8110:
1.911 bisitz 8111: table.LC_tableOfContent {
8112: border-collapse: collapse;
1.789 droeschl 8113: }
8114:
1.771 droeschl 8115: table.LC_tableBrowseRes a,
1.768 schulted 8116: table.LC_tableOfContent a {
1.911 bisitz 8117: background-color: transparent;
8118: text-decoration: none;
1.753 droeschl 8119: }
8120:
1.795 www 8121: table.LC_tableOfContent img {
1.911 bisitz 8122: border: none;
8123: height: 1.3em;
8124: vertical-align: text-bottom;
8125: margin-right: 0.3em;
1.753 droeschl 8126: }
1.757 schulted 8127:
1.795 www 8128: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8129: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8130: }
8131:
1.795 www 8132: a#LC_content_toolbar_everything {
1.911 bisitz 8133: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8134: }
8135:
1.795 www 8136: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8137: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8138: }
8139:
1.795 www 8140: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8141: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8142: }
8143:
1.795 www 8144: a#LC_content_toolbar_changefolder {
1.911 bisitz 8145: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8146: }
8147:
1.795 www 8148: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8149: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8150: }
8151:
1.1043 raeburn 8152: a#LC_content_toolbar_edittoplevel {
8153: background-image:url(/res/adm/pages/edittoplevel.gif);
8154: }
8155:
1.795 www 8156: ul#LC_toolbar li a:hover {
1.911 bisitz 8157: background-position: bottom center;
1.757 schulted 8158: }
8159:
1.795 www 8160: ul#LC_toolbar {
1.911 bisitz 8161: padding: 0;
8162: margin: 2px;
8163: list-style:none;
8164: position:relative;
8165: background-color:white;
1.1082 raeburn 8166: overflow: auto;
1.757 schulted 8167: }
8168:
1.795 www 8169: ul#LC_toolbar li {
1.911 bisitz 8170: border:1px solid white;
8171: padding: 0;
8172: margin: 0;
8173: float: left;
8174: display:inline;
8175: vertical-align:middle;
1.1082 raeburn 8176: white-space: nowrap;
1.911 bisitz 8177: }
1.757 schulted 8178:
1.783 amueller 8179:
1.795 www 8180: a.LC_toolbarItem {
1.911 bisitz 8181: display:block;
8182: padding: 0;
8183: margin: 0;
8184: height: 32px;
8185: width: 32px;
8186: color:white;
8187: border: none;
8188: background-repeat:no-repeat;
8189: background-color:transparent;
1.757 schulted 8190: }
8191:
1.915 droeschl 8192: ul.LC_funclist {
8193: margin: 0;
8194: padding: 0.5em 1em 0.5em 0;
8195: }
8196:
1.933 droeschl 8197: ul.LC_funclist > li:first-child {
8198: font-weight:bold;
8199: margin-left:0.8em;
8200: }
8201:
1.915 droeschl 8202: ul.LC_funclist + ul.LC_funclist {
8203: /*
8204: left border as a seperator if we have more than
8205: one list
8206: */
8207: border-left: 1px solid $sidebg;
8208: /*
8209: this hides the left border behind the border of the
8210: outer box if element is wrapped to the next 'line'
8211: */
8212: margin-left: -1px;
8213: }
8214:
1.843 bisitz 8215: ul.LC_funclist li {
1.915 droeschl 8216: display: inline;
1.782 bisitz 8217: white-space: nowrap;
1.915 droeschl 8218: margin: 0 0 0 25px;
8219: line-height: 150%;
1.782 bisitz 8220: }
8221:
1.974 wenzelju 8222: .LC_hidden {
8223: display: none;
8224: }
8225:
1.1030 www 8226: .LCmodal-overlay {
8227: position:fixed;
8228: top:0;
8229: right:0;
8230: bottom:0;
8231: left:0;
8232: height:100%;
8233: width:100%;
8234: margin:0;
8235: padding:0;
8236: background:#999;
8237: opacity:.75;
8238: filter: alpha(opacity=75);
8239: -moz-opacity: 0.75;
8240: z-index:101;
8241: }
8242:
8243: * html .LCmodal-overlay {
8244: position: absolute;
8245: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8246: }
8247:
8248: .LCmodal-window {
8249: position:fixed;
8250: top:50%;
8251: left:50%;
8252: margin:0;
8253: padding:0;
8254: z-index:102;
8255: }
8256:
8257: * html .LCmodal-window {
8258: position:absolute;
8259: }
8260:
8261: .LCclose-window {
8262: position:absolute;
8263: width:32px;
8264: height:32px;
8265: right:8px;
8266: top:8px;
8267: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8268: text-indent:-99999px;
8269: overflow:hidden;
8270: cursor:pointer;
8271: }
8272:
1.1335 raeburn 8273: pre.LC_wordwrap {
8274: white-space: pre-wrap;
8275: white-space: -moz-pre-wrap;
8276: white-space: -pre-wrap;
8277: white-space: -o-pre-wrap;
8278: word-wrap: break-word;
8279: }
8280:
1.1100 raeburn 8281: /*
1.1231 damieng 8282: styles used for response display
8283: */
8284: div.LC_radiofoil, div.LC_rankfoil {
8285: margin: .5em 0em .5em 0em;
8286: }
8287: table.LC_itemgroup {
8288: margin-top: 1em;
8289: }
8290:
8291: /*
1.1100 raeburn 8292: styles used by TTH when "Default set of options to pass to tth/m
8293: when converting TeX" in course settings has been set
8294:
8295: option passed: -t
8296:
8297: */
8298:
8299: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8300: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8301: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8302: td div.norm {line-height:normal;}
8303:
8304: /*
8305: option passed -y3
8306: */
8307:
8308: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8309: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8310: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8311:
1.1230 damieng 8312: /*
8313: sections with roles, for content only
8314: */
8315: section[class^="role-"] {
8316: padding-left: 10px;
8317: padding-right: 5px;
8318: margin-top: 8px;
8319: margin-bottom: 8px;
8320: border: 1px solid #2A4;
8321: border-radius: 5px;
8322: box-shadow: 0px 1px 1px #BBB;
8323: }
8324: section[class^="role-"]>h1 {
8325: position: relative;
8326: margin: 0px;
8327: padding-top: 10px;
8328: padding-left: 40px;
8329: }
8330: section[class^="role-"]>h1:before {
8331: position: absolute;
8332: left: -5px;
8333: top: 5px;
8334: }
8335: section.role-activity>h1:before {
8336: content:url('/adm/daxe/images/section_icons/activity.png');
8337: }
8338: section.role-advice>h1:before {
8339: content:url('/adm/daxe/images/section_icons/advice.png');
8340: }
8341: section.role-bibliography>h1:before {
8342: content:url('/adm/daxe/images/section_icons/bibliography.png');
8343: }
8344: section.role-citation>h1:before {
8345: content:url('/adm/daxe/images/section_icons/citation.png');
8346: }
8347: section.role-conclusion>h1:before {
8348: content:url('/adm/daxe/images/section_icons/conclusion.png');
8349: }
8350: section.role-definition>h1:before {
8351: content:url('/adm/daxe/images/section_icons/definition.png');
8352: }
8353: section.role-demonstration>h1:before {
8354: content:url('/adm/daxe/images/section_icons/demonstration.png');
8355: }
8356: section.role-example>h1:before {
8357: content:url('/adm/daxe/images/section_icons/example.png');
8358: }
8359: section.role-explanation>h1:before {
8360: content:url('/adm/daxe/images/section_icons/explanation.png');
8361: }
8362: section.role-introduction>h1:before {
8363: content:url('/adm/daxe/images/section_icons/introduction.png');
8364: }
8365: section.role-method>h1:before {
8366: content:url('/adm/daxe/images/section_icons/method.png');
8367: }
8368: section.role-more_information>h1:before {
8369: content:url('/adm/daxe/images/section_icons/more_information.png');
8370: }
8371: section.role-objectives>h1:before {
8372: content:url('/adm/daxe/images/section_icons/objectives.png');
8373: }
8374: section.role-prerequisites>h1:before {
8375: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8376: }
8377: section.role-remark>h1:before {
8378: content:url('/adm/daxe/images/section_icons/remark.png');
8379: }
8380: section.role-reminder>h1:before {
8381: content:url('/adm/daxe/images/section_icons/reminder.png');
8382: }
8383: section.role-summary>h1:before {
8384: content:url('/adm/daxe/images/section_icons/summary.png');
8385: }
8386: section.role-syntax>h1:before {
8387: content:url('/adm/daxe/images/section_icons/syntax.png');
8388: }
8389: section.role-warning>h1:before {
8390: content:url('/adm/daxe/images/section_icons/warning.png');
8391: }
8392:
1.1269 raeburn 8393: #LC_minitab_header {
8394: float:left;
8395: width:100%;
8396: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8397: font-size:93%;
8398: line-height:normal;
8399: margin: 0.5em 0 0.5em 0;
8400: }
8401: #LC_minitab_header ul {
8402: margin:0;
8403: padding:10px 10px 0;
8404: list-style:none;
8405: }
8406: #LC_minitab_header li {
8407: float:left;
8408: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8409: margin:0;
8410: padding:0 0 0 9px;
8411: }
8412: #LC_minitab_header a {
8413: display:block;
8414: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8415: padding:5px 15px 4px 6px;
8416: }
8417: #LC_minitab_header #LC_current_minitab {
8418: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8419: }
8420: #LC_minitab_header #LC_current_minitab a {
8421: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8422: padding-bottom:5px;
8423: }
8424:
8425:
1.343 albertel 8426: END
8427: }
8428:
1.306 albertel 8429: =pod
8430:
8431: =item * &headtag()
8432:
8433: Returns a uniform footer for LON-CAPA web pages.
8434:
1.307 albertel 8435: Inputs: $title - optional title for the head
8436: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8437: $args - optional arguments
1.319 albertel 8438: force_register - if is true call registerurl so the remote is
8439: informed
1.415 albertel 8440: redirect -> array ref of
8441: 1- seconds before redirect occurs
8442: 2- url to redirect to
8443: 3- whether the side effect should occur
1.315 albertel 8444: (side effect of setting
8445: $env{'internal.head.redirect'} to the url
8446: redirected too)
1.352 albertel 8447: domain -> force to color decorate a page for a specific
8448: domain
8449: function -> force usage of a specific rolish color scheme
8450: bgcolor -> override the default page bgcolor
1.460 albertel 8451: no_auto_mt_title
8452: -> prevent &mt()ing the title arg
1.464 albertel 8453:
1.306 albertel 8454: =cut
8455:
8456: sub headtag {
1.313 albertel 8457: my ($title,$head_extra,$args) = @_;
1.306 albertel 8458:
1.363 albertel 8459: my $function = $args->{'function'} || &get_users_function();
8460: my $domain = $args->{'domain'} || &determinedomain();
8461: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8462: my $httphost = $args->{'use_absolute'};
1.418 albertel 8463: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8464: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8465: #time(),
1.418 albertel 8466: $env{'environment.color.timestamp'},
1.363 albertel 8467: $function,$domain,$bgcolor);
8468:
1.369 www 8469: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8470:
1.308 albertel 8471: my $result =
8472: '<head>'.
1.1160 raeburn 8473: &font_settings($args);
1.319 albertel 8474:
1.1188 raeburn 8475: my $inhibitprint;
8476: if ($args->{'print_suppress'}) {
8477: $inhibitprint = &print_suppression();
8478: }
1.1064 raeburn 8479:
1.461 albertel 8480: if (!$args->{'frameset'}) {
8481: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8482: }
1.962 droeschl 8483: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8484: $result .= Apache::lonxml::display_title();
1.319 albertel 8485: }
1.436 albertel 8486: if (!$args->{'no_nav_bar'}
8487: && !$args->{'only_body'}
8488: && !$args->{'frameset'}) {
1.1154 raeburn 8489: $result .= &help_menu_js($httphost);
1.1032 www 8490: $result.=&modal_window();
1.1038 www 8491: $result.=&togglebox_script();
1.1034 www 8492: $result.=&wishlist_window();
1.1041 www 8493: $result.=&LCprogressbarUpdate_script();
1.1034 www 8494: } else {
8495: if ($args->{'add_modal'}) {
8496: $result.=&modal_window();
8497: }
8498: if ($args->{'add_wishlist'}) {
8499: $result.=&wishlist_window();
8500: }
1.1038 www 8501: if ($args->{'add_togglebox'}) {
8502: $result.=&togglebox_script();
8503: }
1.1041 www 8504: if ($args->{'add_progressbar'}) {
8505: $result.=&LCprogressbarUpdate_script();
8506: }
1.436 albertel 8507: }
1.314 albertel 8508: if (ref($args->{'redirect'})) {
1.414 albertel 8509: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8510: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8511: if (!$inhibit_continue) {
8512: $env{'internal.head.redirect'} = $url;
8513: }
1.313 albertel 8514: $result.=<<ADDMETA
8515: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8516: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8517: ADDMETA
1.1210 raeburn 8518: } else {
8519: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8520: my $requrl = $env{'request.uri'};
8521: if ($requrl eq '') {
8522: $requrl = $ENV{'REQUEST_URI'};
8523: $requrl =~ s/\?.+$//;
8524: }
8525: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8526: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8527: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8528: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8529: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8530: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 8531: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
8532: my $offload;
1.1210 raeburn 8533: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8534: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 8535: $offload = 1;
8536: }
8537: }
8538: unless ($offload) {
8539: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
8540: if ($domdefs{'offloadoth'}{$lonhost}) {
8541: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8542: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8543: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8544: $offload = 1;
8545: $dom_in_use = $env{'user.domain'};
8546: }
1.1210 raeburn 8547: }
1.1340 raeburn 8548: }
8549: }
8550: }
8551: if ($offload) {
8552: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
8553: if (($newserver) && ($newserver ne $lonhost)) {
8554: my $numsec = 5;
8555: my $timeout = $numsec * 1000;
8556: my ($newurl,$locknum,%locks,$msg);
8557: if ($env{'request.role.adv'}) {
8558: ($locknum,%locks) = &Apache::lonnet::get_locks();
8559: }
8560: my $disable_submit = 0;
8561: if ($requrl =~ /$LONCAPA::assess_re/) {
8562: $disable_submit = 1;
8563: }
8564: if ($locknum) {
8565: my @lockinfo = sort(values(%locks));
8566: $msg = &mt('Once the following tasks are complete: ')."\n".
8567: join(", ",sort(values(%locks)))."\n";
8568: if (&show_course()) {
8569: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
8570: } else {
8571: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 8572: }
1.1340 raeburn 8573: } else {
8574: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8575: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
8576: }
8577: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8578: $newurl = '/adm/switchserver?otherserver='.$newserver;
8579: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8580: $newurl .= '&role='.$env{'request.role'};
8581: }
8582: if ($env{'request.symb'}) {
8583: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
8584: if ($shownsymb =~ m{^/enc/}) {
8585: my $reqdmajor = 2;
8586: my $reqdminor = 11;
8587: my $reqdsubminor = 3;
8588: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
8589: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
8590: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
8591: if (($major eq '' && $minor eq '') ||
8592: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
8593: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
8594: ($reqdsubminor > $subminor))))) {
8595: undef($shownsymb);
8596: }
1.1210 raeburn 8597: }
1.1340 raeburn 8598: if ($shownsymb) {
8599: &js_escape(\$shownsymb);
8600: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 8601: }
1.1340 raeburn 8602: } else {
8603: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
8604: &js_escape(\$shownurl);
8605: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 8606: }
1.1340 raeburn 8607: }
8608: &js_escape(\$msg);
8609: $result.=<<OFFLOAD
1.1210 raeburn 8610: <meta http-equiv="pragma" content="no-cache" />
8611: <script type="text/javascript">
1.1215 raeburn 8612: // <![CDATA[
1.1210 raeburn 8613: function LC_Offload_Now() {
8614: var dest = "$newurl";
8615: if (dest != '') {
8616: window.location.href="$newurl";
8617: }
8618: }
1.1214 raeburn 8619: \$(document).ready(function () {
8620: window.alert('$msg');
8621: if ($disable_submit) {
1.1210 raeburn 8622: \$(".LC_hwk_submit").prop("disabled", true);
8623: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 8624: }
8625: setTimeout('LC_Offload_Now()', $timeout);
8626: });
1.1215 raeburn 8627: // ]]>
1.1210 raeburn 8628: </script>
8629: OFFLOAD
8630: }
8631: }
8632: }
8633: }
8634: }
1.313 albertel 8635: }
1.306 albertel 8636: if (!defined($title)) {
8637: $title = 'The LearningOnline Network with CAPA';
8638: }
1.460 albertel 8639: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
8640: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 8641: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
8642: if (!$args->{'frameset'}) {
8643: $result .= ' /';
8644: }
8645: $result .= '>'
1.1064 raeburn 8646: .$inhibitprint
1.414 albertel 8647: .$head_extra;
1.1242 raeburn 8648: my $clientmobile;
8649: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8650: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8651: } else {
8652: $clientmobile = $env{'browser.mobile'};
8653: }
8654: if ($clientmobile) {
1.1137 raeburn 8655: $result .= '
8656: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8657: <meta name="apple-mobile-web-app-capable" content="yes" />';
8658: }
1.1278 raeburn 8659: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8660: return $result.'</head>';
1.306 albertel 8661: }
8662:
8663: =pod
8664:
1.340 albertel 8665: =item * &font_settings()
8666:
8667: Returns neccessary <meta> to set the proper encoding
8668:
1.1160 raeburn 8669: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8670:
8671: =cut
8672:
8673: sub font_settings {
1.1160 raeburn 8674: my ($args) = @_;
1.340 albertel 8675: my $headerstring='';
1.1160 raeburn 8676: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8677: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 8678: $headerstring.=
8679: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8680: if (!$args->{'frameset'}) {
8681: $headerstring.= ' /';
8682: }
8683: $headerstring .= '>'."\n";
1.340 albertel 8684: }
8685: return $headerstring;
8686: }
8687:
1.341 albertel 8688: =pod
8689:
1.1064 raeburn 8690: =item * &print_suppression()
8691:
8692: In course context returns css which causes the body to be blank when media="print",
8693: if printout generation is unavailable for the current resource.
8694:
8695: This could be because:
8696:
8697: (a) printstartdate is in the future
8698:
8699: (b) printenddate is in the past
8700:
8701: (c) there is an active exam block with "printout"
8702: functionality blocked
8703:
8704: Users with pav, pfo or evb privileges are exempt.
8705:
8706: Inputs: none
8707:
8708: =cut
8709:
8710:
8711: sub print_suppression {
8712: my $noprint;
8713: if ($env{'request.course.id'}) {
8714: my $scope = $env{'request.course.id'};
8715: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8716: (&Apache::lonnet::allowed('pfo',$scope))) {
8717: return;
8718: }
8719: if ($env{'request.course.sec'} ne '') {
8720: $scope .= "/$env{'request.course.sec'}";
8721: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8722: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8723: return;
1.1064 raeburn 8724: }
8725: }
8726: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8727: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 8728: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 8729: if ($blocked) {
8730: my $checkrole = "cm./$cdom/$cnum";
8731: if ($env{'request.course.sec'} ne '') {
8732: $checkrole .= "/$env{'request.course.sec'}";
8733: }
8734: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8735: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8736: $noprint = 1;
8737: }
8738: }
8739: unless ($noprint) {
8740: my $symb = &Apache::lonnet::symbread();
8741: if ($symb ne '') {
8742: my $navmap = Apache::lonnavmaps::navmap->new();
8743: if (ref($navmap)) {
8744: my $res = $navmap->getBySymb($symb);
8745: if (ref($res)) {
8746: if (!$res->resprintable()) {
8747: $noprint = 1;
8748: }
8749: }
8750: }
8751: }
8752: }
8753: if ($noprint) {
8754: return <<"ENDSTYLE";
8755: <style type="text/css" media="print">
8756: body { display:none }
8757: </style>
8758: ENDSTYLE
8759: }
8760: }
8761: return;
8762: }
8763:
8764: =pod
8765:
1.341 albertel 8766: =item * &xml_begin()
8767:
8768: Returns the needed doctype and <html>
8769:
8770: Inputs: none
8771:
8772: =cut
8773:
8774: sub xml_begin {
1.1168 raeburn 8775: my ($is_frameset) = @_;
1.341 albertel 8776: my $output='';
8777:
8778: if ($env{'browser.mathml'}) {
8779: $output='<?xml version="1.0"?>'
8780: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8781: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8782:
8783: # .'<!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">] >'
8784: .'<!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">'
8785: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8786: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 8787: } elsif ($is_frameset) {
8788: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8789: '<html>'."\n";
1.341 albertel 8790: } else {
1.1168 raeburn 8791: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8792: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8793: }
8794: return $output;
8795: }
1.340 albertel 8796:
8797: =pod
8798:
1.306 albertel 8799: =item * &start_page()
8800:
8801: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8802:
1.648 raeburn 8803: Inputs:
8804:
8805: =over 4
8806:
8807: $title - optional title for the page
8808:
8809: $head_extra - optional extra HTML to incude inside the <head>
8810:
8811: $args - additional optional args supported are:
8812:
8813: =over 8
8814:
8815: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8816: arg on
1.814 bisitz 8817: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8818: add_entries -> additional attributes to add to the <body>
8819: domain -> force to color decorate a page for a
1.317 albertel 8820: specific domain
1.648 raeburn 8821: function -> force usage of a specific rolish color
1.317 albertel 8822: scheme
1.648 raeburn 8823: redirect -> see &headtag()
8824: bgcolor -> override the default page bg color
8825: js_ready -> return a string ready for being used in
1.317 albertel 8826: a javascript writeln
1.648 raeburn 8827: html_encode -> return a string ready for being used in
1.320 albertel 8828: a html attribute
1.648 raeburn 8829: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8830: $forcereg arg
1.648 raeburn 8831: frameset -> if true will start with a <frameset>
1.330 albertel 8832: rather than <body>
1.648 raeburn 8833: skip_phases -> hash ref of
1.338 albertel 8834: head -> skip the <html><head> generation
8835: body -> skip all <body> generation
1.648 raeburn 8836: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8837: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8838: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 8839: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8840: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 8841: group -> includes the current group, if page is for a
1.1274 raeburn 8842: specific group
8843: use_absolute -> for request for external resource or syllabus, this
8844: will contain https://<hostname> if server uses
8845: https (as per hosts.tab), but request is for http
8846: hostname -> hostname, originally from $r->hostname(), (optional).
1.361 albertel 8847:
1.648 raeburn 8848: =back
1.460 albertel 8849:
1.648 raeburn 8850: =back
1.562 albertel 8851:
1.306 albertel 8852: =cut
8853:
8854: sub start_page {
1.309 albertel 8855: my ($title,$head_extra,$args) = @_;
1.318 albertel 8856: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8857:
1.315 albertel 8858: $env{'internal.start_page'}++;
1.1318 raeburn 8859: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
1.964 droeschl 8860:
1.338 albertel 8861: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 8862: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8863: }
1.1316 raeburn 8864:
8865: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 8866: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
8867: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
8868: $args->{'no_primary_menu'} = 1;
8869: }
8870: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
8871: $args->{'no_inline_menu'} = 1;
8872: }
8873: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
8874: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
8875: }
8876: } else {
8877: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8878: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
8879: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
8880: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
8881: $args->{'no_primary_menu'} = 1;
8882: }
8883: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
8884: $args->{'no_inline_menu'} = 1;
8885: }
8886: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
8887: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
8888: }
8889: }
8890: }
1.1316 raeburn 8891: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
8892: $env{'course.'.$env{'request.course.id'}.'.domain'},
8893: $env{'course.'.$env{'request.course.id'}.'.num'});
8894: }
1.338 albertel 8895:
8896: if (! exists($args->{'skip_phases'}{'body'}) ) {
8897: if ($args->{'frameset'}) {
8898: my $attr_string = &make_attr_string($args->{'force_register'},
8899: $args->{'add_entries'});
8900: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8901: } else {
8902: $result .=
8903: &bodytag($title,
8904: $args->{'function'}, $args->{'add_entries'},
8905: $args->{'only_body'}, $args->{'domain'},
8906: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 8907: $args->{'bgcolor'}, $args,
1.1318 raeburn 8908: \@advtools,$ltiscope,$ltiuri,\%ltimenu);
1.831 bisitz 8909: }
1.330 albertel 8910: }
1.338 albertel 8911:
1.315 albertel 8912: if ($args->{'js_ready'}) {
1.713 kaisler 8913: $result = &js_ready($result);
1.315 albertel 8914: }
1.320 albertel 8915: if ($args->{'html_encode'}) {
1.713 kaisler 8916: $result = &html_encode($result);
8917: }
8918:
1.813 bisitz 8919: # Preparation for new and consistent functionlist at top of screen
8920: # if ($args->{'functionlist'}) {
8921: # $result .= &build_functionlist();
8922: #}
8923:
1.964 droeschl 8924: # Don't add anything more if only_body wanted or in const space
8925: return $result if $args->{'only_body'}
8926: || $env{'request.state'} eq 'construct';
1.813 bisitz 8927:
8928: #Breadcrumbs
1.758 kaisler 8929: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8930: &Apache::lonhtmlcommon::clear_breadcrumbs();
8931: #if any br links exists, add them to the breadcrumbs
8932: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8933: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8934: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8935: }
8936: }
1.1096 raeburn 8937: # if @advtools array contains items add then to the breadcrumbs
8938: if (@advtools > 0) {
8939: &Apache::lonmenu::advtools_crumbs(@advtools);
8940: }
1.1272 raeburn 8941: my $menulink;
8942: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8943: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 8944: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 8945: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
8946: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
8947: (!$env{'request.role.adv'}))) {
8948: $menulink = 0;
8949: } else {
8950: undef($menulink);
8951: }
1.758 kaisler 8952: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8953: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 8954: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 8955: } else {
1.1272 raeburn 8956: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 8957: }
1.320 albertel 8958: }
1.315 albertel 8959: return $result;
1.306 albertel 8960: }
8961:
8962: sub end_page {
1.315 albertel 8963: my ($args) = @_;
8964: $env{'internal.end_page'}++;
1.330 albertel 8965: my $result;
1.335 albertel 8966: if ($args->{'discussion'}) {
8967: my ($target,$parser);
8968: if (ref($args->{'discussion'})) {
8969: ($target,$parser) =($args->{'discussion'}{'target'},
8970: $args->{'discussion'}{'parser'});
8971: }
8972: $result .= &Apache::lonxml::xmlend($target,$parser);
8973: }
1.330 albertel 8974: if ($args->{'frameset'}) {
8975: $result .= '</frameset>';
8976: } else {
1.635 raeburn 8977: $result .= &endbodytag($args);
1.330 albertel 8978: }
1.1080 raeburn 8979: unless ($args->{'notbody'}) {
8980: $result .= "\n</html>";
8981: }
1.330 albertel 8982:
1.315 albertel 8983: if ($args->{'js_ready'}) {
1.317 albertel 8984: $result = &js_ready($result);
1.315 albertel 8985: }
1.335 albertel 8986:
1.320 albertel 8987: if ($args->{'html_encode'}) {
8988: $result = &html_encode($result);
8989: }
1.335 albertel 8990:
1.315 albertel 8991: return $result;
8992: }
8993:
1.1034 www 8994: sub wishlist_window {
8995: return(<<'ENDWISHLIST');
1.1046 raeburn 8996: <script type="text/javascript">
1.1034 www 8997: // <![CDATA[
8998: // <!-- BEGIN LON-CAPA Internal
8999: function set_wishlistlink(title, path) {
9000: if (!title) {
9001: title = document.title;
9002: title = title.replace(/^LON-CAPA /,'');
9003: }
1.1175 raeburn 9004: title = encodeURIComponent(title);
1.1203 raeburn 9005: title = title.replace("'","\\\'");
1.1034 www 9006: if (!path) {
9007: path = location.pathname;
9008: }
1.1175 raeburn 9009: path = encodeURIComponent(path);
1.1203 raeburn 9010: path = path.replace("'","\\\'");
1.1034 www 9011: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9012: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9013: }
9014: // END LON-CAPA Internal -->
9015: // ]]>
9016: </script>
9017: ENDWISHLIST
9018: }
9019:
1.1030 www 9020: sub modal_window {
9021: return(<<'ENDMODAL');
1.1046 raeburn 9022: <script type="text/javascript">
1.1030 www 9023: // <![CDATA[
9024: // <!-- BEGIN LON-CAPA Internal
9025: var modalWindow = {
9026: parent:"body",
9027: windowId:null,
9028: content:null,
9029: width:null,
9030: height:null,
9031: close:function()
9032: {
9033: $(".LCmodal-window").remove();
9034: $(".LCmodal-overlay").remove();
9035: },
9036: open:function()
9037: {
9038: var modal = "";
9039: modal += "<div class=\"LCmodal-overlay\"></div>";
9040: 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;\">";
9041: modal += this.content;
9042: modal += "</div>";
9043:
9044: $(this.parent).append(modal);
9045:
9046: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9047: $(".LCclose-window").click(function(){modalWindow.close();});
9048: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9049: }
9050: };
1.1140 raeburn 9051: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9052: {
1.1266 raeburn 9053: source = source.replace(/'/g,"'");
1.1030 www 9054: modalWindow.windowId = "myModal";
9055: modalWindow.width = width;
9056: modalWindow.height = height;
1.1196 raeburn 9057: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9058: modalWindow.open();
1.1208 raeburn 9059: };
1.1030 www 9060: // END LON-CAPA Internal -->
9061: // ]]>
9062: </script>
9063: ENDMODAL
9064: }
9065:
9066: sub modal_link {
1.1140 raeburn 9067: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9068: unless ($width) { $width=480; }
9069: unless ($height) { $height=400; }
1.1031 www 9070: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 9071: unless ($transparency) { $transparency='true'; }
9072:
1.1074 raeburn 9073: my $target_attr;
9074: if (defined($target)) {
9075: $target_attr = 'target="'.$target.'"';
9076: }
9077: return <<"ENDLINK";
1.1336 raeburn 9078: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9079: ENDLINK
1.1030 www 9080: }
9081:
1.1032 www 9082: sub modal_adhoc_script {
9083: my ($funcname,$width,$height,$content)=@_;
9084: return (<<ENDADHOC);
1.1046 raeburn 9085: <script type="text/javascript">
1.1032 www 9086: // <![CDATA[
9087: var $funcname = function()
9088: {
9089: modalWindow.windowId = "myModal";
9090: modalWindow.width = $width;
9091: modalWindow.height = $height;
9092: modalWindow.content = '$content';
9093: modalWindow.open();
9094: };
9095: // ]]>
9096: </script>
9097: ENDADHOC
9098: }
9099:
1.1041 www 9100: sub modal_adhoc_inner {
9101: my ($funcname,$width,$height,$content)=@_;
9102: my $innerwidth=$width-20;
9103: $content=&js_ready(
1.1140 raeburn 9104: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
9105: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9106: $content.
1.1041 www 9107: &end_scrollbox().
1.1140 raeburn 9108: &end_page()
1.1041 www 9109: );
9110: return &modal_adhoc_script($funcname,$width,$height,$content);
9111: }
9112:
9113: sub modal_adhoc_window {
9114: my ($funcname,$width,$height,$content,$linktext)=@_;
9115: return &modal_adhoc_inner($funcname,$width,$height,$content).
9116: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9117: }
9118:
9119: sub modal_adhoc_launch {
9120: my ($funcname,$width,$height,$content)=@_;
9121: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9122: <script type="text/javascript">
9123: // <![CDATA[
9124: $funcname();
9125: // ]]>
9126: </script>
9127: ENDLAUNCH
9128: }
9129:
9130: sub modal_adhoc_close {
9131: return (<<ENDCLOSE);
9132: <script type="text/javascript">
9133: // <![CDATA[
9134: modalWindow.close();
9135: // ]]>
9136: </script>
9137: ENDCLOSE
9138: }
9139:
1.1038 www 9140: sub togglebox_script {
9141: return(<<ENDTOGGLE);
9142: <script type="text/javascript">
9143: // <![CDATA[
9144: function LCtoggleDisplay(id,hidetext,showtext) {
9145: link = document.getElementById(id + "link").childNodes[0];
9146: with (document.getElementById(id).style) {
9147: if (display == "none" ) {
9148: display = "inline";
9149: link.nodeValue = hidetext;
9150: } else {
9151: display = "none";
9152: link.nodeValue = showtext;
9153: }
9154: }
9155: }
9156: // ]]>
9157: </script>
9158: ENDTOGGLE
9159: }
9160:
1.1039 www 9161: sub start_togglebox {
9162: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9163: unless ($heading) { $heading=''; } else { $heading.=' '; }
9164: unless ($showtext) { $showtext=&mt('show'); }
9165: unless ($hidetext) { $hidetext=&mt('hide'); }
9166: unless ($headerbg) { $headerbg='#FFFFFF'; }
9167: return &start_data_table().
9168: &start_data_table_header_row().
9169: '<td bgcolor="'.$headerbg.'">'.$heading.
9170: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9171: $showtext.'\')">'.$showtext.'</a>]</td>'.
9172: &end_data_table_header_row().
9173: '<tr id="'.$id.'" style="display:none""><td>';
9174: }
9175:
9176: sub end_togglebox {
9177: return '</td></tr>'.&end_data_table();
9178: }
9179:
1.1041 www 9180: sub LCprogressbar_script {
1.1302 raeburn 9181: my ($id,$number_to_do)=@_;
9182: if ($number_to_do) {
9183: return(<<ENDPROGRESS);
1.1041 www 9184: <script type="text/javascript">
9185: // <![CDATA[
1.1045 www 9186: \$('#progressbar$id').progressbar({
1.1041 www 9187: value: 0,
9188: change: function(event, ui) {
9189: var newVal = \$(this).progressbar('option', 'value');
9190: \$('.pblabel', this).text(LCprogressTxt);
9191: }
9192: });
9193: // ]]>
9194: </script>
9195: ENDPROGRESS
1.1302 raeburn 9196: } else {
9197: return(<<ENDPROGRESS);
9198: <script type="text/javascript">
9199: // <![CDATA[
9200: \$('#progressbar$id').progressbar({
9201: value: false,
9202: create: function(event, ui) {
9203: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9204: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9205: }
9206: });
9207: // ]]>
9208: </script>
9209: ENDPROGRESS
9210: }
1.1041 www 9211: }
9212:
9213: sub LCprogressbarUpdate_script {
9214: return(<<ENDPROGRESSUPDATE);
9215: <style type="text/css">
9216: .ui-progressbar { position:relative; }
1.1302 raeburn 9217: .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 9218: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9219: </style>
9220: <script type="text/javascript">
9221: // <![CDATA[
1.1045 www 9222: var LCprogressTxt='---';
9223:
1.1302 raeburn 9224: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9225: LCprogressTxt=progresstext;
1.1302 raeburn 9226: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9227: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9228: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 9229: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9230: } else {
9231: \$('#progressbar'+id).progressbar('value',percent);
9232: }
1.1041 www 9233: }
9234: // ]]>
9235: </script>
9236: ENDPROGRESSUPDATE
9237: }
9238:
1.1042 www 9239: my $LClastpercent;
1.1045 www 9240: my $LCidcnt;
9241: my $LCcurrentid;
1.1042 www 9242:
1.1041 www 9243: sub LCprogressbar {
1.1302 raeburn 9244: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9245: $LClastpercent=0;
1.1045 www 9246: $LCidcnt++;
9247: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 9248: my ($starting,$content);
9249: if ($number_to_do) {
9250: $starting=&mt('Starting');
9251: $content=(<<ENDPROGBAR);
9252: $preamble
1.1045 www 9253: <div id="progressbar$LCcurrentid">
1.1041 www 9254: <span class="pblabel">$starting</span>
9255: </div>
9256: ENDPROGBAR
1.1302 raeburn 9257: } else {
9258: $starting=&mt('Loading...');
9259: $LClastpercent='false';
9260: $content=(<<ENDPROGBAR);
9261: $preamble
9262: <div id="progressbar$LCcurrentid">
9263: <div class="progress-label">$starting</div>
9264: </div>
9265: ENDPROGBAR
9266: }
9267: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9268: }
9269:
9270: sub LCprogressbarUpdate {
1.1302 raeburn 9271: my ($r,$val,$text,$number_to_do)=@_;
9272: if ($number_to_do) {
9273: unless ($val) {
9274: if ($LClastpercent) {
9275: $val=$LClastpercent;
9276: } else {
9277: $val=0;
9278: }
9279: }
9280: if ($val<0) { $val=0; }
9281: if ($val>100) { $val=0; }
9282: $LClastpercent=$val;
9283: unless ($text) { $text=$val.'%'; }
9284: } else {
9285: $val = 'false';
1.1042 www 9286: }
1.1041 www 9287: $text=&js_ready($text);
1.1044 www 9288: &r_print($r,<<ENDUPDATE);
1.1041 www 9289: <script type="text/javascript">
9290: // <![CDATA[
1.1302 raeburn 9291: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9292: // ]]>
9293: </script>
9294: ENDUPDATE
1.1035 www 9295: }
9296:
1.1042 www 9297: sub LCprogressbarClose {
9298: my ($r)=@_;
9299: $LClastpercent=0;
1.1044 www 9300: &r_print($r,<<ENDCLOSE);
1.1042 www 9301: <script type="text/javascript">
9302: // <![CDATA[
1.1045 www 9303: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9304: // ]]>
9305: </script>
9306: ENDCLOSE
1.1044 www 9307: }
9308:
9309: sub r_print {
9310: my ($r,$to_print)=@_;
9311: if ($r) {
9312: $r->print($to_print);
9313: $r->rflush();
9314: } else {
9315: print($to_print);
9316: }
1.1042 www 9317: }
9318:
1.320 albertel 9319: sub html_encode {
9320: my ($result) = @_;
9321:
1.322 albertel 9322: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9323:
9324: return $result;
9325: }
1.1044 www 9326:
1.317 albertel 9327: sub js_ready {
9328: my ($result) = @_;
9329:
1.323 albertel 9330: $result =~ s/[\n\r]/ /xmsg;
9331: $result =~ s/\\/\\\\/xmsg;
9332: $result =~ s/'/\\'/xmsg;
1.372 albertel 9333: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9334:
9335: return $result;
9336: }
9337:
1.315 albertel 9338: sub validate_page {
9339: if ( exists($env{'internal.start_page'})
1.316 albertel 9340: && $env{'internal.start_page'} > 1) {
9341: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9342: $env{'internal.start_page'}.' '.
1.316 albertel 9343: $ENV{'request.filename'});
1.315 albertel 9344: }
9345: if ( exists($env{'internal.end_page'})
1.316 albertel 9346: && $env{'internal.end_page'} > 1) {
9347: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9348: $env{'internal.end_page'}.' '.
1.316 albertel 9349: $env{'request.filename'});
1.315 albertel 9350: }
9351: if ( exists($env{'internal.start_page'})
9352: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9353: &Apache::lonnet::logthis('start_page called without end_page '.
9354: $env{'request.filename'});
1.315 albertel 9355: }
9356: if ( ! exists($env{'internal.start_page'})
9357: && exists($env{'internal.end_page'})) {
1.316 albertel 9358: &Apache::lonnet::logthis('end_page called without start_page'.
9359: $env{'request.filename'});
1.315 albertel 9360: }
1.306 albertel 9361: }
1.315 albertel 9362:
1.996 www 9363:
9364: sub start_scrollbox {
1.1140 raeburn 9365: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9366: unless ($outerwidth) { $outerwidth='520px'; }
9367: unless ($width) { $width='500px'; }
9368: unless ($height) { $height='200px'; }
1.1075 raeburn 9369: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9370: if ($id ne '') {
1.1140 raeburn 9371: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9372: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9373: }
1.1075 raeburn 9374: if ($bgcolor ne '') {
9375: $tdcol = "background-color: $bgcolor;";
9376: }
1.1137 raeburn 9377: my $nicescroll_js;
9378: if ($env{'browser.mobile'}) {
1.1140 raeburn 9379: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9380: }
9381: return <<"END";
9382: $nicescroll_js
9383:
9384: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9385: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9386: END
9387: }
9388:
9389: sub end_scrollbox {
9390: return '</div></td></tr></table>';
9391: }
9392:
9393: sub nicescroll_javascript {
9394: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9395: my %options;
9396: if (ref($cursor) eq 'HASH') {
9397: %options = %{$cursor};
9398: }
9399: unless ($options{'railalign'} =~ /^left|right$/) {
9400: $options{'railalign'} = 'left';
9401: }
9402: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9403: my $function = &get_users_function();
9404: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9405: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9406: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9407: }
1.1140 raeburn 9408: }
9409: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9410: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9411: $options{'cursoropacity'}='1.0';
9412: }
1.1140 raeburn 9413: } else {
9414: $options{'cursoropacity'}='1.0';
9415: }
9416: if ($options{'cursorfixedheight'} eq 'none') {
9417: delete($options{'cursorfixedheight'});
9418: } else {
9419: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9420: }
9421: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9422: delete($options{'railoffset'});
9423: }
9424: my @niceoptions;
9425: while (my($key,$value) = each(%options)) {
9426: if ($value =~ /^\{.+\}$/) {
9427: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9428: } else {
1.1140 raeburn 9429: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9430: }
1.1140 raeburn 9431: }
9432: my $nicescroll_js = '
1.1137 raeburn 9433: $(document).ready(
1.1140 raeburn 9434: function() {
9435: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9436: }
1.1137 raeburn 9437: );
9438: ';
1.1140 raeburn 9439: if ($framecheck) {
9440: $nicescroll_js .= '
9441: function expand_div(caller) {
9442: if (top === self) {
9443: document.getElementById("'.$id.'").style.width = "auto";
9444: document.getElementById("'.$id.'").style.height = "auto";
9445: } else {
9446: try {
9447: if (parent.frames) {
9448: if (parent.frames.length > 1) {
9449: var framesrc = parent.frames[1].location.href;
9450: var currsrc = framesrc.replace(/\#.*$/,"");
9451: if ((caller == "search") || (currsrc == "'.$location.'")) {
9452: document.getElementById("'.$id.'").style.width = "auto";
9453: document.getElementById("'.$id.'").style.height = "auto";
9454: }
9455: }
9456: }
9457: } catch (e) {
9458: return;
9459: }
1.1137 raeburn 9460: }
1.1140 raeburn 9461: return;
1.996 www 9462: }
1.1140 raeburn 9463: ';
9464: }
9465: if ($needjsready) {
9466: $nicescroll_js = '
9467: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9468: } else {
9469: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9470: }
9471: return $nicescroll_js;
1.996 www 9472: }
9473:
1.318 albertel 9474: sub simple_error_page {
1.1150 bisitz 9475: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 9476: my %displayargs;
1.1151 raeburn 9477: if (ref($args) eq 'HASH') {
9478: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 9479: if ($args->{'only_body'}) {
9480: $displayargs{'only_body'} = 1;
9481: }
9482: if ($args->{'no_nav_bar'}) {
9483: $displayargs{'no_nav_bar'} = 1;
9484: }
1.1151 raeburn 9485: } else {
9486: $msg = &mt($msg);
9487: }
1.1150 bisitz 9488:
1.318 albertel 9489: my $page =
1.1304 raeburn 9490: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 9491: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9492: &Apache::loncommon::end_page();
9493: if (ref($r)) {
9494: $r->print($page);
1.327 albertel 9495: return;
1.318 albertel 9496: }
9497: return $page;
9498: }
1.347 albertel 9499:
9500: {
1.610 albertel 9501: my @row_count;
1.961 onken 9502:
9503: sub start_data_table_count {
9504: unshift(@row_count, 0);
9505: return;
9506: }
9507:
9508: sub end_data_table_count {
9509: shift(@row_count);
9510: return;
9511: }
9512:
1.347 albertel 9513: sub start_data_table {
1.1018 raeburn 9514: my ($add_class,$id) = @_;
1.422 albertel 9515: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9516: my $table_id;
9517: if (defined($id)) {
9518: $table_id = ' id="'.$id.'"';
9519: }
1.961 onken 9520: &start_data_table_count();
1.1018 raeburn 9521: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9522: }
9523:
9524: sub end_data_table {
1.961 onken 9525: &end_data_table_count();
1.389 albertel 9526: return '</table>'."\n";;
1.347 albertel 9527: }
9528:
9529: sub start_data_table_row {
1.974 wenzelju 9530: my ($add_class, $id) = @_;
1.610 albertel 9531: $row_count[0]++;
9532: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9533: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9534: $id = (' id="'.$id.'"') unless ($id eq '');
9535: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9536: }
1.471 banghart 9537:
9538: sub continue_data_table_row {
1.974 wenzelju 9539: my ($add_class, $id) = @_;
1.610 albertel 9540: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9541: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9542: $id = (' id="'.$id.'"') unless ($id eq '');
9543: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9544: }
1.347 albertel 9545:
9546: sub end_data_table_row {
1.389 albertel 9547: return '</tr>'."\n";;
1.347 albertel 9548: }
1.367 www 9549:
1.421 albertel 9550: sub start_data_table_empty_row {
1.707 bisitz 9551: # $row_count[0]++;
1.421 albertel 9552: return '<tr class="LC_empty_row" >'."\n";;
9553: }
9554:
9555: sub end_data_table_empty_row {
9556: return '</tr>'."\n";;
9557: }
9558:
1.367 www 9559: sub start_data_table_header_row {
1.389 albertel 9560: return '<tr class="LC_header_row">'."\n";;
1.367 www 9561: }
9562:
9563: sub end_data_table_header_row {
1.389 albertel 9564: return '</tr>'."\n";;
1.367 www 9565: }
1.890 droeschl 9566:
9567: sub data_table_caption {
9568: my $caption = shift;
9569: return "<caption class=\"LC_caption\">$caption</caption>";
9570: }
1.347 albertel 9571: }
9572:
1.548 albertel 9573: =pod
9574:
9575: =item * &inhibit_menu_check($arg)
9576:
9577: Checks for a inhibitmenu state and generates output to preserve it
9578:
9579: Inputs: $arg - can be any of
9580: - undef - in which case the return value is a string
9581: to add into arguments list of a uri
9582: - 'input' - in which case the return value is a HTML
9583: <form> <input> field of type hidden to
9584: preserve the value
9585: - a url - in which case the return value is the url with
9586: the neccesary cgi args added to preserve the
9587: inhibitmenu state
9588: - a ref to a url - no return value, but the string is
9589: updated to include the neccessary cgi
9590: args to preserve the inhibitmenu state
9591:
9592: =cut
9593:
9594: sub inhibit_menu_check {
9595: my ($arg) = @_;
9596: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9597: if ($arg eq 'input') {
9598: if ($env{'form.inhibitmenu'}) {
9599: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9600: } else {
9601: return
9602: }
9603: }
9604: if ($env{'form.inhibitmenu'}) {
9605: if (ref($arg)) {
9606: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9607: } elsif ($arg eq '') {
9608: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9609: } else {
9610: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9611: }
9612: }
9613: if (!ref($arg)) {
9614: return $arg;
9615: }
9616: }
9617:
1.251 albertel 9618: ###############################################
1.182 matthew 9619:
9620: =pod
9621:
1.549 albertel 9622: =back
9623:
9624: =head1 User Information Routines
9625:
9626: =over 4
9627:
1.405 albertel 9628: =item * &get_users_function()
1.182 matthew 9629:
9630: Used by &bodytag to determine the current users primary role.
9631: Returns either 'student','coordinator','admin', or 'author'.
9632:
9633: =cut
9634:
9635: ###############################################
9636: sub get_users_function {
1.815 tempelho 9637: my $function = 'norole';
1.818 tempelho 9638: if ($env{'request.role'}=~/^(st)/) {
9639: $function='student';
9640: }
1.907 raeburn 9641: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9642: $function='coordinator';
9643: }
1.258 albertel 9644: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9645: $function='admin';
9646: }
1.826 bisitz 9647: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9648: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9649: $function='author';
9650: }
9651: return $function;
1.54 www 9652: }
1.99 www 9653:
9654: ###############################################
9655:
1.233 raeburn 9656: =pod
9657:
1.821 raeburn 9658: =item * &show_course()
9659:
9660: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9661: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9662:
9663: Inputs:
9664: None
9665:
9666: Outputs:
9667: Scalar: 1 if 'Course' to be used, 0 otherwise.
9668:
9669: =cut
9670:
9671: ###############################################
9672: sub show_course {
9673: my $course = !$env{'user.adv'};
9674: if (!$env{'user.adv'}) {
9675: foreach my $env (keys(%env)) {
9676: next if ($env !~ m/^user\.priv\./);
9677: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9678: $course = 0;
9679: last;
9680: }
9681: }
9682: }
9683: return $course;
9684: }
9685:
9686: ###############################################
9687:
9688: =pod
9689:
1.542 raeburn 9690: =item * &check_user_status()
1.274 raeburn 9691:
9692: Determines current status of supplied role for a
9693: specific user. Roles can be active, previous or future.
9694:
9695: Inputs:
9696: user's domain, user's username, course's domain,
1.375 raeburn 9697: course's number, optional section ID.
1.274 raeburn 9698:
9699: Outputs:
9700: role status: active, previous or future.
9701:
9702: =cut
9703:
9704: sub check_user_status {
1.412 raeburn 9705: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9706: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 9707: my @uroles = keys(%userinfo);
1.274 raeburn 9708: my $srchstr;
9709: my $active_chk = 'none';
1.412 raeburn 9710: my $now = time;
1.274 raeburn 9711: if (@uroles > 0) {
1.908 raeburn 9712: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9713: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9714: } else {
1.412 raeburn 9715: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9716: }
9717: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9718: my $role_end = 0;
9719: my $role_start = 0;
9720: $active_chk = 'active';
1.412 raeburn 9721: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9722: $role_end = $1;
9723: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9724: $role_start = $1;
1.274 raeburn 9725: }
9726: }
9727: if ($role_start > 0) {
1.412 raeburn 9728: if ($now < $role_start) {
1.274 raeburn 9729: $active_chk = 'future';
9730: }
9731: }
9732: if ($role_end > 0) {
1.412 raeburn 9733: if ($now > $role_end) {
1.274 raeburn 9734: $active_chk = 'previous';
9735: }
9736: }
9737: }
9738: }
9739: return $active_chk;
9740: }
9741:
9742: ###############################################
9743:
9744: =pod
9745:
1.405 albertel 9746: =item * &get_sections()
1.233 raeburn 9747:
9748: Determines all the sections for a course including
9749: sections with students and sections containing other roles.
1.419 raeburn 9750: Incoming parameters:
9751:
9752: 1. domain
9753: 2. course number
9754: 3. reference to array containing roles for which sections should
9755: be gathered (optional).
9756: 4. reference to array containing status types for which sections
9757: should be gathered (optional).
9758:
9759: If the third argument is undefined, sections are gathered for any role.
9760: If the fourth argument is undefined, sections are gathered for any status.
9761: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9762:
1.374 raeburn 9763: Returns section hash (keys are section IDs, values are
9764: number of users in each section), subject to the
1.419 raeburn 9765: optional roles filter, optional status filter
1.233 raeburn 9766:
9767: =cut
9768:
9769: ###############################################
9770: sub get_sections {
1.419 raeburn 9771: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9772: if (!defined($cdom) || !defined($cnum)) {
9773: my $cid = $env{'request.course.id'};
9774:
9775: return if (!defined($cid));
9776:
9777: $cdom = $env{'course.'.$cid.'.domain'};
9778: $cnum = $env{'course.'.$cid.'.num'};
9779: }
9780:
9781: my %sectioncount;
1.419 raeburn 9782: my $now = time;
1.240 albertel 9783:
1.1118 raeburn 9784: my $check_students = 1;
9785: my $only_students = 0;
9786: if (ref($possible_roles) eq 'ARRAY') {
9787: if (grep(/^st$/,@{$possible_roles})) {
9788: if (@{$possible_roles} == 1) {
9789: $only_students = 1;
9790: }
9791: } else {
9792: $check_students = 0;
9793: }
9794: }
9795:
9796: if ($check_students) {
1.276 albertel 9797: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9798: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9799: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9800: my $start_index = &Apache::loncoursedata::CL_START();
9801: my $end_index = &Apache::loncoursedata::CL_END();
9802: my $status;
1.366 albertel 9803: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9804: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9805: $data->[$status_index],
9806: $data->[$start_index],
9807: $data->[$end_index]);
9808: if ($stu_status eq 'Active') {
9809: $status = 'active';
9810: } elsif ($end < $now) {
9811: $status = 'previous';
9812: } elsif ($start > $now) {
9813: $status = 'future';
9814: }
9815: if ($section ne '-1' && $section !~ /^\s*$/) {
9816: if ((!defined($possible_status)) || (($status ne '') &&
9817: (grep/^\Q$status\E$/,@{$possible_status}))) {
9818: $sectioncount{$section}++;
9819: }
1.240 albertel 9820: }
9821: }
9822: }
1.1118 raeburn 9823: if ($only_students) {
9824: return %sectioncount;
9825: }
1.240 albertel 9826: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9827: foreach my $user (sort(keys(%courseroles))) {
9828: if ($user !~ /^(\w{2})/) { next; }
9829: my ($role) = ($user =~ /^(\w{2})/);
9830: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9831: my ($section,$status);
1.240 albertel 9832: if ($role eq 'cr' &&
9833: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9834: $section=$1;
9835: }
9836: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9837: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9838: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9839: if ($end == -1 && $start == -1) {
9840: next; #deleted role
9841: }
9842: if (!defined($possible_status)) {
9843: $sectioncount{$section}++;
9844: } else {
9845: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9846: $status = 'active';
9847: } elsif ($end < $now) {
9848: $status = 'future';
9849: } elsif ($start > $now) {
9850: $status = 'previous';
9851: }
9852: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9853: $sectioncount{$section}++;
9854: }
9855: }
1.233 raeburn 9856: }
1.366 albertel 9857: return %sectioncount;
1.233 raeburn 9858: }
9859:
1.274 raeburn 9860: ###############################################
1.294 raeburn 9861:
9862: =pod
1.405 albertel 9863:
9864: =item * &get_course_users()
9865:
1.275 raeburn 9866: Retrieves usernames:domains for users in the specified course
9867: with specific role(s), and access status.
9868:
9869: Incoming parameters:
1.277 albertel 9870: 1. course domain
9871: 2. course number
9872: 3. access status: users must have - either active,
1.275 raeburn 9873: previous, future, or all.
1.277 albertel 9874: 4. reference to array of permissible roles
1.288 raeburn 9875: 5. reference to array of section restrictions (optional)
9876: 6. reference to results object (hash of hashes).
9877: 7. reference to optional userdata hash
1.609 raeburn 9878: 8. reference to optional statushash
1.630 raeburn 9879: 9. flag if privileged users (except those set to unhide in
9880: course settings) should be excluded
1.609 raeburn 9881: Keys of top level results hash are roles.
1.275 raeburn 9882: Keys of inner hashes are username:domain, with
9883: values set to access type.
1.288 raeburn 9884: Optional userdata hash returns an array with arguments in the
9885: same order as loncoursedata::get_classlist() for student data.
9886:
1.609 raeburn 9887: Optional statushash returns
9888:
1.288 raeburn 9889: Entries for end, start, section and status are blank because
9890: of the possibility of multiple values for non-student roles.
9891:
1.275 raeburn 9892: =cut
1.405 albertel 9893:
1.275 raeburn 9894: ###############################################
1.405 albertel 9895:
1.275 raeburn 9896: sub get_course_users {
1.630 raeburn 9897: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9898: my %idx = ();
1.419 raeburn 9899: my %seclists;
1.288 raeburn 9900:
9901: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9902: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9903: $idx{end} = &Apache::loncoursedata::CL_END();
9904: $idx{start} = &Apache::loncoursedata::CL_START();
9905: $idx{id} = &Apache::loncoursedata::CL_ID();
9906: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9907: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9908: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9909:
1.290 albertel 9910: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9911: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9912: my $now = time;
1.277 albertel 9913: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9914: my $match = 0;
1.412 raeburn 9915: my $secmatch = 0;
1.419 raeburn 9916: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9917: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9918: if ($section eq '') {
9919: $section = 'none';
9920: }
1.291 albertel 9921: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9922: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9923: $secmatch = 1;
9924: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9925: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9926: $secmatch = 1;
9927: }
9928: } else {
1.419 raeburn 9929: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9930: $secmatch = 1;
9931: }
1.290 albertel 9932: }
1.412 raeburn 9933: if (!$secmatch) {
9934: next;
9935: }
1.419 raeburn 9936: }
1.275 raeburn 9937: if (defined($$types{'active'})) {
1.288 raeburn 9938: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9939: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9940: $match = 1;
1.275 raeburn 9941: }
9942: }
9943: if (defined($$types{'previous'})) {
1.609 raeburn 9944: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9945: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9946: $match = 1;
1.275 raeburn 9947: }
9948: }
9949: if (defined($$types{'future'})) {
1.609 raeburn 9950: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9951: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9952: $match = 1;
1.275 raeburn 9953: }
9954: }
1.609 raeburn 9955: if ($match) {
9956: push(@{$seclists{$student}},$section);
9957: if (ref($userdata) eq 'HASH') {
9958: $$userdata{$student} = $$classlist{$student};
9959: }
9960: if (ref($statushash) eq 'HASH') {
9961: $statushash->{$student}{'st'}{$section} = $status;
9962: }
1.288 raeburn 9963: }
1.275 raeburn 9964: }
9965: }
1.412 raeburn 9966: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9967: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9968: my $now = time;
1.609 raeburn 9969: my %displaystatus = ( previous => 'Expired',
9970: active => 'Active',
9971: future => 'Future',
9972: );
1.1121 raeburn 9973: my (%nothide,@possdoms);
1.630 raeburn 9974: if ($hidepriv) {
9975: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9976: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9977: if ($user !~ /:/) {
9978: $nothide{join(':',split(/[\@]/,$user))}=1;
9979: } else {
9980: $nothide{$user} = 1;
9981: }
9982: }
1.1121 raeburn 9983: my @possdoms = ($cdom);
9984: if ($coursehash{'checkforpriv'}) {
9985: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9986: }
1.630 raeburn 9987: }
1.439 raeburn 9988: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9989: my $match = 0;
1.412 raeburn 9990: my $secmatch = 0;
1.439 raeburn 9991: my $status;
1.412 raeburn 9992: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9993: $user =~ s/:$//;
1.439 raeburn 9994: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9995: if ($end == -1 || $start == -1) {
9996: next;
9997: }
9998: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9999: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10000: my ($uname,$udom) = split(/:/,$user);
10001: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10002: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10003: $secmatch = 1;
10004: } elsif ($usec eq '') {
1.420 albertel 10005: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10006: $secmatch = 1;
10007: }
10008: } else {
10009: if (grep(/^\Q$usec\E$/,@{$sections})) {
10010: $secmatch = 1;
10011: }
10012: }
10013: if (!$secmatch) {
10014: next;
10015: }
1.288 raeburn 10016: }
1.419 raeburn 10017: if ($usec eq '') {
10018: $usec = 'none';
10019: }
1.275 raeburn 10020: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10021: if ($hidepriv) {
1.1121 raeburn 10022: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10023: (!$nothide{$uname.':'.$udom})) {
10024: next;
10025: }
10026: }
1.503 raeburn 10027: if ($end > 0 && $end < $now) {
1.439 raeburn 10028: $status = 'previous';
10029: } elsif ($start > $now) {
10030: $status = 'future';
10031: } else {
10032: $status = 'active';
10033: }
1.277 albertel 10034: foreach my $type (keys(%{$types})) {
1.275 raeburn 10035: if ($status eq $type) {
1.420 albertel 10036: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10037: push(@{$$users{$role}{$user}},$type);
10038: }
1.288 raeburn 10039: $match = 1;
10040: }
10041: }
1.419 raeburn 10042: if (($match) && (ref($userdata) eq 'HASH')) {
10043: if (!exists($$userdata{$uname.':'.$udom})) {
10044: &get_user_info($udom,$uname,\%idx,$userdata);
10045: }
1.420 albertel 10046: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10047: push(@{$seclists{$uname.':'.$udom}},$usec);
10048: }
1.609 raeburn 10049: if (ref($statushash) eq 'HASH') {
10050: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10051: }
1.275 raeburn 10052: }
10053: }
10054: }
10055: }
1.290 albertel 10056: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10057: if ((defined($cdom)) && (defined($cnum))) {
10058: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10059: if ( defined($csettings{'internal.courseowner'}) ) {
10060: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10061: next if ($owner eq '');
10062: my ($ownername,$ownerdom);
10063: if ($owner =~ /^([^:]+):([^:]+)$/) {
10064: $ownername = $1;
10065: $ownerdom = $2;
10066: } else {
10067: $ownername = $owner;
10068: $ownerdom = $cdom;
10069: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10070: }
10071: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10072: if (defined($userdata) &&
1.609 raeburn 10073: !exists($$userdata{$owner})) {
10074: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10075: if (!grep(/^none$/,@{$seclists{$owner}})) {
10076: push(@{$seclists{$owner}},'none');
10077: }
10078: if (ref($statushash) eq 'HASH') {
10079: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10080: }
1.290 albertel 10081: }
1.279 raeburn 10082: }
10083: }
10084: }
1.419 raeburn 10085: foreach my $user (keys(%seclists)) {
10086: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10087: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10088: }
1.275 raeburn 10089: }
10090: return;
10091: }
10092:
1.288 raeburn 10093: sub get_user_info {
10094: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10095: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10096: &plainname($uname,$udom,'lastname');
1.291 albertel 10097: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10098: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10099: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10100: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10101: return;
10102: }
1.275 raeburn 10103:
1.472 raeburn 10104: ###############################################
10105:
10106: =pod
10107:
10108: =item * &get_user_quota()
10109:
1.1134 raeburn 10110: Retrieves quota assigned for storage of user files.
10111: Default is to report quota for portfolio files.
1.472 raeburn 10112:
10113: Incoming parameters:
10114: 1. user's username
10115: 2. user's domain
1.1134 raeburn 10116: 3. quota name - portfolio, author, or course
1.1136 raeburn 10117: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 10118: 4. crstype - official, unofficial, textbook, placement or community,
10119: if quota name is course
1.472 raeburn 10120:
10121: Returns:
1.1163 raeburn 10122: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10123: 2. (Optional) Type of setting: custom or default
10124: (individually assigned or default for user's
10125: institutional status).
10126: 3. (Optional) - User's institutional status (e.g., faculty, staff
10127: or student - types as defined in localenroll::inst_usertypes
10128: for user's domain, which determines default quota for user.
10129: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10130:
10131: If a value has been stored in the user's environment,
1.536 raeburn 10132: it will return that, otherwise it returns the maximal default
1.1134 raeburn 10133: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10134:
10135: =cut
10136:
10137: ###############################################
10138:
10139:
10140: sub get_user_quota {
1.1136 raeburn 10141: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10142: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10143: if (!defined($udom)) {
10144: $udom = $env{'user.domain'};
10145: }
10146: if (!defined($uname)) {
10147: $uname = $env{'user.name'};
10148: }
10149: if (($udom eq '' || $uname eq '') ||
10150: ($udom eq 'public') && ($uname eq 'public')) {
10151: $quota = 0;
1.536 raeburn 10152: $quotatype = 'default';
10153: $defquota = 0;
1.472 raeburn 10154: } else {
1.536 raeburn 10155: my $inststatus;
1.1134 raeburn 10156: if ($quotaname eq 'course') {
10157: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10158: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10159: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10160: } else {
10161: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10162: $quota = $cenv{'internal.uploadquota'};
10163: }
1.536 raeburn 10164: } else {
1.1134 raeburn 10165: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10166: if ($quotaname eq 'author') {
10167: $quota = $env{'environment.authorquota'};
10168: } else {
10169: $quota = $env{'environment.portfolioquota'};
10170: }
10171: $inststatus = $env{'environment.inststatus'};
10172: } else {
10173: my %userenv =
10174: &Apache::lonnet::get('environment',['portfolioquota',
10175: 'authorquota','inststatus'],$udom,$uname);
10176: my ($tmp) = keys(%userenv);
10177: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10178: if ($quotaname eq 'author') {
10179: $quota = $userenv{'authorquota'};
10180: } else {
10181: $quota = $userenv{'portfolioquota'};
10182: }
10183: $inststatus = $userenv{'inststatus'};
10184: } else {
10185: undef(%userenv);
10186: }
10187: }
10188: }
10189: if ($quota eq '' || wantarray) {
10190: if ($quotaname eq 'course') {
10191: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 10192: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 10193: ($crstype eq 'community') || ($crstype eq 'textbook') ||
10194: ($crstype eq 'placement')) {
1.1136 raeburn 10195: $defquota = $domdefs{$crstype.'quota'};
10196: }
10197: if ($defquota eq '') {
10198: $defquota = 500;
10199: }
1.1134 raeburn 10200: } else {
10201: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10202: }
10203: if ($quota eq '') {
10204: $quota = $defquota;
10205: $quotatype = 'default';
10206: } else {
10207: $quotatype = 'custom';
10208: }
1.472 raeburn 10209: }
10210: }
1.536 raeburn 10211: if (wantarray) {
10212: return ($quota,$quotatype,$settingstatus,$defquota);
10213: } else {
10214: return $quota;
10215: }
1.472 raeburn 10216: }
10217:
10218: ###############################################
10219:
10220: =pod
10221:
10222: =item * &default_quota()
10223:
1.536 raeburn 10224: Retrieves default quota assigned for storage of user portfolio files,
10225: given an (optional) user's institutional status.
1.472 raeburn 10226:
10227: Incoming parameters:
1.1142 raeburn 10228:
1.472 raeburn 10229: 1. domain
1.536 raeburn 10230: 2. (Optional) institutional status(es). This is a : separated list of
10231: status types (e.g., faculty, staff, student etc.)
10232: which apply to the user for whom the default is being retrieved.
10233: If the institutional status string in undefined, the domain
1.1134 raeburn 10234: default quota will be returned.
10235: 3. quota name - portfolio, author, or course
10236: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10237:
10238: Returns:
1.1142 raeburn 10239:
1.1163 raeburn 10240: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10241: 2. (Optional) institutional type which determined the value of the
10242: default quota.
1.472 raeburn 10243:
10244: If a value has been stored in the domain's configuration db,
10245: it will return that, otherwise it returns 20 (for backwards
10246: compatibility with domains which have not set up a configuration
1.1163 raeburn 10247: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10248:
1.536 raeburn 10249: If the user's status includes multiple types (e.g., staff and student),
10250: the largest default quota which applies to the user determines the
10251: default quota returned.
10252:
1.472 raeburn 10253: =cut
10254:
10255: ###############################################
10256:
10257:
10258: sub default_quota {
1.1134 raeburn 10259: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10260: my ($defquota,$settingstatus);
10261: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10262: ['quotas'],$udom);
1.1134 raeburn 10263: my $key = 'defaultquota';
10264: if ($quotaname eq 'author') {
10265: $key = 'authorquota';
10266: }
1.622 raeburn 10267: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10268: if ($inststatus ne '') {
1.765 raeburn 10269: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10270: foreach my $item (@statuses) {
1.1134 raeburn 10271: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10272: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10273: if ($defquota eq '') {
1.1134 raeburn 10274: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10275: $settingstatus = $item;
1.1134 raeburn 10276: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10277: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10278: $settingstatus = $item;
10279: }
10280: }
1.1134 raeburn 10281: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10282: if ($quotahash{'quotas'}{$item} ne '') {
10283: if ($defquota eq '') {
10284: $defquota = $quotahash{'quotas'}{$item};
10285: $settingstatus = $item;
10286: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10287: $defquota = $quotahash{'quotas'}{$item};
10288: $settingstatus = $item;
10289: }
1.536 raeburn 10290: }
10291: }
10292: }
10293: }
10294: if ($defquota eq '') {
1.1134 raeburn 10295: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10296: $defquota = $quotahash{'quotas'}{$key}{'default'};
10297: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10298: $defquota = $quotahash{'quotas'}{'default'};
10299: }
1.536 raeburn 10300: $settingstatus = 'default';
1.1139 raeburn 10301: if ($defquota eq '') {
10302: if ($quotaname eq 'author') {
10303: $defquota = 500;
10304: }
10305: }
1.536 raeburn 10306: }
10307: } else {
10308: $settingstatus = 'default';
1.1134 raeburn 10309: if ($quotaname eq 'author') {
10310: $defquota = 500;
10311: } else {
10312: $defquota = 20;
10313: }
1.536 raeburn 10314: }
10315: if (wantarray) {
10316: return ($defquota,$settingstatus);
1.472 raeburn 10317: } else {
1.536 raeburn 10318: return $defquota;
1.472 raeburn 10319: }
10320: }
10321:
1.1135 raeburn 10322: ###############################################
10323:
10324: =pod
10325:
1.1136 raeburn 10326: =item * &excess_filesize_warning()
1.1135 raeburn 10327:
10328: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10329: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10330: space to be exceeded.
1.1136 raeburn 10331:
10332: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 10333: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10334:
1.1165 raeburn 10335: Inputs: 7
1.1136 raeburn 10336: 1. username or coursenum
1.1135 raeburn 10337: 2. domain
1.1136 raeburn 10338: 3. context ('author' or 'course')
1.1135 raeburn 10339: 4. filename of file for which action is being requested
10340: 5. filesize (kB) of file
10341: 6. action being taken: copy or upload.
1.1237 raeburn 10342: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10343:
10344: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10345: otherwise return null.
10346:
10347: =back
1.1135 raeburn 10348:
10349: =cut
10350:
1.1136 raeburn 10351: sub excess_filesize_warning {
1.1165 raeburn 10352: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10353: my $current_disk_usage = 0;
1.1165 raeburn 10354: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10355: if ($context eq 'author') {
10356: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10357: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10358: } else {
10359: foreach my $subdir ('docs','supplemental') {
10360: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10361: }
10362: }
1.1135 raeburn 10363: $disk_quota = int($disk_quota * 1000);
10364: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10365: return '<p class="LC_warning">'.
1.1135 raeburn 10366: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10367: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10368: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10369: $disk_quota,$current_disk_usage).
10370: '</p>';
10371: }
10372: return;
10373: }
10374:
10375: ###############################################
10376:
10377:
1.1136 raeburn 10378:
10379:
1.384 raeburn 10380: sub get_secgrprole_info {
10381: my ($cdom,$cnum,$needroles,$type) = @_;
10382: my %sections_count = &get_sections($cdom,$cnum);
10383: my @sections = (sort {$a <=> $b} keys(%sections_count));
10384: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10385: my @groups = sort(keys(%curr_groups));
10386: my $allroles = [];
10387: my $rolehash;
10388: my $accesshash = {
10389: active => 'Currently has access',
10390: future => 'Will have future access',
10391: previous => 'Previously had access',
10392: };
10393: if ($needroles) {
10394: $rolehash = {'all' => 'all'};
1.385 albertel 10395: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10396: if (&Apache::lonnet::error(%user_roles)) {
10397: undef(%user_roles);
10398: }
10399: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10400: my ($role)=split(/\:/,$item,2);
10401: if ($role eq 'cr') { next; }
10402: if ($role =~ /^cr/) {
10403: $$rolehash{$role} = (split('/',$role))[3];
10404: } else {
10405: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10406: }
10407: }
10408: foreach my $key (sort(keys(%{$rolehash}))) {
10409: push(@{$allroles},$key);
10410: }
10411: push (@{$allroles},'st');
10412: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10413: }
10414: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10415: }
10416:
1.555 raeburn 10417: sub user_picker {
1.1279 raeburn 10418: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10419: my $currdom = $dom;
1.1253 raeburn 10420: my @alldoms = &Apache::lonnet::all_domains();
10421: if (@alldoms == 1) {
10422: my %domsrch = &Apache::lonnet::get_dom('configuration',
10423: ['directorysrch'],$alldoms[0]);
10424: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10425: my $showdom = $domdesc;
10426: if ($showdom eq '') {
10427: $showdom = $dom;
10428: }
10429: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10430: if ((!$domsrch{'directorysrch'}{'available'}) &&
10431: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10432: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10433: }
10434: }
10435: }
1.555 raeburn 10436: my %curr_selected = (
10437: srchin => 'dom',
1.580 raeburn 10438: srchby => 'lastname',
1.555 raeburn 10439: );
10440: my $srchterm;
1.625 raeburn 10441: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10442: if ($srch->{'srchby'} ne '') {
10443: $curr_selected{'srchby'} = $srch->{'srchby'};
10444: }
10445: if ($srch->{'srchin'} ne '') {
10446: $curr_selected{'srchin'} = $srch->{'srchin'};
10447: }
10448: if ($srch->{'srchtype'} ne '') {
10449: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10450: }
10451: if ($srch->{'srchdomain'} ne '') {
10452: $currdom = $srch->{'srchdomain'};
10453: }
10454: $srchterm = $srch->{'srchterm'};
10455: }
1.1222 damieng 10456: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10457: 'usr' => 'Search criteria',
1.563 raeburn 10458: 'doma' => 'Domain/institution to search',
1.558 albertel 10459: 'uname' => 'username',
10460: 'lastname' => 'last name',
1.555 raeburn 10461: 'lastfirst' => 'last name, first name',
1.558 albertel 10462: 'crs' => 'in this course',
1.576 raeburn 10463: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10464: 'alc' => 'all LON-CAPA',
1.573 raeburn 10465: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10466: 'exact' => 'is',
10467: 'contains' => 'contains',
1.569 raeburn 10468: 'begins' => 'begins with',
1.1222 damieng 10469: );
10470: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10471: 'youm' => "You must include some text to search for.",
10472: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10473: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10474: 'yomc' => "You must choose a domain when using an institutional directory search.",
10475: 'ymcd' => "You must choose a domain when using a domain search.",
10476: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10477: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10478: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10479: );
1.1222 damieng 10480: &html_escape(\%html_lt);
10481: &js_escape(\%js_lt);
1.1255 raeburn 10482: my $domform;
1.1277 raeburn 10483: my $allow_blank = 1;
1.1255 raeburn 10484: if ($fixeddom) {
1.1277 raeburn 10485: $allow_blank = 0;
10486: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 10487: } else {
1.1287 raeburn 10488: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 10489: my ($trusted,$untrusted);
1.1287 raeburn 10490: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 10491: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 10492: } elsif ($context eq 'author') {
1.1288 raeburn 10493: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 10494: } elsif ($context eq 'domain') {
1.1288 raeburn 10495: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 10496: }
1.1288 raeburn 10497: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 10498: }
1.563 raeburn 10499: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10500:
10501: my @srchins = ('crs','dom','alc','instd');
10502:
10503: foreach my $option (@srchins) {
10504: # FIXME 'alc' option unavailable until
10505: # loncreateuser::print_user_query_page()
10506: # has been completed.
10507: next if ($option eq 'alc');
1.880 raeburn 10508: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10509: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 10510: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10511: if ($curr_selected{'srchin'} eq $option) {
10512: $srchinsel .= '
1.1222 damieng 10513: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10514: } else {
10515: $srchinsel .= '
1.1222 damieng 10516: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10517: }
1.555 raeburn 10518: }
1.563 raeburn 10519: $srchinsel .= "\n </select>\n";
1.555 raeburn 10520:
10521: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10522: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10523: if ($curr_selected{'srchby'} eq $option) {
10524: $srchbysel .= '
1.1222 damieng 10525: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10526: } else {
10527: $srchbysel .= '
1.1222 damieng 10528: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10529: }
10530: }
10531: $srchbysel .= "\n </select>\n";
10532:
10533: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10534: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10535: if ($curr_selected{'srchtype'} eq $option) {
10536: $srchtypesel .= '
1.1222 damieng 10537: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10538: } else {
10539: $srchtypesel .= '
1.1222 damieng 10540: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10541: }
10542: }
10543: $srchtypesel .= "\n </select>\n";
10544:
1.558 albertel 10545: my ($newuserscript,$new_user_create);
1.994 raeburn 10546: my $context_dom = $env{'request.role.domain'};
10547: if ($context eq 'requestcrs') {
10548: if ($env{'form.coursedom'} ne '') {
10549: $context_dom = $env{'form.coursedom'};
10550: }
10551: }
1.556 raeburn 10552: if ($forcenewuser) {
1.576 raeburn 10553: if (ref($srch) eq 'HASH') {
1.994 raeburn 10554: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10555: if ($cancreate) {
10556: $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>';
10557: } else {
1.799 bisitz 10558: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10559: my %usertypetext = (
10560: official => 'institutional',
10561: unofficial => 'non-institutional',
10562: );
1.799 bisitz 10563: $new_user_create = '<p class="LC_warning">'
10564: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10565: .' '
10566: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10567: ,'<a href="'.$helplink.'">','</a>')
10568: .'</p><br />';
1.627 raeburn 10569: }
1.576 raeburn 10570: }
10571: }
10572:
1.556 raeburn 10573: $newuserscript = <<"ENDSCRIPT";
10574:
1.570 raeburn 10575: function setSearch(createnew,callingForm) {
1.556 raeburn 10576: if (createnew == 1) {
1.570 raeburn 10577: for (var i=0; i<callingForm.srchby.length; i++) {
10578: if (callingForm.srchby.options[i].value == 'uname') {
10579: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10580: }
10581: }
1.570 raeburn 10582: for (var i=0; i<callingForm.srchin.length; i++) {
10583: if ( callingForm.srchin.options[i].value == 'dom') {
10584: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10585: }
10586: }
1.570 raeburn 10587: for (var i=0; i<callingForm.srchtype.length; i++) {
10588: if (callingForm.srchtype.options[i].value == 'exact') {
10589: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10590: }
10591: }
1.570 raeburn 10592: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10593: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10594: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10595: }
10596: }
10597: }
10598: }
10599: ENDSCRIPT
1.558 albertel 10600:
1.556 raeburn 10601: }
10602:
1.555 raeburn 10603: my $output = <<"END_BLOCK";
1.556 raeburn 10604: <script type="text/javascript">
1.824 bisitz 10605: // <![CDATA[
1.570 raeburn 10606: function validateEntry(callingForm) {
1.558 albertel 10607:
1.556 raeburn 10608: var checkok = 1;
1.558 albertel 10609: var srchin;
1.570 raeburn 10610: for (var i=0; i<callingForm.srchin.length; i++) {
10611: if ( callingForm.srchin[i].checked ) {
10612: srchin = callingForm.srchin[i].value;
1.558 albertel 10613: }
10614: }
10615:
1.570 raeburn 10616: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10617: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10618: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10619: var srchterm = callingForm.srchterm.value;
10620: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10621: var msg = "";
10622:
10623: if (srchterm == "") {
10624: checkok = 0;
1.1222 damieng 10625: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10626: }
10627:
1.569 raeburn 10628: if (srchtype== 'begins') {
10629: if (srchterm.length < 2) {
10630: checkok = 0;
1.1222 damieng 10631: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10632: }
10633: }
10634:
1.556 raeburn 10635: if (srchtype== 'contains') {
10636: if (srchterm.length < 3) {
10637: checkok = 0;
1.1222 damieng 10638: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10639: }
10640: }
10641: if (srchin == 'instd') {
10642: if (srchdomain == '') {
10643: checkok = 0;
1.1222 damieng 10644: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10645: }
10646: }
10647: if (srchin == 'dom') {
10648: if (srchdomain == '') {
10649: checkok = 0;
1.1222 damieng 10650: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10651: }
10652: }
10653: if (srchby == 'lastfirst') {
10654: if (srchterm.indexOf(",") == -1) {
10655: checkok = 0;
1.1222 damieng 10656: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10657: }
10658: if (srchterm.indexOf(",") == srchterm.length -1) {
10659: checkok = 0;
1.1222 damieng 10660: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10661: }
10662: }
10663: if (checkok == 0) {
1.1222 damieng 10664: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10665: return;
10666: }
10667: if (checkok == 1) {
1.570 raeburn 10668: callingForm.submit();
1.556 raeburn 10669: }
10670: }
10671:
10672: $newuserscript
10673:
1.824 bisitz 10674: // ]]>
1.556 raeburn 10675: </script>
1.558 albertel 10676:
10677: $new_user_create
10678:
1.555 raeburn 10679: END_BLOCK
1.558 albertel 10680:
1.876 raeburn 10681: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 10682: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10683: $domform.
10684: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 10685: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10686: $srchbysel.
10687: $srchtypesel.
10688: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10689: $srchinsel.
10690: &Apache::lonhtmlcommon::row_closure(1).
10691: &Apache::lonhtmlcommon::end_pick_box().
10692: '<br />';
1.1253 raeburn 10693: return ($output,1);
1.555 raeburn 10694: }
10695:
1.612 raeburn 10696: sub user_rule_check {
1.615 raeburn 10697: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 10698: my ($response,%inst_response);
1.612 raeburn 10699: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 10700: if (keys(%{$usershash}) > 1) {
10701: my (%by_username,%by_id,%userdoms);
10702: my $checkid;
10703: if (ref($checks) eq 'HASH') {
10704: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10705: $checkid = 1;
10706: }
10707: }
10708: foreach my $user (keys(%{$usershash})) {
10709: my ($uname,$udom) = split(/:/,$user);
10710: if ($checkid) {
10711: if (ref($usershash->{$user}) eq 'HASH') {
10712: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 10713: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 10714: $userdoms{$udom} = 1;
1.1227 raeburn 10715: if (ref($inst_results) eq 'HASH') {
10716: $inst_results->{$uname.':'.$udom} = {};
10717: }
1.1226 raeburn 10718: }
10719: }
10720: } else {
10721: $by_username{$udom}{$uname} = 1;
10722: $userdoms{$udom} = 1;
1.1227 raeburn 10723: if (ref($inst_results) eq 'HASH') {
10724: $inst_results->{$uname.':'.$udom} = {};
10725: }
1.1226 raeburn 10726: }
10727: }
10728: foreach my $udom (keys(%userdoms)) {
10729: if (!$got_rules->{$udom}) {
10730: my %domconfig = &Apache::lonnet::get_dom('configuration',
10731: ['usercreation'],$udom);
10732: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10733: foreach my $item ('username','id') {
10734: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 10735: $$curr_rules{$udom}{$item} =
10736: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 10737: }
10738: }
10739: }
10740: $got_rules->{$udom} = 1;
10741: }
1.612 raeburn 10742: }
1.1226 raeburn 10743: if ($checkid) {
10744: foreach my $udom (keys(%by_id)) {
10745: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10746: if ($outcome eq 'ok') {
1.1227 raeburn 10747: foreach my $id (keys(%{$by_id{$udom}})) {
10748: my $uname = $by_id{$udom}{$id};
10749: $inst_response{$uname.':'.$udom} = $outcome;
10750: }
1.1226 raeburn 10751: if (ref($results) eq 'HASH') {
10752: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 10753: if (exists($inst_response{$uname.':'.$udom})) {
10754: $inst_response{$uname.':'.$udom} = $outcome;
10755: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10756: }
1.1226 raeburn 10757: }
10758: }
10759: }
1.612 raeburn 10760: }
1.615 raeburn 10761: } else {
1.1226 raeburn 10762: foreach my $udom (keys(%by_username)) {
10763: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10764: if ($outcome eq 'ok') {
1.1227 raeburn 10765: foreach my $uname (keys(%{$by_username{$udom}})) {
10766: $inst_response{$uname.':'.$udom} = $outcome;
10767: }
1.1226 raeburn 10768: if (ref($results) eq 'HASH') {
10769: foreach my $uname (keys(%{$results})) {
10770: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10771: }
10772: }
10773: }
10774: }
1.612 raeburn 10775: }
1.1226 raeburn 10776: } elsif (keys(%{$usershash}) == 1) {
10777: my $user = (keys(%{$usershash}))[0];
10778: my ($uname,$udom) = split(/:/,$user);
10779: if (($udom ne '') && ($uname ne '')) {
10780: if (ref($usershash->{$user}) eq 'HASH') {
10781: if (ref($checks) eq 'HASH') {
10782: if (defined($checks->{'username'})) {
10783: ($inst_response{$user},%{$inst_results->{$user}}) =
10784: &Apache::lonnet::get_instuser($udom,$uname);
10785: } elsif (defined($checks->{'id'})) {
10786: if ($usershash->{$user}->{'id'} ne '') {
10787: ($inst_response{$user},%{$inst_results->{$user}}) =
10788: &Apache::lonnet::get_instuser($udom,undef,
10789: $usershash->{$user}->{'id'});
10790: } else {
10791: ($inst_response{$user},%{$inst_results->{$user}}) =
10792: &Apache::lonnet::get_instuser($udom,$uname);
10793: }
1.585 raeburn 10794: }
1.1226 raeburn 10795: } else {
10796: ($inst_response{$user},%{$inst_results->{$user}}) =
10797: &Apache::lonnet::get_instuser($udom,$uname);
10798: return;
10799: }
10800: if (!$got_rules->{$udom}) {
10801: my %domconfig = &Apache::lonnet::get_dom('configuration',
10802: ['usercreation'],$udom);
10803: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10804: foreach my $item ('username','id') {
10805: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10806: $$curr_rules{$udom}{$item} =
10807: $domconfig{'usercreation'}{$item.'_rule'};
10808: }
10809: }
10810: }
10811: $got_rules->{$udom} = 1;
1.585 raeburn 10812: }
10813: }
1.1226 raeburn 10814: } else {
10815: return;
10816: }
10817: } else {
10818: return;
10819: }
10820: foreach my $user (keys(%{$usershash})) {
10821: my ($uname,$udom) = split(/:/,$user);
10822: next if (($udom eq '') || ($uname eq ''));
10823: my $id;
1.1227 raeburn 10824: if (ref($inst_results) eq 'HASH') {
10825: if (ref($inst_results->{$user}) eq 'HASH') {
10826: $id = $inst_results->{$user}->{'id'};
10827: }
10828: }
10829: if ($id eq '') {
10830: if (ref($usershash->{$user})) {
10831: $id = $usershash->{$user}->{'id'};
10832: }
1.585 raeburn 10833: }
1.612 raeburn 10834: foreach my $item (keys(%{$checks})) {
10835: if (ref($$curr_rules{$udom}) eq 'HASH') {
10836: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10837: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 10838: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10839: $$curr_rules{$udom}{$item});
1.612 raeburn 10840: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10841: if ($rule_check{$rule}) {
10842: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 10843: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10844: if (ref($inst_results) eq 'HASH') {
10845: if (ref($inst_results->{$user}) eq 'HASH') {
10846: if (keys(%{$inst_results->{$user}}) == 0) {
10847: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 10848: } elsif ($item eq 'id') {
10849: if ($inst_results->{$user}->{'id'} eq '') {
10850: $$alerts{$item}{$udom}{$uname} = 1;
10851: }
1.615 raeburn 10852: }
1.612 raeburn 10853: }
10854: }
1.615 raeburn 10855: }
10856: last;
1.585 raeburn 10857: }
10858: }
10859: }
10860: }
10861: }
10862: }
10863: }
10864: }
1.612 raeburn 10865: return;
10866: }
10867:
10868: sub user_rule_formats {
10869: my ($domain,$domdesc,$curr_rules,$check) = @_;
10870: my %text = (
10871: 'username' => 'Usernames',
10872: 'id' => 'IDs',
10873: );
10874: my $output;
10875: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10876: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10877: if (@{$ruleorder} > 0) {
1.1102 raeburn 10878: $output = '<br />'.
10879: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10880: '<span class="LC_cusr_emph">','</span>',$domdesc).
10881: ' <ul>';
1.612 raeburn 10882: foreach my $rule (@{$ruleorder}) {
10883: if (ref($curr_rules) eq 'ARRAY') {
10884: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10885: if (ref($rules->{$rule}) eq 'HASH') {
10886: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10887: $rules->{$rule}{'desc'}.'</li>';
10888: }
10889: }
10890: }
10891: }
10892: $output .= '</ul>';
10893: }
10894: }
10895: return $output;
10896: }
10897:
10898: sub instrule_disallow_msg {
1.615 raeburn 10899: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10900: my $response;
10901: my %text = (
10902: item => 'username',
10903: items => 'usernames',
10904: match => 'matches',
10905: do => 'does',
10906: action => 'a username',
10907: one => 'one',
10908: );
10909: if ($count > 1) {
10910: $text{'item'} = 'usernames';
10911: $text{'match'} ='match';
10912: $text{'do'} = 'do';
10913: $text{'action'} = 'usernames',
10914: $text{'one'} = 'ones';
10915: }
10916: if ($checkitem eq 'id') {
10917: $text{'items'} = 'IDs';
10918: $text{'item'} = 'ID';
10919: $text{'action'} = 'an ID';
1.615 raeburn 10920: if ($count > 1) {
10921: $text{'item'} = 'IDs';
10922: $text{'action'} = 'IDs';
10923: }
1.612 raeburn 10924: }
1.674 bisitz 10925: $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 10926: if ($mode eq 'upload') {
10927: if ($checkitem eq 'username') {
10928: $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'}.");
10929: } elsif ($checkitem eq 'id') {
1.674 bisitz 10930: $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 10931: }
1.669 raeburn 10932: } elsif ($mode eq 'selfcreate') {
10933: if ($checkitem eq 'id') {
10934: $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.");
10935: }
1.615 raeburn 10936: } else {
10937: if ($checkitem eq 'username') {
10938: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10939: } elsif ($checkitem eq 'id') {
10940: $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.");
10941: }
1.612 raeburn 10942: }
10943: return $response;
1.585 raeburn 10944: }
10945:
1.624 raeburn 10946: sub personal_data_fieldtitles {
10947: my %fieldtitles = &Apache::lonlocal::texthash (
10948: id => 'Student/Employee ID',
10949: permanentemail => 'E-mail address',
10950: lastname => 'Last Name',
10951: firstname => 'First Name',
10952: middlename => 'Middle Name',
10953: generation => 'Generation',
10954: gen => 'Generation',
1.765 raeburn 10955: inststatus => 'Affiliation',
1.624 raeburn 10956: );
10957: return %fieldtitles;
10958: }
10959:
1.642 raeburn 10960: sub sorted_inst_types {
10961: my ($dom) = @_;
1.1185 raeburn 10962: my ($usertypes,$order);
10963: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10964: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10965: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10966: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10967: } else {
10968: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10969: }
1.642 raeburn 10970: my $othertitle = &mt('All users');
10971: if ($env{'request.course.id'}) {
1.668 raeburn 10972: $othertitle = &mt('Any users');
1.642 raeburn 10973: }
10974: my @types;
10975: if (ref($order) eq 'ARRAY') {
10976: @types = @{$order};
10977: }
10978: if (@types == 0) {
10979: if (ref($usertypes) eq 'HASH') {
10980: @types = sort(keys(%{$usertypes}));
10981: }
10982: }
10983: if (keys(%{$usertypes}) > 0) {
10984: $othertitle = &mt('Other users');
10985: }
10986: return ($othertitle,$usertypes,\@types);
10987: }
10988:
1.645 raeburn 10989: sub get_institutional_codes {
10990: my ($settings,$allcourses,$LC_code) = @_;
10991: # Get complete list of course sections to update
10992: my @currsections = ();
10993: my @currxlists = ();
10994: my $coursecode = $$settings{'internal.coursecode'};
10995:
10996: if ($$settings{'internal.sectionnums'} ne '') {
10997: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10998: }
10999:
11000: if ($$settings{'internal.crosslistings'} ne '') {
11001: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11002: }
11003:
11004: if (@currxlists > 0) {
11005: foreach (@currxlists) {
11006: if (m/^([^:]+):(\w*)$/) {
11007: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 11008: push(@{$allcourses},$1);
1.645 raeburn 11009: $$LC_code{$1} = $2;
11010: }
11011: }
11012: }
11013: }
11014:
11015: if (@currsections > 0) {
11016: foreach (@currsections) {
11017: if (m/^(\w+):(\w*)$/) {
11018: my $sec = $coursecode.$1;
11019: my $lc_sec = $2;
11020: unless (grep/^$sec$/,@{$allcourses}) {
1.1263 raeburn 11021: push(@{$allcourses},$sec);
1.645 raeburn 11022: $$LC_code{$sec} = $lc_sec;
11023: }
11024: }
11025: }
11026: }
11027: return;
11028: }
11029:
1.971 raeburn 11030: sub get_standard_codeitems {
11031: return ('Year','Semester','Department','Number','Section');
11032: }
11033:
1.112 bowersj2 11034: =pod
11035:
1.780 raeburn 11036: =head1 Slot Helpers
11037:
11038: =over 4
11039:
11040: =item * sorted_slots()
11041:
1.1040 raeburn 11042: Sorts an array of slot names in order of an optional sort key,
11043: default sort is by slot start time (earliest first).
1.780 raeburn 11044:
11045: Inputs:
11046:
11047: =over 4
11048:
11049: slotsarr - Reference to array of unsorted slot names.
11050:
11051: slots - Reference to hash of hash, where outer hash keys are slot names.
11052:
1.1040 raeburn 11053: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11054:
1.549 albertel 11055: =back
11056:
1.780 raeburn 11057: Returns:
11058:
11059: =over 4
11060:
1.1040 raeburn 11061: sorted - An array of slot names sorted by a specified sort key
11062: (default sort key is start time of the slot).
1.780 raeburn 11063:
11064: =back
11065:
11066: =cut
11067:
11068:
11069: sub sorted_slots {
1.1040 raeburn 11070: my ($slotsarr,$slots,$sortkey) = @_;
11071: if ($sortkey eq '') {
11072: $sortkey = 'starttime';
11073: }
1.780 raeburn 11074: my @sorted;
11075: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11076: @sorted =
11077: sort {
11078: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11079: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11080: }
11081: if (ref($slots->{$a})) { return -1;}
11082: if (ref($slots->{$b})) { return 1;}
11083: return 0;
11084: } @{$slotsarr};
11085: }
11086: return @sorted;
11087: }
11088:
1.1040 raeburn 11089: =pod
11090:
11091: =item * get_future_slots()
11092:
11093: Inputs:
11094:
11095: =over 4
11096:
11097: cnum - course number
11098:
11099: cdom - course domain
11100:
11101: now - current UNIX time
11102:
11103: symb - optional symb
11104:
11105: =back
11106:
11107: Returns:
11108:
11109: =over 4
11110:
11111: sorted_reservable - ref to array of student_schedulable slots currently
11112: reservable, ordered by end date of reservation period.
11113:
11114: reservable_now - ref to hash of student_schedulable slots currently
11115: reservable.
11116:
11117: Keys in inner hash are:
11118: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11119: (b) endreserve: end date of reservation period.
11120: (c) uniqueperiod: start,end dates when slot is to be uniquely
11121: selected.
1.1040 raeburn 11122:
11123: sorted_future - ref to array of student_schedulable slots reservable in
11124: the future, ordered by start date of reservation period.
11125:
11126: future_reservable - ref to hash of student_schedulable slots reservable
11127: in the future.
11128:
11129: Keys in inner hash are:
11130: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11131: (b) startreserve: start date of reservation period.
11132: (c) uniqueperiod: start,end dates when slot is to be uniquely
11133: selected.
1.1040 raeburn 11134:
11135: =back
11136:
11137: =cut
11138:
11139: sub get_future_slots {
11140: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 11141: my $map;
11142: if ($symb) {
11143: ($map) = &Apache::lonnet::decode_symb($symb);
11144: }
1.1040 raeburn 11145: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11146: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11147: foreach my $slot (keys(%slots)) {
11148: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11149: if ($symb) {
1.1229 raeburn 11150: if ($slots{$slot}->{'symb'} ne '') {
11151: my $canuse;
11152: my %oksymbs;
11153: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
11154: map { $oksymbs{$_} = 1; } @slotsymbs;
11155: if ($oksymbs{$symb}) {
11156: $canuse = 1;
11157: } else {
11158: foreach my $item (@slotsymbs) {
11159: if ($item =~ /\.(page|sequence)$/) {
11160: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
11161: if (($map ne '') && ($map eq $sloturl)) {
11162: $canuse = 1;
11163: last;
11164: }
11165: }
11166: }
11167: }
11168: next unless ($canuse);
11169: }
1.1040 raeburn 11170: }
11171: if (($slots{$slot}->{'starttime'} > $now) &&
11172: ($slots{$slot}->{'endtime'} > $now)) {
11173: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11174: my $userallowed = 0;
11175: if ($slots{$slot}->{'allowedsections'}) {
11176: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11177: if (!defined($env{'request.role.sec'})
11178: && grep(/^No section assigned$/,@allowed_sec)) {
11179: $userallowed=1;
11180: } else {
11181: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11182: $userallowed=1;
11183: }
11184: }
11185: unless ($userallowed) {
11186: if (defined($env{'request.course.groups'})) {
11187: my @groups = split(/:/,$env{'request.course.groups'});
11188: foreach my $group (@groups) {
11189: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11190: $userallowed=1;
11191: last;
11192: }
11193: }
11194: }
11195: }
11196: }
11197: if ($slots{$slot}->{'allowedusers'}) {
11198: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11199: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11200: if (grep(/^\Q$user\E$/,@allowed_users)) {
11201: $userallowed = 1;
11202: }
11203: }
11204: next unless($userallowed);
11205: }
11206: my $startreserve = $slots{$slot}->{'startreserve'};
11207: my $endreserve = $slots{$slot}->{'endreserve'};
11208: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 11209: my $uniqueperiod;
11210: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11211: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11212: }
1.1040 raeburn 11213: if (($startreserve < $now) &&
11214: (!$endreserve || $endreserve > $now)) {
11215: my $lastres = $endreserve;
11216: if (!$lastres) {
11217: $lastres = $slots{$slot}->{'starttime'};
11218: }
11219: $reservable_now{$slot} = {
11220: symb => $symb,
1.1250 raeburn 11221: endreserve => $lastres,
11222: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11223: };
11224: } elsif (($startreserve > $now) &&
11225: (!$endreserve || $endreserve > $startreserve)) {
11226: $future_reservable{$slot} = {
11227: symb => $symb,
1.1250 raeburn 11228: startreserve => $startreserve,
11229: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11230: };
11231: }
11232: }
11233: }
11234: my @unsorted_reservable = keys(%reservable_now);
11235: if (@unsorted_reservable > 0) {
11236: @sorted_reservable =
11237: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11238: }
11239: my @unsorted_future = keys(%future_reservable);
11240: if (@unsorted_future > 0) {
11241: @sorted_future =
11242: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11243: }
11244: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11245: }
1.780 raeburn 11246:
11247: =pod
11248:
1.1057 foxr 11249: =back
11250:
1.549 albertel 11251: =head1 HTTP Helpers
11252:
11253: =over 4
11254:
1.648 raeburn 11255: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11256:
1.258 albertel 11257: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11258: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11259: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11260:
11261: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11262: $possible_names is an ref to an array of form element names. As an example:
11263: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11264: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11265:
11266: =cut
1.1 albertel 11267:
1.6 albertel 11268: sub get_unprocessed_cgi {
1.25 albertel 11269: my ($query,$possible_names)= @_;
1.26 matthew 11270: # $Apache::lonxml::debug=1;
1.356 albertel 11271: foreach my $pair (split(/&/,$query)) {
11272: my ($name, $value) = split(/=/,$pair);
1.369 www 11273: $name = &unescape($name);
1.25 albertel 11274: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11275: $value =~ tr/+/ /;
11276: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11277: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11278: }
1.16 harris41 11279: }
1.6 albertel 11280: }
11281:
1.112 bowersj2 11282: =pod
11283:
1.648 raeburn 11284: =item * &cacheheader()
1.112 bowersj2 11285:
11286: returns cache-controlling header code
11287:
11288: =cut
11289:
1.7 albertel 11290: sub cacheheader {
1.258 albertel 11291: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11292: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11293: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11294: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11295: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11296: return $output;
1.7 albertel 11297: }
11298:
1.112 bowersj2 11299: =pod
11300:
1.648 raeburn 11301: =item * &no_cache($r)
1.112 bowersj2 11302:
11303: specifies header code to not have cache
11304:
11305: =cut
11306:
1.9 albertel 11307: sub no_cache {
1.216 albertel 11308: my ($r) = @_;
11309: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11310: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11311: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11312: $r->no_cache(1);
11313: $r->header_out("Expires" => $date);
11314: $r->header_out("Pragma" => "no-cache");
1.123 www 11315: }
11316:
11317: sub content_type {
1.181 albertel 11318: my ($r,$type,$charset) = @_;
1.299 foxr 11319: if ($r) {
11320: # Note that printout.pl calls this with undef for $r.
11321: &no_cache($r);
11322: }
1.258 albertel 11323: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11324: unless ($charset) {
11325: $charset=&Apache::lonlocal::current_encoding;
11326: }
11327: if ($charset) { $type.='; charset='.$charset; }
11328: if ($r) {
11329: $r->content_type($type);
11330: } else {
11331: print("Content-type: $type\n\n");
11332: }
1.9 albertel 11333: }
1.25 albertel 11334:
1.112 bowersj2 11335: =pod
11336:
1.648 raeburn 11337: =item * &add_to_env($name,$value)
1.112 bowersj2 11338:
1.258 albertel 11339: adds $name to the %env hash with value
1.112 bowersj2 11340: $value, if $name already exists, the entry is converted to an array
11341: reference and $value is added to the array.
11342:
11343: =cut
11344:
1.25 albertel 11345: sub add_to_env {
11346: my ($name,$value)=@_;
1.258 albertel 11347: if (defined($env{$name})) {
11348: if (ref($env{$name})) {
1.25 albertel 11349: #already have multiple values
1.258 albertel 11350: push(@{ $env{$name} },$value);
1.25 albertel 11351: } else {
11352: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11353: my $first=$env{$name};
11354: undef($env{$name});
11355: push(@{ $env{$name} },$first,$value);
1.25 albertel 11356: }
11357: } else {
1.258 albertel 11358: $env{$name}=$value;
1.25 albertel 11359: }
1.31 albertel 11360: }
1.149 albertel 11361:
11362: =pod
11363:
1.648 raeburn 11364: =item * &get_env_multiple($name)
1.149 albertel 11365:
1.258 albertel 11366: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11367: values may be defined and end up as an array ref.
11368:
11369: returns an array of values
11370:
11371: =cut
11372:
11373: sub get_env_multiple {
11374: my ($name) = @_;
11375: my @values;
1.258 albertel 11376: if (defined($env{$name})) {
1.149 albertel 11377: # exists is it an array
1.258 albertel 11378: if (ref($env{$name})) {
11379: @values=@{ $env{$name} };
1.149 albertel 11380: } else {
1.258 albertel 11381: $values[0]=$env{$name};
1.149 albertel 11382: }
11383: }
11384: return(@values);
11385: }
11386:
1.1249 damieng 11387: # Looks at given dependencies, and returns something depending on the context.
11388: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11389: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11390: # For all other contexts, returns ($output, $counter, $numpathchg).
11391: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11392: # $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.
11393: # $numpathchg: integer with the number of cleaned up dependency paths.
11394: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11395: # \%mapping: hash reference clean path -> original path for all dependencies.
11396: # @param {string} actionurl - The path to the handler, indicative of the context.
11397: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11398: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11399: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11400: # @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)
11401: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11402: sub ask_for_embedded_content {
1.1249 damieng 11403: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11404: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11405: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11406: %currsubfile,%unused,$rem);
1.1071 raeburn 11407: my $counter = 0;
11408: my $numnew = 0;
1.987 raeburn 11409: my $numremref = 0;
11410: my $numinvalid = 0;
11411: my $numpathchg = 0;
11412: my $numexisting = 0;
1.1071 raeburn 11413: my $numunused = 0;
11414: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11415: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11416: my $heading = &mt('Upload embedded files');
11417: my $buttontext = &mt('Upload');
11418:
1.1249 damieng 11419: # fills these variables based on the context:
11420: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11421: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11422: if ($env{'request.course.id'}) {
1.1123 raeburn 11423: if ($actionurl eq '/adm/dependencies') {
11424: $navmap = Apache::lonnavmaps::navmap->new();
11425: }
11426: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11427: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11428: }
1.1123 raeburn 11429: if (($actionurl eq '/adm/portfolio') ||
11430: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11431: my $current_path='/';
11432: if ($env{'form.currentpath'}) {
11433: $current_path = $env{'form.currentpath'};
11434: }
11435: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11436: $udom = $cdom;
11437: $uname = $cnum;
1.984 raeburn 11438: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11439: } else {
11440: $udom = $env{'user.domain'};
11441: $uname = $env{'user.name'};
11442: $url = '/userfiles/portfolio';
11443: }
1.987 raeburn 11444: $toplevel = $url.'/';
1.984 raeburn 11445: $url .= $current_path;
11446: $getpropath = 1;
1.987 raeburn 11447: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11448: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11449: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11450: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11451: $toplevel = $url;
1.984 raeburn 11452: if ($rest ne '') {
1.987 raeburn 11453: $url .= $rest;
11454: }
11455: } elsif ($actionurl eq '/adm/coursedocs') {
11456: if (ref($args) eq 'HASH') {
1.1071 raeburn 11457: $url = $args->{'docs_url'};
11458: $toplevel = $url;
1.1084 raeburn 11459: if ($args->{'context'} eq 'paste') {
11460: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11461: ($path) =
11462: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11463: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11464: $fileloc =~ s{^/}{};
11465: }
1.1071 raeburn 11466: }
1.1084 raeburn 11467: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 11468: if ($env{'request.course.id'} ne '') {
11469: if (ref($args) eq 'HASH') {
11470: $url = $args->{'docs_url'};
11471: $title = $args->{'docs_title'};
1.1126 raeburn 11472: $toplevel = $url;
11473: unless ($toplevel =~ m{^/}) {
11474: $toplevel = "/$url";
11475: }
1.1085 raeburn 11476: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 11477: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11478: $path = $1;
11479: } else {
11480: ($path) =
11481: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11482: }
1.1195 raeburn 11483: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11484: $fileloc = $toplevel;
11485: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11486: my ($udom,$uname,$fname) =
11487: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11488: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11489: } else {
11490: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11491: }
1.1071 raeburn 11492: $fileloc =~ s{^/}{};
11493: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11494: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11495: }
1.987 raeburn 11496: }
1.1123 raeburn 11497: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11498: $udom = $cdom;
11499: $uname = $cnum;
11500: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11501: $toplevel = $url;
11502: $path = $url;
11503: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11504: $fileloc =~ s{^/}{};
1.987 raeburn 11505: }
1.1249 damieng 11506:
11507: # parses the dependency paths to get some info
11508: # fills $newfiles, $mapping, $subdependencies, $dependencies
11509: # $newfiles: hash URL -> 1 for new files or external URLs
11510: # (will be completed later)
11511: # $mapping:
11512: # for external URLs: external URL -> external URL
11513: # for relative paths: clean path -> original path
11514: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
11515: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 11516: foreach my $file (keys(%{$allfiles})) {
11517: my $embed_file;
11518: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11519: $embed_file = $1;
11520: } else {
11521: $embed_file = $file;
11522: }
1.1158 raeburn 11523: my ($absolutepath,$cleaned_file);
11524: if ($embed_file =~ m{^\w+://}) {
11525: $cleaned_file = $embed_file;
1.1147 raeburn 11526: $newfiles{$cleaned_file} = 1;
11527: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11528: } else {
1.1158 raeburn 11529: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11530: if ($embed_file =~ m{^/}) {
11531: $absolutepath = $embed_file;
11532: }
1.1147 raeburn 11533: if ($cleaned_file =~ m{/}) {
11534: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11535: $path = &check_for_traversal($path,$url,$toplevel);
11536: my $item = $fname;
11537: if ($path ne '') {
11538: $item = $path.'/'.$fname;
11539: $subdependencies{$path}{$fname} = 1;
11540: } else {
11541: $dependencies{$item} = 1;
11542: }
11543: if ($absolutepath) {
11544: $mapping{$item} = $absolutepath;
11545: } else {
11546: $mapping{$item} = $embed_file;
11547: }
11548: } else {
11549: $dependencies{$embed_file} = 1;
11550: if ($absolutepath) {
1.1147 raeburn 11551: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11552: } else {
1.1147 raeburn 11553: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11554: }
11555: }
1.984 raeburn 11556: }
11557: }
1.1249 damieng 11558:
11559: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
11560: # and lists
11561: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
11562: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
11563: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
11564: # the path had to be cleaned up
11565: # $existing: hash clean path -> 1 if the file exists
11566: # $numexisting: number of keys in $existing
11567: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
11568: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
11569: # dependency subdirectories that are
11570: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 11571: my $dirptr = 16384;
1.984 raeburn 11572: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11573: $currsubfile{$path} = {};
1.1123 raeburn 11574: if (($actionurl eq '/adm/portfolio') ||
11575: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11576: my ($sublistref,$listerror) =
11577: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11578: if (ref($sublistref) eq 'ARRAY') {
11579: foreach my $line (@{$sublistref}) {
11580: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11581: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11582: }
1.984 raeburn 11583: }
1.987 raeburn 11584: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11585: if (opendir(my $dir,$url.'/'.$path)) {
11586: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11587: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11588: }
1.1084 raeburn 11589: } elsif (($actionurl eq '/adm/dependencies') ||
11590: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11591: ($args->{'context'} eq 'paste')) ||
11592: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11593: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 11594: my $dir;
11595: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11596: $dir = $fileloc;
11597: } else {
11598: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11599: }
1.1071 raeburn 11600: if ($dir ne '') {
11601: my ($sublistref,$listerror) =
11602: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11603: if (ref($sublistref) eq 'ARRAY') {
11604: foreach my $line (@{$sublistref}) {
11605: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11606: undef,$mtime)=split(/\&/,$line,12);
11607: unless (($testdir&$dirptr) ||
11608: ($file_name =~ /^\.\.?$/)) {
11609: $currsubfile{$path}{$file_name} = [$size,$mtime];
11610: }
11611: }
11612: }
11613: }
1.984 raeburn 11614: }
11615: }
11616: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11617: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11618: my $item = $path.'/'.$file;
11619: unless ($mapping{$item} eq $item) {
11620: $pathchanges{$item} = 1;
11621: }
11622: $existing{$item} = 1;
11623: $numexisting ++;
11624: } else {
11625: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11626: }
11627: }
1.1071 raeburn 11628: if ($actionurl eq '/adm/dependencies') {
11629: foreach my $path (keys(%currsubfile)) {
11630: if (ref($currsubfile{$path}) eq 'HASH') {
11631: foreach my $file (keys(%{$currsubfile{$path}})) {
11632: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 11633: next if (($rem ne '') &&
11634: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11635: (ref($navmap) &&
11636: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11637: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11638: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11639: $unused{$path.'/'.$file} = 1;
11640: }
11641: }
11642: }
11643: }
11644: }
1.984 raeburn 11645: }
1.1249 damieng 11646:
11647: # fills $currfile, hash file name -> 1 or [$size,$mtime]
11648: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 11649: my %currfile;
1.1123 raeburn 11650: if (($actionurl eq '/adm/portfolio') ||
11651: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11652: my ($dirlistref,$listerror) =
11653: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11654: if (ref($dirlistref) eq 'ARRAY') {
11655: foreach my $line (@{$dirlistref}) {
11656: my ($file_name,$rest) = split(/\&/,$line,2);
11657: $currfile{$file_name} = 1;
11658: }
1.984 raeburn 11659: }
1.987 raeburn 11660: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11661: if (opendir(my $dir,$url)) {
1.987 raeburn 11662: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11663: map {$currfile{$_} = 1;} @dir_list;
11664: }
1.1084 raeburn 11665: } elsif (($actionurl eq '/adm/dependencies') ||
11666: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 11667: ($args->{'context'} eq 'paste')) ||
11668: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11669: if ($env{'request.course.id'} ne '') {
11670: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11671: if ($dir ne '') {
11672: my ($dirlistref,$listerror) =
11673: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11674: if (ref($dirlistref) eq 'ARRAY') {
11675: foreach my $line (@{$dirlistref}) {
11676: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11677: $size,undef,$mtime)=split(/\&/,$line,12);
11678: unless (($testdir&$dirptr) ||
11679: ($file_name =~ /^\.\.?$/)) {
11680: $currfile{$file_name} = [$size,$mtime];
11681: }
11682: }
11683: }
11684: }
11685: }
1.984 raeburn 11686: }
1.1249 damieng 11687: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
11688: # are not in subdirectories, using $currfile
1.984 raeburn 11689: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11690: if (exists($currfile{$file})) {
1.987 raeburn 11691: unless ($mapping{$file} eq $file) {
11692: $pathchanges{$file} = 1;
11693: }
11694: $existing{$file} = 1;
11695: $numexisting ++;
11696: } else {
1.984 raeburn 11697: $newfiles{$file} = 1;
11698: }
11699: }
1.1071 raeburn 11700: foreach my $file (keys(%currfile)) {
11701: unless (($file eq $filename) ||
11702: ($file eq $filename.'.bak') ||
11703: ($dependencies{$file})) {
1.1085 raeburn 11704: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 11705: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11706: next if (($rem ne '') &&
11707: (($env{"httpref.$rem".$file} ne '') ||
11708: (ref($navmap) &&
11709: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11710: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11711: ($navmap->getResourceByUrl($rem.$1)))))));
11712: }
1.1085 raeburn 11713: }
1.1071 raeburn 11714: $unused{$file} = 1;
11715: }
11716: }
1.1249 damieng 11717:
11718: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 11719: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11720: ($args->{'context'} eq 'paste')) {
11721: $counter = scalar(keys(%existing));
11722: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 11723: return ($output,$counter,$numpathchg,\%existing);
11724: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11725: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11726: $counter = scalar(keys(%existing));
11727: $numpathchg = scalar(keys(%pathchanges));
11728: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 11729: }
1.1249 damieng 11730:
11731: # returns HTML otherwise, with dependency results and to ask for more uploads
11732:
11733: # $upload_output: missing dependencies (with upload form)
11734: # $modify_output: uploaded dependencies (in use)
11735: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 11736: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11737: if ($actionurl eq '/adm/dependencies') {
11738: next if ($embed_file =~ m{^\w+://});
11739: }
1.660 raeburn 11740: $upload_output .= &start_data_table_row().
1.1123 raeburn 11741: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11742: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11743: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 11744: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11745: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11746: }
1.1123 raeburn 11747: $upload_output .= '</td>';
1.1071 raeburn 11748: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 11749: $upload_output.='<td align="right">'.
11750: '<span class="LC_info LC_fontsize_medium">'.
11751: &mt("URL points to web address").'</span>';
1.987 raeburn 11752: $numremref++;
1.660 raeburn 11753: } elsif ($args->{'error_on_invalid_names'}
11754: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 11755: $upload_output.='<td align="right"><span class="LC_warning">'.
11756: &mt('Invalid characters').'</span>';
1.987 raeburn 11757: $numinvalid++;
1.660 raeburn 11758: } else {
1.1123 raeburn 11759: $upload_output .= '<td>'.
11760: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11761: $embed_file,\%mapping,
1.1071 raeburn 11762: $allfiles,$codebase,'upload');
11763: $counter ++;
11764: $numnew ++;
1.987 raeburn 11765: }
11766: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11767: }
11768: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11769: if ($actionurl eq '/adm/dependencies') {
11770: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11771: $modify_output .= &start_data_table_row().
11772: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11773: '<img src="'.&icon($embed_file).'" border="0" />'.
11774: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11775: '<td>'.$size.'</td>'.
11776: '<td>'.$mtime.'</td>'.
11777: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11778: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11779: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11780: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11781: &embedded_file_element('upload_embedded',$counter,
11782: $embed_file,\%mapping,
11783: $allfiles,$codebase,'modify').
11784: '</div></td>'.
11785: &end_data_table_row()."\n";
11786: $counter ++;
11787: } else {
11788: $upload_output .= &start_data_table_row().
1.1123 raeburn 11789: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11790: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11791: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11792: &Apache::loncommon::end_data_table_row()."\n";
11793: }
11794: }
11795: my $delidx = $counter;
11796: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11797: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11798: $delete_output .= &start_data_table_row().
11799: '<td><img src="'.&icon($oldfile).'" />'.
11800: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11801: '<td>'.$size.'</td>'.
11802: '<td>'.$mtime.'</td>'.
11803: '<td><label><input type="checkbox" name="del_upload_dep" '.
11804: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11805: &embedded_file_element('upload_embedded',$delidx,
11806: $oldfile,\%mapping,$allfiles,
11807: $codebase,'delete').'</td>'.
11808: &end_data_table_row()."\n";
11809: $numunused ++;
11810: $delidx ++;
1.987 raeburn 11811: }
11812: if ($upload_output) {
11813: $upload_output = &start_data_table().
11814: $upload_output.
11815: &end_data_table()."\n";
11816: }
1.1071 raeburn 11817: if ($modify_output) {
11818: $modify_output = &start_data_table().
11819: &start_data_table_header_row().
11820: '<th>'.&mt('File').'</th>'.
11821: '<th>'.&mt('Size (KB)').'</th>'.
11822: '<th>'.&mt('Modified').'</th>'.
11823: '<th>'.&mt('Upload replacement?').'</th>'.
11824: &end_data_table_header_row().
11825: $modify_output.
11826: &end_data_table()."\n";
11827: }
11828: if ($delete_output) {
11829: $delete_output = &start_data_table().
11830: &start_data_table_header_row().
11831: '<th>'.&mt('File').'</th>'.
11832: '<th>'.&mt('Size (KB)').'</th>'.
11833: '<th>'.&mt('Modified').'</th>'.
11834: '<th>'.&mt('Delete?').'</th>'.
11835: &end_data_table_header_row().
11836: $delete_output.
11837: &end_data_table()."\n";
11838: }
1.987 raeburn 11839: my $applies = 0;
11840: if ($numremref) {
11841: $applies ++;
11842: }
11843: if ($numinvalid) {
11844: $applies ++;
11845: }
11846: if ($numexisting) {
11847: $applies ++;
11848: }
1.1071 raeburn 11849: if ($counter || $numunused) {
1.987 raeburn 11850: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11851: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11852: $state.'<h3>'.$heading.'</h3>';
11853: if ($actionurl eq '/adm/dependencies') {
11854: if ($numnew) {
11855: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11856: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11857: $upload_output.'<br />'."\n";
11858: }
11859: if ($numexisting) {
11860: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11861: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11862: $modify_output.'<br />'."\n";
11863: $buttontext = &mt('Save changes');
11864: }
11865: if ($numunused) {
11866: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11867: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11868: $delete_output.'<br />'."\n";
11869: $buttontext = &mt('Save changes');
11870: }
11871: } else {
11872: $output .= $upload_output.'<br />'."\n";
11873: }
11874: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11875: $counter.'" />'."\n";
11876: if ($actionurl eq '/adm/dependencies') {
11877: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11878: $numnew.'" />'."\n";
11879: } elsif ($actionurl eq '') {
1.987 raeburn 11880: $output .= '<input type="hidden" name="phase" value="three" />';
11881: }
11882: } elsif ($applies) {
11883: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11884: if ($applies > 1) {
11885: $output .=
1.1123 raeburn 11886: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11887: if ($numremref) {
11888: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11889: }
11890: if ($numinvalid) {
11891: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11892: }
11893: if ($numexisting) {
11894: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11895: }
11896: $output .= '</ul><br />';
11897: } elsif ($numremref) {
11898: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11899: } elsif ($numinvalid) {
11900: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11901: } elsif ($numexisting) {
11902: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11903: }
11904: $output .= $upload_output.'<br />';
11905: }
11906: my ($pathchange_output,$chgcount);
1.1071 raeburn 11907: $chgcount = $counter;
1.987 raeburn 11908: if (keys(%pathchanges) > 0) {
11909: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11910: if ($counter) {
1.987 raeburn 11911: $output .= &embedded_file_element('pathchange',$chgcount,
11912: $embed_file,\%mapping,
1.1071 raeburn 11913: $allfiles,$codebase,'change');
1.987 raeburn 11914: } else {
11915: $pathchange_output .=
11916: &start_data_table_row().
11917: '<td><input type ="checkbox" name="namechange" value="'.
11918: $chgcount.'" checked="checked" /></td>'.
11919: '<td>'.$mapping{$embed_file}.'</td>'.
11920: '<td>'.$embed_file.
11921: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11922: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11923: '</td>'.&end_data_table_row();
1.660 raeburn 11924: }
1.987 raeburn 11925: $numpathchg ++;
11926: $chgcount ++;
1.660 raeburn 11927: }
11928: }
1.1127 raeburn 11929: if (($counter) || ($numunused)) {
1.987 raeburn 11930: if ($numpathchg) {
11931: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11932: $numpathchg.'" />'."\n";
11933: }
11934: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11935: ($actionurl eq '/adm/imsimport')) {
11936: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11937: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11938: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11939: } elsif ($actionurl eq '/adm/dependencies') {
11940: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11941: }
1.1123 raeburn 11942: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11943: } elsif ($numpathchg) {
11944: my %pathchange = ();
11945: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11946: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11947: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 11948: }
1.987 raeburn 11949: }
1.1071 raeburn 11950: return ($output,$counter,$numpathchg);
1.987 raeburn 11951: }
11952:
1.1147 raeburn 11953: =pod
11954:
11955: =item * clean_path($name)
11956:
11957: Performs clean-up of directories, subdirectories and filename in an
11958: embedded object, referenced in an HTML file which is being uploaded
11959: to a course or portfolio, where
11960: "Upload embedded images/multimedia files if HTML file" checkbox was
11961: checked.
11962:
11963: Clean-up is similar to replacements in lonnet::clean_filename()
11964: except each / between sub-directory and next level is preserved.
11965:
11966: =cut
11967:
11968: sub clean_path {
11969: my ($embed_file) = @_;
11970: $embed_file =~s{^/+}{};
11971: my @contents;
11972: if ($embed_file =~ m{/}) {
11973: @contents = split(/\//,$embed_file);
11974: } else {
11975: @contents = ($embed_file);
11976: }
11977: my $lastidx = scalar(@contents)-1;
11978: for (my $i=0; $i<=$lastidx; $i++) {
11979: $contents[$i]=~s{\\}{/}g;
11980: $contents[$i]=~s/\s+/\_/g;
11981: $contents[$i]=~s{[^/\w\.\-]}{}g;
11982: if ($i == $lastidx) {
11983: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11984: }
11985: }
11986: if ($lastidx > 0) {
11987: return join('/',@contents);
11988: } else {
11989: return $contents[0];
11990: }
11991: }
11992:
1.987 raeburn 11993: sub embedded_file_element {
1.1071 raeburn 11994: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11995: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11996: (ref($codebase) eq 'HASH'));
11997: my $output;
1.1071 raeburn 11998: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11999: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12000: }
12001: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12002: &escape($embed_file).'" />';
12003: unless (($context eq 'upload_embedded') &&
12004: ($mapping->{$embed_file} eq $embed_file)) {
12005: $output .='
12006: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12007: }
12008: my $attrib;
12009: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12010: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12011: }
12012: $output .=
12013: "\n\t\t".
12014: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12015: $attrib.'" />';
12016: if (exists($codebase->{$mapping->{$embed_file}})) {
12017: $output .=
12018: "\n\t\t".
12019: '<input name="codebase_'.$num.'" type="hidden" value="'.
12020: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12021: }
1.987 raeburn 12022: return $output;
1.660 raeburn 12023: }
12024:
1.1071 raeburn 12025: sub get_dependency_details {
12026: my ($currfile,$currsubfile,$embed_file) = @_;
12027: my ($size,$mtime,$showsize,$showmtime);
12028: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12029: if ($embed_file =~ m{/}) {
12030: my ($path,$fname) = split(/\//,$embed_file);
12031: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12032: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12033: }
12034: } else {
12035: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
12036: ($size,$mtime) = @{$currfile->{$embed_file}};
12037: }
12038: }
12039: $showsize = $size/1024.0;
12040: $showsize = sprintf("%.1f",$showsize);
12041: if ($mtime > 0) {
12042: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
12043: }
12044: }
12045: return ($showsize,$showmtime);
12046: }
12047:
12048: sub ask_embedded_js {
12049: return <<"END";
12050: <script type="text/javascript"">
12051: // <![CDATA[
12052: function toggleBrowse(counter) {
12053: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
12054: var fileid = document.getElementById('embedded_item_'+counter);
12055: var uploaddivid = document.getElementById('moduploaddep_'+counter);
12056: if (chkboxid.checked == true) {
12057: uploaddivid.style.display='block';
12058: } else {
12059: uploaddivid.style.display='none';
12060: fileid.value = '';
12061: }
12062: }
12063: // ]]>
12064: </script>
12065:
12066: END
12067: }
12068:
1.661 raeburn 12069: sub upload_embedded {
12070: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12071: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12072: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12073: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12074: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12075: my $orig_uploaded_filename =
12076: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12077: foreach my $type ('orig','ref','attrib','codebase') {
12078: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12079: $env{'form.embedded_'.$type.'_'.$i} =
12080: &unescape($env{'form.embedded_'.$type.'_'.$i});
12081: }
12082: }
1.661 raeburn 12083: my ($path,$fname) =
12084: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12085: # no path, whole string is fname
12086: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12087: $fname = &Apache::lonnet::clean_filename($fname);
12088: # See if there is anything left
12089: next if ($fname eq '');
12090:
12091: # Check if file already exists as a file or directory.
12092: my ($state,$msg);
12093: if ($context eq 'portfolio') {
12094: my $port_path = $dirpath;
12095: if ($group ne '') {
12096: $port_path = "groups/$group/$port_path";
12097: }
1.987 raeburn 12098: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12099: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12100: $dir_root,$port_path,$disk_quota,
12101: $current_disk_usage,$uname,$udom);
12102: if ($state eq 'will_exceed_quota'
1.984 raeburn 12103: || $state eq 'file_locked') {
1.661 raeburn 12104: $output .= $msg;
12105: next;
12106: }
12107: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12108: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12109: if ($state eq 'exists') {
12110: $output .= $msg;
12111: next;
12112: }
12113: }
12114: # Check if extension is valid
12115: if (($fname =~ /\.(\w+)$/) &&
12116: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 12117: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12118: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12119: next;
12120: } elsif (($fname =~ /\.(\w+)$/) &&
12121: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12122: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12123: next;
12124: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 12125: $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 12126: next;
12127: }
12128: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 12129: my $subdir = $path;
12130: $subdir =~ s{/+$}{};
1.661 raeburn 12131: if ($context eq 'portfolio') {
1.984 raeburn 12132: my $result;
12133: if ($state eq 'existingfile') {
12134: $result=
12135: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 12136: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12137: } else {
1.984 raeburn 12138: $result=
12139: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12140: $dirpath.
1.1123 raeburn 12141: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12142: if ($result !~ m|^/uploaded/|) {
12143: $output .= '<span class="LC_error">'
12144: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12145: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12146: .'</span><br />';
12147: next;
12148: } else {
1.987 raeburn 12149: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12150: $path.$fname.'</span>').'<br />';
1.984 raeburn 12151: }
1.661 raeburn 12152: }
1.1123 raeburn 12153: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 12154: my $extendedsubdir = $dirpath.'/'.$subdir;
12155: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12156: my $result =
1.1126 raeburn 12157: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12158: if ($result !~ m|^/uploaded/|) {
12159: $output .= '<span class="LC_error">'
12160: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12161: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12162: .'</span><br />';
12163: next;
12164: } else {
12165: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12166: $path.$fname.'</span>').'<br />';
1.1125 raeburn 12167: if ($context eq 'syllabus') {
12168: &Apache::lonnet::make_public_indefinitely($result);
12169: }
1.987 raeburn 12170: }
1.661 raeburn 12171: } else {
12172: # Save the file
12173: my $target = $env{'form.embedded_item_'.$i};
12174: my $fullpath = $dir_root.$dirpath.'/'.$path;
12175: my $dest = $fullpath.$fname;
12176: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12177: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12178: my $count;
12179: my $filepath = $dir_root;
1.1027 raeburn 12180: foreach my $subdir (@parts) {
12181: $filepath .= "/$subdir";
12182: if (!-e $filepath) {
1.661 raeburn 12183: mkdir($filepath,0770);
12184: }
12185: }
12186: my $fh;
12187: if (!open($fh,'>'.$dest)) {
12188: &Apache::lonnet::logthis('Failed to create '.$dest);
12189: $output .= '<span class="LC_error">'.
1.1071 raeburn 12190: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12191: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12192: '</span><br />';
12193: } else {
12194: if (!print $fh $env{'form.embedded_item_'.$i}) {
12195: &Apache::lonnet::logthis('Failed to write to '.$dest);
12196: $output .= '<span class="LC_error">'.
1.1071 raeburn 12197: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12198: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12199: '</span><br />';
12200: } else {
1.987 raeburn 12201: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12202: $url.'</span>').'<br />';
12203: unless ($context eq 'testbank') {
12204: $footer .= &mt('View embedded file: [_1]',
12205: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12206: }
12207: }
12208: close($fh);
12209: }
12210: }
12211: if ($env{'form.embedded_ref_'.$i}) {
12212: $pathchange{$i} = 1;
12213: }
12214: }
12215: if ($output) {
12216: $output = '<p>'.$output.'</p>';
12217: }
12218: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12219: $returnflag = 'ok';
1.1071 raeburn 12220: my $numpathchgs = scalar(keys(%pathchange));
12221: if ($numpathchgs > 0) {
1.987 raeburn 12222: if ($context eq 'portfolio') {
12223: $output .= '<p>'.&mt('or').'</p>';
12224: } elsif ($context eq 'testbank') {
1.1071 raeburn 12225: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12226: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12227: $returnflag = 'modify_orightml';
12228: }
12229: }
1.1071 raeburn 12230: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12231: }
12232:
12233: sub modify_html_form {
12234: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12235: my $end = 0;
12236: my $modifyform;
12237: if ($context eq 'upload_embedded') {
12238: return unless (ref($pathchange) eq 'HASH');
12239: if ($env{'form.number_embedded_items'}) {
12240: $end += $env{'form.number_embedded_items'};
12241: }
12242: if ($env{'form.number_pathchange_items'}) {
12243: $end += $env{'form.number_pathchange_items'};
12244: }
12245: if ($end) {
12246: for (my $i=0; $i<$end; $i++) {
12247: if ($i < $env{'form.number_embedded_items'}) {
12248: next unless($pathchange->{$i});
12249: }
12250: $modifyform .=
12251: &start_data_table_row().
12252: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12253: 'checked="checked" /></td>'.
12254: '<td>'.$env{'form.embedded_ref_'.$i}.
12255: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12256: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12257: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12258: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12259: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12260: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12261: '<td>'.$env{'form.embedded_orig_'.$i}.
12262: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12263: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12264: &end_data_table_row();
1.1071 raeburn 12265: }
1.987 raeburn 12266: }
12267: } else {
12268: $modifyform = $pathchgtable;
12269: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12270: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12271: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12272: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12273: }
12274: }
12275: if ($modifyform) {
1.1071 raeburn 12276: if ($actionurl eq '/adm/dependencies') {
12277: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12278: }
1.987 raeburn 12279: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12280: '<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".
12281: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12282: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12283: '</ol></p>'."\n".'<p>'.
12284: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12285: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12286: &start_data_table()."\n".
12287: &start_data_table_header_row().
12288: '<th>'.&mt('Change?').'</th>'.
12289: '<th>'.&mt('Current reference').'</th>'.
12290: '<th>'.&mt('Required reference').'</th>'.
12291: &end_data_table_header_row()."\n".
12292: $modifyform.
12293: &end_data_table().'<br />'."\n".$hiddenstate.
12294: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12295: '</form>'."\n";
12296: }
12297: return;
12298: }
12299:
12300: sub modify_html_refs {
1.1123 raeburn 12301: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12302: my $container;
12303: if ($context eq 'portfolio') {
12304: $container = $env{'form.container'};
12305: } elsif ($context eq 'coursedoc') {
12306: $container = $env{'form.primaryurl'};
1.1071 raeburn 12307: } elsif ($context eq 'manage_dependencies') {
12308: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12309: $container = "/$container";
1.1123 raeburn 12310: } elsif ($context eq 'syllabus') {
12311: $container = $url;
1.987 raeburn 12312: } else {
1.1027 raeburn 12313: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12314: }
12315: my (%allfiles,%codebase,$output,$content);
12316: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 12317: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12318: if (wantarray) {
12319: return ('',0,0);
12320: } else {
12321: return;
12322: }
12323: }
12324: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12325: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12326: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12327: if (wantarray) {
12328: return ('',0,0);
12329: } else {
12330: return;
12331: }
12332: }
1.987 raeburn 12333: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12334: if ($content eq '-1') {
12335: if (wantarray) {
12336: return ('',0,0);
12337: } else {
12338: return;
12339: }
12340: }
1.987 raeburn 12341: } else {
1.1071 raeburn 12342: unless ($container =~ /^\Q$dir_root\E/) {
12343: if (wantarray) {
12344: return ('',0,0);
12345: } else {
12346: return;
12347: }
12348: }
1.1317 raeburn 12349: if (open(my $fh,'<',$container)) {
1.987 raeburn 12350: $content = join('', <$fh>);
12351: close($fh);
12352: } else {
1.1071 raeburn 12353: if (wantarray) {
12354: return ('',0,0);
12355: } else {
12356: return;
12357: }
1.987 raeburn 12358: }
12359: }
12360: my ($count,$codebasecount) = (0,0);
12361: my $mm = new File::MMagic;
12362: my $mime_type = $mm->checktype_contents($content);
12363: if ($mime_type eq 'text/html') {
12364: my $parse_result =
12365: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12366: \%codebase,\$content);
12367: if ($parse_result eq 'ok') {
12368: foreach my $i (@changes) {
12369: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12370: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12371: if ($allfiles{$ref}) {
12372: my $newname = $orig;
12373: my ($attrib_regexp,$codebase);
1.1006 raeburn 12374: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12375: if ($attrib_regexp =~ /:/) {
12376: $attrib_regexp =~ s/\:/|/g;
12377: }
12378: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12379: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12380: $count += $numchg;
1.1123 raeburn 12381: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12382: delete($allfiles{$ref});
1.987 raeburn 12383: }
12384: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12385: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12386: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12387: $codebasecount ++;
12388: }
12389: }
12390: }
1.1123 raeburn 12391: my $skiprewrites;
1.987 raeburn 12392: if ($count || $codebasecount) {
12393: my $saveresult;
1.1071 raeburn 12394: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12395: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12396: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12397: if ($url eq $container) {
12398: my ($fname) = ($container =~ m{/([^/]+)$});
12399: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12400: $count,'<span class="LC_filename">'.
1.1071 raeburn 12401: $fname.'</span>').'</p>';
1.987 raeburn 12402: } else {
12403: $output = '<p class="LC_error">'.
12404: &mt('Error: update failed for: [_1].',
12405: '<span class="LC_filename">'.
12406: $container.'</span>').'</p>';
12407: }
1.1123 raeburn 12408: if ($context eq 'syllabus') {
12409: unless ($saveresult eq 'ok') {
12410: $skiprewrites = 1;
12411: }
12412: }
1.987 raeburn 12413: } else {
1.1317 raeburn 12414: if (open(my $fh,'>',$container)) {
1.987 raeburn 12415: print $fh $content;
12416: close($fh);
12417: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12418: $count,'<span class="LC_filename">'.
12419: $container.'</span>').'</p>';
1.661 raeburn 12420: } else {
1.987 raeburn 12421: $output = '<p class="LC_error">'.
12422: &mt('Error: could not update [_1].',
12423: '<span class="LC_filename">'.
12424: $container.'</span>').'</p>';
1.661 raeburn 12425: }
12426: }
12427: }
1.1123 raeburn 12428: if (($context eq 'syllabus') && (!$skiprewrites)) {
12429: my ($actionurl,$state);
12430: $actionurl = "/public/$udom/$uname/syllabus";
12431: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12432: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12433: \%codebase,
12434: {'context' => 'rewrites',
12435: 'ignore_remote_references' => 1,});
12436: if (ref($mapping) eq 'HASH') {
12437: my $rewrites = 0;
12438: foreach my $key (keys(%{$mapping})) {
12439: next if ($key =~ m{^https?://});
12440: my $ref = $mapping->{$key};
12441: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12442: my $attrib;
12443: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12444: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12445: }
12446: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12447: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12448: $rewrites += $numchg;
12449: }
12450: }
12451: if ($rewrites) {
12452: my $saveresult;
12453: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12454: if ($url eq $container) {
12455: my ($fname) = ($container =~ m{/([^/]+)$});
12456: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12457: $count,'<span class="LC_filename">'.
12458: $fname.'</span>').'</p>';
12459: } else {
12460: $output .= '<p class="LC_error">'.
12461: &mt('Error: could not update links in [_1].',
12462: '<span class="LC_filename">'.
12463: $container.'</span>').'</p>';
12464:
12465: }
12466: }
12467: }
12468: }
1.987 raeburn 12469: } else {
12470: &logthis('Failed to parse '.$container.
12471: ' to modify references: '.$parse_result);
1.661 raeburn 12472: }
12473: }
1.1071 raeburn 12474: if (wantarray) {
12475: return ($output,$count,$codebasecount);
12476: } else {
12477: return $output;
12478: }
1.661 raeburn 12479: }
12480:
12481: sub check_for_existing {
12482: my ($path,$fname,$element) = @_;
12483: my ($state,$msg);
12484: if (-d $path.'/'.$fname) {
12485: $state = 'exists';
12486: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12487: } elsif (-e $path.'/'.$fname) {
12488: $state = 'exists';
12489: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12490: }
12491: if ($state eq 'exists') {
12492: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12493: }
12494: return ($state,$msg);
12495: }
12496:
12497: sub check_for_upload {
12498: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12499: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12500: my $filesize = length($env{'form.'.$element});
12501: if (!$filesize) {
12502: my $msg = '<span class="LC_error">'.
12503: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12504: '<span class="LC_filename">'.$fname.'</span>',
12505: $filesize).'<br />'.
1.1007 raeburn 12506: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12507: '</span>';
12508: return ('zero_bytes',$msg);
12509: }
12510: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12511: my $getpropath = 1;
1.1021 raeburn 12512: my ($dirlistref,$listerror) =
12513: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12514: my $found_file = 0;
12515: my $locked_file = 0;
1.991 raeburn 12516: my @lockers;
12517: my $navmap;
12518: if ($env{'request.course.id'}) {
12519: $navmap = Apache::lonnavmaps::navmap->new();
12520: }
1.1021 raeburn 12521: if (ref($dirlistref) eq 'ARRAY') {
12522: foreach my $line (@{$dirlistref}) {
12523: my ($file_name,$rest)=split(/\&/,$line,2);
12524: if ($file_name eq $fname){
12525: $file_name = $path.$file_name;
12526: if ($group ne '') {
12527: $file_name = $group.$file_name;
12528: }
12529: $found_file = 1;
12530: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12531: foreach my $lock (@lockers) {
12532: if (ref($lock) eq 'ARRAY') {
12533: my ($symb,$crsid) = @{$lock};
12534: if ($crsid eq $env{'request.course.id'}) {
12535: if (ref($navmap)) {
12536: my $res = $navmap->getBySymb($symb);
12537: foreach my $part (@{$res->parts()}) {
12538: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12539: unless (($slot_status == $res->RESERVED) ||
12540: ($slot_status == $res->RESERVED_LOCATION)) {
12541: $locked_file = 1;
12542: }
1.991 raeburn 12543: }
1.1021 raeburn 12544: } else {
12545: $locked_file = 1;
1.991 raeburn 12546: }
12547: } else {
12548: $locked_file = 1;
12549: }
12550: }
1.1021 raeburn 12551: }
12552: } else {
12553: my @info = split(/\&/,$rest);
12554: my $currsize = $info[6]/1000;
12555: if ($currsize < $filesize) {
12556: my $extra = $filesize - $currsize;
12557: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 12558: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12559: &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 12560: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12561: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12562: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12563: return ('will_exceed_quota',$msg);
12564: }
1.984 raeburn 12565: }
12566: }
1.661 raeburn 12567: }
12568: }
12569: }
12570: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 12571: my $msg = '<p class="LC_warning">'.
12572: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 12573: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12574: return ('will_exceed_quota',$msg);
12575: } elsif ($found_file) {
12576: if ($locked_file) {
1.1179 bisitz 12577: my $msg = '<p class="LC_warning">';
1.661 raeburn 12578: $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 12579: $msg .= '</p>';
1.661 raeburn 12580: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12581: return ('file_locked',$msg);
12582: } else {
1.1179 bisitz 12583: my $msg = '<p class="LC_error">';
1.984 raeburn 12584: $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 12585: $msg .= '</p>';
1.984 raeburn 12586: return ('existingfile',$msg);
1.661 raeburn 12587: }
12588: }
12589: }
12590:
1.987 raeburn 12591: sub check_for_traversal {
12592: my ($path,$url,$toplevel) = @_;
12593: my @parts=split(/\//,$path);
12594: my $cleanpath;
12595: my $fullpath = $url;
12596: for (my $i=0;$i<@parts;$i++) {
12597: next if ($parts[$i] eq '.');
12598: if ($parts[$i] eq '..') {
12599: $fullpath =~ s{([^/]+/)$}{};
12600: } else {
12601: $fullpath .= $parts[$i].'/';
12602: }
12603: }
12604: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12605: $cleanpath = $1;
12606: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12607: my $curr_toprel = $1;
12608: my @parts = split(/\//,$curr_toprel);
12609: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12610: my @urlparts = split(/\//,$url_toprel);
12611: my $doubledots;
12612: my $startdiff = -1;
12613: for (my $i=0; $i<@urlparts; $i++) {
12614: if ($startdiff == -1) {
12615: unless ($urlparts[$i] eq $parts[$i]) {
12616: $startdiff = $i;
12617: $doubledots .= '../';
12618: }
12619: } else {
12620: $doubledots .= '../';
12621: }
12622: }
12623: if ($startdiff > -1) {
12624: $cleanpath = $doubledots;
12625: for (my $i=$startdiff; $i<@parts; $i++) {
12626: $cleanpath .= $parts[$i].'/';
12627: }
12628: }
12629: }
12630: $cleanpath =~ s{(/)$}{};
12631: return $cleanpath;
12632: }
1.31 albertel 12633:
1.1053 raeburn 12634: sub is_archive_file {
12635: my ($mimetype) = @_;
12636: if (($mimetype eq 'application/octet-stream') ||
12637: ($mimetype eq 'application/x-stuffit') ||
12638: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12639: return 1;
12640: }
12641: return;
12642: }
12643:
12644: sub decompress_form {
1.1065 raeburn 12645: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12646: my %lt = &Apache::lonlocal::texthash (
12647: this => 'This file is an archive file.',
1.1067 raeburn 12648: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12649: itsc => 'Its contents are as follows:',
1.1053 raeburn 12650: youm => 'You may wish to extract its contents.',
12651: extr => 'Extract contents',
1.1067 raeburn 12652: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12653: proa => 'Process automatically?',
1.1053 raeburn 12654: yes => 'Yes',
12655: no => 'No',
1.1067 raeburn 12656: fold => 'Title for folder containing movie',
12657: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12658: );
1.1065 raeburn 12659: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12660: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12661: my $info = &list_archive_contents($fileloc,\@paths);
12662: if (@paths) {
12663: foreach my $path (@paths) {
12664: $path =~ s{^/}{};
1.1067 raeburn 12665: if ($path =~ m{^([^/]+)/$}) {
12666: $topdir = $1;
12667: }
1.1065 raeburn 12668: if ($path =~ m{^([^/]+)/}) {
12669: $toplevel{$1} = $path;
12670: } else {
12671: $toplevel{$path} = $path;
12672: }
12673: }
12674: }
1.1067 raeburn 12675: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 12676: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12677: "$topdir/media/",
12678: "$topdir/media/$topdir.mp4",
12679: "$topdir/media/FirstFrame.png",
12680: "$topdir/media/player.swf",
12681: "$topdir/media/swfobject.js",
12682: "$topdir/media/expressInstall.swf");
1.1197 raeburn 12683: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 12684: "$topdir/$topdir.mp4",
12685: "$topdir/$topdir\_config.xml",
12686: "$topdir/$topdir\_controller.swf",
12687: "$topdir/$topdir\_embed.css",
12688: "$topdir/$topdir\_First_Frame.png",
12689: "$topdir/$topdir\_player.html",
12690: "$topdir/$topdir\_Thumbnails.png",
12691: "$topdir/playerProductInstall.swf",
12692: "$topdir/scripts/",
12693: "$topdir/scripts/config_xml.js",
12694: "$topdir/scripts/handlebars.js",
12695: "$topdir/scripts/jquery-1.7.1.min.js",
12696: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12697: "$topdir/scripts/modernizr.js",
12698: "$topdir/scripts/player-min.js",
12699: "$topdir/scripts/swfobject.js",
12700: "$topdir/skins/",
12701: "$topdir/skins/configuration_express.xml",
12702: "$topdir/skins/express_show/",
12703: "$topdir/skins/express_show/player-min.css",
12704: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 12705: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12706: "$topdir/$topdir.mp4",
12707: "$topdir/$topdir\_config.xml",
12708: "$topdir/$topdir\_controller.swf",
12709: "$topdir/$topdir\_embed.css",
12710: "$topdir/$topdir\_First_Frame.png",
12711: "$topdir/$topdir\_player.html",
12712: "$topdir/$topdir\_Thumbnails.png",
12713: "$topdir/playerProductInstall.swf",
12714: "$topdir/scripts/",
12715: "$topdir/scripts/config_xml.js",
12716: "$topdir/scripts/techsmith-smart-player.min.js",
12717: "$topdir/skins/",
12718: "$topdir/skins/configuration_express.xml",
12719: "$topdir/skins/express_show/",
12720: "$topdir/skins/express_show/spritesheet.min.css",
12721: "$topdir/skins/express_show/spritesheet.png",
12722: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 12723: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12724: if (@diffs == 0) {
1.1164 raeburn 12725: $is_camtasia = 6;
12726: } else {
1.1197 raeburn 12727: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 12728: if (@diffs == 0) {
12729: $is_camtasia = 8;
1.1197 raeburn 12730: } else {
12731: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12732: if (@diffs == 0) {
12733: $is_camtasia = 8;
12734: }
1.1164 raeburn 12735: }
1.1067 raeburn 12736: }
12737: }
12738: my $output;
12739: if ($is_camtasia) {
12740: $output = <<"ENDCAM";
12741: <script type="text/javascript" language="Javascript">
12742: // <![CDATA[
12743:
12744: function camtasiaToggle() {
12745: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12746: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 12747: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12748: document.getElementById('camtasia_titles').style.display='block';
12749: } else {
12750: document.getElementById('camtasia_titles').style.display='none';
12751: }
12752: }
12753: }
12754: return;
12755: }
12756:
12757: // ]]>
12758: </script>
12759: <p>$lt{'camt'}</p>
12760: ENDCAM
1.1065 raeburn 12761: } else {
1.1067 raeburn 12762: $output = '<p>'.$lt{'this'};
12763: if ($info eq '') {
12764: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12765: } else {
12766: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12767: '<div><pre>'.$info.'</pre></div>';
12768: }
1.1065 raeburn 12769: }
1.1067 raeburn 12770: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12771: my $duplicates;
12772: my $num = 0;
12773: if (ref($dirlist) eq 'ARRAY') {
12774: foreach my $item (@{$dirlist}) {
12775: if (ref($item) eq 'ARRAY') {
12776: if (exists($toplevel{$item->[0]})) {
12777: $duplicates .=
12778: &start_data_table_row().
12779: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12780: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12781: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12782: 'value="1" />'.&mt('Yes').'</label>'.
12783: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12784: '<td>'.$item->[0].'</td>';
12785: if ($item->[2]) {
12786: $duplicates .= '<td>'.&mt('Directory').'</td>';
12787: } else {
12788: $duplicates .= '<td>'.&mt('File').'</td>';
12789: }
12790: $duplicates .= '<td>'.$item->[3].'</td>'.
12791: '<td>'.
12792: &Apache::lonlocal::locallocaltime($item->[4]).
12793: '</td>'.
12794: &end_data_table_row();
12795: $num ++;
12796: }
12797: }
12798: }
12799: }
12800: my $itemcount;
12801: if (@paths > 0) {
12802: $itemcount = scalar(@paths);
12803: } else {
12804: $itemcount = 1;
12805: }
1.1067 raeburn 12806: if ($is_camtasia) {
12807: $output .= $lt{'auto'}.'<br />'.
12808: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 12809: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12810: $lt{'yes'}.'</label> <label>'.
12811: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12812: $lt{'no'}.'</label></span><br />'.
12813: '<div id="camtasia_titles" style="display:block">'.
12814: &Apache::lonhtmlcommon::start_pick_box().
12815: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12816: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12817: &Apache::lonhtmlcommon::row_closure().
12818: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12819: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12820: &Apache::lonhtmlcommon::row_closure(1).
12821: &Apache::lonhtmlcommon::end_pick_box().
12822: '</div>';
12823: }
1.1065 raeburn 12824: $output .=
12825: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12826: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12827: "\n";
1.1065 raeburn 12828: if ($duplicates ne '') {
12829: $output .= '<p><span class="LC_warning">'.
12830: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12831: &start_data_table().
12832: &start_data_table_header_row().
12833: '<th>'.&mt('Overwrite?').'</th>'.
12834: '<th>'.&mt('Name').'</th>'.
12835: '<th>'.&mt('Type').'</th>'.
12836: '<th>'.&mt('Size').'</th>'.
12837: '<th>'.&mt('Last modified').'</th>'.
12838: &end_data_table_header_row().
12839: $duplicates.
12840: &end_data_table().
12841: '</p>';
12842: }
1.1067 raeburn 12843: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12844: if (ref($hiddenelements) eq 'HASH') {
12845: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12846: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12847: }
12848: }
12849: $output .= <<"END";
1.1067 raeburn 12850: <br />
1.1053 raeburn 12851: <input type="submit" name="decompress" value="$lt{'extr'}" />
12852: </form>
12853: $noextract
12854: END
12855: return $output;
12856: }
12857:
1.1065 raeburn 12858: sub decompression_utility {
12859: my ($program) = @_;
12860: my @utilities = ('tar','gunzip','bunzip2','unzip');
12861: my $location;
12862: if (grep(/^\Q$program\E$/,@utilities)) {
12863: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12864: '/usr/sbin/') {
12865: if (-x $dir.$program) {
12866: $location = $dir.$program;
12867: last;
12868: }
12869: }
12870: }
12871: return $location;
12872: }
12873:
12874: sub list_archive_contents {
12875: my ($file,$pathsref) = @_;
12876: my (@cmd,$output);
12877: my $needsregexp;
12878: if ($file =~ /\.zip$/) {
12879: @cmd = (&decompression_utility('unzip'),"-l");
12880: $needsregexp = 1;
12881: } elsif (($file =~ m/\.tar\.gz$/) ||
12882: ($file =~ /\.tgz$/)) {
12883: @cmd = (&decompression_utility('tar'),"-ztf");
12884: } elsif ($file =~ /\.tar\.bz2$/) {
12885: @cmd = (&decompression_utility('tar'),"-jtf");
12886: } elsif ($file =~ m|\.tar$|) {
12887: @cmd = (&decompression_utility('tar'),"-tf");
12888: }
12889: if (@cmd) {
12890: undef($!);
12891: undef($@);
12892: if (open(my $fh,"-|", @cmd, $file)) {
12893: while (my $line = <$fh>) {
12894: $output .= $line;
12895: chomp($line);
12896: my $item;
12897: if ($needsregexp) {
12898: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12899: } else {
12900: $item = $line;
12901: }
12902: if ($item ne '') {
12903: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12904: push(@{$pathsref},$item);
12905: }
12906: }
12907: }
12908: close($fh);
12909: }
12910: }
12911: return $output;
12912: }
12913:
1.1053 raeburn 12914: sub decompress_uploaded_file {
12915: my ($file,$dir) = @_;
12916: &Apache::lonnet::appenv({'cgi.file' => $file});
12917: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12918: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12919: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12920: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12921: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12922: my $decompressed = $env{'cgi.decompressed'};
12923: &Apache::lonnet::delenv('cgi.file');
12924: &Apache::lonnet::delenv('cgi.dir');
12925: &Apache::lonnet::delenv('cgi.decompressed');
12926: return ($decompressed,$result);
12927: }
12928:
1.1055 raeburn 12929: sub process_decompression {
12930: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 12931: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12932: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12933: &mt('Unexpected file path.').'</p>'."\n";
12934: }
12935: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12936: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12937: &mt('Unexpected course context.').'</p>'."\n";
12938: }
1.1293 raeburn 12939: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 12940: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12941: &mt('Filename contained unexpected characters.').'</p>'."\n";
12942: }
1.1055 raeburn 12943: my ($dir,$error,$warning,$output);
1.1180 raeburn 12944: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 12945: $error = &mt('Filename not a supported archive file type.').
12946: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12947: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12948: } else {
12949: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12950: if ($docuhome eq 'no_host') {
12951: $error = &mt('Could not determine home server for course.');
12952: } else {
12953: my @ids=&Apache::lonnet::current_machine_ids();
12954: my $currdir = "$dir_root/$destination";
12955: if (grep(/^\Q$docuhome\E$/,@ids)) {
12956: $dir = &LONCAPA::propath($docudom,$docuname).
12957: "$dir_root/$destination";
12958: } else {
12959: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12960: "$dir_root/$docudom/$docuname/$destination";
12961: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12962: $error = &mt('Archive file not found.');
12963: }
12964: }
1.1065 raeburn 12965: my (@to_overwrite,@to_skip);
12966: if ($env{'form.archive_overwrite_total'} > 0) {
12967: my $total = $env{'form.archive_overwrite_total'};
12968: for (my $i=0; $i<$total; $i++) {
12969: if ($env{'form.archive_overwrite_'.$i} == 1) {
12970: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12971: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12972: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12973: }
12974: }
12975: }
12976: my $numskip = scalar(@to_skip);
1.1292 raeburn 12977: my $numoverwrite = scalar(@to_overwrite);
12978: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12979: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12980: } elsif ($dir eq '') {
1.1055 raeburn 12981: $error = &mt('Directory containing archive file unavailable.');
12982: } elsif (!$error) {
1.1065 raeburn 12983: my ($decompressed,$display);
1.1292 raeburn 12984: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12985: my $tempdir = time.'_'.$$.int(rand(10000));
12986: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 12987: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12988: ($decompressed,$display) =
12989: &decompress_uploaded_file($file,"$dir/$tempdir");
12990: foreach my $item (@to_skip) {
12991: if (($item ne '') && ($item !~ /\.\./)) {
12992: if (-f "$dir/$tempdir/$item") {
12993: unlink("$dir/$tempdir/$item");
12994: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 12995: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 12996: }
12997: }
12998: }
12999: foreach my $item (@to_overwrite) {
13000: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13001: if (($item ne '') && ($item !~ /\.\./)) {
13002: if (-f "$dir/$item") {
13003: unlink("$dir/$item");
13004: } elsif (-d "$dir/$item") {
1.1300 raeburn 13005: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 13006: }
13007: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13008: }
1.1065 raeburn 13009: }
13010: }
1.1292 raeburn 13011: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 13012: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 13013: }
1.1065 raeburn 13014: }
13015: } else {
13016: ($decompressed,$display) =
13017: &decompress_uploaded_file($file,$dir);
13018: }
1.1055 raeburn 13019: if ($decompressed eq 'ok') {
1.1065 raeburn 13020: $output = '<p class="LC_info">'.
13021: &mt('Files extracted successfully from archive.').
13022: '</p>'."\n";
1.1055 raeburn 13023: my ($warning,$result,@contents);
13024: my ($newdirlistref,$newlisterror) =
13025: &Apache::lonnet::dirlist($currdir,$docudom,
13026: $docuname,1);
13027: my (%is_dir,%changes,@newitems);
13028: my $dirptr = 16384;
1.1065 raeburn 13029: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13030: foreach my $dir_line (@{$newdirlistref}) {
13031: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 13032: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13033: push(@newitems,$item);
13034: if ($dirptr&$testdir) {
13035: $is_dir{$item} = 1;
13036: }
13037: $changes{$item} = 1;
13038: }
13039: }
13040: }
13041: if (keys(%changes) > 0) {
13042: foreach my $item (sort(@newitems)) {
13043: if ($changes{$item}) {
13044: push(@contents,$item);
13045: }
13046: }
13047: }
13048: if (@contents > 0) {
1.1067 raeburn 13049: my $wantform;
13050: unless ($env{'form.autoextract_camtasia'}) {
13051: $wantform = 1;
13052: }
1.1056 raeburn 13053: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 13054: my ($count,$datatable) = &get_extracted($docudom,$docuname,
13055: $currdir,\%is_dir,
13056: \%children,\%parent,
1.1056 raeburn 13057: \@contents,\%dirorder,
13058: \%titles,$wantform);
1.1055 raeburn 13059: if ($datatable ne '') {
13060: $output .= &archive_options_form('decompressed',$datatable,
13061: $count,$hiddenelem);
1.1065 raeburn 13062: my $startcount = 6;
1.1055 raeburn 13063: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 13064: \%titles,\%children);
1.1055 raeburn 13065: }
1.1067 raeburn 13066: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 13067: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13068: my %displayed;
13069: my $total = 1;
13070: $env{'form.archive_directory'} = [];
13071: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13072: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13073: $path =~ s{/$}{};
13074: my $item;
13075: if ($path ne '') {
13076: $item = "$path/$titles{$i}";
13077: } else {
13078: $item = $titles{$i};
13079: }
13080: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13081: if ($item eq $contents[0]) {
13082: push(@{$env{'form.archive_directory'}},$i);
13083: $env{'form.archive_'.$i} = 'display';
13084: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13085: $displayed{'folder'} = $i;
1.1164 raeburn 13086: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13087: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13088: $env{'form.archive_'.$i} = 'display';
13089: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13090: $displayed{'web'} = $i;
13091: } else {
1.1164 raeburn 13092: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13093: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13094: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13095: push(@{$env{'form.archive_directory'}},$i);
13096: }
13097: $env{'form.archive_'.$i} = 'dependency';
13098: }
13099: $total ++;
13100: }
13101: for (my $i=1; $i<$total; $i++) {
13102: next if ($i == $displayed{'web'});
13103: next if ($i == $displayed{'folder'});
13104: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13105: }
13106: $env{'form.phase'} = 'decompress_cleanup';
13107: $env{'form.archivedelete'} = 1;
13108: $env{'form.archive_count'} = $total-1;
13109: $output .=
13110: &process_extracted_files('coursedocs',$docudom,
13111: $docuname,$destination,
13112: $dir_root,$hiddenelem);
13113: }
1.1055 raeburn 13114: } else {
13115: $warning = &mt('No new items extracted from archive file.');
13116: }
13117: } else {
13118: $output = $display;
13119: $error = &mt('An error occurred during extraction from the archive file.');
13120: }
13121: }
13122: }
13123: }
13124: if ($error) {
13125: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13126: $error.'</p>'."\n";
13127: }
13128: if ($warning) {
13129: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13130: }
13131: return $output;
13132: }
13133:
13134: sub get_extracted {
1.1056 raeburn 13135: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13136: $titles,$wantform) = @_;
1.1055 raeburn 13137: my $count = 0;
13138: my $depth = 0;
13139: my $datatable;
1.1056 raeburn 13140: my @hierarchy;
1.1055 raeburn 13141: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13142: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13143: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13144: foreach my $item (@{$contents}) {
13145: $count ++;
1.1056 raeburn 13146: @{$dirorder->{$count}} = @hierarchy;
13147: $titles->{$count} = $item;
1.1055 raeburn 13148: &archive_hierarchy($depth,$count,$parent,$children);
13149: if ($wantform) {
13150: $datatable .= &archive_row($is_dir->{$item},$item,
13151: $currdir,$depth,$count);
13152: }
13153: if ($is_dir->{$item}) {
13154: $depth ++;
1.1056 raeburn 13155: push(@hierarchy,$count);
13156: $parent->{$depth} = $count;
1.1055 raeburn 13157: $datatable .=
13158: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13159: \$depth,\$count,\@hierarchy,$dirorder,
13160: $children,$parent,$titles,$wantform);
1.1055 raeburn 13161: $depth --;
1.1056 raeburn 13162: pop(@hierarchy);
1.1055 raeburn 13163: }
13164: }
13165: return ($count,$datatable);
13166: }
13167:
13168: sub recurse_extracted_archive {
1.1056 raeburn 13169: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13170: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13171: my $result='';
1.1056 raeburn 13172: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13173: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13174: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13175: return $result;
13176: }
13177: my $dirptr = 16384;
13178: my ($newdirlistref,$newlisterror) =
13179: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13180: if (ref($newdirlistref) eq 'ARRAY') {
13181: foreach my $dir_line (@{$newdirlistref}) {
13182: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13183: unless ($item =~ /^\.+$/) {
13184: $$count ++;
1.1056 raeburn 13185: @{$dirorder->{$$count}} = @{$hierarchy};
13186: $titles->{$$count} = $item;
1.1055 raeburn 13187: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13188:
1.1055 raeburn 13189: my $is_dir;
13190: if ($dirptr&$testdir) {
13191: $is_dir = 1;
13192: }
13193: if ($wantform) {
13194: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13195: }
13196: if ($is_dir) {
13197: $$depth ++;
1.1056 raeburn 13198: push(@{$hierarchy},$$count);
13199: $parent->{$$depth} = $$count;
1.1055 raeburn 13200: $result .=
13201: &recurse_extracted_archive("$currdir/$item",$docudom,
13202: $docuname,$depth,$count,
1.1056 raeburn 13203: $hierarchy,$dirorder,$children,
13204: $parent,$titles,$wantform);
1.1055 raeburn 13205: $$depth --;
1.1056 raeburn 13206: pop(@{$hierarchy});
1.1055 raeburn 13207: }
13208: }
13209: }
13210: }
13211: return $result;
13212: }
13213:
13214: sub archive_hierarchy {
13215: my ($depth,$count,$parent,$children) =@_;
13216: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13217: if (exists($parent->{$depth})) {
13218: $children->{$parent->{$depth}} .= $count.':';
13219: }
13220: }
13221: return;
13222: }
13223:
13224: sub archive_row {
13225: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13226: my ($name) = ($item =~ m{([^/]+)$});
13227: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13228: 'display' => 'Add as file',
1.1055 raeburn 13229: 'dependency' => 'Include as dependency',
13230: 'discard' => 'Discard',
13231: );
13232: if ($is_dir) {
1.1059 raeburn 13233: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13234: }
1.1056 raeburn 13235: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13236: my $offset = 0;
1.1055 raeburn 13237: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13238: $offset ++;
1.1065 raeburn 13239: if ($action ne 'display') {
13240: $offset ++;
13241: }
1.1055 raeburn 13242: $output .= '<td><span class="LC_nobreak">'.
13243: '<label><input type="radio" name="archive_'.$count.
13244: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13245: my $text = $choices{$action};
13246: if ($is_dir) {
13247: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13248: if ($action eq 'display') {
1.1059 raeburn 13249: $text = &mt('Add as folder');
1.1055 raeburn 13250: }
1.1056 raeburn 13251: } else {
13252: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13253:
13254: }
13255: $output .= ' /> '.$choices{$action}.'</label></span>';
13256: if ($action eq 'dependency') {
13257: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13258: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13259: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13260: '<option value=""></option>'."\n".
13261: '</select>'."\n".
13262: '</div>';
1.1059 raeburn 13263: } elsif ($action eq 'display') {
13264: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13265: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13266: '</div>';
1.1055 raeburn 13267: }
1.1056 raeburn 13268: $output .= '</td>';
1.1055 raeburn 13269: }
13270: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13271: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13272: for (my $i=0; $i<$depth; $i++) {
13273: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13274: }
13275: if ($is_dir) {
13276: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13277: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13278: } else {
13279: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13280: }
13281: $output .= ' '.$name.'</td>'."\n".
13282: &end_data_table_row();
13283: return $output;
13284: }
13285:
13286: sub archive_options_form {
1.1065 raeburn 13287: my ($form,$display,$count,$hiddenelem) = @_;
13288: my %lt = &Apache::lonlocal::texthash(
13289: perm => 'Permanently remove archive file?',
13290: hows => 'How should each extracted item be incorporated in the course?',
13291: cont => 'Content actions for all',
13292: addf => 'Add as folder/file',
13293: incd => 'Include as dependency for a displayed file',
13294: disc => 'Discard',
13295: no => 'No',
13296: yes => 'Yes',
13297: save => 'Save',
13298: );
13299: my $output = <<"END";
13300: <form name="$form" method="post" action="">
13301: <p><span class="LC_nobreak">$lt{'perm'}
13302: <label>
13303: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13304: </label>
13305:
13306: <label>
13307: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13308: </span>
13309: </p>
13310: <input type="hidden" name="phase" value="decompress_cleanup" />
13311: <br />$lt{'hows'}
13312: <div class="LC_columnSection">
13313: <fieldset>
13314: <legend>$lt{'cont'}</legend>
13315: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13316: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13317: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13318: </fieldset>
13319: </div>
13320: END
13321: return $output.
1.1055 raeburn 13322: &start_data_table()."\n".
1.1065 raeburn 13323: $display."\n".
1.1055 raeburn 13324: &end_data_table()."\n".
13325: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13326: $hiddenelem.
1.1065 raeburn 13327: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13328: '</form>';
13329: }
13330:
13331: sub archive_javascript {
1.1056 raeburn 13332: my ($startcount,$numitems,$titles,$children) = @_;
13333: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13334: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13335: my $scripttag = <<START;
13336: <script type="text/javascript">
13337: // <![CDATA[
13338:
13339: function checkAll(form,prefix) {
13340: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13341: for (var i=0; i < form.elements.length; i++) {
13342: var id = form.elements[i].id;
13343: if ((id != '') && (id != undefined)) {
13344: if (idstr.test(id)) {
13345: if (form.elements[i].type == 'radio') {
13346: form.elements[i].checked = true;
1.1056 raeburn 13347: var nostart = i-$startcount;
1.1059 raeburn 13348: var offset = nostart%7;
13349: var count = (nostart-offset)/7;
1.1056 raeburn 13350: dependencyCheck(form,count,offset);
1.1055 raeburn 13351: }
13352: }
13353: }
13354: }
13355: }
13356:
13357: function propagateCheck(form,count) {
13358: if (count > 0) {
1.1059 raeburn 13359: var startelement = $startcount + ((count-1) * 7);
13360: for (var j=1; j<6; j++) {
13361: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13362: var item = startelement + j;
13363: if (form.elements[item].type == 'radio') {
13364: if (form.elements[item].checked) {
13365: containerCheck(form,count,j);
13366: break;
13367: }
1.1055 raeburn 13368: }
13369: }
13370: }
13371: }
13372: }
13373:
13374: numitems = $numitems
1.1056 raeburn 13375: var titles = new Array(numitems);
13376: var parents = new Array(numitems);
1.1055 raeburn 13377: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13378: parents[i] = new Array;
1.1055 raeburn 13379: }
1.1059 raeburn 13380: var maintitle = '$maintitle';
1.1055 raeburn 13381:
13382: START
13383:
1.1056 raeburn 13384: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13385: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13386: for (my $i=0; $i<@contents; $i ++) {
13387: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13388: }
13389: }
13390:
1.1056 raeburn 13391: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13392: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13393: }
13394:
1.1055 raeburn 13395: $scripttag .= <<END;
13396:
13397: function containerCheck(form,count,offset) {
13398: if (count > 0) {
1.1056 raeburn 13399: dependencyCheck(form,count,offset);
1.1059 raeburn 13400: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13401: form.elements[item].checked = true;
13402: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13403: if (parents[count].length > 0) {
13404: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13405: containerCheck(form,parents[count][j],offset);
13406: }
13407: }
13408: }
13409: }
13410: }
13411:
13412: function dependencyCheck(form,count,offset) {
13413: if (count > 0) {
1.1059 raeburn 13414: var chosen = (offset+$startcount)+7*(count-1);
13415: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13416: var currtype = form.elements[depitem].type;
13417: if (form.elements[chosen].value == 'dependency') {
13418: document.getElementById('arc_depon_'+count).style.display='block';
13419: form.elements[depitem].options.length = 0;
13420: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13421: for (var i=1; i<=numitems; i++) {
13422: if (i == count) {
13423: continue;
13424: }
1.1059 raeburn 13425: var startelement = $startcount + (i-1) * 7;
13426: for (var j=1; j<6; j++) {
13427: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13428: var item = startelement + j;
13429: if (form.elements[item].type == 'radio') {
13430: if (form.elements[item].checked) {
13431: if (form.elements[item].value == 'display') {
13432: var n = form.elements[depitem].options.length;
13433: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13434: }
13435: }
13436: }
13437: }
13438: }
13439: }
13440: } else {
13441: document.getElementById('arc_depon_'+count).style.display='none';
13442: form.elements[depitem].options.length = 0;
13443: form.elements[depitem].options[0] = new Option('Select','',true,true);
13444: }
1.1059 raeburn 13445: titleCheck(form,count,offset);
1.1056 raeburn 13446: }
13447: }
13448:
13449: function propagateSelect(form,count,offset) {
13450: if (count > 0) {
1.1065 raeburn 13451: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13452: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13453: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13454: if (parents[count].length > 0) {
13455: for (var j=0; j<parents[count].length; j++) {
13456: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13457: }
13458: }
13459: }
13460: }
13461: }
1.1056 raeburn 13462:
13463: function containerSelect(form,count,offset,picked) {
13464: if (count > 0) {
1.1065 raeburn 13465: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13466: if (form.elements[item].type == 'radio') {
13467: if (form.elements[item].value == 'dependency') {
13468: if (form.elements[item+1].type == 'select-one') {
13469: for (var i=0; i<form.elements[item+1].options.length; i++) {
13470: if (form.elements[item+1].options[i].value == picked) {
13471: form.elements[item+1].selectedIndex = i;
13472: break;
13473: }
13474: }
13475: }
13476: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13477: if (parents[count].length > 0) {
13478: for (var j=0; j<parents[count].length; j++) {
13479: containerSelect(form,parents[count][j],offset,picked);
13480: }
13481: }
13482: }
13483: }
13484: }
13485: }
13486: }
13487:
1.1059 raeburn 13488: function titleCheck(form,count,offset) {
13489: if (count > 0) {
13490: var chosen = (offset+$startcount)+7*(count-1);
13491: var depitem = $startcount + ((count-1) * 7) + 2;
13492: var currtype = form.elements[depitem].type;
13493: if (form.elements[chosen].value == 'display') {
13494: document.getElementById('arc_title_'+count).style.display='block';
13495: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13496: document.getElementById('archive_title_'+count).value=maintitle;
13497: }
13498: } else {
13499: document.getElementById('arc_title_'+count).style.display='none';
13500: if (currtype == 'text') {
13501: document.getElementById('archive_title_'+count).value='';
13502: }
13503: }
13504: }
13505: return;
13506: }
13507:
1.1055 raeburn 13508: // ]]>
13509: </script>
13510: END
13511: return $scripttag;
13512: }
13513:
13514: sub process_extracted_files {
1.1067 raeburn 13515: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13516: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 13517: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 13518: my @ids=&Apache::lonnet::current_machine_ids();
13519: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13520: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13521: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13522: if (grep(/^\Q$docuhome\E$/,@ids)) {
13523: $prefix = &LONCAPA::propath($docudom,$docuname);
13524: $pathtocheck = "$dir_root/$destination";
13525: $dir = $dir_root;
13526: $ishome = 1;
13527: } else {
13528: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13529: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 13530: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 13531: }
13532: my $currdir = "$dir_root/$destination";
13533: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13534: if ($env{'form.folderpath'}) {
13535: my @items = split('&',$env{'form.folderpath'});
13536: $folders{'0'} = $items[-2];
1.1099 raeburn 13537: if ($env{'form.folderpath'} =~ /\:1$/) {
13538: $containers{'0'}='page';
13539: } else {
13540: $containers{'0'}='sequence';
13541: }
1.1055 raeburn 13542: }
13543: my @archdirs = &get_env_multiple('form.archive_directory');
13544: if ($numitems) {
13545: for (my $i=1; $i<=$numitems; $i++) {
13546: my $path = $env{'form.archive_content_'.$i};
13547: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13548: my $item = $1;
13549: $toplevelitems{$item} = $i;
13550: if (grep(/^\Q$i\E$/,@archdirs)) {
13551: $is_dir{$item} = 1;
13552: }
13553: }
13554: }
13555: }
1.1067 raeburn 13556: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13557: if (keys(%toplevelitems) > 0) {
13558: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13559: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13560: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13561: }
1.1066 raeburn 13562: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13563: if ($numitems) {
13564: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 13565: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13566: my $path = $env{'form.archive_content_'.$i};
13567: if ($path =~ /^\Q$pathtocheck\E/) {
13568: if ($env{'form.archive_'.$i} eq 'discard') {
13569: if ($prefix ne '' && $path ne '') {
13570: if (-e $prefix.$path) {
1.1066 raeburn 13571: if ((@archdirs > 0) &&
13572: (grep(/^\Q$i\E$/,@archdirs))) {
13573: $todeletedir{$prefix.$path} = 1;
13574: } else {
13575: $todelete{$prefix.$path} = 1;
13576: }
1.1055 raeburn 13577: }
13578: }
13579: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13580: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13581: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13582: $docstitle = $env{'form.archive_title_'.$i};
13583: if ($docstitle eq '') {
13584: $docstitle = $title;
13585: }
1.1055 raeburn 13586: $outer = 0;
1.1056 raeburn 13587: if (ref($dirorder{$i}) eq 'ARRAY') {
13588: if (@{$dirorder{$i}} > 0) {
13589: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13590: if ($env{'form.archive_'.$item} eq 'display') {
13591: $outer = $item;
13592: last;
13593: }
13594: }
13595: }
13596: }
13597: my ($errtext,$fatal) =
13598: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13599: '/'.$folders{$outer}.'.'.
13600: $containers{$outer});
13601: next if ($fatal);
13602: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13603: if ($context eq 'coursedocs') {
1.1056 raeburn 13604: $mapinner{$i} = time;
1.1055 raeburn 13605: $folders{$i} = 'default_'.$mapinner{$i};
13606: $containers{$i} = 'sequence';
13607: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13608: $folders{$i}.'.'.$containers{$i};
13609: my $newidx = &LONCAPA::map::getresidx();
13610: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13611: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13612: push(@LONCAPA::map::order,$newidx);
13613: my ($outtext,$errtext) =
13614: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13615: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 13616: '.'.$containers{$outer},1,1);
1.1056 raeburn 13617: $newseqid{$i} = $newidx;
1.1067 raeburn 13618: unless ($errtext) {
1.1294 raeburn 13619: $result .= '<li>'.&mt('Folder: [_1] added to course',
13620: &HTML::Entities::encode($docstitle,'<>&"')).
13621: '</li>'."\n";
1.1067 raeburn 13622: }
1.1055 raeburn 13623: }
13624: } else {
13625: if ($context eq 'coursedocs') {
13626: my $newidx=&LONCAPA::map::getresidx();
13627: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13628: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13629: $title;
1.1294 raeburn 13630: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
13631: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13632: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
13633: }
13634: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13635: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13636: }
13637: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13638: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
13639: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
13640: unless ($ishome) {
13641: my $fetch = "$newdest{$i}/$title";
13642: $fetch =~ s/^\Q$prefix$dir\E//;
13643: $prompttofetch{$fetch} = 1;
13644: }
1.1292 raeburn 13645: }
1.1067 raeburn 13646: }
1.1294 raeburn 13647: $LONCAPA::map::resources[$newidx]=
13648: $docstitle.':'.$url.':false:normal:res';
13649: push(@LONCAPA::map::order, $newidx);
13650: my ($outtext,$errtext)=
13651: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13652: $docuname.'/'.$folders{$outer}.
13653: '.'.$containers{$outer},1,1);
13654: unless ($errtext) {
13655: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13656: $result .= '<li>'.&mt('File: [_1] added to course',
13657: &HTML::Entities::encode($docstitle,'<>&"')).
13658: '</li>'."\n";
13659: }
1.1067 raeburn 13660: }
1.1294 raeburn 13661: } else {
13662: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13663: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 13664: }
1.1055 raeburn 13665: }
13666: }
1.1086 raeburn 13667: }
13668: } else {
1.1294 raeburn 13669: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13670: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 13671: }
13672: }
13673: for (my $i=1; $i<=$numitems; $i++) {
13674: next unless ($env{'form.archive_'.$i} eq 'dependency');
13675: my $path = $env{'form.archive_content_'.$i};
13676: if ($path =~ /^\Q$pathtocheck\E/) {
13677: my ($title) = ($path =~ m{/([^/]+)$});
13678: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13679: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13680: if (ref($dirorder{$i}) eq 'ARRAY') {
13681: my ($itemidx,$fullpath,$relpath);
13682: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13683: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13684: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 13685: if ($dirorder{$i}->[$j] eq $container) {
13686: $itemidx = $j;
1.1056 raeburn 13687: }
13688: }
1.1086 raeburn 13689: }
13690: if ($itemidx eq '') {
13691: $itemidx = 0;
13692: }
13693: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13694: if ($mapinner{$referrer{$i}}) {
13695: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13696: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13697: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13698: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13699: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13700: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13701: if (!-e $fullpath) {
13702: mkdir($fullpath,0755);
1.1056 raeburn 13703: }
13704: }
1.1086 raeburn 13705: } else {
13706: last;
1.1056 raeburn 13707: }
1.1086 raeburn 13708: }
13709: }
13710: } elsif ($newdest{$referrer{$i}}) {
13711: $fullpath = $newdest{$referrer{$i}};
13712: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13713: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13714: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13715: last;
13716: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13717: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13718: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13719: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13720: if (!-e $fullpath) {
13721: mkdir($fullpath,0755);
1.1056 raeburn 13722: }
13723: }
1.1086 raeburn 13724: } else {
13725: last;
1.1056 raeburn 13726: }
1.1055 raeburn 13727: }
13728: }
1.1086 raeburn 13729: if ($fullpath ne '') {
13730: if (-e "$prefix$path") {
1.1292 raeburn 13731: unless (rename("$prefix$path","$fullpath/$title")) {
13732: $warning .= &mt('Failed to rename dependency').'<br />';
13733: }
1.1086 raeburn 13734: }
13735: if (-e "$fullpath/$title") {
13736: my $showpath;
13737: if ($relpath ne '') {
13738: $showpath = "$relpath/$title";
13739: } else {
13740: $showpath = "/$title";
13741: }
1.1294 raeburn 13742: $result .= '<li>'.&mt('[_1] included as a dependency',
13743: &HTML::Entities::encode($showpath,'<>&"')).
13744: '</li>'."\n";
1.1292 raeburn 13745: unless ($ishome) {
13746: my $fetch = "$fullpath/$title";
13747: $fetch =~ s/^\Q$prefix$dir\E//;
13748: $prompttofetch{$fetch} = 1;
13749: }
1.1086 raeburn 13750: }
13751: }
1.1055 raeburn 13752: }
1.1086 raeburn 13753: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13754: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 13755: &HTML::Entities::encode($path,'<>&"'),
13756: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13757: '<br />';
1.1055 raeburn 13758: }
13759: } else {
1.1294 raeburn 13760: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 13761: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13762: }
13763: }
13764: if (keys(%todelete)) {
13765: foreach my $key (keys(%todelete)) {
13766: unlink($key);
1.1066 raeburn 13767: }
13768: }
13769: if (keys(%todeletedir)) {
13770: foreach my $key (keys(%todeletedir)) {
13771: rmdir($key);
13772: }
13773: }
13774: foreach my $dir (sort(keys(%is_dir))) {
13775: if (($pathtocheck ne '') && ($dir ne '')) {
13776: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13777: }
13778: }
1.1067 raeburn 13779: if ($result ne '') {
13780: $output .= '<ul>'."\n".
13781: $result."\n".
13782: '</ul>';
13783: }
13784: unless ($ishome) {
13785: my $replicationfail;
13786: foreach my $item (keys(%prompttofetch)) {
13787: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13788: unless ($fetchresult eq 'ok') {
13789: $replicationfail .= '<li>'.$item.'</li>'."\n";
13790: }
13791: }
13792: if ($replicationfail) {
13793: $output .= '<p class="LC_error">'.
13794: &mt('Course home server failed to retrieve:').'<ul>'.
13795: $replicationfail.
13796: '</ul></p>';
13797: }
13798: }
1.1055 raeburn 13799: } else {
13800: $warning = &mt('No items found in archive.');
13801: }
13802: if ($error) {
13803: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13804: $error.'</p>'."\n";
13805: }
13806: if ($warning) {
13807: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13808: }
13809: return $output;
13810: }
13811:
1.1066 raeburn 13812: sub cleanup_empty_dirs {
13813: my ($path) = @_;
13814: if (($path ne '') && (-d $path)) {
13815: if (opendir(my $dirh,$path)) {
13816: my @dircontents = grep(!/^\./,readdir($dirh));
13817: my $numitems = 0;
13818: foreach my $item (@dircontents) {
13819: if (-d "$path/$item") {
1.1111 raeburn 13820: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13821: if (-e "$path/$item") {
13822: $numitems ++;
13823: }
13824: } else {
13825: $numitems ++;
13826: }
13827: }
13828: if ($numitems == 0) {
13829: rmdir($path);
13830: }
13831: closedir($dirh);
13832: }
13833: }
13834: return;
13835: }
13836:
1.41 ng 13837: =pod
1.45 matthew 13838:
1.1162 raeburn 13839: =item * &get_folder_hierarchy()
1.1068 raeburn 13840:
13841: Provides hierarchy of names of folders/sub-folders containing the current
13842: item,
13843:
13844: Inputs: 3
13845: - $navmap - navmaps object
13846:
13847: - $map - url for map (either the trigger itself, or map containing
13848: the resource, which is the trigger).
13849:
13850: - $showitem - 1 => show title for map itself; 0 => do not show.
13851:
13852: Outputs: 1 @pathitems - array of folder/subfolder names.
13853:
13854: =cut
13855:
13856: sub get_folder_hierarchy {
13857: my ($navmap,$map,$showitem) = @_;
13858: my @pathitems;
13859: if (ref($navmap)) {
13860: my $mapres = $navmap->getResourceByUrl($map);
13861: if (ref($mapres)) {
13862: my $pcslist = $mapres->map_hierarchy();
13863: if ($pcslist ne '') {
13864: my @pcs = split(/,/,$pcslist);
13865: foreach my $pc (@pcs) {
13866: if ($pc == 1) {
1.1129 raeburn 13867: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13868: } else {
13869: my $res = $navmap->getByMapPc($pc);
13870: if (ref($res)) {
13871: my $title = $res->compTitle();
13872: $title =~ s/\W+/_/g;
13873: if ($title ne '') {
13874: push(@pathitems,$title);
13875: }
13876: }
13877: }
13878: }
13879: }
1.1071 raeburn 13880: if ($showitem) {
13881: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 13882: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13883: } else {
13884: my $maptitle = $mapres->compTitle();
13885: $maptitle =~ s/\W+/_/g;
13886: if ($maptitle ne '') {
13887: push(@pathitems,$maptitle);
13888: }
1.1068 raeburn 13889: }
13890: }
13891: }
13892: }
13893: return @pathitems;
13894: }
13895:
13896: =pod
13897:
1.1015 raeburn 13898: =item * &get_turnedin_filepath()
13899:
13900: Determines path in a user's portfolio file for storage of files uploaded
13901: to a specific essayresponse or dropbox item.
13902:
13903: Inputs: 3 required + 1 optional.
13904: $symb is symb for resource, $uname and $udom are for current user (required).
13905: $caller is optional (can be "submission", if routine is called when storing
13906: an upoaded file when "Submit Answer" button was pressed).
13907:
13908: Returns array containing $path and $multiresp.
13909: $path is path in portfolio. $multiresp is 1 if this resource contains more
13910: than one file upload item. Callers of routine should append partid as a
13911: subdirectory to $path in cases where $multiresp is 1.
13912:
13913: Called by: homework/essayresponse.pm and homework/structuretags.pm
13914:
13915: =cut
13916:
13917: sub get_turnedin_filepath {
13918: my ($symb,$uname,$udom,$caller) = @_;
13919: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13920: my $turnindir;
13921: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13922: $turnindir = $userhash{'turnindir'};
13923: my ($path,$multiresp);
13924: if ($turnindir eq '') {
13925: if ($caller eq 'submission') {
13926: $turnindir = &mt('turned in');
13927: $turnindir =~ s/\W+/_/g;
13928: my %newhash = (
13929: 'turnindir' => $turnindir,
13930: );
13931: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13932: }
13933: }
13934: if ($turnindir ne '') {
13935: $path = '/'.$turnindir.'/';
13936: my ($multipart,$turnin,@pathitems);
13937: my $navmap = Apache::lonnavmaps::navmap->new();
13938: if (defined($navmap)) {
13939: my $mapres = $navmap->getResourceByUrl($map);
13940: if (ref($mapres)) {
13941: my $pcslist = $mapres->map_hierarchy();
13942: if ($pcslist ne '') {
13943: foreach my $pc (split(/,/,$pcslist)) {
13944: my $res = $navmap->getByMapPc($pc);
13945: if (ref($res)) {
13946: my $title = $res->compTitle();
13947: $title =~ s/\W+/_/g;
13948: if ($title ne '') {
1.1149 raeburn 13949: if (($pc > 1) && (length($title) > 12)) {
13950: $title = substr($title,0,12);
13951: }
1.1015 raeburn 13952: push(@pathitems,$title);
13953: }
13954: }
13955: }
13956: }
13957: my $maptitle = $mapres->compTitle();
13958: $maptitle =~ s/\W+/_/g;
13959: if ($maptitle ne '') {
1.1149 raeburn 13960: if (length($maptitle) > 12) {
13961: $maptitle = substr($maptitle,0,12);
13962: }
1.1015 raeburn 13963: push(@pathitems,$maptitle);
13964: }
13965: unless ($env{'request.state'} eq 'construct') {
13966: my $res = $navmap->getBySymb($symb);
13967: if (ref($res)) {
13968: my $partlist = $res->parts();
13969: my $totaluploads = 0;
13970: if (ref($partlist) eq 'ARRAY') {
13971: foreach my $part (@{$partlist}) {
13972: my @types = $res->responseType($part);
13973: my @ids = $res->responseIds($part);
13974: for (my $i=0; $i < scalar(@ids); $i++) {
13975: if ($types[$i] eq 'essay') {
13976: my $partid = $part.'_'.$ids[$i];
13977: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13978: $totaluploads ++;
13979: }
13980: }
13981: }
13982: }
13983: if ($totaluploads > 1) {
13984: $multiresp = 1;
13985: }
13986: }
13987: }
13988: }
13989: } else {
13990: return;
13991: }
13992: } else {
13993: return;
13994: }
13995: my $restitle=&Apache::lonnet::gettitle($symb);
13996: $restitle =~ s/\W+/_/g;
13997: if ($restitle eq '') {
13998: $restitle = ($resurl =~ m{/[^/]+$});
13999: if ($restitle eq '') {
14000: $restitle = time;
14001: }
14002: }
1.1149 raeburn 14003: if (length($restitle) > 12) {
14004: $restitle = substr($restitle,0,12);
14005: }
1.1015 raeburn 14006: push(@pathitems,$restitle);
14007: $path .= join('/',@pathitems);
14008: }
14009: return ($path,$multiresp);
14010: }
14011:
14012: =pod
14013:
1.464 albertel 14014: =back
1.41 ng 14015:
1.112 bowersj2 14016: =head1 CSV Upload/Handling functions
1.38 albertel 14017:
1.41 ng 14018: =over 4
14019:
1.648 raeburn 14020: =item * &upfile_store($r)
1.41 ng 14021:
14022: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14023: needs $env{'form.upfile'}
1.41 ng 14024: returns $datatoken to be put into hidden field
14025:
14026: =cut
1.31 albertel 14027:
14028: sub upfile_store {
14029: my $r=shift;
1.258 albertel 14030: $env{'form.upfile'}=~s/\r/\n/gs;
14031: $env{'form.upfile'}=~s/\f/\n/gs;
14032: $env{'form.upfile'}=~s/\n+/\n/gs;
14033: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 14034:
1.1299 raeburn 14035: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
14036: '_enroll_'.$env{'request.course.id'}.'_'.
14037: time.'_'.$$);
14038: return if ($datatoken eq '');
14039:
1.31 albertel 14040: {
1.158 raeburn 14041: my $datafile = $r->dir_config('lonDaemons').
14042: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14043: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 14044: print $fh $env{'form.upfile'};
1.158 raeburn 14045: close($fh);
14046: }
1.31 albertel 14047: }
14048: return $datatoken;
14049: }
14050:
1.56 matthew 14051: =pod
14052:
1.1290 raeburn 14053: =item * &load_tmp_file($r,$datatoken)
1.41 ng 14054:
14055: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 14056: $datatoken is the name to assign to the temporary file.
1.258 albertel 14057: sets $env{'form.upfile'} to the contents of the file
1.41 ng 14058:
14059: =cut
1.31 albertel 14060:
14061: sub load_tmp_file {
1.1290 raeburn 14062: my ($r,$datatoken) = @_;
14063: return if ($datatoken eq '');
1.31 albertel 14064: my @studentdata=();
14065: {
1.158 raeburn 14066: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 14067: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14068: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14069: @studentdata=<$fh>;
14070: close($fh);
14071: }
1.31 albertel 14072: }
1.258 albertel 14073: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14074: }
14075:
1.1290 raeburn 14076: sub valid_datatoken {
14077: my ($datatoken) = @_;
1.1325 raeburn 14078: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 14079: return $datatoken;
14080: }
14081: return;
14082: }
14083:
1.56 matthew 14084: =pod
14085:
1.648 raeburn 14086: =item * &upfile_record_sep()
1.41 ng 14087:
14088: Separate uploaded file into records
14089: returns array of records,
1.258 albertel 14090: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14091:
14092: =cut
1.31 albertel 14093:
14094: sub upfile_record_sep {
1.258 albertel 14095: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14096: } else {
1.248 albertel 14097: my @records;
1.258 albertel 14098: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14099: if ($line=~/^\s*$/) { next; }
14100: push(@records,$line);
14101: }
14102: return @records;
1.31 albertel 14103: }
14104: }
14105:
1.56 matthew 14106: =pod
14107:
1.648 raeburn 14108: =item * &record_sep($record)
1.41 ng 14109:
1.258 albertel 14110: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14111:
14112: =cut
14113:
1.263 www 14114: sub takeleft {
14115: my $index=shift;
14116: return substr('0000'.$index,-4,4);
14117: }
14118:
1.31 albertel 14119: sub record_sep {
14120: my $record=shift;
14121: my %components=();
1.258 albertel 14122: if ($env{'form.upfiletype'} eq 'xml') {
14123: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14124: my $i=0;
1.356 albertel 14125: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14126: $field=~s/^(\"|\')//;
14127: $field=~s/(\"|\')$//;
1.263 www 14128: $components{&takeleft($i)}=$field;
1.31 albertel 14129: $i++;
14130: }
1.258 albertel 14131: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14132: my $i=0;
1.356 albertel 14133: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14134: $field=~s/^(\"|\')//;
14135: $field=~s/(\"|\')$//;
1.263 www 14136: $components{&takeleft($i)}=$field;
1.31 albertel 14137: $i++;
14138: }
14139: } else {
1.561 www 14140: my $separator=',';
1.480 banghart 14141: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14142: $separator=';';
1.480 banghart 14143: }
1.31 albertel 14144: my $i=0;
1.561 www 14145: # the character we are looking for to indicate the end of a quote or a record
14146: my $looking_for=$separator;
14147: # do not add the characters to the fields
14148: my $ignore=0;
14149: # we just encountered a separator (or the beginning of the record)
14150: my $just_found_separator=1;
14151: # store the field we are working on here
14152: my $field='';
14153: # work our way through all characters in record
14154: foreach my $character ($record=~/(.)/g) {
14155: if ($character eq $looking_for) {
14156: if ($character ne $separator) {
14157: # Found the end of a quote, again looking for separator
14158: $looking_for=$separator;
14159: $ignore=1;
14160: } else {
14161: # Found a separator, store away what we got
14162: $components{&takeleft($i)}=$field;
14163: $i++;
14164: $just_found_separator=1;
14165: $ignore=0;
14166: $field='';
14167: }
14168: next;
14169: }
14170: # single or double quotation marks after a separator indicate beginning of a quote
14171: # we are now looking for the end of the quote and need to ignore separators
14172: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14173: $looking_for=$character;
14174: next;
14175: }
14176: # ignore would be true after we reached the end of a quote
14177: if ($ignore) { next; }
14178: if (($just_found_separator) && ($character=~/\s/)) { next; }
14179: $field.=$character;
14180: $just_found_separator=0;
1.31 albertel 14181: }
1.561 www 14182: # catch the very last entry, since we never encountered the separator
14183: $components{&takeleft($i)}=$field;
1.31 albertel 14184: }
14185: return %components;
14186: }
14187:
1.144 matthew 14188: ######################################################
14189: ######################################################
14190:
1.56 matthew 14191: =pod
14192:
1.648 raeburn 14193: =item * &upfile_select_html()
1.41 ng 14194:
1.144 matthew 14195: Return HTML code to select a file from the users machine and specify
14196: the file type.
1.41 ng 14197:
14198: =cut
14199:
1.144 matthew 14200: ######################################################
14201: ######################################################
1.31 albertel 14202: sub upfile_select_html {
1.144 matthew 14203: my %Types = (
14204: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14205: semisv => &mt('Semicolon separated values'),
1.144 matthew 14206: space => &mt('Space separated'),
14207: tab => &mt('Tabulator separated'),
14208: # xml => &mt('HTML/XML'),
14209: );
14210: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14211: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14212: foreach my $type (sort(keys(%Types))) {
14213: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14214: }
14215: $Str .= "</select>\n";
14216: return $Str;
1.31 albertel 14217: }
14218:
1.301 albertel 14219: sub get_samples {
14220: my ($records,$toget) = @_;
14221: my @samples=({});
14222: my $got=0;
14223: foreach my $rec (@$records) {
14224: my %temp = &record_sep($rec);
14225: if (! grep(/\S/, values(%temp))) { next; }
14226: if (%temp) {
14227: $samples[$got]=\%temp;
14228: $got++;
14229: if ($got == $toget) { last; }
14230: }
14231: }
14232: return \@samples;
14233: }
14234:
1.144 matthew 14235: ######################################################
14236: ######################################################
14237:
1.56 matthew 14238: =pod
14239:
1.648 raeburn 14240: =item * &csv_print_samples($r,$records)
1.41 ng 14241:
14242: Prints a table of sample values from each column uploaded $r is an
14243: Apache Request ref, $records is an arrayref from
14244: &Apache::loncommon::upfile_record_sep
14245:
14246: =cut
14247:
1.144 matthew 14248: ######################################################
14249: ######################################################
1.31 albertel 14250: sub csv_print_samples {
14251: my ($r,$records) = @_;
1.662 bisitz 14252: my $samples = &get_samples($records,5);
1.301 albertel 14253:
1.594 raeburn 14254: $r->print(&mt('Samples').'<br />'.&start_data_table().
14255: &start_data_table_header_row());
1.356 albertel 14256: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14257: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14258: $r->print(&end_data_table_header_row());
1.301 albertel 14259: foreach my $hash (@$samples) {
1.594 raeburn 14260: $r->print(&start_data_table_row());
1.356 albertel 14261: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14262: $r->print('<td>');
1.356 albertel 14263: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14264: $r->print('</td>');
14265: }
1.594 raeburn 14266: $r->print(&end_data_table_row());
1.31 albertel 14267: }
1.594 raeburn 14268: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14269: }
14270:
1.144 matthew 14271: ######################################################
14272: ######################################################
14273:
1.56 matthew 14274: =pod
14275:
1.648 raeburn 14276: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14277:
14278: Prints a table to create associations between values and table columns.
1.144 matthew 14279:
1.41 ng 14280: $r is an Apache Request ref,
14281: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14282: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14283:
14284: =cut
14285:
1.144 matthew 14286: ######################################################
14287: ######################################################
1.31 albertel 14288: sub csv_print_select_table {
14289: my ($r,$records,$d) = @_;
1.301 albertel 14290: my $i=0;
14291: my $samples = &get_samples($records,1);
1.144 matthew 14292: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14293: &start_data_table().&start_data_table_header_row().
1.144 matthew 14294: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14295: '<th>'.&mt('Column').'</th>'.
14296: &end_data_table_header_row()."\n");
1.356 albertel 14297: foreach my $array_ref (@$d) {
14298: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14299: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14300:
1.875 bisitz 14301: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14302: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14303: $r->print('<option value="none"></option>');
1.356 albertel 14304: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14305: $r->print('<option value="'.$sample.'"'.
14306: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14307: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14308: }
1.594 raeburn 14309: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14310: $i++;
14311: }
1.594 raeburn 14312: $r->print(&end_data_table());
1.31 albertel 14313: $i--;
14314: return $i;
14315: }
1.56 matthew 14316:
1.144 matthew 14317: ######################################################
14318: ######################################################
14319:
1.56 matthew 14320: =pod
1.31 albertel 14321:
1.648 raeburn 14322: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14323:
14324: Prints a table of sample values from the upload and can make associate samples to internal names.
14325:
14326: $r is an Apache Request ref,
14327: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14328: $d is an array of 2 element arrays (internal name, displayed name)
14329:
14330: =cut
14331:
1.144 matthew 14332: ######################################################
14333: ######################################################
1.31 albertel 14334: sub csv_samples_select_table {
14335: my ($r,$records,$d) = @_;
14336: my $i=0;
1.144 matthew 14337: #
1.662 bisitz 14338: my $max_samples = 5;
14339: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14340: $r->print(&start_data_table().
14341: &start_data_table_header_row().'<th>'.
14342: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14343: &end_data_table_header_row());
1.301 albertel 14344:
14345: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14346: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14347: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14348: foreach my $option (@$d) {
14349: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14350: $r->print('<option value="'.$value.'"'.
1.253 albertel 14351: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14352: $display.'</option>');
1.31 albertel 14353: }
14354: $r->print('</select></td><td>');
1.662 bisitz 14355: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14356: if (defined($samples->[$line]{$key})) {
14357: $r->print($samples->[$line]{$key}."<br />\n");
14358: }
14359: }
1.594 raeburn 14360: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14361: $i++;
14362: }
1.594 raeburn 14363: $r->print(&end_data_table());
1.31 albertel 14364: $i--;
14365: return($i);
1.115 matthew 14366: }
14367:
1.144 matthew 14368: ######################################################
14369: ######################################################
14370:
1.115 matthew 14371: =pod
14372:
1.648 raeburn 14373: =item * &clean_excel_name($name)
1.115 matthew 14374:
14375: Returns a replacement for $name which does not contain any illegal characters.
14376:
14377: =cut
14378:
1.144 matthew 14379: ######################################################
14380: ######################################################
1.115 matthew 14381: sub clean_excel_name {
14382: my ($name) = @_;
14383: $name =~ s/[:\*\?\/\\]//g;
14384: if (length($name) > 31) {
14385: $name = substr($name,0,31);
14386: }
14387: return $name;
1.25 albertel 14388: }
1.84 albertel 14389:
1.85 albertel 14390: =pod
14391:
1.648 raeburn 14392: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14393:
14394: Returns either 1 or undef
14395:
14396: 1 if the part is to be hidden, undef if it is to be shown
14397:
14398: Arguments are:
14399:
14400: $id the id of the part to be checked
14401: $symb, optional the symb of the resource to check
14402: $udom, optional the domain of the user to check for
14403: $uname, optional the username of the user to check for
14404:
14405: =cut
1.84 albertel 14406:
14407: sub check_if_partid_hidden {
14408: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14409: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14410: $symb,$udom,$uname);
1.141 albertel 14411: my $truth=1;
14412: #if the string starts with !, then the list is the list to show not hide
14413: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14414: my @hiddenlist=split(/,/,$hiddenparts);
14415: foreach my $checkid (@hiddenlist) {
1.141 albertel 14416: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14417: }
1.141 albertel 14418: return !$truth;
1.84 albertel 14419: }
1.127 matthew 14420:
1.138 matthew 14421:
14422: ############################################################
14423: ############################################################
14424:
14425: =pod
14426:
1.157 matthew 14427: =back
14428:
1.138 matthew 14429: =head1 cgi-bin script and graphing routines
14430:
1.157 matthew 14431: =over 4
14432:
1.648 raeburn 14433: =item * &get_cgi_id()
1.138 matthew 14434:
14435: Inputs: none
14436:
14437: Returns an id which can be used to pass environment variables
14438: to various cgi-bin scripts. These environment variables will
14439: be removed from the users environment after a given time by
14440: the routine &Apache::lonnet::transfer_profile_to_env.
14441:
14442: =cut
14443:
14444: ############################################################
14445: ############################################################
1.152 albertel 14446: my $uniq=0;
1.136 matthew 14447: sub get_cgi_id {
1.154 albertel 14448: $uniq=($uniq+1)%100000;
1.280 albertel 14449: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14450: }
14451:
1.127 matthew 14452: ############################################################
14453: ############################################################
14454:
14455: =pod
14456:
1.648 raeburn 14457: =item * &DrawBarGraph()
1.127 matthew 14458:
1.138 matthew 14459: Facilitates the plotting of data in a (stacked) bar graph.
14460: Puts plot definition data into the users environment in order for
14461: graph.png to plot it. Returns an <img> tag for the plot.
14462: The bars on the plot are labeled '1','2',...,'n'.
14463:
14464: Inputs:
14465:
14466: =over 4
14467:
14468: =item $Title: string, the title of the plot
14469:
14470: =item $xlabel: string, text describing the X-axis of the plot
14471:
14472: =item $ylabel: string, text describing the Y-axis of the plot
14473:
14474: =item $Max: scalar, the maximum Y value to use in the plot
14475: If $Max is < any data point, the graph will not be rendered.
14476:
1.140 matthew 14477: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14478: they are plotted. If undefined, default values will be used.
14479:
1.178 matthew 14480: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14481:
1.138 matthew 14482: =item @Values: An array of array references. Each array reference holds data
14483: to be plotted in a stacked bar chart.
14484:
1.239 matthew 14485: =item If the final element of @Values is a hash reference the key/value
14486: pairs will be added to the graph definition.
14487:
1.138 matthew 14488: =back
14489:
14490: Returns:
14491:
14492: An <img> tag which references graph.png and the appropriate identifying
14493: information for the plot.
14494:
1.127 matthew 14495: =cut
14496:
14497: ############################################################
14498: ############################################################
1.134 matthew 14499: sub DrawBarGraph {
1.178 matthew 14500: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14501: #
14502: if (! defined($colors)) {
14503: $colors = ['#33ff00',
14504: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14505: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14506: ];
14507: }
1.228 matthew 14508: my $extra_settings = {};
14509: if (ref($Values[-1]) eq 'HASH') {
14510: $extra_settings = pop(@Values);
14511: }
1.127 matthew 14512: #
1.136 matthew 14513: my $identifier = &get_cgi_id();
14514: my $id = 'cgi.'.$identifier;
1.129 matthew 14515: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14516: return '';
14517: }
1.225 matthew 14518: #
14519: my @Labels;
14520: if (defined($labels)) {
14521: @Labels = @$labels;
14522: } else {
14523: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 14524: push(@Labels,$i+1);
1.225 matthew 14525: }
14526: }
14527: #
1.129 matthew 14528: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14529: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14530: my %ValuesHash;
14531: my $NumSets=1;
14532: foreach my $array (@Values) {
14533: next if (! ref($array));
1.136 matthew 14534: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14535: join(',',@$array);
1.129 matthew 14536: }
1.127 matthew 14537: #
1.136 matthew 14538: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14539: if ($NumBars < 3) {
14540: $width = 120+$NumBars*32;
1.220 matthew 14541: $xskip = 1;
1.225 matthew 14542: $bar_width = 30;
14543: } elsif ($NumBars < 5) {
14544: $width = 120+$NumBars*20;
14545: $xskip = 1;
14546: $bar_width = 20;
1.220 matthew 14547: } elsif ($NumBars < 10) {
1.136 matthew 14548: $width = 120+$NumBars*15;
14549: $xskip = 1;
14550: $bar_width = 15;
14551: } elsif ($NumBars <= 25) {
14552: $width = 120+$NumBars*11;
14553: $xskip = 5;
14554: $bar_width = 8;
14555: } elsif ($NumBars <= 50) {
14556: $width = 120+$NumBars*8;
14557: $xskip = 5;
14558: $bar_width = 4;
14559: } else {
14560: $width = 120+$NumBars*8;
14561: $xskip = 5;
14562: $bar_width = 4;
14563: }
14564: #
1.137 matthew 14565: $Max = 1 if ($Max < 1);
14566: if ( int($Max) < $Max ) {
14567: $Max++;
14568: $Max = int($Max);
14569: }
1.127 matthew 14570: $Title = '' if (! defined($Title));
14571: $xlabel = '' if (! defined($xlabel));
14572: $ylabel = '' if (! defined($ylabel));
1.369 www 14573: $ValuesHash{$id.'.title'} = &escape($Title);
14574: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14575: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14576: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14577: $ValuesHash{$id.'.NumBars'} = $NumBars;
14578: $ValuesHash{$id.'.NumSets'} = $NumSets;
14579: $ValuesHash{$id.'.PlotType'} = 'bar';
14580: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14581: $ValuesHash{$id.'.height'} = $height;
14582: $ValuesHash{$id.'.width'} = $width;
14583: $ValuesHash{$id.'.xskip'} = $xskip;
14584: $ValuesHash{$id.'.bar_width'} = $bar_width;
14585: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14586: #
1.228 matthew 14587: # Deal with other parameters
14588: while (my ($key,$value) = each(%$extra_settings)) {
14589: $ValuesHash{$id.'.'.$key} = $value;
14590: }
14591: #
1.646 raeburn 14592: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14593: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14594: }
14595:
14596: ############################################################
14597: ############################################################
14598:
14599: =pod
14600:
1.648 raeburn 14601: =item * &DrawXYGraph()
1.137 matthew 14602:
1.138 matthew 14603: Facilitates the plotting of data in an XY graph.
14604: Puts plot definition data into the users environment in order for
14605: graph.png to plot it. Returns an <img> tag for the plot.
14606:
14607: Inputs:
14608:
14609: =over 4
14610:
14611: =item $Title: string, the title of the plot
14612:
14613: =item $xlabel: string, text describing the X-axis of the plot
14614:
14615: =item $ylabel: string, text describing the Y-axis of the plot
14616:
14617: =item $Max: scalar, the maximum Y value to use in the plot
14618: If $Max is < any data point, the graph will not be rendered.
14619:
14620: =item $colors: Array ref containing the hex color codes for the data to be
14621: plotted in. If undefined, default values will be used.
14622:
14623: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14624:
14625: =item $Ydata: Array ref containing Array refs.
1.185 www 14626: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14627:
14628: =item %Values: hash indicating or overriding any default values which are
14629: passed to graph.png.
14630: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14631:
14632: =back
14633:
14634: Returns:
14635:
14636: An <img> tag which references graph.png and the appropriate identifying
14637: information for the plot.
14638:
1.137 matthew 14639: =cut
14640:
14641: ############################################################
14642: ############################################################
14643: sub DrawXYGraph {
14644: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14645: #
14646: # Create the identifier for the graph
14647: my $identifier = &get_cgi_id();
14648: my $id = 'cgi.'.$identifier;
14649: #
14650: $Title = '' if (! defined($Title));
14651: $xlabel = '' if (! defined($xlabel));
14652: $ylabel = '' if (! defined($ylabel));
14653: my %ValuesHash =
14654: (
1.369 www 14655: $id.'.title' => &escape($Title),
14656: $id.'.xlabel' => &escape($xlabel),
14657: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14658: $id.'.y_max_value'=> $Max,
14659: $id.'.labels' => join(',',@$Xlabels),
14660: $id.'.PlotType' => 'XY',
14661: );
14662: #
14663: if (defined($colors) && ref($colors) eq 'ARRAY') {
14664: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14665: }
14666: #
14667: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14668: return '';
14669: }
14670: my $NumSets=1;
1.138 matthew 14671: foreach my $array (@{$Ydata}){
1.137 matthew 14672: next if (! ref($array));
14673: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14674: }
1.138 matthew 14675: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14676: #
14677: # Deal with other parameters
14678: while (my ($key,$value) = each(%Values)) {
14679: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14680: }
14681: #
1.646 raeburn 14682: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14683: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14684: }
14685:
14686: ############################################################
14687: ############################################################
14688:
14689: =pod
14690:
1.648 raeburn 14691: =item * &DrawXYYGraph()
1.138 matthew 14692:
14693: Facilitates the plotting of data in an XY graph with two Y axes.
14694: Puts plot definition data into the users environment in order for
14695: graph.png to plot it. Returns an <img> tag for the plot.
14696:
14697: Inputs:
14698:
14699: =over 4
14700:
14701: =item $Title: string, the title of the plot
14702:
14703: =item $xlabel: string, text describing the X-axis of the plot
14704:
14705: =item $ylabel: string, text describing the Y-axis of the plot
14706:
14707: =item $colors: Array ref containing the hex color codes for the data to be
14708: plotted in. If undefined, default values will be used.
14709:
14710: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14711:
14712: =item $Ydata1: The first data set
14713:
14714: =item $Min1: The minimum value of the left Y-axis
14715:
14716: =item $Max1: The maximum value of the left Y-axis
14717:
14718: =item $Ydata2: The second data set
14719:
14720: =item $Min2: The minimum value of the right Y-axis
14721:
14722: =item $Max2: The maximum value of the left Y-axis
14723:
14724: =item %Values: hash indicating or overriding any default values which are
14725: passed to graph.png.
14726: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14727:
14728: =back
14729:
14730: Returns:
14731:
14732: An <img> tag which references graph.png and the appropriate identifying
14733: information for the plot.
1.136 matthew 14734:
14735: =cut
14736:
14737: ############################################################
14738: ############################################################
1.137 matthew 14739: sub DrawXYYGraph {
14740: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14741: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14742: #
14743: # Create the identifier for the graph
14744: my $identifier = &get_cgi_id();
14745: my $id = 'cgi.'.$identifier;
14746: #
14747: $Title = '' if (! defined($Title));
14748: $xlabel = '' if (! defined($xlabel));
14749: $ylabel = '' if (! defined($ylabel));
14750: my %ValuesHash =
14751: (
1.369 www 14752: $id.'.title' => &escape($Title),
14753: $id.'.xlabel' => &escape($xlabel),
14754: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14755: $id.'.labels' => join(',',@$Xlabels),
14756: $id.'.PlotType' => 'XY',
14757: $id.'.NumSets' => 2,
1.137 matthew 14758: $id.'.two_axes' => 1,
14759: $id.'.y1_max_value' => $Max1,
14760: $id.'.y1_min_value' => $Min1,
14761: $id.'.y2_max_value' => $Max2,
14762: $id.'.y2_min_value' => $Min2,
1.136 matthew 14763: );
14764: #
1.137 matthew 14765: if (defined($colors) && ref($colors) eq 'ARRAY') {
14766: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14767: }
14768: #
14769: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14770: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14771: return '';
14772: }
14773: my $NumSets=1;
1.137 matthew 14774: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14775: next if (! ref($array));
14776: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14777: }
14778: #
14779: # Deal with other parameters
14780: while (my ($key,$value) = each(%Values)) {
14781: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14782: }
14783: #
1.646 raeburn 14784: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14785: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14786: }
14787:
14788: ############################################################
14789: ############################################################
14790:
14791: =pod
14792:
1.157 matthew 14793: =back
14794:
1.139 matthew 14795: =head1 Statistics helper routines?
14796:
14797: Bad place for them but what the hell.
14798:
1.157 matthew 14799: =over 4
14800:
1.648 raeburn 14801: =item * &chartlink()
1.139 matthew 14802:
14803: Returns a link to the chart for a specific student.
14804:
14805: Inputs:
14806:
14807: =over 4
14808:
14809: =item $linktext: The text of the link
14810:
14811: =item $sname: The students username
14812:
14813: =item $sdomain: The students domain
14814:
14815: =back
14816:
1.157 matthew 14817: =back
14818:
1.139 matthew 14819: =cut
14820:
14821: ############################################################
14822: ############################################################
14823: sub chartlink {
14824: my ($linktext, $sname, $sdomain) = @_;
14825: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14826: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14827: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14828: '">'.$linktext.'</a>';
1.153 matthew 14829: }
14830:
14831: #######################################################
14832: #######################################################
14833:
14834: =pod
14835:
14836: =head1 Course Environment Routines
1.157 matthew 14837:
14838: =over 4
1.153 matthew 14839:
1.648 raeburn 14840: =item * &restore_course_settings()
1.153 matthew 14841:
1.648 raeburn 14842: =item * &store_course_settings()
1.153 matthew 14843:
14844: Restores/Store indicated form parameters from the course environment.
14845: Will not overwrite existing values of the form parameters.
14846:
14847: Inputs:
14848: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14849:
14850: a hash ref describing the data to be stored. For example:
14851:
14852: %Save_Parameters = ('Status' => 'scalar',
14853: 'chartoutputmode' => 'scalar',
14854: 'chartoutputdata' => 'scalar',
14855: 'Section' => 'array',
1.373 raeburn 14856: 'Group' => 'array',
1.153 matthew 14857: 'StudentData' => 'array',
14858: 'Maps' => 'array');
14859:
14860: Returns: both routines return nothing
14861:
1.631 raeburn 14862: =back
14863:
1.153 matthew 14864: =cut
14865:
14866: #######################################################
14867: #######################################################
14868: sub store_course_settings {
1.496 albertel 14869: return &store_settings($env{'request.course.id'},@_);
14870: }
14871:
14872: sub store_settings {
1.153 matthew 14873: # save to the environment
14874: # appenv the same items, just to be safe
1.300 albertel 14875: my $udom = $env{'user.domain'};
14876: my $uname = $env{'user.name'};
1.496 albertel 14877: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14878: my %SaveHash;
14879: my %AppHash;
14880: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14881: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14882: my $envname = 'environment.'.$basename;
1.258 albertel 14883: if (exists($env{'form.'.$setting})) {
1.153 matthew 14884: # Save this value away
14885: if ($type eq 'scalar' &&
1.258 albertel 14886: (! exists($env{$envname}) ||
14887: $env{$envname} ne $env{'form.'.$setting})) {
14888: $SaveHash{$basename} = $env{'form.'.$setting};
14889: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14890: } elsif ($type eq 'array') {
14891: my $stored_form;
1.258 albertel 14892: if (ref($env{'form.'.$setting})) {
1.153 matthew 14893: $stored_form = join(',',
14894: map {
1.369 www 14895: &escape($_);
1.258 albertel 14896: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14897: } else {
14898: $stored_form =
1.369 www 14899: &escape($env{'form.'.$setting});
1.153 matthew 14900: }
14901: # Determine if the array contents are the same.
1.258 albertel 14902: if ($stored_form ne $env{$envname}) {
1.153 matthew 14903: $SaveHash{$basename} = $stored_form;
14904: $AppHash{$envname} = $stored_form;
14905: }
14906: }
14907: }
14908: }
14909: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14910: $udom,$uname);
1.153 matthew 14911: if ($put_result !~ /^(ok|delayed)/) {
14912: &Apache::lonnet::logthis('unable to save form parameters, '.
14913: 'got error:'.$put_result);
14914: }
14915: # Make sure these settings stick around in this session, too
1.646 raeburn 14916: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14917: return;
14918: }
14919:
14920: sub restore_course_settings {
1.499 albertel 14921: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14922: }
14923:
14924: sub restore_settings {
14925: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14926: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14927: next if (exists($env{'form.'.$setting}));
1.496 albertel 14928: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14929: '.'.$setting;
1.258 albertel 14930: if (exists($env{$envname})) {
1.153 matthew 14931: if ($type eq 'scalar') {
1.258 albertel 14932: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14933: } elsif ($type eq 'array') {
1.258 albertel 14934: $env{'form.'.$setting} = [
1.153 matthew 14935: map {
1.369 www 14936: &unescape($_);
1.258 albertel 14937: } split(',',$env{$envname})
1.153 matthew 14938: ];
14939: }
14940: }
14941: }
1.127 matthew 14942: }
14943:
1.618 raeburn 14944: #######################################################
14945: #######################################################
14946:
14947: =pod
14948:
14949: =head1 Domain E-mail Routines
14950:
14951: =over 4
14952:
1.648 raeburn 14953: =item * &build_recipient_list()
1.618 raeburn 14954:
1.1144 raeburn 14955: Build recipient lists for following types of e-mail:
1.766 raeburn 14956: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 14957: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14958: module change checking, student/employee ID conflict checks, as
14959: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14960: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14961:
14962: Inputs:
1.619 raeburn 14963: defmail (scalar - email address of default recipient),
1.1144 raeburn 14964: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14965: requestsmail, updatesmail, or idconflictsmail).
14966:
1.619 raeburn 14967: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 14968:
1.619 raeburn 14969: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 14970: i.e., predates configuration by DC via domainprefs.pm
14971:
14972: $requname username of requester (if mailing type is helpdeskmail)
14973:
14974: $requdom domain of requester (if mailing type is helpdeskmail)
14975:
14976: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14977:
1.618 raeburn 14978:
1.655 raeburn 14979: Returns: comma separated list of addresses to which to send e-mail.
14980:
14981: =back
1.618 raeburn 14982:
14983: =cut
14984:
14985: ############################################################
14986: ############################################################
14987: sub build_recipient_list {
1.1297 raeburn 14988: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14989: my @recipients;
1.1270 raeburn 14990: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14991: my %domconfig =
1.1270 raeburn 14992: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14993: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14994: if (exists($domconfig{'contacts'}{$mailing})) {
14995: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14996: my @contacts = ('adminemail','supportemail');
14997: foreach my $item (@contacts) {
14998: if ($domconfig{'contacts'}{$mailing}{$item}) {
14999: my $addr = $domconfig{'contacts'}{$item};
15000: if (!grep(/^\Q$addr\E$/,@recipients)) {
15001: push(@recipients,$addr);
15002: }
1.619 raeburn 15003: }
1.1270 raeburn 15004: }
15005: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15006: if ($mailing eq 'helpdeskmail') {
15007: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15008: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15009: my @ok_bccs;
15010: foreach my $bcc (@bccs) {
15011: $bcc =~ s/^\s+//g;
15012: $bcc =~ s/\s+$//g;
15013: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15014: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15015: push(@ok_bccs,$bcc);
15016: }
15017: }
15018: }
15019: if (@ok_bccs > 0) {
15020: $allbcc = join(', ',@ok_bccs);
15021: }
15022: }
15023: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15024: }
15025: }
1.766 raeburn 15026: } elsif ($origmail ne '') {
1.1270 raeburn 15027: $lastresort = $origmail;
1.618 raeburn 15028: }
1.1297 raeburn 15029: if ($mailing eq 'helpdeskmail') {
15030: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15031: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
15032: my ($inststatus,$inststatus_checked);
15033: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
15034: ($env{'user.domain'} ne 'public')) {
15035: $inststatus_checked = 1;
15036: $inststatus = $env{'environment.inststatus'};
15037: }
15038: unless ($inststatus_checked) {
15039: if (($requname ne '') && ($requdom ne '')) {
15040: if (($requname =~ /^$match_username$/) &&
15041: ($requdom =~ /^$match_domain$/) &&
15042: (&Apache::lonnet::domain($requdom))) {
15043: my $requhome = &Apache::lonnet::homeserver($requname,
15044: $requdom);
15045: unless ($requhome eq 'no_host') {
15046: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
15047: $inststatus = $userenv{'inststatus'};
15048: $inststatus_checked = 1;
15049: }
15050: }
15051: }
15052: }
15053: unless ($inststatus_checked) {
15054: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
15055: my %srch = (srchby => 'email',
15056: srchdomain => $defdom,
15057: srchterm => $reqemail,
15058: srchtype => 'exact');
15059: my %srch_results = &Apache::lonnet::usersearch(\%srch);
15060: foreach my $uname (keys(%srch_results)) {
15061: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15062: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15063: $inststatus_checked = 1;
15064: last;
15065: }
15066: }
15067: unless ($inststatus_checked) {
15068: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15069: if ($dirsrchres eq 'ok') {
15070: foreach my $uname (keys(%srch_results)) {
15071: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15072: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15073: $inststatus_checked = 1;
15074: last;
15075: }
15076: }
15077: }
15078: }
15079: }
15080: }
15081: if ($inststatus ne '') {
15082: foreach my $status (split(/\:/,$inststatus)) {
15083: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15084: my @contacts = ('adminemail','supportemail');
15085: foreach my $item (@contacts) {
15086: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15087: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15088: if (!grep(/^\Q$addr\E$/,@recipients)) {
15089: push(@recipients,$addr);
15090: }
15091: }
15092: }
15093: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15094: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15095: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15096: my @ok_bccs;
15097: foreach my $bcc (@bccs) {
15098: $bcc =~ s/^\s+//g;
15099: $bcc =~ s/\s+$//g;
15100: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15101: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15102: push(@ok_bccs,$bcc);
15103: }
15104: }
15105: }
15106: if (@ok_bccs > 0) {
15107: $allbcc = join(', ',@ok_bccs);
15108: }
15109: }
15110: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15111: last;
15112: }
15113: }
15114: }
15115: }
15116: }
1.619 raeburn 15117: } elsif ($origmail ne '') {
1.1270 raeburn 15118: $lastresort = $origmail;
15119: }
1.1297 raeburn 15120: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 15121: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15122: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15123: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15124: my %what = (
15125: perlvar => 1,
15126: );
15127: my $primary = &Apache::lonnet::domain($defdom,'primary');
15128: if ($primary) {
15129: my $gotaddr;
15130: my ($result,$returnhash) =
15131: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15132: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15133: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15134: $lastresort = $returnhash->{'lonSupportEMail'};
15135: $gotaddr = 1;
15136: }
15137: }
15138: unless ($gotaddr) {
15139: my $uintdom = &Apache::lonnet::internet_dom($primary);
15140: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15141: unless ($uintdom eq $intdom) {
15142: my %domconfig =
15143: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15144: if (ref($domconfig{'contacts'}) eq 'HASH') {
15145: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15146: my @contacts = ('adminemail','supportemail');
15147: foreach my $item (@contacts) {
15148: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15149: my $addr = $domconfig{'contacts'}{$item};
15150: if (!grep(/^\Q$addr\E$/,@recipients)) {
15151: push(@recipients,$addr);
15152: }
15153: }
15154: }
15155: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15156: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15157: }
15158: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15159: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15160: my @ok_bccs;
15161: foreach my $bcc (@bccs) {
15162: $bcc =~ s/^\s+//g;
15163: $bcc =~ s/\s+$//g;
15164: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15165: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15166: push(@ok_bccs,$bcc);
15167: }
15168: }
15169: }
15170: if (@ok_bccs > 0) {
15171: $allbcc = join(', ',@ok_bccs);
15172: }
15173: }
15174: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15175: }
15176: }
15177: }
15178: }
15179: }
15180: }
1.618 raeburn 15181: }
1.688 raeburn 15182: if (defined($defmail)) {
15183: if ($defmail ne '') {
15184: push(@recipients,$defmail);
15185: }
1.618 raeburn 15186: }
15187: if ($otheremails) {
1.619 raeburn 15188: my @others;
15189: if ($otheremails =~ /,/) {
15190: @others = split(/,/,$otheremails);
1.618 raeburn 15191: } else {
1.619 raeburn 15192: push(@others,$otheremails);
15193: }
15194: foreach my $addr (@others) {
15195: if (!grep(/^\Q$addr\E$/,@recipients)) {
15196: push(@recipients,$addr);
15197: }
1.618 raeburn 15198: }
15199: }
1.1298 raeburn 15200: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 15201: if ((!@recipients) && ($lastresort ne '')) {
15202: push(@recipients,$lastresort);
15203: }
15204: } elsif ($lastresort ne '') {
15205: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15206: push(@recipients,$lastresort);
15207: }
15208: }
1.1271 raeburn 15209: my $recipientlist = join(',',@recipients);
1.1270 raeburn 15210: if (wantarray) {
15211: return ($recipientlist,$allbcc,$addtext);
15212: } else {
15213: return $recipientlist;
15214: }
1.618 raeburn 15215: }
15216:
1.127 matthew 15217: ############################################################
15218: ############################################################
1.154 albertel 15219:
1.655 raeburn 15220: =pod
15221:
1.1224 musolffc 15222: =over 4
15223:
1.1223 musolffc 15224: =item * &mime_email()
15225:
15226: Sends an email with a possible attachment
15227:
15228: Inputs:
15229:
15230: =over 4
15231:
15232: from - Sender's email address
15233:
1.1343 raeburn 15234: replyto - Reply-To email address
15235:
1.1223 musolffc 15236: to - Email address of recipient
15237:
15238: subject - Subject of email
15239:
15240: body - Body of email
15241:
15242: cc_string - Carbon copy email address
15243:
15244: bcc - Blind carbon copy email address
15245:
15246: attachment_path - Path of file to be attached
15247:
15248: file_name - Name of file to be attached
15249:
15250: attachment_text - The body of an attachment of type "TEXT"
15251:
15252: =back
15253:
15254: =back
15255:
15256: =cut
15257:
15258: ############################################################
15259: ############################################################
15260:
15261: sub mime_email {
1.1343 raeburn 15262: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
15263: $file_name,$attachment_text) = @_;
15264:
1.1223 musolffc 15265: my $msg = MIME::Lite->new(
15266: From => $from,
15267: To => $to,
15268: Subject => $subject,
15269: Type =>'TEXT',
15270: Data => $body,
15271: );
1.1343 raeburn 15272: if ($replyto ne '') {
15273: $msg->add("Reply-To" => $replyto);
15274: }
1.1223 musolffc 15275: if ($cc_string ne '') {
15276: $msg->add("Cc" => $cc_string);
15277: }
15278: if ($bcc ne '') {
15279: $msg->add("Bcc" => $bcc);
15280: }
15281: $msg->attr("content-type" => "text/plain");
15282: $msg->attr("content-type.charset" => "UTF-8");
15283: # Attach file if given
15284: if ($attachment_path) {
15285: unless ($file_name) {
15286: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15287: }
15288: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15289: $msg->attach(Type => $type,
15290: Path => $attachment_path,
15291: Filename => $file_name
15292: );
15293: # Otherwise attach text if given
15294: } elsif ($attachment_text) {
15295: $msg->attach(Type => 'TEXT',
15296: Data => $attachment_text);
15297: }
15298: # Send it
15299: $msg->send('sendmail');
15300: }
15301:
15302: ############################################################
15303: ############################################################
15304:
15305: =pod
15306:
1.655 raeburn 15307: =head1 Course Catalog Routines
15308:
15309: =over 4
15310:
15311: =item * &gather_categories()
15312:
15313: Converts category definitions - keys of categories hash stored in
15314: coursecategories in configuration.db on the primary library server in a
15315: domain - to an array. Also generates javascript and idx hash used to
15316: generate Domain Coordinator interface for editing Course Categories.
15317:
15318: Inputs:
1.663 raeburn 15319:
1.655 raeburn 15320: categories (reference to hash of category definitions).
1.663 raeburn 15321:
1.655 raeburn 15322: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15323: categories and subcategories).
1.663 raeburn 15324:
1.655 raeburn 15325: idx (reference to hash of counters used in Domain Coordinator interface for
15326: editing Course Categories).
1.663 raeburn 15327:
1.655 raeburn 15328: jsarray (reference to array of categories used to create Javascript arrays for
15329: Domain Coordinator interface for editing Course Categories).
15330:
15331: Returns: nothing
15332:
15333: Side effects: populates cats, idx and jsarray.
15334:
15335: =cut
15336:
15337: sub gather_categories {
15338: my ($categories,$cats,$idx,$jsarray) = @_;
15339: my %counters;
15340: my $num = 0;
15341: foreach my $item (keys(%{$categories})) {
15342: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15343: if ($container eq '' && $depth == 0) {
15344: $cats->[$depth][$categories->{$item}] = $cat;
15345: } else {
15346: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15347: }
15348: my ($escitem,$tail) = split(/:/,$item,2);
15349: if ($counters{$tail} eq '') {
15350: $counters{$tail} = $num;
15351: $num ++;
15352: }
15353: if (ref($idx) eq 'HASH') {
15354: $idx->{$item} = $counters{$tail};
15355: }
15356: if (ref($jsarray) eq 'ARRAY') {
15357: push(@{$jsarray->[$counters{$tail}]},$item);
15358: }
15359: }
15360: return;
15361: }
15362:
15363: =pod
15364:
15365: =item * &extract_categories()
15366:
15367: Used to generate breadcrumb trails for course categories.
15368:
15369: Inputs:
1.663 raeburn 15370:
1.655 raeburn 15371: categories (reference to hash of category definitions).
1.663 raeburn 15372:
1.655 raeburn 15373: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15374: categories and subcategories).
1.663 raeburn 15375:
1.655 raeburn 15376: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15377:
1.655 raeburn 15378: allitems (reference to hash - key is category key
15379: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15380:
1.655 raeburn 15381: idx (reference to hash of counters used in Domain Coordinator interface for
15382: editing Course Categories).
1.663 raeburn 15383:
1.655 raeburn 15384: jsarray (reference to array of categories used to create Javascript arrays for
15385: Domain Coordinator interface for editing Course Categories).
15386:
1.665 raeburn 15387: subcats (reference to hash of arrays containing all subcategories within each
15388: category, -recursive)
15389:
1.1321 raeburn 15390: maxd (reference to hash used to hold max depth for all top-level categories).
15391:
1.655 raeburn 15392: Returns: nothing
15393:
15394: Side effects: populates trails and allitems hash references.
15395:
15396: =cut
15397:
15398: sub extract_categories {
1.1321 raeburn 15399: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 15400: if (ref($categories) eq 'HASH') {
15401: &gather_categories($categories,$cats,$idx,$jsarray);
15402: if (ref($cats->[0]) eq 'ARRAY') {
15403: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15404: my $name = $cats->[0][$i];
15405: my $item = &escape($name).'::0';
15406: my $trailstr;
15407: if ($name eq 'instcode') {
15408: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15409: } elsif ($name eq 'communities') {
15410: $trailstr = &mt('Communities');
1.1239 raeburn 15411: } elsif ($name eq 'placement') {
15412: $trailstr = &mt('Placement Tests');
1.655 raeburn 15413: } else {
15414: $trailstr = $name;
15415: }
15416: if ($allitems->{$item} eq '') {
15417: push(@{$trails},$trailstr);
15418: $allitems->{$item} = scalar(@{$trails})-1;
15419: }
15420: my @parents = ($name);
15421: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15422: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15423: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15424: if (ref($subcats) eq 'HASH') {
15425: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15426: }
1.1321 raeburn 15427: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 15428: }
15429: } else {
15430: if (ref($subcats) eq 'HASH') {
15431: $subcats->{$item} = [];
1.655 raeburn 15432: }
1.1321 raeburn 15433: if (ref($maxd) eq 'HASH') {
15434: $maxd->{$name} = 1;
15435: }
1.655 raeburn 15436: }
15437: }
15438: }
15439: }
15440: return;
15441: }
15442:
15443: =pod
15444:
1.1162 raeburn 15445: =item * &recurse_categories()
1.655 raeburn 15446:
15447: Recursively used to generate breadcrumb trails for course categories.
15448:
15449: Inputs:
1.663 raeburn 15450:
1.655 raeburn 15451: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15452: categories and subcategories).
1.663 raeburn 15453:
1.655 raeburn 15454: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 15455:
15456: category (current course category, for which breadcrumb trail is being generated).
15457:
15458: trails (reference to array of breadcrumb trails for each category).
15459:
1.655 raeburn 15460: allitems (reference to hash - key is category key
15461: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15462:
1.655 raeburn 15463: parents (array containing containers directories for current category,
15464: back to top level).
15465:
15466: Returns: nothing
15467:
15468: Side effects: populates trails and allitems hash references
15469:
15470: =cut
15471:
15472: sub recurse_categories {
1.1321 raeburn 15473: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 15474: my $shallower = $depth - 1;
15475: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
15476: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
15477: my $name = $cats->[$depth]{$category}[$k];
15478: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 15479: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15480: if ($allitems->{$item} eq '') {
15481: push(@{$trails},$trailstr);
15482: $allitems->{$item} = scalar(@{$trails})-1;
15483: }
15484: my $deeper = $depth+1;
15485: push(@{$parents},$category);
1.665 raeburn 15486: if (ref($subcats) eq 'HASH') {
15487: my $subcat = &escape($name).':'.$category.':'.$depth;
15488: for (my $j=@{$parents}; $j>=0; $j--) {
15489: my $higher;
15490: if ($j > 0) {
15491: $higher = &escape($parents->[$j]).':'.
15492: &escape($parents->[$j-1]).':'.$j;
15493: } else {
15494: $higher = &escape($parents->[$j]).'::'.$j;
15495: }
15496: push(@{$subcats->{$higher}},$subcat);
15497: }
15498: }
15499: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 15500: $subcats,$maxd);
1.655 raeburn 15501: pop(@{$parents});
15502: }
15503: } else {
15504: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 15505: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15506: if ($allitems->{$item} eq '') {
15507: push(@{$trails},$trailstr);
15508: $allitems->{$item} = scalar(@{$trails})-1;
15509: }
1.1321 raeburn 15510: if (ref($maxd) eq 'HASH') {
15511: if ($depth > $maxd->{$parents->[0]}) {
15512: $maxd->{$parents->[0]} = $depth;
15513: }
15514: }
1.655 raeburn 15515: }
15516: return;
15517: }
15518:
1.663 raeburn 15519: =pod
15520:
1.1162 raeburn 15521: =item * &assign_categories_table()
1.663 raeburn 15522:
15523: Create a datatable for display of hierarchical categories in a domain,
15524: with checkboxes to allow a course to be categorized.
15525:
15526: Inputs:
15527:
15528: cathash - reference to hash of categories defined for the domain (from
15529: configuration.db)
15530:
15531: currcat - scalar with an & separated list of categories assigned to a course.
15532:
1.919 raeburn 15533: type - scalar contains course type (Course or Community).
15534:
1.1260 raeburn 15535: disabled - scalar (optional) contains disabled="disabled" if input elements are
15536: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15537:
1.663 raeburn 15538: Returns: $output (markup to be displayed)
15539:
15540: =cut
15541:
15542: sub assign_categories_table {
1.1259 raeburn 15543: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15544: my $output;
15545: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 15546: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
15547: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 15548: $maxdepth = scalar(@cats);
15549: if (@cats > 0) {
15550: my $itemcount = 0;
15551: if (ref($cats[0]) eq 'ARRAY') {
15552: my @currcategories;
15553: if ($currcat ne '') {
15554: @currcategories = split('&',$currcat);
15555: }
1.919 raeburn 15556: my $table;
1.663 raeburn 15557: for (my $i=0; $i<@{$cats[0]}; $i++) {
15558: my $parent = $cats[0][$i];
1.919 raeburn 15559: next if ($parent eq 'instcode');
15560: if ($type eq 'Community') {
15561: next unless ($parent eq 'communities');
1.1239 raeburn 15562: } elsif ($type eq 'Placement') {
15563: next unless ($parent eq 'placement');
1.919 raeburn 15564: } else {
1.1239 raeburn 15565: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 15566: }
1.663 raeburn 15567: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15568: my $item = &escape($parent).'::0';
15569: my $checked = '';
15570: if (@currcategories > 0) {
15571: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15572: $checked = ' checked="checked"';
1.663 raeburn 15573: }
15574: }
1.919 raeburn 15575: my $parent_title = $parent;
15576: if ($parent eq 'communities') {
15577: $parent_title = &mt('Communities');
1.1239 raeburn 15578: } elsif ($parent eq 'placement') {
15579: $parent_title = &mt('Placement Tests');
1.919 raeburn 15580: }
15581: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15582: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15583: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15584: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15585: my $depth = 1;
15586: push(@path,$parent);
1.1259 raeburn 15587: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15588: pop(@path);
1.919 raeburn 15589: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15590: $itemcount ++;
15591: }
1.919 raeburn 15592: if ($itemcount) {
15593: $output = &Apache::loncommon::start_data_table().
15594: $table.
15595: &Apache::loncommon::end_data_table();
15596: }
1.663 raeburn 15597: }
15598: }
15599: }
15600: return $output;
15601: }
15602:
15603: =pod
15604:
1.1162 raeburn 15605: =item * &assign_category_rows()
1.663 raeburn 15606:
15607: Create a datatable row for display of nested categories in a domain,
15608: with checkboxes to allow a course to be categorized,called recursively.
15609:
15610: Inputs:
15611:
15612: itemcount - track row number for alternating colors
15613:
15614: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15615: categories and subcategories.
15616:
15617: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15618:
15619: parent - parent of current category item
15620:
15621: path - Array containing all categories back up through the hierarchy from the
15622: current category to the top level.
15623:
15624: currcategories - reference to array of current categories assigned to the course
15625:
1.1260 raeburn 15626: disabled - scalar (optional) contains disabled="disabled" if input elements are
15627: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15628:
1.663 raeburn 15629: Returns: $output (markup to be displayed).
15630:
15631: =cut
15632:
15633: sub assign_category_rows {
1.1259 raeburn 15634: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15635: my ($text,$name,$item,$chgstr);
15636: if (ref($cats) eq 'ARRAY') {
15637: my $maxdepth = scalar(@{$cats});
15638: if (ref($cats->[$depth]) eq 'HASH') {
15639: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15640: my $numchildren = @{$cats->[$depth]{$parent}};
15641: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 15642: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15643: for (my $j=0; $j<$numchildren; $j++) {
15644: $name = $cats->[$depth]{$parent}[$j];
15645: $item = &escape($name).':'.&escape($parent).':'.$depth;
15646: my $deeper = $depth+1;
15647: my $checked = '';
15648: if (ref($currcategories) eq 'ARRAY') {
15649: if (@{$currcategories} > 0) {
15650: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15651: $checked = ' checked="checked"';
1.663 raeburn 15652: }
15653: }
15654: }
1.664 raeburn 15655: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15656: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 15657: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15658: '<input type="hidden" name="catname" value="'.$name.'" />'.
15659: '</td><td>';
1.663 raeburn 15660: if (ref($path) eq 'ARRAY') {
15661: push(@{$path},$name);
1.1259 raeburn 15662: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15663: pop(@{$path});
15664: }
15665: $text .= '</td></tr>';
15666: }
15667: $text .= '</table></td>';
15668: }
15669: }
15670: }
15671: return $text;
15672: }
15673:
1.1181 raeburn 15674: =pod
15675:
15676: =back
15677:
15678: =cut
15679:
1.655 raeburn 15680: ############################################################
15681: ############################################################
15682:
15683:
1.443 albertel 15684: sub commit_customrole {
1.664 raeburn 15685: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15686: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15687: ($start?', '.&mt('starting').' '.localtime($start):'').
15688: ($end?', ending '.localtime($end):'').': <b>'.
15689: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15690: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15691: '</b><br />';
15692: return $output;
15693: }
15694:
15695: sub commit_standardrole {
1.1116 raeburn 15696: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15697: my ($output,$logmsg,$linefeed);
15698: if ($context eq 'auto') {
15699: $linefeed = "\n";
15700: } else {
15701: $linefeed = "<br />\n";
15702: }
1.443 albertel 15703: if ($three eq 'st') {
1.541 raeburn 15704: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 15705: $one,$two,$sec,$context,$credits);
1.541 raeburn 15706: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15707: ($result eq 'unknown_course') || ($result eq 'refused')) {
15708: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15709: } else {
1.541 raeburn 15710: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15711: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15712: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15713: if ($context eq 'auto') {
15714: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15715: } else {
15716: $output .= '<b>'.$result.'</b>'.$linefeed.
15717: &mt('Add to classlist').': <b>ok</b>';
15718: }
15719: $output .= $linefeed;
1.443 albertel 15720: }
15721: } else {
15722: $output = &mt('Assigning').' '.$three.' in '.$url.
15723: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15724: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15725: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15726: if ($context eq 'auto') {
15727: $output .= $result.$linefeed;
15728: } else {
15729: $output .= '<b>'.$result.'</b>'.$linefeed;
15730: }
1.443 albertel 15731: }
15732: return $output;
15733: }
15734:
15735: sub commit_studentrole {
1.1116 raeburn 15736: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15737: $credits) = @_;
1.626 raeburn 15738: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15739: if ($context eq 'auto') {
15740: $linefeed = "\n";
15741: } else {
15742: $linefeed = '<br />'."\n";
15743: }
1.443 albertel 15744: if (defined($one) && defined($two)) {
15745: my $cid=$one.'_'.$two;
15746: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15747: my $secchange = 0;
15748: my $expire_role_result;
15749: my $modify_section_result;
1.628 raeburn 15750: if ($oldsec ne '-1') {
15751: if ($oldsec ne $sec) {
1.443 albertel 15752: $secchange = 1;
1.628 raeburn 15753: my $now = time;
1.443 albertel 15754: my $uurl='/'.$cid;
15755: $uurl=~s/\_/\//g;
15756: if ($oldsec) {
15757: $uurl.='/'.$oldsec;
15758: }
1.626 raeburn 15759: $oldsecurl = $uurl;
1.628 raeburn 15760: $expire_role_result =
1.652 raeburn 15761: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 15762: if ($env{'request.course.sec'} ne '') {
15763: if ($expire_role_result eq 'refused') {
15764: my @roles = ('st');
15765: my @statuses = ('previous');
15766: my @roledoms = ($one);
15767: my $withsec = 1;
15768: my %roleshash =
15769: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15770: \@statuses,\@roles,\@roledoms,$withsec);
15771: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15772: my ($oldstart,$oldend) =
15773: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15774: if ($oldend > 0 && $oldend <= $now) {
15775: $expire_role_result = 'ok';
15776: }
15777: }
15778: }
15779: }
1.443 albertel 15780: $result = $expire_role_result;
15781: }
15782: }
15783: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 15784: $modify_section_result =
15785: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15786: undef,undef,undef,$sec,
15787: $end,$start,'','',$cid,
15788: '',$context,$credits);
1.443 albertel 15789: if ($modify_section_result =~ /^ok/) {
15790: if ($secchange == 1) {
1.628 raeburn 15791: if ($sec eq '') {
15792: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15793: } else {
15794: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15795: }
1.443 albertel 15796: } elsif ($oldsec eq '-1') {
1.628 raeburn 15797: if ($sec eq '') {
15798: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15799: } else {
15800: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15801: }
1.443 albertel 15802: } else {
1.628 raeburn 15803: if ($sec eq '') {
15804: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15805: } else {
15806: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15807: }
1.443 albertel 15808: }
15809: } else {
1.1115 raeburn 15810: if ($secchange) {
1.628 raeburn 15811: $$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;
15812: } else {
15813: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15814: }
1.443 albertel 15815: }
15816: $result = $modify_section_result;
15817: } elsif ($secchange == 1) {
1.628 raeburn 15818: if ($oldsec eq '') {
1.1103 raeburn 15819: $$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 15820: } else {
15821: $$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;
15822: }
1.626 raeburn 15823: if ($expire_role_result eq 'refused') {
15824: my $newsecurl = '/'.$cid;
15825: $newsecurl =~ s/\_/\//g;
15826: if ($sec ne '') {
15827: $newsecurl.='/'.$sec;
15828: }
15829: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15830: if ($sec eq '') {
15831: $$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;
15832: } else {
15833: $$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;
15834: }
15835: }
15836: }
1.443 albertel 15837: }
15838: } else {
1.626 raeburn 15839: $$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 15840: $result = "error: incomplete course id\n";
15841: }
15842: return $result;
15843: }
15844:
1.1108 raeburn 15845: sub show_role_extent {
15846: my ($scope,$context,$role) = @_;
15847: $scope =~ s{^/}{};
15848: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15849: push(@courseroles,'co');
15850: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15851: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15852: $scope =~ s{/}{_};
15853: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15854: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15855: my ($audom,$auname) = split(/\//,$scope);
15856: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15857: &Apache::loncommon::plainname($auname,$audom).'</span>');
15858: } else {
15859: $scope =~ s{/$}{};
15860: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15861: &Apache::lonnet::domain($scope,'description').'</span>');
15862: }
15863: }
15864:
1.443 albertel 15865: ############################################################
15866: ############################################################
15867:
1.566 albertel 15868: sub check_clone {
1.578 raeburn 15869: my ($args,$linefeed) = @_;
1.566 albertel 15870: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15871: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15872: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 15873: my $clonetitle;
15874: my @clonemsg;
1.566 albertel 15875: my $can_clone = 0;
1.944 raeburn 15876: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15877: if ($lctype ne 'community') {
15878: $lctype = 'course';
15879: }
1.566 albertel 15880: if ($clonehome eq 'no_host') {
1.944 raeburn 15881: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 15882: push(@clonemsg,({
15883: mt => 'No new community created.',
15884: args => [],
15885: },
15886: {
15887: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
15888: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
15889: }));
1.908 raeburn 15890: } else {
1.1344 raeburn 15891: push(@clonemsg,({
15892: mt => 'No new course created.',
15893: args => [],
15894: },
15895: {
15896: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
15897: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
15898: }));
15899: }
1.566 albertel 15900: } else {
15901: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 15902: $clonetitle = $clonedesc{'description'};
1.944 raeburn 15903: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15904: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 15905: push(@clonemsg,({
15906: mt => 'No new community created.',
15907: args => [],
15908: },
15909: {
15910: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
15911: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
15912: }));
15913: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 15914: }
15915: }
1.1262 raeburn 15916: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15917: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15918: $can_clone = 1;
15919: } else {
1.1221 raeburn 15920: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15921: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 15922: if ($clonehash{'cloners'} eq '') {
15923: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15924: if ($domdefs{'canclone'}) {
15925: unless ($domdefs{'canclone'} eq 'none') {
15926: if ($domdefs{'canclone'} eq 'domain') {
15927: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15928: $can_clone = 1;
15929: }
15930: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15931: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15932: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15933: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15934: $can_clone = 1;
15935: }
15936: }
15937: }
15938: }
1.578 raeburn 15939: } else {
1.1221 raeburn 15940: my @cloners = split(/,/,$clonehash{'cloners'});
15941: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15942: $can_clone = 1;
1.1221 raeburn 15943: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15944: $can_clone = 1;
1.1225 raeburn 15945: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15946: $can_clone = 1;
1.1221 raeburn 15947: }
15948: unless ($can_clone) {
1.1225 raeburn 15949: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15950: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 15951: my (%gotdomdefaults,%gotcodedefaults);
15952: foreach my $cloner (@cloners) {
15953: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15954: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15955: my (%codedefaults,@code_order);
15956: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15957: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15958: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15959: }
15960: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15961: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15962: }
15963: } else {
15964: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15965: \%codedefaults,
15966: \@code_order);
15967: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15968: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15969: }
15970: if (@code_order > 0) {
15971: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15972: $cloner,$clonehash{'internal.coursecode'},
15973: $args->{'crscode'})) {
15974: $can_clone = 1;
15975: last;
15976: }
15977: }
15978: }
15979: }
15980: }
1.1225 raeburn 15981: }
15982: }
15983: unless ($can_clone) {
15984: my $ccrole = 'cc';
15985: if ($args->{'crstype'} eq 'Community') {
15986: $ccrole = 'co';
15987: }
15988: my %roleshash =
15989: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15990: $args->{'ccdomain'},
15991: 'userroles',['active'],[$ccrole],
15992: [$args->{'clonedomain'}]);
15993: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15994: $can_clone = 1;
15995: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15996: $args->{'ccuname'},$args->{'ccdomain'})) {
15997: $can_clone = 1;
1.1221 raeburn 15998: }
15999: }
16000: unless ($can_clone) {
16001: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16002: push(@clonemsg,({
16003: mt => 'No new community created.',
16004: args => [],
16005: },
16006: {
16007: 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]).',
16008: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16009: }));
1.942 raeburn 16010: } else {
1.1344 raeburn 16011: push(@clonemsg,({
16012: mt => 'No new course created.',
16013: args => [],
16014: },
16015: {
16016: 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]).',
16017: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16018: }));
1.1221 raeburn 16019: }
1.566 albertel 16020: }
1.578 raeburn 16021: }
1.566 albertel 16022: }
1.1344 raeburn 16023: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16024: }
16025:
1.444 albertel 16026: sub construct_course {
1.1262 raeburn 16027: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 16028: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
16029: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 16030: my $linefeed = '<br />'."\n";
16031: if ($context eq 'auto') {
16032: $linefeed = "\n";
16033: }
1.566 albertel 16034:
16035: #
16036: # Are we cloning?
16037: #
1.1344 raeburn 16038: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16039: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 16040: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 16041: if (!$can_clone) {
1.1344 raeburn 16042: return (0,$outcome,$clonemsgref);
1.566 albertel 16043: }
16044: }
16045:
1.444 albertel 16046: #
16047: # Open course
16048: #
1.1239 raeburn 16049: my $showncrstype;
16050: if ($args->{'crstype'} eq 'Placement') {
16051: $showncrstype = 'placement test';
16052: } else {
16053: $showncrstype = lc($args->{'crstype'});
16054: }
1.444 albertel 16055: my %cenv=();
16056: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
16057: $args->{'cdescr'},
16058: $args->{'curl'},
16059: $args->{'course_home'},
16060: $args->{'nonstandard'},
16061: $args->{'crscode'},
16062: $args->{'ccuname'}.':'.
16063: $args->{'ccdomain'},
1.882 raeburn 16064: $args->{'crstype'},
1.1344 raeburn 16065: $cnum,$context,$category,
16066: $callercontext);
1.444 albertel 16067:
16068: # Note: The testing routines depend on this being output; see
16069: # Utils::Course. This needs to at least be output as a comment
16070: # if anyone ever decides to not show this, and Utils::Course::new
16071: # will need to be suitably modified.
1.1344 raeburn 16072: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16073: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16074: } else {
16075: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16076: }
1.943 raeburn 16077: if ($$courseid =~ /^error:/) {
1.1344 raeburn 16078: return (0,$outcome,$clonemsgref);
1.943 raeburn 16079: }
16080:
1.444 albertel 16081: #
16082: # Check if created correctly
16083: #
1.479 albertel 16084: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 16085: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 16086: if ($crsuhome eq 'no_host') {
1.1344 raeburn 16087: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16088: $outcome .= &mt_user($user_lh,
16089: 'Course creation failed, unrecognized course home server.');
16090: } else {
16091: $outcome .= &mt('Course creation failed, unrecognized course home server.');
16092: }
16093: $outcome .= $linefeed;
16094: return (0,$outcome,$clonemsgref);
1.943 raeburn 16095: }
1.541 raeburn 16096: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 16097:
1.444 albertel 16098: #
1.566 albertel 16099: # Do the cloning
16100: #
1.1344 raeburn 16101: my @clonemsg;
1.566 albertel 16102: if ($can_clone && $cloneid) {
1.1344 raeburn 16103: push(@clonemsg,
16104: {
16105: mt => 'Created [_1] by cloning from [_2]',
16106: args => [$showncrstype,$clonetitle],
16107: });
1.566 albertel 16108: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 16109: # Copy all files
1.1344 raeburn 16110: my @info =
16111: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
16112: $args->{'dateshift'},$args->{'crscode'},
16113: $args->{'ccuname'}.':'.$args->{'ccdomain'},
16114: $args->{'tinyurls'});
16115: if (@info) {
16116: push(@clonemsg,@info);
16117: }
1.444 albertel 16118: # Restore URL
1.566 albertel 16119: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 16120: # Restore title
1.566 albertel 16121: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 16122: # Restore creation date, creator and creation context.
16123: $cenv{'internal.created'}=$oldcenv{'internal.created'};
16124: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
16125: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 16126: # Mark as cloned
1.566 albertel 16127: $cenv{'clonedfrom'}=$cloneid;
1.638 www 16128: # Need to clone grading mode
16129: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
16130: $cenv{'grading'}=$newenv{'grading'};
16131: # Do not clone these environment entries
16132: &Apache::lonnet::del('environment',
16133: ['default_enrollment_start_date',
16134: 'default_enrollment_end_date',
16135: 'question.email',
16136: 'policy.email',
16137: 'comment.email',
16138: 'pch.users.denied',
1.725 raeburn 16139: 'plc.users.denied',
16140: 'hidefromcat',
1.1121 raeburn 16141: 'checkforpriv',
1.1166 raeburn 16142: 'categories',
16143: 'internal.uniquecode'],
1.638 www 16144: $$crsudom,$$crsunum);
1.1170 raeburn 16145: if ($args->{'textbook'}) {
16146: $cenv{'internal.textbook'} = $args->{'textbook'};
16147: }
1.444 albertel 16148: }
1.566 albertel 16149:
1.444 albertel 16150: #
16151: # Set environment (will override cloned, if existing)
16152: #
16153: my @sections = ();
16154: my @xlists = ();
16155: if ($args->{'crstype'}) {
16156: $cenv{'type'}=$args->{'crstype'};
16157: }
16158: if ($args->{'crsid'}) {
16159: $cenv{'courseid'}=$args->{'crsid'};
16160: }
16161: if ($args->{'crscode'}) {
16162: $cenv{'internal.coursecode'}=$args->{'crscode'};
16163: }
16164: if ($args->{'crsquota'} ne '') {
16165: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16166: } else {
16167: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16168: }
16169: if ($args->{'ccuname'}) {
16170: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16171: ':'.$args->{'ccdomain'};
16172: } else {
16173: $cenv{'internal.courseowner'} = $args->{'curruser'};
16174: }
1.1116 raeburn 16175: if ($args->{'defaultcredits'}) {
16176: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16177: }
1.444 albertel 16178: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
16179: if ($args->{'crssections'}) {
16180: $cenv{'internal.sectionnums'} = '';
16181: if ($args->{'crssections'} =~ m/,/) {
16182: @sections = split/,/,$args->{'crssections'};
16183: } else {
16184: $sections[0] = $args->{'crssections'};
16185: }
16186: if (@sections > 0) {
16187: foreach my $item (@sections) {
16188: my ($sec,$gp) = split/:/,$item;
16189: my $class = $args->{'crscode'}.$sec;
16190: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16191: $cenv{'internal.sectionnums'} .= $item.',';
16192: unless ($addcheck eq 'ok') {
1.1263 raeburn 16193: push(@badclasses,$class);
1.444 albertel 16194: }
16195: }
16196: $cenv{'internal.sectionnums'} =~ s/,$//;
16197: }
16198: }
16199: # do not hide course coordinator from staff listing,
16200: # even if privileged
16201: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 16202: # add course coordinator's domain to domains to check for privileged users
16203: # if different to course domain
16204: if ($$crsudom ne $args->{'ccdomain'}) {
16205: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16206: }
1.444 albertel 16207: # add crosslistings
16208: if ($args->{'crsxlist'}) {
16209: $cenv{'internal.crosslistings'}='';
16210: if ($args->{'crsxlist'} =~ m/,/) {
16211: @xlists = split/,/,$args->{'crsxlist'};
16212: } else {
16213: $xlists[0] = $args->{'crsxlist'};
16214: }
16215: if (@xlists > 0) {
16216: foreach my $item (@xlists) {
16217: my ($xl,$gp) = split/:/,$item;
16218: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16219: $cenv{'internal.crosslistings'} .= $item.',';
16220: unless ($addcheck eq 'ok') {
1.1263 raeburn 16221: push(@badclasses,$xl);
1.444 albertel 16222: }
16223: }
16224: $cenv{'internal.crosslistings'} =~ s/,$//;
16225: }
16226: }
16227: if ($args->{'autoadds'}) {
16228: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16229: }
16230: if ($args->{'autodrops'}) {
16231: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16232: }
16233: # check for notification of enrollment changes
16234: my @notified = ();
16235: if ($args->{'notify_owner'}) {
16236: if ($args->{'ccuname'} ne '') {
16237: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16238: }
16239: }
16240: if ($args->{'notify_dc'}) {
16241: if ($uname ne '') {
1.630 raeburn 16242: push(@notified,$uname.':'.$udom);
1.444 albertel 16243: }
16244: }
16245: if (@notified > 0) {
16246: my $notifylist;
16247: if (@notified > 1) {
16248: $notifylist = join(',',@notified);
16249: } else {
16250: $notifylist = $notified[0];
16251: }
16252: $cenv{'internal.notifylist'} = $notifylist;
16253: }
16254: if (@badclasses > 0) {
16255: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 16256: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16257: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16258: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16259: );
1.1264 raeburn 16260: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16261: &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 16262: if ($context eq 'auto') {
16263: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 16264: } else {
1.566 albertel 16265: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 16266: }
16267: foreach my $item (@badclasses) {
1.541 raeburn 16268: if ($context eq 'auto') {
1.1261 raeburn 16269: $outcome .= " - $item\n";
1.541 raeburn 16270: } else {
1.1261 raeburn 16271: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16272: }
1.1261 raeburn 16273: }
16274: if ($context eq 'auto') {
16275: $outcome .= $linefeed;
16276: } else {
16277: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 16278: }
1.444 albertel 16279: }
16280: if ($args->{'no_end_date'}) {
16281: $args->{'endaccess'} = 0;
16282: }
16283: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16284: $cenv{'internal.autoend'}=$args->{'enrollend'};
16285: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16286: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16287: if ($args->{'showphotos'}) {
16288: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16289: }
16290: $cenv{'internal.authtype'} = $args->{'authtype'};
16291: $cenv{'internal.autharg'} = $args->{'autharg'};
16292: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16293: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16294: 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');
16295: if ($context eq 'auto') {
16296: $outcome .= $krb_msg;
16297: } else {
1.566 albertel 16298: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16299: }
16300: $outcome .= $linefeed;
1.444 albertel 16301: }
16302: }
16303: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16304: if ($args->{'setpolicy'}) {
16305: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16306: }
16307: if ($args->{'setcontent'}) {
16308: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16309: }
1.1251 raeburn 16310: if ($args->{'setcomment'}) {
16311: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16312: }
1.444 albertel 16313: }
16314: if ($args->{'reshome'}) {
16315: $cenv{'reshome'}=$args->{'reshome'}.'/';
16316: $cenv{'reshome'}=~s/\/+$/\//;
16317: }
16318: #
16319: # course has keyed access
16320: #
16321: if ($args->{'setkeys'}) {
16322: $cenv{'keyaccess'}='yes';
16323: }
16324: # if specified, key authority is not course, but user
16325: # only active if keyaccess is yes
16326: if ($args->{'keyauth'}) {
1.487 albertel 16327: my ($user,$domain) = split(':',$args->{'keyauth'});
16328: $user = &LONCAPA::clean_username($user);
16329: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16330: if ($user ne '' && $domain ne '') {
1.487 albertel 16331: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16332: }
16333: }
16334:
1.1166 raeburn 16335: #
1.1167 raeburn 16336: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 16337: #
16338: if ($args->{'uniquecode'}) {
16339: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16340: if ($code) {
16341: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 16342: my %crsinfo =
16343: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16344: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16345: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16346: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16347: }
1.1166 raeburn 16348: if (ref($coderef)) {
16349: $$coderef = $code;
16350: }
16351: }
16352: }
16353:
1.444 albertel 16354: if ($args->{'disresdis'}) {
16355: $cenv{'pch.roles.denied'}='st';
16356: }
16357: if ($args->{'disablechat'}) {
16358: $cenv{'plc.roles.denied'}='st';
16359: }
16360:
16361: # Record we've not yet viewed the Course Initialization Helper for this
16362: # course
16363: $cenv{'course.helper.not.run'} = 1;
16364: #
16365: # Use new Randomseed
16366: #
16367: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16368: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16369: #
16370: # The encryption code and receipt prefix for this course
16371: #
16372: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16373: $cenv{'internal.encpref'}=100+int(9*rand(99));
16374: #
16375: # By default, use standard grading
16376: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16377:
1.541 raeburn 16378: $outcome .= $linefeed.&mt('Setting environment').': '.
16379: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16380: #
16381: # Open all assignments
16382: #
16383: if ($args->{'openall'}) {
1.1341 raeburn 16384: my $opendate = time;
16385: if ($args->{'openallfrom'} =~ /^\d+$/) {
16386: $opendate = $args->{'openallfrom'};
16387: }
1.444 albertel 16388: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 16389: my %storecontent = ($storeunder => $opendate,
1.444 albertel 16390: $storeunder.'.type' => 'date_start');
1.1341 raeburn 16391: $outcome .= &mt('All assignments open starting [_1]',
16392: &Apache::lonlocal::locallocaltime($opendate)).': '.
16393: &Apache::lonnet::cput
16394: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16395: }
16396: #
16397: # Set first page
16398: #
16399: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16400: || ($cloneid)) {
1.445 albertel 16401: use LONCAPA::map;
1.444 albertel 16402: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16403:
16404: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16405: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16406:
1.444 albertel 16407: $outcome .= ($fatal?$errtext:'read ok').' - ';
16408: my $title; my $url;
16409: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16410: $title=&mt('Syllabus');
1.444 albertel 16411: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16412: } else {
1.963 raeburn 16413: $title=&mt('Table of Contents');
1.444 albertel 16414: $url='/adm/navmaps';
16415: }
1.445 albertel 16416:
16417: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16418: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16419:
16420: if ($errtext) { $fatal=2; }
1.541 raeburn 16421: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16422: }
1.566 albertel 16423:
1.1237 raeburn 16424: #
16425: # Set params for Placement Tests
16426: #
1.1239 raeburn 16427: if ($args->{'crstype'} eq 'Placement') {
16428: my %storecontent;
16429: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
16430: my %defaults = (
16431: buttonshide => { value => 'yes',
16432: type => 'string_yesno',},
16433: type => { value => 'randomizetry',
16434: type => 'string_questiontype',},
16435: maxtries => { value => 1,
16436: type => 'int_pos',},
16437: problemstatus => { value => 'no',
16438: type => 'string_problemstatus',},
16439: );
16440: foreach my $key (keys(%defaults)) {
16441: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
16442: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
16443: }
1.1237 raeburn 16444: &Apache::lonnet::cput
16445: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
16446: }
16447:
1.1344 raeburn 16448: return (1,$outcome,\@clonemsg);
1.444 albertel 16449: }
16450:
1.1166 raeburn 16451: sub make_unique_code {
16452: my ($cdom,$cnum) = @_;
16453: # get lock on uniquecodes db
16454: my $lockhash = {
16455: $cnum."\0".'uniquecodes' => $env{'user.name'}.
16456: ':'.$env{'user.domain'},
16457: };
16458: my $tries = 0;
16459: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16460: my ($code,$error);
16461:
16462: while (($gotlock ne 'ok') && ($tries<3)) {
16463: $tries ++;
16464: sleep 1;
16465: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
16466: }
16467: if ($gotlock eq 'ok') {
16468: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
16469: my $gotcode;
16470: my $attempts = 0;
16471: while ((!$gotcode) && ($attempts < 100)) {
16472: $code = &generate_code();
16473: if (!exists($currcodes{$code})) {
16474: $gotcode = 1;
16475: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
16476: $error = 'nostore';
16477: }
16478: }
16479: $attempts ++;
16480: }
16481: my @del_lock = ($cnum."\0".'uniquecodes');
16482: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
16483: } else {
16484: $error = 'nolock';
16485: }
16486: return ($code,$error);
16487: }
16488:
16489: sub generate_code {
16490: my $code;
16491: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
16492: for (my $i=0; $i<6; $i++) {
16493: my $lettnum = int (rand 2);
16494: my $item = '';
16495: if ($lettnum) {
16496: $item = $letts[int( rand(18) )];
16497: } else {
16498: $item = 1+int( rand(8) );
16499: }
16500: $code .= $item;
16501: }
16502: return $code;
16503: }
16504:
1.444 albertel 16505: ############################################################
16506: ############################################################
16507:
1.1237 raeburn 16508: # Community, Course and Placement Test
1.378 raeburn 16509: sub course_type {
16510: my ($cid) = @_;
16511: if (!defined($cid)) {
16512: $cid = $env{'request.course.id'};
16513: }
1.404 albertel 16514: if (defined($env{'course.'.$cid.'.type'})) {
16515: return $env{'course.'.$cid.'.type'};
1.378 raeburn 16516: } else {
16517: return 'Course';
1.377 raeburn 16518: }
16519: }
1.156 albertel 16520:
1.406 raeburn 16521: sub group_term {
16522: my $crstype = &course_type();
16523: my %names = (
16524: 'Course' => 'group',
1.865 raeburn 16525: 'Community' => 'group',
1.1237 raeburn 16526: 'Placement' => 'group',
1.406 raeburn 16527: );
16528: return $names{$crstype};
16529: }
16530:
1.902 raeburn 16531: sub course_types {
1.1310 raeburn 16532: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 16533: my %typename = (
16534: official => 'Official course',
16535: unofficial => 'Unofficial course',
16536: community => 'Community',
1.1165 raeburn 16537: textbook => 'Textbook course',
1.1237 raeburn 16538: placement => 'Placement test',
1.1310 raeburn 16539: lti => 'LTI provider',
1.902 raeburn 16540: );
16541: return (\@types,\%typename);
16542: }
16543:
1.156 albertel 16544: sub icon {
16545: my ($file)=@_;
1.505 albertel 16546: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 16547: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 16548: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 16549: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
16550: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
16551: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16552: $curfext.".gif") {
16553: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16554: $curfext.".gif";
16555: }
16556: }
1.249 albertel 16557: return &lonhttpdurl($iconname);
1.154 albertel 16558: }
1.84 albertel 16559:
1.575 albertel 16560: sub lonhttpdurl {
1.692 www 16561: #
16562: # Had been used for "small fry" static images on separate port 8080.
16563: # Modify here if lightweight http functionality desired again.
16564: # Currently eliminated due to increasing firewall issues.
16565: #
1.575 albertel 16566: my ($url)=@_;
1.692 www 16567: return $url;
1.215 albertel 16568: }
16569:
1.213 albertel 16570: sub connection_aborted {
16571: my ($r)=@_;
16572: $r->print(" ");$r->rflush();
16573: my $c = $r->connection;
16574: return $c->aborted();
16575: }
16576:
1.221 foxr 16577: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16578: # strings as 'strings'.
16579: sub escape_single {
1.221 foxr 16580: my ($input) = @_;
1.223 albertel 16581: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16582: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16583: return $input;
16584: }
1.223 albertel 16585:
1.222 foxr 16586: # Same as escape_single, but escape's "'s This
16587: # can be used for "strings"
16588: sub escape_double {
16589: my ($input) = @_;
16590: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16591: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16592: return $input;
16593: }
1.223 albertel 16594:
1.222 foxr 16595: # Escapes the last element of a full URL.
16596: sub escape_url {
16597: my ($url) = @_;
1.238 raeburn 16598: my @urlslices = split(/\//, $url,-1);
1.369 www 16599: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 16600: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16601: }
1.462 albertel 16602:
1.820 raeburn 16603: sub compare_arrays {
16604: my ($arrayref1,$arrayref2) = @_;
16605: my (@difference,%count);
16606: @difference = ();
16607: %count = ();
16608: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16609: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16610: foreach my $element (keys(%count)) {
16611: if ($count{$element} == 1) {
16612: push(@difference,$element);
16613: }
16614: }
16615: }
16616: return @difference;
16617: }
16618:
1.1322 raeburn 16619: sub lon_status_items {
16620: my %defaults = (
16621: E => 100,
16622: W => 4,
16623: N => 1,
1.1324 raeburn 16624: U => 5,
1.1322 raeburn 16625: threshold => 200,
16626: sysmail => 2500,
16627: );
16628: my %names = (
16629: E => 'Errors',
16630: W => 'Warnings',
16631: N => 'Notices',
1.1324 raeburn 16632: U => 'Unsent',
1.1322 raeburn 16633: );
16634: return (\%defaults,\%names);
16635: }
16636:
1.817 bisitz 16637: # -------------------------------------------------------- Initialize user login
1.462 albertel 16638: sub init_user_environment {
1.463 albertel 16639: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16640: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16641:
16642: my $public=($username eq 'public' && $domain eq 'public');
16643:
1.1062 raeburn 16644: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16645: my $now=time;
16646:
16647: if ($public) {
16648: my $max_public=100;
16649: my $oldest;
16650: my $oldest_time=0;
16651: for(my $next=1;$next<=$max_public;$next++) {
16652: if (-e $lonids."/publicuser_$next.id") {
16653: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16654: if ($mtime<$oldest_time || !$oldest_time) {
16655: $oldest_time=$mtime;
16656: $oldest=$next;
16657: }
16658: } else {
16659: $cookie="publicuser_$next";
16660: last;
16661: }
16662: }
16663: if (!$cookie) { $cookie="publicuser_$oldest"; }
16664: } else {
1.1275 raeburn 16665: # See if old ID present, if so, remove if this isn't a robot,
16666: # killing any existing non-robot sessions
1.463 albertel 16667: if (!$args->{'robot'}) {
16668: opendir(DIR,$lonids);
16669: while ($filename=readdir(DIR)) {
16670: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 16671: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
16672: &GDBM_READER(),0640)) {
1.1295 raeburn 16673: my $linkedfile;
1.1320 raeburn 16674: if (exists($oldenv{'user.linkedenv'})) {
16675: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 16676: }
1.1320 raeburn 16677: untie(%oldenv);
16678: if (unlink("$lonids/$filename")) {
16679: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
16680: if (-l "$lonids/$linkedfile.id") {
16681: unlink("$lonids/$linkedfile.id");
16682: }
1.1295 raeburn 16683: }
16684: }
16685: } else {
16686: unlink($lonids.'/'.$filename);
16687: }
1.463 albertel 16688: }
1.462 albertel 16689: }
1.463 albertel 16690: closedir(DIR);
1.1204 raeburn 16691: # If there is a undeleted lockfile for the user's paste buffer remove it.
16692: my $namespace = 'nohist_courseeditor';
16693: my $lockingkey = 'paste'."\0".'locked_num';
16694: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16695: $domain,$username);
16696: if (exists($lockhash{$lockingkey})) {
16697: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16698: unless ($delresult eq 'ok') {
16699: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16700: }
16701: }
1.462 albertel 16702: }
16703: # Give them a new cookie
1.463 albertel 16704: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16705: : $now.$$.int(rand(10000)));
1.463 albertel 16706: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16707:
16708: # Initialize roles
16709:
1.1062 raeburn 16710: ($userroles,$firstaccenv,$timerintenv) =
16711: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16712: }
16713: # ------------------------------------ Check browser type and MathML capability
16714:
1.1194 raeburn 16715: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16716: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16717:
16718: # ------------------------------------------------------------- Get environment
16719:
16720: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16721: my ($tmp) = keys(%userenv);
1.1275 raeburn 16722: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 16723: undef(%userenv);
16724: }
16725: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16726: $form->{'interface'}=$userenv{'interface'};
16727: }
16728: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16729:
16730: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16731: foreach my $option ('interface','localpath','localres') {
16732: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16733: }
16734: # --------------------------------------------------------- Write first profile
16735:
16736: {
16737: my %initial_env =
16738: ("user.name" => $username,
16739: "user.domain" => $domain,
16740: "user.home" => $authhost,
16741: "browser.type" => $clientbrowser,
16742: "browser.version" => $clientversion,
16743: "browser.mathml" => $clientmathml,
16744: "browser.unicode" => $clientunicode,
16745: "browser.os" => $clientos,
1.1137 raeburn 16746: "browser.mobile" => $clientmobile,
1.1141 raeburn 16747: "browser.info" => $clientinfo,
1.1194 raeburn 16748: "browser.osversion" => $clientosversion,
1.462 albertel 16749: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16750: "request.course.fn" => '',
16751: "request.course.uri" => '',
16752: "request.course.sec" => '',
16753: "request.role" => 'cm',
16754: "request.role.adv" => $env{'user.adv'},
16755: "request.host" => $ENV{'REMOTE_ADDR'},);
16756:
16757: if ($form->{'localpath'}) {
16758: $initial_env{"browser.localpath"} = $form->{'localpath'};
16759: $initial_env{"browser.localres"} = $form->{'localres'};
16760: }
16761:
16762: if ($form->{'interface'}) {
16763: $form->{'interface'}=~s/\W//gs;
16764: $initial_env{"browser.interface"} = $form->{'interface'};
16765: $env{'browser.interface'}=$form->{'interface'};
16766: }
16767:
1.1157 raeburn 16768: if ($form->{'iptoken'}) {
16769: my $lonhost = $r->dir_config('lonHostID');
16770: $initial_env{"user.noloadbalance"} = $lonhost;
16771: $env{'user.noloadbalance'} = $lonhost;
16772: }
16773:
1.1268 raeburn 16774: if ($form->{'noloadbalance'}) {
16775: my @hosts = &Apache::lonnet::current_machine_ids();
16776: my $hosthere = $form->{'noloadbalance'};
16777: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16778: $initial_env{"user.noloadbalance"} = $hosthere;
16779: $env{'user.noloadbalance'} = $hosthere;
16780: }
16781: }
16782:
1.1016 raeburn 16783: unless ($domain eq 'public') {
1.1273 raeburn 16784: my %is_adv = ( is_adv => $env{'user.adv'} );
16785: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
16786:
16787: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16788: $userenv{'availabletools.'.$tool} =
16789: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16790: undef,\%userenv,\%domdef,\%is_adv);
16791: }
1.980 raeburn 16792:
1.1311 raeburn 16793: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 16794: $userenv{'canrequest.'.$crstype} =
16795: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16796: 'reload','requestcourses',
16797: \%userenv,\%domdef,\%is_adv);
16798: }
1.724 raeburn 16799:
1.1273 raeburn 16800: $userenv{'canrequest.author'} =
16801: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16802: 'reload','requestauthor',
1.980 raeburn 16803: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 16804: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16805: $domain,$username);
16806: my $reqstatus = $reqauthor{'author_status'};
16807: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16808: if (ref($reqauthor{'author'}) eq 'HASH') {
16809: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16810: $reqauthor{'author'}{'timestamp'};
16811: }
1.1092 raeburn 16812: }
1.1287 raeburn 16813: my ($types,$typename) = &course_types();
16814: if (ref($types) eq 'ARRAY') {
16815: my @options = ('approval','validate','autolimit');
16816: my $optregex = join('|',@options);
16817: my (%willtrust,%trustchecked);
16818: foreach my $type (@{$types}) {
16819: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
16820: if ($dom_str ne '') {
16821: my $updatedstr = '';
16822: my @possdomains = split(',',$dom_str);
16823: foreach my $entry (@possdomains) {
16824: my ($extdom,$extopt) = split(':',$entry);
16825: unless ($trustchecked{$extdom}) {
16826: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
16827: $trustchecked{$extdom} = 1;
16828: }
16829: if ($willtrust{$extdom}) {
16830: $updatedstr .= $entry.',';
16831: }
16832: }
16833: $updatedstr =~ s/,$//;
16834: if ($updatedstr) {
16835: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
16836: } else {
16837: delete($userenv{'reqcrsotherdom.'.$type});
16838: }
16839: }
16840: }
16841: }
1.1092 raeburn 16842: }
1.462 albertel 16843: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16844:
1.462 albertel 16845: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16846: &GDBM_WRCREAT(),0640)) {
16847: &_add_to_env(\%disk_env,\%initial_env);
16848: &_add_to_env(\%disk_env,\%userenv,'environment.');
16849: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16850: if (ref($firstaccenv) eq 'HASH') {
16851: &_add_to_env(\%disk_env,$firstaccenv);
16852: }
16853: if (ref($timerintenv) eq 'HASH') {
16854: &_add_to_env(\%disk_env,$timerintenv);
16855: }
1.463 albertel 16856: if (ref($args->{'extra_env'})) {
16857: &_add_to_env(\%disk_env,$args->{'extra_env'});
16858: }
1.462 albertel 16859: untie(%disk_env);
16860: } else {
1.705 tempelho 16861: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16862: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16863: return 'error: '.$!;
16864: }
16865: }
16866: $env{'request.role'}='cm';
16867: $env{'request.role.adv'}=$env{'user.adv'};
16868: $env{'browser.type'}=$clientbrowser;
16869:
16870: return $cookie;
16871:
16872: }
16873:
16874: sub _add_to_env {
16875: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16876: if (ref($env_data) eq 'HASH') {
16877: while (my ($key,$value) = each(%$env_data)) {
16878: $idf->{$prefix.$key} = $value;
16879: $env{$prefix.$key} = $value;
16880: }
1.462 albertel 16881: }
16882: }
16883:
1.685 tempelho 16884: # --- Get the symbolic name of a problem and the url
16885: sub get_symb {
16886: my ($request,$silent) = @_;
1.726 raeburn 16887: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16888: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16889: if ($symb eq '') {
16890: if (!$silent) {
1.1071 raeburn 16891: if (ref($request)) {
16892: $request->print("Unable to handle ambiguous references:$url:.");
16893: }
1.685 tempelho 16894: return ();
16895: }
16896: }
16897: &Apache::lonenc::check_decrypt(\$symb);
16898: return ($symb);
16899: }
16900:
16901: # --------------------------------------------------------------Get annotation
16902:
16903: sub get_annotation {
16904: my ($symb,$enc) = @_;
16905:
16906: my $key = $symb;
16907: if (!$enc) {
16908: $key =
16909: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16910: }
16911: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16912: return $annotation{$key};
16913: }
16914:
16915: sub clean_symb {
1.731 raeburn 16916: my ($symb,$delete_enc) = @_;
1.685 tempelho 16917:
16918: &Apache::lonenc::check_decrypt(\$symb);
16919: my $enc = $env{'request.enc'};
1.731 raeburn 16920: if ($delete_enc) {
1.730 raeburn 16921: delete($env{'request.enc'});
16922: }
1.685 tempelho 16923:
16924: return ($symb,$enc);
16925: }
1.462 albertel 16926:
1.1181 raeburn 16927: ############################################################
16928: ############################################################
16929:
16930: =pod
16931:
16932: =head1 Routines for building display used to search for courses
16933:
16934:
16935: =over 4
16936:
16937: =item * &build_filters()
16938:
16939: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 16940: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16941: and quotacheck.pl
16942:
1.1181 raeburn 16943:
16944: Inputs:
16945:
16946: filterlist - anonymous array of fields to include as potential filters
16947:
16948: crstype - course type
16949:
16950: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16951: to pop-open a course selector (will contain "extra element").
16952:
16953: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16954:
16955: filter - anonymous hash of criteria and their values
16956:
16957: action - form action
16958:
16959: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16960:
1.1182 raeburn 16961: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 16962:
16963: cloneruname - username of owner of new course who wants to clone
16964:
16965: clonerudom - domain of owner of new course who wants to clone
16966:
16967: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16968:
16969: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16970:
16971: codedom - domain
16972:
16973: formname - value of form element named "form".
16974:
16975: fixeddom - domain, if fixed.
16976:
16977: prevphase - value to assign to form element named "phase" when going back to the previous screen
16978:
16979: cnameelement - name of form element in form on opener page which will receive title of selected course
16980:
16981: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16982:
16983: cdomelement - name of form element in form on opener page which will receive domain of selected course
16984:
16985: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16986:
16987: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16988:
16989: clonewarning - warning message about missing information for intended course owner when DC creates a course
16990:
1.1182 raeburn 16991:
1.1181 raeburn 16992: Returns: $output - HTML for display of search criteria, and hidden form elements.
16993:
1.1182 raeburn 16994:
1.1181 raeburn 16995: Side Effects: None
16996:
16997: =cut
16998:
16999: # ---------------------------------------------- search for courses based on last activity etc.
17000:
17001: sub build_filters {
17002: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
17003: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
17004: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
17005: $cnameelement,$cnumelement,$cdomelement,$setroles,
17006: $clonetext,$clonewarning) = @_;
1.1182 raeburn 17007: my ($list,$jscript);
1.1181 raeburn 17008: my $onchange = 'javascript:updateFilters(this)';
17009: my ($domainselectform,$sincefilterform,$createdfilterform,
17010: $ownerdomselectform,$persondomselectform,$instcodeform,
17011: $typeselectform,$instcodetitle);
17012: if ($formname eq '') {
17013: $formname = $caller;
17014: }
17015: foreach my $item (@{$filterlist}) {
17016: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
17017: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
17018: if ($item eq 'domainfilter') {
17019: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
17020: } elsif ($item eq 'coursefilter') {
17021: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
17022: } elsif ($item eq 'ownerfilter') {
17023: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17024: } elsif ($item eq 'ownerdomfilter') {
17025: $filter->{'ownerdomfilter'} =
17026: &LONCAPA::clean_domain($filter->{$item});
17027: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
17028: 'ownerdomfilter',1);
17029: } elsif ($item eq 'personfilter') {
17030: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17031: } elsif ($item eq 'persondomfilter') {
17032: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
17033: 'persondomfilter',1);
17034: } else {
17035: $filter->{$item} =~ s/\W//g;
17036: }
17037: if (!$filter->{$item}) {
17038: $filter->{$item} = '';
17039: }
17040: }
17041: if ($item eq 'domainfilter') {
17042: my $allow_blank = 1;
17043: if ($formname eq 'portform') {
17044: $allow_blank=0;
17045: } elsif ($formname eq 'studentform') {
17046: $allow_blank=0;
17047: }
17048: if ($fixeddom) {
17049: $domainselectform = '<input type="hidden" name="domainfilter"'.
17050: ' value="'.$codedom.'" />'.
17051: &Apache::lonnet::domain($codedom,'description');
17052: } else {
17053: $domainselectform = &select_dom_form($filter->{$item},
17054: 'domainfilter',
17055: $allow_blank,'',$onchange);
17056: }
17057: } else {
17058: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
17059: }
17060: }
17061:
17062: # last course activity filter and selection
17063: $sincefilterform = &timebased_select_form('sincefilter',$filter);
17064:
17065: # course created filter and selection
17066: if (exists($filter->{'createdfilter'})) {
17067: $createdfilterform = &timebased_select_form('createdfilter',$filter);
17068: }
17069:
1.1239 raeburn 17070: my $prefix = $crstype;
17071: if ($crstype eq 'Placement') {
17072: $prefix = 'Placement Test'
17073: }
1.1181 raeburn 17074: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 17075: 'cac' => "$prefix Activity",
17076: 'ccr' => "$prefix Created",
17077: 'cde' => "$prefix Title",
17078: 'cdo' => "$prefix Domain",
1.1181 raeburn 17079: 'ins' => 'Institutional Code',
17080: 'inc' => 'Institutional Categorization',
1.1239 raeburn 17081: 'cow' => "$prefix Owner/Co-owner",
17082: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 17083: 'cog' => 'Type',
17084: );
17085:
17086: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17087: my $typeval = 'Course';
17088: if ($crstype eq 'Community') {
17089: $typeval = 'Community';
1.1239 raeburn 17090: } elsif ($crstype eq 'Placement') {
17091: $typeval = 'Placement';
1.1181 raeburn 17092: }
17093: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
17094: } else {
17095: $typeselectform = '<select name="type" size="1"';
17096: if ($onchange) {
17097: $typeselectform .= ' onchange="'.$onchange.'"';
17098: }
17099: $typeselectform .= '>'."\n";
1.1237 raeburn 17100: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 17101: my $shown;
17102: if ($posstype eq 'Placement') {
17103: $shown = &mt('Placement Test');
17104: } else {
17105: $shown = &mt($posstype);
17106: }
1.1181 raeburn 17107: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 17108: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 17109: }
17110: $typeselectform.="</select>";
17111: }
17112:
17113: my ($cloneableonlyform,$cloneabletitle);
17114: if (exists($filter->{'cloneableonly'})) {
17115: my $cloneableon = '';
17116: my $cloneableoff = ' checked="checked"';
17117: if ($filter->{'cloneableonly'}) {
17118: $cloneableon = $cloneableoff;
17119: $cloneableoff = '';
17120: }
17121: $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>';
17122: if ($formname eq 'ccrs') {
1.1187 bisitz 17123: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 17124: } else {
17125: $cloneabletitle = &mt('Cloneable by you');
17126: }
17127: }
17128: my $officialjs;
17129: if ($crstype eq 'Course') {
17130: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 17131: # if (($fixeddom) || ($formname eq 'requestcrs') ||
17132: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
17133: if ($codedom) {
1.1181 raeburn 17134: $officialjs = 1;
17135: ($instcodeform,$jscript,$$numtitlesref) =
17136: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
17137: $officialjs,$codetitlesref);
17138: if ($jscript) {
1.1182 raeburn 17139: $jscript = '<script type="text/javascript">'."\n".
17140: '// <![CDATA['."\n".
17141: $jscript."\n".
17142: '// ]]>'."\n".
17143: '</script>'."\n";
1.1181 raeburn 17144: }
17145: }
17146: if ($instcodeform eq '') {
17147: $instcodeform =
17148: '<input type="text" name="instcodefilter" size="10" value="'.
17149: $list->{'instcodefilter'}.'" />';
17150: $instcodetitle = $lt{'ins'};
17151: } else {
17152: $instcodetitle = $lt{'inc'};
17153: }
17154: if ($fixeddom) {
17155: $instcodetitle .= '<br />('.$codedom.')';
17156: }
17157: }
17158: }
17159: my $output = qq|
17160: <form method="post" name="filterpicker" action="$action">
17161: <input type="hidden" name="form" value="$formname" />
17162: |;
17163: if ($formname eq 'modifycourse') {
17164: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
17165: '<input type="hidden" name="prevphase" value="'.
17166: $prevphase.'" />'."\n";
1.1198 musolffc 17167: } elsif ($formname eq 'quotacheck') {
17168: $output .= qq|
17169: <input type="hidden" name="sortby" value="" />
17170: <input type="hidden" name="sortorder" value="" />
17171: |;
17172: } else {
1.1181 raeburn 17173: my $name_input;
17174: if ($cnameelement ne '') {
17175: $name_input = '<input type="hidden" name="cnameelement" value="'.
17176: $cnameelement.'" />';
17177: }
17178: $output .= qq|
1.1182 raeburn 17179: <input type="hidden" name="cnumelement" value="$cnumelement" />
17180: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 17181: $name_input
17182: $roleelement
17183: $multelement
17184: $typeelement
17185: |;
17186: if ($formname eq 'portform') {
17187: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
17188: }
17189: }
17190: if ($fixeddom) {
17191: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
17192: }
17193: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
17194: if ($sincefilterform) {
17195: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
17196: .$sincefilterform
17197: .&Apache::lonhtmlcommon::row_closure();
17198: }
17199: if ($createdfilterform) {
17200: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
17201: .$createdfilterform
17202: .&Apache::lonhtmlcommon::row_closure();
17203: }
17204: if ($domainselectform) {
17205: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
17206: .$domainselectform
17207: .&Apache::lonhtmlcommon::row_closure();
17208: }
17209: if ($typeselectform) {
17210: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17211: $output .= $typeselectform;
17212: } else {
17213: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
17214: .$typeselectform
17215: .&Apache::lonhtmlcommon::row_closure();
17216: }
17217: }
17218: if ($instcodeform) {
17219: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
17220: .$instcodeform
17221: .&Apache::lonhtmlcommon::row_closure();
17222: }
17223: if (exists($filter->{'ownerfilter'})) {
17224: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
17225: '<table><tr><td>'.&mt('Username').'<br />'.
17226: '<input type="text" name="ownerfilter" size="20" value="'.
17227: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17228: $ownerdomselectform.'</td></tr></table>'.
17229: &Apache::lonhtmlcommon::row_closure();
17230: }
17231: if (exists($filter->{'personfilter'})) {
17232: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17233: '<table><tr><td>'.&mt('Username').'<br />'.
17234: '<input type="text" name="personfilter" size="20" value="'.
17235: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17236: $persondomselectform.'</td></tr></table>'.
17237: &Apache::lonhtmlcommon::row_closure();
17238: }
17239: if (exists($filter->{'coursefilter'})) {
17240: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17241: .'<input type="text" name="coursefilter" size="25" value="'
17242: .$list->{'coursefilter'}.'" />'
17243: .&Apache::lonhtmlcommon::row_closure();
17244: }
17245: if ($cloneableonlyform) {
17246: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17247: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17248: }
17249: if (exists($filter->{'descriptfilter'})) {
17250: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17251: .'<input type="text" name="descriptfilter" size="40" value="'
17252: .$list->{'descriptfilter'}.'" />'
17253: .&Apache::lonhtmlcommon::row_closure(1);
17254: }
17255: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17256: '<input type="hidden" name="updater" value="" />'."\n".
17257: '<input type="submit" name="gosearch" value="'.
17258: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17259: return $jscript.$clonewarning.$output;
17260: }
17261:
17262: =pod
17263:
17264: =item * &timebased_select_form()
17265:
1.1182 raeburn 17266: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 17267: filter e.g., Course Activity, Course Created, when searching for courses
17268: or communities
17269:
17270: Inputs:
17271:
17272: item - name of form element (sincefilter or createdfilter)
17273:
17274: filter - anonymous hash of criteria and their values
17275:
17276: Returns: HTML for a select box contained a blank, then six time selections,
17277: with value set in incoming form variables currently selected.
17278:
17279: Side Effects: None
17280:
17281: =cut
17282:
17283: sub timebased_select_form {
17284: my ($item,$filter) = @_;
17285: if (ref($filter) eq 'HASH') {
17286: $filter->{$item} =~ s/[^\d-]//g;
17287: if (!$filter->{$item}) { $filter->{$item}=-1; }
17288: return &select_form(
17289: $filter->{$item},
17290: $item,
17291: { '-1' => '',
17292: '86400' => &mt('today'),
17293: '604800' => &mt('last week'),
17294: '2592000' => &mt('last month'),
17295: '7776000' => &mt('last three months'),
17296: '15552000' => &mt('last six months'),
17297: '31104000' => &mt('last year'),
17298: 'select_form_order' =>
17299: ['-1','86400','604800','2592000','7776000',
17300: '15552000','31104000']});
17301: }
17302: }
17303:
17304: =pod
17305:
17306: =item * &js_changer()
17307:
17308: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 17309: when course type or domain is changed, and also to hide 'Searching ...' on
17310: page load completion for page showing search result.
1.1181 raeburn 17311:
17312: Inputs: None
17313:
1.1183 raeburn 17314: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 17315:
17316: Side Effects: None
17317:
17318: =cut
17319:
17320: sub js_changer {
17321: return <<ENDJS;
17322: <script type="text/javascript">
17323: // <![CDATA[
17324: function updateFilters(caller) {
17325: if (typeof(caller) != "undefined") {
17326: document.filterpicker.updater.value = caller.name;
17327: }
17328: document.filterpicker.submit();
17329: }
1.1183 raeburn 17330:
17331: function hideSearching() {
17332: if (document.getElementById('searching')) {
17333: document.getElementById('searching').style.display = 'none';
17334: }
17335: return;
17336: }
17337:
1.1181 raeburn 17338: // ]]>
17339: </script>
17340:
17341: ENDJS
17342: }
17343:
17344: =pod
17345:
1.1182 raeburn 17346: =item * &search_courses()
17347:
17348: Process selected filters form course search form and pass to lonnet::courseiddump
17349: to retrieve a hash for which keys are courseIDs which match the selected filters.
17350:
17351: Inputs:
17352:
17353: dom - domain being searched
17354:
17355: type - course type ('Course' or 'Community' or '.' if any).
17356:
17357: filter - anonymous hash of criteria and their values
17358:
17359: numtitles - for institutional codes - number of categories
17360:
17361: cloneruname - optional username of new course owner
17362:
17363: clonerudom - optional domain of new course owner
17364:
1.1221 raeburn 17365: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 17366: (used when DC is using course creation form)
17367:
17368: codetitles - reference to array of titles of components in institutional codes (official courses).
17369:
1.1221 raeburn 17370: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17371: (and so can clone automatically)
17372:
17373: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17374:
17375: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17376: courses to clone
1.1182 raeburn 17377:
17378: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17379:
17380:
17381: Side Effects: None
17382:
17383: =cut
17384:
17385:
17386: sub search_courses {
1.1221 raeburn 17387: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17388: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 17389: my (%courses,%showcourses,$cloner);
17390: if (($filter->{'ownerfilter'} ne '') ||
17391: ($filter->{'ownerdomfilter'} ne '')) {
17392: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17393: $filter->{'ownerdomfilter'};
17394: }
17395: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17396: if (!$filter->{$item}) {
17397: $filter->{$item}='.';
17398: }
17399: }
17400: my $now = time;
17401: my $timefilter =
17402: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17403: my ($createdbefore,$createdafter);
17404: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17405: $createdbefore = $now;
17406: $createdafter = $now-$filter->{'createdfilter'};
17407: }
17408: my ($instcodefilter,$regexpok);
17409: if ($numtitles) {
17410: if ($env{'form.official'} eq 'on') {
17411: $instcodefilter =
17412: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17413: $regexpok = 1;
17414: } elsif ($env{'form.official'} eq 'off') {
17415: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17416: unless ($instcodefilter eq '') {
17417: $regexpok = -1;
17418: }
17419: }
17420: } else {
17421: $instcodefilter = $filter->{'instcodefilter'};
17422: }
17423: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17424: if ($type eq '') { $type = '.'; }
17425:
17426: if (($clonerudom ne '') && ($cloneruname ne '')) {
17427: $cloner = $cloneruname.':'.$clonerudom;
17428: }
17429: %courses = &Apache::lonnet::courseiddump($dom,
17430: $filter->{'descriptfilter'},
17431: $timefilter,
17432: $instcodefilter,
17433: $filter->{'combownerfilter'},
17434: $filter->{'coursefilter'},
17435: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 17436: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 17437: $filter->{'cloneableonly'},
17438: $createdbefore,$createdafter,undef,
1.1221 raeburn 17439: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 17440: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
17441: my $ccrole;
17442: if ($type eq 'Community') {
17443: $ccrole = 'co';
17444: } else {
17445: $ccrole = 'cc';
17446: }
17447: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
17448: $filter->{'persondomfilter'},
17449: 'userroles',undef,
17450: [$ccrole,'in','ad','ep','ta','cr'],
17451: $dom);
17452: foreach my $role (keys(%rolehash)) {
17453: my ($cnum,$cdom,$courserole) = split(':',$role);
17454: my $cid = $cdom.'_'.$cnum;
17455: if (exists($courses{$cid})) {
17456: if (ref($courses{$cid}) eq 'HASH') {
17457: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
17458: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 17459: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 17460: }
17461: } else {
17462: $courses{$cid}{roles} = [$courserole];
17463: }
17464: $showcourses{$cid} = $courses{$cid};
17465: }
17466: }
17467: }
17468: %courses = %showcourses;
17469: }
17470: return %courses;
17471: }
17472:
17473: =pod
17474:
1.1181 raeburn 17475: =back
17476:
1.1207 raeburn 17477: =head1 Routines for version requirements for current course.
17478:
17479: =over 4
17480:
17481: =item * &check_release_required()
17482:
17483: Compares required LON-CAPA version with version on server, and
17484: if required version is newer looks for a server with the required version.
17485:
17486: Looks first at servers in user's owen domain; if none suitable, looks at
17487: servers in course's domain are permitted to host sessions for user's domain.
17488:
17489: Inputs:
17490:
17491: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17492:
17493: $courseid - Course ID of current course
17494:
17495: $rolecode - User's current role in course (for switchserver query string).
17496:
17497: $required - LON-CAPA version needed by course (format: Major.Minor).
17498:
17499:
17500: Returns:
17501:
17502: $switchserver - query string tp append to /adm/switchserver call (if
17503: current server's LON-CAPA version is too old.
17504:
17505: $warning - Message is displayed if no suitable server could be found.
17506:
17507: =cut
17508:
17509: sub check_release_required {
17510: my ($loncaparev,$courseid,$rolecode,$required) = @_;
17511: my ($switchserver,$warning);
17512: if ($required ne '') {
17513: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
17514: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17515: if ($reqdmajor ne '' && $reqdminor ne '') {
17516: my $otherserver;
17517: if (($major eq '' && $minor eq '') ||
17518: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
17519: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
17520: my $switchlcrev =
17521: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
17522: $userdomserver);
17523: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
17524: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
17525: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
17526: my $cdom = $env{'course.'.$courseid.'.domain'};
17527: if ($cdom ne $env{'user.domain'}) {
17528: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
17529: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
17530: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17531: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
17532: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
17533: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
17534: my $canhost =
17535: &Apache::lonnet::can_host_session($env{'user.domain'},
17536: $coursedomserver,
17537: $remoterev,
17538: $udomdefaults{'remotesessions'},
17539: $defdomdefaults{'hostedsessions'});
17540:
17541: if ($canhost) {
17542: $otherserver = $coursedomserver;
17543: } else {
17544: $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.");
17545: }
17546: } else {
17547: $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).");
17548: }
17549: } else {
17550: $otherserver = $userdomserver;
17551: }
17552: }
17553: if ($otherserver ne '') {
17554: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
17555: }
17556: }
17557: }
17558: return ($switchserver,$warning);
17559: }
17560:
17561: =pod
17562:
17563: =item * &check_release_result()
17564:
17565: Inputs:
17566:
17567: $switchwarning - Warning message if no suitable server found to host session.
17568:
17569: $switchserver - query string to append to /adm/switchserver containing lonHostID
17570: and current role.
17571:
17572: Returns: HTML to display with information about requirement to switch server.
17573: Either displaying warning with link to Roles/Courses screen or
17574: display link to switchserver.
17575:
1.1181 raeburn 17576: =cut
17577:
1.1207 raeburn 17578: sub check_release_result {
17579: my ($switchwarning,$switchserver) = @_;
17580: my $output = &start_page('Selected course unavailable on this server').
17581: '<p class="LC_warning">';
17582: if ($switchwarning) {
17583: $output .= $switchwarning.'<br /><a href="/adm/roles">';
17584: if (&show_course()) {
17585: $output .= &mt('Display courses');
17586: } else {
17587: $output .= &mt('Display roles');
17588: }
17589: $output .= '</a>';
17590: } elsif ($switchserver) {
17591: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17592: '<br />'.
17593: '<a href="/adm/switchserver?'.$switchserver.'">'.
17594: &mt('Switch Server').
17595: '</a>';
17596: }
17597: $output .= '</p>'.&end_page();
17598: return $output;
17599: }
17600:
17601: =pod
17602:
17603: =item * &needs_coursereinit()
17604:
17605: Determine if course contents stored for user's session needs to be
17606: refreshed, because content has changed since "Big Hash" last tied.
17607:
17608: Check for change is made if time last checked is more than 10 minutes ago
17609: (by default).
17610:
17611: Inputs:
17612:
17613: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17614:
17615: $interval (optional) - Time which may elapse (in s) between last check for content
17616: change in current course. (default: 600 s).
17617:
17618: Returns: an array; first element is:
17619:
17620: =over 4
17621:
17622: 'switch' - if content updates mean user's session
17623: needs to be switched to a server running a newer LON-CAPA version
17624:
17625: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17626: on current server hosting user's session
17627:
17628: '' - if no action required.
17629:
17630: =back
17631:
17632: If first item element is 'switch':
17633:
17634: second item is $switchwarning - Warning message if no suitable server found to host session.
17635:
17636: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17637: and current role.
17638:
17639: otherwise: no other elements returned.
17640:
17641: =back
17642:
17643: =cut
17644:
17645: sub needs_coursereinit {
17646: my ($loncaparev,$interval) = @_;
17647: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17648: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17649: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17650: my $now = time;
17651: if ($interval eq '') {
17652: $interval = 600;
17653: }
17654: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 17655: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1283 raeburn 17656: my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
1.1282 raeburn 17657: if ($blocked) {
17658: return ();
17659: }
1.1207 raeburn 17660: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
17661: if ($lastchange > $env{'request.course.tied'}) {
17662: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17663: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17664: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17665: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17666: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17667: $curr_reqd_hash{'internal.releaserequired'}});
17668: my ($switchserver,$switchwarning) =
17669: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17670: $curr_reqd_hash{'internal.releaserequired'});
17671: if ($switchwarning ne '' || $switchserver ne '') {
17672: return ('switch',$switchwarning,$switchserver);
17673: }
17674: }
17675: }
17676: return ('update');
17677: }
17678: }
17679: return ();
17680: }
1.1181 raeburn 17681:
1.1083 raeburn 17682: sub update_content_constraints {
1.1326 raeburn 17683: my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
1.1083 raeburn 17684: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17685: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 17686: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 17687: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 17688: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 17689: if ($item eq 'resourcetag') {
17690: if ($name eq 'responsetype') {
17691: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17692: }
1.1307 raeburn 17693: } elsif ($item eq 'course') {
17694: if ($name eq 'courserestype') {
17695: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
17696: }
1.1083 raeburn 17697: }
17698: }
17699: my $navmap = Apache::lonnavmaps::navmap->new();
17700: if (defined($navmap)) {
1.1307 raeburn 17701: my (%allresponses,%allcrsrestypes);
17702: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
17703: if ($res->is_tool()) {
17704: if ($allcrsrestypes{'exttool'}) {
17705: $allcrsrestypes{'exttool'} ++;
17706: } else {
17707: $allcrsrestypes{'exttool'} = 1;
17708: }
17709: next;
17710: }
1.1083 raeburn 17711: my %responses = $res->responseTypes();
17712: foreach my $key (keys(%responses)) {
17713: next unless(exists($checkresponsetypes{$key}));
17714: $allresponses{$key} += $responses{$key};
17715: }
17716: }
17717: foreach my $key (keys(%allresponses)) {
17718: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17719: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17720: ($reqdmajor,$reqdminor) = ($major,$minor);
17721: }
17722: }
1.1307 raeburn 17723: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 17724: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 17725: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17726: ($reqdmajor,$reqdminor) = ($major,$minor);
17727: }
17728: }
1.1083 raeburn 17729: undef($navmap);
17730: }
1.1326 raeburn 17731: my (@resources,@order,@resparms,@zombies);
17732: if ($keeporder) {
17733: use LONCAPA::map;
17734: @resources = @LONCAPA::map::resources;
17735: @order = @LONCAPA::map::order;
17736: @resparms = @LONCAPA::map::resparms;
17737: @zombies = @LONCAPA::map::zombies;
17738: }
1.1308 raeburn 17739: my $suppmap = 'supplemental.sequence';
17740: my ($suppcount,$supptools,$errors) = (0,0,0);
17741: ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
17742: $suppcount,$supptools,$errors);
1.1326 raeburn 17743: if ($keeporder) {
17744: @LONCAPA::map::resources = @resources;
17745: @LONCAPA::map::order = @order;
17746: @LONCAPA::map::resparms = @resparms;
17747: @LONCAPA::map::zombies = @zombies;
17748: }
1.1308 raeburn 17749: if ($supptools) {
17750: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
17751: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17752: ($reqdmajor,$reqdminor) = ($major,$minor);
17753: }
17754: }
1.1083 raeburn 17755: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17756: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17757: }
17758: return;
17759: }
17760:
1.1110 raeburn 17761: sub allmaps_incourse {
17762: my ($cdom,$cnum,$chome,$cid) = @_;
17763: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17764: $cid = $env{'request.course.id'};
17765: $cdom = $env{'course.'.$cid.'.domain'};
17766: $cnum = $env{'course.'.$cid.'.num'};
17767: $chome = $env{'course.'.$cid.'.home'};
17768: }
17769: my %allmaps = ();
17770: my $lastchange =
17771: &Apache::lonnet::get_coursechange($cdom,$cnum);
17772: if ($lastchange > $env{'request.course.tied'}) {
17773: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17774: unless ($ferr) {
1.1326 raeburn 17775: &update_content_constraints($cdom,$cnum,$chome,$cid,1);
1.1110 raeburn 17776: }
17777: }
17778: my $navmap = Apache::lonnavmaps::navmap->new();
17779: if (defined($navmap)) {
17780: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17781: $allmaps{$res->src()} = 1;
17782: }
17783: }
17784: return \%allmaps;
17785: }
17786:
1.1083 raeburn 17787: sub parse_supplemental_title {
17788: my ($title) = @_;
17789:
17790: my ($foldertitle,$renametitle);
17791: if ($title =~ /&&&/) {
17792: $title = &HTML::Entites::decode($title);
17793: }
17794: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17795: $renametitle=$4;
17796: my ($time,$uname,$udom) = ($1,$2,$3);
17797: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17798: my $name = &plainname($uname,$udom);
17799: $name = &HTML::Entities::encode($name,'"<>&\'');
17800: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17801: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17802: $name.': <br />'.$foldertitle;
17803: }
17804: if (wantarray) {
17805: return ($title,$foldertitle,$renametitle);
17806: }
17807: return $title;
17808: }
17809:
1.1143 raeburn 17810: sub recurse_supplemental {
1.1308 raeburn 17811: my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
1.1143 raeburn 17812: if ($suppmap) {
17813: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17814: if ($fatal) {
17815: $errors ++;
17816: } else {
17817: if ($#LONCAPA::map::resources > 0) {
17818: foreach my $res (@LONCAPA::map::resources) {
17819: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
17820: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 17821: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1308 raeburn 17822: ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
17823: $numfiles,$numexttools,$errors);
1.1143 raeburn 17824: } else {
1.1308 raeburn 17825: if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
17826: $numexttools ++;
17827: }
1.1143 raeburn 17828: $numfiles ++;
17829: }
17830: }
17831: }
17832: }
17833: }
17834: }
1.1308 raeburn 17835: return ($numfiles,$numexttools,$errors);
1.1143 raeburn 17836: }
17837:
1.1101 raeburn 17838: sub symb_to_docspath {
1.1267 raeburn 17839: my ($symb,$navmapref) = @_;
17840: return unless ($symb && ref($navmapref));
1.1101 raeburn 17841: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17842: if ($resurl=~/\.(sequence|page)$/) {
17843: $mapurl=$resurl;
17844: } elsif ($resurl eq 'adm/navmaps') {
17845: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17846: }
17847: my $mapresobj;
1.1267 raeburn 17848: unless (ref($$navmapref)) {
17849: $$navmapref = Apache::lonnavmaps::navmap->new();
17850: }
17851: if (ref($$navmapref)) {
17852: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 17853: }
17854: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17855: my $type=$2;
17856: my $path;
17857: if (ref($mapresobj)) {
17858: my $pcslist = $mapresobj->map_hierarchy();
17859: if ($pcslist ne '') {
17860: foreach my $pc (split(/,/,$pcslist)) {
17861: next if ($pc <= 1);
1.1267 raeburn 17862: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 17863: if (ref($res)) {
17864: my $thisurl = $res->src();
17865: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17866: my $thistitle = $res->title();
17867: $path .= '&'.
17868: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 17869: &escape($thistitle).
1.1101 raeburn 17870: ':'.$res->randompick().
17871: ':'.$res->randomout().
17872: ':'.$res->encrypted().
17873: ':'.$res->randomorder().
17874: ':'.$res->is_page();
17875: }
17876: }
17877: }
17878: $path =~ s/^\&//;
17879: my $maptitle = $mapresobj->title();
17880: if ($mapurl eq 'default') {
1.1129 raeburn 17881: $maptitle = 'Main Content';
1.1101 raeburn 17882: }
17883: $path .= (($path ne '')? '&' : '').
17884: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17885: &escape($maptitle).
1.1101 raeburn 17886: ':'.$mapresobj->randompick().
17887: ':'.$mapresobj->randomout().
17888: ':'.$mapresobj->encrypted().
17889: ':'.$mapresobj->randomorder().
17890: ':'.$mapresobj->is_page();
17891: } else {
17892: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17893: my $ispage = (($type eq 'page')? 1 : '');
17894: if ($mapurl eq 'default') {
1.1129 raeburn 17895: $maptitle = 'Main Content';
1.1101 raeburn 17896: }
17897: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 17898: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 17899: }
17900: unless ($mapurl eq 'default') {
17901: $path = 'default&'.
1.1146 raeburn 17902: &escape('Main Content').
1.1101 raeburn 17903: ':::::&'.$path;
17904: }
17905: return $path;
17906: }
17907:
1.1094 raeburn 17908: sub captcha_display {
1.1327 raeburn 17909: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 17910: my ($output,$error);
1.1234 raeburn 17911: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 17912: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 17913: if ($captcha eq 'original') {
1.1094 raeburn 17914: $output = &create_captcha();
17915: unless ($output) {
1.1172 raeburn 17916: $error = 'captcha';
1.1094 raeburn 17917: }
17918: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17919: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 17920: unless ($output) {
1.1172 raeburn 17921: $error = 'recaptcha';
1.1094 raeburn 17922: }
17923: }
1.1234 raeburn 17924: return ($output,$error,$captcha,$version);
1.1094 raeburn 17925: }
17926:
17927: sub captcha_response {
1.1327 raeburn 17928: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 17929: my ($captcha_chk,$captcha_error);
1.1327 raeburn 17930: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 17931: if ($captcha eq 'original') {
1.1094 raeburn 17932: ($captcha_chk,$captcha_error) = &check_captcha();
17933: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 17934: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 17935: } else {
17936: $captcha_chk = 1;
17937: }
17938: return ($captcha_chk,$captcha_error);
17939: }
17940:
17941: sub get_captcha_config {
1.1327 raeburn 17942: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 17943: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 17944: my $hostname = &Apache::lonnet::hostname($lonhost);
17945: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17946: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 17947: if ($context eq 'usercreation') {
17948: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17949: if (ref($domconfig{$context}) eq 'HASH') {
17950: $hashtocheck = $domconfig{$context}{'cancreate'};
17951: if (ref($hashtocheck) eq 'HASH') {
17952: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17953: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17954: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17955: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17956: }
17957: if ($privkey && $pubkey) {
17958: $captcha = 'recaptcha';
1.1234 raeburn 17959: $version = $hashtocheck->{'recaptchaversion'};
17960: if ($version ne '2') {
17961: $version = 1;
17962: }
1.1095 raeburn 17963: } else {
17964: $captcha = 'original';
17965: }
17966: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17967: $captcha = 'original';
17968: }
1.1094 raeburn 17969: }
1.1095 raeburn 17970: } else {
17971: $captcha = 'captcha';
17972: }
17973: } elsif ($context eq 'login') {
17974: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17975: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17976: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17977: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 17978: if ($privkey && $pubkey) {
17979: $captcha = 'recaptcha';
1.1234 raeburn 17980: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17981: if ($version ne '2') {
17982: $version = 1;
17983: }
1.1095 raeburn 17984: } else {
17985: $captcha = 'original';
1.1094 raeburn 17986: }
1.1095 raeburn 17987: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17988: $captcha = 'original';
1.1094 raeburn 17989: }
1.1327 raeburn 17990: } elsif ($context eq 'passwords') {
17991: if ($dom_in_effect) {
17992: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
17993: if ($passwdconf{'captcha'} eq 'recaptcha') {
17994: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
17995: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
17996: $privkey = $passwdconf{'recaptchakeys'}{'private'};
17997: }
17998: if ($privkey && $pubkey) {
17999: $captcha = 'recaptcha';
18000: $version = $passwdconf{'recaptchaversion'};
18001: if ($version ne '2') {
18002: $version = 1;
18003: }
18004: } else {
18005: $captcha = 'original';
18006: }
18007: } elsif ($passwdconf{'captcha'} ne 'notused') {
18008: $captcha = 'original';
18009: }
18010: }
18011: }
1.1234 raeburn 18012: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 18013: }
18014:
18015: sub create_captcha {
18016: my %captcha_params = &captcha_settings();
18017: my ($output,$maxtries,$tries) = ('',10,0);
18018: while ($tries < $maxtries) {
18019: $tries ++;
18020: my $captcha = Authen::Captcha->new (
18021: output_folder => $captcha_params{'output_dir'},
18022: data_folder => $captcha_params{'db_dir'},
18023: );
18024: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
18025:
18026: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
18027: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
18028: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 18029: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
18030: '<br />'.
18031: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 18032: last;
18033: }
18034: }
1.1323 raeburn 18035: if ($output eq '') {
18036: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
18037: }
1.1094 raeburn 18038: return $output;
18039: }
18040:
18041: sub captcha_settings {
18042: my %captcha_params = (
18043: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
18044: www_output_dir => "/captchaspool",
18045: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
18046: numchars => '5',
18047: );
18048: return %captcha_params;
18049: }
18050:
18051: sub check_captcha {
18052: my ($captcha_chk,$captcha_error);
18053: my $code = $env{'form.code'};
18054: my $md5sum = $env{'form.crypt'};
18055: my %captcha_params = &captcha_settings();
18056: my $captcha = Authen::Captcha->new(
18057: output_folder => $captcha_params{'output_dir'},
18058: data_folder => $captcha_params{'db_dir'},
18059: );
1.1109 raeburn 18060: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 18061: my %captcha_hash = (
18062: 0 => 'Code not checked (file error)',
18063: -1 => 'Failed: code expired',
18064: -2 => 'Failed: invalid code (not in database)',
18065: -3 => 'Failed: invalid code (code does not match crypt)',
18066: );
18067: if ($captcha_chk != 1) {
18068: $captcha_error = $captcha_hash{$captcha_chk}
18069: }
18070: return ($captcha_chk,$captcha_error);
18071: }
18072:
18073: sub create_recaptcha {
1.1234 raeburn 18074: my ($pubkey,$version) = @_;
18075: if ($version >= 2) {
18076: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
18077: } else {
18078: my $use_ssl;
18079: if ($ENV{'SERVER_PORT'} == 443) {
18080: $use_ssl = 1;
18081: }
18082: my $captcha = Captcha::reCAPTCHA->new;
18083: return $captcha->get_options_setter({theme => 'white'})."\n".
18084: $captcha->get_html($pubkey,undef,$use_ssl).
18085: &mt('If the text is hard to read, [_1] will replace them.',
18086: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
18087: '<br /><br />';
18088: }
1.1094 raeburn 18089: }
18090:
18091: sub check_recaptcha {
1.1234 raeburn 18092: my ($privkey,$version) = @_;
1.1094 raeburn 18093: my $captcha_chk;
1.1234 raeburn 18094: if ($version >= 2) {
18095: my %info = (
18096: secret => $privkey,
18097: response => $env{'form.g-recaptcha-response'},
18098: remoteip => $ENV{'REMOTE_ADDR'},
18099: );
1.1280 raeburn 18100: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
18101: $request->content(join('&',map {
18102: my $name = escape($_);
18103: "$name=" . ( ref($info{$_}) eq 'ARRAY'
18104: ? join("&$name=", map {escape($_) } @{$info{$_}})
18105: : &escape($info{$_}) );
18106: } keys(%info)));
18107: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 18108: if ($response->is_success) {
18109: my $data = JSON::DWIW->from_json($response->decoded_content);
18110: if (ref($data) eq 'HASH') {
18111: if ($data->{'success'}) {
18112: $captcha_chk = 1;
18113: }
18114: }
18115: }
18116: } else {
18117: my $captcha = Captcha::reCAPTCHA->new;
18118: my $captcha_result =
18119: $captcha->check_answer(
18120: $privkey,
18121: $ENV{'REMOTE_ADDR'},
18122: $env{'form.recaptcha_challenge_field'},
18123: $env{'form.recaptcha_response_field'},
18124: );
18125: if ($captcha_result->{is_valid}) {
18126: $captcha_chk = 1;
18127: }
1.1094 raeburn 18128: }
18129: return $captcha_chk;
18130: }
18131:
1.1174 raeburn 18132: sub emailusername_info {
1.1244 raeburn 18133: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 18134: my %titles = &Apache::lonlocal::texthash (
18135: lastname => 'Last Name',
18136: firstname => 'First Name',
18137: institution => 'School/college/university',
18138: location => "School's city, state/province, country",
18139: web => "School's web address",
18140: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 18141: id => 'Student/Employee ID',
1.1174 raeburn 18142: );
18143: return (\@fields,\%titles);
18144: }
18145:
1.1161 raeburn 18146: sub cleanup_html {
18147: my ($incoming) = @_;
18148: my $outgoing;
18149: if ($incoming ne '') {
18150: $outgoing = $incoming;
18151: $outgoing =~ s/;/;/g;
18152: $outgoing =~ s/\#/#/g;
18153: $outgoing =~ s/\&/&/g;
18154: $outgoing =~ s/</</g;
18155: $outgoing =~ s/>/>/g;
18156: $outgoing =~ s/\(/(/g;
18157: $outgoing =~ s/\)/)/g;
18158: $outgoing =~ s/"/"/g;
18159: $outgoing =~ s/'/'/g;
18160: $outgoing =~ s/\$/$/g;
18161: $outgoing =~ s{/}{/}g;
18162: $outgoing =~ s/=/=/g;
18163: $outgoing =~ s/\\/\/g
18164: }
18165: return $outgoing;
18166: }
18167:
1.1190 musolffc 18168: # Checks for critical messages and returns a redirect url if one exists.
18169: # $interval indicates how often to check for messages.
1.1282 raeburn 18170: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 18171: sub critical_redirect {
1.1282 raeburn 18172: my ($interval,$context) = @_;
1.1190 musolffc 18173: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 18174: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
18175: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18176: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18177: my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
18178: if ($blocked) {
18179: my $checkrole = "cm./$cdom/$cnum";
18180: if ($env{'request.course.sec'} ne '') {
18181: $checkrole .= "/$env{'request.course.sec'}";
18182: }
18183: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
18184: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
18185: return;
18186: }
18187: }
18188: }
1.1190 musolffc 18189: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
18190: $env{'user.name'});
18191: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 18192: my $redirecturl;
1.1190 musolffc 18193: if ($what[0]) {
18194: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
18195: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 18196: my $url=&Apache::lonnet::absolute_url().$redirecturl;
18197: return (1, $url);
1.1190 musolffc 18198: }
1.1191 raeburn 18199: }
18200: }
18201: return ();
1.1190 musolffc 18202: }
18203:
1.1174 raeburn 18204: # Use:
18205: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
18206: #
18207: ##################################################
18208: # password associated functions #
18209: ##################################################
18210: sub des_keys {
18211: # Make a new key for DES encryption.
18212: # Each key has two parts which are returned separately.
18213: # Please note: Each key must be passed through the &hex function
18214: # before it is output to the web browser. The hex versions cannot
18215: # be used to decrypt.
18216: my @hexstr=('0','1','2','3','4','5','6','7',
18217: '8','9','a','b','c','d','e','f');
18218: my $lkey='';
18219: for (0..7) {
18220: $lkey.=$hexstr[rand(15)];
18221: }
18222: my $ukey='';
18223: for (0..7) {
18224: $ukey.=$hexstr[rand(15)];
18225: }
18226: return ($lkey,$ukey);
18227: }
18228:
18229: sub des_decrypt {
18230: my ($key,$cyphertext) = @_;
18231: my $keybin=pack("H16",$key);
18232: my $cypher;
18233: if ($Crypt::DES::VERSION>=2.03) {
18234: $cypher=new Crypt::DES $keybin;
18235: } else {
18236: $cypher=new DES $keybin;
18237: }
1.1233 raeburn 18238: my $plaintext='';
18239: my $cypherlength = length($cyphertext);
18240: my $numchunks = int($cypherlength/32);
18241: for (my $j=0; $j<$numchunks; $j++) {
18242: my $start = $j*32;
18243: my $cypherblock = substr($cyphertext,$start,32);
18244: my $chunk =
18245: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
18246: $chunk .=
18247: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
18248: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
18249: $plaintext .= $chunk;
18250: }
1.1174 raeburn 18251: return $plaintext;
18252: }
18253:
1.1344 raeburn 18254: sub get_requested_shorturls {
1.1309 raeburn 18255: my ($cdom,$cnum,$navmap) = @_;
18256: return unless (ref($navmap));
1.1344 raeburn 18257: my ($numnew,$errors);
1.1309 raeburn 18258: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
18259: if (@toshorten) {
18260: my (%maps,%resources,%titles);
18261: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
18262: 'shorturls',$cdom,$cnum);
18263: if (keys(%resources)) {
1.1344 raeburn 18264: my %tocreate;
1.1309 raeburn 18265: foreach my $item (sort {$a <=> $b} (@toshorten)) {
18266: my $symb = $resources{$item};
18267: if ($symb) {
18268: $tocreate{$cnum.'&'.$symb} = 1;
18269: }
18270: }
1.1344 raeburn 18271: if (keys(%tocreate)) {
18272: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
18273: \%tocreate);
18274: }
1.1309 raeburn 18275: }
1.1344 raeburn 18276: }
18277: return ($numnew,$errors);
18278: }
18279:
18280: sub make_short_symbs {
18281: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
18282: my ($numnew,@errors);
18283: if (ref($tocreateref) eq 'HASH') {
18284: my %tocreate = %{$tocreateref};
1.1309 raeburn 18285: if (keys(%tocreate)) {
18286: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
18287: my $su = Short::URL->new(no_vowels => 1);
18288: my $init = '';
18289: my (%newunique,%addcourse,%courseonly,%failed);
18290: # get lock on tiny db
18291: my $now = time;
1.1344 raeburn 18292: if ($lockuser eq '') {
18293: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
18294: }
1.1309 raeburn 18295: my $lockhash = {
1.1344 raeburn 18296: "lock\0$now" => $lockuser,
1.1309 raeburn 18297: };
18298: my $tries = 0;
18299: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
18300: my ($code,$error);
18301: while (($gotlock ne 'ok') && ($tries<3)) {
18302: $tries ++;
18303: sleep 1;
1.1319 raeburn 18304: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 18305: }
18306: if ($gotlock eq 'ok') {
18307: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
18308: \%addcourse,\%courseonly,\%failed);
18309: if (keys(%failed)) {
18310: my $numfailed = scalar(keys(%failed));
18311: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
18312: }
18313: if (keys(%newunique)) {
18314: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
18315: if ($putres eq 'ok') {
18316: $numnew = scalar(keys(%newunique));
18317: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
18318: unless ($newputres eq 'ok') {
18319: push(@errors,&mt('error: could not store course look-up of short URLs'));
18320: }
18321: } else {
18322: push(@errors,&mt('error: could not store unique six character URLs'));
18323: }
18324: }
18325: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
18326: unless ($dellockres eq 'ok') {
18327: push(@errors,&mt('error: could not release lockfile'));
18328: }
18329: } else {
18330: push(@errors,&mt('error: could not obtain lockfile'));
18331: }
18332: if (keys(%courseonly)) {
18333: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
18334: if ($result ne 'ok') {
18335: push(@errors,&mt('error: could not update course look-up of short URLs'));
18336: }
18337: }
18338: }
18339: }
18340: return ($numnew,\@errors);
18341: }
18342:
18343: sub shorten_symbs {
18344: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
18345: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
18346: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
18347: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
18348: my (%possibles,%collisions);
18349: foreach my $key (keys(%{$tocreate})) {
18350: my $num = String::CRC32::crc32($key);
18351: my $tiny = $su->encode($num,$init);
18352: if ($tiny) {
18353: $possibles{$tiny} = $key;
18354: }
18355: }
18356: if (!$init) {
18357: $init = 1;
18358: } else {
18359: $init ++;
18360: }
18361: if (keys(%possibles)) {
18362: my @posstiny = keys(%possibles);
18363: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
18364: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
18365: if (keys(%currtiny)) {
18366: foreach my $key (keys(%currtiny)) {
18367: next if ($currtiny{$key} eq '');
18368: if ($currtiny{$key} eq $possibles{$key}) {
18369: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
18370: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18371: $courseonly->{$tsymb} = $key;
18372: }
18373: } else {
18374: $collisions{$possibles{$key}} = 1;
18375: }
18376: delete($possibles{$key});
18377: }
18378: }
18379: foreach my $key (keys(%possibles)) {
18380: $newunique->{$key} = $possibles{$key};
18381: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
18382: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18383: $addcourse->{$tsymb} = $key;
18384: }
18385: }
18386: }
18387: if (keys(%collisions)) {
18388: if ($init <5) {
18389: if (!$init) {
18390: $init = 1;
18391: } else {
18392: $init ++;
18393: }
18394: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
18395: $newunique,$addcourse,$courseonly,$failed);
18396: } else {
18397: foreach my $key (keys(%collisions)) {
18398: $failed->{$key} = 1;
18399: }
18400: }
18401: }
18402: return $init;
18403: }
18404:
1.1328 raeburn 18405: sub is_nonframeable {
1.1329 raeburn 18406: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
18407: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 18408: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 18409:
18410: $remprotocol = lc($remprotocol);
18411: $remhost = lc($remhost);
18412: my $remport = 80;
18413: if ($remprotocol eq 'https') {
18414: $remport = 443;
18415: }
1.1330 raeburn 18416: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 18417: if ($cached) {
18418: unless ($nocache) {
18419: if ($result) {
18420: return 1;
18421: } else {
18422: return 0;
18423: }
18424: }
18425: }
1.1328 raeburn 18426: my $uselink;
18427: my $request = new HTTP::Request('HEAD',$url);
18428: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
18429: if ($response->is_success()) {
18430: my $secpolicy = lc($response->header('content-security-policy'));
18431: my $xframeop = lc($response->header('x-frame-options'));
18432: $secpolicy =~ s/^\s+|\s+$//g;
18433: $xframeop =~ s/^\s+|\s+$//g;
18434: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 18435: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 18436: my ($origin,$protocol,$port);
18437: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
18438: $port = $ENV{'SERVER_PORT'};
18439: } else {
18440: $port = 80;
18441: }
18442: if ($absolute eq '') {
18443: $protocol = 'http:';
18444: if ($port == 443) {
18445: $protocol = 'https:';
18446: }
18447: $origin = $protocol.'//'.lc($hostname);
18448: } else {
18449: $origin = lc($absolute);
18450: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
18451: }
18452: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
18453: my $framepolicy = $1;
18454: $framepolicy =~ s/^\s+|\s+$//g;
18455: my @policies = split(/\s+/,$framepolicy);
18456: if (@policies) {
18457: if (grep(/^\Q'none'\E$/,@policies)) {
18458: $uselink = 1;
18459: } else {
18460: $uselink = 1;
18461: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
18462: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
18463: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
18464: undef($uselink);
18465: }
18466: if ($uselink) {
18467: if (grep(/^\Q'self'\E$/,@policies)) {
18468: if (($origin ne '') && ($remotehost eq $origin)) {
18469: undef($uselink);
18470: }
18471: }
18472: }
18473: if ($uselink) {
18474: my @possok;
18475: if ($ip ne '') {
18476: push(@possok,$ip);
18477: }
18478: my $hoststr = '';
18479: foreach my $part (reverse(split(/\./,$hostname))) {
18480: if ($hoststr eq '') {
18481: $hoststr = $part;
18482: } else {
18483: $hoststr = "$part.$hoststr";
18484: }
18485: if ($hoststr eq $hostname) {
18486: push(@possok,$hostname);
18487: } else {
18488: push(@possok,"*.$hoststr");
18489: }
18490: }
18491: if (@possok) {
18492: foreach my $poss (@possok) {
18493: last if (!$uselink);
18494: foreach my $policy (@policies) {
18495: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
18496: undef($uselink);
18497: last;
18498: }
18499: }
18500: }
18501: }
18502: }
18503: }
18504: }
18505: } elsif ($xframeop ne '') {
18506: $uselink = 1;
18507: my @policies = split(/\s*,\s*/,$xframeop);
18508: if (@policies) {
18509: unless (grep(/^deny$/,@policies)) {
18510: if ($origin ne '') {
18511: if (grep(/^sameorigin$/,@policies)) {
18512: if ($remotehost eq $origin) {
18513: undef($uselink);
18514: }
18515: }
18516: if ($uselink) {
18517: foreach my $policy (@policies) {
18518: if ($policy =~ /^allow-from\s*(.+)$/) {
18519: my $allowfrom = $1;
18520: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
18521: undef($uselink);
18522: last;
18523: }
18524: }
18525: }
18526: }
18527: }
18528: }
18529: }
18530: }
18531: }
18532: }
1.1329 raeburn 18533: if ($nocache) {
18534: if ($cached) {
18535: my $devalidate;
18536: if ($uselink && !$result) {
18537: $devalidate = 1;
18538: } elsif (!$uselink && $result) {
18539: $devalidate = 1;
18540: }
18541: if ($devalidate) {
18542: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
18543: }
18544: }
18545: } else {
18546: if ($uselink) {
18547: $result = 1;
18548: } else {
18549: $result = 0;
18550: }
18551: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
18552: }
1.1328 raeburn 18553: return $uselink;
18554: }
18555:
1.112 bowersj2 18556: 1;
18557: __END__;
1.41 ng 18558:
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